From f2fd88eaf229fa6fbef27aad1ea8d7bbeb9f69d7 Mon Sep 17 00:00:00 2001 From: Brian Dobbins Date: Sun, 28 Jan 2024 12:38:51 -0700 Subject: [PATCH 001/207] Very minor documentation fix for the ESMF_Info section where two lines said more or less the same thing, but the first seemed more clear. --- src/Infrastructure/Base/doc/Info_desc.tex | 2 -- 1 file changed, 2 deletions(-) diff --git a/src/Infrastructure/Base/doc/Info_desc.tex b/src/Infrastructure/Base/doc/Info_desc.tex index 51630f2844..e55dcbb4ed 100644 --- a/src/Infrastructure/Base/doc/Info_desc.tex +++ b/src/Infrastructure/Base/doc/Info_desc.tex @@ -69,8 +69,6 @@ \subsection{Key Format Overview} \label{info_key_format} A key in the \texttt{ESMF\_Info} interface provides the location of a value to retrieve from the key-value storage. Keys in the \texttt{ESMF\_Info} class use the JSON Pointer syntax \cite{json_for_modern_cpp_json_pointer}. A forward slash is prepended to string keys if it does not exist. Hence, \texttt{"aKey"} and \texttt{"/aKey"} are equivalent. Note the indexing aspect of the JSON Pointer syntax is not supported. -Every "key" argument in the \texttt{ESMF\_Info} class uses pathing following the JSON Pointer syntax [6]. A forward slash is prepended to string keys if it does not exist. Hence, "aKey" and "/aKey" are equivalent. Note the indexing aspect of the JSON Pointer syntax is not supported (i.e. "/my\_list~1"). - Some examples for valid "key" arguments: \begin{itemize} \item \texttt{altitude} :: A simple key argument with no nesting. From d9da2ea14ef24d50ec1f67f9a4e995612880ee0c Mon Sep 17 00:00:00 2001 From: uturuncoglu Date: Thu, 2 May 2024 16:13:27 -0600 Subject: [PATCH 002/207] add extra metadata to fields --- src/addon/NUOPC/src/NUOPC_Connector.F90 | 12 +++++++ src/addon/NUOPC/src/NUOPC_Driver.F90 | 45 ++++++++++++++++++++++++- 2 files changed, 56 insertions(+), 1 deletion(-) diff --git a/src/addon/NUOPC/src/NUOPC_Connector.F90 b/src/addon/NUOPC/src/NUOPC_Connector.F90 index b11e6e92d4..30f687690e 100644 --- a/src/addon/NUOPC/src/NUOPC_Connector.F90 +++ b/src/addon/NUOPC/src/NUOPC_Connector.F90 @@ -802,6 +802,7 @@ recursive subroutine doMirror(providerState, acceptorState, acceptorVM, rc) integer :: item, itemCount character(ESMF_MAXSTR) :: providerTransferOffer, acceptorTransferOffer character(ESMF_MAXSTR) :: acceptorStateName + character(ESMF_MAXSTR) :: providerCompName type(ESMF_State) :: providerNestedState type(ESMF_State) :: acceptorNestedState character(ESMF_MAXSTR) :: nestedStateName @@ -836,6 +837,11 @@ recursive subroutine doMirror(providerState, acceptorState, acceptorVM, rc) if (vmThis == ESMF_NULL_POINTER) then actualFlag = .false. ! local PET is not for an actual member endif + + call NUOPC_GetAttribute(providerState, name="CompName", & + value=providerCompName, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=trim(name)//":"//FILENAME)) return ! bail out call ESMF_StateGet(acceptorState, name=acceptorStateName, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & @@ -1012,6 +1018,12 @@ recursive subroutine doMirror(providerState, acceptorState, acceptorVM, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, file=trim(name)//":"//FILENAME)) return ! bail out endif + + ! Add extra metadata to the field in acceptor side about provider + call NUOPC_SetAttribute(fieldAdv, name="ProviderCompName", & + value=trim(providerCompName), rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=trim(name)//":"//FILENAME)) return ! bail out end do endif diff --git a/src/addon/NUOPC/src/NUOPC_Driver.F90 b/src/addon/NUOPC/src/NUOPC_Driver.F90 index f04e0d4a7e..5b2c6602bc 100644 --- a/src/addon/NUOPC/src/NUOPC_Driver.F90 +++ b/src/addon/NUOPC/src/NUOPC_Driver.F90 @@ -1600,6 +1600,8 @@ recursive subroutine loopModelComps(phase, rc) logical :: areServicesSet character(ESMF_MAXSTR) :: iString, pLabel logical :: mustAttributeUpdate(1:is%wrap%modelCount) + logical :: isPresent + type(ESMF_Info) :: info rc = ESMF_SUCCESS mustAttributeUpdate = .false. ! loop through all the model components first time to execute @@ -1642,7 +1644,48 @@ recursive subroutine loopModelComps(phase, rc) return ! bail out endif enddo - ! loop through all the model components second time to update Attributes + ! loop through all the model components second time to add extra metadata + do i=1, is%wrap%modelCount + call ESMF_GridCompGet(is%wrap%modelComp(i), name=compName, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=trim(name)//":"//FILENAME, rcToReturn=rc)) & + return ! bail out + ! add metadata to import state + call ESMF_InfoGetFromHost(is%wrap%modelIS(i), info=info, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=trim(name)//":"//FILENAME, rcToReturn=rc)) & + return ! bail out + call ESMF_InfoGet(info, key="/NUOPC/Instance/CompName", & + isPresent=isPresent, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=trim(name)//":"//FILENAME, rcToReturn=rc)) & + return ! bail out + if (.not. isPresent) then + call ESMF_InfoSet(info, key="/NUOPC/Instance/CompName", & + value=trim(compName), rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=trim(name)//":"//FILENAME, rcToReturn=rc)) & + return ! bail out + end if + ! add metadata to export state + call ESMF_InfoGetFromHost(is%wrap%modelES(i), info=info, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=trim(name)//":"//FILENAME, rcToReturn=rc)) & + return ! bail out + call ESMF_InfoGet(info, key="/NUOPC/Instance/CompName", & + isPresent=isPresent, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=trim(name)//":"//FILENAME, rcToReturn=rc)) & + return ! bail out + if (.not. isPresent) then + call ESMF_InfoSet(info, key="/NUOPC/Instance/CompName", & + value=trim(compName), rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=trim(name)//":"//FILENAME, rcToReturn=rc)) & + return ! bail out + end if + end do + ! loop through all the model components third time to update Attributes do i=1, is%wrap%modelCount if (mustAttributeUpdate(i)) then ! need to update the Component attributes across all PETs From 1adf804cbf77335b5614e85093dfc578c1e4887e Mon Sep 17 00:00:00 2001 From: Robert Oehmke Date: Sun, 14 Jul 2024 15:51:52 -0600 Subject: [PATCH 003/207] Pass mesh and side info down for XGrid Conserve 2nd order. --- .../Field/src/ESMF_FieldRegrid.F90 | 137 ++++++++++-- src/Infrastructure/Mesh/src/Legacy/ESMCI_SM.C | 195 ++++++++++++++++++ .../Mesh/src/Regridding/ESMCI_Interp.C | 10 + .../XGrid/tests/ESMF_XGridUTest.F90 | 5 +- 4 files changed, 327 insertions(+), 20 deletions(-) diff --git a/src/Infrastructure/Field/src/ESMF_FieldRegrid.F90 b/src/Infrastructure/Field/src/ESMF_FieldRegrid.F90 index 65819e29d1..68eb2f5e21 100644 --- a/src/Infrastructure/Field/src/ESMF_FieldRegrid.F90 +++ b/src/Infrastructure/Field/src/ESMF_FieldRegrid.F90 @@ -3475,17 +3475,21 @@ subroutine ESMF_FieldRegridStoreX(xgrid, srcField, dstField, keywordEnforcer, & type(ESMF_STAGGERLOC):: interpFieldStaggerloc, fracFieldStaggerloc type(ESMF_MESHLOC) :: interpFieldMeshloc, fracFieldMeshloc type(ESMF_RegridMethod_Flag) :: lregridmethod - type(ESMF_Mesh) :: superMesh + type(ESMF_Mesh) :: xgridMesh, sideMesh + logical :: sideMeshDestroy type(ESMF_Field) :: tmpSrcField, tmpDstField + type(ESMF_Field) :: sideField type(ESMF_Typekind_Flag) :: fieldTypeKind + integer :: xgridSide, xgridInd, sideMeshSide, sideMeshInd + ! Initialize return code; assume failure until success is certain localrc = ESMF_SUCCESS if (present(rc)) rc = ESMF_RC_NOT_IMPL ! Set optional method argument if (present(regridmethod)) then - lregridmethod=regridmethod + Lregridmethod=regridmethod else lregridmethod=ESMF_REGRIDMETHOD_CONSERVE endif @@ -3521,6 +3525,7 @@ subroutine ESMF_FieldRegridStoreX(xgrid, srcField, dstField, keywordEnforcer, & ESMF_CONTEXT, rcToReturn=rc)) return srcgeomtype = geomtype + ! locate the Grid or XGrid contained in srcField if(geomtype == ESMF_GEOMTYPE_GRID) then call ESMF_FieldGet(srcField, grid=srcGrid, & @@ -3558,6 +3563,7 @@ subroutine ESMF_FieldRegridStoreX(xgrid, srcField, dstField, keywordEnforcer, & endif enddo + ! If found create Mesh from Grid if(.not. found) then call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_BAD, & msg="- cannot Locate src Field Grid in XGrid", & @@ -3972,6 +3978,11 @@ subroutine ESMF_FieldRegridStoreX(xgrid, srcField, dstField, keywordEnforcer, & ESMF_CONTEXT, rcToReturn=rc)) return else + ! Init side info + sideMeshDestroy=.false. + sideMeshSide=0 + sideMeshInd=0 + ! Set temporary field for source if (srcSide == ESMF_XGRIDSIDE_BALANCED) then @@ -3982,19 +3993,22 @@ subroutine ESMF_FieldRegridStoreX(xgrid, srcField, dstField, keywordEnforcer, & ESMF_CONTEXT, rcToReturn=rc)) return ! Get Super Mesh - call ESMF_XGridGet(xgrid, mesh=superMesh, rc=localrc) + call ESMF_XGridGet(xgrid, mesh=xgridMesh, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return ! Create temporary field - tmpSrcField=ESMF_FieldCreate(superMesh, & + tmpSrcField=ESMF_FieldCreate(xgridMesh, & typekind=fieldTypeKind, & meshloc=ESMF_MESHLOC_ELEMENT, & rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return else - tmpSrcField=srcField + sideField=srcField + sideMeshSide=0 + if (srcSide == ESMF_XGRIDSIDE_B) sideMeshSide=1 + sideMeshInd=srcIdx endif ! Set temporary field for dst @@ -4007,21 +4021,105 @@ subroutine ESMF_FieldRegridStoreX(xgrid, srcField, dstField, keywordEnforcer, & ESMF_CONTEXT, rcToReturn=rc)) return ! Get Super Mesh - call ESMF_XGridGet(xgrid, mesh=superMesh, rc=localrc) + call ESMF_XGridGet(xgrid, mesh=xgridMesh, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return ! Create temporary field - tmpDstField=ESMF_FieldCreate(superMesh, & + tmpDstField=ESMF_FieldCreate(xgridMesh, & typekind=fieldTypeKind, & meshloc=ESMF_MESHLOC_ELEMENT, & rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return else - tmpDstField=dstField + sideField=dstField + sideMeshSide=0 + if (dstSide == ESMF_XGRIDSIDE_B) sideMeshSide=1 + sideMeshInd=dstIdx + endif + + ! Set XGrid side and ind information + xgridSide=3 + xgridInd=0 + call c_esmc_meshsetxgridinfo(xgridMesh, xgridSide, xgridInd, localrc) + if (ESMF_LogFoundError(localrc, & + ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, rcToReturn=rc)) return + + ! Get/create sideMesh + call ESMF_FieldGet(sideField, geomtype=geomtype, & + rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, rcToReturn=rc)) return + + if (geomtype == ESMF_GEOMTYPE_GRID) then + call ESMF_FieldGet(sideField, grid=srcGrid, & + rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, rcToReturn=rc)) return + + ! Create Mesh from Grid + sideMesh=conserve_GridToMesh(srcGrid, & + !maskValues, turnedOnMeshElemMask, & + rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, rcToReturn=rc)) return + + ! Record that we created the mesh + sideMeshDestroy=.true. + + else if (geomtype == ESMF_GEOMTYPE_MESH) then + call ESMF_FieldGet(sideField, mesh=sideMesh, rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, rcToReturn=rc)) return + else + call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_BAD, & + msg=" side Field is not built on Grid, or Mesh.", & + ESMF_CONTEXT, rcToReturn=rc) + return endif + ! Set side Mesh info + call c_esmc_meshsetxgridinfo(sideMesh, sideMeshSide, sideMeshInd, localrc) + if (ESMF_LogFoundError(localrc, & + ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, rcToReturn=rc)) return + + ! Set temporary field for side + if (srcSide /= ESMF_XGRIDSIDE_BALANCED) then + + ! Get Field typekind + call ESMF_FieldGet(srcField, typekind=fieldTypeKind, & + rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, rcToReturn=rc)) return + + ! Create temporary field + tmpSrcField=ESMF_FieldCreate(sideMesh, & + typekind=fieldTypeKind, & + meshloc=ESMF_MESHLOC_ELEMENT, & + rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, rcToReturn=rc)) return + else if (dstSide /= ESMF_XGRIDSIDE_BALANCED) then + + ! Get Field typekind + call ESMF_FieldGet(dstField, typekind=fieldTypeKind, & + rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, rcToReturn=rc)) return + + ! Create temporary field + tmpDstField=ESMF_FieldCreate(sideMesh, & + typekind=fieldTypeKind, & + meshloc=ESMF_MESHLOC_ELEMENT, & + rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, rcToReturn=rc)) return + endif + + ! Generate routehandle other that 1st order conserve call ESMF_FieldRegridStoreNX(& srcField=tmpSrcField, & @@ -4037,22 +4135,23 @@ subroutine ESMF_FieldRegridStoreX(xgrid, srcField, dstField, keywordEnforcer, & if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return - ! Get rid of temporary source Field if necessary - if (srcSide == ESMF_XGRIDSIDE_BALANCED) then + ! Get rid of temporary source Fields if necessary + call ESMF_FieldDestroy(tmpSrcField, rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, rcToReturn=rc)) return - call ESMF_FieldDestroy(tmpSrcField, rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, rcToReturn=rc)) return - endif + call ESMF_FieldDestroy(tmpDstField, rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, rcToReturn=rc)) return - ! Get rid of temporary destination Field if necessary - if (dstSide == ESMF_XGRIDSIDE_BALANCED) then - call ESMF_FieldDestroy(tmpDstField, rc=localrc) + ! Get rid of temporary sideMesh if necessary + if (sideMeshDestroy) then + call ESMF_MeshDestroy(sideMesh, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, rcToReturn=rc)) return + ESMF_CONTEXT, rcToReturn=rc)) return endif - + endif diff --git a/src/Infrastructure/Mesh/src/Legacy/ESMCI_SM.C b/src/Infrastructure/Mesh/src/Legacy/ESMCI_SM.C index 76970520f7..37cbd37e8e 100644 --- a/src/Infrastructure/Mesh/src/Legacy/ESMCI_SM.C +++ b/src/Infrastructure/Mesh/src/Legacy/ESMCI_SM.C @@ -1070,4 +1070,199 @@ namespace ESMCI { //////////////// END CALC 2D 3D WEIGHTS ////////////////// + // This method creates sm cells for a 2nd order interpolation going from a side mesh to an XGrid + + // Here valid and wghts need to be resized to the same size as dst_elems before being passed into + // this call. + void create_dst_xgrid_SM_cells_2D_3D_sph(const MeshObj *src_elem, MEField<> *src_cfield, + std::vector dst_elems, MEField<> *dst_cfield, MEField<> * dst_mask_field, MEField<> * dst_frac2_field, + double *src_elem_area, + std::vector *valid, + std::vector *sintd_areas_out, std::vector *dst_areas_out, + std::vector *tmp_valid, std::vector *tmp_sintd_areas_out, std::vector *tmp_dst_areas_out, + std::vector *sm_cells) { + + //// STOPPED HERE //// + + +// Maximum size for a supported polygon +// Since the elements are of a small +// limited size. Fixed sized buffers seem +// the best way to handle them + +#define MAX_NUM_POLY_NODES 40 +#define MAX_NUM_POLY_COORDS_3D (3*MAX_NUM_POLY_NODES) + + // Declaration for src polygon + int num_src_nodes; + double src_coords[MAX_NUM_POLY_COORDS_3D]; + double tmp_coords[MAX_NUM_POLY_COORDS_3D]; + + // Get src coords + get_elem_coords_3D_ccw(src_elem, src_cfield, MAX_NUM_POLY_NODES, tmp_coords, &num_src_nodes, src_coords); + + // Get rid of degenerate edges + remove_0len_edges3D(&num_src_nodes, src_coords); + + // If less than a triangle invalidate everything and leave because it won't results in weights + // Decision about returning error for degeneracy is made above this subroutine + if (num_src_nodes<3) { + *src_elem_area=0.0; + for (int i=0; i 3) { + bool left_turn=false; + bool right_turn=false; + + rot_2D_3D_sph(num_src_nodes, src_coords, &left_turn, &right_turn); + + if (left_turn && right_turn) is_concave=true; + } + + // If not concave then just call into the lower level + if (!is_concave) { + create_SM_cells_2D_3D_sph_src_pnts(num_src_nodes, src_coords, + dst_elems, dst_cfield, dst_mask_field, dst_frac2_field, + src_elem_area, + valid, + sintd_areas_out, dst_areas_out, + sm_cells); + + } else { // else, break into two pieces... + + // Space for temporary buffers + double td[3*4]; + int ti[4]; + int tri_ind[6]; + + + // This must be a quad if not complain and exit + // IF NOT A QUAD, THEN THE ABOVE BUFFER SIZES MUST BE CHANGED!!! + // TO EMPHASIZE THAT IT MUST BE QUAD 4 IS PASSED IN FOR THE SIZE BELOW. + if (num_src_nodes != 4) Throw() << " This isn't a quad, but it should be!"; + int ret=triangulate_poly(4, src_coords, td, + ti, tri_ind); + // Error check + // Check return code + if (ret != ESMCI_TP_SUCCESS) { + if (ret == ESMCI_TP_DEGENERATE_POLY) Throw() << " - can't triangulate a polygon with less than 3 sides"; + else if (ret == ESMCI_TP_CLOCKWISE_POLY) Throw() << " - clockwise polygons not supported in triangulation routine"; + else Throw() << " - unknown error in triangulation"; + } + + + // Because this is a quad it will be in 2 pieces. + double tri[9]; + + // Tri 1 + tri[0]=src_coords[3*tri_ind[0]]; + tri[1]=src_coords[3*tri_ind[0]+1]; + tri[2]=src_coords[3*tri_ind[0]+2]; + + tri[3]=src_coords[3*tri_ind[1]]; + tri[4]=src_coords[3*tri_ind[1]+1]; + tri[5]=src_coords[3*tri_ind[1]+2]; + + tri[6]=src_coords[3*tri_ind[2]]; + tri[7]=src_coords[3*tri_ind[2]+1]; + tri[8]=src_coords[3*tri_ind[2]+2]; + + create_SM_cells_2D_3D_sph_src_pnts(3, tri, + dst_elems, dst_cfield, dst_mask_field, dst_frac2_field, + src_elem_area, + valid, + sintd_areas_out, dst_areas_out, + sm_cells); + + + // Tri 2 + tri[0]=src_coords[3*tri_ind[3]]; + tri[1]=src_coords[3*tri_ind[3]+1]; + tri[2]=src_coords[3*tri_ind[3]+2]; + + tri[3]=src_coords[3*tri_ind[4]]; + tri[4]=src_coords[3*tri_ind[4]+1]; + tri[5]=src_coords[3*tri_ind[4]+2]; + + tri[6]=src_coords[3*tri_ind[5]]; + tri[7]=src_coords[3*tri_ind[5]+1]; + tri[8]=src_coords[3*tri_ind[5]+2]; + + + // Tmp variables to hold info from second triangle + double src_elem_area2; + + // If need to expand arrays, expand + if (dst_elems.size() > tmp_valid->size()) { + tmp_valid->resize(dst_elems.size(),0); + tmp_sintd_areas_out->resize(dst_elems.size(),0.0); + tmp_dst_areas_out->resize(dst_elems.size(),0.0); + } + + create_SM_cells_2D_3D_sph_src_pnts(3, tri, + dst_elems, dst_cfield, dst_mask_field, dst_frac2_field, + &src_elem_area2, + tmp_valid, + tmp_sintd_areas_out, tmp_dst_areas_out, + sm_cells); + + // Merge together src area + *src_elem_area=*src_elem_area+src_elem_area2; + + //loop through merging valid, sintd area and dst area + for (int i=0; i *src_cfield = srcmesh.GetCoordField(); diff --git a/src/Infrastructure/XGrid/tests/ESMF_XGridUTest.F90 b/src/Infrastructure/XGrid/tests/ESMF_XGridUTest.F90 index 3781591ec8..df0fe5807e 100644 --- a/src/Infrastructure/XGrid/tests/ESMF_XGridUTest.F90 +++ b/src/Infrastructure/XGrid/tests/ESMF_XGridUTest.F90 @@ -65,7 +65,7 @@ program ESMF_XGridUTest call ESMF_Test((rc .eq. ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE) !------------------------------------------------------------------------ -#if 1 +#if 0 !------------------------------------------------------------------------ !NEX_UTest write(name, *) "Testing XGrid IsCreated for uncreated object" @@ -194,6 +194,8 @@ program ESMF_XGridUTest write(name, *) "Creating an XGrid with Mesh easy element create interface" call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE) +#endif + !------------------------------------------------------------------------ !NEX_UTest ! Create an XGrid in 2D from Meshes with user supplied area @@ -202,6 +204,7 @@ program ESMF_XGridUTest write(name, *) "Test 2nd order on an XGrid between Meshes" call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE) +#if 0 !------------------------------------------------------------------------ !NEX_UTest ! Create an XGrid in 2D from Meshes with user supplied area From 0effdbcac4486ebd4a9a3bc324a781f7addc0f30 Mon Sep 17 00:00:00 2001 From: Robert Oehmke Date: Mon, 5 Aug 2024 16:41:01 -0600 Subject: [PATCH 004/207] Add search result creator for 2nd order conservative on XGrid to side mesh. --- .../Mesh/include/ESMCI_XGridUtil.h | 3 +- src/Infrastructure/Mesh/src/ESMCI_XGridUtil.C | 105 ++++++++++++++++++ .../Mesh/src/Regridding/ESMCI_Interp.C | 35 ++++-- 3 files changed, 135 insertions(+), 8 deletions(-) diff --git a/src/Infrastructure/Mesh/include/ESMCI_XGridUtil.h b/src/Infrastructure/Mesh/include/ESMCI_XGridUtil.h index 1d7b1b2f0f..9cc30d820f 100644 --- a/src/Infrastructure/Mesh/include/ESMCI_XGridUtil.h +++ b/src/Infrastructure/Mesh/include/ESMCI_XGridUtil.h @@ -17,6 +17,7 @@ #include #include #include +#include namespace ESMCI { @@ -291,7 +292,7 @@ double gcdistance(double * v1, double * v2); void calc_wgts_from_side_mesh_to_xgrid(Mesh *src_side_mesh, Mesh *dst_xgrid_mesh, IWeights &wts); void calc_wgts_from_xgrid_to_side_mesh(Mesh *src_xgrid_mesh, Mesh *dst_side_mesh, IWeights &wts); - +void XGridGatherOverlappingElems(Mesh &srcMesh, Mesh &dstMesh, SearchResult &result); // Debugging apis void cart2sph(int num_p, const double *p, double *lonlat); diff --git a/src/Infrastructure/Mesh/src/ESMCI_XGridUtil.C b/src/Infrastructure/Mesh/src/ESMCI_XGridUtil.C index 6d4a654042..36a3caf2b5 100644 --- a/src/Infrastructure/Mesh/src/ESMCI_XGridUtil.C +++ b/src/Infrastructure/Mesh/src/ESMCI_XGridUtil.C @@ -24,6 +24,8 @@ #include #include #include +#include + #include #include @@ -2798,5 +2800,108 @@ void calc_wgts_from_xgrid_to_side_mesh(Mesh *src_xgrid_mesh, Mesh *dst_side_mesh } } + void srcXGridGatherOverlappingElems(Mesh &srcXGridMesh, Mesh &dstMesh, SearchResult &result) { + + printf("sXGE src side=%d src ind=%d\n",srcXGridMesh.side,srcXGridMesh.ind); + printf("sXGE dst side=%d dst ind=%d\n",dstMesh.side,dstMesh.ind); + + // Get dst side mesh info + int side=dstMesh.side; + int ind=dstMesh.ind; + + // Check side and ind info to make sure it's valid + if ((side != 1) && (side !=2)) Throw() << "side (for an xgrid side mesh) should be 1 or 2"; + if (ind < 1) Throw() <<"ind (for an xgrid side mesh) should be >=1."; + + // Get data fields corresponding to side + MEField<> *mesh_ind_field = NULL; + MEField<> *orig_elem_id_field = NULL; + if (side == 1) { + mesh_ind_field = srcXGridMesh.GetField("side1_mesh_ind"); + orig_elem_id_field = srcXGridMesh.GetField("side1_orig_elem_id"); + } else if (side ==2) { + mesh_ind_field = srcXGridMesh.GetField("side2_mesh_ind"); + orig_elem_id_field = srcXGridMesh.GetField("side2_orig_elem_id"); + } else { + Throw() << "Invalid mesh side: "<data(src_elem); + int elem_mesh_ind = (int)(*elem_mesh_ind_dbl + 0.5); + + // if the ind matches, then attempt to add entry + if (elem_mesh_ind == ind) { + + // Get orig elem id + // (Round to nearest to take care of possible representation issues) + double *dst_orig_elem_id_dbl = orig_elem_id_field->data(src_elem); + int dst_orig_elem_id = (int)(*dst_orig_elem_id_dbl+0.5); + + // If the orig dst id is in the side mesh, then add it + Mesh::MeshObjIDMap::iterator mi = dstMesh.map_find(MeshObj::ELEMENT, dst_orig_elem_id); + if (mi != dstMesh.map_end(MeshObj::ELEMENT)) { + MeshObj *dst_elem=&*mi; + + // Create Search result + Search_result *sr=new Search_result(); + sr->elem=&src_elem; // Add src elem + sr->elems.push_back(dst_elem); // Add dst elem + + // Add it to results list + result.push_back(sr); + } + } + } + + } + + void dstXGridGatherOverlappingElems(Mesh &srcMesh, Mesh &dstXGridMesh, SearchResult &result) { + + printf("dXGE src side=%d src ind=%d\n",srcMesh.side,srcMesh.ind); + printf("dXGE dst side=%d dst ind=%d\n",dstXGridMesh.side,dstXGridMesh.ind); + + + + // Iterate through dst Mesh + //MeshDB::const_iterator ei = dstMesh.elem_begin(), ee = dstMesh.elem_end(); + //for (; ei != ee; ++ei) { + // meshB_elist.push_back(&*ei); + //} + +} + + + + // Used when one of src or dst Mesh is an XGrid. Uses XGrid + // information to gather elements of dstMesh that overlap with srcMesh + void XGridGatherOverlappingElems(Mesh &srcMesh, Mesh &dstMesh, SearchResult &result) { + + // Error check + if (srcMesh.spatial_dim() != dstMesh.spatial_dim()) { + Throw() << "Meshes must have same spatial dim for search"; + } + + // Branch depending on which is the XGrid + if (srcMesh.side==3) srcXGridGatherOverlappingElems(srcMesh, dstMesh, result); + else if (dstMesh.side==3) dstXGridGatherOverlappingElems(srcMesh, dstMesh, result); + else Throw() << "Unexpectedly neither src or dst Mesh is an XGrid."; + + } + } //namespace diff --git a/src/Infrastructure/Mesh/src/Regridding/ESMCI_Interp.C b/src/Infrastructure/Mesh/src/Regridding/ESMCI_Interp.C index 00692a6b4f..b6f31e362b 100644 --- a/src/Infrastructure/Mesh/src/Regridding/ESMCI_Interp.C +++ b/src/Infrastructure/Mesh/src/Regridding/ESMCI_Interp.C @@ -767,15 +767,15 @@ void calc_2nd_order_conserve_mat_serial_2D_3D_sph(Mesh &srcmesh, Mesh &dstmesh, struct Zoltan_Struct * zz, bool set_dst_status, WMat &dst_status) { Trace __trace("calc_conserve_mat_serial(Mesh &srcmesh, Mesh &dstmesh, SearchResult &sres, IWeights &iw)"); - + // See if we're doing an XGrid + bool xgrid_regrid=false; if ((srcmesh.side==3) || (dstmesh.side==3)) { + xgrid_regrid=true; + printf("src side=%d src ind=%d\n",srcmesh.side,srcmesh.ind); - printf("dst side=%d dst ind=%d\n",dstmesh.side,dstmesh.ind); + printf("dst side=%d dst ind=%d\n",dstmesh.side,dstmesh.ind); } - - - // Get src coord field MEField<> *src_cfield = srcmesh.GetCoordField(); @@ -3020,7 +3020,17 @@ interp_method(imethod) if(freeze_src_) { OctSearchElems(*src, ESMCI_UNMAPPEDACTION_IGNORE, grend.GetDstRend(), unmappedaction, 1e-8, sres); } else { - OctSearchElems(grend.GetSrcRend(), ESMCI_UNMAPPEDACTION_IGNORE, grend.GetDstRend(), unmappedaction, 1e-8, sres); + // If 2nd order see if it's an XGrid and then use that + if (interp_method == Interp::INTERP_CONSERVE_2ND) { + // If an XGrid is involved, then do a search using that + if ((grend.GetSrcRend().side==3) || (grend.GetSrcRend().side==3)) { + XGridGatherOverlappingElems(grend.GetSrcRend(), grend.GetDstRend(), sres); + } else { // ...otherwise just use the regular search + OctSearchElems(grend.GetSrcRend(), ESMCI_UNMAPPEDACTION_IGNORE, grend.GetDstRend(), unmappedaction, 1e-8, sres); + } + } else { // ...otherwise just use the regular search + OctSearchElems(grend.GetSrcRend(), ESMCI_UNMAPPEDACTION_IGNORE, grend.GetDstRend(), unmappedaction, 1e-8, sres); + } } } } @@ -3055,7 +3065,18 @@ interp_method(imethod) _check_mesh(*dest, "destination"); } - OctSearchElems(*src, ESMCI_UNMAPPEDACTION_IGNORE, *dest, unmappedaction, 1e-8, sres); + // If 2nd order see if it's an XGrid and then use that + if (interp_method == Interp::INTERP_CONSERVE_2ND) { + + // If an XGrid is involved, then do a search using that + if ((src->side==3) || (dest->side==3)) { + XGridGatherOverlappingElems(*src, *dest, sres); + } else { // ...otherwise just use the regular search + OctSearchElems(*src, ESMCI_UNMAPPEDACTION_IGNORE, *dest, unmappedaction, 1e-8, sres); + } + } else { // ...otherwise just use the regular search + OctSearchElems(*src, ESMCI_UNMAPPEDACTION_IGNORE, *dest, unmappedaction, 1e-8, sres); + } } } From 3667a00c4e27323f06992d4dd7bc844b5362e015 Mon Sep 17 00:00:00 2001 From: Robert Oehmke Date: Tue, 13 Aug 2024 16:43:03 -0600 Subject: [PATCH 005/207] Add search result creator for 2nd order conservative for side mesh to XGrid. --- src/Infrastructure/Mesh/src/ESMCI_XGridUtil.C | 88 +++++++++++++++++-- 1 file changed, 82 insertions(+), 6 deletions(-) diff --git a/src/Infrastructure/Mesh/src/ESMCI_XGridUtil.C b/src/Infrastructure/Mesh/src/ESMCI_XGridUtil.C index 36a3caf2b5..7de04666eb 100644 --- a/src/Infrastructure/Mesh/src/ESMCI_XGridUtil.C +++ b/src/Infrastructure/Mesh/src/ESMCI_XGridUtil.C @@ -41,6 +41,7 @@ #include #include +#include #include #include "ESMCI_Macros.h" @@ -2876,14 +2877,89 @@ void calc_wgts_from_xgrid_to_side_mesh(Mesh *src_xgrid_mesh, Mesh *dst_side_mesh printf("dXGE dst side=%d dst ind=%d\n",dstXGridMesh.side,dstXGridMesh.ind); + // Get dst side mesh info + int side=srcMesh.side; + int ind=srcMesh.ind; + + // Check side and ind info to make sure it's valid + if ((side != 1) && (side !=2)) Throw() << "side (for an xgrid side mesh) should be 1 or 2"; + if (ind < 1) Throw() <<"ind (for an xgrid side mesh) should be >=1."; + + // Get data fields corresponding to side + MEField<> *mesh_ind_field = NULL; + MEField<> *orig_elem_id_field = NULL; + if (side == 1) { + mesh_ind_field = dstXGridMesh.GetField("side1_mesh_ind"); + orig_elem_id_field = dstXGridMesh.GetField("side1_orig_elem_id"); + } else if (side ==2) { + mesh_ind_field = dstXGridMesh.GetField("side2_mesh_ind"); + orig_elem_id_field = dstXGridMesh.GetField("side2_orig_elem_id"); + } else { + Throw() << "Invalid mesh side: "< id_to_sr_map; + + // Iterate through dst XGrid Mesh + Mesh::iterator dxei = dstXGridMesh.elem_begin(), dxee = dstXGridMesh.elem_end(); + for (; dxei != dxee; ++dxei) { + MeshObj &dst_elem = *dxei; -} + // Skip non-local elements + if (!GetAttr(dst_elem).is_locally_owned()) continue; + + // Get XGrid element ind + // (Round to nearest to take care of possible representation issues) + double *elem_mesh_ind_dbl = mesh_ind_field->data(dst_elem); + int elem_mesh_ind = (int)(*elem_mesh_ind_dbl + 0.5); + + // if the ind matches, then attempt to add entry + if (elem_mesh_ind == ind) { + + // Get orig elem id + // (Round to nearest to take care of possible representation issues) + double *src_orig_elem_id_dbl = orig_elem_id_field->data(dst_elem); + int src_orig_elem_id = (int)(*src_orig_elem_id_dbl+0.5); + + // If the orig dst id is in the side mesh, then add it + Mesh::MeshObjIDMap::iterator mi = srcMesh.map_find(MeshObj::ELEMENT, src_orig_elem_id); + if (mi != srcMesh.map_end(MeshObj::ELEMENT)) { + MeshObj *src_elem=&*mi; + + // Find search result to add to + std::map::iterator itsr=id_to_sr_map.find(src_elem->get_id()); + + // Get search result based on whether it was found + Search_result *sr; + if (itsr == id_to_sr_map.end()) { + // Create new Search_result + sr=new Search_result(); + sr->elem=src_elem; // Add src elem + + // Add to map + id_to_sr_map[src_elem->get_id()]=sr; + + // Add to result + result.push_back(sr); + + } else { + // Get from map + sr=itsr->second; + } + + // Add dst element to search result + sr->elems.push_back(&dst_elem); + + } + } + } + + } From 92d13eb1526daa5d64e741d2559929c1188583f9 Mon Sep 17 00:00:00 2001 From: Robert Oehmke Date: Tue, 13 Aug 2024 17:27:05 -0600 Subject: [PATCH 006/207] Correctly set side Mesh side number when using XGrid version of ESMF_FieldRegridStore(). --- src/Infrastructure/Field/src/ESMF_FieldRegrid.F90 | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/src/Infrastructure/Field/src/ESMF_FieldRegrid.F90 b/src/Infrastructure/Field/src/ESMF_FieldRegrid.F90 index 68eb2f5e21..343c385647 100644 --- a/src/Infrastructure/Field/src/ESMF_FieldRegrid.F90 +++ b/src/Infrastructure/Field/src/ESMF_FieldRegrid.F90 @@ -4006,8 +4006,8 @@ subroutine ESMF_FieldRegridStoreX(xgrid, srcField, dstField, keywordEnforcer, & ESMF_CONTEXT, rcToReturn=rc)) return else sideField=srcField - sideMeshSide=0 - if (srcSide == ESMF_XGRIDSIDE_B) sideMeshSide=1 + sideMeshSide=1 ! side A + if (srcSide == ESMF_XGRIDSIDE_B) sideMeshSide=2 ! side B sideMeshInd=srcIdx endif @@ -4034,8 +4034,8 @@ subroutine ESMF_FieldRegridStoreX(xgrid, srcField, dstField, keywordEnforcer, & ESMF_CONTEXT, rcToReturn=rc)) return else sideField=dstField - sideMeshSide=0 - if (dstSide == ESMF_XGRIDSIDE_B) sideMeshSide=1 + sideMeshSide=1 ! side A + if (dstSide == ESMF_XGRIDSIDE_B) sideMeshSide=2 ! side B sideMeshInd=dstIdx endif From 8b07f65a415da7e0a732d30572c71f52aa73d54c Mon Sep 17 00:00:00 2001 From: Robert Oehmke Date: Wed, 14 Aug 2024 16:50:08 -0600 Subject: [PATCH 007/207] Add flag to 2nd order calc indicating that an xgrid is being used and if src or dst. --- .../Regridding/ESMCI_Conserve2ndInterp.h | 7 +++- .../src/Regridding/ESMCI_Conserve2ndInterp.C | 7 +++- .../Mesh/src/Regridding/ESMCI_Interp.C | 42 ++++++++++++++----- 3 files changed, 41 insertions(+), 15 deletions(-) diff --git a/src/Infrastructure/Mesh/include/Regridding/ESMCI_Conserve2ndInterp.h b/src/Infrastructure/Mesh/include/Regridding/ESMCI_Conserve2ndInterp.h index 8976903683..5c2c8fed1e 100644 --- a/src/Infrastructure/Mesh/include/Regridding/ESMCI_Conserve2ndInterp.h +++ b/src/Infrastructure/Mesh/include/Regridding/ESMCI_Conserve2ndInterp.h @@ -52,8 +52,11 @@ namespace ESMCI { } SM_CELL; #endif + enum XGRID_USE {XGRID_USE_NONE, XGRID_USE_SRC, XGRID_USE_DST}; + + void calc_2nd_order_weights_2D_3D_sph(const MeshObj *src_elem, MEField<> *src_cfield, MEField<> *src_mask_field, - std::vector dst_elems, MEField<> *dst_cfield, MEField<> * dst_mask_field, MEField<> * dst_frac2_field, + std::vector dst_elems, MEField<> *dst_cfield, MEField<> * dst_mask_field, MEField<> * dst_frac2_field, XGRID_USE xgrid_use, double *src_elem_area, std::vector *valid, std::vector *wgts, @@ -64,7 +67,7 @@ namespace ESMCI { ); void calc_2nd_order_weights_2D_2D_cart(const MeshObj *src_elem, MEField<> *src_cfield, MEField<> *src_mask_field, - std::vector dst_elems, MEField<> *dst_cfield, MEField<> * dst_mask_field, MEField<> * dst_frac2_field, + std::vector dst_elems, MEField<> *dst_cfield, MEField<> * dst_mask_field, MEField<> * dst_frac2_field, XGRID_USE xgrid_use, double *src_elem_area, std::vector *valid, std::vector *wgts, diff --git a/src/Infrastructure/Mesh/src/Regridding/ESMCI_Conserve2ndInterp.C b/src/Infrastructure/Mesh/src/Regridding/ESMCI_Conserve2ndInterp.C index 79866c6623..e79f0d5a12 100644 --- a/src/Infrastructure/Mesh/src/Regridding/ESMCI_Conserve2ndInterp.C +++ b/src/Infrastructure/Mesh/src/Regridding/ESMCI_Conserve2ndInterp.C @@ -497,7 +497,7 @@ namespace ESMCI { // Main Call void calc_2nd_order_weights_2D_2D_cart(const MeshObj *src_elem, MEField<> *src_cfield, MEField<> *src_mask_field, - std::vector dst_elems, MEField<> *dst_cfield, MEField<> * dst_mask_field, MEField<> * dst_frac2_field, + std::vector dst_elems, MEField<> *dst_cfield, MEField<> * dst_mask_field, MEField<> * dst_frac2_field, XGRID_USE xgrid_use, double *src_elem_area, std::vector *valid, std::vector *wgts, @@ -1236,7 +1236,7 @@ namespace ESMCI { // Main Call void calc_2nd_order_weights_2D_3D_sph(const MeshObj *src_elem, MEField<> *src_cfield, MEField<> *src_mask_field, - std::vector dst_elems, MEField<> *dst_cfield, MEField<> * dst_mask_field, MEField<> * dst_frac2_field, + std::vector dst_elems, MEField<> *dst_cfield, MEField<> * dst_mask_field, MEField<> * dst_frac2_field, XGRID_USE xgrid_use, double *src_elem_area, std::vector *valid, std::vector *wgts, @@ -1245,6 +1245,9 @@ namespace ESMCI { std::vector *sm_cells, std::vector *nbrs ) { + + printf("xgrid_use=%d\n",xgrid_use); + // Create super mesh cells by intersecting src_elem and list of dst_elems create_SM_cells_2D_3D_sph(src_elem, src_cfield, dst_elems, dst_cfield, dst_mask_field, dst_frac2_field, diff --git a/src/Infrastructure/Mesh/src/Regridding/ESMCI_Interp.C b/src/Infrastructure/Mesh/src/Regridding/ESMCI_Interp.C index b6f31e362b..1af27f9302 100644 --- a/src/Infrastructure/Mesh/src/Regridding/ESMCI_Interp.C +++ b/src/Infrastructure/Mesh/src/Regridding/ESMCI_Interp.C @@ -767,13 +767,18 @@ void calc_2nd_order_conserve_mat_serial_2D_3D_sph(Mesh &srcmesh, Mesh &dstmesh, struct Zoltan_Struct * zz, bool set_dst_status, WMat &dst_status) { Trace __trace("calc_conserve_mat_serial(Mesh &srcmesh, Mesh &dstmesh, SearchResult &sres, IWeights &iw)"); - // See if we're doing an XGrid - bool xgrid_regrid=false; - if ((srcmesh.side==3) || (dstmesh.side==3)) { - xgrid_regrid=true; - - printf("src side=%d src ind=%d\n",srcmesh.side,srcmesh.ind); - printf("dst side=%d dst ind=%d\n",dstmesh.side,dstmesh.ind); + // See if we're using an XGrid + XGRID_USE xgrid_use=XGRID_USE_NONE; + if (srcmesh.side==3) { + // Extra check to ensure that it's actually a side mesh going to XGrid + if ((dstmesh.side == 1) || (dstmesh.side == 2)) { + xgrid_use=XGRID_USE_SRC; + } + } else if (dstmesh.side==3) { + // Extra check to ensure that it's actually a side mesh going to XGrid + if ((srcmesh.side == 1) || (srcmesh.side == 2)) { + xgrid_use=XGRID_USE_DST; + } } @@ -891,9 +896,10 @@ void calc_2nd_order_conserve_mat_serial_2D_3D_sph(Mesh &srcmesh, Mesh &dstmesh, // Calculate weights calc_2nd_order_weights_2D_3D_sph(sr.elem,src_cfield,src_mask_field, - sr.elems,dst_cfield,dst_mask_field, dst_frac2_field, - &src_elem_area, &valid, &wgts, &areas, &dst_areas, - &tmp_valid, &tmp_areas, &tmp_dst_areas, &sm_cells, &nbrs); + sr.elems,dst_cfield,dst_mask_field, dst_frac2_field, + xgrid_use, + &src_elem_area, &valid, &wgts, &areas, &dst_areas, + &tmp_valid, &tmp_areas, &tmp_dst_areas, &sm_cells, &nbrs); // Invalidate masked destination elements @@ -1095,6 +1101,20 @@ void calc_2nd_order_conserve_mat_serial_2D_2D_cart(Mesh &srcmesh, Mesh &dstmesh, struct Zoltan_Struct * zz, bool set_dst_status, WMat &dst_status) { Trace __trace("calc_conserve_mat_serial(Mesh &srcmesh, Mesh &dstmesh, SearchResult &sres, IWeights &iw)"); + // See if we're using an XGrid + XGRID_USE xgrid_use=XGRID_USE_NONE; + if (srcmesh.side==3) { + // Extra check to ensure that it's actually a side mesh going to XGrid + if ((dstmesh.side == 1) || (dstmesh.side == 2)) { + xgrid_use=XGRID_USE_SRC; + } + } else if (dstmesh.side==3) { + // Extra check to ensure that it's actually a side mesh going to XGrid + if ((srcmesh.side == 1) || (srcmesh.side == 2)) { + xgrid_use=XGRID_USE_DST; + } + } + // Get src coord field MEField<> *src_cfield = srcmesh.GetCoordField(); @@ -1209,7 +1229,7 @@ void calc_2nd_order_conserve_mat_serial_2D_2D_cart(Mesh &srcmesh, Mesh &dstmesh, // Calculate weights calc_2nd_order_weights_2D_2D_cart(sr.elem,src_cfield,src_mask_field, - sr.elems,dst_cfield,dst_mask_field, dst_frac2_field, + sr.elems,dst_cfield,dst_mask_field, dst_frac2_field, xgrid_use, &src_elem_area, &valid, &wgts, &areas, &dst_areas, &tmp_valid, &tmp_areas, &tmp_dst_areas, &sm_cells, &nbrs); From 3af40d851b7fb6a90d59653234861d15f2d62c76 Mon Sep 17 00:00:00 2001 From: Ufuk Turuncoglu Date: Mon, 19 Aug 2024 10:10:49 -0500 Subject: [PATCH 008/207] add nested state support --- src/addon/NUOPC/src/NUOPC_Connector.F90 | 47 +++++++++++++++++++++++++ 1 file changed, 47 insertions(+) diff --git a/src/addon/NUOPC/src/NUOPC_Connector.F90 b/src/addon/NUOPC/src/NUOPC_Connector.F90 index 30f687690e..2ad1c28c2a 100644 --- a/src/addon/NUOPC/src/NUOPC_Connector.F90 +++ b/src/addon/NUOPC/src/NUOPC_Connector.F90 @@ -440,6 +440,7 @@ subroutine InitializeIPDv05p1(connector, importState, exportState, clock, rc) integer :: i, j character(ESMF_MAXSTR) :: importCplSet, exportCplSet character(len=240) :: msgString + character(ESMF_MAXSTR) :: importProvider, exportProvider rc = ESMF_SUCCESS @@ -611,6 +612,29 @@ subroutine InitializeIPDv05p1(connector, importState, exportState, clock, rc) call doMirror(importState, exportState, acceptorVM=vm, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, file=trim(name)//":"//FILENAME)) return ! bail out + elseif (trim(exportXferPolicy)=="transferAllNested") then + ! check name of provider component + call NUOPC_GetAttribute(importState, name="CompName", & + value=importProvider, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=trim(name)//":"//FILENAME)) return ! bail out + ! create nested state + exportNestedState = ESMF_StateCreate(name=trim(importProvider)//"-NestedState", rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=trim(name)//":"//FILENAME)) return ! bail out + ! set FieldTransferPolicy metadata for nested state + call NUOPC_SetAttribute(exportNestedState, "FieldTransferPolicy", "transferAll", rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=trim(name)//":"//FILENAME)) return ! bail out + ! define namespace and nested state + call NUOPC_AddNamespace(exportState, namespace=trim(importProvider), & + nestedState=exportNestedState, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=trim(name)//":"//FILENAME)) return ! bail out + ! top level mirroring into exportState + call doMirror(importState, exportNestedState, acceptorVM=vm, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=trim(name)//":"//FILENAME)) return ! bail out elseif (importHasNested .and. exportHasNested) then ! loop through the nested states inside of the exportState and see if ! any of them request mirroring @@ -686,6 +710,29 @@ subroutine InitializeIPDv05p1(connector, importState, exportState, clock, rc) call doMirror(exportState, importState, acceptorVM=vm, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, file=trim(name)//":"//FILENAME)) return ! bail out + elseif (trim(importXferPolicy)=="transferAllNested") then + ! check name of provider component + call NUOPC_GetAttribute(exportState, name="CompName", & + value=exportProvider, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=trim(name)//":"//FILENAME)) return ! bail out + ! create nested state + importNestedState = ESMF_StateCreate(name=trim(exportProvider)//"-NestedState", rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=trim(name)//":"//FILENAME)) return ! bail out + ! set FieldTransferPolicy metadata for nested state + call NUOPC_SetAttribute(importNestedState, "FieldTransferPolicy", "transferAll", rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=trim(name)//":"//FILENAME)) return ! bail out + ! define namespace and nested state + call NUOPC_AddNamespace(importState, namespace=trim(exportProvider), & + nestedState=importNestedState, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=trim(name)//":"//FILENAME)) return ! bail out + ! top level mirroring into exportState + call doMirror(exportState, importNestedState, acceptorVM=vm, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=trim(name)//":"//FILENAME)) return ! bail out elseif (importHasNested .and. exportHasNested) then ! loop through the nested states inside of the importState and see if ! any of them request mirroring From ac01fa36cab813ddcca8f072b6ac916464af6500 Mon Sep 17 00:00:00 2001 From: Ufuk Turuncoglu Date: Wed, 21 Aug 2024 12:31:43 -0500 Subject: [PATCH 009/207] change the new attribute name based on discussion --- src/addon/NUOPC/src/NUOPC_Connector.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/addon/NUOPC/src/NUOPC_Connector.F90 b/src/addon/NUOPC/src/NUOPC_Connector.F90 index 2ad1c28c2a..ef7c59d2e0 100644 --- a/src/addon/NUOPC/src/NUOPC_Connector.F90 +++ b/src/addon/NUOPC/src/NUOPC_Connector.F90 @@ -612,7 +612,7 @@ subroutine InitializeIPDv05p1(connector, importState, exportState, clock, rc) call doMirror(importState, exportState, acceptorVM=vm, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, file=trim(name)//":"//FILENAME)) return ! bail out - elseif (trim(exportXferPolicy)=="transferAllNested") then + elseif (trim(exportXferPolicy)=="transferAllAsNests") then ! check name of provider component call NUOPC_GetAttribute(importState, name="CompName", & value=importProvider, rc=rc) @@ -710,7 +710,7 @@ subroutine InitializeIPDv05p1(connector, importState, exportState, clock, rc) call doMirror(exportState, importState, acceptorVM=vm, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, file=trim(name)//":"//FILENAME)) return ! bail out - elseif (trim(importXferPolicy)=="transferAllNested") then + elseif (trim(importXferPolicy)=="transferAllAsNests") then ! check name of provider component call NUOPC_GetAttribute(exportState, name="CompName", & value=exportProvider, rc=rc) From 3f654bc453b0dcf532ac330fa9edfd1bd1caa05a Mon Sep 17 00:00:00 2001 From: Gerhard Theurich Date: Thu, 12 Sep 2024 16:30:56 -0700 Subject: [PATCH 010/207] Implement the `link_options` application option. --- src/addon/ESMX/Driver/CMakeLists.txt | 5 +++++ src/addon/ESMX/Driver/esmx_app_config.py | 1 + src/addon/ESMX/README.md | 3 ++- 3 files changed, 8 insertions(+), 1 deletion(-) diff --git a/src/addon/ESMX/Driver/CMakeLists.txt b/src/addon/ESMX/Driver/CMakeLists.txt index 8998b7f8bd..9bda54e302 100644 --- a/src/addon/ESMX/Driver/CMakeLists.txt +++ b/src/addon/ESMX/Driver/CMakeLists.txt @@ -157,6 +157,11 @@ foreach(ESMX_LINK_LIBRARY IN ITEMS ${ESMX_LINK_LIBRARIES}) endif() endforeach() +# link options +if(DEFINED ESMX_LINK_OPTIONS) + target_link_options(esmx_driver PUBLIC ${ESMX_LINK_OPTIONS}) +endif() + # add components set(CMP_OPTIONS BUILD_TYPE; SOURCE_DIR; diff --git a/src/addon/ESMX/Driver/esmx_app_config.py b/src/addon/ESMX/Driver/esmx_app_config.py index 4fea190d99..2e41a8075c 100755 --- a/src/addon/ESMX/Driver/esmx_app_config.py +++ b/src/addon/ESMX/Driver/esmx_app_config.py @@ -28,6 +28,7 @@ def create_appConf(appCfg: ESMXAppCfg, odir): ESMXOpt('disable_comps', None, str), ESMXOpt('link_paths', None, dir), ESMXOpt('link_libraries', None, str), + ESMXOpt('link_options', None, str), ESMXOpt('build_args', None, str), ESMXOpt('build_jobs', None, str), ESMXOpt('build_verbose', None, str), diff --git a/src/addon/ESMX/README.md b/src/addon/ESMX/README.md index 4e879c5016..a5575da7e7 100644 --- a/src/addon/ESMX/README.md +++ b/src/addon/ESMX/README.md @@ -126,9 +126,10 @@ These options affect the ESMX application layer. If no key/value pair is provide | `exe_name` | executable name for application | `esmx_app` | | `disable_comps` | scalar or list of components to disable | *None* | | `link_module_paths` | scalar or list of search paths for CMake modules | *None* | +| `link_libraries` | scalar or list of external libraries, linked to esmx | *None* | +| `link_options` | scalar or list of options used during linking of esmx | *None* | | `link_packages` | scalar or list of cmake packages, use link_libraries to link to esmx | *None* | | `link_paths` | scalar or list of search path for external libraries | *None* | -| `link_libraries` | scalar or list of external libraries, linked to esmx | *None* | | `build_args` | scalar or list of arguments passed to all build_types | *None* | | `build_jobs` | job number used for all build_types | *None* | | `build_verbose` | verbosity setting used for all build_types | *None* | From aa7060ab1ccf05faf93bbbc1841341e0eae5d71f Mon Sep 17 00:00:00 2001 From: Robert Oehmke Date: Mon, 16 Sep 2024 14:19:43 -0600 Subject: [PATCH 011/207] Bump versioning into the 8.8.0 beta snapshot phase. --- .github/workflows/api-change.yml | 2 +- README.md | 2 +- src/Infrastructure/Util/include/ESMC_Macros.h | 4 ++-- src/Infrastructure/Util/src/ESMF_UtilTypes.F90 | 4 ++-- src/addon/NUOPC/doc/NUOPC_howtodoc.ctex | 2 +- src/addon/NUOPC/doc/NUOPC_refdoc.ctex | 2 +- src/addon/esmpy/pyproject.toml | 2 +- src/doc/ESMC_crefdoc.ctex | 2 +- src/doc/ESMF_refdoc.ctex | 2 +- src/doc/ESMF_usrdoc.ctex | 2 +- 10 files changed, 12 insertions(+), 12 deletions(-) diff --git a/.github/workflows/api-change.yml b/.github/workflows/api-change.yml index 50c0111023..f051071682 100644 --- a/.github/workflows/api-change.yml +++ b/.github/workflows/api-change.yml @@ -6,7 +6,7 @@ on: tag1: description: 'First ESMF Tag' required: true - default: 'v8.6.0' + default: 'v8.7.0' tag2: description: 'Second ESMF Tag' required: true diff --git a/README.md b/README.md index 499f50e5fd..eb7f420bea 100644 --- a/README.md +++ b/README.md @@ -34,7 +34,7 @@ Pre-built binaries for ESMF and ESMPy are available through a number of channels ``` docker run -it --rm esmf/esmf-build-release:latest ``` - Replace `latest` in the above command with a valid version, like `8.6.0`, in order to access a specific ESMF version. + Replace `latest` in the above command with a valid version, like `8.8.0`, in order to access a specific ESMF version. * [Anaconda Conda-Forge](https://anaconda.org/conda-forge/): Under [conda-forge/esmpy](https://anaconda.org/conda-forge/esmpy). To install locally (_note Windows is not supported_), run: ``` diff --git a/src/Infrastructure/Util/include/ESMC_Macros.h b/src/Infrastructure/Util/include/ESMC_Macros.h index 37d5dfd600..6c1eac73e2 100644 --- a/src/Infrastructure/Util/include/ESMC_Macros.h +++ b/src/Infrastructure/Util/include/ESMC_Macros.h @@ -51,13 +51,13 @@ #define ESMF_VERSION_MAJOR 8 -#define ESMF_VERSION_MINOR 7 +#define ESMF_VERSION_MINOR 8 #define ESMF_VERSION_REVISION 0 #define ESMF_VERSION_PATCHLEVEL 0 #define ESMF_VERSION_PUBLIC 'F' #define ESMF_VERSION_BETASNAPSHOT 'T' -#define ESMF_VERSION_STRING "8.7.0 beta snapshot" +#define ESMF_VERSION_STRING "8.8.0 beta snapshot" #endif // ESMC_MACROS_H diff --git a/src/Infrastructure/Util/src/ESMF_UtilTypes.F90 b/src/Infrastructure/Util/src/ESMF_UtilTypes.F90 index be758f0daf..7e64f1cc3b 100644 --- a/src/Infrastructure/Util/src/ESMF_UtilTypes.F90 +++ b/src/Infrastructure/Util/src/ESMF_UtilTypes.F90 @@ -82,13 +82,13 @@ module ESMF_UtilTypesMod !EOPI integer, parameter :: ESMF_VERSION_MAJOR = 8 - integer, parameter :: ESMF_VERSION_MINOR = 7 + integer, parameter :: ESMF_VERSION_MINOR = 8 integer, parameter :: ESMF_VERSION_REVISION = 0 integer, parameter :: ESMF_VERSION_PATCHLEVEL = 0 logical, parameter :: ESMF_VERSION_PUBLIC = .false. logical, parameter :: ESMF_VERSION_BETASNAPSHOT = .true. - character(*), parameter :: ESMF_VERSION_STRING = "8.7.0 beta snapshot" + character(*), parameter :: ESMF_VERSION_STRING = "8.8.0 beta snapshot" #if defined (ESMF_NETCDF) logical, parameter :: ESMF_IO_NETCDF_PRESENT = .true. diff --git a/src/addon/NUOPC/doc/NUOPC_howtodoc.ctex b/src/addon/NUOPC/doc/NUOPC_howtodoc.ctex index 4499ecb7db..85d8425a43 100644 --- a/src/addon/NUOPC/doc/NUOPC_howtodoc.ctex +++ b/src/addon/NUOPC/doc/NUOPC_howtodoc.ctex @@ -17,7 +17,7 @@ \addtolength{\oddsidemargin}{-.75in} \newcommand{\mytitle}{\Large {\bf Building a NUOPC Model}} \newcommand{\myauthors}{\large {\it Content Standards Committee (CSC) Members}} -\newcommand{\myversion}{ESMF 8.7.0 beta snapshot} +\newcommand{\myversion}{ESMF 8.8.0 beta snapshot} % set a standard paragraph style \setlength{\parskip}{0pt} \setlength{\parindent}{0pt} diff --git a/src/addon/NUOPC/doc/NUOPC_refdoc.ctex b/src/addon/NUOPC/doc/NUOPC_refdoc.ctex index 92777d849e..69e343ed4a 100644 --- a/src/addon/NUOPC/doc/NUOPC_refdoc.ctex +++ b/src/addon/NUOPC/doc/NUOPC_refdoc.ctex @@ -17,7 +17,7 @@ \addtolength{\oddsidemargin}{-.75in} \newcommand{\mytitle}{\Large {\bf NUOPC Layer Reference}} \newcommand{\myauthors}{\large {\it Content Standards Committee (CSC) Members}} -\newcommand{\myversion}{ESMF 8.7.0 beta snapshot} +\newcommand{\myversion}{ESMF 8.8.0 beta snapshot} % set a standard paragraph style \setlength{\parskip}{0pt} \setlength{\parindent}{0pt} diff --git a/src/addon/esmpy/pyproject.toml b/src/addon/esmpy/pyproject.toml index 3c7c03aa5a..40bc3d1da9 100644 --- a/src/addon/esmpy/pyproject.toml +++ b/src/addon/esmpy/pyproject.toml @@ -33,7 +33,7 @@ enabled = true template = "{tag}" dev_template = "{tag}" dirty_template = "{tag}" -starting_version = "8.7.0beta" # this is a backup for pip <= 22.0 where git-versioning doesn't work +starting_version = "8.8.0beta" # this is a backup for pip <= 22.0 where git-versioning doesn't work [tool.dynamic] version = "placeholder" # this is a placeholder for the version pulled with git-versioning diff --git a/src/doc/ESMC_crefdoc.ctex b/src/doc/ESMC_crefdoc.ctex index 9c9b12f657..f1416366f0 100644 --- a/src/doc/ESMC_crefdoc.ctex +++ b/src/doc/ESMC_crefdoc.ctex @@ -14,7 +14,7 @@ \newcommand{\sreq}[1]{\subsection{\hspace{.2in}#1}} \newcommand{\ssreq}[1]{\subsubsection{\hspace{.2in}#1}} \newcommand{\mytitle}{\longname \docmttype ~~} -\newcommand{\myversion}{Version 8.7.0 beta snapshot} +\newcommand{\myversion}{Version 8.8.0 beta snapshot} \newenvironment {reqlist} diff --git a/src/doc/ESMF_refdoc.ctex b/src/doc/ESMF_refdoc.ctex index 05c693040c..f50f960db5 100644 --- a/src/doc/ESMF_refdoc.ctex +++ b/src/doc/ESMF_refdoc.ctex @@ -15,7 +15,7 @@ \newcommand{\sreq}[1]{\subsection{\hspace{.2in}#1}} \newcommand{\ssreq}[1]{\subsubsection{\hspace{.2in}#1}} \newcommand{\mytitle}{\longname \docmttype ~~} -\newcommand{\myversion}{Version 8.7.0 beta snapshot} +\newcommand{\myversion}{Version 8.8.0 beta snapshot} \input{common_commands} diff --git a/src/doc/ESMF_usrdoc.ctex b/src/doc/ESMF_usrdoc.ctex index 8a10bcc157..74541c66be 100644 --- a/src/doc/ESMF_usrdoc.ctex +++ b/src/doc/ESMF_usrdoc.ctex @@ -14,7 +14,7 @@ \newcommand{\sreq}[1]{\subsection{\hspace{.2in}#1}} \newcommand{\ssreq}[1]{\subsubsection{\hspace{.2in}#1}} \newcommand{\mytitle}{\longname \docmttype ~~} -\newcommand{\myversion}{Version 8.7.0 beta snapshot} +\newcommand{\myversion}{Version 8.8.0 beta snapshot} \newenvironment {reqlist} From 9bc54ab2f3bc9756925b4d7abc8a26477cbf041d Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Tue, 17 Sep 2024 16:47:25 -0600 Subject: [PATCH 012/207] Fix sprintf issues Fixes uses of sprintf where the output string is also used in the input, which can result in garbled time strings. Also changes these sprintf calls to snprintf to avoid possible buffer overflows, and checks these calls to ensure that the output variable is large enough to hold the relevant string, returning an error code if not. Resolves esmf-org/esmf#284 --- .../Mesh/src/Legacy/ESMCI_MeshMerge.C | 10 ++--- .../TimeMgr/include/ESMCI_Time.h | 2 +- .../TimeMgr/include/ESMCI_TimeInterval.h | 2 +- src/Infrastructure/TimeMgr/src/ESMCI_Time.C | 40 +++++++++++++----- .../TimeMgr/src/ESMCI_TimeInterval.C | 41 ++++++++++++++----- .../TimeMgr/tests/ESMF_TimeIntervalUTest.F90 | 27 ++++++++---- .../TimeMgr/tests/ESMF_TimeUTest.F90 | 34 ++++++++++----- 7 files changed, 110 insertions(+), 46 deletions(-) diff --git a/src/Infrastructure/Mesh/src/Legacy/ESMCI_MeshMerge.C b/src/Infrastructure/Mesh/src/Legacy/ESMCI_MeshMerge.C index 4285002832..199dd9fa24 100644 --- a/src/Infrastructure/Mesh/src/Legacy/ESMCI_MeshMerge.C +++ b/src/Infrastructure/Mesh/src/Legacy/ESMCI_MeshMerge.C @@ -1178,12 +1178,12 @@ void concat_meshes(const Mesh & srcmesh, const Mesh & dstmesh, Mesh & mergemesh, for(int npt=0; npt // return in string format (TMG 2.4.7) - int getString(char *timeString, const char *options=0) const; + int getString(char *timeString, int timeStringLen, const char *options=0) const; int getDayOfWeek(int *dayOfWeek) const; // (TMG 2.5.3) int getMidMonth(Time *midMonth) const; diff --git a/src/Infrastructure/TimeMgr/include/ESMCI_TimeInterval.h b/src/Infrastructure/TimeMgr/include/ESMCI_TimeInterval.h index 633c6d4575..ab2186830c 100644 --- a/src/Infrastructure/TimeMgr/include/ESMCI_TimeInterval.h +++ b/src/Infrastructure/TimeMgr/include/ESMCI_TimeInterval.h @@ -245,7 +245,7 @@ class TimeInterval : public BaseTime { // private: // return in string format (TMG 1.5.9) - int getString(char *timeString, const char *options=0) const; + int getString(char *timeString, int timeStringLen, const char *options=0) const; // common method for overloaded comparison operators bool compare(const TimeInterval &, ESMC_ComparisonType) const; diff --git a/src/Infrastructure/TimeMgr/src/ESMCI_Time.C b/src/Infrastructure/TimeMgr/src/ESMCI_Time.C index 78c21bce04..eb3febdd48 100644 --- a/src/Infrastructure/TimeMgr/src/ESMCI_Time.C +++ b/src/Infrastructure/TimeMgr/src/ESMCI_Time.C @@ -545,7 +545,7 @@ namespace ESMCI{ *timeZone = this->timeZone; } if (tempTimeString != ESMC_NULL_POINTER && timeStringLen > 0) { - rc = Time::getString(tempTimeString); + rc = Time::getString(tempTimeString, timeStringLen); if (ESMC_LogDefault.MsgFoundError(rc, ESMCI_ERR_PASSTHRU, ESMC_CONTEXT, &rc)) return(rc); @@ -554,7 +554,7 @@ namespace ESMCI{ } if (tempTimeStringISOFrac != ESMC_NULL_POINTER && timeStringLenISOFrac > 0) { - rc = Time::getString(tempTimeStringISOFrac, "isofrac"); + rc = Time::getString(tempTimeStringISOFrac, timeStringLenISOFrac, "isofrac"); if (ESMC_LogDefault.MsgFoundError(rc, ESMCI_ERR_PASSTHRU, ESMC_CONTEXT, &rc)) return(rc); @@ -1260,7 +1260,7 @@ namespace ESMCI{ if (options != ESMC_NULL_POINTER) { if (strncmp(options, "string", 6) == 0) { char timeString[ESMF_MAXSTR]; - Time::getString(timeString, &options[6]); + Time::getString(timeString, sizeof(timeString)-1, &options[6]); printf("%s\n", timeString); // see also method Time::get() } @@ -1393,9 +1393,9 @@ namespace ESMCI{ // int error return code // // !ARGUMENTS: - char *timeString, const char *options) const { // out - time value in - // string format - // in - format options + char *timeString, // out - time value in string format + int timeStringLen, // in - max number of characters that can be stored in timeString, not including the null terminator + const char *options) const { // in - format options // // !DESCRIPTION: // Gets a {\tt time}'s value in ISO 8601 string format @@ -1451,14 +1451,25 @@ namespace ESMCI{ &rc)) return(rc); + int requiredLen; + // format everything except seconds - sprintf(timeString, "%04lld-%02d-%02dT%02d:%02d:", yy_i8, mm, dd, h, m); + requiredLen = snprintf(timeString, timeStringLen+1, "%04lld-%02d-%02dT%02d:%02d:", yy_i8, mm, dd, h, m); + if (requiredLen > timeStringLen) { + std::stringstream msg; + msg << "timeString too small for result: " << timeStringLen << " < " << requiredLen; + ESMC_LogDefault.MsgFoundError(ESMC_RC_ARG_SIZE, msg, ESMC_CONTEXT, &rc); + return(rc); + } // format seconds according to specified options bool isofrac = false; if (options != ESMC_NULL_POINTER) { if (strstr(options, "isofrac") != ESMC_NULL_POINTER) isofrac = true; } + + char timeStringTemp[timeStringLen+1]; + strncpy(timeStringTemp, timeString, sizeof(timeStringTemp)); if (isofrac) { // strict ISO 8601 format YYYY-MM-DDThh:mm:ss[.f] @@ -1468,20 +1479,27 @@ namespace ESMCI{ // if fractionalSeconds non-zero (>= 0.5 ns) append full fractional value if (fabs(fractionalSeconds) >= 5e-10) { - sprintf(timeString, "%s%012.9f", timeString, (s + fractionalSeconds)); + requiredLen = snprintf(timeString, timeStringLen+1, "%s%012.9f", timeStringTemp, (s + fractionalSeconds)); } else { // no fractional seconds, just append integer seconds - sprintf(timeString, "%s%02d", timeString, s); + requiredLen = snprintf(timeString, timeStringLen+1, "%s%02d", timeStringTemp, s); } } else { // not strict ISO fractional seconds format // hybrid ISO 8601 format YYYY-MM-DDThh:mm:ss[:n/d] // if fractionalSeconds non-zero (sN!=0) append full fractional value if (sN != 0) { - sprintf(timeString, "%s%02d:%lld/%lld", timeString, s, sN, sD); + requiredLen = snprintf(timeString, timeStringLen+1, "%s%02d:%lld/%lld", timeStringTemp, s, sN, sD); } else { // no fractional seconds, just append integer seconds - sprintf(timeString, "%s%02d", timeString, s); + requiredLen = snprintf(timeString, timeStringLen+1, "%s%02d", timeStringTemp, s); } } + if (requiredLen > timeStringLen) + { + std::stringstream msg; + msg << "timeString too small for result: " << timeStringLen << " < " << requiredLen; + ESMC_LogDefault.MsgFoundError(ESMC_RC_ARG_SIZE, msg, ESMC_CONTEXT, &rc); + return (rc); + } return(rc); diff --git a/src/Infrastructure/TimeMgr/src/ESMCI_TimeInterval.C b/src/Infrastructure/TimeMgr/src/ESMCI_TimeInterval.C index 142d2fae09..7d9ea05b0f 100644 --- a/src/Infrastructure/TimeMgr/src/ESMCI_TimeInterval.C +++ b/src/Infrastructure/TimeMgr/src/ESMCI_TimeInterval.C @@ -822,7 +822,7 @@ namespace ESMCI{ // if requested, return time interval in string format if (tempTimeString != ESMC_NULL_POINTER && timeStringLen > 0) { - rc = TimeInterval::getString(tempTimeString); + rc = TimeInterval::getString(tempTimeString, timeStringLen); if (ESMC_LogDefault.MsgFoundError(rc, ESMCI_ERR_PASSTHRU, ESMC_CONTEXT, &rc)) return(rc); @@ -831,7 +831,7 @@ namespace ESMCI{ } if (tempTimeStringISOFrac != ESMC_NULL_POINTER && timeStringLenISOFrac > 0) { - rc = TimeInterval::getString(tempTimeStringISOFrac, "isofrac"); + rc = TimeInterval::getString(tempTimeStringISOFrac, timeStringLenISOFrac, "isofrac"); if (ESMC_LogDefault.MsgFoundError(rc, ESMCI_ERR_PASSTHRU, ESMC_CONTEXT, &rc)) return(rc); @@ -2885,7 +2885,7 @@ namespace ESMCI{ if (options != ESMC_NULL_POINTER) { if (strncmp(options, "string", 6) == 0) { char timeString[160]; - TimeInterval::getString(timeString, &options[6]); + TimeInterval::getString(timeString, sizeof(timeString)-1, &options[6]); printf("%s\n", timeString); // see also method TimeInterval::get() } @@ -3075,9 +3075,9 @@ namespace ESMCI{ // int error return code // // !ARGUMENTS: - char *timeString, const char *options) const { // out - time interval - // value in - // string format + char *timeString, // out - time interval value in string format + int timeStringLen, // in - max number of characters that can be stored in timeString, not including the null terminator + const char *options) const { // in - format options // // !DESCRIPTION: // Gets a {\tt ESMC\_TimeInterval}'s value in ISO 8601 string format @@ -3122,14 +3122,26 @@ namespace ESMCI{ if (ESMC_LogDefault.MsgFoundError(rc, ESMCI_ERR_PASSTHRU, ESMC_CONTEXT, &rc)) return(rc); + int requiredLen; + // format everything except seconds - sprintf(timeString, "P%lldY%lldM%lldDT%dH%dM", yy_i8, mm_i8, d_i8, h, m); + requiredLen = snprintf(timeString, timeStringLen+1, "P%lldY%lldM%lldDT%dH%dM", yy_i8, mm_i8, d_i8, h, m); + if (requiredLen > timeStringLen) + { + std::stringstream msg; + msg << "timeString too small for result: " << timeStringLen << " < " << requiredLen; + ESMC_LogDefault.MsgFoundError(ESMC_RC_ARG_SIZE, msg, ESMC_CONTEXT, &rc); + return (rc); + } // format seconds according to specified options bool isofrac = false; if (options != ESMC_NULL_POINTER) { if (strstr(options, "isofrac") != ESMC_NULL_POINTER) isofrac = true; } + + char timeStringTemp[timeStringLen+1]; + strncpy(timeStringTemp, timeString, sizeof(timeStringTemp)); if (isofrac) { // strict ISO 8601 format PyYmMdDThHmMs[.f]S @@ -3139,20 +3151,27 @@ namespace ESMCI{ // if fractionalSeconds non-zero (>= 0.5 ns) append full fractional value if (fabs(fractionalSeconds) >= 5e-10) { - sprintf(timeString, "%s%.9fS", timeString, (s + fractionalSeconds)); + requiredLen = snprintf(timeString, timeStringLen+1, "%s%.9fS", timeStringTemp, (s + fractionalSeconds)); } else { // no fractional seconds, just append integer seconds - sprintf(timeString, "%s%dS", timeString, s); + requiredLen = snprintf(timeString, timeStringLen+1, "%s%dS", timeStringTemp, s); } } else { // not strict ISO fractional seconds format // hybrid ISO 8601 format PyYmMdDThHmMs[:n/d]S // if fractionalSeconds non-zero (sN!=0) append full fractional value if (sN != 0) { - sprintf(timeString, "%s%d:%lld/%lldS", timeString, s, sN, sD); + requiredLen = snprintf(timeString, timeStringLen+1, "%s%d:%lld/%lldS", timeStringTemp, s, sN, sD); } else { // no fractional seconds, just append integer seconds - sprintf(timeString, "%s%dS", timeString, s); + requiredLen = snprintf(timeString, timeStringLen+1, "%s%dS", timeStringTemp, s); } } + if (requiredLen > timeStringLen) + { + std::stringstream msg; + msg << "timeString too small for result: " << timeStringLen << " < " << requiredLen; + ESMC_LogDefault.MsgFoundError(ESMC_RC_ARG_SIZE, msg, ESMC_CONTEXT, &rc); + return (rc); + } return(rc); diff --git a/src/Infrastructure/TimeMgr/tests/ESMF_TimeIntervalUTest.F90 b/src/Infrastructure/TimeMgr/tests/ESMF_TimeIntervalUTest.F90 index c8ee211fde..ad2669cd28 100644 --- a/src/Infrastructure/TimeMgr/tests/ESMF_TimeIntervalUTest.F90 +++ b/src/Infrastructure/TimeMgr/tests/ESMF_TimeIntervalUTest.F90 @@ -68,7 +68,13 @@ program ESMF_TimeIntervalUTest logical :: bool ! to retrieve time in string format - character(ESMF_MAXSTR) :: timeString + ! + ! note that this string is just barely long enough to hold the result string (to + ! ensure we don't have off-by-one errors in the string building and going back and + ! forth between Fortran and C strings) + character(15) :: timeString15 + ! and this one is just barely too short: + character(14) :: timeString14 ! instantiate timestep, start and stop times type(ESMF_Time) :: time1, time2 @@ -503,12 +509,19 @@ program ESMF_TimeIntervalUTest calendar=gregorianCalendar, rc=rc) call ESMF_TimeIntervalSet(timeStep, d=60, rc=rc) call ESMF_TimeIntervalGet(timeStep, mm=months, startTimeIn=startTime, & - timeString=timeString, rc=rc) - call ESMF_Test((months==2 .and. timeString=="P0Y0M60DT0H0M0S" .and. & + timeString=timeString15, rc=rc) + call ESMF_Test((months==2 .and. timeString15=="P0Y0M60DT0H0M0S" .and. & rc==ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE) !print *, "months = ", months - !print *, "timeStep = ", timeString + !print *, "timeStep = ", timeString15 + + ! ---------------------------------------------------------------------------- + !EX_UTest + write(name, *) "Get TimeInterval Test - too short string" + write(failMsg, *) " Did not return ESMC_RC_ARG_SIZE" + call ESMF_TimeIntervalGet(timeStep, startTimeIn=startTime, timeString=timeString14, rc=rc) + call ESMF_Test((rc==ESMC_RC_ARG_SIZE), name, failMsg, result, ESMF_SRCLINE) ! ---------------------------------------------------------------------------- !EX_UTest @@ -1766,12 +1779,12 @@ program ESMF_TimeIntervalUTest calendar=julianCalendar, rc=rc) call ESMF_TimeIntervalSet(timeStep, d=60, rc=rc) call ESMF_TimeIntervalGet(timeStep, mm=months, startTimeIn=startTime, & - timeString=timeString, rc=rc) - call ESMF_Test((months==2 .and. timeString=="P0Y0M60DT0H0M0S" .and. & + timeString=timeString15, rc=rc) + call ESMF_Test((months==2 .and. timeString15=="P0Y0M60DT0H0M0S" .and. & rc==ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE) !print *, "months = ", months - !print *, "timeStep = ", timeString + !print *, "timeStep = ", timeString15 ! ---------------------------------------------------------------------------- !EX_UTest diff --git a/src/Infrastructure/TimeMgr/tests/ESMF_TimeUTest.F90 b/src/Infrastructure/TimeMgr/tests/ESMF_TimeUTest.F90 index d1a7cb0ca3..1ac112ae6e 100644 --- a/src/Infrastructure/TimeMgr/tests/ESMF_TimeUTest.F90 +++ b/src/Infrastructure/TimeMgr/tests/ESMF_TimeUTest.F90 @@ -53,7 +53,14 @@ program ESMF_TimeUTest character(ESMF_MAXSTR) :: failMsg ! to retrieve time in string format - character(ESMF_MAXSTR) :: timeString + ! + ! note that these strings are just barely long enough to hold the result string (to + ! ensure we don't have off-by-one errors in the string building and going back and + ! forth between Fortran and C strings) + character(19) :: timeString19 + character(20) :: timeString20 + ! and this one is just barely too short: + character(18) :: timeString18 ! instantiate start time type(ESMF_Time) :: startTime @@ -131,14 +138,21 @@ program ESMF_TimeUTest write(name, *) "Get Time Test 1" write(failMsg, *) " Did not return 2004-01-29T12:17:58 or ESMF_SUCCESS" call ESMF_TimeGet(startTime, yy=YY, mm=MM, dd=DD, h=H, m=M, s=S, & - timeString=timeString, rc=rc) + timeString=timeString19, rc=rc) call ESMF_Test((YY==2004 .and. MM==1 .and. DD==29 .and. & H==12 .and. M==17 .and. S==58 .and. & - timeString=="2004-01-29T12:17:58" .and. & + timeString19=="2004-01-29T12:17:58" .and. & rc==ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE) - !print *, "startTime = ", timeString + !print *, "startTime = ", timeString19 + ! ---------------------------------------------------------------------------- + !NEX_UTest + + write(name, *) "Get Time Test - too short string" + write(failMsg, *) " Did not return ESMC_RC_ARG_SIZE" + call ESMF_TimeGet(startTime, timeString=timeString18, rc=rc) + call ESMF_Test((rc==ESMC_RC_ARG_SIZE), name, failMsg, result, ESMF_SRCLINE) #ifdef ESMF_TESTEXHAUSTIVE @@ -227,12 +241,12 @@ program ESMF_TimeUTest call ESMF_TimeSet(time1, yy=9, mm=2, dd=7, & calendar=gregorianCalendar, rc=rc) call ESMF_TimeGet(time1, yy=YY, mm=MM, dd=DD, & - timeString=timeString, rc=rc) + timeString=timeString19, rc=rc) call ESMF_Test((YY==9 .and. MM==2 .and. DD==7 .and. & - timeString=="0009-02-07T00:00:00" .and. & + timeString19=="0009-02-07T00:00:00" .and. & rc==ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE) - !print *, "time1 = ", timeString + !print *, "time1 = ", timeString19 ! ---------------------------------------------------------------------------- !EX_UTest @@ -243,12 +257,12 @@ program ESMF_TimeUTest call ESMF_TimeSet(time1, yy=10000, mm=2, dd=7, & calendar=gregorianCalendar, rc=rc) call ESMF_TimeGet(time1, yy=YY, mm=MM, dd=DD, & - timeString=timeString, rc=rc) + timeString=timeString20, rc=rc) call ESMF_Test((YY==10000 .and. MM==2 .and. DD==7 .and. & - timeString=="10000-02-07T00:00:00" .and. & + timeString20=="10000-02-07T00:00:00" .and. & rc==ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE) - !print *, "time1 = ", timeString + !print *, "time1 = ", timeString20 ! ---------------------------------------------------------------------------- !EX_UTest From cef85deffbd998cf6c045dff0ffc1b477143dad5 Mon Sep 17 00:00:00 2001 From: Daniel Rosen Date: Wed, 18 Sep 2024 15:06:10 -0600 Subject: [PATCH 013/207] Roll back OpenMPI version for dev tests (#299) --- .github/workflows/development-tests.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.github/workflows/development-tests.yml b/.github/workflows/development-tests.yml index 02fea01041..fb093f44f3 100644 --- a/.github/workflows/development-tests.yml +++ b/.github/workflows/development-tests.yml @@ -146,7 +146,7 @@ jobs: if: matrix.config.comm == 'openmpi' run: | if [[ "$CACHE_HIT" != 'true' ]]; then - OPENMPI_URL="https://download.open-mpi.org/release/open-mpi/v5.0/openmpi-5.0.5.tar.gz" + OPENMPI_URL="https://download.open-mpi.org/release/open-mpi/v4.1/openmpi-4.1.6.tar.gz" mkdir ${{runner.temp}}/openmpi cd ${{runner.temp}}/openmpi curl -L $OPENMPI_URL | tar --strip-components=1 -xz From e84ae5b02edfbe62be9dd9ce6b9db48c5c4dbf6f Mon Sep 17 00:00:00 2001 From: Daniel Rosen Date: Sun, 22 Sep 2024 18:21:07 -0600 Subject: [PATCH 014/207] Fixes #288 ESMF_ArrayCreateGetUTest (#289) * fill array with random number 0 - 1000 * fail if every element in array matches --- .../Array/tests/ESMF_ArrayCreateGetUTest.F90 | 11 ++++++++--- 1 file changed, 8 insertions(+), 3 deletions(-) diff --git a/src/Infrastructure/Array/tests/ESMF_ArrayCreateGetUTest.F90 b/src/Infrastructure/Array/tests/ESMF_ArrayCreateGetUTest.F90 index c8a3151485..b64ecd47ea 100644 --- a/src/Infrastructure/Array/tests/ESMF_ArrayCreateGetUTest.F90 +++ b/src/Infrastructure/Array/tests/ESMF_ArrayCreateGetUTest.F90 @@ -369,7 +369,12 @@ program ESMF_ArrayCreateGetUTest !NEX_UTest_Multi_Proc_Only write(name, *) "ArrayCreate from Copy (ALLOC), 2D ESMF_TYPEKIND_R8 Test" write(failMsg, *) "Did not return ESMF_SUCCESS" - farrayPtr2D = real(localPet+10, ESMF_KIND_R8) ! fill with data to check + ! In most circumstances it is best to avoid using random_number in unit tests. + ! In this case farrayPtr2D will be compared to an uninitialized array, which + ! is already effectively random. Filling farrayPtr2D with random numbers + ! reduces the chance of a value collision to near zero. + call random_number(farrayPtr2D) ! fill with data to check + farrayPtr2D = farrayPtr2D * 1000.0_ESMF_KIND_R8 arrayDup = ESMF_ArrayCreate(array, datacopyflag=ESMF_DATACOPY_ALLOC, rc=rc) call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE) @@ -398,14 +403,14 @@ program ESMF_ArrayCreateGetUTest !NEX_UTest_Multi_Proc_Only write(name, *) "Verify Array vs Array Copy (ALLOC) no data copy" write(failMsg, *) "Unexpected data copy" - dataCorrect = .true. + dataCorrect = .false. do j=lbound(farrayPtr2D,2), ubound(farrayPtr2D,2) do i=lbound(farrayPtr2D,1), ubound(farrayPtr2D,1) write (msg,*) "farrayPtr2D(",i,",",j,")=", farrayPtr2D(i,j), & " farrayPtr2DCpy(",i,",",j,")=", farrayPtr2DCpy(i,j) call ESMF_LogWrite(msg, ESMF_LOGMSG_INFO, rc=rc) if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT) - if (abs(farrayPtr2D(i,j)-farrayPtr2DCpy(i,j)) < 1.d-10) dataCorrect=.false. + if (abs(farrayPtr2D(i,j)-farrayPtr2DCpy(i,j)) >= 1.d-10) dataCorrect=.true. enddo enddo call ESMF_Test((dataCorrect), name, failMsg, result, ESMF_SRCLINE) From 6959a592bde8b0ceba2ac022fcda454688635092 Mon Sep 17 00:00:00 2001 From: Gerhard Theurich Date: Mon, 23 Sep 2024 15:42:16 -0600 Subject: [PATCH 015/207] Add `logSystem` driver option. --- src/addon/ESMX/Driver/ESMX_Driver.F90 | 24 +++++++++++++++++++++++- 1 file changed, 23 insertions(+), 1 deletion(-) diff --git a/src/addon/ESMX/Driver/ESMX_Driver.F90 b/src/addon/ESMX/Driver/ESMX_Driver.F90 index eac2465c5f..bbf197e8d3 100644 --- a/src/addon/ESMX/Driver/ESMX_Driver.F90 +++ b/src/addon/ESMX/Driver/ESMX_Driver.F90 @@ -150,7 +150,8 @@ subroutine SetModelServices(driver, rc) isFlag = ESMF_HConfigValidateMapKeys(hconfigNode, & vocabulary=["attributes ", & ! ESMX_Driver option "componentList", & ! ESMX_Driver option - "runSequence " & ! ESMX_Driver option + "runSequence ", & ! ESMX_Driver option + "logSystem " & ! ESMX_Driver option ], badKey=string1, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, file=FILENAME)) & @@ -161,6 +162,27 @@ subroutine SetModelServices(driver, rc) line=__LINE__, file=FILENAME, rcToReturn=rc) call ESMF_Finalize(endflag=ESMF_END_ABORT) endif + ! Ingest logSystem logical + isFlag = ESMF_HConfigIsDefined(hconfigNode, keyString="logSystem", & + rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=FILENAME)) return ! bail out + isFlag = isFlag .and. & + .not.ESMF_HConfigIsNull(hconfigNode, keyString="logSystem", rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=FILENAME)) return ! bail out + if (isFlag) then + isFlag = ESMF_HConfigAsLogical(hconfigNode, keyString="logSystem", & + rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=FILENAME)) return ! bail out + if (isFLag) then + call ESMF_VMLogSystem(prefix="ESMX_Driver: ", rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=FILENAME)) return ! bail out + endif + endif + ! Ingest the generic component label list isFlag = ESMF_HConfigIsDefined(hconfigNode, keyString="componentList", & rc=rc) From 95349b69ca36a82b38ec959c207eb480644b0a52 Mon Sep 17 00:00:00 2001 From: Gerhard Theurich Date: Mon, 23 Sep 2024 15:42:49 -0600 Subject: [PATCH 016/207] Turn on `profiling` in StateReconcile for performance work. --- .../StateReconcile/src/ESMF_StateReconcile.F90 | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/src/Superstructure/StateReconcile/src/ESMF_StateReconcile.F90 b/src/Superstructure/StateReconcile/src/ESMF_StateReconcile.F90 index bf0d1e7091..969f4a8355 100644 --- a/src/Superstructure/StateReconcile/src/ESMF_StateReconcile.F90 +++ b/src/Superstructure/StateReconcile/src/ESMF_StateReconcile.F90 @@ -176,7 +176,7 @@ subroutine ESMF_StateReconcile(state, vm, rc) type(ESMF_InfoDescribe) :: idesc - logical, parameter :: profile = .false. + logical, parameter :: profile = .true. ! check input variables ESMF_INIT_CHECK_DEEP(ESMF_StateGetInit,state,rc) @@ -321,7 +321,7 @@ subroutine ESMF_StateReconcile_driver (state, vm, attreconflag, rc) logical, parameter :: debug = .false. logical, parameter :: meminfo = .false. logical, parameter :: trace = .false. - logical, parameter :: profile = .false. + logical, parameter :: profile = .true. character(160) :: prefixStr type(ESMF_VMId), allocatable, target :: vmIdMap(:) @@ -1587,7 +1587,7 @@ subroutine ESMF_ReconcileExchgAttributes (state, vm, rc) type(ESMF_Info) :: base_info, base_temp_info logical, parameter :: debug = .false. - logical, parameter :: profile = .false. + logical, parameter :: profile = .true. rc = ESMF_RC_NOT_IMPL @@ -2139,7 +2139,7 @@ subroutine ESMF_ReconcileExchgItems (vm, id_info, recv_items, recv_buffer, rc) logical, parameter :: debug = .false. logical, parameter :: meminfo = .false. - logical, parameter :: profile = .false. + logical, parameter :: profile = .true. character(len=ESMF_MAXSTR) :: logmsg @@ -2383,7 +2383,7 @@ subroutine ESMF_ReconcileExchgNeeds (vm, id_info, recv_needs, rc) character(ESMF_MAXSTR) :: msgstring logical, parameter :: debug = .false. - logical, parameter :: profile = .false. + logical, parameter :: profile = .true. localrc = ESMF_RC_NOT_IMPL @@ -2723,7 +2723,7 @@ subroutine ESMF_ReconcileInitialize (state, vm, & integer :: nitems_local(1) integer :: mypet, npets - logical, parameter :: profile = .false. + logical, parameter :: profile = .true. localrc = ESMF_RC_NOT_IMPL From 207f3234c0c7c1027afb217646cbf08246e31883 Mon Sep 17 00:00:00 2001 From: Gerhard Theurich Date: Tue, 24 Sep 2024 12:06:48 -0600 Subject: [PATCH 017/207] Add `vm` arguemnts to Get() methods in support of StateReconcile() optimization work. --- .../interface/ESMF_ArrayBundle.F90 | 19 ++++++++++++++++--- .../FieldBundle/src/ESMF_FieldBundle.cppF90 | 17 ++++++++++++++--- .../Route/interface/ESMF_RHandle.F90 | 12 +++++++++++- .../State/src/ESMF_StateAPI.cppF90 | 13 ++++++++++++- 4 files changed, 53 insertions(+), 8 deletions(-) diff --git a/src/Infrastructure/ArrayBundle/interface/ESMF_ArrayBundle.F90 b/src/Infrastructure/ArrayBundle/interface/ESMF_ArrayBundle.F90 index adfd393b05..c6a4594ee9 100644 --- a/src/Infrastructure/ArrayBundle/interface/ESMF_ArrayBundle.F90 +++ b/src/Infrastructure/ArrayBundle/interface/ESMF_ArrayBundle.F90 @@ -44,7 +44,8 @@ module ESMF_ArrayBundleMod use ESMF_IOUtilMod use ESMF_RHandleMod use ESMF_ArrayMod - + use ESMF_VMMod + implicit none !------------------------------------------------------------------------------ @@ -883,9 +884,9 @@ end subroutine ESMF_ArrayBundleDestroy ! !IROUTINE: ESMF_ArrayBundleGet - Get object-wide information from an ArrayBundle ! ! !INTERFACE: - ! Private name; call using ESMF_ArrayBundleGet() + ! Private name; call using ESMF_ArrayBundleGet() subroutine ESMF_ArrayBundleGetListAll(arraybundle, keywordEnforcer, & - itemorderflag, arrayCount, arrayList, arrayNameList, name, rc) + itemorderflag, arrayCount, arrayList, arrayNameList, name, vm, rc) ! ! !ARGUMENTS: type(ESMF_ArrayBundle), intent(in) :: arraybundle @@ -895,6 +896,7 @@ subroutine ESMF_ArrayBundleGetListAll(arraybundle, keywordEnforcer, & type(ESMF_Array), intent(out), optional :: arrayList(:) character(len=*), intent(out), optional :: arrayNameList(:) character(len=*), intent(out), optional :: name + type(ESMF_VM), intent(out), optional :: vm integer, intent(out), optional :: rc ! ! !STATUS: @@ -905,6 +907,8 @@ subroutine ESMF_ArrayBundleGetListAll(arraybundle, keywordEnforcer, & ! \item[6.1.0] Added argument {\tt itemorderflag}. ! The new argument gives the user control over the order in which ! the items are returned. +! \item[8.8.0] Added argument {\tt vm} in order to offer information about the +! VM on which the ArrayBundle was created. ! \end{description} ! \end{itemize} ! @@ -930,6 +934,8 @@ subroutine ESMF_ArrayBundleGetListAll(arraybundle, keywordEnforcer, & ! size {\tt arrayCount}. ! \item [{[name]}] ! Name of the ArrayBundle object. +! \item [{[vm}] +! The VM on which the ArrayBundle object was created. ! \item [{[rc]}] ! Return code; equals {\tt ESMF\_SUCCESS} if there are no errors. ! \end{description} @@ -1015,6 +1021,13 @@ subroutine ESMF_ArrayBundleGetListAll(arraybundle, keywordEnforcer, & endif endif + ! Special call to get vm out of Base class + if (present(vm)) then + call c_ESMC_GetVM(arraybundle, vm, localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, rcToReturn=rc)) return + endif + ! Return successfully if (present(rc)) rc = ESMF_SUCCESS diff --git a/src/Infrastructure/FieldBundle/src/ESMF_FieldBundle.cppF90 b/src/Infrastructure/FieldBundle/src/ESMF_FieldBundle.cppF90 index e160fae06a..e48f8d8653 100644 --- a/src/Infrastructure/FieldBundle/src/ESMF_FieldBundle.cppF90 +++ b/src/Infrastructure/FieldBundle/src/ESMF_FieldBundle.cppF90 @@ -1705,7 +1705,7 @@ type(ESMF_KeywordEnforcer), optional:: keywordEnforcer ! must use keywords below ! Private name; call using ESMF_FieldBundleGet() subroutine ESMF_FieldBundleGetListAll(fieldbundle, keywordEnforcer, & itemorderflag, geomtype, grid, locstream, mesh, xgrid, & - fieldCount, fieldList, fieldNameList, isPacked, name, rc) + fieldCount, fieldList, fieldNameList, isPacked, name, vm, rc) ! ! !ARGUMENTS: type(ESMF_FieldBundle), intent(in) :: fieldbundle @@ -1721,6 +1721,7 @@ type(ESMF_KeywordEnforcer), optional:: keywordEnforcer ! must use keywords below character(len=*), intent(out), optional :: fieldNameList(:) logical, intent(out), optional :: isPacked character(len=*), intent(out), optional :: name + type(ESMF_VM), intent(out), optional :: vm integer, intent(out), optional :: rc ! ! !STATUS: @@ -1733,6 +1734,8 @@ type(ESMF_KeywordEnforcer), optional:: keywordEnforcer ! must use keywords below ! the items are returned. ! \item[8.0.0] Added argument {\tt isPacked}. ! The new argument allows the user to query if this is a packed FieldBundle. +! \item[8.8.0] Added argument {\tt vm} in order to offer information about the +! VM on which the FieldBundle was created. ! \end{description} ! \end{itemize} ! @@ -1771,7 +1774,9 @@ type(ESMF_KeywordEnforcer), optional:: keywordEnforcer ! must use keywords below ! \item [{[isPacked]}] ! Upon return holds the information if this FieldBundle is packed. ! \item [{[name]}] -! Name of the fieldbundle object. +! Name of the FieldBundle object. +! \item [{[vm}] +! The VM on which the FieldBundle object was created. ! \item [{[rc]}] ! Return code; equals {\tt ESMF\_SUCCESS} if there are no errors. ! \end{description} @@ -1960,7 +1965,13 @@ type(ESMF_KeywordEnforcer), optional:: keywordEnforcer ! must use keywords below ESMF_CONTEXT, rcToReturn=rc)) return endif endif - + + if (present(vm)) then + call c_ESMC_GetVM(fieldbundle%this%base, vm, localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, rcToReturn=rc)) return + endif + ! Return successfully if (present(rc)) rc = ESMF_SUCCESS diff --git a/src/Infrastructure/Route/interface/ESMF_RHandle.F90 b/src/Infrastructure/Route/interface/ESMF_RHandle.F90 index 7e5dcf2779..b0d57b3a6f 100644 --- a/src/Infrastructure/Route/interface/ESMF_RHandle.F90 +++ b/src/Infrastructure/Route/interface/ESMF_RHandle.F90 @@ -43,6 +43,7 @@ module ESMF_RHandleMod use ESMF_LogErrMod ! ESMF error handling use ESMF_F90InterfaceMod ! ESMF F90-C++ interface helper use ESMF_IOUtilMod ! ESMF I/O utility layer + use ESMF_VMMod implicit none @@ -755,12 +756,13 @@ end subroutine ESMF_RouteHandleDestroy ! !INTERFACE: ! Private name; call using ESMF_RouteHandleGet() - subroutine ESMF_RouteHandleGetP(routehandle, keywordEnforcer, name, rc) + subroutine ESMF_RouteHandleGetP(routehandle, keywordEnforcer, name, vm, rc) ! ! !ARGUMENTS: type(ESMF_RouteHandle), intent(in) :: routehandle type(ESMF_KeywordEnforcer), optional:: keywordEnforcer ! must use keywords below character(len=*), intent(out), optional :: name + type(ESMF_VM), intent(out), optional :: vm integer, intent(out), optional :: rc ! @@ -773,6 +775,8 @@ subroutine ESMF_RouteHandleGetP(routehandle, keywordEnforcer, name, rc) ! {\tt ESMF\_RouteHandle} to be queried. ! \item [{[name]}] ! Name of the RouteHandle object. +! \item [{[vm}] +! The VM on which the RouteHandle object was created. ! \item[{[rc]}] ! Return code; equals {\tt ESMF\_SUCCESS} if there are no errors. ! \end{description} @@ -794,6 +798,12 @@ subroutine ESMF_RouteHandleGetP(routehandle, keywordEnforcer, name, rc) ESMF_CONTEXT, rcToReturn=rc)) return endif + if (present(vm)) then + call c_ESMC_GetVM(routehandle, vm, localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, rcToReturn=rc)) return + endif + ! Return successfully if (present(rc)) rc = ESMF_SUCCESS diff --git a/src/Superstructure/State/src/ESMF_StateAPI.cppF90 b/src/Superstructure/State/src/ESMF_StateAPI.cppF90 index 0e26f6e7de..20371d2cdb 100644 --- a/src/Superstructure/State/src/ESMF_StateAPI.cppF90 +++ b/src/Superstructure/State/src/ESMF_StateAPI.cppF90 @@ -1123,7 +1123,7 @@ ESMF_INIT_CHECK_DEEP(ESMF_RouteHandleGetInit,routehandleList(i),rc) ! Private name; call using ESMF_StateGet() subroutine ESMF_StateGetInfo(state, & keywordEnforcer, itemSearch, itemorderflag, nestedFlag, & - stateIntent, itemCount, itemNameList, itemTypeList, name, rc) + stateIntent, itemCount, itemNameList, itemTypeList, name, vm, rc) ! ! !ARGUMENTS: type(ESMF_State), intent(in) :: state @@ -1136,6 +1136,7 @@ ESMF_INIT_CHECK_DEEP(ESMF_RouteHandleGetInit,routehandleList(i),rc) character (len=*), intent(out), optional :: itemNameList(:) type(ESMF_StateItem_Flag), intent(out), optional :: itemTypeList(:) character (len=*), intent(out), optional :: name + type(ESMF_VM), intent(out), optional :: vm integer, intent(out), optional :: rc ! @@ -1147,6 +1148,8 @@ ESMF_INIT_CHECK_DEEP(ESMF_RouteHandleGetInit,routehandleList(i),rc) ! \item[6.1.0] Added argument {\tt itemorderflag}. ! The new argument gives the user control over the order in which ! the items are returned. +! \item[8.8.0] Added argument {\tt vm} in order to offer information about the +! VM on which the State was created. ! \end{description} ! \end{itemize} ! @@ -1205,6 +1208,8 @@ ESMF_INIT_CHECK_DEEP(ESMF_RouteHandleGetInit,routehandleList(i),rc) ! long. Return values are listed in Section~\ref{const:stateitem}. ! \item[{[name]}] ! Returns the name of this {\tt ESMF\_State}. +! \item [{[vm}] +! The VM on which the State object was created. ! \item[{[rc]}] ! Return code; equals {\tt ESMF\_SUCCESS} if there are no errors. ! \end{description} @@ -1268,6 +1273,12 @@ ESMF_INIT_CHECK_DEEP(ESMF_RouteHandleGetInit,routehandleList(i),rc) call itemTypeWorker (stypep) endif + if (present(vm)) then + call c_ESMC_GetVM(stypep%base, vm, localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, rcToReturn=rc)) return + endif + ! return successfully if (present(rc)) rc = ESMF_SUCCESS From b582b0ce1aa463e15b6a7cf76276b8d46916d936 Mon Sep 17 00:00:00 2001 From: Gerhard Theurich Date: Tue, 24 Sep 2024 19:55:55 +0000 Subject: [PATCH 018/207] Start implementation to detect whether Reconcile is a NOOP. --- .../src/ESMF_StateReconcile.F90 | 207 ++++++++++++++++++ 1 file changed, 207 insertions(+) diff --git a/src/Superstructure/StateReconcile/src/ESMF_StateReconcile.F90 b/src/Superstructure/StateReconcile/src/ESMF_StateReconcile.F90 index 969f4a8355..644933913d 100644 --- a/src/Superstructure/StateReconcile/src/ESMF_StateReconcile.F90 +++ b/src/Superstructure/StateReconcile/src/ESMF_StateReconcile.F90 @@ -178,6 +178,8 @@ subroutine ESMF_StateReconcile(state, vm, rc) logical, parameter :: profile = .true. + logical :: isNoop + ! check input variables ESMF_INIT_CHECK_DEEP(ESMF_StateGetInit,state,rc) ESMF_INIT_CHECK_DEEP(ESMF_VMGetInit,vm,rc) @@ -195,6 +197,28 @@ subroutine ESMF_StateReconcile(state, vm, rc) rcToReturn=rc)) return end if + ! Determine whether there is anything to be Reconciled at all. + ! If not then return as quickly as possible + + if (profile) then + call ESMF_TraceRegionEnter("ESMF_StateReconcileIsNoop", rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, & + rcToReturn=rc)) return + endif + + call ESMF_StateReconcileIsNoop(state, vm=localvm, isNoop=isNoop, rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, & + rcToReturn=rc)) return + + if (profile) then + call ESMF_TraceRegionExit("ESMF_StateReconcileIsNoop", rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, & + rcToReturn=rc)) return + endif + ! Each PET broadcasts the object ID lists and compares them to what ! they get back. Missing objects are sent so they can be recreated ! on the PETs without those objects as "proxy" objects. Eventually @@ -266,6 +290,189 @@ subroutine ESMF_StateReconcile(state, vm, rc) end subroutine ESMF_StateReconcile +!------------------------------------------------------------------------------ +#undef ESMF_METHOD +#define ESMF_METHOD "ESMF_StateReconcileIsNoop" +!BOPI +! !IROUTINE: ESMF_StateReconcileIsNoop +! +! !INTERFACE: + subroutine ESMF_StateReconcileIsNoop(state, vm, isNoop, rc) +! +! !ARGUMENTS: + type (ESMF_State), intent(inout) :: state + type (ESMF_VM), intent(in) :: vm + logical, intent(out) :: isNoop + integer, intent(out) :: rc +! +! !DESCRIPTION: +! +! The arguments are: +! \begin{description} +! \item[state] +! {\tt ESMF\_State} to be reconciled. +! \item[vm] +! The current {\tt ESMF\_VM} (virtual machine). +! \item[isNoop] +! Return {\tt .true.} if no reconcile is needed, {\tt .false.} otherwise. +! \item[{[rc]}] +! Return code; equals {\tt ESMF\_SUCCESS} if there are no errors. +! \end{description} +!EOPI + integer :: localrc + type(ESMF_VMId) :: vmId + logical :: isNoopLoc + + localrc = ESMF_RC_NOT_IMPL + + isNoop = .false. ! assume reconcile is needed + + call ESMF_VMGetVMId(vm, vmId=vmId, rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & + rcToReturn=rc)) return + + call ESMF_VMIdLog(vmId, prefix="ESMF_StateReconcileIsNoop(): ", & + rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & + rcToReturn=rc)) return + + call StateReconcileIsNoopLoc(state, isNoopLoc=isNoopLoc, rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & + rcToReturn=rc)) return + + ! return successfully + rc = ESMF_SUCCESS + + contains + + recursive subroutine StateReconcileIsNoopLoc(stateR, isNoopLoc, rc) + type(ESMF_State), intent(in) :: stateR + logical, intent(out) :: isNoopLoc + integer, intent(out) :: rc + ! - local variables + integer :: localrc + integer :: itemCount, item + character(ESMF_MAXSTR), allocatable :: itemNameList(:) + type(ESMF_StateItem_Flag), allocatable :: itemTypeList(:) + type(ESMF_State) :: nestedState + type(ESMF_Field) :: field + type(ESMF_FieldBundle) :: fieldbundle + type(ESMF_Array) :: array + type(ESMF_ArrayBundle) :: arraybundle + type(ESMF_RouteHandle) :: routehandle + type(ESMF_VM) :: vmItem + type(ESMF_VMId) :: vmIdItem + + localrc = ESMF_RC_NOT_IMPL + + isNoopLoc = .false. ! assume reconcile needed until found otherwise + + ! query + call ESMF_StateGet(stateR, itemCount=itemCount, rc=localrc) + if (ESMF_LogFoundError(localrc, & + ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, rcToReturn=rc)) return + + if (itemCount > 0) then + allocate(itemNameList(itemCount)) + allocate(itemTypeList(itemCount)) + call ESMF_StateGet(stateR, itemNameList=itemNameList, & + itemtypeList=itemtypeList, rc=localrc) + if (ESMF_LogFoundError(localrc, & + ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, rcToReturn=rc)) return + + do item=1, itemCount + ! access the VM of the item, using appropriate API + if ((itemtypeList(item) == ESMF_STATEITEM_STATE)) then + call ESMF_StateGet(stateR, vm=vmItem, rc=localrc) + if (ESMF_LogFoundError(localrc, & + ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, rcToReturn=rc)) return + ! recursion into nested state + call ESMF_StateGet(stateR, itemName=itemNameList(item), & + nestedState=nestedState, rc=localrc) + if (ESMF_LogFoundError(localrc, & + ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, rcToReturn=rc)) return + call StateReconcileIsNoopLoc(stateR=nestedState, & + isNoopLoc=isNoopLoc, rc=localrc) + if (ESMF_LogFoundError(localrc, & + ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, rcToReturn=rc)) return + else if (itemtypeList(item) == ESMF_STATEITEM_FIELD) then + call ESMF_StateGet(stateR, itemName=itemNameList(item), & + field=field, rc=localrc) + if (ESMF_LogFoundError(localrc, & + ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, rcToReturn=rc)) return + call ESMF_FieldGet(field, vm=vmItem, rc=localrc) + if (ESMF_LogFoundError(localrc, & + ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, rcToReturn=rc)) return + else if (itemtypeList(item) == ESMF_STATEITEM_FIELDBUNDLE) then + call ESMF_StateGet(stateR, itemName=itemNameList(item), & + fieldbundle=fieldbundle, rc=localrc) + if (ESMF_LogFoundError(localrc, & + ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, rcToReturn=rc)) return + call ESMF_FieldBundleGet(fieldbundle, vm=vmItem, rc=localrc) + if (ESMF_LogFoundError(localrc, & + ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, rcToReturn=rc)) return +!TODO: need to loop over fields in FB + else if (itemtypeList(item) == ESMF_STATEITEM_ARRAY) then + call ESMF_StateGet(stateR, itemName=itemNameList(item), & + array=array, rc=localrc) + if (ESMF_LogFoundError(localrc, & + ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, rcToReturn=rc)) return + call ESMF_ArrayGet(array, vm=vmItem, rc=localrc) + if (ESMF_LogFoundError(localrc, & + ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, rcToReturn=rc)) return + else if (itemtypeList(item) == ESMF_STATEITEM_ARRAYBUNDLE) then + call ESMF_StateGet(stateR, itemName=itemNameList(item), & + arraybundle=arraybundle, rc=localrc) + if (ESMF_LogFoundError(localrc, & + ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, rcToReturn=rc)) return + call ESMF_ArrayBundleGet(arraybundle, vm=vmItem, rc=localrc) + if (ESMF_LogFoundError(localrc, & + ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, rcToReturn=rc)) return +!TODO: need to loop over arrays in AB + else if (itemtypeList(item) == ESMF_STATEITEM_ROUTEHANDLE) then + call ESMF_StateGet(stateR, itemName=itemNameList(item), & + routehandle=routehandle, rc=localrc) + if (ESMF_LogFoundError(localrc, & + ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, rcToReturn=rc)) return + call ESMF_RouteHandleGet(routehandle, vm=vmItem, rc=localrc) + if (ESMF_LogFoundError(localrc, & + ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, rcToReturn=rc)) return + endif + + call ESMF_VMGetVMId(vmItem, vmId=vmIdItem, rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & + rcToReturn=rc)) return + + call ESMF_VMIdLog(vmIdItem, prefix="vmIdItem: ", & + rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & + rcToReturn=rc)) return + + enddo + + deallocate(itemNameList) + deallocate(itemTypeList) + endif + + end subroutine StateReconcileIsNoopLoc + + end subroutine ESMF_StateReconcileIsNoop + !------------------------------------------------------------------------------ #undef ESMF_METHOD #define ESMF_METHOD "ESMF_StateReconcile_driver" From 4fb8294896761effdbe564fb25faae970a9d5384 Mon Sep 17 00:00:00 2001 From: Gerhard Theurich Date: Tue, 24 Sep 2024 17:23:43 -0600 Subject: [PATCH 019/207] First ESMF_StateReconcileIsNoop() implementation complete. --- src/Infrastructure/VM/include/ESMCI_VM.h | 2 +- src/Infrastructure/VM/interface/ESMCI_VM_F.C | 7 ++- src/Infrastructure/VM/interface/ESMF_VM.F90 | 15 ++++-- src/Infrastructure/VM/src/ESMCI_VM.C | 12 +++-- .../src/ESMF_StateReconcile.F90 | 47 ++++++++++++++----- 5 files changed, 62 insertions(+), 21 deletions(-) diff --git a/src/Infrastructure/VM/include/ESMCI_VM.h b/src/Infrastructure/VM/include/ESMCI_VM.h index 5a6493d332..8fdb37aa54 100644 --- a/src/Infrastructure/VM/include/ESMCI_VM.h +++ b/src/Infrastructure/VM/include/ESMCI_VM.h @@ -81,7 +81,7 @@ class VMId { namespace ESMCI { // ESMCI::VMId methods: -bool VMIdCompare(const VMId *vmID1, const VMId *vmID2); +bool VMIdCompare(const VMId *vmID1, const VMId *vmID2, bool keyOnly=false); bool VMIdLessThan(const VMId *vmID1, const VMId *vmID2); int VMIdCopy(VMId *vmIDdst, VMId *vmIDsrc); } // namespace ESMCI diff --git a/src/Infrastructure/VM/interface/ESMCI_VM_F.C b/src/Infrastructure/VM/interface/ESMCI_VM_F.C index 760c8fbe60..ff9f1fea75 100644 --- a/src/Infrastructure/VM/interface/ESMCI_VM_F.C +++ b/src/Infrastructure/VM/interface/ESMCI_VM_F.C @@ -1660,7 +1660,7 @@ extern "C" { } void FTN_X(c_esmc_vmidcompare)(ESMCI::VMId **vmid1, ESMCI::VMId **vmid2, - ESMC_Logical *result, int *rc){ + ESMC_Logical *keyOnly, ESMC_Logical *result, int *rc){ #undef ESMC_METHOD #define ESMC_METHOD "c_esmc_vmidcompare()" // Initialize return code; assume routine not implemented @@ -1669,7 +1669,10 @@ extern "C" { ESMCI_NULL_CHECK_PRC(vmid1, rc) ESMCI_NULL_CHECK_PRC(vmid2, rc) ESMCI_NULL_CHECK_PRC(result, rc) - bool resultBool = ESMCI::VMIdCompare(*vmid1, *vmid2); + bool keyOnlyOpt = false; // default + if (ESMC_NOT_PRESENT_FILTER(keyOnly) != ESMC_NULL_POINTER) + if (*keyOnly == ESMF_TRUE) keyOnlyOpt = true; + bool resultBool = ESMCI::VMIdCompare(*vmid1, *vmid2, keyOnlyOpt); *result = resultBool ? ESMF_TRUE : ESMF_FALSE; // return successfully if (rc!=NULL) *rc = ESMF_SUCCESS; diff --git a/src/Infrastructure/VM/interface/ESMF_VM.F90 b/src/Infrastructure/VM/interface/ESMF_VM.F90 index 5ceae6c30e..c41955b510 100644 --- a/src/Infrastructure/VM/interface/ESMF_VM.F90 +++ b/src/Infrastructure/VM/interface/ESMF_VM.F90 @@ -10353,7 +10353,7 @@ end subroutine ESMF_VMPlanMinThreads ! !IROUTINE: ESMF_VMIdCompare - Compare two ESMF_VMId objects ! !INTERFACE: - function ESMF_VMIdCompare(vmId1, vmId2, rc) + function ESMF_VMIdCompare(vmId1, vmId2, keyOnly, rc) ! ! !RETURN VALUE: logical :: ESMF_VMIdCompare @@ -10361,6 +10361,7 @@ function ESMF_VMIdCompare(vmId1, vmId2, rc) ! !ARGUMENTS: type(ESMF_VMId), intent(in) :: vmId1 type(ESMF_VMId), intent(in) :: vmId2 + logical, intent(in), optional :: keyOnly integer, intent(out), optional :: rc ! ! !DESCRIPTION: @@ -10372,6 +10373,9 @@ function ESMF_VMIdCompare(vmId1, vmId2, rc) ! ESMF_VMId object 1 ! \item[vmId2] ! ESMF_VMId object 2 +! \item[{[keyOnly]}] +! For {\tt .true.} only compare the vmKey parts. Default is +! {\tt .false.}. ! \item[{[rc]}] ! Return code; equals {\tt ESMF\_SUCCESS} if there are no errors. ! \end{description} @@ -10379,14 +10383,19 @@ function ESMF_VMIdCompare(vmId1, vmId2, rc) !EOPI !------------------------------------------------------------------------------ integer :: localrc ! local return code - type(ESMF_Logical) :: tf + type(ESMF_Logical) :: tf, keyOnlyOpt ! initialize return code; assume routine not implemented localrc = ESMF_RC_NOT_IMPL if (present(rc)) rc = ESMF_RC_NOT_IMPL + keyOnlyOpt = ESMF_FALSE + if (present(keyOnly)) then + if (keyOnly) keyOnlyOpt = ESMF_TRUE + endif + ! Call into the C++ interface - call c_ESMC_VMIdCompare(vmId1, vmId2, tf, localrc) + call c_ESMC_VMIdCompare(vmId1, vmId2, keyOnly, tf, localrc) ESMF_VMIdCompare = tf == ESMF_TRUE if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return diff --git a/src/Infrastructure/VM/src/ESMCI_VM.C b/src/Infrastructure/VM/src/ESMCI_VM.C index fd341a86a9..db32a1532f 100644 --- a/src/Infrastructure/VM/src/ESMCI_VM.C +++ b/src/Infrastructure/VM/src/ESMCI_VM.C @@ -729,11 +729,13 @@ bool VMIdCompare( // !ARGUMENTS: // const VMId *vmID1, - const VMId *vmID2 + const VMId *vmID2, + bool keyOnly ){ // // !DESCRIPTION: -// Compare two {\tt ESMC\_VMId} objects. +// Compare two {\tt ESMC\_VMId} objects. If {\tt keyOnly==true} only compare +// vmKey part. // //EOPI //----------------------------------------------------------------------------- @@ -742,8 +744,10 @@ bool VMIdCompare( "- Invalid vmIDs", ESMC_CONTEXT, NULL); return false; // bail out } - if (vmID1->localID != vmID2->localID){ - return false; + if (!keyOnly){ + if (vmID1->localID != vmID2->localID){ + return false; + } } return VMKeyCompare(vmID1->vmKey, vmID2->vmKey); } diff --git a/src/Superstructure/StateReconcile/src/ESMF_StateReconcile.F90 b/src/Superstructure/StateReconcile/src/ESMF_StateReconcile.F90 index 644933913d..0e6a006379 100644 --- a/src/Superstructure/StateReconcile/src/ESMF_StateReconcile.F90 +++ b/src/Superstructure/StateReconcile/src/ESMF_StateReconcile.F90 @@ -219,6 +219,13 @@ subroutine ESMF_StateReconcile(state, vm, rc) rcToReturn=rc)) return endif + if (isNoop) then +call ESMF_LogWrite("returning early with isNoop=.true.", ESMF_LOGMSG_DEBUG, rc=localrc) + ! successful early return because of NOOP condition + if (present(rc)) rc = ESMF_SUCCESS + return + endif + ! Each PET broadcasts the object ID lists and compares them to what ! they get back. Missing objects are sent so they can be recreated ! on the PETs without those objects as "proxy" objects. Eventually @@ -322,6 +329,7 @@ subroutine ESMF_StateReconcileIsNoop(state, vm, isNoop, rc) integer :: localrc type(ESMF_VMId) :: vmId logical :: isNoopLoc + integer :: isNoopLocInt(1), isNoopInt(1) localrc = ESMF_RC_NOT_IMPL @@ -331,15 +339,21 @@ subroutine ESMF_StateReconcileIsNoop(state, vm, isNoop, rc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & rcToReturn=rc)) return - call ESMF_VMIdLog(vmId, prefix="ESMF_StateReconcileIsNoop(): ", & - rc=localrc) + call StateReconcileIsNoopLoc(state, isNoopLoc=isNoopLoc, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & rcToReturn=rc)) return - call StateReconcileIsNoopLoc(state, isNoopLoc=isNoopLoc, rc=localrc) + isNoopLocInt(1) = 0 + if (isNoopLoc) isNoopLocInt(1) = 1 + + ! logical AND reduction, only 1 if all incoming 1 + call ESMF_VMAllReduce(vm, isNoopLocInt, isNoopInt, 1, ESMF_REDUCE_MIN, & + rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & rcToReturn=rc)) return + if (isNoopInt(1)==1) isNoop = .true. ! found that Reconcile is a NOOP + ! return successfully rc = ESMF_SUCCESS @@ -362,10 +376,11 @@ recursive subroutine StateReconcileIsNoopLoc(stateR, isNoopLoc, rc) type(ESMF_RouteHandle) :: routehandle type(ESMF_VM) :: vmItem type(ESMF_VMId) :: vmIdItem + type(ESMF_Pointer) :: thisItem localrc = ESMF_RC_NOT_IMPL - isNoopLoc = .false. ! assume reconcile needed until found otherwise + isNoopLoc = .true. ! query call ESMF_StateGet(stateR, itemCount=itemCount, rc=localrc) @@ -454,14 +469,24 @@ recursive subroutine StateReconcileIsNoopLoc(stateR, isNoopLoc, rc) ESMF_CONTEXT, rcToReturn=rc)) return endif - call ESMF_VMGetVMId(vmItem, vmId=vmIdItem, rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & - rcToReturn=rc)) return + call ESMF_VMGetThis(vmItem, thisItem, rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & + rcToReturn=rc)) return - call ESMF_VMIdLog(vmIdItem, prefix="vmIdItem: ", & - rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & - rcToReturn=rc)) return + if (thisItem == ESMF_NULL_POINTER) isNoopLoc = .false. ! found proxy + + if (.not.isNoopLoc) exit ! exit for .false. already recurse or proxy + + call ESMF_VMGetVMId(vmItem, vmId=vmIdItem, rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & + rcToReturn=rc)) return + + isNoopLoc = ESMF_VMIdCompare(vmIdItem, vmId, keyOnly=.true., & + rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & + rcToReturn=rc)) return + + if (.not.isNoopLoc) exit ! exit for .false. enddo From 1ee3e408e084f5d08c2a735e1a3f10123bc48d42 Mon Sep 17 00:00:00 2001 From: Gerhard Theurich Date: Tue, 24 Sep 2024 20:23:31 -0600 Subject: [PATCH 020/207] Correct nested state handling. --- .../StateReconcile/src/ESMF_StateReconcile.F90 | 10 ++++++---- 1 file changed, 6 insertions(+), 4 deletions(-) diff --git a/src/Superstructure/StateReconcile/src/ESMF_StateReconcile.F90 b/src/Superstructure/StateReconcile/src/ESMF_StateReconcile.F90 index 0e6a006379..3eaa2e9f47 100644 --- a/src/Superstructure/StateReconcile/src/ESMF_StateReconcile.F90 +++ b/src/Superstructure/StateReconcile/src/ESMF_StateReconcile.F90 @@ -400,16 +400,16 @@ recursive subroutine StateReconcileIsNoopLoc(stateR, isNoopLoc, rc) do item=1, itemCount ! access the VM of the item, using appropriate API if ((itemtypeList(item) == ESMF_STATEITEM_STATE)) then - call ESMF_StateGet(stateR, vm=vmItem, rc=localrc) + call ESMF_StateGet(stateR, itemName=itemNameList(item), & + nestedState=nestedState, rc=localrc) if (ESMF_LogFoundError(localrc, & ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return - ! recursion into nested state - call ESMF_StateGet(stateR, itemName=itemNameList(item), & - nestedState=nestedState, rc=localrc) + call ESMF_StateGet(nestedState, vm=vmItem, rc=localrc) if (ESMF_LogFoundError(localrc, & ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return + ! recursion into nested state call StateReconcileIsNoopLoc(stateR=nestedState, & isNoopLoc=isNoopLoc, rc=localrc) if (ESMF_LogFoundError(localrc, & @@ -469,6 +469,8 @@ recursive subroutine StateReconcileIsNoopLoc(stateR, isNoopLoc, rc) ESMF_CONTEXT, rcToReturn=rc)) return endif +call ESMF_LogWrite("processing "//trim(itemNameList(item)), ESMF_LOGMSG_DEBUG, rc=localrc) + call ESMF_VMGetThis(vmItem, thisItem, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & rcToReturn=rc)) return From 5ea7603ee2bc6493515658b7acd3ed9a1ea5f6ee Mon Sep 17 00:00:00 2001 From: Gerhard Theurich Date: Tue, 24 Sep 2024 20:23:41 -0600 Subject: [PATCH 021/207] Correct VM access call. --- src/Infrastructure/FieldBundle/src/ESMF_FieldBundle.cppF90 | 2 +- src/Superstructure/State/src/ESMF_StateAPI.cppF90 | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/src/Infrastructure/FieldBundle/src/ESMF_FieldBundle.cppF90 b/src/Infrastructure/FieldBundle/src/ESMF_FieldBundle.cppF90 index e48f8d8653..e12f32ce88 100644 --- a/src/Infrastructure/FieldBundle/src/ESMF_FieldBundle.cppF90 +++ b/src/Infrastructure/FieldBundle/src/ESMF_FieldBundle.cppF90 @@ -1967,7 +1967,7 @@ type(ESMF_KeywordEnforcer), optional:: keywordEnforcer ! must use keywords below endif if (present(vm)) then - call c_ESMC_GetVM(fieldbundle%this%base, vm, localrc) + call ESMF_GetVM(fieldbundle%this%base, vm, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return endif diff --git a/src/Superstructure/State/src/ESMF_StateAPI.cppF90 b/src/Superstructure/State/src/ESMF_StateAPI.cppF90 index 20371d2cdb..7a7dd1c9e1 100644 --- a/src/Superstructure/State/src/ESMF_StateAPI.cppF90 +++ b/src/Superstructure/State/src/ESMF_StateAPI.cppF90 @@ -1274,7 +1274,7 @@ ESMF_INIT_CHECK_DEEP(ESMF_RouteHandleGetInit,routehandleList(i),rc) endif if (present(vm)) then - call c_ESMC_GetVM(stypep%base, vm, localrc) + call ESMF_GetVM(stypep%base, vm, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return endif From 938b33ea3b752b3ab37242e4774cf064e66df30c Mon Sep 17 00:00:00 2001 From: Gerhard Theurich Date: Tue, 24 Sep 2024 23:59:39 -0600 Subject: [PATCH 022/207] Add 'vm' argument to the NUOPC_AdvertiseFields entry point of the NUOPC_Advertise interface, --- src/addon/NUOPC/src/NUOPC_Base.F90 | 12 +++++++++--- 1 file changed, 9 insertions(+), 3 deletions(-) diff --git a/src/addon/NUOPC/src/NUOPC_Base.F90 b/src/addon/NUOPC/src/NUOPC_Base.F90 index 1d965235f7..2f3bf35a4a 100644 --- a/src/addon/NUOPC/src/NUOPC_Base.F90 +++ b/src/addon/NUOPC/src/NUOPC_Base.F90 @@ -623,13 +623,14 @@ subroutine NUOPC_AdvertiseField(state, StandardName, Units, & ! !INTERFACE: ! Private name; call using NUOPC_Advertise() subroutine NUOPC_AdvertiseFields(state, StandardNames, & - TransferOfferGeomObject, SharePolicyField, SharePolicyGeomObject, rc) + TransferOfferGeomObject, SharePolicyField, SharePolicyGeomObject, vm, rc) ! !ARGUMENTS: type(ESMF_State), intent(inout) :: state character(*), intent(in) :: StandardNames(:) character(*), intent(in), optional :: TransferOfferGeomObject character(*), intent(in), optional :: SharePolicyField character(*), intent(in), optional :: SharePolicyGeomObject + type(ESMF_VM), intent(in), optional :: vm integer, intent(out), optional :: rc ! !DESCRIPTION: ! \label{NUOPC_AdvertiseFields} @@ -668,6 +669,10 @@ subroutine NUOPC_AdvertiseFields(state, StandardNames, & ! controls the vocabulary of this attribute. Valid options are ! "share", and "not share". ! If omitted, the default is equal to {\tt SharePolicyField}. +! \item[{[vm]}] +! If present, the Field objects used during advertising are created on the +! specified {\tt ESMF\_VM} object. The default is to create the Field +! objects on the VM of the current component context. ! \item[{[rc]}] ! Return code; equals {\tt ESMF\_SUCCESS} if there are no errors. ! \end{description} @@ -682,8 +687,9 @@ subroutine NUOPC_AdvertiseFields(state, StandardNames, & do i=1, size(StandardNames) call NUOPC_AdvertiseField(state, StandardName=StandardNames(i), & - TransferOfferGeomObject=TransferOfferGeomObject, SharePolicyField=SharePolicyField, & - SharePolicyGeomObject=SharePolicyGeomObject, rc=localrc) + TransferOfferGeomObject=TransferOfferGeomObject, & + SharePolicyField=SharePolicyField, & + SharePolicyGeomObject=SharePolicyGeomObject, vm=vm, rc=localrc) if (ESMF_LogFoundError(rcToCheck=localrc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=FILENAME, & From cda15d3169181653631243117ba483d32acf6f77 Mon Sep 17 00:00:00 2001 From: Gerhard Theurich Date: Wed, 25 Sep 2024 00:03:35 -0600 Subject: [PATCH 023/207] A bit more logging for development. --- src/Superstructure/StateReconcile/src/ESMF_StateReconcile.F90 | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/src/Superstructure/StateReconcile/src/ESMF_StateReconcile.F90 b/src/Superstructure/StateReconcile/src/ESMF_StateReconcile.F90 index 3eaa2e9f47..0aae5d77ef 100644 --- a/src/Superstructure/StateReconcile/src/ESMF_StateReconcile.F90 +++ b/src/Superstructure/StateReconcile/src/ESMF_StateReconcile.F90 @@ -221,11 +221,15 @@ subroutine ESMF_StateReconcile(state, vm, rc) if (isNoop) then call ESMF_LogWrite("returning early with isNoop=.true.", ESMF_LOGMSG_DEBUG, rc=localrc) +#if 1 ! successful early return because of NOOP condition if (present(rc)) rc = ESMF_SUCCESS return +#endif endif +call ESMF_LogWrite("continue with isNoop=.false.", ESMF_LOGMSG_DEBUG, rc=localrc) + ! Each PET broadcasts the object ID lists and compares them to what ! they get back. Missing objects are sent so they can be recreated ! on the PETs without those objects as "proxy" objects. Eventually From e957f39ab709063889b39301c8c089ee11b1784b Mon Sep 17 00:00:00 2001 From: Gerhard Theurich Date: Wed, 25 Sep 2024 14:13:30 +0000 Subject: [PATCH 024/207] Use the correct local logical variable when calling down into C++ layer. --- src/Infrastructure/VM/interface/ESMF_VM.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Infrastructure/VM/interface/ESMF_VM.F90 b/src/Infrastructure/VM/interface/ESMF_VM.F90 index c41955b510..3cd4266171 100644 --- a/src/Infrastructure/VM/interface/ESMF_VM.F90 +++ b/src/Infrastructure/VM/interface/ESMF_VM.F90 @@ -10395,7 +10395,7 @@ function ESMF_VMIdCompare(vmId1, vmId2, keyOnly, rc) endif ! Call into the C++ interface - call c_ESMC_VMIdCompare(vmId1, vmId2, keyOnly, tf, localrc) + call c_ESMC_VMIdCompare(vmId1, vmId2, keyOnlyOpt, tf, localrc) ESMF_VMIdCompare = tf == ESMF_TRUE if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return From 12b430014842d930e83b1458db3ea27b2cf6cc23 Mon Sep 17 00:00:00 2001 From: Gerhard Theurich Date: Wed, 25 Sep 2024 14:16:39 +0000 Subject: [PATCH 025/207] Add development/debugging logs, but have them commented out. --- .../StateReconcile/src/ESMF_StateReconcile.F90 | 14 ++++++++++++-- 1 file changed, 12 insertions(+), 2 deletions(-) diff --git a/src/Superstructure/StateReconcile/src/ESMF_StateReconcile.F90 b/src/Superstructure/StateReconcile/src/ESMF_StateReconcile.F90 index 0aae5d77ef..11996c22a6 100644 --- a/src/Superstructure/StateReconcile/src/ESMF_StateReconcile.F90 +++ b/src/Superstructure/StateReconcile/src/ESMF_StateReconcile.F90 @@ -343,6 +343,8 @@ subroutine ESMF_StateReconcileIsNoop(state, vm, isNoop, rc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & rcToReturn=rc)) return +!call ESMF_VMIdLog(vmId, prefix="vmId: ", rc=rc) + call StateReconcileIsNoopLoc(state, isNoopLoc=isNoopLoc, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & rcToReturn=rc)) return @@ -473,7 +475,7 @@ recursive subroutine StateReconcileIsNoopLoc(stateR, isNoopLoc, rc) ESMF_CONTEXT, rcToReturn=rc)) return endif -call ESMF_LogWrite("processing "//trim(itemNameList(item)), ESMF_LOGMSG_DEBUG, rc=localrc) +!call ESMF_LogWrite("processing "//trim(itemNameList(item)), ESMF_LOGMSG_DEBUG, rc=localrc) call ESMF_VMGetThis(vmItem, thisItem, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & @@ -487,11 +489,19 @@ recursive subroutine StateReconcileIsNoopLoc(stateR, isNoopLoc, rc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & rcToReturn=rc)) return +!call ESMF_VMIdLog(vmIdItem, prefix="vmIdItem: ", rc=rc) + isNoopLoc = ESMF_VMIdCompare(vmIdItem, vmId, keyOnly=.true., & rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & rcToReturn=rc)) return - +#if 0 +block + character(160) :: msgStr + write(msgStr,*) "isNoopLoc: ", isNoopLoc + call ESMF_LogWrite(msgStr, ESMF_LOGMSG_DEBUG, rc=localrc) +end block +#endif if (.not.isNoopLoc) exit ! exit for .false. enddo From 491caf31035e50cb4dbe5516f6deb74fa5d644ad Mon Sep 17 00:00:00 2001 From: Gerhard Theurich Date: Wed, 25 Sep 2024 14:42:52 +0000 Subject: [PATCH 026/207] Add profiling inside ESMF_StateReconcileIsNoop(). --- .../src/ESMF_StateReconcile.F90 | 30 +++++++++++++++++++ 1 file changed, 30 insertions(+) diff --git a/src/Superstructure/StateReconcile/src/ESMF_StateReconcile.F90 b/src/Superstructure/StateReconcile/src/ESMF_StateReconcile.F90 index 11996c22a6..f528d56c39 100644 --- a/src/Superstructure/StateReconcile/src/ESMF_StateReconcile.F90 +++ b/src/Superstructure/StateReconcile/src/ESMF_StateReconcile.F90 @@ -335,6 +335,8 @@ subroutine ESMF_StateReconcileIsNoop(state, vm, isNoop, rc) logical :: isNoopLoc integer :: isNoopLocInt(1), isNoopInt(1) + logical, parameter :: profile = .true. + localrc = ESMF_RC_NOT_IMPL isNoop = .false. ! assume reconcile is needed @@ -345,19 +347,47 @@ subroutine ESMF_StateReconcileIsNoop(state, vm, isNoop, rc) !call ESMF_VMIdLog(vmId, prefix="vmId: ", rc=rc) + if (profile) then + call ESMF_TraceRegionEnter("StateReconcileIsNoopLoc", rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, & + rcToReturn=rc)) return + endif + call StateReconcileIsNoopLoc(state, isNoopLoc=isNoopLoc, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & rcToReturn=rc)) return + if (profile) then + call ESMF_TraceRegionExit("StateReconcileIsNoopLoc", rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, & + rcToReturn=rc)) return + endif + isNoopLocInt(1) = 0 if (isNoopLoc) isNoopLocInt(1) = 1 + if (profile) then + call ESMF_TraceRegionEnter("ESMF_VMAllReduce", rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, & + rcToReturn=rc)) return + endif + ! logical AND reduction, only 1 if all incoming 1 call ESMF_VMAllReduce(vm, isNoopLocInt, isNoopInt, 1, ESMF_REDUCE_MIN, & rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & rcToReturn=rc)) return + if (profile) then + call ESMF_TraceRegionExit("ESMF_VMAllReduce", rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, & + rcToReturn=rc)) return + endif + if (isNoopInt(1)==1) isNoop = .true. ! found that Reconcile is a NOOP ! return successfully From 3f94d1b260808a7a23fa1e2d6e90f2a2d56116ed Mon Sep 17 00:00:00 2001 From: Gerhard Theurich Date: Wed, 25 Sep 2024 17:51:50 +0000 Subject: [PATCH 027/207] Small optimizations for large petCounts. --- src/Infrastructure/VM/src/ESMCI_VM.C | 5 +++++ .../StateReconcile/src/ESMF_StateReconcile.F90 | 8 ++++++++ 2 files changed, 13 insertions(+) diff --git a/src/Infrastructure/VM/src/ESMCI_VM.C b/src/Infrastructure/VM/src/ESMCI_VM.C index db32a1532f..e609585189 100644 --- a/src/Infrastructure/VM/src/ESMCI_VM.C +++ b/src/Infrastructure/VM/src/ESMCI_VM.C @@ -140,6 +140,10 @@ static bool esmfFinalized = false; #undef ESMC_METHOD #define ESMC_METHOD "ESMCI::VMKeyCompare()" static bool VMKeyCompare(unsigned char *vmKey1, unsigned char *vmKey2){ + if (vmKey1==vmKey2) return true; // quick return for identical pointers +#if 1 + return std::memcmp(vmKey1, vmKey2, vmKeyWidth) == 0; +#else int i; for (i=0; i Date: Wed, 25 Sep 2024 12:20:47 -0600 Subject: [PATCH 028/207] Ensure the returned 'vm' object has init code set to indicate it is valid. --- src/Infrastructure/Array/interface/ESMF_ArrayGet.cppF90 | 4 ++++ src/Infrastructure/ArrayBundle/interface/ESMF_ArrayBundle.F90 | 4 ++++ src/Infrastructure/Route/interface/ESMF_RHandle.F90 | 4 ++++ 3 files changed, 12 insertions(+) diff --git a/src/Infrastructure/Array/interface/ESMF_ArrayGet.cppF90 b/src/Infrastructure/Array/interface/ESMF_ArrayGet.cppF90 index 25c2c19faf..208c2d866f 100644 --- a/src/Infrastructure/Array/interface/ESMF_ArrayGet.cppF90 +++ b/src/Infrastructure/Array/interface/ESMF_ArrayGet.cppF90 @@ -583,6 +583,10 @@ type(ESMF_KeywordEnforcer), optional:: keywordEnforcer ! must use keywords below call c_ESMC_GetVM(array, vm, localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return + ! Set init code + call ESMF_VMSetInitCreated(vm, rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, rcToReturn=rc)) return endif ! Obtain DistGrid information diff --git a/src/Infrastructure/ArrayBundle/interface/ESMF_ArrayBundle.F90 b/src/Infrastructure/ArrayBundle/interface/ESMF_ArrayBundle.F90 index c6a4594ee9..0f1eec696b 100644 --- a/src/Infrastructure/ArrayBundle/interface/ESMF_ArrayBundle.F90 +++ b/src/Infrastructure/ArrayBundle/interface/ESMF_ArrayBundle.F90 @@ -1026,6 +1026,10 @@ subroutine ESMF_ArrayBundleGetListAll(arraybundle, keywordEnforcer, & call c_ESMC_GetVM(arraybundle, vm, localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return + ! Set init code on the VM object before returning + call ESMF_VMSetInitCreated(vm, rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, rcToReturn=rc)) return endif ! Return successfully diff --git a/src/Infrastructure/Route/interface/ESMF_RHandle.F90 b/src/Infrastructure/Route/interface/ESMF_RHandle.F90 index b0d57b3a6f..6ebe42dd9e 100644 --- a/src/Infrastructure/Route/interface/ESMF_RHandle.F90 +++ b/src/Infrastructure/Route/interface/ESMF_RHandle.F90 @@ -802,6 +802,10 @@ subroutine ESMF_RouteHandleGetP(routehandle, keywordEnforcer, name, vm, rc) call c_ESMC_GetVM(routehandle, vm, localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return + ! Set init code on the VM object before returning + call ESMF_VMSetInitCreated(vm, rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, rcToReturn=rc)) return endif ! Return successfully From 6b970f44d70e72d7dbcd8ab2690e9f80601496e3 Mon Sep 17 00:00:00 2001 From: Gerhard Theurich Date: Wed, 25 Sep 2024 16:23:14 -0600 Subject: [PATCH 029/207] More complete comment. --- src/Infrastructure/Array/interface/ESMF_ArrayGet.cppF90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Infrastructure/Array/interface/ESMF_ArrayGet.cppF90 b/src/Infrastructure/Array/interface/ESMF_ArrayGet.cppF90 index 208c2d866f..fa64f8a17b 100644 --- a/src/Infrastructure/Array/interface/ESMF_ArrayGet.cppF90 +++ b/src/Infrastructure/Array/interface/ESMF_ArrayGet.cppF90 @@ -583,7 +583,7 @@ type(ESMF_KeywordEnforcer), optional:: keywordEnforcer ! must use keywords below call c_ESMC_GetVM(array, vm, localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return - ! Set init code + ! Set init code on the VM object before returning call ESMF_VMSetInitCreated(vm, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return From a1d6d490cfc96e1cfa6d8fc09ecaa2b220836702 Mon Sep 17 00:00:00 2001 From: Gerhard Theurich Date: Wed, 25 Sep 2024 16:24:39 -0600 Subject: [PATCH 030/207] Make ESMF_ReconcileExchgAttributes internally public for testing. Rework the ESMF_StateReconcileUTest to correctly abide to unison rule and adjust testing. --- .../src/ESMF_StateReconcile.F90 | 17 +- .../tests/ESMF_StateReconcileUTest.F90 | 340 ++++++++++++------ 2 files changed, 252 insertions(+), 105 deletions(-) diff --git a/src/Superstructure/StateReconcile/src/ESMF_StateReconcile.F90 b/src/Superstructure/StateReconcile/src/ESMF_StateReconcile.F90 index ed296abb3c..d693fe03f2 100644 --- a/src/Superstructure/StateReconcile/src/ESMF_StateReconcile.F90 +++ b/src/Superstructure/StateReconcile/src/ESMF_StateReconcile.F90 @@ -83,6 +83,7 @@ module ESMF_StateReconcileMod ! to be called by ESMF users. ! public :: ESMF_ReconcileDeserialize, ESMF_ReconcileSerialize ! public :: ESMF_ReconcileSendItems + public :: ESMF_ReconcileExchgAttributes !EOPI @@ -227,6 +228,14 @@ subroutine ESMF_StateReconcile(state, vm, rc) if (isNoop) then call ESMF_LogWrite("returning early with isNoop=.true.", ESMF_LOGMSG_DEBUG, rc=localrc) +#if 0 + !TODO: this is copied here for the old attribute reconciliation behavior + !TODO: remove now that we decided that's not what we want to happen + call ESMF_ReconcileExchgAttributes (state, vm, rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, & + rcToReturn=rc)) return +#endif #if 1 ! successful early return because of NOOP condition if (present(rc)) rc = ESMF_SUCCESS @@ -511,7 +520,7 @@ recursive subroutine StateReconcileIsNoopLoc(stateR, isNoopLoc, rc) ESMF_CONTEXT, rcToReturn=rc)) return endif -!call ESMF_LogWrite("processing "//trim(itemNameList(item)), ESMF_LOGMSG_DEBUG, rc=localrc) +call ESMF_LogWrite("processing "//trim(itemNameList(item)), ESMF_LOGMSG_DEBUG, rc=localrc) call ESMF_VMGetThis(vmItem, thisItem, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & @@ -525,7 +534,7 @@ recursive subroutine StateReconcileIsNoopLoc(stateR, isNoopLoc, rc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & rcToReturn=rc)) return -!call ESMF_VMIdLog(vmIdItem, prefix="vmIdItem: ", rc=rc) +call ESMF_VMIdLog(vmIdItem, prefix="vmIdItem: ", rc=rc) isNoopLoc = ESMF_VMIdCompare(vmIdItem, vmId, keyOnly=.true., & rc=localrc) @@ -1145,6 +1154,9 @@ subroutine ESMF_StateReconcile_driver (state, vm, attreconflag, rc) rcToReturn=rc)) return endif ! ------------------------------------------------------------------------- +#if 1 + !TODO: Turn this off, and probably remove completely from StateReconcile + !TODO: But first make sure the NUOPC protos still all work!!!! if (attreconflag == ESMF_ATTRECONCILE_ON) then if (trace) then call ESMF_ReconcileDebugPrint (ESMF_METHOD // & @@ -1156,6 +1168,7 @@ subroutine ESMF_StateReconcile_driver (state, vm, attreconflag, rc) ESMF_CONTEXT, & rcToReturn=rc)) return end if +#endif state%statep%reconcileneededflag = .false. ! ------------------------------------------------------------------------- if (profile) then diff --git a/src/Superstructure/StateReconcile/tests/ESMF_StateReconcileUTest.F90 b/src/Superstructure/StateReconcile/tests/ESMF_StateReconcileUTest.F90 index a55b9c90bd..c60546b902 100644 --- a/src/Superstructure/StateReconcile/tests/ESMF_StateReconcileUTest.F90 +++ b/src/Superstructure/StateReconcile/tests/ESMF_StateReconcileUTest.F90 @@ -534,6 +534,93 @@ subroutine comp2_sg_final(gcomp, istate, ostate, clock, rc) end subroutine comp2_sg_final +!------------------------------------------------------------------------------ + +! Array added to exportState + +subroutine comp1_init_simple(gcomp, istate, ostate, clock, rc) + type(ESMF_GridComp) :: gcomp + type(ESMF_State) :: istate, ostate + type(ESMF_Clock) :: clock + integer, intent(out) :: rc + + type(ESMF_ArraySpec) :: arrayspec + type(ESMF_Distgrid) :: distgrid + type(ESMF_Array) :: array + + rc = ESMF_SUCCESS + + call ESMF_ArraySpecSet(arrayspec, typekind=ESMF_TYPEKIND_R8, rank=2, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=FILENAME)) & + return ! bail out + + distgrid = ESMF_DistGridCreate(minIndex=(/1,1/), maxIndex=(/15,23/), & + regDecomp=(/2,2/), rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=FILENAME)) & + return ! bail out + + array = ESMF_ArrayCreate(arrayspec=arrayspec, & + name="Array_for_reconciling", distgrid=distgrid, & + indexflag=ESMF_INDEX_GLOBAL, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=FILENAME)) & + return ! bail out + + call ESMF_StateAdd (ostate, [array], rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=FILENAME)) & + return ! bail out + +end subroutine comp1_init_simple + +!------------------------------------------------------------------------------ + +! Nested State with Field added to exportState + +subroutine comp1_init_nested(gcomp, istate, ostate, clock, rc) + type(ESMF_GridComp) :: gcomp + type(ESMF_State) :: istate, ostate + type(ESMF_Clock) :: clock + integer, intent(out) :: rc + + type(ESMF_State) :: state_nested + type(ESMF_Field) :: field_nested + + rc = ESMF_SUCCESS + + state_nested = ESMF_StateCreate(name='state_nested', rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=FILENAME)) & + return ! bail out + + field_nested = ESMF_FieldEmptyCreate(name='nested Field', rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=FILENAME)) & + return ! bail out + + call ESMF_StateAdd(state_nested, fieldList=[field_nested], rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=FILENAME)) & + return ! bail out + + call ESMF_StateAdd(ostate, nestedStateList=[state_nested], rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=FILENAME)) & + return ! bail out + +end subroutine comp1_init_nested + +!------------------------------------------------------------------------------ subroutine StateLog(state, rc) type(ESMF_State) :: state @@ -688,9 +775,8 @@ program ESMF_StateReconcileUTest type(ESMF_Field) :: field_attr(5) type(ESMF_Field) :: field_attr_new(size (field_attr)) type(ESMF_Field) :: field_sg1, field_sg2 - type(ESMF_FieldBundle) :: fb_attr, fb_attr_new type(ESMF_Grid) :: grid_shared, grid_sg1, grid_sg2 - type(ESMF_VM) :: vm + type(ESMF_VM) :: vm, vm0 character(len=ESMF_MAXSTR) :: comp1name, comp2name, statename, fieldname character(len=ESMF_MAXSTR) :: array1name character(len=ESMF_MAXSTR) :: fb_name @@ -702,7 +788,7 @@ program ESMF_StateReconcileUTest ! individual test failure message character(ESMF_MAXSTR) :: failMsg character(ESMF_MAXSTR) :: name - integer :: result = 0, localPet, petCount + integer :: result = 0, localPet, petCount, testPet !------------------------------------------------------------------------- @@ -1057,7 +1143,6 @@ program ESMF_StateReconcileUTest write(name, *) "Creating a State" call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE) - ! In SetServices() the VM for each component is initialized. ! Normally you would call SetEntryPoint inside set services, ! but to make this test very short, they are called inline below. @@ -1375,43 +1460,58 @@ program ESMF_StateReconcileUTest !------------------------------------------------------------------------- !NEX_UTest_Multi_Proc_Only - state2 = ESMF_StateCreate () + state2 = ESMF_StateCreate() write(failMsg, *) "Did not return ESMF_SUCCESS" write(name, *) "Calling StateCreate for rereconcile tests" call ESMF_Test((rc == ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE) !------------------------------------------------------------------------- !NEX_UTest_Multi_Proc_Only - rc = ESMF_SUCCESS - array1name = 'Array_for_reconciling' - if (localPet == 0) then - call ESMF_ArraySpecSet(arrayspec, typekind=ESMF_TYPEKIND_R8, rank=2, & - rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT) - distgrid = ESMF_DistGridCreate(minIndex=(/1,1/), maxIndex=(/15,23/), & - regDecomp=(/2,2/), rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT) - array1 = ESMF_ArrayCreate(arrayspec=arrayspec, name=array1name, & - distgrid=distgrid, & - indexflag=ESMF_INDEX_GLOBAL, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT) - call ESMF_StateAdd (state2, (/array1/), rc=rc) - end if + ! component on PET 0 + comp1 = ESMF_GridCompCreate(petList=[0], rc=rc) write(failMsg, *) "Did not return ESMF_SUCCESS" - write(name, *) "Creating PET 0 Array for rereconcile tests" - call ESMF_Test((rc == ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE) + write(name, *) "Creating a Gridded Component" + call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE) + + ! In SetServices() the VM for each component is initialized. + ! Normally you would call SetEntryPoint inside set services, + ! but to make this test very short, they are called inline below. + + !------------------------------------------------------------------------- + !NEX_UTest_Multi_Proc_Only + call ESMF_GridCompSetServices(comp1, userRoutine=comp_dummy, userrc=urc, rc=rc) + write(failMsg, *) "Did not return ESMF_SUCCESS" + write(name, *) "Calling GridCompSetServices" + call ESMF_Test(((rc.eq.ESMF_SUCCESS).and.(urc.eq.ESMF_SUCCESS)), name, failMsg, result, ESMF_SRCLINE) + + !------------------------------------------------------------------------- + !NEX_UTest_Multi_Proc_Only + call ESMF_GridCompSetEntryPoint(comp1, ESMF_METHOD_INITIALIZE, & + userRoutine=comp1_init_simple, rc=rc) + write(failMsg, *) "Did not return ESMF_SUCCESS" + write(name, *) "Calling GridCompSetEntryPoint" + call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE) !------------------------------------------------------------------------- !NEX_UTest_Multi_Proc_Only - call ESMF_StateReconcile (state2, rc=rc) + ! creating and adding array to the exportState on PET 0 + call ESMF_GridCompInitialize(comp1, exportState=state2, userrc=urc, rc=rc) + write(failMsg, *) "Did not return ESMF_SUCCESS" + write(name, *) "Calling GridCompInitialize" + call ESMF_Test(((rc.eq.ESMF_SUCCESS).and.(urc.eq.ESMF_SUCCESS)), name, failMsg, result, ESMF_SRCLINE) + + !------------------------------------------------------------------------- + !NEX_UTest_Multi_Proc_Only + call ESMF_StateReconcile(state2, rc=rc) write(failMsg, *) "Did not return ESMF_SUCCESS" write(name, *) "Calling initial reconcile for rereconcile tests" call ESMF_Test((rc == ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE) !------------------------------------------------------------------------- !NEX_UTest_Multi_Proc_Only - call ESMF_StateGet (state2, itemName=array1name, & - array=array1_alternate, rc=rc) + array1name = "Array_for_reconciling" + call ESMF_StateGet(state2, itemName=array1name, array=array1_alternate, & + rc=rc) write(failMsg, *) "Did not return ESMF_SUCCESS" write(name, *) "PET", localpet, ": Calling StateGet to access proxies" call ESMF_Test((rc == ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE) @@ -1419,7 +1519,7 @@ program ESMF_StateReconcileUTest !------------------------------------------------------------------------- !NEX_UTest_Multi_Proc_Only if (localPet == 0) then - call ESMF_StateRemove (state2, itemNameList=(/array1name/), rc=rc) + call ESMF_StateRemove(state2, itemNameList=[array1name], rc=rc) end if write(failMsg, *) "Did not return ESMF_SUCCESS" write(name, *) "Removing non-proxy item test" @@ -1427,19 +1527,32 @@ program ESMF_StateReconcileUTest !------------------------------------------------------------------------- !NEX_UTest_Multi_Proc_Only - call ESMF_StateReconcile (state2, rc=rc) + call ESMF_StateReconcile(state2, rc=rc) write(failMsg, *) "Did not return ESMF_SUCCESS" write(name, *) "Re-reconciling State test" call ESMF_Test((rc == ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE) !------------------------------------------------------------------------- !NEX_UTest_Multi_Proc_Only - call ESMF_StateGet (state2, itemName=array1name, & - array=array2, rc=rc) + call ESMF_StateGet(state2, itemName=array1name, array=array2, rc=rc) write(failMsg, *) "Returned ESMF_SUCCESS by mistake" write(name, *) "Checking for empty State tests" call ESMF_Test((rc /= ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE) + !------------------------------------------------------------------------- + !NEX_UTest_Multi_Proc_Only + call ESMF_StateDestroy(state2, rc=rc) + write(failMsg, *) "Did not return ESMF_SUCCESS" + write(name, *) "StateDestroy test" + call ESMF_Test((rc == ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE) + + !------------------------------------------------------------------------- + !NEX_UTest_Multi_Proc_Only + call ESMF_GridCompDestroy(comp1, rc=rc) + write(failMsg, *) "Did not return ESMF_SUCCESS" + write(name, *) "GridCompDestroy test" + call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE) + !------------------------------------------------------------------------- !------------------------------------------------------------------------- @@ -1454,63 +1567,58 @@ program ESMF_StateReconcileUTest !------------------------------------------------------------------------- !NEX_UTest_Multi_Proc_Only - state3 = ESMF_StateCreate (name='state3', rc=rc) + state3 = ESMF_StateCreate(name='state3', rc=rc) write(failMsg, *) "Did not return ESMF_SUCCESS" - write(name, *) "Calling StateCreate for top-level State tests" + write(name, *) "Calling StateCreate for rereconcile tests" call ESMF_Test((rc == ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE) - if (localPET /= 0) then - rc = ESMF_SUCCESS - end if !------------------------------------------------------------------------- !NEX_UTest_Multi_Proc_Only - if (localPET == 0) then - state_nested = ESMF_StateCreate (name='state_nested', rc=rc) - end if + ! component on PET 0 + comp1 = ESMF_GridCompCreate(petList=[0], rc=rc) write(failMsg, *) "Did not return ESMF_SUCCESS" - write(name, *) "Calling StateCreate for nested State tests" - call ESMF_Test((rc == ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE) + write(name, *) "Creating a Gridded Component" + call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE) + + ! In SetServices() the VM for each component is initialized. + ! Normally you would call SetEntryPoint inside set services, + ! but to make this test very short, they are called inline below. !------------------------------------------------------------------------- !NEX_UTest_Multi_Proc_Only - if (localPET == 0) then - field_nested = ESMF_FieldEmptyCreate (name='nested Field', rc=rc) - end if + call ESMF_GridCompSetServices(comp1, userRoutine=comp_dummy, userrc=urc, rc=rc) write(failMsg, *) "Did not return ESMF_SUCCESS" - write(name, *) "Calling FieldEmptyCreate for nested State test" - call ESMF_Test((rc == ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE) + write(name, *) "Calling GridCompSetServices" + call ESMF_Test(((rc.eq.ESMF_SUCCESS).and.(urc.eq.ESMF_SUCCESS)), name, failMsg, result, ESMF_SRCLINE) !------------------------------------------------------------------------- !NEX_UTest_Multi_Proc_Only - if (localPET == 0) then - call ESMF_StateAdd (state_nested, fieldList=(/ field_nested /), rc=rc) - end if + call ESMF_GridCompSetEntryPoint(comp1, ESMF_METHOD_INITIALIZE, & + userRoutine=comp1_init_nested, rc=rc) write(failMsg, *) "Did not return ESMF_SUCCESS" - write(name, *) "Calling StateAdd of nested Field test" - call ESMF_Test((rc == ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE) + write(name, *) "Calling GridCompSetEntryPoint" + call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE) !------------------------------------------------------------------------- !NEX_UTest_Multi_Proc_Only - if (localPET == 0) then - call ESMF_StateAdd (state3, nestedStateList=(/ state_nested /), rc=rc) - ! call ESMF_StatePrint (state3, nestedFlag=.true.) - end if + ! creating and adding nested state with field to the exportState on PET 0 + call ESMF_GridCompInitialize(comp1, exportState=state3, userrc=urc, rc=rc) write(failMsg, *) "Did not return ESMF_SUCCESS" - write(name, *) "Calling StateAdd of nested State test" - call ESMF_Test((rc == ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE) + write(name, *) "Calling GridCompInitialize" + call ESMF_Test(((rc.eq.ESMF_SUCCESS).and.(urc.eq.ESMF_SUCCESS)), name, failMsg, result, ESMF_SRCLINE) !------------------------------------------------------------------------- !NEX_UTest_Multi_Proc_Only - call ESMF_StateReconcile (state=state3, rc=rc) + call ESMF_StateReconcile(state=state3, rc=rc) write(failMsg, *) "Did not return ESMF_SUCCESS" write(name, *) "Calling StateReconcile of nested State test" call ESMF_Test((rc == ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE) - ! PETs 1-n should now be able to access the nested Field proxy item + ! PETs 1-n should now be able to access the nested Field proxy item !------------------------------------------------------------------------- !NEX_UTest_Multi_Proc_Only - call ESMF_StateGet (state=state3, & + call ESMF_StateGet(state=state3, & itemname='state_nested/nested Field', & field=field_dummy, & rc=rc) @@ -1520,7 +1628,7 @@ program ESMF_StateReconcileUTest !------------------------------------------------------------------------- !NEX_UTest_Multi_Proc_Only - call ESMF_StateGet (state=state3, & + call ESMF_StateGet(state=state3, & itemname='state_nested/nested Field_badname', & field=field_dummy, & rc=rc) @@ -1529,8 +1637,48 @@ program ESMF_StateReconcileUTest call ESMF_Test((rc /= ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE) !------------------------------------------------------------------------- - ! Test with attribute reconcile turned on + !NEX_UTest_Multi_Proc_Only + call ESMF_StateDestroy(state3, rc=rc) + write(failMsg, *) "Did not return ESMF_SUCCESS" + write(name, *) "StateDestroy test" + call ESMF_Test((rc == ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE) + + !------------------------------------------------------------------------- + !NEX_UTest_Multi_Proc_Only + call ESMF_GridCompDestroy(comp1, rc=rc) + write(failMsg, *) "Did not return ESMF_SUCCESS" + write(name, *) "GridCompDestroy test" + call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE) + + !------------------------------------------------------------------------- + ! Test attribute reconcililiation + !------------------------------------------------------------------------- + +!@@@ + + !------------------------------------------------------------------------- + !NEX_UTest_Multi_Proc_Only + ! component on PET 0 -> needed for consistent VM + comp1 = ESMF_GridCompCreate(petList=[0], rc=rc) + write(failMsg, *) "Did not return ESMF_SUCCESS" + write(name, *) "Creating a Gridded Component" + call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE) + + ! In SetServices() the VM for each component is initialized. + !------------------------------------------------------------------------- + !NEX_UTest_Multi_Proc_Only + call ESMF_GridCompSetServices(comp1, userRoutine=comp_dummy, userrc=urc, rc=rc) + write(failMsg, *) "Did not return ESMF_SUCCESS" + write(name, *) "Calling GridCompSetServices" + call ESMF_Test(((rc.eq.ESMF_SUCCESS).and.(urc.eq.ESMF_SUCCESS)), name, failMsg, result, ESMF_SRCLINE) + + !------------------------------------------------------------------------- + !NEX_UTest_Multi_Proc_Only + write(failMsg, *) "Did not return ESMF_SUCCESS" + write(name, *) "Access the VM that has one PET on 0" + call ESMF_GridCompGet(comp1, vm=vm0, rc=rc) + call ESMF_Test((rc == ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE) !------------------------------------------------------------------------- !NEX_UTest_Multi_Proc_Only @@ -1543,8 +1691,8 @@ program ESMF_StateReconcileUTest !------------------------------------------------------------------------- !NEX_UTest_Multi_Proc_Only write(failMsg, *) "Did not return ESMF_SUCCESS" - write(name, *) "Reconciling state with Attribute reconciling turned on" - call ESMF_StateReconcile (state_attr, rc=rc) + write(name, *) "Reconciling state before adding Attributes" + call ESMF_StateReconcile(state_attr, rc=rc) call ESMF_Test((rc == ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE) !------------------------------------------------------------------------- @@ -1568,13 +1716,31 @@ program ESMF_StateReconcileUTest !------------------------------------------------------------------------- !NEX_UTest_Multi_Proc_Only write(failMsg, *) "Did not return ESMF_SUCCESS" - write(name, *) "Verifying reconciled Base attributes test" + write(name, *) "Verifying StateReconcile does not mess with Base attributes" write (temppet_str, '(i4)') localPet + call ESMF_AttributeGet (state_attr, & + name='Base PET ' // trim (adjustl (temppet_str)), & + valueList=attr_val, rc=rc) + call ESMF_Test((attr_val(1)==localPet), name, failMsg, result, ESMF_SRCLINE) + + !------------------------------------------------------------------------- + !NEX_UTest_Multi_Proc_Only + write(failMsg, *) "Did not return ESMF_SUCCESS" + write(name, *) "ReconcileExchgAttributes to exchange State attributes test" + call ESMF_ReconcileExchgAttributes(state_attr, vm, rc=rc) + call ESMF_Test((rc == ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE) + + !------------------------------------------------------------------------- + !NEX_UTest_Multi_Proc_Only + write(failMsg, *) "Did not return ESMF_SUCCESS" + write(name, *) "Verifying exchange reconciled Base attributes test" + testPet = mod(localPet+1, petCount) + write (temppet_str, '(i4)') testPet call ESMF_AttributeGet (state_attr, & name='Base PET ' // trim (adjustl (temppet_str)), & valueList=attr_val, & rc=rc) - if (attr_val(1) /= localPet) rc = ESMF_FAILURE + if (attr_val(1) /= testPet) rc = ESMF_FAILURE call ESMF_Test((rc == ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE) !------------------------------------------------------------------------- @@ -1585,18 +1751,18 @@ program ESMF_StateReconcileUTest if (localPet == 0) then do, i=1, size (field_attr) write (fieldname, '(a,i4)') 'PET 0 Field', i - field_attr(i) = ESMF_FieldEmptyCreate (name=fieldname, rc=rc) - if (rc /= ESMF_SUCCESS) go to 50 + field_attr(i) = ESMF_FieldEmptyCreate(name=fieldname, vm=vm0, rc=rc) + if (rc /= ESMF_SUCCESS) goto 50 call ESMF_AttributeSet (field_attr(i), & name=trim (fieldname) // ' attribute', & valueList=(/ i /), & rc=rc) - if (rc /= ESMF_SUCCESS) go to 50 + if (rc /= ESMF_SUCCESS) goto 50 end do call ESMF_StateAdd (state_attr, field_attr, rc=rc) - if (rc /= ESMF_SUCCESS) go to 50 + if (rc /= ESMF_SUCCESS) goto 50 end if 50 continue @@ -1642,42 +1808,10 @@ program ESMF_StateReconcileUTest !------------------------------------------------------------------------- !NEX_UTest_Multi_Proc_Only + call ESMF_GridCompDestroy(comp1, rc=rc) ! also shuts down vm0 write(failMsg, *) "Did not return ESMF_SUCCESS" - write(name, *) "Create a FieldBundle with Attributes on PET 0 test" - fb_name = 'my fields' - if (localPet == 0) then - fb_attr = ESMF_FieldBundleCreate ( & - fieldList=(/field_attr/), & - name=fb_name, & - rc=rc) - if (rc /= ESMF_SUCCESS) go to 55 - - call ESMF_StateAdd (state_attr, (/ fb_attr /), rc=rc) - if (rc /= ESMF_SUCCESS) go to 55 - else - rc = ESMF_SUCCESS - end if - - 55 continue - call ESMF_Test((rc == ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE) - - !------------------------------------------------------------------------- - !NEX_UTest_Multi_Proc_Only - write(failMsg, *) "Did not return ESMF_SUCCESS" - write(name, *) "Reconciling state with FieldBundle and Attributes test" - call ESMF_StateReconcile (state_attr, rc=rc) - call ESMF_Test((rc == ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE) - - !------------------------------------------------------------------------- - !NEX_UTest_Multi_Proc_Only - write(failMsg, *) "Did not return ESMF_SUCCESS" - write(name, *) "Access reconciled FieldBundle test" - call ESMF_StateGet (state_attr, & - itemName=fb_name, & - fieldBundle=fb_attr_new, & - rc=rc) - call ESMF_Test((rc == ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE) - + write(name, *) "GridCompDestroy test" + call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE) !------------------------------------------------------------------------- ! Fields with shared Grids From e05fce68f0fe52316e5327978a8526903fe62acf Mon Sep 17 00:00:00 2001 From: Gerhard Theurich Date: Wed, 25 Sep 2024 16:27:59 -0600 Subject: [PATCH 031/207] Use public ESMF_StateLog() instead of custom code. --- .../tests/ESMF_StateReconcileUTest.F90 | 124 +----------------- 1 file changed, 5 insertions(+), 119 deletions(-) diff --git a/src/Superstructure/StateReconcile/tests/ESMF_StateReconcileUTest.F90 b/src/Superstructure/StateReconcile/tests/ESMF_StateReconcileUTest.F90 index c60546b902..030ceb4b53 100644 --- a/src/Superstructure/StateReconcile/tests/ESMF_StateReconcileUTest.F90 +++ b/src/Superstructure/StateReconcile/tests/ESMF_StateReconcileUTest.F90 @@ -622,120 +622,6 @@ end subroutine comp1_init_nested !------------------------------------------------------------------------------ -subroutine StateLog(state, rc) - type(ESMF_State) :: state - integer, intent(out) :: rc - - integer :: i, j - integer :: iCount, jCount - character(ESMF_MAXSTR), allocatable :: itemNameList(:) - type(ESMF_FieldBundle) :: fb - type(ESMF_Field), allocatable :: fieldList(:) - character(ESMF_MAXSTR) :: stateName, fieldName, gridName - type(ESMF_Grid) :: grid - character(800) :: msgString - type(ESMF_StateItem_Flag) :: itemType - type(ESMF_Field) :: field - - rc=ESMF_SUCCESS - - call ESMF_StateGet(state, itemCount=iCount, name=stateName, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=FILENAME)) & - return ! bail out - - allocate(itemNameList(iCount)) - - call ESMF_StateGet(state, itemNameList=itemNameList, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=FILENAME)) & - return ! bail out - - do i=1, iCount - call ESMF_StateGet(state, itemName=itemNameList(i), itemType=itemType, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=FILENAME)) & - return ! bail out - - if (itemType == ESMF_STATEITEM_FIELDBUNDLE) then - call ESMF_StateGet(state, itemName=itemNameList(i), fieldBundle=fb, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=FILENAME)) & - return ! bail out - call ESMF_FieldBundleGet(fb, fieldCount=jCount, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=FILENAME)) & - return ! bail out - allocate(fieldList(jCount)) - call ESMF_FieldBundleGet(fb, fieldList=fieldList, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=FILENAME)) & - return ! bail out - do j=1, jCount - call ESMF_FieldGet(fieldList(j), name=fieldName, grid=grid, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=FILENAME)) & - return ! bail out - call ESMF_GridGet(grid, name=gridName, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=FILENAME)) & - return ! bail out - write(msgString,*) trim(stateName)//": "//trim(itemNameList(i))//": "//trim(fieldName)//& - ": "//trim(gridName) - call ESMF_LogWrite(msgString, ESMF_LOGMSG_DEBUG, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=FILENAME)) & - return ! bail out - enddo - deallocate(fieldList) - elseif (itemType == ESMF_STATEITEM_FIELD) then - call ESMF_StateGet(state, itemName=itemNameList(i), field=field, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=FILENAME)) & - return ! bail out -#if 0 - call ESMF_FieldGet(field, name=fieldName, grid=grid, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=FILENAME)) &FAIL - return ! bail out - call ESMF_GridGet(grid, name=gridName, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=FILENAME)) & - return ! bail out - write(msgString,*) trim(stateName)//": "//trim(itemNameList(i))//": "//trim(fieldName)//& - ": "//trim(gridName) - call ESMF_LogWrite(msgString, ESMF_LOGMSG_DEBUG, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=FILENAME)) & - return ! bail out -#else - write(msgString,*) trim(stateName)//": "//trim(itemNameList(i)) - call ESMF_LogWrite(msgString, ESMF_LOGMSG_DEBUG, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=FILENAME)) & - return ! bail out -#endif - endif - enddo - deallocate(itemNameList) - -end subroutine - - end module ESMF_StateReconcileUTest_Mod @@ -923,7 +809,7 @@ program ESMF_StateReconcileUTest write(name, *) "Calling GridCompSetEntryPoint" call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE) -call StateLog(state1, rc=rc) +call ESMF_StateLog(state1, rc=rc) if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT) !------------------------------------------------------------------------- @@ -933,7 +819,7 @@ program ESMF_StateReconcileUTest write(name, *) "Calling GridCompInitialize" call ESMF_Test(((rc.eq.ESMF_SUCCESS).and.(urc.eq.ESMF_SUCCESS)), name, failMsg, result, ESMF_SRCLINE) -call StateLog(state1, rc=rc) +call ESMF_StateLog(state1, rc=rc) if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT) !------------------------------------------------------------------------- @@ -943,7 +829,7 @@ program ESMF_StateReconcileUTest write(name, *) "Calling GridCompInitialize" call ESMF_Test(((rc.eq.ESMF_SUCCESS).and.(urc.eq.ESMF_SUCCESS)), name, failMsg, result, ESMF_SRCLINE) -call StateLog(state1, rc=rc) +call ESMF_StateLog(state1, rc=rc) if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT) !------------------------------------------------------------------------- @@ -985,7 +871,7 @@ program ESMF_StateReconcileUTest write(name, *) "Calling StateReconcile in concurrent mode" call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE) -call StateLog(state1, rc=rc) +call ESMF_StateLog(state1, rc=rc) if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT) !------------------------------------------------------------------------- @@ -1052,7 +938,7 @@ program ESMF_StateReconcileUTest write(name, *) "Calling 2nd StateReconcile in concurrent mode" call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE) -call StateLog(state1, rc=rc) +call ESMF_StateLog(state1, rc=rc) if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT) !------------------------------------------------------------------------- From 5568ef86f277649c3aa1f2fb94fa519afbf49ec7 Mon Sep 17 00:00:00 2001 From: Gerhard Theurich Date: Wed, 25 Sep 2024 17:04:47 -0600 Subject: [PATCH 032/207] Remove calls into ESMF_ReconcileExchgAttributes from ESMF_StateReconcile(). This operation is not needed for standard following ESMF and NUOPC code. --- .../src/ESMF_StateReconcile.F90 | 42 ------------------- 1 file changed, 42 deletions(-) diff --git a/src/Superstructure/StateReconcile/src/ESMF_StateReconcile.F90 b/src/Superstructure/StateReconcile/src/ESMF_StateReconcile.F90 index d693fe03f2..6830315611 100644 --- a/src/Superstructure/StateReconcile/src/ESMF_StateReconcile.F90 +++ b/src/Superstructure/StateReconcile/src/ESMF_StateReconcile.F90 @@ -228,14 +228,6 @@ subroutine ESMF_StateReconcile(state, vm, rc) if (isNoop) then call ESMF_LogWrite("returning early with isNoop=.true.", ESMF_LOGMSG_DEBUG, rc=localrc) -#if 0 - !TODO: this is copied here for the old attribute reconciliation behavior - !TODO: remove now that we decided that's not what we want to happen - call ESMF_ReconcileExchgAttributes (state, vm, rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, & - rcToReturn=rc)) return -#endif #if 1 ! successful early return because of NOOP condition if (present(rc)) rc = ESMF_SUCCESS @@ -1144,41 +1136,7 @@ subroutine ESMF_StateReconcile_driver (state, vm, attreconflag, rc) ! ------------------------------------------------------------------------- if (meminfo) call ESMF_VMLogMemInfo ("after 7.) Deserialize received objects and create proxies") - ! ------------------------------------------------------------------------- - ! 8.) Attributes on the State itself - ! ------------------------------------------------------------------------- - if (profile) then - call ESMF_TraceRegionEnter("8.) Attributes on the State itself", rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, & - rcToReturn=rc)) return - endif - ! ------------------------------------------------------------------------- -#if 1 - !TODO: Turn this off, and probably remove completely from StateReconcile - !TODO: But first make sure the NUOPC protos still all work!!!! - if (attreconflag == ESMF_ATTRECONCILE_ON) then - if (trace) then - call ESMF_ReconcileDebugPrint (ESMF_METHOD // & - ': *** Step 8 - Exchange Base Attributes', ask=.false.) - call ESMF_VMBarrier (vm) - end if - call ESMF_ReconcileExchgAttributes (state, vm, rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, & - rcToReturn=rc)) return - end if -#endif state%statep%reconcileneededflag = .false. - ! ------------------------------------------------------------------------- - if (profile) then - call ESMF_TraceRegionExit("8.) Attributes on the State itself", rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, & - rcToReturn=rc)) return - endif - ! ------------------------------------------------------------------------- - if (meminfo) call ESMF_VMLogMemInfo ("after 8.) Attributes on the State itself") if (trace) then call ESMF_ReconcileDebugPrint (ESMF_METHOD // ': Complete!') From bf55e926db9905306cc14f4ee7ad7debf848e70c Mon Sep 17 00:00:00 2001 From: Gerhard Theurich Date: Wed, 25 Sep 2024 19:30:57 -0600 Subject: [PATCH 033/207] Remove ESMF_StateIsReconcileNeeded(), which was much to basic to be useful for most real world problems. It is the job of ESMF_StateReconcile() to figure out how much needs to be done to guarantee consistency across all PETs that are being reconciled. --- src/Superstructure/State/src/ESMF_State.F90 | 1 - .../State/src/ESMF_StateAPI.cppF90 | 137 ------------------ .../State/src/ESMF_StateInternals.cppF90 | 4 - .../State/src/ESMF_StateItem.F90 | 1 - .../src/ESMF_StateReconcile.F90 | 2 - .../tests/ESMF_StateReconcileUTest.F90 | 91 +----------- 6 files changed, 2 insertions(+), 234 deletions(-) diff --git a/src/Superstructure/State/src/ESMF_State.F90 b/src/Superstructure/State/src/ESMF_State.F90 index a1c5c159fc..dd48f8f4b4 100644 --- a/src/Superstructure/State/src/ESMF_State.F90 +++ b/src/Superstructure/State/src/ESMF_State.F90 @@ -62,7 +62,6 @@ module ESMF_StateMod public ESMF_StateAdd, ESMF_StateAddReplace public ESMF_StateGet - public ESMF_StateIsReconcileNeeded public ESMF_StateLog diff --git a/src/Superstructure/State/src/ESMF_StateAPI.cppF90 b/src/Superstructure/State/src/ESMF_StateAPI.cppF90 index 7a7dd1c9e1..317f3afc28 100644 --- a/src/Superstructure/State/src/ESMF_StateAPI.cppF90 +++ b/src/Superstructure/State/src/ESMF_StateAPI.cppF90 @@ -84,7 +84,6 @@ module ESMF_StateAPIMod public ESMF_StateAdd, ESMF_StateAddReplace public ESMF_StateGet public ESMF_StateIsCreated - public ESMF_StateIsReconcileNeeded public ESMF_StateLog @@ -1700,140 +1699,6 @@ type(ESMF_KeywordEnforcer), optional:: keywordEnforcer ! must use keywords below !------------------------------------------------------------------------------ - - -!------------------------------------------------------------------------------ -^undef ESMF_METHOD -^define ESMF_METHOD "ESMF_StateIsReconcileNeeded" -!BOPI -! !IROUTINE: ESMF_StateIsReconcileNeeded -- Return logical true if reconciliation needed -! -! !INTERFACE: - function ESMF_StateIsReconcileNeeded(state, keywordEnforcer, collectiveflag, vm, rc) -! -! !RETURN VALUE: - logical :: ESMF_StateIsReconcileNeeded -! -! !ARGUMENTS: - type(ESMF_State), intent(in) :: state - type(ESMF_KeywordEnforcer), optional:: keywordEnforcer ! must use keywords below - logical, intent(in), optional :: collectiveflag - type(ESMF_VM), intent(in), optional :: vm - integer, intent(out), optional :: rc - -! -! !DESCRIPTION: -! Returns true if the {\tt state} needs to be reconciled in order -! to be coherent across PETs. By default, this is a local call. -! Optionally, the {\tt collectiveflag} may be set to collectively -! determine whether other PETs in the VM may need to be reconciled. -! -! The arguments are: -! \begin{description} -! \item[state] -! {\tt ESMF\_State} to query. -! \item[{[collectiveflag]}] -! Perform a collective style call across all PETs in the VM. -! \item[vm] -! The current {\tt ESMF\_VM} (virtual machine). All PETs in this -! {\tt ESMF\_VM} will exchange information about objects which might -! only be known to one or more PETs, and ensure all PETs in this VM -! have a consistent view of the object list in this {\tt ESMF\_State}. -! Required when {\tt collectiveflag} is set to {\tt .true.}. -! \item[{[rc]}] -! Return code; equals {\tt ESMF\_SUCCESS} if there are no errors. -! \end{description} -! -!EOPI - - logical :: localrecflag - integer :: localrc - integer :: commsend, commrecv - - ESMF_StateIsReconcileNeeded = .false. - - ! check input variables - ESMF_INIT_CHECK_DEEP(ESMF_StateGetInit,state,rc) - ESMF_INIT_CHECK_DEEP(ESMF_VMGetInit,vm,rc) - - localrecflag = is_rec_needed_worker (state%statep) - - if (present (collectiveflag)) then - if (collectiveflag) then - - if (.not. present (vm)) then - localrc = ESMF_RC_ARG_INCOMP - if (ESMF_LogFoundError(localrc, & - msg="VM is required for collective inquiry", & - ESMF_CONTEXT, rcToReturn=rc)) return - end if - - commsend = merge (1, 0, localrecflag) - call ESMF_VMAllReduce (vm=vm, & - sendData=commsend, recvData=commrecv, reduceflag=ESMF_REDUCE_SUM, & - rc=localrc) - if (ESMF_LogFoundError(localrc, & - ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, rcToReturn=rc)) return - localrecflag = commrecv /= 0 - end if - end if - - ESMF_StateIsReconcileNeeded = localrecflag - if (present (rc)) rc = ESMF_SUCCESS - - contains - - recursive function is_rec_needed_worker (sp1) result (is_rec_needed) - type(ESMF_StateClass), intent(in) :: sp1 - logical :: is_rec_needed - - type(ESMF_StateItem) , pointer :: nextitem1 - integer :: i1 - - type(ESMF_StateItemWrap), pointer :: siwrap(:) - integer :: ptrcnt - - integer :: localrc1 - integer :: memstat1 - - ! Default return this levels flag - - is_rec_needed = sp1%reconcileneededflag - if (is_rec_needed) return - - ! Then search nested States - - siwrap => null () - call ESMF_ContainerGet (sp1%stateContainer, & - itemCount=ptrcnt, itemList=siwrap, rc=localrc1) - if (ESMF_LogFoundError(localrc1, ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, rcToReturn=rc)) return - - do, i1 = 1, ptrcnt - nextitem1 => siwrap(i1)%si - if (nextitem1%otype == ESMF_STATEITEM_STATE) then - is_rec_needed = & - is_rec_needed_worker (nextitem1%datap%spp) - if (is_rec_needed) then - deallocate (siwrap, stat=memstat1) - if (ESMF_LogFoundDeallocError(memstat1, ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, rcToReturn=rc)) return - return - end if - end if - end do - - if (associated (siwrap)) & - deallocate (siwrap, stat=memstat1) - if (ESMF_LogFoundDeallocError(memstat1, ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, rcToReturn=rc)) return - - end function is_rec_needed_worker - - end function ESMF_StateIsReconcileNeeded - - ! -------------------------- ESMF-public method ----------------------------- ^undef ESMF_METHOD ^define ESMF_METHOD "ESMF_StateLog()" @@ -2274,8 +2139,6 @@ type(ESMF_KeywordEnforcer), optional:: keywordEnforcer ! must use keywords below write (ESMF_UtilIOStdout,'(1x,4a,i0)') nestr, & " status: ", trim(msgbuf), & ", object count: ", ptrcnt - write (ESMF_UtilIOStdout,'(1x,2a,L1)') nestr, & - " reconcile needed: ", sp1%reconcileneededflag ! Prints Attributes associated with the State call ESMF_UtilIOUnitFlush (unit=ESMF_UtilIOstdout, rc=localrc1) diff --git a/src/Superstructure/State/src/ESMF_StateInternals.cppF90 b/src/Superstructure/State/src/ESMF_StateInternals.cppF90 index 6053e342cb..1481604027 100644 --- a/src/Superstructure/State/src/ESMF_StateInternals.cppF90 +++ b/src/Superstructure/State/src/ESMF_StateInternals.cppF90 @@ -377,7 +377,6 @@ ESMF_INIT_CHECK_DEEP(ESMF_RouteHandleGetInit,routehandles(i),rc) else stypep%st = ESMF_STATEINTENT_UNSPECIFIED endif - stypep%reconcileneededflag = .false. stypep%stateContainer = ESMF_ContainerCreate (rc=localrc) if (ESMF_LogFoundError(localrc, & @@ -698,7 +697,6 @@ ESMF_INIT_CHECK_DEEP(ESMF_RouteHandleGetInit,routehandles(i),rc) ^if defined(stateversion) @\ ! TODO: This needs to be verified... @\ sip%datap%spp => mname(i)%statep ! State version @\ - sip%datap%spp%reconcileneededFlag = .false. @\ ^else @\ sip%datap%mtypecomponent = mname(i) @\ ^endif @\ @@ -725,8 +723,6 @@ ESMF_INIT_CHECK_DEEP(ESMF_RouteHandleGetInit,routehandles(i),rc) end if @\ @\ end do @\ - @\ - stypep%reconcileneededFlag = .true. @\ @\ if (present(rc)) rc = ESMF_SUCCESS @\ @\ diff --git a/src/Superstructure/State/src/ESMF_StateItem.F90 b/src/Superstructure/State/src/ESMF_StateItem.F90 index fb6fedd6e4..ccf8fe15a8 100644 --- a/src/Superstructure/State/src/ESMF_StateItem.F90 +++ b/src/Superstructure/State/src/ESMF_StateItem.F90 @@ -260,7 +260,6 @@ module ESMF_StateItemMod #endif type(ESMF_Container):: stateContainer integer :: alloccount - logical :: reconcileneededflag ESMF_INIT_DECLARE end type diff --git a/src/Superstructure/StateReconcile/src/ESMF_StateReconcile.F90 b/src/Superstructure/StateReconcile/src/ESMF_StateReconcile.F90 index 6830315611..98db1b1cff 100644 --- a/src/Superstructure/StateReconcile/src/ESMF_StateReconcile.F90 +++ b/src/Superstructure/StateReconcile/src/ESMF_StateReconcile.F90 @@ -1136,8 +1136,6 @@ subroutine ESMF_StateReconcile_driver (state, vm, attreconflag, rc) ! ------------------------------------------------------------------------- if (meminfo) call ESMF_VMLogMemInfo ("after 7.) Deserialize received objects and create proxies") - state%statep%reconcileneededflag = .false. - if (trace) then call ESMF_ReconcileDebugPrint (ESMF_METHOD // ': Complete!') call ESMF_VMBarrier (vm) diff --git a/src/Superstructure/StateReconcile/tests/ESMF_StateReconcileUTest.F90 b/src/Superstructure/StateReconcile/tests/ESMF_StateReconcileUTest.F90 index 030ceb4b53..1c38d14114 100644 --- a/src/Superstructure/StateReconcile/tests/ESMF_StateReconcileUTest.F90 +++ b/src/Superstructure/StateReconcile/tests/ESMF_StateReconcileUTest.F90 @@ -669,7 +669,6 @@ program ESMF_StateReconcileUTest character(4) :: localpet_str, temppet_str integer :: attr_val(1) integer :: i - logical :: reconcile_needed, recneeded_expected ! individual test failure message character(ESMF_MAXSTR) :: failMsg @@ -718,31 +717,6 @@ program ESMF_StateReconcileUTest write(name, *) "Creating a State" call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE) - !------------------------------------------------------------------------- - !NEX_UTest_Multi_Proc_Only - reconcile_needed = ESMF_StateIsReconcileNeeded (state1, rc=rc) - write(failMsg, *) "Did not return ESMF_SUCCESS" - write(name, *) "Testing empty State for reconcile needed" - call ESMF_Test(rc == ESMF_SUCCESS, name, failMsg, result, ESMF_SRCLINE) - - !------------------------------------------------------------------------- - !NEX_UTest_Multi_Proc_Only - write(failMsg, *) "Did not return .false. for empty State" - call ESMF_Test(.not. reconcile_needed, name, failMsg, result, ESMF_SRCLINE) - - !------------------------------------------------------------------------- - !NEX_UTest_Multi_Proc_Only - reconcile_needed = ESMF_StateIsReconcileNeeded (state1, & - vm=vm, collectiveflag=.true., rc=rc) - write(failMsg, *) "Did not return ESMF_SUCCESS" - write(name, *) "Testing empty State for reconcile needed (collective)" - call ESMF_Test(rc == ESMF_SUCCESS, name, failMsg, result, ESMF_SRCLINE) - - !------------------------------------------------------------------------- - !NEX_UTest_Multi_Proc_Only - write(failMsg, *) "Did not return .false. for empty State" - call ESMF_Test(.not. reconcile_needed, name, failMsg, result, ESMF_SRCLINE) - ! In SetServices() the VM for each component is initialized. ! Normally you would call SetEntryPoint inside set services, ! but to make this test very short, they are called inline below. @@ -839,31 +813,6 @@ program ESMF_StateReconcileUTest write(name, *) "Calling StateValidate" call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE) - !------------------------------------------------------------------------- - !NEX_UTest_Multi_Proc_Only - reconcile_needed = ESMF_StateIsReconcileNeeded (state1, rc=rc) - write(failMsg, *) "Did not return ESMF_SUCCESS" - write(name, *) "Testing modified State for reconcile needed" - call ESMF_Test(rc == ESMF_SUCCESS, name, failMsg, result, ESMF_SRCLINE) - - !------------------------------------------------------------------------- - !NEX_UTest_Multi_Proc_Only - write(failMsg, *) "Did not return .true. for modified State" - call ESMF_Test(reconcile_needed, name, failMsg, result, ESMF_SRCLINE) - - !------------------------------------------------------------------------- - !NEX_UTest_Multi_Proc_Only - reconcile_needed = ESMF_StateIsReconcileNeeded (state1, & - vm=vm, collectiveflag=.true., rc=rc) - write(failMsg, *) "Did not return ESMF_SUCCESS" - write(name, *) "Testing modified State for reconcile needed (collective)" - call ESMF_Test(rc == ESMF_SUCCESS, name, failMsg, result, ESMF_SRCLINE) - - !------------------------------------------------------------------------- - !NEX_UTest_Multi_Proc_Only - write(failMsg, *) "Did not return .true. for modified State" - call ESMF_Test(reconcile_needed, name, failMsg, result, ESMF_SRCLINE) - !------------------------------------------------------------------------- !NEX_UTest_Multi_Proc_Only call ESMF_StateReconcile(state1, vm=vm, rc=rc) @@ -895,41 +844,6 @@ program ESMF_StateReconcileUTest write(name, *) "Calling StateValidate" call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE) - !------------------------------------------------------------------------- - !NEX_UTest_Multi_Proc_Only - reconcile_needed = ESMF_StateIsReconcileNeeded (state1, rc=rc) - write(failMsg, *) "Did not return ESMF_SUCCESS" - write(name, *) "Testing reconciled State for reconcile needed" - call ESMF_Test(rc == ESMF_SUCCESS, name, failMsg, result, ESMF_SRCLINE) - - !------------------------------------------------------------------------- - !NEX_UTest_Multi_Proc_Only - ! Note that even though the top level State should have its reconcileneeded - ! flag cleared, the two nested States still should have their flags set. - recneeded_expected = localpet == 0 .or. localpet == 1 - write(failMsg, *) "Did not return correct result for reconciled State", & - localpet, reconcile_needed, recneeded_expected - call ESMF_Test(reconcile_needed .eqv. recneeded_expected, & - name, failMsg, result, ESMF_SRCLINE) - - !------------------------------------------------------------------------- - !NEX_UTest_Multi_Proc_Only - reconcile_needed = ESMF_StateIsReconcileNeeded (state1, & - vm=vm, collectiveflag=.true., rc=rc) - write(failMsg, *) "Did not return ESMF_SUCCESS" - write(name, *) "Testing reconciled State for reconcile needed (collective)" - call ESMF_Test(rc == ESMF_SUCCESS, name, failMsg, result, ESMF_SRCLINE) - - !------------------------------------------------------------------------- - !NEX_UTest_Multi_Proc_Only - ! Note that even though the top level State should have its reconcileneeded - ! flag cleared, two nested States still should have their flags set. So the - ! collective ESMF_StateIsReconcileNeeded function should return .true.. - write(failMsg, *) "Did not return correct collective result for reconciled State", & - localpet, reconcile_needed, recneeded_expected - call ESMF_Test(reconcile_needed, & - name, failMsg, result, ESMF_SRCLINE) - !------------------------------------------------------------------------- !NEX_UTest_Multi_Proc_Only ! Test redundant reconcile @@ -1540,11 +1454,9 @@ program ESMF_StateReconcileUTest ! Test attribute reconcililiation !------------------------------------------------------------------------- -!@@@ - !------------------------------------------------------------------------- !NEX_UTest_Multi_Proc_Only - ! component on PET 0 -> needed for consistent VM + ! component on PET 0 -> needed to create Field below on PET 0 comp1 = ESMF_GridCompCreate(petList=[0], rc=rc) write(failMsg, *) "Did not return ESMF_SUCCESS" write(name, *) "Creating a Gridded Component" @@ -1637,6 +1549,7 @@ program ESMF_StateReconcileUTest if (localPet == 0) then do, i=1, size (field_attr) write (fieldname, '(a,i4)') 'PET 0 Field', i + ! create on vm0 to not violate ESMF unison rule for Create() methods field_attr(i) = ESMF_FieldEmptyCreate(name=fieldname, vm=vm0, rc=rc) if (rc /= ESMF_SUCCESS) goto 50 From 6c647d321014278385669c068a0d41ba574465bc Mon Sep 17 00:00:00 2001 From: Robert Oehmke Date: Wed, 25 Sep 2024 22:54:48 -0600 Subject: [PATCH 034/207] Take ESMF_StateWrite() and ESMF_StateRead() out of public API. --- .../State/doc/State_refdoc.ctex | 2 - .../State/examples/ESMF_StateReadWriteEx.F90 | 198 ---------- src/Superstructure/State/examples/makefile | 22 +- src/Superstructure/State/src/ESMF_State.F90 | 15 +- .../State/src/ESMF_StateAPI.cppF90 | 19 +- src/Superstructure/State/src/ESMF_StateWr.F90 | 12 +- .../State/tests/ESMF_StateReadWriteUTest.F90 | 345 ------------------ src/Superstructure/State/tests/makefile | 14 - 8 files changed, 33 insertions(+), 594 deletions(-) delete mode 100644 src/Superstructure/State/examples/ESMF_StateReadWriteEx.F90 delete mode 100644 src/Superstructure/State/tests/ESMF_StateReadWriteUTest.F90 diff --git a/src/Superstructure/State/doc/State_refdoc.ctex b/src/Superstructure/State/doc/State_refdoc.ctex index d9add4823e..3c83f42351 100644 --- a/src/Superstructure/State/doc/State_refdoc.ctex +++ b/src/Superstructure/State/doc/State_refdoc.ctex @@ -66,12 +66,10 @@ \input{State_usage} \input{ESMF_StateEx_fapi} \input{../../StateReconcile/doc/ESMF_StateReconcileEx_fapi} -\input{ESMF_StateReadWriteEx_fapi} #elif defined(CONSTITUENT) \input{../Superstructure/State/doc/State_usage} \input{../Superstructure/State/doc/ESMF_StateEx_fapi} \input{../Superstructure/StateReconcile/doc/ESMF_StateReconcileEx_fapi} -\input{../Superstructure/State/doc/ESMF_StateReadWriteEx_fapi} #endif \subsection{Restrictions and Future Work} diff --git a/src/Superstructure/State/examples/ESMF_StateReadWriteEx.F90 b/src/Superstructure/State/examples/ESMF_StateReadWriteEx.F90 deleted file mode 100644 index 0ce7774aae..0000000000 --- a/src/Superstructure/State/examples/ESMF_StateReadWriteEx.F90 +++ /dev/null @@ -1,198 +0,0 @@ -! $Id$ -! -! Earth System Modeling Framework -! Copyright (c) 2002-2024, 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. -! -!============================================================================== -! - program ESMF_StateReadWriteEx - -!------------------------------------------------------------------------------ -!ESMF_EXAMPLE String used by test script to count examples. -!------------------------------------------------------------------------- - -#include "ESMF.h" - -!BOE -!\subsubsection{Read Arrays from a NetCDF file and add to a State} -! \label{example:StateRdWr} -! This program shows an example of reading and writing Arrays from a State -! from/to a NetCDF file. -!EOE - -!----------------------------------------------------------------------------- - -!BOC - ! ESMF Framework module - use ESMF - use ESMF_TestMod - implicit none - - ! Local variables - type(ESMF_State) :: state - type(ESMF_Array) :: latArray, lonArray, timeArray, humidArray, & - tempArray, pArray, rhArray - type(ESMF_VM) :: vm - integer :: localPet, rc -!EOC - integer :: finalrc, result - character(ESMF_MAXSTR) :: testname - character(ESMF_MAXSTR) :: failMsg - -!------------------------------------------------------------------------- -!------------------------------------------------------------------------- - - write(failMsg, *) "Example failure" - write(testname, *) "Example ESMF_StateReadWriteEx" - - -! ------------------------------------------------------------------------------ -! ------------------------------------------------------------------------------ - - - finalrc = ESMF_SUCCESS - - call ESMF_Initialize(vm=vm, defaultlogfilename="StateReadWriteEx.Log", & - logkindflag=ESMF_LOGKIND_MULTI, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT) - call ESMF_VMGet(vm, localPet=localPet, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT) - - state = ESMF_StateCreate(name="Ocean Import", & - stateintent=ESMF_STATEINTENT_IMPORT, rc=rc) - if (rc.NE.ESMF_SUCCESS) finalrc = ESMF_FAILURE - -!BOE -! The following line of code will read all Array data contained in a NetCDF -! file, place them in {\tt ESMF\_Arrays} and add them to an {\tt ESMF\_State}. -! Only PET 0 reads the file; the States in the other PETs remain empty. -! Currently, the data is not decomposed or distributed; each PET -! has only 1 DE and only PET 0 contains data after reading the file. -! Future versions of ESMF will support data decomposition and distribution -! upon reading a file. -! -! Note that the third party NetCDF library must be installed. For more -! details, see the "ESMF Users Guide", -! "Building and Installing the ESMF, Third Party Libraries, NetCDF" and -! the website http://www.unidata.ucar.edu/software/netcdf. -!EOE - -!BOC - ! Read the NetCDF data file into Array objects in the State on PET 0 - call ESMF_StateRead(state, "io_netcdf_testdata.nc", rc=rc) - - ! If the NetCDF library is not present (on PET 0), cleanup and exit - if (rc == ESMF_RC_LIB_NOT_PRESENT) then - call ESMF_StateDestroy(state, rc=rc) - goto 10 - endif -!EOC - if (rc.NE.ESMF_SUCCESS) finalrc = ESMF_FAILURE - -!BOE -! Only reading data into {\tt ESMF\_Arrays} is supported at this time; -! {\tt ESMF\_ArrayBundles}, {\tt ESMF\_Fields}, and {\tt ESMF\_FieldBundles} -! will be supported in future releases of ESMF. -!EOE - -!------------------------------------------------------------------------- -!BOE -!\subsubsection{Print Array data from a State} -! -! To see that the State now contains the same data as in the file, the -! following shows how to print out what Arrays are contained within the -! State and to print the data contained within each Array. The NetCDF utility -! "ncdump" can be used to view the contents of the NetCDF file. -! In this example, only PET 0 will contain data. -!EOE - -!BOC - if (localPet == 0) then - ! Print the names and attributes of Array objects contained in the State - call ESMF_StatePrint(state, rc=rc) - - ! Get each Array by name from the State - call ESMF_StateGet(state, "lat", latArray, rc=rc) - call ESMF_StateGet(state, "lon", lonArray, rc=rc) - call ESMF_StateGet(state, "time", timeArray, rc=rc) - call ESMF_StateGet(state, "Q", humidArray, rc=rc) - call ESMF_StateGet(state, "TEMP", tempArray, rc=rc) - call ESMF_StateGet(state, "p", pArray, rc=rc) - call ESMF_StateGet(state, "rh", rhArray, rc=rc) - - ! Print out the Array data - call ESMF_ArrayPrint(latArray, rc=rc) - call ESMF_ArrayPrint(lonArray, rc=rc) - call ESMF_ArrayPrint(timeArray, rc=rc) - call ESMF_ArrayPrint(humidArray, rc=rc) - call ESMF_ArrayPrint(tempArray, rc=rc) - call ESMF_ArrayPrint(pArray, rc=rc) - call ESMF_ArrayPrint(rhArray, rc=rc) - endif -!EOC - if (rc.NE.ESMF_SUCCESS) finalrc = ESMF_FAILURE - -!BOE -! Note that the Arrays "lat", "lon", and "time" hold spatial and temporal -! coordinate data for the dimensions latitude, longitude and time, -! respectively. These will be used in future releases of ESMF to create -! {\tt ESMF\_Grids}. -!EOE - -!------------------------------------------------------------------------- -!BOE -!\subsubsection{Write Array data within a State to a NetCDF file} -! -! All the Array data within the State on PET 0 can be written out to a NetCDF -! file as follows: -!EOE - -!BOC - ! Write Arrays within the State on PET 0 to a NetCDF file - call ESMF_StateWrite(state, "io_netcdf_testdata_out.nc", rc=rc) -!EOC - if (rc.NE.ESMF_SUCCESS) finalrc = ESMF_FAILURE - -!BOE -! Currently writing is limited to PET 0; future versions of ESMF will allow -! parallel writing, as well as parallel reading. -!EOE - - ! Destroy the State container - call ESMF_StateDestroy(state, rc=rc) - - if (localPet == 0) then - ! Destroy the constituent Arrays - call ESMF_ArrayDestroy(latArray, rc=rc) - call ESMF_ArrayDestroy(lonArray, rc=rc) - call ESMF_ArrayDestroy(timeArray, rc=rc) - call ESMF_ArrayDestroy(humidArray, rc=rc) - call ESMF_ArrayDestroy(tempArray, rc=rc) - call ESMF_ArrayDestroy(pArray, rc=rc) - call ESMF_ArrayDestroy(rhArray, rc=rc) - endif - if (rc.NE.ESMF_SUCCESS) finalrc = ESMF_FAILURE - - 10 continue ! Exit point if NetCDF not present (PET 0) - - ! IMPORTANT: ESMF_STest() prints the PASS string and the # of processors in the log - ! file that the scripts grep for. - call ESMF_STest((finalrc.eq.ESMF_SUCCESS), testname, failMsg, result, ESMF_SRCLINE) - - - call ESMF_Finalize(rc=rc) - if (rc.NE.ESMF_SUCCESS) finalrc = ESMF_FAILURE - - if (finalrc.EQ.ESMF_SUCCESS) then - print *, "PASS: ESMF_StateReadWriteEx.F90" - else - print *, "FAIL: ESMF_StateReadWriteEx.F90" - end if - - end program ESMF_StateReadWriteEx - diff --git a/src/Superstructure/State/examples/makefile b/src/Superstructure/State/examples/makefile index 3e71583422..60217754db 100644 --- a/src/Superstructure/State/examples/makefile +++ b/src/Superstructure/State/examples/makefile @@ -7,14 +7,13 @@ run_uni: run_examples_uni LOCDIR = src/Superstructure/State/examples .NOTPARALLEL: -EXAMPLES_BUILD = $(ESMF_EXDIR)/ESMF_StateEx \ - $(ESMF_EXDIR)/ESMF_StateReadWriteEx +EXAMPLES_BUILD = $(ESMF_EXDIR)/ESMF_StateEx -EXAMPLES_RUN = run_ESMF_StateEx \ - run_ESMF_StateReadWriteEx -EXAMPLES_RUN_UNI = run_ESMF_StateEx_uni \ - run_ESMF_StateReadWriteEx_uni +EXAMPLES_RUN = run_ESMF_StateEx + +EXAMPLES_RUN_UNI = run_ESMF_StateEx_uni + include $(ESMF_DIR)/makefile @@ -34,14 +33,3 @@ run_ESMF_StateEx: run_ESMF_StateEx_uni: $(MAKE) EXNAME=State NP=1 exfrun -# -# ESMF_StateReadWriteEx -# -run_ESMF_StateReadWriteEx: - cp -f $(ESMF_DIR)/src/Infrastructure/IO/tests/io_netcdf_testdata.nc $(ESMF_EXDIR) - $(MAKE) EXNAME=StateReadWrite NP=4 exfrun - -run_ESMF_StateReadWriteEx_uni: - cp -f $(ESMF_DIR)/src/Infrastructure/IO/tests/io_netcdf_testdata.nc $(ESMF_EXDIR) - $(MAKE) EXNAME=StateReadWrite NP=1 exfrun - diff --git a/src/Superstructure/State/src/ESMF_State.F90 b/src/Superstructure/State/src/ESMF_State.F90 index a1c5c159fc..8d72c0c59c 100644 --- a/src/Superstructure/State/src/ESMF_State.F90 +++ b/src/Superstructure/State/src/ESMF_State.F90 @@ -69,18 +69,21 @@ module ESMF_StateMod public ESMF_StateRemove public ESMF_StateReplace - - public ESMF_StateWriteRestart - public ESMF_StateReadRestart - - public ESMF_StateRead - public ESMF_StateWrite public ESMF_StatePrint public ESMF_StateSet public ESMF_StateSerialize, ESMF_StateDeserialize public ESMF_StateClassFindData + + ! These methods are broken and create Arrays in a bad configuration. + ! We are taking them out so no one uses them. Eventually, new correct + ! versions will be implemented. + ! public ESMF_StateRead + ! public ESMF_StateWrite + ! public ESMF_StateWriteRestart + ! public ESMF_StateReadRestart + !EOPI diff --git a/src/Superstructure/State/src/ESMF_StateAPI.cppF90 b/src/Superstructure/State/src/ESMF_StateAPI.cppF90 index 7a7dd1c9e1..7f5de0e04e 100644 --- a/src/Superstructure/State/src/ESMF_StateAPI.cppF90 +++ b/src/Superstructure/State/src/ESMF_StateAPI.cppF90 @@ -87,12 +87,6 @@ module ESMF_StateAPIMod public ESMF_StateIsReconcileNeeded public ESMF_StateLog - - public ESMF_StateWriteRestart - public ESMF_StateReadRestart - - public ESMF_StateRead - public ESMF_StateWrite public ESMF_StatePrint public ESMF_StateSet @@ -100,6 +94,15 @@ module ESMF_StateAPIMod public ESMF_StateClassFindData + ! These methods are broken and create Arrays in a bad configuration. + ! We are taking them out so no one uses them. Eventually, new correct + ! versions will be implemented. + ! public ESMF_StateRead + ! public ESMF_StateWrite + ! public ESMF_StateWriteRestart + ! public ESMF_StateReadRestart + + !EOPI !------------------------------------------------------------------------------ @@ -2334,7 +2337,7 @@ type(ESMF_KeywordEnforcer), optional:: keywordEnforcer ! must use keywords below !------------------------------------------------------------------------------ ^undef ESMF_METHOD ^define ESMF_METHOD "ESMF_StateRead" -!BOP +!BOPI ! !IROUTINE: ESMF_StateRead -- Read data items from a file into a State ! ! !INTERFACE: @@ -2375,7 +2378,7 @@ type(ESMF_KeywordEnforcer), optional:: keywordEnforcer ! must use keywords below ! not present. ! \end{description} ! -!EOP +!EOPI ! TODO: use item flag ESMF_STATEITEM_ARRAY integer :: localrc diff --git a/src/Superstructure/State/src/ESMF_StateWr.F90 b/src/Superstructure/State/src/ESMF_StateWr.F90 index 75c1d3a9b9..0814f07fcf 100644 --- a/src/Superstructure/State/src/ESMF_StateWr.F90 +++ b/src/Superstructure/State/src/ESMF_StateWr.F90 @@ -48,8 +48,12 @@ module ESMF_StateWrMod !------------------------------------------------------------------------------ ! !PUBLIC MEMBER FUNCTIONS: - public :: ESMF_StateWrite - public :: ESMF_StateWriteRestart + + ! These methods are broken and create Arrays in a bad configuration. + ! We are taking them out so no one uses them. Eventually, new correct + ! versions will be implemented. + ! public :: ESMF_StateWrite + ! public :: ESMF_StateWriteRestart !EOPI @@ -123,7 +127,7 @@ module ESMF_StateWrMod !------------------------------------------------------------------------------ #undef ESMF_METHOD #define ESMF_METHOD "ESMF_StateWrite" -!BOP +!BOPI ! !IROUTINE: ESMF_StateWrite -- Write items from a State to file ! ! !INTERFACE: @@ -162,7 +166,7 @@ subroutine ESMF_StateWrite(state, fileName, rc) ! not present. ! \end{description} ! -!EOP +!EOPI ! TODO: use item flag ESMF_STATEITEM_ARRAY integer :: localrc diff --git a/src/Superstructure/State/tests/ESMF_StateReadWriteUTest.F90 b/src/Superstructure/State/tests/ESMF_StateReadWriteUTest.F90 deleted file mode 100644 index 10f48fc376..0000000000 --- a/src/Superstructure/State/tests/ESMF_StateReadWriteUTest.F90 +++ /dev/null @@ -1,345 +0,0 @@ -! $Id$ -! -! Earth System Modeling Framework -! Copyright (c) 2002-2024, 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. -! -!============================================================================== -! - -!------------------------------------------------------------------------------- - - program ESMF_StateReadWriteUTest - -!============================================================================== -! -#include "ESMF.h" -! -!BOP -! !PROGRAM: ESMF_StateReadWriteUTest - Test code which Reads/Writes States -! -! !DESCRIPTION: -! -! The code in this file drives F90 State Read/Write unit tests. -! -!----------------------------------------------------------------------------- -! !USES: - use ESMF_TestMod ! test methods - use ESMF - implicit none - -!------------------------------------------------------------------------------ -! The following line turns the CVS identifier string into a printable variable. - character(*), parameter :: version = & - '$Id$' -!------------------------------------------------------------------------------ - -! ! Local variables - type(ESMF_State) :: state - type(ESMF_Array) :: latArray, lonArray, timeArray, humidArray, & - tempArray, pArray, rhArray - type(ESMF_VM) :: vm - integer :: localPet - integer :: i - integer :: rc, localrc - logical :: have_netcdf - - character(*), parameter :: netcdf_file = 'io_netcdf_testdata.nc' - character(*), parameter :: netcdf_fileout = 'io_netcdf_testdata_out.nc' - - integer, parameter :: narrays = 7 - character(8), parameter :: arraynames(narrays) = (/ & - "lat ", "lon ", "time", & - "Q ", "TEMP", "p ", & - "rh " & - /) - type(ESMF_StateItem_Flag) :: itemtype - integer :: itemcount - logical :: passfail - - ! individual test failure messages - character(ESMF_MAXSTR) :: failMsg - character(ESMF_MAXSTR) :: name - - ! cumulative result: count failures; no failures equals "all pass" - integer :: result = 0 - -!------------------------------------------------------------------------------- -! The unit tests are divided into Sanity and Exhaustive. The Sanity tests are -! always run. When the environment variable, EXHAUSTIVE, is set to ON then -! the EXHAUSTIVE and sanity tests both run. If the EXHAUSTIVE variable is set -! to OFF, then only the sanity unit tests. -! Special strings (Non-exhaustive and exhaustive) have been -! added to allow a script to count the number and types of unit tests. -!------------------------------------------------------------------------------- - - - call ESMF_TestStart(ESMF_SRCLINE, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT) - - call ESMF_VMGetGlobal(vm=vm, rc=rc) - call ESMF_VMGet (vm, localPet=localPet) - -#ifdef ESMF_TESTEXHAUSTIVE - !------------------------------------------------------------------------ - !EX_UTest - ! Test Creation of an empty export State - state = ESMF_StateCreate(name="Ocean Export", stateintent=ESMF_STATEINTENT_EXPORT, rc=rc) - write(failMsg, *) "Did not return ESMF_SUCCESS" - write(name, *) "Creating an empty export State Test" - call ESMF_Test((rc.eq.ESMF_SUCCESS), & - name, failMsg, result, ESMF_SRCLINE) - !------------------------------------------------------------------------ - !EX_UTest - ! Test reading a with no file name specified - call ESMF_StateRead(state, filename=' ', rc=rc) - write(failMsg, *) "Did not return an error" - write(name, *) "Reading a file with no file name specified" - call ESMF_Test(rc /= ESMF_SUCCESS, & - name, failMsg, result, ESMF_SRCLINE) - !------------------------------------------------------------------------ - !EX_UTest - ! Test reading a netCDF file into Arrays in a State - call ESMF_StateRead(state, filename=netcdf_file, rc=rc) - write(failMsg, *) "Did not return ESMF_SUCCESS when reading: ", netcdf_file - write(name, *) "Reading netCDF file ", netcdf_file, " into Arrays in a State" - call ESMF_Test((rc == ESMF_SUCCESS .or. rc == ESMF_RC_LIB_NOT_PRESENT), & - name, failMsg, result, ESMF_SRCLINE) - - have_netcdf = rc /= ESMF_RC_LIB_NOT_PRESENT - !------------------------------------------------------------------------ - !EX_UTest - ! Test for number of State items read from the file. - call ESMF_StateGet (state, itemCount=itemcount, rc=localrc) - write(failMsg, *) "Incorrect number of items read from file" - write(name, *) "Checking read-in Array item count in a State test" - ! Current implementation reads data on PET 0 - if (localPet == 0) then - passfail = itemcount == narrays - else - passfail = itemcount == 0 - end if - call ESMF_Test((rc == ESMF_SUCCESS .and. passfail) .or. .not. have_netcdf, & - name, failMsg, result, ESMF_SRCLINE) - !------------------------------------------------------------------------ - !EX_UTest - ! Test for presense of State items read from the file. - if (localPet == 0) then - do, i=1, narrays - call ESMF_StateGet (state, itemname=arraynames(i), itemType=itemtype, rc=localrc) - if (localrc /= ESMF_SUCCESS) exit - if (itemtype /= ESMF_STATEITEM_ARRAY) then - localrc = ESMF_RC_NOT_FOUND - exit - end if - end do - rc = merge (ESMF_SUCCESS, localrc, i>narrays) - else - i = 1 - rc = ESMF_SUCCESS - end if - write(failMsg, *) "Could not find read-in Array: ", trim (arraynames(min (i, narrays))) - write(name, *) "Checking read-in Array names in a State test" - call ESMF_Test((rc == ESMF_SUCCESS .or. .not. have_netcdf), & - name, failMsg, result, ESMF_SRCLINE) - !------------------------------------------------------------------------ - !EX_UTest - ! Test reconciling Arrays across all PETs in a VM - call ESMF_StateReconcile(state, vm=vm, rc=rc) - write(failMsg, *) "Did not return ESMF_SUCCESS" - write(name, *) "Reconciling Arrays across all PETs in a VM" - call ESMF_Test((rc.eq.ESMF_SUCCESS), & - name, failMsg, result, ESMF_SRCLINE) - !------------------------------------------------------------------------ - !EX_UTest - ! Test writing Arrays with no file name specified - call ESMF_StateWrite(state, filename=' ', rc=rc) - write(failMsg, *) "Did not return an error" - write(name, *) "Writing a file with no file name" - call ESMF_Test(rc /= ESMF_SUCCESS, & - name, failMsg, result, ESMF_SRCLINE) - !------------------------------------------------------------------------ - !EX_UTest - ! Test writing Arrays in a State to a netCDF file - call ESMF_StateWrite(state, filename=netcdf_fileout, rc=rc) - write(failMsg, *) "Did not return ESMF_SUCCESS" - write(name, *) "Writing netCDF file ", netcdf_fileout, " from Arrays in a State" - call ESMF_Test((rc.eq.ESMF_SUCCESS.or.rc.eq.ESMF_RC_LIB_NOT_PRESENT), & - name, failMsg, result, ESMF_SRCLINE) - !------------------------------------------------------------------------ - ! Get each Array by name from the State - !------------------------------------------------------------------------ - !EX_UTest - ! Test getting an Array from a State - call ESMF_StateGet(state, "lat", latArray, rc=rc) - write(failMsg, *) "Did not return ESMF_SUCCESS" - write(name, *) "Getting Array named 'lat' from a State" - if (have_netcdf) then - call ESMF_Test(rc == ESMF_SUCCESS, & - name, failMsg, result, ESMF_SRCLINE) - else - call ESMF_Test(rc == ESMF_RC_NOT_FOUND, & - name, failMsg, result, ESMF_SRCLINE) - end if - !------------------------------------------------------------------------ - !EX_UTest - ! Test getting an Array from a State - call ESMF_StateGet(state, "lon", lonArray, rc=rc) - write(failMsg, *) "Did not return ESMF_SUCCESS" - write(name, *) "Getting Array named 'lon' from a State" - if (have_netcdf) then - call ESMF_Test(rc == ESMF_SUCCESS, & - name, failMsg, result, ESMF_SRCLINE) - else - call ESMF_Test(rc == ESMF_RC_NOT_FOUND, & - name, failMsg, result, ESMF_SRCLINE) - end if - !------------------------------------------------------------------------ - !EX_UTest - ! Test getting an Array from a State - call ESMF_StateGet(state, "time", timeArray, rc=rc) - write(failMsg, *) "Did not return ESMF_SUCCESS" - write(name, *) "Getting Array named 'time' from a State" - if (have_netcdf) then - call ESMF_Test(rc == ESMF_SUCCESS, & - name, failMsg, result, ESMF_SRCLINE) - else - call ESMF_Test(rc == ESMF_RC_NOT_FOUND, & - name, failMsg, result, ESMF_SRCLINE) - end if - !------------------------------------------------------------------------ - !EX_UTest - ! Test getting an Array from a State - call ESMF_StateGet(state, "Q", humidArray, rc=rc) - write(failMsg, *) "Did not return ESMF_SUCCESS" - write(name, *) "Getting Array named 'Q' from a State" - if (have_netcdf) then - call ESMF_Test(rc == ESMF_SUCCESS, & - name, failMsg, result, ESMF_SRCLINE) - else - call ESMF_Test(rc == ESMF_RC_NOT_FOUND, & - name, failMsg, result, ESMF_SRCLINE) - end if - !------------------------------------------------------------------------ - !EX_UTest - ! Test getting an Array from a State - call ESMF_StateGet(state, "TEMP", tempArray, rc=rc) - write(failMsg, *) "Did not return ESMF_SUCCESS" - write(name, *) "Getting Array named 'TEMP' from a State" - if (have_netcdf) then - call ESMF_Test(rc == ESMF_SUCCESS, & - name, failMsg, result, ESMF_SRCLINE) - else - call ESMF_Test(rc == ESMF_RC_NOT_FOUND, & - name, failMsg, result, ESMF_SRCLINE) - end if - !------------------------------------------------------------------------ - !EX_UTest - ! Test getting an Array from a State - call ESMF_StateGet(state, "p", pArray, rc=rc) - write(failMsg, *) "Did not return ESMF_SUCCESS" - write(name, *) "Getting Array named 'p' from a State" - if (have_netcdf) then - call ESMF_Test(rc == ESMF_SUCCESS, & - name, failMsg, result, ESMF_SRCLINE) - else - call ESMF_Test(rc == ESMF_RC_NOT_FOUND, & - name, failMsg, result, ESMF_SRCLINE) - end if - !------------------------------------------------------------------------ - !EX_UTest - ! Test getting an Array from a State - call ESMF_StateGet(state, "rh", rhArray, rc=rc) - write(failMsg, *) "Did not return ESMF_SUCCESS" - write(name, *) "Getting Array named 'rh' from a State" - if (have_netcdf) then - call ESMF_Test(rc == ESMF_SUCCESS, & - name, failMsg, result, ESMF_SRCLINE) - else - call ESMF_Test(rc == ESMF_RC_NOT_FOUND, & - name, failMsg, result, ESMF_SRCLINE) - end if - !------------------------------------------------------------------------ - ! Destroy the State - !------------------------------------------------------------------------ - !EX_UTest - ! Test destroying a State - call ESMF_StateDestroy(state, rc=rc) - write(failMsg, *) "Did not return ESMF_SUCCESS" - write(name, *) "Destroying a State" - call ESMF_Test((rc.eq.ESMF_SUCCESS), & - name, failMsg, result, ESMF_SRCLINE) - !------------------------------------------------------------------------ - ! Destroy the constituent Arrays - !------------------------------------------------------------------------ - !EX_UTest - ! Test destroying an Array - call ESMF_ArrayDestroy(latArray, rc=rc) - write(failMsg, *) "Did not return ESMF_SUCCESS" - write(name, *) "Destroying Array named 'lat' from a State" - call ESMF_Test((rc.eq.ESMF_SUCCESS.or.rc.eq.ESMF_RC_OBJ_NOT_CREATED), & - name, failMsg, result, ESMF_SRCLINE) - !------------------------------------------------------------------------ - !EX_UTest - ! Test destroying an Array - call ESMF_ArrayDestroy(lonArray, rc=rc) - write(failMsg, *) "Did not return ESMF_SUCCESS" - write(name, *) "Destroying Array named 'lon' from a State" - call ESMF_Test((rc.eq.ESMF_SUCCESS.or.rc.eq.ESMF_RC_OBJ_NOT_CREATED), & - name, failMsg, result, ESMF_SRCLINE) - !------------------------------------------------------------------------ - !EX_UTest - ! Test destroying an Array - call ESMF_ArrayDestroy(timeArray, rc=rc) - write(failMsg, *) "Did not return ESMF_SUCCESS" - write(name, *) "Destroying Array named 'time' from a State" - call ESMF_Test((rc.eq.ESMF_SUCCESS.or.rc.eq.ESMF_RC_OBJ_NOT_CREATED), & - name, failMsg, result, ESMF_SRCLINE) - !------------------------------------------------------------------------ - !EX_UTest - ! Test destroying an Array - call ESMF_ArrayDestroy(humidArray, rc=rc) - write(failMsg, *) "Did not return ESMF_SUCCESS" - write(name, *) "Destroying Array named 'Q' from a State" - call ESMF_Test((rc.eq.ESMF_SUCCESS.or.rc.eq.ESMF_RC_OBJ_NOT_CREATED), & - name, failMsg, result, ESMF_SRCLINE) - !------------------------------------------------------------------------ - !EX_UTest - ! Test destroying an Array - call ESMF_ArrayDestroy(tempArray, rc=rc) - write(failMsg, *) "Did not return ESMF_SUCCESS" - write(name, *) "Destroying Array named 'TEMP' from a State" - call ESMF_Test((rc.eq.ESMF_SUCCESS.or.rc.eq.ESMF_RC_OBJ_NOT_CREATED), & - name, failMsg, result, ESMF_SRCLINE) - !------------------------------------------------------------------------ - !EX_UTest - ! Test destroying an Array - call ESMF_ArrayDestroy(pArray, rc=rc) - write(failMsg, *) "Did not return ESMF_SUCCESS" - write(name, *) "Destroying Array named 'p' from a State" - call ESMF_Test((rc.eq.ESMF_SUCCESS.or.rc.eq.ESMF_RC_OBJ_NOT_CREATED), & - name, failMsg, result, ESMF_SRCLINE) - !------------------------------------------------------------------------ - !EX_UTest - ! Test destroying an Array - call ESMF_ArrayDestroy(rhArray, rc=rc) - write(failMsg, *) "Did not return ESMF_SUCCESS" - write(name, *) "Destroying Array named 'rh' from a State" - call ESMF_Test((rc.eq.ESMF_SUCCESS.or.rc.eq.ESMF_RC_OBJ_NOT_CREATED), & - name, failMsg, result, ESMF_SRCLINE) - !------------------------------------------------------------------------ - ! End of Exhaustive tests -#endif - - ! return number of failures to environment; 0 = success (all pass) - ! return result ! TODO: no way to do this in F90 ? - - call ESMF_TestEnd(ESMF_SRCLINE) - - end program ESMF_StateReadWriteUTest - -!------------------------------------------------------------------------- diff --git a/src/Superstructure/State/tests/makefile b/src/Superstructure/State/tests/makefile index 5633288009..bee6bf4bff 100644 --- a/src/Superstructure/State/tests/makefile +++ b/src/Superstructure/State/tests/makefile @@ -9,17 +9,14 @@ LOCDIR = src/Superstructure/State/tests .NOTPARALLEL: TESTS_BUILD = $(ESMF_TESTDIR)/ESMC_StateUTest \ $(ESMF_TESTDIR)/ESMF_StateCreateUTest \ - $(ESMF_TESTDIR)/ESMF_StateReadWriteUTest \ $(ESMF_TESTDIR)/ESMF_StateUTest TESTS_RUN = RUN_ESMC_StateUTest \ RUN_ESMF_StateCreateUTest \ - RUN_ESMF_StateReadWriteUTest \ RUN_ESMF_StateUTest TESTS_RUN_UNI = RUN_ESMC_StateUTestUNI \ RUN_ESMF_StateCreateUTestUNI \ - RUN_ESMF_StateReadWriteUTestUNI \ RUN_ESMF_StateUTestUNI @@ -62,15 +59,4 @@ RUN_ESMC_StateUTest: RUN_ESMC_StateUTestUNI: $(MAKE) TNAME=State NP=1 ctest -# -# State Read/Write Unit Test -# - -RUN_ESMF_StateReadWriteUTest: - cp -f $(ESMF_DIR)/src/Infrastructure/IO/tests/io_netcdf_testdata.nc $(ESMF_TESTDIR) - $(MAKE) TNAME=StateReadWrite NP=4 ftest - -RUN_ESMF_StateReadWriteUTestUNI: - cp -f $(ESMF_DIR)/src/Infrastructure/IO/tests/io_netcdf_testdata.nc $(ESMF_TESTDIR) - $(MAKE) TNAME=StateReadWrite NP=1 ftest From cdb486a7fe63ebb81eaa6029c42e0fd2d302cee1 Mon Sep 17 00:00:00 2001 From: Gerhard Theurich Date: Thu, 26 Sep 2024 10:37:54 -0600 Subject: [PATCH 035/207] Relabeling of steps under ESMF_StateReconcile_driver() and split of step 1 into 1+2 to facilitate case split to come. --- .../src/ESMF_StateReconcile.F90 | 98 +++++++++++-------- 1 file changed, 58 insertions(+), 40 deletions(-) diff --git a/src/Superstructure/StateReconcile/src/ESMF_StateReconcile.F90 b/src/Superstructure/StateReconcile/src/ESMF_StateReconcile.F90 index 98db1b1cff..73756d06f6 100644 --- a/src/Superstructure/StateReconcile/src/ESMF_StateReconcile.F90 +++ b/src/Superstructure/StateReconcile/src/ESMF_StateReconcile.F90 @@ -641,10 +641,10 @@ subroutine ESMF_StateReconcile_driver (state, vm, attreconflag, rc) end if ! ------------------------------------------------------------------------- - ! 0.) Interchange item counts between PETs. Set up counts/displacements + ! (0) Interchange item counts between PETs. Set up counts/displacements ! ------------------------------------------------------------------------- if (profile) then - call ESMF_TraceRegionEnter("0.) Interchange item counts", rc=localrc) + call ESMF_TraceRegionEnter("(0) Interchange item counts", rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, & rcToReturn=rc)) return @@ -665,21 +665,21 @@ subroutine ESMF_StateReconcile_driver (state, vm, attreconflag, rc) rcToReturn=rc)) return ! ------------------------------------------------------------------------- if (profile) then - call ESMF_TraceRegionExit("0.) Interchange item counts", rc=localrc) + call ESMF_TraceRegionExit("(0) Interchange item counts", rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, & rcToReturn=rc)) return endif ! ------------------------------------------------------------------------- - if (meminfo) call ESMF_VMLogMemInfo ("after 0.) Interchange item counts") + if (meminfo) call ESMF_VMLogMemInfo ("after (0) Interchange item counts") ! ------------------------------------------------------------------------- - ! 1.) Each PET constructs its send arrays containing local Id + ! (1) Each PET constructs its send arrays containing local Id ! and VMId info for each object contained in the State. ! Note that element zero is reserved for the State itself. ! ------------------------------------------------------------------------- if (profile) then - call ESMF_TraceRegionEnter("1.) Construct send arrays", rc=localrc) + call ESMF_TraceRegionEnter("(1) Construct send arrays", rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, & rcToReturn=rc)) return @@ -760,6 +760,16 @@ subroutine ESMF_StateReconcile_driver (state, vm, attreconflag, rc) vmIdMap_ptr => vmIdMap + ! ------------------------------------------------------------------------- + if (profile) then + call ESMF_TraceRegionExit("(1) Construct send arrays", rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, & + rcToReturn=rc)) return + endif + ! ------------------------------------------------------------------------- + if (meminfo) call ESMF_VMLogMemInfo ("after (1) Construct send arrays") + #if 0 ! Log a JSON State representation ----------------------------------------- @@ -776,9 +786,17 @@ subroutine ESMF_StateReconcile_driver (state, vm, attreconflag, rc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, rcToReturn=rc)) return #endif + ! ------------------------------------------------------------------------- + if (profile) then + call ESMF_TraceRegionEnter("(2) Update Field metadata", rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, & + rcToReturn=rc)) return + endif + ! ------------------------------------------------------------------------- if (trace) then call ESMF_ReconcileDebugPrint (ESMF_METHOD // & - ': *** Step 1.2 - Update Field metadata for unique geometries') + ': *** Step 2.0 - Update Field metadata for unique geometries') end if ! Update Field metadata for unique geometries. This will traverse the state @@ -811,20 +829,20 @@ subroutine ESMF_StateReconcile_driver (state, vm, attreconflag, rc) ! ------------------------------------------------------------------------- if (profile) then - call ESMF_TraceRegionExit("1.) Construct send arrays", rc=localrc) + call ESMF_TraceRegionExit("(2) Update Field metadata", rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, & rcToReturn=rc)) return endif ! ------------------------------------------------------------------------- - if (meminfo) call ESMF_VMLogMemInfo ("after 1.) Construct send arrays") + if (meminfo) call ESMF_VMLogMemInfo ("after (2) Update Field metadata") ! ------------------------------------------------------------------------- - ! 2.) All PETs send their items Ids and VMIds to all the other PETs, + ! (3) All PETs send their items Ids and VMIds to all the other PETs, ! then create local directories of which PETs have which ids/VMIds. ! ------------------------------------------------------------------------- if (profile) then - call ESMF_TraceRegionEnter("2.) Send arrays exchange", rc=localrc) + call ESMF_TraceRegionEnter("(3) Send arrays exchange", rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, & rcToReturn=rc)) return @@ -832,7 +850,7 @@ subroutine ESMF_StateReconcile_driver (state, vm, attreconflag, rc) ! ------------------------------------------------------------------------- if (trace) then call ESMF_ReconcileDebugPrint (ESMF_METHOD // & - ': *** Step 2 - Exchange Ids/VMIds') + ': *** Step 3 - Exchange Ids/VMIds') end if allocate (id_info(0:npets-1), stat=memstat) if (ESMF_LogFoundAllocError(memstat, ESMF_ERR_PASSTHRU, & @@ -851,25 +869,25 @@ subroutine ESMF_StateReconcile_driver (state, vm, attreconflag, rc) rcToReturn=rc)) return ! ------------------------------------------------------------------------- if (profile) then - call ESMF_TraceRegionExit("2.) Send arrays exchange", rc=localrc) + call ESMF_TraceRegionExit("(3) Send arrays exchange", rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, & rcToReturn=rc)) return endif ! ------------------------------------------------------------------------- - if (meminfo) call ESMF_VMLogMemInfo ("after 2.) Send arrays exchange") + if (meminfo) call ESMF_VMLogMemInfo ("after (3) Send arrays exchange") ! At this point, each PET knows what items can be found on all of ! the other PETs. The id_info array has global PET info in it. ! ------------------------------------------------------------------------- - ! 3.) Construct needs list. Receiving PETs compare IDs and VMIds + ! (4) Construct needs list. Receiving PETs compare IDs and VMIds ! in their send ID/VMId array with what was received from the ! currently-being-processed sending PET. Note that multiple PETs ! can 'offer' an item. ! ------------------------------------------------------------------------- if (profile) then - call ESMF_TraceRegionEnter("3.) Construct needs list", rc=localrc) + call ESMF_TraceRegionEnter("(4) Construct needs list", rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, & rcToReturn=rc)) return @@ -877,7 +895,7 @@ subroutine ESMF_StateReconcile_driver (state, vm, attreconflag, rc) ! ------------------------------------------------------------------------- if (trace) then call ESMF_ReconcileDebugPrint (ESMF_METHOD // & - ': *** Step 3 - Compare and create needs arrays') + ': *** Step 4 - Compare and create needs arrays') end if call ESMF_ReconcileCompareNeeds (vm, & id= ids_send, & @@ -891,23 +909,23 @@ subroutine ESMF_StateReconcile_driver (state, vm, attreconflag, rc) rcToReturn=rc)) return ! ------------------------------------------------------------------------- if (profile) then - call ESMF_TraceRegionExit("3.) Construct needs list", rc=localrc) + call ESMF_TraceRegionExit("(4) Construct needs list", rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, & rcToReturn=rc)) return endif ! ------------------------------------------------------------------------- - if (meminfo) call ESMF_VMLogMemInfo ("after 3.) Construct needs list") + if (meminfo) call ESMF_VMLogMemInfo ("after (4) Construct needs list") ! ------------------------------------------------------------------------- - ! 4.) Communicate needs back to the offering PETs. + ! (5) Communicate needs back to the offering PETs. ! Send to each offering PET a buffer containing 'needed' array ! specifying which items are needed. The array is the same size as, ! and corresponds to, the ID and VMId arrays that were previously ! offered. ! ------------------------------------------------------------------------- if (profile) then - call ESMF_TraceRegionEnter("4.) Communicate needs back", rc=localrc) + call ESMF_TraceRegionEnter("(5) Communicate needs back", rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, & rcToReturn=rc)) return @@ -915,7 +933,7 @@ subroutine ESMF_StateReconcile_driver (state, vm, attreconflag, rc) ! ------------------------------------------------------------------------- if (trace) then call ESMF_ReconcileDebugPrint (ESMF_METHOD // & - ': *** Step 4 - Exchange needs') + ': *** Step 5 - Exchange needs') end if recvd_needs_matrix => null () call ESMF_ReconcileExchgNeeds (vm, & @@ -929,19 +947,19 @@ subroutine ESMF_StateReconcile_driver (state, vm, attreconflag, rc) rcToReturn=rc)) return ! ------------------------------------------------------------------------- if (profile) then - call ESMF_TraceRegionExit("4.) Communicate needs back", rc=localrc) + call ESMF_TraceRegionExit("(5) Communicate needs back", rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, & rcToReturn=rc)) return endif ! ------------------------------------------------------------------------- - if (meminfo) call ESMF_VMLogMemInfo ("after 4.) Communicate needs back") + if (meminfo) call ESMF_VMLogMemInfo ("after (5) Communicate needs back") ! ------------------------------------------------------------------------- - ! 5.) Serialize needed objects + ! (6) Serialize needed objects ! ------------------------------------------------------------------------- if (profile) then - call ESMF_TraceRegionEnter("5.) Serialize needed objects", rc=localrc) + call ESMF_TraceRegionEnter("(6) Serialize needed objects", rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, & rcToReturn=rc)) return @@ -949,7 +967,7 @@ subroutine ESMF_StateReconcile_driver (state, vm, attreconflag, rc) ! ------------------------------------------------------------------------- if (trace) then call ESMF_ReconcileDebugPrint (ESMF_METHOD // & - ': *** Step 5 - Serialize needs', ask=.false.) + ': *** Step 6 - Serialize needs', ask=.false.) end if call ESMF_ReconcileSerialize (state, vm, siwrap, & needs_list=recvd_needs_matrix, & @@ -967,19 +985,19 @@ subroutine ESMF_StateReconcile_driver (state, vm, attreconflag, rc) rcToReturn=rc)) return ! ------------------------------------------------------------------------- if (profile) then - call ESMF_TraceRegionExit("5.) Serialize needed objects", rc=localrc) + call ESMF_TraceRegionExit("(6) Serialize needed objects", rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, & rcToReturn=rc)) return endif ! ------------------------------------------------------------------------- - if (meminfo) call ESMF_VMLogMemInfo ("after 5.) Serialize needed objects") + if (meminfo) call ESMF_VMLogMemInfo ("after (6) Serialize needed objects") ! ------------------------------------------------------------------------- - ! 6.) Send/receive serialized objects to whoever needed them + ! (7) Send/receive serialized objects to whoever needed them ! ------------------------------------------------------------------------- if (profile) then - call ESMF_TraceRegionEnter("6.) Send/receive serialized objects", rc=localrc) + call ESMF_TraceRegionEnter("(7) Send/receive serialized objects", rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, & rcToReturn=rc)) return @@ -987,7 +1005,7 @@ subroutine ESMF_StateReconcile_driver (state, vm, attreconflag, rc) ! ------------------------------------------------------------------------- if (trace) then call ESMF_ReconcileDebugPrint (ESMF_METHOD // & - ': *** Step 6 - Exchange serialized objects') + ': *** Step 7 - Exchange serialized objects') end if allocate (items_recv(0:npets-1), stat=memstat) if (ESMF_LogFoundAllocError(memstat, ESMF_ERR_PASSTHRU, & @@ -1006,20 +1024,20 @@ subroutine ESMF_StateReconcile_driver (state, vm, attreconflag, rc) rcToReturn=rc)) return ! ------------------------------------------------------------------------- if (profile) then - call ESMF_TraceRegionExit("6.) Send/receive serialized objects", rc=localrc) + call ESMF_TraceRegionExit("(7) Send/receive serialized objects", rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, & rcToReturn=rc)) return endif ! ------------------------------------------------------------------------- - if (meminfo) call ESMF_VMLogMemInfo ("after 6.) Send/receive serialized objects") + if (meminfo) call ESMF_VMLogMemInfo ("after (7) Send/receive serialized objects") ! ------------------------------------------------------------------------- - ! 7.) Deserialize received objects and create proxies (recurse on + ! (8) Deserialize received objects and create proxies (recurse on ! nested States as needed) ! ------------------------------------------------------------------------- if (profile) then - call ESMF_TraceRegionEnter("7.) Deserialize received objects and create proxies", rc=localrc) + call ESMF_TraceRegionEnter("(8) Deserialize received objects and create proxies", rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, & rcToReturn=rc)) return @@ -1027,7 +1045,7 @@ subroutine ESMF_StateReconcile_driver (state, vm, attreconflag, rc) ! ------------------------------------------------------------------------- if (trace) then call ESMF_ReconcileDebugPrint (ESMF_METHOD // & - ': *** Step 7 - Deserialize needs') + ': *** Step 8 - Deserialize needs') end if do, i=0, npets-1 if (debug) then @@ -1055,7 +1073,7 @@ subroutine ESMF_StateReconcile_driver (state, vm, attreconflag, rc) end do if (trace) then call ESMF_ReconcileDebugPrint (ESMF_METHOD // & - ': *** Step 7 - Complete') + ': *** Step 8 - Complete') end if ! Clean up @@ -1128,13 +1146,13 @@ subroutine ESMF_StateReconcile_driver (state, vm, attreconflag, rc) rcToReturn=rc)) return ! ------------------------------------------------------------------------- if (profile) then - call ESMF_TraceRegionExit("7.) Deserialize received objects and create proxies", rc=localrc) + call ESMF_TraceRegionExit("(8) Deserialize received objects and create proxies", rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, & rcToReturn=rc)) return endif ! ------------------------------------------------------------------------- - if (meminfo) call ESMF_VMLogMemInfo ("after 7.) Deserialize received objects and create proxies") + if (meminfo) call ESMF_VMLogMemInfo ("after (8) Deserialize received objects and create proxies") if (trace) then call ESMF_ReconcileDebugPrint (ESMF_METHOD // ': Complete!') From 8522ed04f22d4cfc5aa62b004fd6610a4fb5ebda Mon Sep 17 00:00:00 2001 From: Gerhard Theurich Date: Thu, 26 Sep 2024 11:11:16 -0600 Subject: [PATCH 036/207] Separate case 3 specific code into a subroutine to allow case 2 implementation. --- .../src/ESMF_StateReconcile.F90 | 159 ++++++++++++------ 1 file changed, 104 insertions(+), 55 deletions(-) diff --git a/src/Superstructure/StateReconcile/src/ESMF_StateReconcile.F90 b/src/Superstructure/StateReconcile/src/ESMF_StateReconcile.F90 index 73756d06f6..53dff95d48 100644 --- a/src/Superstructure/StateReconcile/src/ESMF_StateReconcile.F90 +++ b/src/Superstructure/StateReconcile/src/ESMF_StateReconcile.F90 @@ -786,6 +786,99 @@ subroutine ESMF_StateReconcile_driver (state, vm, attreconflag, rc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, rcToReturn=rc)) return #endif + call handle_case3() + + ! Clean up + + ! ------------------------------------------------------------------------- + if (profile) then + call ESMF_TraceRegionEnter("(X) Clean-up", rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, & + rcToReturn=rc)) return + endif + ! ------------------------------------------------------------------------- + if (trace) then + call ESMF_ReconcileDebugPrint (ESMF_METHOD // & + ': *** Step X.0 - Clean-up') + end if + + if (associated (ids_send)) then + deallocate (ids_send, vmids_send, stat=memstat) + if (ESMF_LogFoundDeallocError(memstat, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, & + rcToReturn=rc)) return + end if + + call ESMF_VMIdDestroy(vmIdMap, rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, rcToReturn=rc)) return + + deallocate (vmIdMap, stat=memstat) + if (ESMF_LogFoundDeallocError(memstat, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, & + rcToReturn=rc)) return + + if (associated (siwrap)) then + deallocate (siwrap, stat=memstat) + if (ESMF_LogFoundDeallocError(memstat, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, & + rcToReturn=rc)) return + end if + + deallocate (nitems_buf, stat=memstat) + if (ESMF_LogFoundDeallocError(memstat, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, & + rcToReturn=rc)) return + + ! ------------------------------------------------------------------------- + if (profile) then + call ESMF_TraceRegionExit("(X) Clean-up", rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, & + rcToReturn=rc)) return + endif + ! ------------------------------------------------------------------------- + if (meminfo) call ESMF_VMLogMemInfo ("after (X) Clean-up") + + ! ------------------------------------------------------------------------- + if (profile) then + call ESMF_TraceRegionEnter("(X+1) Reconcile Zapped Proxies", rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, & + rcToReturn=rc)) return + endif + ! ------------------------------------------------------------------------- + if (trace) then + call ESMF_ReconcileDebugPrint (ESMF_METHOD // & + ': *** Step X+1.0 - Reconcile Zapped Proxies') + end if + call ESMF_ReconcileZappedProxies(state, rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, & + rcToReturn=rc)) return + + ! ------------------------------------------------------------------------- + if (profile) then + call ESMF_TraceRegionExit("(X+1) Reconcile Zapped Proxies", rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, & + rcToReturn=rc)) return + endif + ! ------------------------------------------------------------------------- + if (meminfo) call ESMF_VMLogMemInfo ("(X+1) Reconcile Zapped Proxies") + + if (trace) then + call ESMF_ReconcileDebugPrint (ESMF_METHOD // ': Complete!') + call ESMF_VMBarrier (vm) + end if + rc = ESMF_SUCCESS + + if (meminfo) call ESMF_VMLogMemInfo ("exiting ESMF_StateReconcile_driver") + + contains + + subroutine handle_case3() + ! ------------------------------------------------------------------------- if (profile) then call ESMF_TraceRegionEnter("(2) Update Field metadata", rc=localrc) @@ -1076,13 +1169,17 @@ subroutine ESMF_StateReconcile_driver (state, vm, attreconflag, rc) ': *** Step 8 - Complete') end if -! Clean up + ! ------------------------------------------------------------------------- + if (profile) then + call ESMF_TraceRegionExit("(8) Deserialize received objects and create proxies", rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, & + rcToReturn=rc)) return + endif + ! ------------------------------------------------------------------------- + if (meminfo) call ESMF_VMLogMemInfo ("after (8) Deserialize received objects and create proxies") - if (trace) then - call ESMF_ReconcileDebugPrint (ESMF_METHOD // & - ': At clean up.', ask=.false.) - call ESMF_VMBarrier (vm) - end if + ! Clean up if (associated (buffer_recv)) then deallocate (buffer_recv, stat=memstat) @@ -1091,13 +1188,6 @@ subroutine ESMF_StateReconcile_driver (state, vm, attreconflag, rc) rcToReturn=rc)) return end if - if (associated (ids_send)) then - deallocate (ids_send, vmids_send, stat=memstat) - if (ESMF_LogFoundDeallocError(memstat, ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, & - rcToReturn=rc)) return - end if - do, i=0, ubound (id_info, 1) if (associated (id_info(i)%id)) then deallocate (id_info(i)%id, id_info(i)%vmid, id_info(i)%needed, & @@ -1114,53 +1204,12 @@ subroutine ESMF_StateReconcile_driver (state, vm, attreconflag, rc) rcToReturn=rc)) return end if end do - - call ESMF_VMIdDestroy(vmIdMap, rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, rcToReturn=rc)) return - - deallocate (vmIdMap, stat=memstat) - if (ESMF_LogFoundDeallocError(memstat, ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, & - rcToReturn=rc)) return - deallocate (id_info, stat=memstat) if (ESMF_LogFoundDeallocError(memstat, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, & rcToReturn=rc)) return - if (associated (siwrap)) then - deallocate (siwrap, stat=memstat) - if (ESMF_LogFoundDeallocError(memstat, ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, & - rcToReturn=rc)) return - end if - - deallocate (nitems_buf, stat=memstat) - if (ESMF_LogFoundDeallocError(memstat, ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, & - rcToReturn=rc)) return - - call ESMF_ReconcileZappedProxies (state, localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, & - rcToReturn=rc)) return - ! ------------------------------------------------------------------------- - if (profile) then - call ESMF_TraceRegionExit("(8) Deserialize received objects and create proxies", rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, & - rcToReturn=rc)) return - endif - ! ------------------------------------------------------------------------- - if (meminfo) call ESMF_VMLogMemInfo ("after (8) Deserialize received objects and create proxies") - - if (trace) then - call ESMF_ReconcileDebugPrint (ESMF_METHOD // ': Complete!') - call ESMF_VMBarrier (vm) - end if - rc = ESMF_SUCCESS - - if (meminfo) call ESMF_VMLogMemInfo ("exiting ESMF_StateReconcile_driver") + end subroutine handle_case3 end subroutine ESMF_StateReconcile_driver From 6f1d8720d1003fd73726d3180d3372c78d5b7441 Mon Sep 17 00:00:00 2001 From: Gerhard Theurich Date: Thu, 26 Sep 2024 11:39:56 -0600 Subject: [PATCH 037/207] Fix issues with State logging option in JSON format inside Reconcile, and some related clean-up. --- .../src/ESMF_StateReconcile.F90 | 42 ++++++++----------- 1 file changed, 18 insertions(+), 24 deletions(-) diff --git a/src/Superstructure/StateReconcile/src/ESMF_StateReconcile.F90 b/src/Superstructure/StateReconcile/src/ESMF_StateReconcile.F90 index 53dff95d48..16b46cec21 100644 --- a/src/Superstructure/StateReconcile/src/ESMF_StateReconcile.F90 +++ b/src/Superstructure/StateReconcile/src/ESMF_StateReconcile.F90 @@ -67,7 +67,7 @@ module ESMF_StateReconcileMod use ESMF_TraceMod - use ESMF_InfoMod, only : ESMF_Info, ESMF_InfoGetFromBase, ESMF_InfoUpdate + use ESMF_InfoMod use ESMF_InfoCacheMod implicit none @@ -267,21 +267,6 @@ subroutine ESMF_StateReconcile(state, vm, rc) rcToReturn=rc)) return endif -#if 0 - ! Log a JSON State representation ----------------------------------------- - - call idesc%Initialize(createInfo=.true., addObjectInfo=.true., rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, rcToReturn=rc)) return - call idesc%Update(state, "", rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, rcToReturn=rc)) return - call ESMF_LogWrite("InfoDescribe before InfoCacheReassembleFields=", rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, rcToReturn=rc)) return - call ESMF_LogWrite("state_json_before_reassemble="//ESMF_InfoDump(idesc%info), rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, rcToReturn=rc)) return - call idesc%Destroy(rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, rcToReturn=rc)) return -#endif - if (profile) then call ESMF_TraceRegionEnter("ESMF_InfoCacheReassembleFields", rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & @@ -297,6 +282,20 @@ subroutine ESMF_StateReconcile(state, vm, rc) call ESMF_InfoCacheReassembleFieldsFinalize(state, localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, rcToReturn=rc)) return +#if 0 + ! Log a JSON State representation ----------------------------------------- + call idesc%Initialize(createInfo=.true., addObjectInfo=.true., rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, rcToReturn=rc)) return + call idesc%Update(state, "", rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, rcToReturn=rc)) return + call ESMF_LogWrite("InfoDescribe before InfoCacheReassembleFields=", rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, rcToReturn=rc)) return + call ESMF_LogWrite("state_json_before_reassemble="//ESMF_InfoDump(idesc%info), rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, rcToReturn=rc)) return + call idesc%Destroy(rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, rcToReturn=rc)) return +#endif + if (profile) then call ESMF_TraceRegionExit("ESMF_InfoCacheReassembleFields", rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & @@ -612,7 +611,6 @@ subroutine ESMF_StateReconcile_driver (state, vm, attreconflag, rc) character(160) :: prefixStr type(ESMF_VMId), allocatable, target :: vmIdMap(:) - type(ESMF_VMId), pointer :: vmIdMap_ptr(:) character(len=ESMF_MAXSTR) :: logmsg @@ -621,7 +619,6 @@ subroutine ESMF_StateReconcile_driver (state, vm, attreconflag, rc) ! ------------------------------------------------------------------------- localrc = ESMF_RC_NOT_IMPL - nullify(vmIdMap_ptr) if (meminfo) call ESMF_VMLogMemInfo ("entering ESMF_StateReconcile_driver") @@ -758,8 +755,6 @@ subroutine ESMF_StateReconcile_driver (state, vm, attreconflag, rc) rcToReturn=rc)) return endif - vmIdMap_ptr => vmIdMap - ! ------------------------------------------------------------------------- if (profile) then call ESMF_TraceRegionExit("(1) Construct send arrays", rc=localrc) @@ -772,9 +767,8 @@ subroutine ESMF_StateReconcile_driver (state, vm, attreconflag, rc) #if 0 ! Log a JSON State representation ----------------------------------------- - - call idesc%Initialize(createInfo=.true., addObjectInfo=.true., vmIdMap=vmIdMap_ptr, & - vmIdMapGeomExc=.true., rc=localrc) + call idesc%Initialize(createInfo=.true., addObjectInfo=.true., & + vmIdMap=vmIdMap, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, rcToReturn=rc)) return call idesc%Update(state, "", rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, rcToReturn=rc)) return @@ -907,7 +901,7 @@ subroutine handle_case3() call info_cache%Initialize(localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, rcToReturn=rc)) return - call info_cache%UpdateFields(state, vmIdMap_ptr, localrc) + call info_cache%UpdateFields(state, vmIdMap, localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, rcToReturn=rc)) return call info_cache%Destroy(localrc) From a63200c9be5623255d863fba2f3809064cd4dd5d Mon Sep 17 00:00:00 2001 From: Robert Oehmke Date: Thu, 26 Sep 2024 12:07:47 -0600 Subject: [PATCH 038/207] Add functionality for getting the leftmost on bit to VMId. --- src/Infrastructure/VM/include/ESMCI_VM.h | 1 + src/Infrastructure/VM/interface/ESMCI_VM_F.C | 18 +++++++ src/Infrastructure/VM/interface/ESMF_VM.F90 | 53 ++++++++++++++++++++ src/Infrastructure/VM/src/ESMCI_VM.C | 44 ++++++++++++++++ 4 files changed, 116 insertions(+) diff --git a/src/Infrastructure/VM/include/ESMCI_VM.h b/src/Infrastructure/VM/include/ESMCI_VM.h index 8fdb37aa54..49f17cff98 100644 --- a/src/Infrastructure/VM/include/ESMCI_VM.h +++ b/src/Infrastructure/VM/include/ESMCI_VM.h @@ -61,6 +61,7 @@ class VMId { int create (); // allocates memory for vmKey member int destroy (); // frees memory for vmKey member int get(int *localID, char *key, int key_len); + int getLeftmostOnBit(int *leftmostOnBit); int set(int localID, const char *key, int key_len); int serialize(const char *buffer, int *length, int *offset, const ESMC_InquireFlag &inquireflag); diff --git a/src/Infrastructure/VM/interface/ESMCI_VM_F.C b/src/Infrastructure/VM/interface/ESMCI_VM_F.C index ff9f1fea75..dc24cdb3ab 100644 --- a/src/Infrastructure/VM/interface/ESMCI_VM_F.C +++ b/src/Infrastructure/VM/interface/ESMCI_VM_F.C @@ -1746,6 +1746,24 @@ extern "C" { if (rc!=NULL) *rc = ESMF_SUCCESS; // TODO: finish error handling } + + void FTN_X(c_esmci_vmidgetleftmostonbit)(ESMCI::VMId **vmid, int *leftmostOnBit, + int *rc) { +#undef ESMC_METHOD +#define ESMC_METHOD "c_esmci_vmidgetleftmostonbit()" + // Initialize return code; assume routine not implemented + if (rc!=NULL) *rc = ESMC_RC_NOT_IMPL; + int localrc = ESMC_RC_NOT_IMPL; + // test for NULL pointer via macro before calling any class methods + ESMCI_NULL_CHECK_PRC(vmid, rc) + ESMCI_NULL_CHECK_PRC(*vmid, rc) + localrc = (*vmid)->getLeftmostOnBit(leftmostOnBit); + if (ESMC_LogDefault.MsgFoundError(localrc, ESMCI_ERR_PASSTHRU, ESMC_CONTEXT, + rc)) return; + // return successfully + if (rc!=NULL) *rc = ESMF_SUCCESS; // TODO: finish error handling + } + void FTN_X(c_esmc_vmidlog)(ESMCI::VMId **vmid, char *prefix, ESMC_LogMsgType_Flag *logMsgFlag, int *rc, ESMCI_FortranStrLenArg prefix_l){ #undef ESMC_METHOD diff --git a/src/Infrastructure/VM/interface/ESMF_VM.F90 b/src/Infrastructure/VM/interface/ESMF_VM.F90 index 3cd4266171..04eea6e2d1 100644 --- a/src/Infrastructure/VM/interface/ESMF_VM.F90 +++ b/src/Infrastructure/VM/interface/ESMF_VM.F90 @@ -10466,6 +10466,59 @@ end subroutine ESMF_VMIdCopy !------------------------------------------------------------------------------ +! -------------------------- ESMF-internal method ----------------------------- +#undef ESMF_METHOD +#define ESMF_METHOD "ESMF_VMIdGet()" +!BOPI +! !IROUTINE: ESMF_VMIdGet - Get information about a VMId object + +! !INTERFACE: + subroutine ESMF_VMIdGet(vmId, leftMostOnBit, rc) +! +! !ARGUMENTS: + type(ESMF_VMId), intent(in) :: vmId + integer, intent(out), optional :: leftMostOnBit + integer, intent(out), optional :: rc +! +! !DESCRIPTION: +! Copy the contents of ESMF_VMId objects. Note that the destination +! objects must have been (deeply) allocated prior to calling this +! copy. +! +! The arguments are: +! \begin{description} +! \item[vmId] +! VMId to get information from. +! \item[leftMostOnBit] +! The index (base 0) of the leftmost on bit in the VMId. If the index is -1, +! then there were no on bits +! \item[{[rc]}] +! Return code; equals {\tt ESMF\_SUCCESS} if there are no errors. +! \end{description} +! +!EOPI +!------------------------------------------------------------------------------ + integer :: localrc ! local return code + integer :: i + type(ESMF_Logical) :: tf + + ! initialize return code; assume routine not implemented + localrc = ESMF_RC_NOT_IMPL + if (present(rc)) rc = ESMF_RC_NOT_IMPL + + ! Call into the C++ interface + if (present(leftMostOnBit)) then + call c_ESMCI_VMIdGetLeftMostOnBit(vmId, leftMostOnBit, localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, rcToReturn=rc)) return + endif + + ! return successfully + if (present(rc)) rc = ESMF_SUCCESS + + end subroutine ESMF_VMIdGet +!------------------------------------------------------------------------------ + ! -------------------------- ESMF-internal method ----------------------------- #undef ESMF_METHOD #define ESMF_METHOD "ESMF_VMIdLog()" diff --git a/src/Infrastructure/VM/src/ESMCI_VM.C b/src/Infrastructure/VM/src/ESMCI_VM.C index e609585189..86c2111e5a 100644 --- a/src/Infrastructure/VM/src/ESMCI_VM.C +++ b/src/Infrastructure/VM/src/ESMCI_VM.C @@ -405,6 +405,50 @@ int VMId::get( //----------------------------------------------------------------------------- +//----------------------------------------------------------------------------- +#undef ESMC_METHOD +#define ESMC_METHOD "ESMCI::VMId::getLeftmostOnBit()" +//BOPI +// !IROUTINE: ESMCI::VMId::getLeftmostOnBit +// +// !RETURN VALUE: +// int return code +// +// !INTERFACE: +int VMId::getLeftmostOnBit( +// +// !RETURN VALUE: +// int return code +// +// +// !ARGUMENTS: +// + int *leftmostOnBit + ){ +// +// !DESCRIPTION: +// Gets the index of the leftmost on bit of the VMId. If there are on on bits, then +// returns -1. +// +//EOPI +//----------------------------------------------------------------------------- + // Initialize return code; assume routine not implemented + int localrc = ESMC_RC_NOT_IMPL; + + // Get leftmost + unsigned unsigned_leftmost=VMKeyFirstBitFromLeft(this->vmKey); + + // a value returned of vmKeyWidth * 8 indicates that no bit was set + if (unsigned_leftmost == vmKeyWidth*8) *leftmostOnBit=-1; + else *leftmostOnBit=(signed int)unsigned_leftmost; + + localrc = ESMF_SUCCESS; + return localrc; +} +//----------------------------------------------------------------------------- + + + //----------------------------------------------------------------------------- #undef ESMC_METHOD #define ESMC_METHOD "ESMCI::VMId::set()" From ea2ea0b29abcb6c79f2978fe46acbb07f0fb23dd Mon Sep 17 00:00:00 2001 From: Gerhard Theurich Date: Thu, 26 Sep 2024 13:51:23 -0600 Subject: [PATCH 039/207] Implement decision between SingleCompCase and MultiCompCase in StateReconcile_driver(). --- .../src/ESMF_StateReconcile.F90 | 115 +++++++++++++++++- 1 file changed, 111 insertions(+), 4 deletions(-) diff --git a/src/Superstructure/StateReconcile/src/ESMF_StateReconcile.F90 b/src/Superstructure/StateReconcile/src/ESMF_StateReconcile.F90 index 16b46cec21..3226da2568 100644 --- a/src/Superstructure/StateReconcile/src/ESMF_StateReconcile.F90 +++ b/src/Superstructure/StateReconcile/src/ESMF_StateReconcile.F90 @@ -611,12 +611,16 @@ subroutine ESMF_StateReconcile_driver (state, vm, attreconflag, rc) character(160) :: prefixStr type(ESMF_VMId), allocatable, target :: vmIdMap(:) + type(ESMF_VMId), pointer :: vmIdSingleComp + integer :: rootPetSingleComp character(len=ESMF_MAXSTR) :: logmsg type(ESMF_InfoCache) :: info_cache type(ESMF_InfoDescribe) :: idesc + logical :: singleCompCaseFlag + ! ------------------------------------------------------------------------- localrc = ESMF_RC_NOT_IMPL @@ -744,7 +748,8 @@ subroutine ESMF_StateReconcile_driver (state, vm, attreconflag, rc) endif do i=lbound(vmintids_send,1),ubound(vmintids_send,1) if (vmintids_send(i) <= 0) then - if (ESMF_LogFoundError(ESMF_FAILURE, msg="A <= zero VM integer id was encountered", & + if (ESMF_LogFoundError(ESMF_FAILURE, & + msg="A <= zero VM integer id was encountered", & ESMF_CONTEXT, rcToReturn=rc)) return end if enddo @@ -780,7 +785,74 @@ subroutine ESMF_StateReconcile_driver (state, vm, attreconflag, rc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, rcToReturn=rc)) return #endif - call handle_case3() + ! Decide between SingleComp case and MultiComp case + singleCompCaseFlag = .false. + if (size(vmIdMap)==1) then + singleCompCaseFlag = all(vmintids_send(1:)==1) + vmIdSingleComp => vmIdMap(1) + else if (size(vmIdMap)==2) then + singleCompCaseFlag = all(vmintids_send(1:)==2) ! most likely case + vmIdSingleComp => vmIdMap(2) + endif + +block + character(1600):: msgStr + write(msgStr,*) "size(vmintids_send): ", size(vmintids_send) + call ESMF_LogWrite(msgStr, ESMF_LOGMSG_DEBUG, rc=rc) + write(msgStr,*) "size(vmIdMap): ", size(vmIdMap) + call ESMF_LogWrite(msgStr, ESMF_LOGMSG_DEBUG, rc=rc) + write(msgStr,*) "singleCompCaseFlag: ", singleCompCaseFlag + call ESMF_LogWrite(msgStr, ESMF_LOGMSG_DEBUG, rc=rc) +end block + + if (singleCompCaseFlag) then + ! CASE: a single component interacting with a state + ! ------------------------------------------------------------------------ + if (profile) then + call ESMF_TraceRegionEnter("Single Comp Case", rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, & + rcToReturn=rc)) return + endif + ! ------------------------------------------------------------------------ +#if 0 +!TODO: enable SingleComp case when implemented + call ESMF_ReconcileSingleCompCase(vmId=vmIdSingleComp, & + rootPet=rootPetSingleComp), rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, & + rcToReturn=rc)) return +#else + call ESMF_ReconcileMultiCompCase() +#endif + ! ------------------------------------------------------------------------ + if (profile) then + call ESMF_TraceRegionExit("Single Comp Case", rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, & + rcToReturn=rc)) return + endif + ! ------------------------------------------------------------------------ + else + ! CASE: multiple components interacting with a state + ! ------------------------------------------------------------------------ + if (profile) then + call ESMF_TraceRegionEnter("Multi Comp Case", rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, & + rcToReturn=rc)) return + endif + ! ------------------------------------------------------------------------ + call ESMF_ReconcileMultiCompCase() + ! ------------------------------------------------------------------------ + if (profile) then + call ESMF_TraceRegionExit("Single Comp Case", rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, & + rcToReturn=rc)) return + endif + ! ------------------------------------------------------------------------ + endif ! Clean up @@ -871,7 +943,7 @@ subroutine ESMF_StateReconcile_driver (state, vm, attreconflag, rc) contains - subroutine handle_case3() + subroutine ESMF_ReconcileMultiCompCase() ! ------------------------------------------------------------------------- if (profile) then @@ -1203,10 +1275,45 @@ subroutine handle_case3() ESMF_CONTEXT, & rcToReturn=rc)) return - end subroutine handle_case3 + end subroutine ESMF_ReconcileMultiCompCase end subroutine ESMF_StateReconcile_driver +!------------------------------------------------------------------------------ +#undef ESMF_METHOD +#define ESMF_METHOD "ESMF_ReconcileSingleCompCase" +!BOPI +! !IROUTINE: ESMF_ReconcileSingleCompCase +! +! !INTERFACE: + subroutine ESMF_ReconcileSingleCompCase(vmId, rootPet, rc) +! +! !ARGUMENTS: + type(ESMF_VMId), pointer :: vmId + integer, intent(in) :: rootPet + integer, intent(out) :: rc +! +! !DESCRIPTION: +! +! Handle the single component reconciliation case. This is the expected +! situation under NUOPC rules. +! +! The arguments are: +! \begin{description} +! \item[vmId] +! The ESMF\_VMId} of the single component who ownes all objects present +! in the state. +! \item[rootPet] +! The lowest PET that holds actual objects. +! \item[rc] +! Return code; equals {\tt ESMF\_SUCCESS} if there are no errors. +! \end{description} +!EOPI + + rc = ESMF_SUCCESS + + end subroutine ESMF_ReconcileSingleCompCase + !------------------------------------------------------------------------------ #undef ESMF_METHOD #define ESMF_METHOD "ESMF_ReconcileCompareNeeds" From 87ac463625fa9eb25e52ac89f79c8b68cbcd557b Mon Sep 17 00:00:00 2001 From: Gerhard Theurich Date: Thu, 26 Sep 2024 14:28:21 -0600 Subject: [PATCH 040/207] Refine and complete the information passed into ESMF_ReconcileSingleCompCase(). --- src/Infrastructure/VM/interface/ESMF_VM.F90 | 1 + .../src/ESMF_StateReconcile.F90 | 46 ++++++++++++++++--- 2 files changed, 41 insertions(+), 6 deletions(-) diff --git a/src/Infrastructure/VM/interface/ESMF_VM.F90 b/src/Infrastructure/VM/interface/ESMF_VM.F90 index 04eea6e2d1..20d8ecce10 100644 --- a/src/Infrastructure/VM/interface/ESMF_VM.F90 +++ b/src/Infrastructure/VM/interface/ESMF_VM.F90 @@ -480,6 +480,7 @@ subroutine c_ESMC_VMSendRecvNB(vm, sendData, sendSize, dst, recvData, & public ESMF_VMIdCopy public ESMF_VMIdCreate public ESMF_VMIdDestroy + public ESMF_VMIdGet public ESMF_VMIdLog public ESMF_VMIdPrint public ESMF_VMSendVMId diff --git a/src/Superstructure/StateReconcile/src/ESMF_StateReconcile.F90 b/src/Superstructure/StateReconcile/src/ESMF_StateReconcile.F90 index 3226da2568..34b17ab759 100644 --- a/src/Superstructure/StateReconcile/src/ESMF_StateReconcile.F90 +++ b/src/Superstructure/StateReconcile/src/ESMF_StateReconcile.F90 @@ -612,7 +612,6 @@ subroutine ESMF_StateReconcile_driver (state, vm, attreconflag, rc) character(160) :: prefixStr type(ESMF_VMId), allocatable, target :: vmIdMap(:) type(ESMF_VMId), pointer :: vmIdSingleComp - integer :: rootPetSingleComp character(len=ESMF_MAXSTR) :: logmsg @@ -796,7 +795,7 @@ subroutine ESMF_StateReconcile_driver (state, vm, attreconflag, rc) endif block - character(1600):: msgStr + character(160):: msgStr write(msgStr,*) "size(vmintids_send): ", size(vmintids_send) call ESMF_LogWrite(msgStr, ESMF_LOGMSG_DEBUG, rc=rc) write(msgStr,*) "size(vmIdMap): ", size(vmIdMap) @@ -817,8 +816,7 @@ subroutine ESMF_StateReconcile_driver (state, vm, attreconflag, rc) ! ------------------------------------------------------------------------ #if 0 !TODO: enable SingleComp case when implemented - call ESMF_ReconcileSingleCompCase(vmId=vmIdSingleComp, & - rootPet=rootPetSingleComp), rc=localrc) + call ESMF_ReconcileSingleCompCase(vm=vm, vmId=vmIdSingleComp, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, & rcToReturn=rc)) return @@ -1286,11 +1284,11 @@ end subroutine ESMF_StateReconcile_driver ! !IROUTINE: ESMF_ReconcileSingleCompCase ! ! !INTERFACE: - subroutine ESMF_ReconcileSingleCompCase(vmId, rootPet, rc) + subroutine ESMF_ReconcileSingleCompCase(vm, vmId, rc) ! ! !ARGUMENTS: + type(ESMF_VM), intent(in) :: vm type(ESMF_VMId), pointer :: vmId - integer, intent(in) :: rootPet integer, intent(out) :: rc ! ! !DESCRIPTION: @@ -1300,6 +1298,8 @@ subroutine ESMF_ReconcileSingleCompCase(vmId, rootPet, rc) ! ! The arguments are: ! \begin{description} +! \item[vm] +! The ESMF\_VM} object across which the state is reconciled. ! \item[vmId] ! The ESMF\_VMId} of the single component who ownes all objects present ! in the state. @@ -1310,8 +1310,42 @@ subroutine ESMF_ReconcileSingleCompCase(vmId, rootPet, rc) ! \end{description} !EOPI + integer :: localrc + integer :: petCount, localPet, rootVas, rootPet, vas + rc = ESMF_SUCCESS + call ESMF_VMGet(vm, petCount=petCount, localPet=localPet, rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, & + rcToReturn=rc)) return + + call ESMF_VMIdGet(vmId, leftMostOnBit=rootVas, rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, & + rcToReturn=rc)) return + + ! search for PET in VM that executes on rootVas + do rootPet=0, petCount-1 + call ESMF_VMGet(vm, pet=rootPet, vas=vas, rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, & + rcToReturn=rc)) return + if (vas==rootVas) exit ! found + enddo + if (rootPet==petCount) then + call ESMF_LogSetError(ESMF_RC_INTNRL_INCONS, & + msg="Could not find PET that executes on the identified VAS", & + ESMF_CONTEXT, rcToReturn=rc) + return + endif + +block + character(160) :: msgStr + write(msgStr,*) "SingleCompCase rootPet=", rootPet + call ESMF_LogWrite(msgStr, ESMF_LOGMSG_DEBUG, rc=localrc) +end block + end subroutine ESMF_ReconcileSingleCompCase !------------------------------------------------------------------------------ From 900aa5987a5a927dba1a53c9348ed48160fc557a Mon Sep 17 00:00:00 2001 From: Gerhard Theurich Date: Thu, 26 Sep 2024 15:16:43 -0600 Subject: [PATCH 041/207] Move case decision code into performance region (1). Clean-up some profiling details. Simplify vmintids check. --- .../src/ESMF_StateReconcile.F90 | 54 +++++++++++-------- 1 file changed, 33 insertions(+), 21 deletions(-) diff --git a/src/Superstructure/StateReconcile/src/ESMF_StateReconcile.F90 b/src/Superstructure/StateReconcile/src/ESMF_StateReconcile.F90 index 34b17ab759..041f93ab99 100644 --- a/src/Superstructure/StateReconcile/src/ESMF_StateReconcile.F90 +++ b/src/Superstructure/StateReconcile/src/ESMF_StateReconcile.F90 @@ -745,13 +745,12 @@ subroutine ESMF_StateReconcile_driver (state, vm, attreconflag, rc) ESMF_CONTEXT, & rcToReturn=rc)) return endif - do i=lbound(vmintids_send,1),ubound(vmintids_send,1) - if (vmintids_send(i) <= 0) then - if (ESMF_LogFoundError(ESMF_FAILURE, & - msg="A <= zero VM integer id was encountered", & - ESMF_CONTEXT, rcToReturn=rc)) return - end if - enddo + if (any(vmintids_send(:) <= 0)) then + call ESMF_LogSetError(ESMF_RC_INTNRL_INCONS, & + msg="All integer VM ids must be greater than 0!", & + ESMF_CONTEXT, rcToReturn=rc) + return + endif if (profile) then call ESMF_TraceRegionExit("Check vmIntIds", rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & @@ -759,6 +758,29 @@ subroutine ESMF_StateReconcile_driver (state, vm, attreconflag, rc) rcToReturn=rc)) return endif + ! Use the translated VM ids information to make decision about the case + if (profile) then + call ESMF_TraceRegionEnter("Decide between cases", rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, & + rcToReturn=rc)) return + endif + ! Decide between SingleComp and MultiComp case + singleCompCaseFlag = .false. + if (size(vmIdMap)==1) then + singleCompCaseFlag = all(vmintids_send(1:)==1) + vmIdSingleComp => vmIdMap(1) + else if (size(vmIdMap)==2) then + singleCompCaseFlag = all(vmintids_send(1:)==2) ! most likely case + vmIdSingleComp => vmIdMap(2) + endif + if (profile) then + call ESMF_TraceRegionExit("Decide between cases", rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, & + rcToReturn=rc)) return + endif + ! ------------------------------------------------------------------------- if (profile) then call ESMF_TraceRegionExit("(1) Construct send arrays", rc=localrc) @@ -784,16 +806,6 @@ subroutine ESMF_StateReconcile_driver (state, vm, attreconflag, rc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, rcToReturn=rc)) return #endif - ! Decide between SingleComp case and MultiComp case - singleCompCaseFlag = .false. - if (size(vmIdMap)==1) then - singleCompCaseFlag = all(vmintids_send(1:)==1) - vmIdSingleComp => vmIdMap(1) - else if (size(vmIdMap)==2) then - singleCompCaseFlag = all(vmintids_send(1:)==2) ! most likely case - vmIdSingleComp => vmIdMap(2) - endif - block character(160):: msgStr write(msgStr,*) "size(vmintids_send): ", size(vmintids_send) @@ -808,7 +820,7 @@ subroutine ESMF_StateReconcile_driver (state, vm, attreconflag, rc) ! CASE: a single component interacting with a state ! ------------------------------------------------------------------------ if (profile) then - call ESMF_TraceRegionEnter("Single Comp Case", rc=localrc) + call ESMF_TraceRegionEnter("ESMF_ReconcileSingleCompCase", rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, & rcToReturn=rc)) return @@ -825,7 +837,7 @@ subroutine ESMF_StateReconcile_driver (state, vm, attreconflag, rc) #endif ! ------------------------------------------------------------------------ if (profile) then - call ESMF_TraceRegionExit("Single Comp Case", rc=localrc) + call ESMF_TraceRegionExit("ESMF_ReconcileSingleCompCase", rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, & rcToReturn=rc)) return @@ -835,7 +847,7 @@ subroutine ESMF_StateReconcile_driver (state, vm, attreconflag, rc) ! CASE: multiple components interacting with a state ! ------------------------------------------------------------------------ if (profile) then - call ESMF_TraceRegionEnter("Multi Comp Case", rc=localrc) + call ESMF_TraceRegionEnter("ESMF_ReconcileMultiCompCase", rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, & rcToReturn=rc)) return @@ -844,7 +856,7 @@ subroutine ESMF_StateReconcile_driver (state, vm, attreconflag, rc) call ESMF_ReconcileMultiCompCase() ! ------------------------------------------------------------------------ if (profile) then - call ESMF_TraceRegionExit("Single Comp Case", rc=localrc) + call ESMF_TraceRegionExit("ESMF_ReconcileMultiCompCase", rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, & rcToReturn=rc)) return From 84d44627aaf6d91b7693bf9bfcb69aeca14e2985 Mon Sep 17 00:00:00 2001 From: Gerhard Theurich Date: Thu, 26 Sep 2024 17:30:10 -0600 Subject: [PATCH 042/207] One more rework of logic to find 'singleCompCaseFlag' and 'vmIdSingleComp'. Also add a comment describing why this logic is much more complicated than might be expected. --- .../src/ESMF_StateReconcile.F90 | 21 ++++++++++++++----- 1 file changed, 16 insertions(+), 5 deletions(-) diff --git a/src/Superstructure/StateReconcile/src/ESMF_StateReconcile.F90 b/src/Superstructure/StateReconcile/src/ESMF_StateReconcile.F90 index 041f93ab99..8bc83ed970 100644 --- a/src/Superstructure/StateReconcile/src/ESMF_StateReconcile.F90 +++ b/src/Superstructure/StateReconcile/src/ESMF_StateReconcile.F90 @@ -612,14 +612,14 @@ subroutine ESMF_StateReconcile_driver (state, vm, attreconflag, rc) character(160) :: prefixStr type(ESMF_VMId), allocatable, target :: vmIdMap(:) type(ESMF_VMId), pointer :: vmIdSingleComp + logical :: singleCompCaseFlag + integer :: singleCompIndex character(len=ESMF_MAXSTR) :: logmsg type(ESMF_InfoCache) :: info_cache type(ESMF_InfoDescribe) :: idesc - logical :: singleCompCaseFlag - ! ------------------------------------------------------------------------- localrc = ESMF_RC_NOT_IMPL @@ -767,12 +767,23 @@ subroutine ESMF_StateReconcile_driver (state, vm, attreconflag, rc) endif ! Decide between SingleComp and MultiComp case singleCompCaseFlag = .false. + nullify(vmIdSingleComp) if (size(vmIdMap)==1) then singleCompCaseFlag = all(vmintids_send(1:)==1) - vmIdSingleComp => vmIdMap(1) + if (singleCompCaseFlag) vmIdSingleComp => vmIdMap(1) else if (size(vmIdMap)==2) then - singleCompCaseFlag = all(vmintids_send(1:)==2) ! most likely case - vmIdSingleComp => vmIdMap(2) + singleCompCaseFlag = all(vmintids_send(1:)==1) & + .or.all(vmintids_send(1:)==2) + if (singleCompCaseFlag) then + ! singleCompIndex could be 1 or 2, however, cannot simply look this up + ! in vmintids_send(1), because on PETs that do not have objects it only + ! stores vmintids_send(1), which holds the index into vmIdMap of the + ! executing VM. Since there are only two possible values, the correct + ! singleCompIndex must be "the other one". Therefore, look at + ! vmintids_send(0), which is valid on all PETs, add 1 mod 2. + singleCompIndex = mod(vmintids_send(0)+1,2) + vmIdSingleComp => vmIdMap(singleCompIndex) + endif endif if (profile) then call ESMF_TraceRegionExit("Decide between cases", rc=localrc) From 38d1cf1e9da604441967cbe49ab3d65b419a677b Mon Sep 17 00:00:00 2001 From: Robert Oehmke Date: Thu, 26 Sep 2024 17:49:12 -0600 Subject: [PATCH 043/207] Add new calls to serialize/deserialize an entire State in preparation for handing one component case. --- .../src/ESMF_StateReconcile.F90 | 571 +++++++++++++++++- 1 file changed, 570 insertions(+), 1 deletion(-) diff --git a/src/Superstructure/StateReconcile/src/ESMF_StateReconcile.F90 b/src/Superstructure/StateReconcile/src/ESMF_StateReconcile.F90 index 53dff95d48..c8dc09567c 100644 --- a/src/Superstructure/StateReconcile/src/ESMF_StateReconcile.F90 +++ b/src/Superstructure/StateReconcile/src/ESMF_StateReconcile.F90 @@ -618,7 +618,8 @@ subroutine ESMF_StateReconcile_driver (state, vm, attreconflag, rc) type(ESMF_InfoCache) :: info_cache type(ESMF_InfoDescribe) :: idesc - + character, pointer :: buffer(:) + ! ------------------------------------------------------------------------- localrc = ESMF_RC_NOT_IMPL nullify(vmIdMap_ptr) @@ -786,6 +787,18 @@ subroutine ESMF_StateReconcile_driver (state, vm, attreconflag, rc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, rcToReturn=rc)) return #endif +#if 0 + ! Test new serialize/deserialize calls + call ESMF_ReconcileSerializeAll(state, vm, siwrap, attreconflag, buffer, rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, rcToReturn=rc)) return + + call ESMF_ReconcileDeserializeAll(state, vm, buffer, attreconflag, rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, rcToReturn=rc)) return + + ! Get rid of buffer + deallocate(buffer) +#endif + call handle_case3() ! Clean up @@ -1865,6 +1878,229 @@ subroutine ESMF_ReconcileDeserialize (state, vm, obj_buffer, attreconflag, rc) end subroutine ESMF_ReconcileDeserialize + +!------------------------------------------------------------------------------ +#undef ESMF_METHOD +#define ESMF_METHOD "ESMF_ReconcileDeserializeAll" +!BOPI +! !IROUTINE: ESMF_ReconcileDeserializeAll + +! !INTERFACE: + subroutine ESMF_ReconcileDeserializeAll(state, vm, buffer, attreconflag, rc) +! +! !ARGUMENTS: + type (ESMF_State), intent(inout):: state + type (ESMF_VM), intent(in) :: vm + character, pointer :: buffer(:) ! intent(in) + type(ESMF_AttReconcileFlag),intent(in) :: attreconflag + integer, intent(out) :: rc +! +! !DESCRIPTION: +! Builds proxy items for each of the items in the buffer. +! +! The arguments are: +! \begin{description} +! \item[state] +! {\tt ESMF\_State} to add proxy objects to. +! \item[vm] +! {\tt ESMF\_VM} to use. +! \item[buffer] +! Buffer of serialized State objects (intent(in)) +! \item[attreconflag] +! Flag to indicate attribute reconciliation. +! \item[rc] +! Return code; equals {\tt ESMF\_SUCCESS} if there are no errors. +! \end{description} +!EOPI + + integer :: localrc + integer :: memstat + + type(ESMF_FieldBundle) :: fieldbundle + type(ESMF_Field) :: field + type(ESMF_Array) :: array + type(ESMF_ArrayBundle) :: arraybundle + type(ESMF_State) :: substate + + integer :: stateitem_type + character(ESMF_MAXSTR) :: errstring + character(ESMF_MAXSTR) :: name + integer :: mypet + logical, parameter :: debug = .false. + logical, parameter :: trace = .false. + + integer :: item, numNewItems + integer :: itemType + integer :: sizeBuffer, posBuffer + +! XMRKX ! + + ! VM information for debug output + call ESMF_VMGet (vm, localPet=mypet, rc=localrc) + if (ESMF_LogFoundError (localrc, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, & + rcToReturn=rc)) return + + ! Set start position of buffer + posBuffer = 1 + + ! Get the number of items to add + numNewItems = transfer ( & + source=buffer(posBuffer:posBuffer+ESMF_SIZEOF_DEFINT-1), & + mold = numNewItems) + posBuffer = posbuffer + ESMF_SIZEOF_DEFINT + + write(*,*) myPet,"# DA: numNewItems=",numNewItems + + ! Loop getting new items + do item=1, numNewItems + + ! Get item type + itemType = transfer ( & + source=buffer(posBuffer:posBuffer+ESMF_SIZEOF_DEFINT-1), & + mold = itemType) + posBuffer = posbuffer + ESMF_SIZEOF_DEFINT + + ! Debug + write(*,*) myPet,"# DA: ",item," type=",itemType + + ! Get items + select case (itemType) + case (ESMF_STATEITEM_FIELDBUNDLE%ot) + if (debug) then + print *, "deserializing FieldBundle, pos =",posBuffer + end if + fieldbundle = ESMF_FieldBundleDeserialize(buffer, posBuffer, & + attreconflag=attreconflag, rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, & + rcToReturn=rc)) return + + call ESMF_StateAdd(state, fieldbundle, & + addflag=.true., proxyflag=.true., & + rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, & + rcToReturn=rc)) return + + case (ESMF_STATEITEM_FIELD%ot) + if (debug) then + print *, "deserializing Field, pos =", posBuffer + end if + field = ESMF_FieldDeserialize(buffer, posBuffer, & + attreconflag=attreconflag, rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, & + rcToReturn=rc)) return + + ! Debug + call ESMF_FieldGet(field, name=name, rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, & + rcToReturn=rc)) return + + write(*,*) myPet,"# ",item," name=",name + + if (debug) then + print *, "created field, ready to add to local state" + end if + + ! BOB: Take out StateAdd until we have a new State to add to +#if 0 + call ESMF_StateAdd(state, field, & + addflag=.true., proxyflag=.true., & + rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, & + rcToReturn=rc)) return +#endif + + case (ESMF_STATEITEM_ARRAY%ot) + if (debug) then + print *, " PET", mypet, & + ": deserializing Array pos =",posBuffer + end if + call c_ESMC_ArrayDeserialize(array, buffer, posBuffer, & + attreconflag, localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, & + rcToReturn=rc)) return + + ! Set init code + call ESMF_ArraySetInitCreated(array, rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, & + rcToReturn=rc)) return + + call ESMF_StateAdd(state, array, & + addflag=.true., proxyflag=.true., & + rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, & + rcToReturn=rc)) return + + case (ESMF_STATEITEM_ARRAYBUNDLE%ot) + if (debug) then + print *, "deserializing ArrayBundle pos =",posBuffer + end if + call c_ESMC_ArrayBundleDeserialize(arraybundle, buffer, posBuffer, & + attreconflag, localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, & + rcToReturn=rc)) return + + ! Set init code + call ESMF_ArrayBundleSetInitCreated(arraybundle, rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, & + rcToReturn=rc)) return + + call ESMF_StateAdd(state, arraybundle, & + addflag=.true., proxyflag=.true., & + rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, & + rcToReturn=rc)) return + + case (ESMF_STATEITEM_STATE%ot) + if (debug) then + print *, "deserializing nested State pos =",posBuffer + end if + substate = ESMF_StateDeserialize(vm, buffer, posBuffer, & + attreconflag=attreconflag, rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, & + rcToReturn=rc)) return + + call ESMF_StateAdd(state, substate, & + addflag=.true., proxyflag=.true., & + rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, & + rcToReturn=rc)) return + + case (ESMF_STATEITEM_UNKNOWN%ot) + write (errstring, '(a,i0)') 'can''t deserialize unknown type: ', itemType + if (ESMF_LogFoundError(ESMF_RC_INTNRL_INCONS, msg=errstring, & + ESMF_CONTEXT, & + rcToReturn=rc)) return + + case default + write (errstring, '(a,i0)') 'can''t deserialize unsupported type: ', itemType + if (ESMF_LogFoundError(ESMF_RC_INTNRL_INCONS, msg=errstring, & + ESMF_CONTEXT, & + rcToReturn=rc)) return + end select + + enddo + + + ! Return success + rc = ESMF_SUCCESS + + end subroutine ESMF_ReconcileDeserializeAll + + !------------------------------------------------------------------------------ #undef ESMF_METHOD #define ESMF_METHOD "ESMF_ReconcileExchgAttributes" @@ -3538,6 +3774,339 @@ subroutine ESMF_ReconcileSerialize (state, vm, siwrap, & end subroutine ESMF_ReconcileSerialize + +!------------------------------------------------------------------------------ +#undef ESMF_METHOD +#define ESMF_METHOD "ESMF_ReconcileSerializeAll" +!BOPI +! !IROUTINE: ESMF_ReconcileSerializeAll +! +! !INTERFACE: + subroutine ESMF_ReconcileSerializeAll(state, vm, siwrap, & + attreconflag, buffer, rc) +! +! !ARGUMENTS: + type (ESMF_State), intent(in) :: state + type (ESMF_VM), intent(in) :: vm + type (ESMF_StateItemWrap), intent(in) :: siwrap(:) + type(ESMF_AttReconcileFlag),intent(in) :: attreconflag + character, pointer :: buffer(:) + integer, intent(out) :: rc +! +! !DESCRIPTION: +! +! The arguments are: +! \begin{description} +! \item[state] +! {\tt ESMF\_State} to collect information from. +! \item[siwrap] +! State items in the state. +! \item[needs\_list] +! List of State items that need to be sent to other PETs +! \item[attreconflag] +! Flag to indicate attribute reconciliation. +! \item[rc] +! Return code; equals {\tt ESMF\_SUCCESS} if there are no errors. +! \end{description} +!EOPI + + integer :: localrc + integer :: memstat + integer :: item,numStateItems + type(ESMF_StateItem), pointer :: stateItem + type(ESMF_State) :: wrapper + integer :: itemType + integer :: sizeBuffer, posBuffer + character, pointer :: fakeBuffer(:) ! Fake buffer for passing when getting sizes + integer :: sizeFakeBuffer + integer :: itemSize + type(ESMF_InquireFlag) :: inqflag + integer :: mypet, npets, pet + + ! XMRKX ! + + ! Init to not implemented + localrc = ESMF_RC_NOT_IMPL + + ! Get vm info + call ESMF_VMGet(vm, localPet=mypet, petCount=npets, rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, & + rcToReturn=rc)) return + + + ! Get the number of items + numStateItems = size (siwrap) + + + !!!!! Calculate buffer size !!!!! + + ! Start with number of items + sizeBuffer=ESMF_SIZEOF_DEFINT + + ! Allocate a fake buffer for passing in when asking for size + allocate(fakeBuffer(ESMF_SIZEOF_DEFINT)) + + ! Fake buffer size + sizeFakeBuffer=size(fakeBuffer) + + ! Set flag to only check size + inqflag = ESMF_INQUIREONLY + + ! Loop State items computing size + do item=1,numStateItems + + ! Get one State Item + stateItem => siwrap(item)%si + + ! Get item type + itemType = stateitem%otype%ot + + ! Add item type's size + sizeBuffer = sizeBuffer + ESMF_SIZEOF_DEFINT + + ! Init itemSize to 0, so when we ask for the offset, + ! we are also getting the size + itemSize=0 + + ! Get size of item to serialize + select case (itemType) + case (ESMF_STATEITEM_FIELDBUNDLE%ot) + call ESMF_FieldBundleSerialize(stateItem%datap%fbp, & + fakeBuffer, sizeFakeBuffer, itemSize, & + attreconflag=attreconflag, inquireflag=inqflag, & + rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, & + rcToReturn=rc)) return + if (debug) then + print *, ' PET', mypet, & + ' Getting FieldBundle size=',itemSize + end if + + case (ESMF_STATEITEM_FIELD%ot) + call ESMF_FieldSerialize(stateItem%datap%fp, & + fakeBuffer, sizeFakeBuffer, itemSize, & + attreconflag=attreconflag, inquireflag=inqflag, & + rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, & + rcToReturn=rc)) return + if (debug) then + print *, ' PET', mypet, & + ' Getting Field size=',itemSize + end if + + case (ESMF_STATEITEM_ARRAY%ot) + call c_ESMC_ArraySerialize(stateitem%datap%ap, & + fakeBuffer, sizeFakeBuffer, itemSize, & + attreconflag, inqflag, & + localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, & + rcToReturn=rc)) return + if (debug) then + print *, ' PET', mypet, & + ' Getting Array size=',itemSize + end if + + case (ESMF_STATEITEM_ARRAYBUNDLE%ot) + call c_ESMC_ArrayBundleSerialize(stateitem%datap%abp, & + fakeBuffer, sizeFakeBuffer, itemSize, & + attreconflag, inqflag, & + localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, & + rcToReturn=rc)) return + if (debug) then + print *, ' PET', mypet, & + ' Getting ArrayBundle size=',itemSize + end if + + case (ESMF_STATEITEM_STATE%ot) + wrapper%statep => stateitem%datap%spp + ESMF_INIT_SET_CREATED(wrapper) + call ESMF_StateSerialize(wrapper, & + fakeBuffer, sizeFakeBuffer, itemSize, & + attreconflag=attreconflag, inquireflag=inqflag, & + rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, & + rcToReturn=rc)) return + if (debug) then + print *, ' PET', mypet, & + ' Getting State size=',itemSize + end if + + case (ESMF_STATEITEM_ROUTEHANDLE%ot) + ! Do nothing for RouteHandles. There is no need to reconcile them. + + case (ESMF_STATEITEM_UNKNOWN%ot) + call c_ESMC_StringSerialize(stateitem%namep, & + fakeBuffer, sizeFakeBuffer, itemSize, & + inqflag, localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, & + rcToReturn=rc)) return + if (debug) then + print *, ' PET', mypet, & + ' Getting Unknown size=',itemSize + end if + + case default + if (ESMF_LogFoundError(ESMF_RC_INTNRL_INCONS, & + msg="Unrecognized item type.", & + ESMF_CONTEXT, & + rcToReturn=rc)) return + end select + + ! Update buffer size by itemSize + sizeBuffer = sizeBuffer + itemSize + enddo + + ! Get rid of fakeBuffer + deallocate(fakeBuffer) + + + + !!!!! Allocate buffer to serialize into !!!!! + allocate(buffer(sizeBuffer), stat=memstat) + if (ESMF_LogFoundAllocError(memstat, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, & + rcToReturn=rc)) return + + + + !!!!! Serialize information into buffer !!!!! + + ! Start position of buffer + posBuffer = 1 + + ! Put item count in buffer + buffer(posBuffer:posBuffer+ESMF_SIZEOF_DEFINT-1) = transfer ( & + source=numStateItems, & + mold=buffer(1:ESMF_SIZEOF_DEFINT)) + posBuffer = posbuffer + ESMF_SIZEOF_DEFINT + + ! Set flag to actually serialize + inqflag = ESMF_NOINQUIRE + + ! Loop State items adding to buffer + do item=1,numStateItems + + ! Get one State Item + stateItem => siwrap(item)%si + + ! Get item type + itemType = stateitem%otype%ot + + ! Add item type to buffer + buffer(posBuffer:posBuffer+ESMF_SIZEOF_DEFINT-1) = transfer (& + source=itemType, & + mold =buffer(1:ESMF_SIZEOF_DEFINT)) + posBuffer = posbuffer + ESMF_SIZEOF_DEFINT + + ! Add serialized items + select case (itemType) + case (ESMF_STATEITEM_FIELDBUNDLE%ot) + if (debug) then + print *, ' PET', mypet, & + ' Getting FieldBundle pos=',posBuffer + end if + call ESMF_FieldBundleSerialize(stateItem%datap%fbp, & + buffer, sizeBuffer, posBuffer, & + attreconflag=attreconflag, inquireflag=inqflag, & + rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, & + rcToReturn=rc)) return + + case (ESMF_STATEITEM_FIELD%ot) + if (debug) then + print *, ' PET', mypet, & + ' Getting Field pos=',posBuffer + end if + call ESMF_FieldSerialize(stateItem%datap%fp, & + buffer, sizeBuffer, posBuffer, & + attreconflag=attreconflag, inquireflag=inqflag, & + rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, & + rcToReturn=rc)) return + + case (ESMF_STATEITEM_ARRAY%ot) + if (debug) then + print *, ' PET', mypet, & + ' Getting Array pos=',posBuffer + end if + call c_ESMC_ArraySerialize(stateitem%datap%ap, & + buffer, sizeBuffer, posBuffer, & + attreconflag, inqflag, & + localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, & + rcToReturn=rc)) return + + case (ESMF_STATEITEM_ARRAYBUNDLE%ot) + if (debug) then + print *, ' PET', mypet, & + ' Getting ArrayBundle pos=',posBuffer + end if + call c_ESMC_ArrayBundleSerialize(stateitem%datap%abp, & + buffer, sizeBuffer, posBuffer, & + attreconflag, inqflag, & + localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, & + rcToReturn=rc)) return + + case (ESMF_STATEITEM_STATE%ot) + if (debug) then + print *, ' PET', mypet, & + ' Getting State pos=',posBuffer + end if + wrapper%statep => stateitem%datap%spp + ESMF_INIT_SET_CREATED(wrapper) + call ESMF_StateSerialize(wrapper, & + buffer, sizeBuffer, posBuffer, & + attreconflag=attreconflag, inquireflag=inqflag, & + rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, & + rcToReturn=rc)) return + + + case (ESMF_STATEITEM_ROUTEHANDLE%ot) + ! Do nothing for RouteHandles. There is no need to reconcile them. + + case (ESMF_STATEITEM_UNKNOWN%ot) + if (debug) then + print *, ' PET', mypet, & + ' Getting Unknown pos=',posBuffer + end if + call c_ESMC_StringSerialize(stateitem%namep, & + buffer, sizeBuffer, posBuffer, & + inqflag, localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, & + rcToReturn=rc)) return + + + case default + if (ESMF_LogFoundError(ESMF_RC_INTNRL_INCONS, & + msg="Unrecognized item type.", & + ESMF_CONTEXT, & + rcToReturn=rc)) return + end select + enddo + + ! Return success + rc = ESMF_SUCCESS + + end subroutine ESMF_ReconcileSerializeAll + + + !------------------------------------------------------------------------------ #undef ESMF_METHOD #define ESMF_METHOD "ESMF_ReconcileZapProxies" From ffc6881716ea623b219813d9d49a5d4805d042a2 Mon Sep 17 00:00:00 2001 From: Gerhard Theurich Date: Thu, 26 Sep 2024 18:20:23 -0600 Subject: [PATCH 044/207] And one more small fix in the logic to find 'singleCompCaseFlag' - considering that Fortran indexing starts at 1 when doing mod! --- .../StateReconcile/src/ESMF_StateReconcile.F90 | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/src/Superstructure/StateReconcile/src/ESMF_StateReconcile.F90 b/src/Superstructure/StateReconcile/src/ESMF_StateReconcile.F90 index 8bc83ed970..c4b04a8383 100644 --- a/src/Superstructure/StateReconcile/src/ESMF_StateReconcile.F90 +++ b/src/Superstructure/StateReconcile/src/ESMF_StateReconcile.F90 @@ -777,11 +777,12 @@ subroutine ESMF_StateReconcile_driver (state, vm, attreconflag, rc) if (singleCompCaseFlag) then ! singleCompIndex could be 1 or 2, however, cannot simply look this up ! in vmintids_send(1), because on PETs that do not have objects it only - ! stores vmintids_send(1), which holds the index into vmIdMap of the + ! stores vmintids_send(0), which holds the index into vmIdMap of the ! executing VM. Since there are only two possible values, the correct ! singleCompIndex must be "the other one". Therefore, look at - ! vmintids_send(0), which is valid on all PETs, add 1 mod 2. - singleCompIndex = mod(vmintids_send(0)+1,2) + ! vmintids_send(0), which is valid on all PETs, add 1 mod 2. But since + ! indexing into vmIdMap starts at 1 the add 1 happens _after_ the mod 2. + singleCompIndex = mod(vmintids_send(0),2)+1 vmIdSingleComp => vmIdMap(singleCompIndex) endif endif From 3cacf3eac2283ff8126fee835f62499feb35313c Mon Sep 17 00:00:00 2001 From: Gerhard Theurich Date: Fri, 27 Sep 2024 07:31:35 -0600 Subject: [PATCH 045/207] Rework JSON State output handling (for development/debugging). Implement cross PET checking of consistency of State at end of StateReconcile() based on the JSON State representation. Provided as development/debugging tool. --- .../src/ESMF_StateReconcile.F90 | 78 ++++++++++++++++--- 1 file changed, 67 insertions(+), 11 deletions(-) diff --git a/src/Superstructure/StateReconcile/src/ESMF_StateReconcile.F90 b/src/Superstructure/StateReconcile/src/ESMF_StateReconcile.F90 index c4b04a8383..851e10a5e4 100644 --- a/src/Superstructure/StateReconcile/src/ESMF_StateReconcile.F90 +++ b/src/Superstructure/StateReconcile/src/ESMF_StateReconcile.F90 @@ -171,16 +171,13 @@ subroutine ESMF_StateReconcile(state, vm, rc) ! !EOP - integer :: localrc - type(ESMF_VM) :: localvm + integer :: localrc + type(ESMF_VM) :: localvm type(ESMF_AttReconcileFlag) :: lattreconflag - - type(ESMF_InfoDescribe) :: idesc + logical :: isNoop logical, parameter :: profile = .true. - logical :: isNoop - ! check input variables ESMF_INIT_CHECK_DEEP(ESMF_StateGetInit,state,rc) ESMF_INIT_CHECK_DEEP(ESMF_VMGetInit,vm,rc) @@ -198,6 +195,23 @@ subroutine ESMF_StateReconcile(state, vm, rc) rcToReturn=rc)) return end if +#if 0 + block + type(ESMF_InfoDescribe) :: idesc + ! Log a JSON State representation ----------------------------------------- + call idesc%Initialize(createInfo=.true., addObjectInfo=.true., rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, rcToReturn=rc)) return + call idesc%Update(state, "", rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, rcToReturn=rc)) return + call ESMF_LogWrite("InfoDescribe before Reconcile=", rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, rcToReturn=rc)) return + call ESMF_LogWrite("state_json_before_reconcile="//ESMF_InfoDump(idesc%info), rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, rcToReturn=rc)) return + call idesc%Destroy(rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, rcToReturn=rc)) return + end block +#endif + #if 0 ! cleaner timings below, eliminating issue due to different times PETs enter ! BUT: only enable this for testing purposes @@ -282,26 +296,68 @@ subroutine ESMF_StateReconcile(state, vm, rc) call ESMF_InfoCacheReassembleFieldsFinalize(state, localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, rcToReturn=rc)) return -#if 0 + if (profile) then + call ESMF_TraceRegionExit("ESMF_InfoCacheReassembleFields", rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, & + rcToReturn=rc)) return + endif + +#if 1 + if (profile) then + call ESMF_TraceRegionEnter("JSON cross PET check", rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, & + rcToReturn=rc)) return + endif + block + type(ESMF_InfoDescribe) :: idesc + character(:), allocatable :: jsonStr, testStr + integer :: size(1), localPet ! Log a JSON State representation ----------------------------------------- call idesc%Initialize(createInfo=.true., addObjectInfo=.true., rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, rcToReturn=rc)) return call idesc%Update(state, "", rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, rcToReturn=rc)) return - call ESMF_LogWrite("InfoDescribe before InfoCacheReassembleFields=", rc=localrc) + jsonStr = "state_json_after_reassemble="//ESMF_InfoDump(idesc%info) +#if 0 + call ESMF_LogWrite("InfoDescribe after InfoCacheReassembleFields=", rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, rcToReturn=rc)) return - call ESMF_LogWrite("state_json_before_reassemble="//ESMF_InfoDump(idesc%info), rc=localrc) + call ESMF_LogWrite(jsonStr, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, rcToReturn=rc)) return +#endif call idesc%Destroy(rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, rcToReturn=rc)) return +#if 1 + ! check match across all PETs of VM + size(1) = len(jsonStr) + call ESMF_VMBroadcast(localvm, size, count=1, rootPet=0, rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, rcToReturn=rc)) return + call ESMF_VMGet(localvm, localPet=localPet, rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, rcToReturn=rc)) return + if (localPet==0) then + call ESMF_VMBroadcast(localvm, jsonStr, count=size(1), rootPet=0, rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, rcToReturn=rc)) return + else + allocate(character(len=size(1))::testStr) + call ESMF_VMBroadcast(localvm, testStr, count=size(1), rootPet=0, rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, rcToReturn=rc)) return + if (testStr/=jsonStr) then + call ESMF_LogSetError(ESMF_RC_INTNRL_INCONS, & + msg="StateReconcile() failed!! Not all PETs hold same content!!", & + ESMF_CONTEXT, rcToReturn=rc) + return + endif + endif #endif - + end block if (profile) then - call ESMF_TraceRegionExit("ESMF_InfoCacheReassembleFields", rc=localrc) + call ESMF_TraceRegionExit("JSON cross PET check", rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, & rcToReturn=rc)) return endif +#endif if (present(rc)) rc = ESMF_SUCCESS From 41122e5a13e72a60303211b496a9536c0e6b8e42 Mon Sep 17 00:00:00 2001 From: Gerhard Theurich Date: Fri, 27 Sep 2024 14:20:06 -0600 Subject: [PATCH 046/207] Implement 'isLocalPetActive' in ESMF_VMIdGet(). --- src/Infrastructure/VM/include/ESMCI_VM.h | 1 + src/Infrastructure/VM/interface/ESMCI_VM_F.C | 17 +++++++-- src/Infrastructure/VM/interface/ESMF_VM.F90 | 23 ++++++++---- src/Infrastructure/VM/src/ESMCI_VM.C | 38 +++++++++++++++++++- 4 files changed, 69 insertions(+), 10 deletions(-) diff --git a/src/Infrastructure/VM/include/ESMCI_VM.h b/src/Infrastructure/VM/include/ESMCI_VM.h index 49f17cff98..d3a006f654 100644 --- a/src/Infrastructure/VM/include/ESMCI_VM.h +++ b/src/Infrastructure/VM/include/ESMCI_VM.h @@ -83,6 +83,7 @@ namespace ESMCI { // ESMCI::VMId methods: bool VMIdCompare(const VMId *vmID1, const VMId *vmID2, bool keyOnly=false); +bool VMIdIsLocalPetActive(const VMId *vmID); bool VMIdLessThan(const VMId *vmID1, const VMId *vmID2); int VMIdCopy(VMId *vmIDdst, VMId *vmIDsrc); } // namespace ESMCI diff --git a/src/Infrastructure/VM/interface/ESMCI_VM_F.C b/src/Infrastructure/VM/interface/ESMCI_VM_F.C index dc24cdb3ab..e268fd1ba2 100644 --- a/src/Infrastructure/VM/interface/ESMCI_VM_F.C +++ b/src/Infrastructure/VM/interface/ESMCI_VM_F.C @@ -1746,7 +1746,6 @@ extern "C" { if (rc!=NULL) *rc = ESMF_SUCCESS; // TODO: finish error handling } - void FTN_X(c_esmci_vmidgetleftmostonbit)(ESMCI::VMId **vmid, int *leftmostOnBit, int *rc) { #undef ESMC_METHOD @@ -1763,7 +1762,21 @@ extern "C" { // return successfully if (rc!=NULL) *rc = ESMF_SUCCESS; // TODO: finish error handling } - + + void FTN_X(c_esmci_vmidgetislocalpetactive)(ESMCI::VMId **vmid, + ESMC_Logical *isLocalPetActive, int *rc){ +#undef ESMC_METHOD +#define ESMC_METHOD "c_ESMCI_VMIdGetIsLocalPetActive()" + // Initialize return code; assume routine not implemented + if (rc!=NULL) *rc = ESMC_RC_NOT_IMPL; + // test for NULL pointer via macro before calling any class methods + ESMCI_NULL_CHECK_PRC(vmid, rc) + bool resultBool = ESMCI::VMIdIsLocalPetActive(*vmid); + *isLocalPetActive = resultBool ? ESMF_TRUE : ESMF_FALSE; + // return successfully + if (rc!=NULL) *rc = ESMF_SUCCESS; + } + void FTN_X(c_esmc_vmidlog)(ESMCI::VMId **vmid, char *prefix, ESMC_LogMsgType_Flag *logMsgFlag, int *rc, ESMCI_FortranStrLenArg prefix_l){ #undef ESMC_METHOD diff --git a/src/Infrastructure/VM/interface/ESMF_VM.F90 b/src/Infrastructure/VM/interface/ESMF_VM.F90 index 20d8ecce10..c79810b8a8 100644 --- a/src/Infrastructure/VM/interface/ESMF_VM.F90 +++ b/src/Infrastructure/VM/interface/ESMF_VM.F90 @@ -10474,11 +10474,12 @@ end subroutine ESMF_VMIdCopy ! !IROUTINE: ESMF_VMIdGet - Get information about a VMId object ! !INTERFACE: - subroutine ESMF_VMIdGet(vmId, leftMostOnBit, rc) + subroutine ESMF_VMIdGet(vmId, leftMostOnBit, isLocalPetActive, rc) ! ! !ARGUMENTS: type(ESMF_VMId), intent(in) :: vmId integer, intent(out), optional :: leftMostOnBit + logical, intent(out), optional :: isLocalPetActive integer, intent(out), optional :: rc ! ! !DESCRIPTION: @@ -10490,17 +10491,19 @@ subroutine ESMF_VMIdGet(vmId, leftMostOnBit, rc) ! \begin{description} ! \item[vmId] ! VMId to get information from. -! \item[leftMostOnBit] -! The index (base 0) of the leftmost on bit in the VMId. If the index is -1, -! then there were no on bits -! \item[{[rc]}] +! \item[{[leftMostOnBit]}] +! The index (base 0) of the leftmost on bit in {\tt vmId}. If the index +! is -1, then there were no on bits. +! \item[{[isLocalPetActive]}] +! Set to {\tt .true.} if the local PET is indicated as active in +! {\tt vmId}. +! \item[{[rc]}] ! Return code; equals {\tt ESMF\_SUCCESS} if there are no errors. ! \end{description} ! !EOPI !------------------------------------------------------------------------------ integer :: localrc ! local return code - integer :: i type(ESMF_Logical) :: tf ! initialize return code; assume routine not implemented @@ -10513,7 +10516,13 @@ subroutine ESMF_VMIdGet(vmId, leftMostOnBit, rc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return endif - + if (present(isLocalPetActive)) then + call c_ESMCI_VMIdGetIsLocalPetActive(vmId, tf, localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, rcToReturn=rc)) return + isLocalPetActive = tf == ESMF_TRUE + endif + ! return successfully if (present(rc)) rc = ESMF_SUCCESS diff --git a/src/Infrastructure/VM/src/ESMCI_VM.C b/src/Infrastructure/VM/src/ESMCI_VM.C index 86c2111e5a..094d61683d 100644 --- a/src/Infrastructure/VM/src/ESMCI_VM.C +++ b/src/Infrastructure/VM/src/ESMCI_VM.C @@ -439,7 +439,7 @@ int VMId::getLeftmostOnBit( unsigned unsigned_leftmost=VMKeyFirstBitFromLeft(this->vmKey); // a value returned of vmKeyWidth * 8 indicates that no bit was set - if (unsigned_leftmost == vmKeyWidth*8) *leftmostOnBit=-1; + if (unsigned_leftmost == (unsigned)vmKeyWidth*8) *leftmostOnBit=-1; else *leftmostOnBit=(signed int)unsigned_leftmost; localrc = ESMF_SUCCESS; @@ -803,6 +803,42 @@ bool VMIdCompare( //----------------------------------------------------------------------------- +//----------------------------------------------------------------------------- +#undef ESMC_METHOD +#define ESMC_METHOD "ESMCI::VMIdIsLocalPetActive()" +//BOPI +// !IROUTINE: ESMCI::VMIdIsLocalPetActive +// +// !INTERFACE: +bool VMIdIsLocalPetActive( +// +// !RETURN VALUE: +// bool indicating whether localPet is marked active in {\tt vmID}. +// +// !ARGUMENTS: +// + const VMId *vmID + ){ +// +// !DESCRIPTION: +// Return {\tt true} if the bit corresponding to the local PET is set in +// {\tt vmID}. Return {\tt false} otherwise. +// +//EOPI +//----------------------------------------------------------------------------- + if (vmID==NULL){ + ESMC_LogDefault.MsgFoundError(ESMC_RC_ARG_BAD, + "- Invalid vmID", ESMC_CONTEXT, NULL); + return false; // bail out + } + int localPet = VM::getGlobal()->getLocalPet(); + int index = localPet/8; + int bitIndex = localPet%8; + return (vmID->vmKey[index]&0x01<<(7-bitIndex)); +} +//----------------------------------------------------------------------------- + + //----------------------------------------------------------------------------- #undef ESMC_METHOD #define ESMC_METHOD "ESMCI::VMIdLessThan()" From a6ef19e623d71e014c2b1d2141fd1490ac67b891 Mon Sep 17 00:00:00 2001 From: Gerhard Theurich Date: Fri, 27 Sep 2024 14:30:42 -0600 Subject: [PATCH 047/207] Working with Bob to implement and activate ESMF_ReconcileSingleCompCase(). --- .../src/ESMF_StateReconcile.F90 | 190 ++++++++++-------- 1 file changed, 109 insertions(+), 81 deletions(-) diff --git a/src/Superstructure/StateReconcile/src/ESMF_StateReconcile.F90 b/src/Superstructure/StateReconcile/src/ESMF_StateReconcile.F90 index c6e8cf24ad..dda014fd95 100644 --- a/src/Superstructure/StateReconcile/src/ESMF_StateReconcile.F90 +++ b/src/Superstructure/StateReconcile/src/ESMF_StateReconcile.F90 @@ -303,7 +303,7 @@ subroutine ESMF_StateReconcile(state, vm, rc) rcToReturn=rc)) return endif -#if 1 +#if 0 if (profile) then call ESMF_TraceRegionEnter("JSON cross PET check", rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & @@ -320,7 +320,7 @@ subroutine ESMF_StateReconcile(state, vm, rc) call idesc%Update(state, "", rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, rcToReturn=rc)) return jsonStr = "state_json_after_reassemble="//ESMF_InfoDump(idesc%info) -#if 0 +#if 1 call ESMF_LogWrite("InfoDescribe after InfoCacheReassembleFields=", rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, rcToReturn=rc)) return call ESMF_LogWrite(jsonStr, rc=localrc) @@ -675,8 +675,7 @@ subroutine ESMF_StateReconcile_driver (state, vm, attreconflag, rc) type(ESMF_InfoCache) :: info_cache type(ESMF_InfoDescribe) :: idesc - character, pointer :: buffer(:) - + ! ------------------------------------------------------------------------- localrc = ESMF_RC_NOT_IMPL @@ -875,19 +874,57 @@ subroutine ESMF_StateReconcile_driver (state, vm, attreconflag, rc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, rcToReturn=rc)) return #endif -#if 0 - ! Test new serialize/deserialize calls - call ESMF_ReconcileSerializeAll(state, vm, siwrap, attreconflag, buffer, rc=localrc) + ! ------------------------------------------------------------------------- + if (profile) then + call ESMF_TraceRegionEnter("(2) Update Field metadata", rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, & + rcToReturn=rc)) return + endif + ! ------------------------------------------------------------------------- + if (trace) then + call ESMF_ReconcileDebugPrint (ESMF_METHOD // & + ': *** Step 2.0 - Update Field metadata for unique geometries') + end if + + ! Update Field metadata for unique geometries. This will traverse the state + ! hierarchy adding reconcile-specific attributes that will find unique + ! geometry objects and maintain sufficient information to re-establish + ! references once the objects have been communicated and deserialized. + ! ------------------------------------------------------------------------- + if (profile) then + call ESMF_TraceRegionEnter("info_cache for unique geometries", rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, & + rcToReturn=rc)) return + endif + + call info_cache%Initialize(localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, rcToReturn=rc)) return - - call ESMF_ReconcileDeserializeAll(state, vm, buffer, attreconflag, rc=localrc) + + call info_cache%UpdateFields(state, vmIdMap, localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, rcToReturn=rc)) return - ! Get rid of buffer - deallocate(buffer) -#endif + call info_cache%Destroy(localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, rcToReturn=rc)) return + + if (profile) then + call ESMF_TraceRegionExit("info_cache for unique geometries", rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, & + rcToReturn=rc)) return + endif + + ! ------------------------------------------------------------------------- + if (profile) then + call ESMF_TraceRegionExit("(2) Update Field metadata", rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, & + rcToReturn=rc)) return + endif + ! ------------------------------------------------------------------------- + if (meminfo) call ESMF_VMLogMemInfo ("after (2) Update Field metadata") - block character(160):: msgStr write(msgStr,*) "size(vmintids_send): ", size(vmintids_send) @@ -908,9 +945,10 @@ subroutine ESMF_StateReconcile_driver (state, vm, attreconflag, rc) rcToReturn=rc)) return endif ! ------------------------------------------------------------------------ -#if 0 +#if 1 !TODO: enable SingleComp case when implemented - call ESMF_ReconcileSingleCompCase(vm=vm, vmId=vmIdSingleComp, rc=localrc) + call ESMF_ReconcileSingleCompCase(state, vm=vm, vmId=vmIdSingleComp, & + attreconflag=attreconflag, siwrap=siwrap, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, & rcToReturn=rc)) return @@ -1037,57 +1075,6 @@ subroutine ESMF_StateReconcile_driver (state, vm, attreconflag, rc) subroutine ESMF_ReconcileMultiCompCase() - ! ------------------------------------------------------------------------- - if (profile) then - call ESMF_TraceRegionEnter("(2) Update Field metadata", rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, & - rcToReturn=rc)) return - endif - ! ------------------------------------------------------------------------- - if (trace) then - call ESMF_ReconcileDebugPrint (ESMF_METHOD // & - ': *** Step 2.0 - Update Field metadata for unique geometries') - end if - - ! Update Field metadata for unique geometries. This will traverse the state - ! hierarchy adding reconcile-specific attributes that will find unique - ! geometry objects and maintain sufficient information to re-establish - ! references once the objects have been communicated and deserialized. - ! ------------------------------------------------------------------------- - if (profile) then - call ESMF_TraceRegionEnter("info_cache for unique geometries", rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, & - rcToReturn=rc)) return - endif - - call info_cache%Initialize(localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, rcToReturn=rc)) return - - call info_cache%UpdateFields(state, vmIdMap, localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, rcToReturn=rc)) return - - call info_cache%Destroy(localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, rcToReturn=rc)) return - - if (profile) then - call ESMF_TraceRegionExit("info_cache for unique geometries", rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, & - rcToReturn=rc)) return - endif - - ! ------------------------------------------------------------------------- - if (profile) then - call ESMF_TraceRegionExit("(2) Update Field metadata", rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, & - rcToReturn=rc)) return - endif - ! ------------------------------------------------------------------------- - if (meminfo) call ESMF_VMLogMemInfo ("after (2) Update Field metadata") - ! ------------------------------------------------------------------------- ! (3) All PETs send their items Ids and VMIds to all the other PETs, ! then create local directories of which PETs have which ids/VMIds. @@ -1378,12 +1365,15 @@ end subroutine ESMF_StateReconcile_driver ! !IROUTINE: ESMF_ReconcileSingleCompCase ! ! !INTERFACE: - subroutine ESMF_ReconcileSingleCompCase(vm, vmId, rc) + subroutine ESMF_ReconcileSingleCompCase(state, vm, vmId, attreconflag, siwrap, rc) ! ! !ARGUMENTS: - type(ESMF_VM), intent(in) :: vm - type(ESMF_VMId), pointer :: vmId - integer, intent(out) :: rc + type(ESMF_State), intent(inout) :: state + type(ESMF_VM), intent(in) :: vm + type(ESMF_VMId), pointer :: vmId ! intent(in) + type(ESMF_AttReconcileFlag), intent(in) :: attreconflag + type(ESMF_StateItemWrap), pointer :: siwrap(:) ! intent(in) + integer, intent(out) :: rc ! ! !DESCRIPTION: ! @@ -1406,6 +1396,9 @@ subroutine ESMF_ReconcileSingleCompCase(vm, vmId, rc) integer :: localrc integer :: petCount, localPet, rootVas, rootPet, vas + integer :: sizeBuffer(1) + logical :: isFlag + character, pointer :: buffer(:) rc = ESMF_SUCCESS @@ -1436,10 +1429,55 @@ subroutine ESMF_ReconcileSingleCompCase(vm, vmId, rc) block character(160) :: msgStr + write(msgStr,*) "SingleCompCase rootVas=", rootVas + call ESMF_LogWrite(msgStr, ESMF_LOGMSG_DEBUG, rc=localrc) write(msgStr,*) "SingleCompCase rootPet=", rootPet call ESMF_LogWrite(msgStr, ESMF_LOGMSG_DEBUG, rc=localrc) end block + ! Serialize on rootPet + if (localPet==rootPet) then + call ESMF_ReconcileSerializeAll(state, vm, siwrap, attreconflag, & + buffer, rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, rcToReturn=rc)) return + sizeBuffer(1) = size(buffer) + endif + + ! Broadcast buffer across all PETs + call ESMF_VMBroadcast(vm, sizeBuffer, count=1, rootPet=rootPet, rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, rcToReturn=rc)) return + + if (localPet/=rootPet) allocate(buffer(sizeBuffer(1))) + + call ESMF_VMBroadcast(vm, buffer, count=sizeBuffer(1), rootPet=rootPet, & + rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, rcToReturn=rc)) return + + ! determine if local PET is active under the vmId + call ESMF_VMIdGet(vmId, isLocalPetActive=isFlag, rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, rcToReturn=rc)) return + +block + character(160) :: msgStr + write(msgStr,*) "isFlag=", isFlag + call ESMF_LogWrite(msgStr, ESMF_LOGMSG_DEBUG, rc=localrc) +end block + + ! only inactive PETs deserialize the buffer received from rootPet + if (.not.isFlag) then + call ESMF_ReconcileDeserializeAll(state, vm, buffer, attreconflag, & + rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, rcToReturn=rc)) return + endif + + ! Get rid of buffer + deallocate(buffer) + end subroutine ESMF_ReconcileSingleCompCase !------------------------------------------------------------------------------ @@ -2166,8 +2204,6 @@ subroutine ESMF_ReconcileDeserializeAll(state, vm, buffer, attreconflag, rc) mold = numNewItems) posBuffer = posbuffer + ESMF_SIZEOF_DEFINT - write(*,*) myPet,"# DA: numNewItems=",numNewItems - ! Loop getting new items do item=1, numNewItems @@ -2177,9 +2213,6 @@ subroutine ESMF_ReconcileDeserializeAll(state, vm, buffer, attreconflag, rc) mold = itemType) posBuffer = posbuffer + ESMF_SIZEOF_DEFINT - ! Debug - write(*,*) myPet,"# DA: ",item," type=",itemType - ! Get items select case (itemType) case (ESMF_STATEITEM_FIELDBUNDLE%ot) @@ -2215,22 +2248,17 @@ subroutine ESMF_ReconcileDeserializeAll(state, vm, buffer, attreconflag, rc) ESMF_CONTEXT, & rcToReturn=rc)) return - write(*,*) myPet,"# ",item," name=",name - if (debug) then print *, "created field, ready to add to local state" end if - ! BOB: Take out StateAdd until we have a new State to add to -#if 0 call ESMF_StateAdd(state, field, & addflag=.true., proxyflag=.true., & rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, & rcToReturn=rc)) return -#endif - + case (ESMF_STATEITEM_ARRAY%ot) if (debug) then print *, " PET", mypet, & From 0a84bc63c6f8aabb24f498346226f5c45318484b Mon Sep 17 00:00:00 2001 From: Gerhard Theurich Date: Mon, 30 Sep 2024 18:27:23 +0000 Subject: [PATCH 048/207] Eliminate use of fixed size output buffer in VMId::log(). --- src/Infrastructure/VM/src/ESMCI_VM.C | 16 ++++++---------- 1 file changed, 6 insertions(+), 10 deletions(-) diff --git a/src/Infrastructure/VM/src/ESMCI_VM.C b/src/Infrastructure/VM/src/ESMCI_VM.C index 094d61683d..9a0bcfa31d 100644 --- a/src/Infrastructure/VM/src/ESMCI_VM.C +++ b/src/Infrastructure/VM/src/ESMCI_VM.C @@ -516,14 +516,12 @@ void VMId::log( int rc = ESMC_RC_NOT_IMPL; // final return code char digits[64]; - char msg[800]; std::stringstream info; - info << " vmKeyWidth (bytes) = " << vmKeyWidth + info << prefix << " - VMId: vmKeyWidth (bytes) = " << vmKeyWidth <<" vmKeyOff (invalid bits end of last byte) = " << vmKeyOff; - sprintf(msg, "%s - VMId: %s", prefix.c_str(), info.str().c_str()); - ESMC_LogDefault.Write(msg, msgType); + ESMC_LogDefault.Write(info.str(), msgType); info.str(""); // clear info - info << " vmKey=0x"; + info << prefix << " - VMId: vmKey=0x"; int bitmap=0; int k=0; for (int i=0; i Date: Mon, 30 Sep 2024 15:40:45 -0700 Subject: [PATCH 050/207] White space clean-up while reviewing a specific section of the code. --- src/addon/NUOPC/src/NUOPC_Connector.F90 | 18 +++++++++--------- 1 file changed, 9 insertions(+), 9 deletions(-) diff --git a/src/addon/NUOPC/src/NUOPC_Connector.F90 b/src/addon/NUOPC/src/NUOPC_Connector.F90 index 1a0ef0a744..3daaf1d282 100644 --- a/src/addon/NUOPC/src/NUOPC_Connector.F90 +++ b/src/addon/NUOPC/src/NUOPC_Connector.F90 @@ -4581,7 +4581,7 @@ subroutine ShareFieldWithGrid(acceptorField, providerField, name, rc) ! set RC rc = ESMF_SUCCESS - + ! queries call ESMF_FieldGet(acceptorField, grid=grid, name=fieldName, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & @@ -4648,7 +4648,7 @@ subroutine ShareFieldWithGrid(acceptorField, providerField, name, rc) line=__LINE__, file=FILENAME, rcToReturn=rc)) return ! bail out if (localPet>-1) then ! this is an active PET -> create the acceptorField - + !TODO: make sure that this FieldCreate() sets total widths correctly !TODO: difficult to do with current FieldCreate() for multiple DEs/PET if (fieldDimCount - gridDimCount > 0) then @@ -4670,7 +4670,7 @@ subroutine ShareFieldWithGrid(acceptorField, providerField, name, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, file=trim(name)//":"//FILENAME)) return endif - + ! reconcile across the entire Connector VM call ESMF_StateReconcile(state, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & @@ -4678,7 +4678,7 @@ subroutine ShareFieldWithGrid(acceptorField, providerField, name, rc) call ESMF_StateGet(state, itemName=fieldName, field=acceptorField, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, file=trim(name)//":"//FILENAME)) return - + ! done with the helper state call ESMF_StateDestroy(state, noGarbage=.true., rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & @@ -4703,7 +4703,7 @@ subroutine ShareFieldWithGrid(acceptorField, providerField, name, rc) msg="Deallocating ungriddedUBound", & line=__LINE__, file=trim(name)//":"//FILENAME)) return ! bail out endif - + end subroutine !----------------------------------------------------------------------------- @@ -4729,7 +4729,7 @@ subroutine ShareFieldWithMesh(acceptorField, providerField, name, rc) ! set RC rc = ESMF_SUCCESS - + ! queries call ESMF_FieldGet(acceptorField, mesh=mesh, name=fieldName, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & @@ -4814,7 +4814,7 @@ subroutine ShareFieldWithMesh(acceptorField, providerField, name, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, file=trim(name)//":"//FILENAME)) return endif - + ! reconcile across the entire Connector VM call ESMF_StateReconcile(state, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & @@ -4827,7 +4827,7 @@ subroutine ShareFieldWithMesh(acceptorField, providerField, name, rc) call ESMF_StateDestroy(state, noGarbage=.true., rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, file=trim(name)//":"//FILENAME)) return - + ! clean-up deallocate(gridToFieldMap, stat=rc) if (ESMF_LogFoundDeallocError(rc, & @@ -4843,7 +4843,7 @@ subroutine ShareFieldWithMesh(acceptorField, providerField, name, rc) msg="Deallocating ungriddedUBound", & line=__LINE__, file=trim(name)//":"//FILENAME)) return ! bail out endif - + end subroutine !----------------------------------------------------------------------------- From 29b80fdfed52dd2b578834f190597d9c8e696f30 Mon Sep 17 00:00:00 2001 From: Gerhard Theurich Date: Mon, 30 Sep 2024 17:14:59 -0700 Subject: [PATCH 051/207] Disable debugging logs. --- src/addon/NUOPC/src/NUOPC_Connector.F90 | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/src/addon/NUOPC/src/NUOPC_Connector.F90 b/src/addon/NUOPC/src/NUOPC_Connector.F90 index 3daaf1d282..b73f2ebb26 100644 --- a/src/addon/NUOPC/src/NUOPC_Connector.F90 +++ b/src/addon/NUOPC/src/NUOPC_Connector.F90 @@ -4487,8 +4487,10 @@ subroutine InitializeIPDv05p5(connector, importState, exportState, clock, rc) gridList=>gridList%prev #define CLEAN_OUT_OLD_ACCEPTOR_GRID #ifdef CLEAN_OUT_OLD_ACCEPTOR_GRID +#if 0 call ESMF_PointerLog(gridListE%keyGrid%this, prefix="about to destroy Grid: ", & logMsgFlag=ESMF_LOGMSG_DEBUG, rc=rc) +#endif call ESMF_GridDestroy(gridListE%keyGrid, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, file=trim(name)//":"//FILENAME)) return ! bail out @@ -4501,8 +4503,10 @@ subroutine InitializeIPDv05p5(connector, importState, exportState, clock, rc) meshList=>meshList%prev #define CLEAN_OUT_OLD_ACCEPTOR_MESH #ifdef CLEAN_OUT_OLD_ACCEPTOR_MESH +#if 0 call ESMF_PointerLog(meshListE%keyMesh%this, prefix="about to destroy Mesh: ", & logMsgFlag=ESMF_LOGMSG_DEBUG, rc=rc) +#endif call ESMF_MeshDestroy(meshListE%keyMesh, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, file=trim(name)//":"//FILENAME)) return ! bail out From 72e83f2298caa38e38d93d50e73eaee5416ea469 Mon Sep 17 00:00:00 2001 From: Gerhard Theurich Date: Mon, 30 Sep 2024 17:15:36 -0700 Subject: [PATCH 052/207] Ensure globally consistent singleCompCaseFlag setting across PETs. Clean up debug loging. --- .../src/ESMF_StateReconcile.F90 | 44 ++++++++++++++++--- 1 file changed, 38 insertions(+), 6 deletions(-) diff --git a/src/Superstructure/StateReconcile/src/ESMF_StateReconcile.F90 b/src/Superstructure/StateReconcile/src/ESMF_StateReconcile.F90 index f302618815..8b67e368b9 100644 --- a/src/Superstructure/StateReconcile/src/ESMF_StateReconcile.F90 +++ b/src/Superstructure/StateReconcile/src/ESMF_StateReconcile.F90 @@ -195,6 +195,21 @@ subroutine ESMF_StateReconcile(state, vm, rc) rcToReturn=rc)) return end if +#if 0 + block + character(ESMF_MAXSTR) :: stateName + call ESMF_StateGet(state, name=stateName, rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, & + rcToReturn=rc)) return + call ESMF_LogWrite("StateReconcile() for State: "//trim(stateName), & + ESMF_LOGMSG_DEBUG, rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, & + rcToReturn=rc)) return + end block +#endif + #if 0 block type(ESMF_InfoDescribe) :: idesc @@ -241,15 +256,13 @@ subroutine ESMF_StateReconcile(state, vm, rc) endif if (isNoop) then -call ESMF_LogWrite("returning early with isNoop=.true.", ESMF_LOGMSG_DEBUG, rc=localrc) -#if 1 +!call ESMF_LogWrite("returning early with isNoop=.true.", ESMF_LOGMSG_DEBUG, rc=localrc) ! successful early return because of NOOP condition if (present(rc)) rc = ESMF_SUCCESS return -#endif endif -call ESMF_LogWrite("continue with isNoop=.false.", ESMF_LOGMSG_DEBUG, rc=localrc) +!call ESMF_LogWrite("continue with isNoop=.false.", ESMF_LOGMSG_DEBUG, rc=localrc) ! Each PET broadcasts the object ID lists and compares them to what ! they get back. Missing objects are sent so they can be recreated @@ -448,7 +461,7 @@ subroutine ESMF_StateReconcileIsNoop(state, vm, isNoop, rc) rcToReturn=rc)) return endif - if (isNoopInt(1)==1) isNoop = .true. ! found that Reconcile is a NOOP + isNoop = (isNoopInt(1)==1) ! globally consistent result ! return successfully rc = ESMF_SUCCESS @@ -565,7 +578,7 @@ recursive subroutine StateReconcileIsNoopLoc(stateR, isNoopLoc, rc) ESMF_CONTEXT, rcToReturn=rc)) return endif -call ESMF_LogWrite("processing "//trim(itemNameList(item)), ESMF_LOGMSG_DEBUG, rc=localrc) +!call ESMF_LogWrite("processing "//trim(itemNameList(item)), ESMF_LOGMSG_DEBUG, rc=localrc) call ESMF_VMGetThis(vmItem, thisItem, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & @@ -665,6 +678,8 @@ subroutine ESMF_StateReconcile_driver (state, vm, attreconflag, rc) type(ESMF_VMId), allocatable, target :: vmIdMap(:) type(ESMF_VMId), pointer :: vmIdSingleComp logical :: singleCompCaseFlag + integer :: singleCompCaseFlagInt(1) + integer :: singleCompCaseInt(1) integer :: singleCompIndex character(len=ESMF_MAXSTR) :: logmsg @@ -838,6 +853,17 @@ subroutine ESMF_StateReconcile_driver (state, vm, attreconflag, rc) vmIdSingleComp => vmIdMap(singleCompIndex) endif endif + + ! ensure global consistency of the final result + singleCompCaseFlagInt(1) = 0 + if (singleCompCaseFlag) singleCompCaseFlagInt(1) = 1 + ! logical AND reduction, only 1 if all incoming 1 + call ESMF_VMAllReduce(vm, singleCompCaseFlagInt, singleCompCaseInt, 1, & + ESMF_REDUCE_MIN, rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & + rcToReturn=rc)) return + singleCompCaseFlag = (singleCompCaseInt(1)==1) ! globally consistent result + if (profile) then call ESMF_TraceRegionExit("Decide between cases", rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & @@ -926,6 +952,7 @@ subroutine ESMF_StateReconcile_driver (state, vm, attreconflag, rc) !singleCompCaseFlag = .false. !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +#if 0 block character(160):: msgStr write(msgStr,*) "size(vmintids_send): ", size(vmintids_send) @@ -935,6 +962,7 @@ subroutine ESMF_StateReconcile_driver (state, vm, attreconflag, rc) write(msgStr,*) "singleCompCaseFlag: ", singleCompCaseFlag call ESMF_LogWrite(msgStr, ESMF_LOGMSG_DEBUG, rc=rc) end block +#endif if (singleCompCaseFlag) then ! CASE: a single component interacting with a state @@ -1423,6 +1451,7 @@ subroutine ESMF_ReconcileSingleCompCase(state, vm, vmId, attreconflag, siwrap, r return endif +#if 0 block character(160) :: msgStr write(msgStr,*) "SingleCompCase rootVas=", rootVas @@ -1430,6 +1459,7 @@ subroutine ESMF_ReconcileSingleCompCase(state, vm, vmId, attreconflag, siwrap, r write(msgStr,*) "SingleCompCase rootPet=", rootPet call ESMF_LogWrite(msgStr, ESMF_LOGMSG_DEBUG, rc=localrc) end block +#endif ! Serialize on rootPet if (localPet==rootPet) then @@ -1457,11 +1487,13 @@ subroutine ESMF_ReconcileSingleCompCase(state, vm, vmId, attreconflag, siwrap, r if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return +#if 0 block character(160) :: msgStr write(msgStr,*) "isFlag=", isFlag call ESMF_LogWrite(msgStr, ESMF_LOGMSG_DEBUG, rc=localrc) end block +#endif ! only inactive PETs deserialize the buffer received from rootPet if (.not.isFlag) then From 4a851c81a879b77e684c21fd0ffc55b82d6b5f81 Mon Sep 17 00:00:00 2001 From: Gerhard Theurich Date: Tue, 1 Oct 2024 11:50:32 -0700 Subject: [PATCH 053/207] Correct ProTex label mix up. --- src/Infrastructure/Util/interface/ESMF_Util.F90 | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/Infrastructure/Util/interface/ESMF_Util.F90 b/src/Infrastructure/Util/interface/ESMF_Util.F90 index 51bfc9a24d..829924626a 100644 --- a/src/Infrastructure/Util/interface/ESMF_Util.F90 +++ b/src/Infrastructure/Util/interface/ESMF_Util.F90 @@ -777,7 +777,7 @@ function ESMF_UtilString2Double(string, keywordEnforcer, rc) ! Return code; equals {\tt ESMF\_SUCCESS} if there are no errors. ! \end{description} ! -!EOPI +!EOP !----------------------------------------------------------------------------- ! local variables integer :: ioerr @@ -857,7 +857,7 @@ function ESMF_UtilString2Int(string, keywordEnforcer, & ! Return code; equals {\tt ESMF\_SUCCESS} if there are no errors. ! \end{description} ! -!EOPI +!EOP !----------------------------------------------------------------------------- ! local variables logical :: ssL, svL @@ -958,7 +958,7 @@ function ESMF_UtilString2Real(string, keywordEnforcer, rc) ! Return code; equals {\tt ESMF\_SUCCESS} if there are no errors. ! \end{description} ! -!EOPI +!EOP !----------------------------------------------------------------------------- ! local variables integer :: ioerr From 00e26047f1a6bdd8ff158416c0031d7f18220e7b Mon Sep 17 00:00:00 2001 From: Gerhard Theurich Date: Tue, 1 Oct 2024 15:55:28 -0700 Subject: [PATCH 054/207] Implement ESMF_UtilStringDiffMatch() utility function in support of ESMF_StateReconcile() checkFlag. --- src/Infrastructure/Util/include/dmp_diff.hpp | 1223 +++++++++++++++++ .../Util/interface/ESMCI_Util_F.C | 108 +- .../Util/interface/ESMF_Util.F90 | 66 + 3 files changed, 1396 insertions(+), 1 deletion(-) create mode 100644 src/Infrastructure/Util/include/dmp_diff.hpp diff --git a/src/Infrastructure/Util/include/dmp_diff.hpp b/src/Infrastructure/Util/include/dmp_diff.hpp new file mode 100644 index 0000000000..7d98ce6cf0 --- /dev/null +++ b/src/Infrastructure/Util/include/dmp_diff.hpp @@ -0,0 +1,1223 @@ +/* + * Diff (without the Match and Patch) + * Copyright 2018 The diff-match-patch Authors. + * Copyright 2019 Victor Grishchenko + * https://github.com/google/diff-match-patch + * https://github.com/gritzko/myers-diff + * + * Licensed under the Apache License, Version 2.0 (the "License"); + * you may not use this file except in compliance with the License. + * You may obtain a copy of the License at + * + * http://www.apache.org/licenses/LICENSE-2.0 + * + * Unless required by applicable law or agreed to in writing, software + * distributed under the License is distributed on an "AS IS" BASIS, + * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. + * See the License for the specific language governing permissions and + * limitations under the License. + */ +#ifndef MyersDiff_HPP +#define MyersDiff_HPP + +#include +#include +#include +#include +#include +#include +#include +#include + +using namespace std; + +enum Operation : int8_t { EQUAL=0, INSERT=1, DELETE=2 }; + +inline char op2chr(Operation op) { + switch (op) { + case DELETE: + return '-'; + case INSERT: + return '+'; + case EQUAL: + return '='; + default: + return '?'; + } +} + +/* + * Computes the difference between two texts to create a patch. + * Also contains the behaviour settings. + */ +template +class MyersDiff { + public: + // Defaults. + // Set these on your diff_match_patch instance to override the defaults. + + /** + * Number of milliseconds to map a diff before giving up (0 for infinity). + */ + long Diff_Timeout = 1000; + /** + * Cost of an empty edit operation in terms of edit characters. + */ + uint16_t Diff_EditCost = 4; + /** + * At what point is no match declared (0.0 = perfection, 1.0 = very loose). + */ + float Match_Threshold = 0.5f; + /** + * How far to search for a match (0 = exact location, 1000+ = broad match). + * A match this many characters away from the expected location will add + * 1.0 to the score (0.0 is a perfect match). + */ + int Match_Distance = 1000; + /** + * When deleting a large block of text (over ~64 characters), how close do + * the contents have to be to match the expected contents. (0.0 = + * perfection, 1.0 = very loose). Note that Match_Threshold controls how + * closely the end points of a delete need to match. + */ + float Patch_DeleteThreshold = 0.5f; + /** + * Chunk size for context length. + */ + uint16_t Patch_Margin = 4; + + public: + using Char = typename String::value_type; + using Time = chrono::time_point; + using Size = typename String::size_type; + using ConstIter = typename String::const_iterator; + + struct Range { + ConstIter from, till; + Range(ConstIter begin, ConstIter end) : from{begin}, till{end} {} + explicit Range(const String& str) + : from{str.begin()}, till{str.end()} {} + bool operator==(Range b) const { + if (till - from != b.till - b.from) return false; + for (auto i = from, j = b.from; i < till; ++i, ++j) + if (*i != *j) return false; + return true; + } + Size size() const { return till - from; } + Range substr(Size start) const { + assert(start <= size()); + return Range{from + start, till}; + } + Range substr(Size start, Size end) const { + assert(end >= start); + assert(start <= size()); + if (end >= size()) end = size(); + return Range{from + start, from + end}; + } + Char operator[](Size idx) const { + assert(idx < size()); + return *(from + idx); + } + Size find(Range b) const { + auto at = std::search(from, till, b.from, b.till); + return at < till ? at - from : -1; + } + }; + + struct Diff { + Operation operation; + Range text; + Diff(Operation op, Range text_range) + : operation{op}, text{text_range} {} + std::string str() const { + string ret; + ret.push_back(op2chr(operation)); + ret.push_back('\t'); + ret.append(text.from, text.till); + return ret; + } + }; + + using Diffs = std::vector; + + private: + const String& text1; + const String& text2; + Diffs result; + + public: + MyersDiff(const String& original_text, const String& changed_text) + : text1{original_text}, text2{changed_text} { + result = diff_main(Range{text1}, Range{text2}); + } + + typename Diffs::const_iterator begin() const { return result.begin(); } + typename Diffs::const_iterator end() const { return result.end(); } + + const Diffs& diffs() const { return result; } + + // DIFF FUNCTIONS + + /** + * Find the differences between two texts. + * @return std::vector of Diff objects. + */ + Diffs diff_main(Range text1, Range text2) { + // Set a deadline by which time the diff must be complete. + Time deadline; + if (Diff_Timeout <= 0) { + deadline = Time::max(); + } else { + deadline = chrono::steady_clock::now() + + chrono::milliseconds(Diff_Timeout); + } + return diff_main(text1, text2, deadline); + } + + /** + * Find the differences between two texts. Simplifies the problem by + * stripping any common prefix or suffix off the texts before diffing. + * @param deadline Time when the diff should be complete by. Used + * internally for recursive calls. Users should set DiffTimeout + * instead. + * @return std::vector of Diff objects. + */ + Diffs diff_main(Range text1, Range text2, Time deadline) { + // Check for equality (speedup). + Diffs diffs{}; + if (text1 == text2) { + if (text1.size() != 0) { + diffs.push_back(Diff(EQUAL, text1)); + } + return diffs; + } + + // Trim off common prefix (speedup). + int commonlength = diff_commonPrefix(text1, text2); + Range commonprefix = text1.substr(0, commonlength); + text1 = text1.substr(commonlength); + text2 = text2.substr(commonlength); + + // Trim off common suffix (speedup). + commonlength = diff_commonSuffix(text1, text2); + Range commonsuffix = text1.substr(text1.size() - commonlength); + text1 = text1.substr(0, text1.size() - commonlength); + text2 = text2.substr(0, text2.size() - commonlength); + + // Compute the diff on the middle block. + diffs = diff_compute(text1, text2, deadline); + + // Restore the prefix and suffix. + if (commonprefix.size() != 0) { + diffs.insert(diffs.begin(), Diff(EQUAL, commonprefix)); + } + if (commonsuffix.size() != 0) { + diffs.push_back(Diff(EQUAL, commonsuffix)); + } + + // TODO diff_cleanupMerge(diffs); + return diffs; + } + + /** + * Find the differences between two texts. Assumes that the texts do not + * have any common prefix or suffix. + * @param text1 Old string to be diffed. + * @param text2 New string to be diffed. + * @param checklines Speedup flag. If false, then don't run a + * line-level diff first to identify the changed areas. + * If true, then run a faster slightly less optimal diff. + * @param deadline Time when the diff should be complete by. + * @return std::vector of Diff objects. + */ + Diffs diff_compute(Range text1, Range text2, Time deadline) { + Diffs diffs{}; + + if (text1.size() == 0) { + // Just add some text (speedup). + diffs.push_back(Diff(INSERT, text2)); + return diffs; + } + + if (text2.size() == 0) { + // Just delete some text (speedup). + diffs.push_back(Diff(DELETE, text1)); + return diffs; + } + + Range longtext = text1.size() > text2.size() ? text1 : text2; + Range shorttext = text1.size() > text2.size() ? text2 : text1; + int i = longtext.find(shorttext); + if (i != -1) { + // Shorter text is inside the longer text (speedup). + Operation op = (text1.size() > text2.size()) ? DELETE : INSERT; + diffs.push_back(Diff(op, longtext.substr(0, i))); + diffs.push_back(Diff(EQUAL, shorttext)); + diffs.push_back(Diff(op, longtext.substr(i + shorttext.size()))); + return diffs; + } + + if (shorttext.size() == 1) { + // Single character string. + // After the previous speedup, the character can't be an equality. + diffs.push_back(Diff(DELETE, text1)); + diffs.push_back(Diff(INSERT, text2)); + return diffs; + } + + // Check to see if the problem can be split in two. + /* TODO String[] hm = diff_halfMatch(text1, text2); + if (hm != null) { + // A half-match was found, sort out the return data. + Range text1_a = hm[0]; + Range text1_b = hm[1]; + Range text2_a = hm[2]; + Range text2_b = hm[3]; + String mid_common = hm[4]; + // Send both pairs off for separate processing. + Diffs diffs_a = diff_main(text1_a, text2_a, + checklines, deadline); + Diffs diffs_b = diff_main(text1_b, text2_b, + checklines, deadline); + // Merge the results. + diffs = diffs_a; + diffs.push_back(Diff(EQUAL, mid_common)); + diffs.addAll(diffs_b); + return diffs; + } + + if (checklines && text1.size() > 100 && text2.size() > 100) { + return diff_lineMode(text1, text2, deadline); + }*/ + + return diff_bisect(text1, text2, deadline); + } + + /** + * Find the 'middle snake' of a diff, split the problem in two + * and return the recursively constructed diff. + * See Myers 1986 paper: An O(ND) Difference Algorithm and Its Variations. + * @param text1 Old string to be diffed. + * @param text2 New string to be diffed. + * @param deadline Time at which to bail if not yet complete. + * @return std::vector of Diff objects. + */ + Diffs diff_bisect(Range text1, Range text2, Time deadline) { + // Cache the text lengths to prevent multiple calls. + int text1_length = text1.size(); + int text2_length = text2.size(); + int max_d = (text1_length + text2_length + 1) / 2; + int v_offset = max_d; + int v_length = 2 * max_d; + vector v1; + v1.resize(v_length); + vector v2; + v2.resize(v_length); + for (int x = 0; x < v_length; x++) { + v1[x] = -1; + v2[x] = -1; + } + v1[v_offset + 1] = 0; + v2[v_offset + 1] = 0; + int delta = text1_length - text2_length; + // If the total number of characters is odd, then the front path will + // collide with the reverse path. + bool front = (delta % 2 != 0); + // Offsets for start and end of k loop. + // Prevents mapping of space beyond the grid. + int k1start = 0; + int k1end = 0; + int k2start = 0; + int k2end = 0; + for (int d = 0; d < max_d; d++) { + // Bail out if deadline is reached. + /* TODO if (System.currentTimeMillis() > deadline) { + break; + } */ + + // Walk the front path one step. + for (int k1 = -d + k1start; k1 <= d - k1end; k1 += 2) { + int k1_offset = v_offset + k1; + int x1; + if (k1 == -d || + (k1 != d && v1[k1_offset - 1] < v1[k1_offset + 1])) { + x1 = v1[k1_offset + 1]; + } else { + x1 = v1[k1_offset - 1] + 1; + } + int y1 = x1 - k1; + while (x1 < text1_length && y1 < text2_length && + text1[x1] == text2[y1]) { + x1++; + y1++; + } + v1[k1_offset] = x1; + if (x1 > text1_length) { + // Ran off the right of the graph. + k1end += 2; + } else if (y1 > text2_length) { + // Ran off the bottom of the graph. + k1start += 2; + } else if (front) { + int k2_offset = v_offset + delta - k1; + if (k2_offset >= 0 && k2_offset < v_length && + v2[k2_offset] != -1) { + // Mirror x2 onto top-left coordinate system. + int x2 = text1_length - v2[k2_offset]; + if (x1 >= x2) { + // Overlap detected. + return diff_bisectSplit(text1, text2, x1, y1, + deadline); + } + } + } + } + + // Walk the reverse path one step. + for (int k2 = -d + k2start; k2 <= d - k2end; k2 += 2) { + int k2_offset = v_offset + k2; + int x2; + if (k2 == -d || + (k2 != d && v2[k2_offset - 1] < v2[k2_offset + 1])) { + x2 = v2[k2_offset + 1]; + } else { + x2 = v2[k2_offset - 1] + 1; + } + int y2 = x2 - k2; + while (x2 < text1_length && y2 < text2_length && + text1[text1_length - x2 - 1] == + text2[text2_length - y2 - 1]) { + x2++; + y2++; + } + v2[k2_offset] = x2; + if (x2 > text1_length) { + // Ran off the left of the graph. + k2end += 2; + } else if (y2 > text2_length) { + // Ran off the top of the graph. + k2start += 2; + } else if (!front) { + int k1_offset = v_offset + delta - k2; + if (k1_offset >= 0 && k1_offset < v_length && + v1[k1_offset] != -1) { + int x1 = v1[k1_offset]; + int y1 = v_offset + x1 - k1_offset; + // Mirror x2 onto top-left coordinate system. + x2 = text1_length - x2; + if (x1 >= x2) { + // Overlap detected. + return diff_bisectSplit(text1, text2, x1, y1, + deadline); + } + } + } + } + } + // Diff took too long and hit the deadline or + // number of diffs equals number of characters, no commonality at all. + Diffs diffs{}; + diffs.push_back(Diff{DELETE, text1}); + diffs.push_back(Diff{INSERT, text2}); + return diffs; + } + + /** + * Given the location of the 'middle snake', split the diff in two parts + * and recurse. + * @param text1 Old string to be diffed. + * @param text2 New string to be diffed. + * @param x Index of split point in text1. + * @param y Index of split point in text2. + * @param deadline Time at which to bail if not yet complete. + * @return std::vector of Diff objects. + */ + Diffs diff_bisectSplit(Range text1, Range text2, int x, int y, + Time deadline) { + Range text1a = text1.substr(0, x); + Range text2a = text2.substr(0, y); + Range text1b = text1.substr(x); + Range text2b = text2.substr(y); + + // Compute both diffs serially. + Diffs diffs = diff_main(text1a, text2a, deadline); + Diffs diffsb = diff_main(text1b, text2b, deadline); + + diffs.insert(diffs.end(), diffsb.begin(), diffsb.end()); + return diffs; + } + + /** + * Determine the common prefix of two strings + * @param text1 First string. + * @param text2 Second string. + * @return The number of characters common to the start of each string. + */ + int diff_commonPrefix(Range text1, Range text2) { + // Performance analysis: https://neil.fraser.name/news/2007/10/09/ + int n = std::min(text1.size(), text2.size()); + for (int i = 0; i < n; i++) { + if (text1[i] != text2[i]) { + return i; + } + } + return n; + } + + /** + * Determine the common suffix of two strings + * @param text1 First string. + * @param text2 Second string. + * @return The number of characters common to the end of each string. + */ + int diff_commonSuffix(Range text1, Range text2) { + // Performance analysis: https://neil.fraser.name/news/2007/10/09/ + int text1_length = text1.size(); + int text2_length = text2.size(); + int n = std::min(text1_length, text2_length); + for (int i = 1; i <= n; i++) { + if (text1[text1_length - i] != text2[text2_length - i]) { + return i - 1; + } + } + return n; + } + + /** + * Determine if the suffix of one string is the prefix of another. + * @param text1 First string. + * @param text2 Second string. + * @return The number of characters common to the end of the first + * string and the start of the second string. + */ + int diff_commonOverlap(Range text1, Range text2) { + // Cache the text lengths to prevent multiple calls. + int text1_length = text1.size(); + int text2_length = text2.size(); + // Eliminate the null case. + if (text1_length == 0 || text2_length == 0) { + return 0; + } + // Truncate the longer string. + if (text1_length > text2_length) { + text1 = text1.substr(text1_length - text2_length); + } else if (text1_length < text2_length) { + text2 = text2.substr(0, text1_length); + } + int text_length = std::min(text1_length, text2_length); + // Quick check for the worst case. + if (text1 == text2) { + return text_length; + } + + // Start by looking for a single character match + // and increase length until no match is found. + // Performance analysis: https://neil.fraser.name/news/2010/11/04/ + int best = 0; + int length = 1; + while (true) { + String pattern = text1.substr(text_length - length); + int found = text2.indexOf(pattern); + if (found == -1) { + return best; + } + length += found; + if (found == 0 || + text1.substr(text_length - length) == text2.substr(0, length)) { + best = length; + length++; + } + } + } + + /** + * Do the two texts share a substring which is at least half the length of + * the longer text? + * This speedup can produce non-minimal diffs. + * @param text1 First string. + * @param text2 Second string. + * @return Five element String array, containing the prefix of text1, the + * suffix of text1, the prefix of text2, the suffix of text2 and the + * common middle. Or null if there was no match. + */ + /* TODO + String[] diff_halfMatch(Range text1, Range text2) { + if (Diff_Timeout <= 0) { + // Don't risk returning a non-optimal diff if we have unlimited time. + return null; + } + String longtext = text1.size() > text2.size() ? text1 : text2; + String shorttext = text1.size() > text2.size() ? text2 : text1; + if (longtext.size() < 4 || shorttext.size() * 2 < longtext.size()) { + return null; // Pointless. + } + + // First check if the second quarter is the seed for a half-match. + String[] hm1 = diff_halfMatchI(longtext, shorttext, + (longtext.size() + 3) / 4); + // Check again based on the third quarter. + String[] hm2 = diff_halfMatchI(longtext, shorttext, + (longtext.size() + 1) / 2); + String[] hm; + if (hm1 == null && hm2 == null) { + return null; + } else if (hm2 == null) { + hm = hm1; + } else if (hm1 == null) { + hm = hm2; + } else { + // Both matched. Select the longest. + hm = hm1[4].size() > hm2[4].size() ? hm1 : hm2; + } + + // A half-match was found, sort out the return data. + if (text1.size() > text2.size()) { + return hm; + //return new String[]{hm[0], hm[1], hm[2], hm[3], hm[4]}; + } else { + return new String[]{hm[2], hm[3], hm[0], hm[1], hm[4]}; + } + } + */ + + /** + * Does a substring of shorttext exist within longtext such that the + * substring is at least half the length of longtext? + * @param longtext Longer string. + * @param shorttext Shorter string. + * @param i Start index of quarter length substring within longtext. + * @return Five element String array, containing the prefix of longtext, the + * suffix of longtext, the prefix of shorttext, the suffix of shorttext + * and the common middle. Or null if there was no match. + * + String[] diff_halfMatchI(String longtext, String shorttext, int i) { + // Start with a 1/4 length substring at position i as a seed. + String seed = longtext.substring(i, i + longtext.size() / 4); + int j = -1; + String best_common = ""; + String best_longtext_a = "", best_longtext_b = ""; + String best_shorttext_a = "", best_shorttext_b = ""; + while ((j = shorttext.indexOf(seed, j + 1)) != -1) { + int prefixLength = diff_commonPrefix(longtext.substring(i), + shorttext.substring(j)); + int suffixLength = diff_commonSuffix(longtext.substring(0, i), + shorttext.substring(0, j)); + if (best_common.size() < suffixLength + prefixLength) { + best_common = shorttext.substring(j - suffixLength, j) + + shorttext.substring(j, j + prefixLength); + best_longtext_a = longtext.substring(0, i - suffixLength); + best_longtext_b = longtext.substring(i + prefixLength); + best_shorttext_a = shorttext.substring(0, j - suffixLength); + best_shorttext_b = shorttext.substring(j + prefixLength); + } + } + if (best_common.size() * 2 >= longtext.size()) { + return new String[]{best_longtext_a, best_longtext_b, + best_shorttext_a, best_shorttext_b, best_common}; + } else { + return null; + } + } + */ + + /** + * Reduce the number of edits by eliminating semantically trivial + equalities. + * @param diffs std::vector of Diff objects. + * + void diff_cleanupSemantic(Diffs diffs) { + if (diffs.isEmpty()) { + return; + } + bool changes = false; + std::deque equalities = new ArrayDeque(); // Double-ended + queue of qualities. String lastEquality = null; // Always equal to + equalities.peek().text std::vectorIterator pointer = + diffs.listIterator(); + // Number of characters that changed prior to the equality. + int length_insertions1 = 0; + int length_deletions1 = 0; + // Number of characters that changed after the equality. + int length_insertions2 = 0; + int length_deletions2 = 0; + Diff thisDiff = pointer.next(); + while (thisDiff != null) { + if (thisDiff.operation == EQUAL) { + // Equality found. + equalities.push(thisDiff); + length_insertions1 = length_insertions2; + length_deletions1 = length_deletions2; + length_insertions2 = 0; + length_deletions2 = 0; + lastEquality = thisDiff.text; + } else { + // An insertion or deletion. + if (thisDiff.operation == INSERT) { + length_insertions2 += thisDiff.text.size(); + } else { + length_deletions2 += thisDiff.text.size(); + } + // Eliminate an equality that is smaller or equal to the edits on both + // sides of it. + if (lastEquality != null && (lastEquality.size() + <= std::max(length_insertions1, length_deletions1)) + && (lastEquality.size() + <= std::max(length_insertions2, length_deletions2))) { + //System.out.println("Splitting: '" + lastEquality + "'"); + // Walk back to offending equality. + while (thisDiff != equalities.peek()) { + thisDiff = pointer.previous(); + } + pointer.next(); + + // Replace equality with a delete. + pointer.set(Diff(DELETE, lastEquality)); + // Insert a corresponding an insert. + pointer.push_back(Diff(INSERT, lastEquality)); + + equalities.pop(); // Throw away the equality we just deleted. + if (!equalities.isEmpty()) { + // Throw away the previous equality (it needs to be reevaluated). + equalities.pop(); + } + if (equalities.isEmpty()) { + // There are no previous equalities, walk back to the start. + while (pointer.hasPrevious()) { + pointer.previous(); + } + } else { + // There is a safe equality we can fall back to. + thisDiff = equalities.peek(); + while (thisDiff != pointer.previous()) { + // Intentionally empty loop. + } + } + + length_insertions1 = 0; // Reset the counters. + length_insertions2 = 0; + length_deletions1 = 0; + length_deletions2 = 0; + lastEquality = null; + changes = true; + } + } + thisDiff = pointer.hasNext() ? pointer.next() : null; + } + + // Normalize the diff. + if (changes) { + diff_cleanupMerge(diffs); + } + diff_cleanupSemanticLossless(diffs); + + // Find any overlaps between deletions and insertions. + // e.g: abcxxxxxxdef + // -> abcxxxdef + // e.g: xxxabcdefxxx + // -> defxxxabc + // Only extract an overlap if it is as big as the edit ahead or behind it. + pointer = diffs.listIterator(); + Diff prevDiff = null; + thisDiff = null; + if (pointer.hasNext()) { + prevDiff = pointer.next(); + if (pointer.hasNext()) { + thisDiff = pointer.next(); + } + } + while (thisDiff != null) { + if (prevDiff.operation == DELETE && + thisDiff.operation == INSERT) { + String deletion = prevDiff.text; + String insertion = thisDiff.text; + int overlap_length1 = diff_commonOverlap(deletion, insertion); + int overlap_length2 = diff_commonOverlap(insertion, deletion); + if (overlap_length1 >= overlap_length2) { + if (overlap_length1 >= deletion.size() / 2.0 || + overlap_length1 >= insertion.size() / 2.0) { + // Overlap found. Insert an equality and trim the surrounding + edits. pointer.previous(); pointer.push_back(Diff(EQUAL, + insertion.substring(0, overlap_length1))); + prevDiff.text = + deletion.substring(0, deletion.size() - overlap_length1); + thisDiff.text = insertion.substring(overlap_length1); + // pointer.add inserts the element before the cursor, so there is + // no need to step past the new element. + } + } else { + if (overlap_length2 >= deletion.size() / 2.0 || + overlap_length2 >= insertion.size() / 2.0) { + // Reverse overlap found. + // Insert an equality and swap and trim the surrounding edits. + pointer.previous(); + pointer.push_back(Diff(EQUAL, + deletion.substring(0, overlap_length2))); + prevDiff.operation = INSERT; + prevDiff.text = + insertion.substring(0, insertion.size() - overlap_length2); + thisDiff.operation = DELETE; + thisDiff.text = deletion.substring(overlap_length2); + // pointer.add inserts the element before the cursor, so there is + // no need to step past the new element. + } + } + thisDiff = pointer.hasNext() ? pointer.next() : null; + } + prevDiff = thisDiff; + thisDiff = pointer.hasNext() ? pointer.next() : null; + } + } + */ + + /** + * Look for single edits surrounded on both sides by equalities + * which can be shifted sideways to align the edit to a word boundary. + * e.g: The cat came. -> The cat came. + * @param diffs std::vector of Diff objects. + * TODO + void diff_cleanupSemanticLossless(Diffs diffs) { + String equality1, edit, equality2; + String commonString; + int commonOffset; + int score, bestScore; + String bestEquality1, bestEdit, bestEquality2; + // Create a new iterator at the start. + std::vectorIterator pointer = diffs.listIterator(); + Diff prevDiff = pointer.hasNext() ? pointer.next() : null; + Diff thisDiff = pointer.hasNext() ? pointer.next() : null; + Diff nextDiff = pointer.hasNext() ? pointer.next() : null; + // Intentionally ignore the first and last element (don't need checking). + while (nextDiff != null) { + if (prevDiff.operation == EQUAL && + nextDiff.operation == EQUAL) { + // This is a single edit surrounded by equalities. + equality1 = prevDiff.text; + edit = thisDiff.text; + equality2 = nextDiff.text; + + // First, shift the edit as far left as possible. + commonOffset = diff_commonSuffix(equality1, edit); + if (commonOffset != 0) { + commonString = edit.substring(edit.size() - commonOffset); + equality1 = equality1.substring(0, equality1.size() - + commonOffset); edit = commonString + edit.substring(0, edit.size() - + commonOffset); equality2 = commonString + equality2; + } + + // Second, step character by character right, looking for the best + fit. bestEquality1 = equality1; bestEdit = edit; bestEquality2 = equality2; + bestScore = diff_cleanupSemanticScore(equality1, edit) + + diff_cleanupSemanticScore(edit, equality2); + while (edit.size() != 0 && equality2.size() != 0 + && edit.charAt(0) == equality2.charAt(0)) { + equality1 += edit.charAt(0); + edit = edit.substring(1) + equality2.charAt(0); + equality2 = equality2.substring(1); + score = diff_cleanupSemanticScore(equality1, edit) + + diff_cleanupSemanticScore(edit, equality2); + // The >= encourages trailing rather than leading whitespace on + edits. if (score >= bestScore) { bestScore = score; bestEquality1 = + equality1; bestEdit = edit; bestEquality2 = equality2; + } + } + + if (!prevDiff.text.equals(bestEquality1)) { + // We have an improvement, save it back to the diff. + if (bestEquality1.size() != 0) { + prevDiff.text = bestEquality1; + } else { + pointer.previous(); // Walk past nextDiff. + pointer.previous(); // Walk past thisDiff. + pointer.previous(); // Walk past prevDiff. + pointer.remove(); // Delete prevDiff. + pointer.next(); // Walk past thisDiff. + pointer.next(); // Walk past nextDiff. + } + thisDiff.text = bestEdit; + if (bestEquality2.size() != 0) { + nextDiff.text = bestEquality2; + } else { + pointer.remove(); // Delete nextDiff. + nextDiff = thisDiff; + thisDiff = prevDiff; + } + } + } + prevDiff = thisDiff; + thisDiff = nextDiff; + nextDiff = pointer.hasNext() ? pointer.next() : null; + } + } + */ + + /** + * Given two strings, compute a score representing whether the internal + * boundary falls on logical boundaries. + * Scores range from 6 (best) to 0 (worst). + * @param one First string. + * @param two Second string. + * @return The score. + * TODO + int diff_cleanupSemanticScore(String one, String two) { + if (one.size() == 0 || two.size() == 0) { + // Edges are the best. + return 6; + } + + // Each port of this function behaves slightly differently due to + // subtle differences in each language's definition of things like + // 'whitespace'. Since this function's purpose is largely cosmetic, + // the choice has been made to use each language's native features + // rather than force total conformity. + char char1 = one.charAt(one.size() - 1); + char char2 = two.charAt(0); + bool nonAlphaNumeric1 = !Character.isLetterOrDigit(char1); + bool nonAlphaNumeric2 = !Character.isLetterOrDigit(char2); + bool whitespace1 = nonAlphaNumeric1 && Character.isWhitespace(char1); + bool whitespace2 = nonAlphaNumeric2 && Character.isWhitespace(char2); + bool lineBreak1 = whitespace1 + && Character.getType(char1) == Character.CONTROL; + bool lineBreak2 = whitespace2 + && Character.getType(char2) == Character.CONTROL; + bool blankLine1 = lineBreak1 && BLANKLINEEND.matcher(one).find(); + bool blankLine2 = lineBreak2 && BLANKLINESTART.matcher(two).find(); + + if (blankLine1 || blankLine2) { + // Five points for blank lines. + return 5; + } else if (lineBreak1 || lineBreak2) { + // Four points for line breaks. + return 4; + } else if (nonAlphaNumeric1 && !whitespace1 && whitespace2) { + // Three points for end of sentences. + return 3; + } else if (whitespace1 || whitespace2) { + // Two points for whitespace. + return 2; + } else if (nonAlphaNumeric1 || nonAlphaNumeric2) { + // One point for non-alphanumeric. + return 1; + } + return 0; + } + */ + + /* Define some regex patterns for matching boundaries. + Pattern BLANKLINEEND + = Pattern.compile("\\n\\r?\\n\\Z", Pattern.DOTALL); + Pattern BLANKLINESTART + = Pattern.compile("\\A\\r?\\n\\r?\\n", Pattern.DOTALL); + */ + + /** + * Reduce the number of edits by eliminating operationally trivial + equalities. + * @param diffs std::vector of Diff objects. + * TODO + void diff_cleanupEfficiency(Diffs diffs) { + if (diffs.isEmpty()) { + return; + } + bool changes = false; + std::deque equalities = new ArrayDeque(); // Double-ended + queue of equalities. String lastEquality = null; // Always equal to + equalities.peek().text std::vectorIterator pointer = + diffs.listIterator(); + // Is there an insertion operation before the last equality. + bool pre_ins = false; + // Is there a deletion operation before the last equality. + bool pre_del = false; + // Is there an insertion operation after the last equality. + bool post_ins = false; + // Is there a deletion operation after the last equality. + bool post_del = false; + Diff thisDiff = pointer.next(); + Diff safeDiff = thisDiff; // The last Diff that is known to be + unsplittable. while (thisDiff != null) { if (thisDiff.operation == EQUAL) { + // Equality found. + if (thisDiff.text.size() < Diff_EditCost && (post_ins || post_del)) + { + // Candidate found. + equalities.push(thisDiff); + pre_ins = post_ins; + pre_del = post_del; + lastEquality = thisDiff.text; + } else { + // Not a candidate, and can never become one. + equalities.clear(); + lastEquality = null; + safeDiff = thisDiff; + } + post_ins = post_del = false; + } else { + // An insertion or deletion. + if (thisDiff.operation == DELETE) { + post_del = true; + } else { + post_ins = true; + } + /* + * Five types to be split: + * ABXYCD + * AXCD + * ABXC + * AXCD + * ABXC + * / + if (lastEquality != null + && ((pre_ins && pre_del && post_ins && post_del) + || ((lastEquality.size() < Diff_EditCost / 2) + && ((pre_ins ? 1 : 0) + (pre_del ? 1 : 0) + + (post_ins ? 1 : 0) + (post_del ? 1 : 0)) == 3))) { + //System.out.println("Splitting: '" + lastEquality + "'"); + // Walk back to offending equality. + while (thisDiff != equalities.peek()) { + thisDiff = pointer.previous(); + } + pointer.next(); + + // Replace equality with a delete. + pointer.set(Diff(DELETE, lastEquality)); + // Insert a corresponding an insert. + pointer.push_back(thisDiff = Diff(INSERT, lastEquality)); + + equalities.pop(); // Throw away the equality we just deleted. + lastEquality = null; + if (pre_ins && pre_del) { + // No changes made which could affect previous entry, keep going. + post_ins = post_del = true; + equalities.clear(); + safeDiff = thisDiff; + } else { + if (!equalities.isEmpty()) { + // Throw away the previous equality (it needs to be + reevaluated). equalities.pop(); + } + if (equalities.isEmpty()) { + // There are no previous questionable equalities, + // walk back to the last known safe diff. + thisDiff = safeDiff; + } else { + // There is an equality we can fall back to. + thisDiff = equalities.peek(); + } + while (thisDiff != pointer.previous()) { + // Intentionally empty loop. + } + post_ins = post_del = false; + } + + changes = true; + } + } + thisDiff = pointer.hasNext() ? pointer.next() : null; + } + + if (changes) { + diff_cleanupMerge(diffs); + } + } + */ + + /** + * Reorder and merge like edit sections. Merge equalities. + * Any edit section can move as long as it doesn't cross an equality. + * @param diffs std::vector of Diff objects. + * + void diff_cleanupMerge(Diffs diffs) { + diffs.push_back(Diff(EQUAL, "")); // Add a dummy entry at the end. + std::vectorIterator pointer = diffs.listIterator(); + int count_delete = 0; + int count_insert = 0; + Range text_delete = ""; + Range text_insert = ""; + Diff thisDiff = pointer.next(); + Diff prevEqual = null; + int commonlength; + while (thisDiff != null) { + switch (thisDiff.operation) { + case INSERT: + count_insert++; + text_insert += thisDiff.text; + prevEqual = null; + break; + case DELETE: + count_delete++; + text_delete += thisDiff.text; + prevEqual = null; + break; + case EQUAL: + if (count_delete + count_insert > 1) { + bool both_types = count_delete != 0 && count_insert != 0; + // Delete the offending records. + pointer.previous(); // Reverse direction. + while (count_delete-- > 0) { + pointer.previous(); + pointer.remove(); + } + while (count_insert-- > 0) { + pointer.previous(); + pointer.remove(); + } + if (both_types) { + // Factor out any common prefixies. + commonlength = diff_commonPrefix(text_insert, text_delete); + if (commonlength != 0) { + if (pointer.hasPrevious()) { + thisDiff = pointer.previous(); + assert thisDiff.operation == EQUAL + : "Previous diff should have been an equality."; + thisDiff.text += text_insert.substring(0, commonlength); + pointer.next(); + } else { + pointer.push_back(Diff(EQUAL, + text_insert.substring(0, commonlength))); + } + text_insert = text_insert.substring(commonlength); + text_delete = text_delete.substring(commonlength); + } + // Factor out any common suffixies. + commonlength = diff_commonSuffix(text_insert, text_delete); + if (commonlength != 0) { + thisDiff = pointer.next(); + thisDiff.text = text_insert.substring(text_insert.size() + - commonlength) + thisDiff.text; + text_insert = text_insert.substring(0, text_insert.size() + - commonlength); + text_delete = text_delete.substring(0, text_delete.size() + - commonlength); + pointer.previous(); + } + } + // Insert the merged records. + if (text_delete.size() != 0) { + pointer.push_back(Diff(DELETE, text_delete)); + } + if (text_insert.size() != 0) { + pointer.push_back(Diff(INSERT, text_insert)); + } + // Step forward to the equality. + thisDiff = pointer.hasNext() ? pointer.next() : null; + } else if (prevEqual != null) { + // Merge this equality with the previous one. + prevEqual.text += thisDiff.text; + pointer.remove(); + thisDiff = pointer.previous(); + pointer.next(); // Forward direction + } + count_insert = 0; + count_delete = 0; + text_delete = ""; + text_insert = ""; + prevEqual = thisDiff; + break; + } + thisDiff = pointer.hasNext() ? pointer.next() : null; + } + if (diffs.getLast().text.size() == 0) { + diffs.removeLast(); // Remove the dummy entry at the end. + } + + /* + * Second pass: look for single edits surrounded on both sides by + equalities + * which can be shifted sideways to eliminate an equality. + * e.g: ABAC -> ABAC + * / + bool changes = false; + // Create a new iterator at the start. + // (As opposed to walking the current one back.) + pointer = diffs.listIterator(); + Diff prevDiff = pointer.hasNext() ? pointer.next() : null; + thisDiff = pointer.hasNext() ? pointer.next() : null; + Diff nextDiff = pointer.hasNext() ? pointer.next() : null; + // Intentionally ignore the first and last element (don't need checking). + while (nextDiff != null) { + if (prevDiff.operation == EQUAL && + nextDiff.operation == EQUAL) { + // This is a single edit surrounded by equalities. + if (thisDiff.text.endsWith(prevDiff.text)) { + // Shift the edit over the previous equality. + thisDiff.text = prevDiff.text + + thisDiff.text.substring(0, thisDiff.text.size() + - prevDiff.text.size()); + nextDiff.text = prevDiff.text + nextDiff.text; + pointer.previous(); // Walk past nextDiff. + pointer.previous(); // Walk past thisDiff. + pointer.previous(); // Walk past prevDiff. + pointer.remove(); // Delete prevDiff. + pointer.next(); // Walk past thisDiff. + thisDiff = pointer.next(); // Walk past nextDiff. + nextDiff = pointer.hasNext() ? pointer.next() : null; + changes = true; + } else if (thisDiff.text.startsWith(nextDiff.text)) { + // Shift the edit over the next equality. + prevDiff.text += nextDiff.text; + thisDiff.text = thisDiff.text.substring(nextDiff.text.size()) + + nextDiff.text; + pointer.remove(); // Delete nextDiff. + nextDiff = pointer.hasNext() ? pointer.next() : null; + changes = true; + } + } + prevDiff = thisDiff; + thisDiff = nextDiff; + nextDiff = pointer.hasNext() ? pointer.next() : null; + } + // If shifts were made, the diff needs reordering and another shift sweep. + if (changes) { + diff_cleanupMerge(diffs); + } + } + */ + + /** + * Compute and return the source text (all equalities and deletions). + * @param diffs std::vector of Diff objects. + * @return Source text. + */ + String diff_text1(Diffs diffs) { + Range text{}; + for (Diff aDiff : diffs) { + if (aDiff.operation != INSERT) { + text.append(aDiff.text); + } + } + return text; + } + + /** + * Compute and return the destination text (all equalities and insertions). + * @param diffs std::vector of Diff objects. + * @return Destination text. + */ + String diff_text2(Diffs diffs) { + Range text{}; + for (Diff aDiff : diffs) { + if (aDiff.operation != DELETE) { + text.append(aDiff.text); + } + } + return text; + } + + struct Stats { + Size equal, inserted, deleted; + Stats() : equal{0}, inserted{0}, deleted{0} {} + }; + + Stats stats() const { + Stats ret; + for (const auto &i : result) { + switch (i.operation) { + case EQUAL: ret.equal += i.text.size(); break; + case INSERT: ret.inserted += i.text.size(); break; + case DELETE: ret.deleted += i.text.size(); break; + } + } + return ret; + } + +}; + +#endif diff --git a/src/Infrastructure/Util/interface/ESMCI_Util_F.C b/src/Infrastructure/Util/interface/ESMCI_Util_F.C index 394f7bbf0f..49311775c9 100644 --- a/src/Infrastructure/Util/interface/ESMCI_Util_F.C +++ b/src/Infrastructure/Util/interface/ESMCI_Util_F.C @@ -28,10 +28,13 @@ #endif #include #include +#include #include #include #include #include +#include + using namespace std; #if !defined (ESMF_OS_MinGW) @@ -48,6 +51,8 @@ using namespace std; #include "ESMCI_F90Interface.h" #include "ESMCI_LogErr.h" +#include "dmp_diff.hpp" + //----------------------------------------------------------------------------- // leave the following line as-is; it will insert the cvs ident string // into the object file for tracking purposes. @@ -371,11 +376,112 @@ extern "C" { if (len < pathname_l) memset (pathname+len, ' ', pathname_l-len); } - //----------------------------------------------------------------------------- + +//----------------------------------------------------------------------------- void FTN_X(c_pointerprint)(void **ptr){ printf("ESMF_PointerPrint: %p\n", *ptr); } +//----------------------------------------------------------------------------- + + +//----------------------------------------------------------------------------- +//BOPI +// !IROUTINE: c_ESMC_StringDiffMatch - Mayers diff between two strings +// +// !INTERFACE: + void FTN_X(c_esmc_stringdiffmatch)( +// +// !RETURN VALUE: +// none. return code is passed thru the parameter list +// +// !ARGUMENTS: + char *fstring1, // in - string object + char *fstring2, // in - string object + char *fminus, // in - string object + char *fplus, // in - string object + int *matchCount, // in - string object + ESMC_Logical *resultFlag, // out - result + int *rc, // out - return code + ESMCI_FortranStrLenArg clen1, // in, hidden - string length + ESMCI_FortranStrLenArg clen2, // in, hidden - string length + ESMCI_FortranStrLenArg clenMinus, // in, hidden - string length + ESMCI_FortranStrLenArg clenPlus) { // in, hidden - string length +// +// !DESCRIPTION: +// Produce Mayers diff between two strings. Then see if diffs match string +// pairs provided in fminus and fplus lists. +// +//EOPI +#undef ESMC_METHOD +#define ESMC_METHOD "c_ESMC_StringDiffMatch" + + if (rc) *rc = ESMF_SUCCESS; + + string string1(fstring1, clen1); + string string2(fstring2, clen2); + + vector minusStrings(*matchCount); + vector plusStrings(*matchCount); + + for (auto i=0; i<*matchCount; i++){ + // set up minus/plus Strings, trimming trailing white spaces + minusStrings[i] = regex_replace(string(fminus+i*clenMinus, clenMinus), + regex(" +$"), ""); + plusStrings[i] = regex_replace(string(fplus+i*clenPlus, clenPlus), + regex(" +$"), ""); + } + + MyersDiff diff{string1, string2}; // generate the difference + + bool allDiffOk = true; + for (auto it=diff.begin(); it!=diff.end(); ++it) { + string minusString, plusString; + bool diffFlag = false; + if (it->str().c_str()[0]=='-'){ + // this is '-' check for '+' on the next string + diffFlag = true; + minusString = it->str().substr(2); + if ((it+1)->str().c_str()[0]=='+'){ + ++it; + plusString = it->str().substr(2); + } + }else if (it->str().c_str()[0]=='+'){ + diffFlag = true; + // this is '+' therefore minusString is empty + minusString = string(""); + plusString = it->str().substr(2); + } + if (diffFlag){ + // search for this minus/plus pair in the provided strings + auto i=0; + for (i=0; i<*matchCount; i++){ + if ((minusString==minusStrings[i])&&(plusString==plusStrings[i])) break; + } + allDiffOk = (i<*matchCount); + if (!allDiffOk){ + // debug help + stringstream msg; + msg << "c_esmc_stringdiffmatch() string1: " << string1; + ESMC_LogDefault.Write(msg, ESMC_LOGMSG_DEBUG); + msg.str(""); // clear + msg << "c_esmc_stringdiffmatch() string2: " << string2; + ESMC_LogDefault.Write(msg, ESMC_LOGMSG_DEBUG); + msg.str(""); // clear + msg << "c_esmc_stringdiffmatch() minusString: " << minusString; + ESMC_LogDefault.Write(msg, ESMC_LOGMSG_DEBUG); + msg.str(""); // clear + msg << "c_esmc_stringdiffmatch() plusString: " << plusString; + ESMC_LogDefault.Write(msg, ESMC_LOGMSG_DEBUG); + } + } + if (!allDiffOk) break; + } + + *resultFlag = (allDiffOk) ? ESMF_TRUE : ESMF_FALSE; + +} // end c_ESMC_StringSerialize + } // extern "C" diff --git a/src/Infrastructure/Util/interface/ESMF_Util.F90 b/src/Infrastructure/Util/interface/ESMF_Util.F90 index 829924626a..4daeda1801 100644 --- a/src/Infrastructure/Util/interface/ESMF_Util.F90 +++ b/src/Infrastructure/Util/interface/ESMF_Util.F90 @@ -90,6 +90,7 @@ module ESMF_UtilMod public :: ESMF_UtilString2Real public :: ESMF_UtilString2Double public :: ESMF_UtilStringInt2String + public :: ESMF_UtilStringDiffMatch public :: ESMF_UtilStringLowerCase public :: ESMF_UtilStringUpperCase public :: ESMF_UtilArray2String @@ -996,6 +997,71 @@ end function ESMF_UtilString2Real !----------------------------------------------------------------------------- +!BOP +! !IROUTINE: ESMF_UtilStringDiffMatch - Match differences between two strings +! !INTERFACE: + function ESMF_UtilStringDiffMatch(string1, string2, minusStringList, & + plusStringList, keywordEnforcer, rc) +! !RETURN VALUE: + logical :: ESMF_UtilStringDiffMatch +! !ARGUMENTS: + character(len=*), intent(in) :: string1 + character(len=*), intent(in) :: string2 + character(len=*), intent(in) :: minusStringList(:) + character(len=*), intent(in) :: plusStringList(:) +type(ESMF_KeywordEnforcer), optional:: keywordEnforcer ! must use keywords below + integer, intent(out), optional :: rc +! !DESCRIPTION: +! Match the list of differences between {\tt string1} and {\tt string2} +! against {\tt plus} and {\tt minus} string pairs. +! The generated differences are based on Myers diff algorithm implementation +! provided by \url{https://github.com/gritzko/myers-diff}. +! +! The arguments are: +! \begin{description} +! \item[string1] +! First string in the difference. +! \item[string2] +! Second string in the difference. +! \item[minusStringList] +! List of strings that are allowed to show up as "minus" in the difference. +! \item[plusStringList] +! List of strings that are allowed to show up as "plus" in the difference. +! \item[{[rc]}] +! Return code; equals {\tt ESMF\_SUCCESS} if there are no errors. +! \end{description} +! +!EOP + !----------------------------------------------------------------------------- + ! local variables + integer :: localrc + integer :: matchCount + type(ESMF_Logical) :: tf + + if (present(rc)) rc = ESMF_SUCCESS + + ESMF_UtilStringDiffMatch = .false. ! default return value + + matchCount = size(minusStringList) + if (size(plusStringList) /= matchCount) then + call ESMF_LogSetError(ESMF_RC_ARG_BAD, & + msg="Number of strings in minus/plus string lists must match!`", & + line=__LINE__, & + file=ESMF_FILENAME, & + rcToReturn=rc) + return ! bail out + endif + + call c_ESMC_StringDiffMatch(string1, string2, minusStringList, & + plusStringList, matchCount, tf, localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, rcToReturn=rc)) return + ESMF_UtilStringDiffMatch = (tf == ESMF_TRUE) + + end function ESMF_UtilStringDiffMatch + !----------------------------------------------------------------------------- + + pure function int2str_len (i) ! Internal function for use by ESMF_UtilStringInt2String. From 1228ced72d5334f014896c0e37755e4ac29f72b8 Mon Sep 17 00:00:00 2001 From: Gerhard Theurich Date: Tue, 1 Oct 2024 16:04:17 -0700 Subject: [PATCH 055/207] Utilize ESMF_UtilStringDiffMatch() when comparing the JSON strings for cross PET StateReconcile() validation. Activate validation. --- .../src/ESMF_StateReconcile.F90 | 54 +++++++++++++++---- 1 file changed, 44 insertions(+), 10 deletions(-) diff --git a/src/Superstructure/StateReconcile/src/ESMF_StateReconcile.F90 b/src/Superstructure/StateReconcile/src/ESMF_StateReconcile.F90 index 8b67e368b9..9a54a81d32 100644 --- a/src/Superstructure/StateReconcile/src/ESMF_StateReconcile.F90 +++ b/src/Superstructure/StateReconcile/src/ESMF_StateReconcile.F90 @@ -49,6 +49,7 @@ module ESMF_StateReconcileMod use ESMF_BaseMod use ESMF_InitMacrosMod use ESMF_IOUtilMod + use ESMF_UtilMod use ESMF_LogErrMod use ESMF_StateMod use ESMF_StateContainerMod @@ -164,7 +165,8 @@ subroutine ESMF_StateReconcile(state, vm, rc) ! \item[state] ! {\tt ESMF\_State} to reconcile. ! \item[{[vm]}] -! {\tt ESMF\_VM} for this {\tt ESMF\_Component}. By default, it is set to the current vm. +! {\tt ESMF\_VM} across which to reconcile. The default is the +! current VM. ! \item[{[rc]}] ! Return code; equals {\tt ESMF\_SUCCESS} if there are no errors. ! \end{description} @@ -174,7 +176,7 @@ subroutine ESMF_StateReconcile(state, vm, rc) integer :: localrc type(ESMF_VM) :: localvm type(ESMF_AttReconcileFlag) :: lattreconflag - logical :: isNoop + logical :: isNoop, isFlag logical, parameter :: profile = .true. @@ -302,11 +304,11 @@ subroutine ESMF_StateReconcile(state, vm, rc) endif ! Traverse the State hierarchy and fix Field references to a shared geometry - call ESMF_InfoCacheReassembleFields(state, state, localrc) + call ESMF_InfoCacheReassembleFields(state, state, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, rcToReturn=rc)) return ! Traverse the state hierarchy and remove reconcile-specific attributes - call ESMF_InfoCacheReassembleFieldsFinalize(state, localrc) + call ESMF_InfoCacheReassembleFieldsFinalize(state, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, rcToReturn=rc)) return if (profile) then @@ -316,7 +318,7 @@ subroutine ESMF_StateReconcile(state, vm, rc) rcToReturn=rc)) return endif -#if 0 +#if 1 if (profile) then call ESMF_TraceRegionEnter("JSON cross PET check", rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & @@ -356,10 +358,41 @@ subroutine ESMF_StateReconcile(state, vm, rc) call ESMF_VMBroadcast(localvm, testStr, count=size(1), rootPet=0, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, rcToReturn=rc)) return if (testStr/=jsonStr) then - call ESMF_LogSetError(ESMF_RC_INTNRL_INCONS, & - msg="StateReconcile() failed!! Not all PETs hold same content!!", & - ESMF_CONTEXT, rcToReturn=rc) - return + ! not a perfect match -> see if the differences are acceptable + isFlag = ESMF_UtilStringDiffMatch(jsonStr, testStr, & + minusStringList = ["None ", & + "All ", & + "1 ", & + "2 ", & + " ", & + " ", & + "M ", & + "DEF ", & + "UL ", & + " ", & + "driverChild " & + ], & + plusStringList = ["All ", & + "None ", & + "2 ", & + "1 ", & + "DEF ", & + "UL ", & + " ", & + " ", & + " ", & + "M ", & + "DEFAULT" & + ], rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & + rcToReturn=rc)) return + if (.not.isFlag) then + ! found unexpected/unacceptable differences + call ESMF_LogSetError(ESMF_RC_INTNRL_INCONS, & + msg="StateReconcile() failed!! Not all PETs hold same content!!", & + ESMF_CONTEXT, rcToReturn=rc) + return + endif endif endif #endif @@ -599,6 +632,7 @@ recursive subroutine StateReconcileIsNoopLoc(stateR, isNoopLoc, rc) #if 0 block character(160) :: msgStr + call ESMF_VMIdLog(vmIdItem, prefix="vmIdItem: ", rc=localrc) write(msgStr,*) "isNoopLoc: ", isNoopLoc call ESMF_LogWrite(msgStr, ESMF_LOGMSG_DEBUG, rc=localrc) end block @@ -924,7 +958,7 @@ subroutine ESMF_StateReconcile_driver (state, vm, attreconflag, rc) call info_cache%Initialize(localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, rcToReturn=rc)) return - call info_cache%UpdateFields(state, vmIdMap, localrc) + call info_cache%UpdateFields(state, vmIdMap, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, rcToReturn=rc)) return call info_cache%Destroy(localrc) From 670c082dfd660128e828f2745d09185d726951fe Mon Sep 17 00:00:00 2001 From: Gerhard Theurich Date: Tue, 1 Oct 2024 16:42:39 -0700 Subject: [PATCH 056/207] Introduce 'checkflag' to ESMF_StateReconcile() API. When .true. carry out cross PET consistency check on the State before returning. --- .../src/ESMF_StateReconcile.F90 | 23 +++++++++++++++---- 1 file changed, 19 insertions(+), 4 deletions(-) diff --git a/src/Superstructure/StateReconcile/src/ESMF_StateReconcile.F90 b/src/Superstructure/StateReconcile/src/ESMF_StateReconcile.F90 index 9a54a81d32..67cd402143 100644 --- a/src/Superstructure/StateReconcile/src/ESMF_StateReconcile.F90 +++ b/src/Superstructure/StateReconcile/src/ESMF_StateReconcile.F90 @@ -140,11 +140,13 @@ module ESMF_StateReconcileMod ! !IROUTINE: ESMF_StateReconcile -- Reconcile State data across all PETs in a VM ! ! !INTERFACE: - subroutine ESMF_StateReconcile(state, vm, rc) + subroutine ESMF_StateReconcile(state, keywordEnforcer, vm, checkflag, rc) ! ! !ARGUMENTS: type(ESMF_State), intent(inout) :: state +type(ESMF_KeywordEnforcer), optional:: keywordEnforcer ! must use keywords below type(ESMF_VM), intent(in), optional :: vm + logical, intent(in), optional :: checkflag integer, intent(out), optional :: rc ! ! !DESCRIPTION: @@ -167,6 +169,11 @@ subroutine ESMF_StateReconcile(state, vm, rc) ! \item[{[vm]}] ! {\tt ESMF\_VM} across which to reconcile. The default is the ! current VM. +! \item [{[checkflag]}] +! If set to {\tt .TRUE.} the reconciled State object will be checked +! for consistency across PETs before returning. Any detected issues will +! be indicated in {\tt rc}. Set {\tt checkflag} to {\tt .FALSE.} in order +! to achieve highest performance. The default is {\tt .FALSE.}. ! \item[{[rc]}] ! Return code; equals {\tt ESMF\_SUCCESS} if there are no errors. ! \end{description} @@ -176,7 +183,7 @@ subroutine ESMF_StateReconcile(state, vm, rc) integer :: localrc type(ESMF_VM) :: localvm type(ESMF_AttReconcileFlag) :: lattreconflag - logical :: isNoop, isFlag + logical :: isNoop, isFlag, localCheckFlag logical, parameter :: profile = .true. @@ -188,6 +195,12 @@ subroutine ESMF_StateReconcile(state, vm, rc) if (present(rc)) rc = ESMF_RC_NOT_IMPL localrc = ESMF_RC_NOT_IMPL + localCheckFlag = .false. ! default + if (present(checkFlag)) localCheckFlag = checkFlag + +!TODO: turn this .true. when working on StateReoncile, so all tests validate! +!localCheckFlag = .true. ! force checking + if (present (vm)) then localvm = vm else @@ -318,7 +331,7 @@ subroutine ESMF_StateReconcile(state, vm, rc) rcToReturn=rc)) return endif -#if 1 + if (localCheckFlag) then if (profile) then call ESMF_TraceRegionEnter("JSON cross PET check", rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & @@ -359,6 +372,8 @@ subroutine ESMF_StateReconcile(state, vm, rc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, rcToReturn=rc)) return if (testStr/=jsonStr) then ! not a perfect match -> see if the differences are acceptable + ! these are differences in the values of attributes, which show up in + ! the bundled esmf and nuopc test cases... these diffs are begnin. isFlag = ESMF_UtilStringDiffMatch(jsonStr, testStr, & minusStringList = ["None ", & "All ", & @@ -403,7 +418,7 @@ subroutine ESMF_StateReconcile(state, vm, rc) ESMF_CONTEXT, & rcToReturn=rc)) return endif -#endif + endif if (present(rc)) rc = ESMF_SUCCESS From a122080211007c15c750b8aa3dfe8143173aeaab Mon Sep 17 00:00:00 2001 From: Gerhard Theurich Date: Tue, 1 Oct 2024 16:55:57 -0700 Subject: [PATCH 057/207] Push the 'attreconflag' down inside of ESMF_StateReconcile_driver(), where it is hardcoded to ESMF_ATTRECONCILE_ON for now. --- .../StateReconcile/src/ESMF_StateReconcile.F90 | 15 +++++++-------- 1 file changed, 7 insertions(+), 8 deletions(-) diff --git a/src/Superstructure/StateReconcile/src/ESMF_StateReconcile.F90 b/src/Superstructure/StateReconcile/src/ESMF_StateReconcile.F90 index 67cd402143..9fe0c99fdc 100644 --- a/src/Superstructure/StateReconcile/src/ESMF_StateReconcile.F90 +++ b/src/Superstructure/StateReconcile/src/ESMF_StateReconcile.F90 @@ -182,7 +182,6 @@ subroutine ESMF_StateReconcile(state, keywordEnforcer, vm, checkflag, rc) integer :: localrc type(ESMF_VM) :: localvm - type(ESMF_AttReconcileFlag) :: lattreconflag logical :: isNoop, isFlag, localCheckFlag logical, parameter :: profile = .true. @@ -286,9 +285,6 @@ subroutine ESMF_StateReconcile(state, keywordEnforcer, vm, checkflag, rc) ! (or short list of numbers) instead of having to build and send the ! list each time. - ! Attributes must be reconciled to de-deduplicate Field geometries - lattreconflag = ESMF_ATTRECONCILE_ON - if (profile) then call ESMF_TraceRegionEnter("ESMF_StateReconcile_driver", rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & @@ -296,8 +292,7 @@ subroutine ESMF_StateReconcile(state, keywordEnforcer, vm, checkflag, rc) rcToReturn=rc)) return endif - call ESMF_StateReconcile_driver (state, vm=localvm, & - attreconflag=lattreconflag, rc=localrc) + call ESMF_StateReconcile_driver(state, vm=localvm, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, & rcToReturn=rc)) return @@ -673,12 +668,11 @@ end subroutine ESMF_StateReconcileIsNoop ! !IROUTINE: ESMF_StateReconcile_driver ! ! !INTERFACE: - subroutine ESMF_StateReconcile_driver (state, vm, attreconflag, rc) + subroutine ESMF_StateReconcile_driver(state, vm, rc) ! ! !ARGUMENTS: type (ESMF_State), intent(inout) :: state type (ESMF_VM), intent(in) :: vm - type(ESMF_AttReconcileFlag), intent(in) :: attreconflag integer, intent(out) :: rc ! ! !DESCRIPTION: @@ -731,6 +725,8 @@ subroutine ESMF_StateReconcile_driver (state, vm, attreconflag, rc) integer :: singleCompCaseInt(1) integer :: singleCompIndex + type(ESMF_AttReconcileFlag) :: attreconflag + character(len=ESMF_MAXSTR) :: logmsg type(ESMF_InfoCache) :: info_cache @@ -739,6 +735,9 @@ subroutine ESMF_StateReconcile_driver (state, vm, attreconflag, rc) ! ------------------------------------------------------------------------- localrc = ESMF_RC_NOT_IMPL + ! Attributes must be reconciled to de-duplicate Field geometry proxies + attreconflag = ESMF_ATTRECONCILE_ON + if (meminfo) call ESMF_VMLogMemInfo ("entering ESMF_StateReconcile_driver") call ESMF_VMGet(vm, localPet=mypet, petCount=npets, rc=localrc) From ccbf5ee61bc05f0a180bbf5407f3c1fd6ab38abf Mon Sep 17 00:00:00 2001 From: Gerhard Theurich Date: Tue, 1 Oct 2024 21:56:57 -0700 Subject: [PATCH 058/207] Make sure to use argument keywords when calling ESMF_StateReconcile(). --- src/system_tests/ESMF_XGridConcurrent/coupler_comp.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/system_tests/ESMF_XGridConcurrent/coupler_comp.F90 b/src/system_tests/ESMF_XGridConcurrent/coupler_comp.F90 index 743428466a..70394643b3 100644 --- a/src/system_tests/ESMF_XGridConcurrent/coupler_comp.F90 +++ b/src/system_tests/ESMF_XGridConcurrent/coupler_comp.F90 @@ -116,9 +116,9 @@ subroutine user_init(comp, importState, exportState, clock, rc) print *, "User Coupler Init starting, localPet =", localPet ! Need to reconcile import and export states - call ESMF_StateReconcile(importState, vm, rc=rc) + call ESMF_StateReconcile(importState, vm=vm, rc=rc) if (rc/=ESMF_SUCCESS) return ! bail out - call ESMF_StateReconcile(exportState, vm, rc=rc) + call ESMF_StateReconcile(exportState, vm=vm, rc=rc) if (rc/=ESMF_SUCCESS) return ! bail out call ESMF_StatePrint(importState, nestedFlag=.true., rc=rc) From 9ac7034ec9b5e2ad93419bc5b7edad9cc6b25f99 Mon Sep 17 00:00:00 2001 From: Gerhard Theurich Date: Tue, 1 Oct 2024 21:59:15 -0700 Subject: [PATCH 059/207] Finish handling of FieldBundle and ArrayBundle in StateReconcileIsNoopLoc(). --- .../src/ESMF_StateReconcile.F90 | 67 +++++++++++++++++-- 1 file changed, 62 insertions(+), 5 deletions(-) diff --git a/src/Superstructure/StateReconcile/src/ESMF_StateReconcile.F90 b/src/Superstructure/StateReconcile/src/ESMF_StateReconcile.F90 index 9fe0c99fdc..ca8e292ac9 100644 --- a/src/Superstructure/StateReconcile/src/ESMF_StateReconcile.F90 +++ b/src/Superstructure/StateReconcile/src/ESMF_StateReconcile.F90 @@ -517,18 +517,21 @@ recursive subroutine StateReconcileIsNoopLoc(stateR, isNoopLoc, rc) integer, intent(out) :: rc ! - local variables integer :: localrc - integer :: itemCount, item + integer :: itemCount, item, fieldCount, arrayCount, i character(ESMF_MAXSTR), allocatable :: itemNameList(:) type(ESMF_StateItem_Flag), allocatable :: itemTypeList(:) type(ESMF_State) :: nestedState type(ESMF_Field) :: field + type(ESMF_Field), allocatable :: fieldList(:) type(ESMF_FieldBundle) :: fieldbundle type(ESMF_Array) :: array + type(ESMF_Array), allocatable :: arrayList(:) type(ESMF_ArrayBundle) :: arraybundle type(ESMF_RouteHandle) :: routehandle type(ESMF_VM) :: vmItem type(ESMF_VMId) :: vmIdItem type(ESMF_Pointer) :: thisItem + logical :: isFlag localrc = ESMF_RC_NOT_IMPL @@ -583,11 +586,39 @@ recursive subroutine StateReconcileIsNoopLoc(stateR, isNoopLoc, rc) if (ESMF_LogFoundError(localrc, & ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return + call ESMF_FieldBundleGet(fieldbundle, fieldCount=fieldCount, & + isPacked=isFlag, rc=localrc) + if (ESMF_LogFoundError(localrc, & + ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, rcToReturn=rc)) return + if (.not.isFlag) then + ! not a packed fieldbundle -> check each field item + allocate(fieldList(fieldCount)) + call ESMF_FieldBundleGet(fieldbundle, fieldList=fieldList, & + rc=localrc) + if (ESMF_LogFoundError(localrc, & + ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, rcToReturn=rc)) return + do i=1, fieldCount + call ESMF_FieldGet(fieldList(i), vm=vmItem, rc=localrc) + if (ESMF_LogFoundError(localrc, & + ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, rcToReturn=rc)) return + call ESMF_VMGetVMId(vmItem, vmId=vmIdItem, rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & + rcToReturn=rc)) return + isNoopLoc = ESMF_VMIdCompare(vmIdItem, vmId, keyOnly=.true., & + rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & + rcToReturn=rc)) return + if (.not.isNoopLoc) exit ! exit for .false. + enddo + deallocate(fieldList) + endif call ESMF_FieldBundleGet(fieldbundle, vm=vmItem, rc=localrc) if (ESMF_LogFoundError(localrc, & ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return -!TODO: need to loop over fields in FB else if (itemtypeList(item) == ESMF_STATEITEM_ARRAY) then call ESMF_StateGet(stateR, itemName=itemNameList(item), & array=array, rc=localrc) @@ -604,11 +635,36 @@ recursive subroutine StateReconcileIsNoopLoc(stateR, isNoopLoc, rc) if (ESMF_LogFoundError(localrc, & ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return + call ESMF_ArrayBundleGet(arraybundle, arrayCount=arrayCount, & + rc=localrc) + if (ESMF_LogFoundError(localrc, & + ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, rcToReturn=rc)) return + allocate(arrayList(arrayCount)) + call ESMF_ArrayBundleGet(arraybundle, arrayList=arrayList, & + rc=localrc) + if (ESMF_LogFoundError(localrc, & + ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, rcToReturn=rc)) return + do i=1, arrayCount + call ESMF_ArrayGet(arrayList(i), vm=vmItem, rc=localrc) + if (ESMF_LogFoundError(localrc, & + ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, rcToReturn=rc)) return + call ESMF_VMGetVMId(vmItem, vmId=vmIdItem, rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & + rcToReturn=rc)) return + isNoopLoc = ESMF_VMIdCompare(vmIdItem, vmId, keyOnly=.true., & + rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & + rcToReturn=rc)) return + if (.not.isNoopLoc) exit ! exit for .false. + enddo + deallocate(arrayList) call ESMF_ArrayBundleGet(arraybundle, vm=vmItem, rc=localrc) if (ESMF_LogFoundError(localrc, & ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return -!TODO: need to loop over arrays in AB else if (itemtypeList(item) == ESMF_STATEITEM_ROUTEHANDLE) then call ESMF_StateGet(stateR, itemName=itemNameList(item), & routehandle=routehandle, rc=localrc) @@ -629,7 +685,8 @@ recursive subroutine StateReconcileIsNoopLoc(stateR, isNoopLoc, rc) if (thisItem == ESMF_NULL_POINTER) isNoopLoc = .false. ! found proxy - if (.not.isNoopLoc) exit ! exit for .false. already recurse or proxy + ! exit for .false. already from proxy, recursive state, or bundles + if (.not.isNoopLoc) exit call ESMF_VMGetVMId(vmItem, vmId=vmIdItem, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & @@ -996,7 +1053,7 @@ subroutine ESMF_StateReconcile_driver(state, vm, rc) if (meminfo) call ESMF_VMLogMemInfo ("after (2) Update Field metadata") !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -!TODO: Remove this once done with performance testing! +!TODO: Remove this once done with testing! !singleCompCaseFlag = .false. !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! From c97acb73165eddd645af1e7c6cd4b000ad86bd3d Mon Sep 17 00:00:00 2001 From: Gerhard Theurich Date: Wed, 2 Oct 2024 07:50:31 +0000 Subject: [PATCH 060/207] Ensure Intel 2021 still compiles. --- .../StateReconcile/src/ESMF_StateReconcile.F90 | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/src/Superstructure/StateReconcile/src/ESMF_StateReconcile.F90 b/src/Superstructure/StateReconcile/src/ESMF_StateReconcile.F90 index ca8e292ac9..bc272e3ff6 100644 --- a/src/Superstructure/StateReconcile/src/ESMF_StateReconcile.F90 +++ b/src/Superstructure/StateReconcile/src/ESMF_StateReconcile.F90 @@ -776,6 +776,7 @@ subroutine ESMF_StateReconcile_driver(state, vm, rc) character(160) :: prefixStr type(ESMF_VMId), allocatable, target :: vmIdMap(:) + type(ESMF_VMId), pointer :: vmIdMap_ptr(:) type(ESMF_VMId), pointer :: vmIdSingleComp logical :: singleCompCaseFlag integer :: singleCompCaseFlagInt(1) @@ -903,6 +904,7 @@ subroutine ESMF_StateReconcile_driver(state, vm, rc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, & rcToReturn=rc)) return + vmIdMap_ptr => vmIdMap if (profile) then call ESMF_TraceRegionExit("ESMF_VMTranslateVMId", rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & @@ -989,7 +991,7 @@ subroutine ESMF_StateReconcile_driver(state, vm, rc) #if 0 ! Log a JSON State representation ----------------------------------------- call idesc%Initialize(createInfo=.true., addObjectInfo=.true., & - vmIdMap=vmIdMap, rc=localrc) + vmIdMap=vmIdMap_ptr, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, rcToReturn=rc)) return call idesc%Update(state, "", rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, rcToReturn=rc)) return @@ -1029,7 +1031,7 @@ subroutine ESMF_StateReconcile_driver(state, vm, rc) call info_cache%Initialize(localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, rcToReturn=rc)) return - call info_cache%UpdateFields(state, vmIdMap, rc=localrc) + call info_cache%UpdateFields(state, vmIdMap=vmIdMap_ptr, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, rcToReturn=rc)) return call info_cache%Destroy(localrc) From 3bec650c67b04d8e739a80bbb3bab560508f3b92 Mon Sep 17 00:00:00 2001 From: Robert Oehmke Date: Thu, 3 Oct 2024 11:27:44 -0600 Subject: [PATCH 061/207] Take extra commas out of test file. NAG doesn't seem to like them. --- .../IO/tests/ESMF_IO_FileTypeCheckUTest.F90 | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) diff --git a/src/Infrastructure/IO/tests/ESMF_IO_FileTypeCheckUTest.F90 b/src/Infrastructure/IO/tests/ESMF_IO_FileTypeCheckUTest.F90 index bd0f8e7c27..99d3b5e038 100644 --- a/src/Infrastructure/IO/tests/ESMF_IO_FileTypeCheckUTest.F90 +++ b/src/Infrastructure/IO/tests/ESMF_IO_FileTypeCheckUTest.F90 @@ -69,7 +69,7 @@ program ESMF_IO_FileTypeCheckUTest write(failMsg, *) "Returned wrong file type" call ESMF_Test(fileType == ESMF_FILEFORMAT_SCRIP, name, failMsg, result, ESMF_SRCLINE) #else - write(failMsg, *), "Comparison did not fail as expected" + write(failMsg, *) "Comparison did not fail as expected" call ESMF_Test(fileType /= ESMF_FILEFORMAT_SCRIP, name, failMsg, result, ESMF_SRCLINE) #endif !------------------------------------------------------------------------ @@ -91,7 +91,7 @@ program ESMF_IO_FileTypeCheckUTest write(failMsg, *) "Returned wrong file type" call ESMF_Test(fileType == ESMF_FILEFORMAT_UGRID, name, failMsg, result, ESMF_SRCLINE) #else - write(failMsg, *), "Comparison did not fail as expected" + write(failMsg, *) "Comparison did not fail as expected" call ESMF_Test(fileType /= ESMF_FILEFORMAT_UGRID, name, failMsg, result, ESMF_SRCLINE) #endif !------------------------------------------------------------------------ @@ -113,7 +113,7 @@ program ESMF_IO_FileTypeCheckUTest write(failMsg, *) "Returned wrong file type" call ESMF_Test(fileType == ESMF_FILEFORMAT_ESMFMESH, name, failMsg, result, ESMF_SRCLINE) #else - write(failMsg, *), "Comparison did not fail as expected" + write(failMsg, *) "Comparison did not fail as expected" call ESMF_Test(fileType /= ESMF_FILEFORMAT_ESMFMESH, name, failMsg, result, ESMF_SRCLINE) #endif !------------------------------------------------------------------------ @@ -135,7 +135,7 @@ program ESMF_IO_FileTypeCheckUTest write(failMsg, *) "Returned wrong file type" call ESMF_Test(fileType == ESMF_FILEFORMAT_GRIDSPEC, name, failMsg, result, ESMF_SRCLINE) #else - write(failMsg, *), "Comparison did not fail as expected" + write(failMsg, *) "Comparison did not fail as expected" call ESMF_Test(fileType /= ESMF_FILEFORMAT_GRIDSPEC, name, failMsg, result, ESMF_SRCLINE) #endif !------------------------------------------------------------------------ @@ -157,7 +157,7 @@ program ESMF_IO_FileTypeCheckUTest write(failMsg, *) "Returned wrong file type" call ESMF_Test(fileType == ESMF_FILEFORMAT_MOSAIC, name, failMsg, result, ESMF_SRCLINE) #else - write(failMsg, *), "Comparison did not fail as expected" + write(failMsg, *) "Comparison did not fail as expected" call ESMF_Test(fileType /= ESMF_FILEFORMAT_MOSAIC, name, failMsg, result, ESMF_SRCLINE) #endif !------------------------------------------------------------------------ @@ -179,7 +179,7 @@ program ESMF_IO_FileTypeCheckUTest write(failMsg, *) "Returned wrong file type" call ESMF_Test(fileType == ESMF_FILEFORMAT_TILE, name, failMsg, result, ESMF_SRCLINE) #else - write(failMsg, *), "Comparison did not fail as expected" + write(failMsg, *) "Comparison did not fail as expected" call ESMF_Test(fileType /= ESMF_FILEFORMAT_TILE, name, failMsg, result, ESMF_SRCLINE) #endif !------------------------------------------------------------------------ @@ -201,7 +201,7 @@ program ESMF_IO_FileTypeCheckUTest write(failMsg, *) "Returned wrong file type" call ESMF_Test(fileType == ESMF_FILEFORMAT_SCRIP, name, failMsg, result, ESMF_SRCLINE) #else - write(failMsg, *), "Comparison did not fail as expected" + write(failMsg, *) "Comparison did not fail as expected" call ESMF_Test(fileType /= ESMF_FILEFORMAT_SCRIP, name, failMsg, result, ESMF_SRCLINE) #endif !------------------------------------------------------------------------ From 8106297e4c740efae740372d5b02eabdd7a3f5c9 Mon Sep 17 00:00:00 2001 From: Robert Oehmke Date: Wed, 2 Oct 2024 13:55:29 -0600 Subject: [PATCH 062/207] Re-BOPI ESMF_FieldBundleGetIndex() to enable discussion of adding an ordering flag before making interface officially public. --- src/Infrastructure/FieldBundle/src/ESMF_FieldBundle.cppF90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/Infrastructure/FieldBundle/src/ESMF_FieldBundle.cppF90 b/src/Infrastructure/FieldBundle/src/ESMF_FieldBundle.cppF90 index e160fae06a..9e2a21aab0 100644 --- a/src/Infrastructure/FieldBundle/src/ESMF_FieldBundle.cppF90 +++ b/src/Infrastructure/FieldBundle/src/ESMF_FieldBundle.cppF90 @@ -2183,7 +2183,7 @@ msg="This call does not work with packed FieldBundle.",& !------------------------------------------------------------------------------ ^undef ESMF_METHOD ^define ESMF_METHOD "ESMF_FieldBundleGetIndex()" -!BOP +!BOPI ! !IROUTINE: ESMF_FieldBundleGet - Access the Field at a specific index in a FieldBundle ! ! !INTERFACE: @@ -2214,7 +2214,7 @@ type(ESMF_KeywordEnforcer), optional:: keywordEnforcer ! must use keywords below ! Return code; equals {\tt ESMF\_SUCCESS} if there are no errors. ! \end{description} ! -!EOP +!EOPI !------------------------------------------------------------------------------ integer :: localrc ! local return code integer :: l_fieldCount, i ! helper variable From a633d652f9c663693b2b179865363e1a575ec5e6 Mon Sep 17 00:00:00 2001 From: Robert Oehmke Date: Wed, 2 Oct 2024 14:26:29 -0600 Subject: [PATCH 063/207] Add 8.7 status information to ESMF_ClockCreateNew() and ESMF_ClockGet(). --- .../TimeMgr/interface/ESMF_Clock.F90 | 20 +++++++++++++++++-- 1 file changed, 18 insertions(+), 2 deletions(-) diff --git a/src/Infrastructure/TimeMgr/interface/ESMF_Clock.F90 b/src/Infrastructure/TimeMgr/interface/ESMF_Clock.F90 index fce650e6d4..18bceda375 100644 --- a/src/Infrastructure/TimeMgr/interface/ESMF_Clock.F90 +++ b/src/Infrastructure/TimeMgr/interface/ESMF_Clock.F90 @@ -447,6 +447,15 @@ function ESMF_ClockCreateNew(timeStep, startTime, keywordEnforcer, & ! !STATUS: ! \begin{itemize} ! \item\apiStatusCompatibleVersion{5.2.0r} +! \item\apiStatusModifiedSinceVersion{5.2.0r} +! \begin{description} +! \item[8.7.0] Added argument {\tt repeatDuration}. +! The new argument allows the user to specify that they want the +! clock to be a repeat clock and repeatedly go through the same +! interval of time. +! \end{description} +! \end{itemize} + ! \end{itemize} ! ! !DESCRIPTION: @@ -718,6 +727,11 @@ subroutine ESMF_ClockGet(clock, keywordEnforcer, & ! !STATUS: ! \begin{itemize} ! \item\apiStatusCompatibleVersion{5.2.0r} +! \begin{description} +! \item[8.7.0] Added arguments {\tt repeatDuration} and {\tt repeatCount}. +! The argument {\tt repeatDuration} allows the user to get information +! about how far the clock will advance before repeating. The argument +! {\tt repeatCount} tells how many times the clock has repeated. ! \end{itemize} ! ! !DESCRIPTION: @@ -773,9 +787,11 @@ subroutine ESMF_ClockGet(clock, keywordEnforcer, & ! {\tt ESMF\_ClockIsReverse()}, an alternative for convenient use in ! "if" and "do while" constructs. ! \item[{[repeatDuration]}] -! If not 0, then how long the clock should run before going back to startTime. +! If not 0, then tells how long the clock will advance before going back to +! startTime. If 0, then the clock is not a repeat clock. ! \item[{[repeatCount]}] -! The number of times this clock has gone back to startTime when repeating. +! If this clock is a repeat clock, then gives the number of times this +! clock has gone back to startTime. ! \item[{[name]}] ! The name of this clock. ! \item[{[rc]}] From 72873a9d8df55b507b00015ef72bb19a850047b5 Mon Sep 17 00:00:00 2001 From: Robert Oehmke Date: Wed, 2 Oct 2024 14:39:16 -0600 Subject: [PATCH 064/207] Specify more precisely which ISO version (8601) the TimeInterval set from string usees. --- .../TimeMgr/interface/ESMF_TimeInterval.F90 | 24 +++++++++---------- 1 file changed, 12 insertions(+), 12 deletions(-) diff --git a/src/Infrastructure/TimeMgr/interface/ESMF_TimeInterval.F90 b/src/Infrastructure/TimeMgr/interface/ESMF_TimeInterval.F90 index d96f160f26..a64cdc17b6 100644 --- a/src/Infrastructure/TimeMgr/interface/ESMF_TimeInterval.F90 +++ b/src/Infrastructure/TimeMgr/interface/ESMF_TimeInterval.F90 @@ -3135,7 +3135,7 @@ end subroutine ESMF_ParseDurString #undef ESMF_METHOD #define ESMF_METHOD "ESMF_TimeIntervalSetStr()" !BOP -! !IROUTINE: ESMF_TimeIntervalSet - Initialize or set a TimeInterval from an ISO format string +! !IROUTINE: ESMF_TimeIntervalSet - Initialize or set a TimeInterval from an ISO 8601 format string ! \label{API:TimeIntervalSetStr} ! !INTERFACE: @@ -3152,7 +3152,7 @@ subroutine ESMF_TimeIntervalSetStr(timeinterval, timeIntervalString, rc) ! ! !DESCRIPTION: ! Sets the value of the {\tt ESMF\_TimeInterval} using a user specified -! string in ISO duration format P[y]Y[mm]M[d]DT[h]H[m]M[s]S. See ~\cite{ISO} and ~\cite{ISOnotes} for information about the format. In ESMF's implementation the time values can have the following types: +! string in ISO 8601 duration format P[y]Y[mm]M[d]DT[h]H[m]M[s]S. See ~\cite{ISO} and ~\cite{ISOnotes} for information about the format. In ESMF's implementation the time values can have the following types: ! \begin{description} ! \item[y] - the number of years expressed in up to a 64-bit integer ! \item[mm] - the number of months expressed in up to a 64-bit integer @@ -3170,7 +3170,7 @@ subroutine ESMF_TimeIntervalSetStr(timeinterval, timeIntervalString, rc) ! \item[timeinterval] ! The object instance to initialize. ! \item[timeIntervalString] -! ISO format duration string (e.g. P[y]Y[mm]M[d]DT[h]H[m]M[s]S). +! ISO 8601 format duration string (e.g. P[y]Y[mm]M[d]DT[h]H[m]M[s]S). ! \item[{[rc]}] ! Return code; equals {\tt ESMF\_SUCCESS} if there are no errors. ! \end{description} @@ -3229,7 +3229,7 @@ end subroutine ESMF_TimeIntervalSetStr #undef ESMF_METHOD #define ESMF_METHOD "ESMF_TimeIntervalSetStrCal()" !BOP -! !IROUTINE: ESMF_TimeIntervalSet - Initialize or set a TimeInterval from an ISO format string and calendar +! !IROUTINE: ESMF_TimeIntervalSet - Initialize or set a TimeInterval from an ISO 8601 format string and calendar ! !INTERFACE: ! Private name; call using ESMF_TimeIntervalSet() @@ -3246,7 +3246,7 @@ subroutine ESMF_TimeIntervalSetStrCal(timeinterval, calendar, & ! ! !DESCRIPTION: ! Sets the value of the {\tt ESMF\_TimeInterval} using a user specified -! string in ISO duration format P[y]Y[mm]M[d]DT[h]H[m]M[s]S. See ~\cite{ISO} and ~\cite{ISOnotes} for +! string in ISO 8601 duration format P[y]Y[mm]M[d]DT[h]H[m]M[s]S. See ~\cite{ISO} and ~\cite{ISOnotes} for ! information about the format. Also, see the description for the method ! {\tt ESMF\_TimeIntervalSetStr()}~\ref{API:TimeIntervalSetStr} ! for the specific types supported by ESMF for the values in the duration string. @@ -3265,7 +3265,7 @@ subroutine ESMF_TimeIntervalSetStrCal(timeinterval, calendar, & ! it contains a calendar. Alternate to, and mutually exclusive with, ! calkindflag below. Primarily for specifying a custom calendar kind. ! \item[timeIntervalString] -! ISO format duration string (e.g. P[y]Y[mm]M[d]DT[h]H[m]M[s]S). +! ISO 8601 format duration string (e.g. P[y]Y[mm]M[d]DT[h]H[m]M[s]S). ! \item[{[rc]}] ! Return code; equals {\tt ESMF\_SUCCESS} if there are no errors. ! \end{description} @@ -3325,7 +3325,7 @@ end subroutine ESMF_TimeIntervalSetStrCal #undef ESMF_METHOD #define ESMF_METHOD "ESMF_TimeIntervalSetStrCalTyp()" !BOP -! !IROUTINE: ESMF_TimeIntervalSet - Initialize or set a TimeInterval from an ISO format string and calendar kind +! !IROUTINE: ESMF_TimeIntervalSet - Initialize or set a TimeInterval from an ISO 8601 format string and calendar kind ! !INTERFACE: ! Private name; call using ESMF_TimeIntervalSet() @@ -3342,7 +3342,7 @@ subroutine ESMF_TimeIntervalSetStrCalTyp(timeinterval, calkindflag, & ! ! !DESCRIPTION: ! Sets the value of the {\tt ESMF\_TimeInterval} using a user specified -! string in ISO duration format P[y]Y[mm]M[d]DT[h]H[m]M[s]S. See ~\cite{ISO} and ~\cite{ISOnotes} for +! string in ISO 8601 duration format P[y]Y[mm]M[d]DT[h]H[m]M[s]S. See ~\cite{ISO} and ~\cite{ISOnotes} for ! information about the format. Also, see the description for the method ! {\tt ESMF\_TimeIntervalSetStr()}~\ref{API:TimeIntervalSetStr} ! for the specific types supported by ESMF for the values in the duration string. @@ -3356,7 +3356,7 @@ subroutine ESMF_TimeIntervalSetStrCalTyp(timeinterval, calkindflag, & ! calendar above. More convenient way of specifying a built-in ! calendar kind. ! \item[timeIntervalString] -! ISO format duration string (e.g. P[y]Y[mm]M[d]DT[h]H[m]M[s]S). +! ISO 8601 format duration string (e.g. P[y]Y[mm]M[d]DT[h]H[m]M[s]S). ! \item[{[rc]}] ! Return code; equals {\tt ESMF\_SUCCESS} if there are no errors. ! \end{description} @@ -3414,7 +3414,7 @@ end subroutine ESMF_TimeIntervalSetStrCalTyp #undef ESMF_METHOD #define ESMF_METHOD "ESMF_TimeIntervalSetStrStart()" !BOP -! !IROUTINE: ESMF_TimeIntervalSet - Initialize or set a TimeInterval from an ISO format string and start time +! !IROUTINE: ESMF_TimeIntervalSet - Initialize or set a TimeInterval from an ISO 8601 format string and start time ! !INTERFACE: ! Private name; call using ESMF_TimeIntervalSet() @@ -3431,7 +3431,7 @@ subroutine ESMF_TimeIntervalSetStrStart(timeinterval, startTime, & ! ! !DESCRIPTION: ! Sets the value of the {\tt ESMF\_TimeInterval} using a user specified -! string in ISO duration format P[y]Y[mm]M[d]DT[h]H[m]M[s]S. See ~\cite{ISO} and ~\cite{ISOnotes} for +! string in ISO 8601 duration format P[y]Y[mm]M[d]DT[h]H[m]M[s]S. See ~\cite{ISO} and ~\cite{ISOnotes} for ! information about the format. Also, see the description for the method ! {\tt ESMF\_TimeIntervalSetStr()}~\ref{API:TimeIntervalSetStr} ! for the specific types supported by ESMF for the values in the duration string. @@ -3446,7 +3446,7 @@ subroutine ESMF_TimeIntervalSetStrStart(timeinterval, startTime, & ! in time. If not set, and calendar also not set, calendar interval ! "floats" across all calendars and times. ! \item[timeIntervalString] -! ISO format duration string (e.g. P[y]Y[mm]M[d]DT[h]H[m]M[s]S). +! ISO 8601 format duration string (e.g. P[y]Y[mm]M[d]DT[h]H[m]M[s]S). ! \item[{[rc]}] ! Return code; equals {\tt ESMF\_SUCCESS} if there are no errors. ! \end{description} From f62f84cf0c5f6dbd56d4f9721e8d8996a20cc0cd Mon Sep 17 00:00:00 2001 From: Robert Oehmke Date: Wed, 2 Oct 2024 17:08:12 -0600 Subject: [PATCH 065/207] Fix small problem with 8.7 doc changes. --- src/Infrastructure/TimeMgr/interface/ESMF_Clock.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/Infrastructure/TimeMgr/interface/ESMF_Clock.F90 b/src/Infrastructure/TimeMgr/interface/ESMF_Clock.F90 index 18bceda375..322628fe41 100644 --- a/src/Infrastructure/TimeMgr/interface/ESMF_Clock.F90 +++ b/src/Infrastructure/TimeMgr/interface/ESMF_Clock.F90 @@ -454,8 +454,6 @@ function ESMF_ClockCreateNew(timeStep, startTime, keywordEnforcer, & ! clock to be a repeat clock and repeatedly go through the same ! interval of time. ! \end{description} -! \end{itemize} - ! \end{itemize} ! ! !DESCRIPTION: @@ -727,11 +725,13 @@ subroutine ESMF_ClockGet(clock, keywordEnforcer, & ! !STATUS: ! \begin{itemize} ! \item\apiStatusCompatibleVersion{5.2.0r} +! \item\apiStatusModifiedSinceVersion{5.2.0r} ! \begin{description} ! \item[8.7.0] Added arguments {\tt repeatDuration} and {\tt repeatCount}. ! The argument {\tt repeatDuration} allows the user to get information ! about how far the clock will advance before repeating. The argument ! {\tt repeatCount} tells how many times the clock has repeated. +! \end{description} ! \end{itemize} ! ! !DESCRIPTION: From 0d4b825343fbf6ac4c993f6a87c8d19f608ed593 Mon Sep 17 00:00:00 2001 From: Robert Oehmke Date: Wed, 2 Oct 2024 17:35:41 -0600 Subject: [PATCH 066/207] Fix some odd wording. --- .../TimeMgr/interface/ESMF_TimeInterval.F90 | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/src/Infrastructure/TimeMgr/interface/ESMF_TimeInterval.F90 b/src/Infrastructure/TimeMgr/interface/ESMF_TimeInterval.F90 index a64cdc17b6..646aabc445 100644 --- a/src/Infrastructure/TimeMgr/interface/ESMF_TimeInterval.F90 +++ b/src/Infrastructure/TimeMgr/interface/ESMF_TimeInterval.F90 @@ -3151,7 +3151,7 @@ subroutine ESMF_TimeIntervalSetStr(timeinterval, timeIntervalString, rc) ! ! ! !DESCRIPTION: -! Sets the value of the {\tt ESMF\_TimeInterval} using a user specified +! Sets the value of an {\tt ESMF\_TimeInterval} using a ! string in ISO 8601 duration format P[y]Y[mm]M[d]DT[h]H[m]M[s]S. See ~\cite{ISO} and ~\cite{ISOnotes} for information about the format. In ESMF's implementation the time values can have the following types: ! \begin{description} ! \item[y] - the number of years expressed in up to a 64-bit integer @@ -3245,7 +3245,7 @@ subroutine ESMF_TimeIntervalSetStrCal(timeinterval, calendar, & ! ! ! !DESCRIPTION: -! Sets the value of the {\tt ESMF\_TimeInterval} using a user specified +! Sets the value of an {\tt ESMF\_TimeInterval} using a ! string in ISO 8601 duration format P[y]Y[mm]M[d]DT[h]H[m]M[s]S. See ~\cite{ISO} and ~\cite{ISOnotes} for ! information about the format. Also, see the description for the method ! {\tt ESMF\_TimeIntervalSetStr()}~\ref{API:TimeIntervalSetStr} @@ -3341,7 +3341,7 @@ subroutine ESMF_TimeIntervalSetStrCalTyp(timeinterval, calkindflag, & ! ! ! !DESCRIPTION: -! Sets the value of the {\tt ESMF\_TimeInterval} using a user specified +! Sets the value of an {\tt ESMF\_TimeInterval} using a ! string in ISO 8601 duration format P[y]Y[mm]M[d]DT[h]H[m]M[s]S. See ~\cite{ISO} and ~\cite{ISOnotes} for ! information about the format. Also, see the description for the method ! {\tt ESMF\_TimeIntervalSetStr()}~\ref{API:TimeIntervalSetStr} @@ -3430,7 +3430,7 @@ subroutine ESMF_TimeIntervalSetStrStart(timeinterval, startTime, & ! ! ! !DESCRIPTION: -! Sets the value of the {\tt ESMF\_TimeInterval} using a user specified +! Sets the value of an {\tt ESMF\_TimeInterval} using a ! string in ISO 8601 duration format P[y]Y[mm]M[d]DT[h]H[m]M[s]S. See ~\cite{ISO} and ~\cite{ISOnotes} for ! information about the format. Also, see the description for the method ! {\tt ESMF\_TimeIntervalSetStr()}~\ref{API:TimeIntervalSetStr} From da1170ab317cf23ff9e41ada98853bf3bf9c31c6 Mon Sep 17 00:00:00 2001 From: Robert Oehmke Date: Fri, 11 Oct 2024 15:38:50 -0600 Subject: [PATCH 067/207] Add == and \= for Geom. --- src/Infrastructure/Geom/src/ESMF_Geom.F90 | 196 ++++++++++++++++++++++ 1 file changed, 196 insertions(+) diff --git a/src/Infrastructure/Geom/src/ESMF_Geom.F90 b/src/Infrastructure/Geom/src/ESMF_Geom.F90 index 72f749d77c..ec92aa8318 100644 --- a/src/Infrastructure/Geom/src/ESMF_Geom.F90 +++ b/src/Infrastructure/Geom/src/ESMF_Geom.F90 @@ -225,11 +225,207 @@ module ESMF_GeomMod !============================================================================== + +! -------------------------- ESMF-public method ------------------------------- +!BOP +! !IROUTINE: ESMF_GeomAssignment(=) - Geom assignment +! +! !INTERFACE: +! interface assignment(=) +! geom1 = geom2 +! +! !ARGUMENTS: +! type(ESMF_Geom) :: geom1 +! type(ESMF_Geom) :: geom2 +! +! !DESCRIPTION: +! Assign geom1 as an alias to the same ESMF Geom object in memory +! as geom2. If geom2 is invalid, then geom1 will be equally invalid after +! the assignment. +! +! The arguments are: +! \begin{description} +! \item[geom1] +! The {\tt ESMF\_Geom} object on the left hand side of the assignment. +! \item[geom2] +! The {\tt ESMF\_Geom} object on the right hand side of the assignment. +! \end{description} +! +!EOP +!------------------------------------------------------------------------------ + +! -------------------------- ESMF-public method ------------------------------- +!BOP +! !IROUTINE: ESMF_GeomOperator(==) - Geom equality operator +! +! !INTERFACE: + interface operator(==) +! if (geom1 == geom2) then ... endif +! OR +! result = (geom1 == geom2) +! !RETURN VALUE: +! logical :: result +! +! !ARGUMENTS: +! type(ESMF_Geom), intent(in) :: geom1 +! type(ESMF_Geom), intent(in) :: geom2 +!! +! !DESCRIPTION: +! Test whether geom1 and geom2 are valid aliases to the same ESMF +! Geom object in memory. For a more general comparison of two ESMF Geoms, +! going beyond the simple alias test, the ESMF\_GeomMatch() function +! must be used. +! +! The arguments are: +! \begin{description} +! \item[geom1] +! The {\tt ESMF\_Geom} object on the left hand side of the equality +! operation. +! \item[geom2] +! The {\tt ESMF\_Geom} object on the right hand side of the equality +! operation. +! \end{description} +! +!EOP + module procedure ESMF_GeomEQ + + end interface +!------------------------------------------------------------------------------ + + +! -------------------------- ESMF-public method ------------------------------- +!BOP +! !IROUTINE: ESMF_GeomOperator(/=) - Geom not equal operator +! +! !INTERFACE: + interface operator(/=) +! if (geom1 /= geom2) then ... endif +! OR +! result = (geom1 /= geom2) +! !RETURN VALUE: +! logical :: result +! +! !ARGUMENTS: +! type(ESMF_Geom), intent(in) :: geom1 +! type(ESMF_Geom), intent(in) :: geom2 +! +! !DESCRIPTION: +! Test whether geom1 and geom2 are {\it not} valid aliases to the +! same ESMF Geom object in memory. For a more general comparison of two ESMF +! Geoms, going beyond the simple alias test, the ESMF\_GeomMatch() function +! (not yet fully implemented) must be used. +! +! The arguments are: +! \begin{description} +! \item[geom1] +! The {\tt ESMF\_Geom} object on the left hand side of the non-equality +! operation. +! \item[geom2] +! The {\tt ESMF\_Geom} object on the right hand side of the non-equality +! operation. +! \end{description} +! +!EOP + module procedure ESMF_GeomNE + + end interface +!------------------------------------------------------------------------------ + contains !============================================================================== +!------------------------------------------------------------------------------- +#undef ESMF_METHOD +#define ESMF_METHOD "ESMF_GeomEQ()" +!BOPI +! !IROUTINE: ESMF_GeomEQ - Compare two Geoms for equality +! +! !INTERFACE: + impure elemental function ESMF_GeomEQ(geom1, geom2) +! +! !RETURN VALUE: + logical :: ESMF_GeomEQ + +! !ARGUMENTS: + type(ESMF_Geom), intent(in) :: geom1 + type(ESMF_Geom), intent(in) :: geom2 + +! !DESCRIPTION: +! Test if both {\tt geom1} and {\tt geom2} alias the same ESMF Geom +! object. +! +!EOPI +!------------------------------------------------------------------------------- + + ESMF_INIT_TYPE ginit1, ginit2 + integer :: localrc1, localrc2 + logical :: lval1, lval2 + + ! Use the following logic, rather than "ESMF-INIT-CHECK-DEEP", to gain + ! init checks on both args, and in the case where both are uninitialized, + ! to distinguish equality based on uninitialized type (uncreated, + ! deleted). + + ! TODO: Consider moving this logic to C++: use Base class? status? + ! Or replicate logic for C interface also. + + ! check inputs + ginit1 = ESMF_GeomGetInit(geom1) + ginit2 = ESMF_GeomGetInit(geom2) + + ! TODO: this line must remain split in two for SunOS f90 8.3 127000-03 + if (ginit1 == ESMF_INIT_CREATED .and. & + ginit2 == ESMF_INIT_CREATED) then + ESMF_GeomEQ = associated(geom1%gbcp, geom2%gbcp) + else + ESMF_GeomEQ = .false. + endif + + end function ESMF_GeomEQ +!------------------------------------------------------------------------------- + + +!------------------------------------------------------------------------------- +#undef ESMF_METHOD +#define ESMF_METHOD "ESMF_GeomNE()" +!BOPI +! !IROUTINE: ESMF_GeomNE - Compare two Geoms for non-equality +! +! !INTERFACE: + impure elemental function ESMF_GeomNE(geom1, geom2) +! +! !RETURN VALUE: + logical :: ESMF_GeomNE + +! !ARGUMENTS: + type(ESMF_Geom), intent(in) :: geom1 + type(ESMF_Geom), intent(in) :: geom2 + +! !DESCRIPTION: +! Test if both {\tt geom1} and {\tt geom2} alias the same ESMF Geom +! object. +! +!EOPI +!------------------------------------------------------------------------------- + + ESMF_INIT_TYPE ginit1, ginit2 + integer :: localrc1, localrc2 + logical :: lval1, lval2 + + ! Use the following logic, rather than "ESMF-INIT-CHECK-DEEP", to gain + ! init checks on both args, and in the case where both are uninitialized, + ! to distinguish equality based on uninitialized type (uncreated, + ! deleted). + + ESMF_GeomNE = .not.ESMF_GeomEQ(geom1, geom2) + + end function ESMF_GeomNE +!------------------------------------------------------------------------------- + + + !------------------------------------------------------------------------------ #undef ESMF_METHOD #define ESMF_METHOD "ESMF_GeomGetArrayInfo" From 867c30314c126e07026f0483556879edd8f233ff Mon Sep 17 00:00:00 2001 From: Robert Oehmke Date: Tue, 15 Oct 2024 11:19:20 -0600 Subject: [PATCH 068/207] Add ESMF_GeomMatch() functionality and testing for Geom comparison operations and match. --- src/Infrastructure/Geom/makefile | 2 +- src/Infrastructure/Geom/src/ESMF_Geom.F90 | 252 +++++++++++++++++- .../Geom/tests/ESMF_GeomUTest.F90 | 242 +++++++++++++++++ src/Infrastructure/Geom/tests/makefile | 35 +++ 4 files changed, 529 insertions(+), 2 deletions(-) create mode 100644 src/Infrastructure/Geom/tests/ESMF_GeomUTest.F90 create mode 100644 src/Infrastructure/Geom/tests/makefile diff --git a/src/Infrastructure/Geom/makefile b/src/Infrastructure/Geom/makefile index 5b3e5dd85d..66793a77da 100644 --- a/src/Infrastructure/Geom/makefile +++ b/src/Infrastructure/Geom/makefile @@ -12,7 +12,7 @@ include ${ESMF_DIR}/makefile # The DIRS line needs to contain all subdirectories which exist # directly below this directory, and have either library, # example/test code, or documents which need to be generated. -DIRS = doc src interface +DIRS = doc src interface tests CLEANDIRS = CLEANFILES = diff --git a/src/Infrastructure/Geom/src/ESMF_Geom.F90 b/src/Infrastructure/Geom/src/ESMF_Geom.F90 index ec92aa8318..353a95b840 100644 --- a/src/Infrastructure/Geom/src/ESMF_Geom.F90 +++ b/src/Infrastructure/Geom/src/ESMF_Geom.F90 @@ -114,6 +114,25 @@ module ESMF_GeomMod ESMF_INIT_DECLARE end type + +!------------------------------------------------------------------------------ +! ! ESMF_GeomMatch_Flag +! +!------------------------------------------------------------------------------ + type ESMF_GeomMatch_Flag +#ifndef ESMF_NO_SEQUENCE + sequence +#endif +! private + integer :: geommatch + end type + + type(ESMF_GeomMatch_Flag), parameter :: & + ESMF_GEOMMATCH_INVALID=ESMF_GeomMatch_Flag(0), & + ESMF_GEOMMATCH_NONE=ESMF_GeomMatch_Flag(1), & + ESMF_GEOMMATCH_ALIAS=ESMF_GeomMatch_Flag(2), & + ESMF_GEOMMATCH_GEOMALIAS=ESMF_GeomMatch_Flag(3) + !------------------------------------------------------------------------------ ! ! !PUBLIC TYPES: @@ -124,6 +143,11 @@ module ESMF_GeomMod ESMF_GEOMTYPE_GRID, ESMF_GEOMTYPE_MESH, & ESMF_GEOMTYPE_LOCSTREAM, ESMF_GEOMTYPE_XGRID +public ESMF_GeomMatch_Flag, ESMF_GEOMMATCH_INVALID, & + ESMF_GEOMMATCH_NONE, ESMF_GEOMMATCH_ALIAS, & + ESMF_GEOMMATCH_GEOMALIAS + + !------------------------------------------------------------------------------ ! ! !PUBLIC MEMBER FUNCTIONS: @@ -139,7 +163,8 @@ module ESMF_GeomMod public ESMF_GeomGet public ESMF_GeomGetPlocalDE - + public ESMF_GeomMatch + public ESMF_GeomSerialize public ESMF_GeomDeserialize @@ -147,6 +172,7 @@ module ESMF_GeomMod public ESMF_GeomGetArrayInfo + ! public ESMF_GeomGetMesh @@ -189,6 +215,39 @@ module ESMF_GeomMod end interface +!------------------------------------------------------------------------------ +!BOPI +! !INTERFACE: + interface operator (==) + +! !PRIVATE MEMBER FUNCTIONS: + module procedure ESMF_GeomMatchEqual + +! !DESCRIPTION: +! This interface overloads the equality operator for the specific +! ESMF GeomMatch. 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_GeomMatchNotEqual + +! !DESCRIPTION: +! This interface overloads the inequality operator for the specific +! ESMF GeomMatch. It is provided for easy comparisons of +! these types with defined values. +! +!EOPI + end interface + + !============================================================================== !BOPI @@ -1824,6 +1883,128 @@ function ESMF_GeomDeserialize(buffer, offset, attreconflag, skipGeomObj, & end function ESMF_GeomDeserialize +! -------------------------- ESMF-public method ------------------------------- +#undef ESMF_METHOD +#define ESMF_METHOD "ESMF_GeomMatch()" +!BOP +! !IROUTINE: ESMF_GeomMatch - Check if two Geom objects match + +! !INTERFACE: + function ESMF_GeomMatch(geom1, geom2, keywordEnforcer, rc) +! +! !RETURN VALUE: + type(ESMF_GeomMatch_Flag) :: ESMF_GeomMatch + +! !ARGUMENTS: + type(ESMF_Geom), intent(in) :: geom1 + type(ESMF_Geom), intent(in) :: geom2 +type(ESMF_KeywordEnforcer), optional:: keywordEnforcer ! must use keywords below + integer, intent(out), optional :: rc +! +! +! !DESCRIPTION: +! Check if {\tt geom1} and {\tt geom2} match. Returns a range of values of type +! ESMF\_GeomMatch indicating how closely the Geoms match. For a description of +! the possible return values, please see~\ref{const:geommatch}. +! Please also note that by default this call is not collective and only +! returns the match for the piece of the Geoms on the local PET. In this case, +! it is possible for this call to return a different match on different PETs +! for the same Geoms. +! +! The arguments are: +! \begin{description} +! \item[geom1] +! {\tt ESMF\_Geom} object. +! \item[geom2] +! {\tt ESMF\_Geom} object. +! \item[{[rc]}] +! Return code; equals {\tt ESMF\_SUCCESS} if there are no errors. +! \end{description} +! +!EOP +!------------------------------------------------------------------------------ + integer :: localrc ! local return code + integer :: matchResult + integer(ESMF_KIND_I4) :: localResult(1), globalResult(1) + logical :: l_global + integer :: npet + type(ESMF_VM) :: vm + type(ESMF_GeomType_Flag) :: type + + ! 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_GeomMatch = ESMF_GEOMMATCH_INVALID + + ! Check init status of arguments + ESMF_INIT_CHECK_DEEP(ESMF_GeomGetInit, geom1, rc) + ESMF_INIT_CHECK_DEEP(ESMF_GeomGetInit, geom2, rc) + + ! Check for Alias + if (geom1 == geom2) then + ESMF_GeomMatch=ESMF_GEOMMATCH_ALIAS + endif + + ! If not alias, check for geom alias + if (ESMF_GeomMatch == ESMF_GEOMMATCH_INVALID) then + + ! If types not equal, not geom alias + type = geom1%gbcp%type + if (type == geom2%gbcp%type) then + + if (type == ESMF_GEOMTYPE_GRID) then + if (geom1%gbcp%grid == geom2%gbcp%grid) ESMF_GeomMatch=ESMF_GEOMMATCH_GEOMALIAS + else if (type == ESMF_GEOMTYPE_MESH) then + if (geom1%gbcp%mesh == geom2%gbcp%mesh) ESMF_GeomMatch=ESMF_GEOMMATCH_GEOMALIAS + else if (type == ESMF_GEOMTYPE_LOCSTREAM) then + if (geom1%gbcp%locstream == geom2%gbcp%locstream) ESMF_GeomMatch=ESMF_GEOMMATCH_GEOMALIAS + else if (type == ESMF_GEOMTYPE_XGRID) then + if (geom1%gbcp%xgrid == geom2%gbcp%xgrid) ESMF_GeomMatch=ESMF_GEOMMATCH_GEOMALIAS + endif + endif + endif + + ! If we're still invalid, then nothing has matched, so set to none + if (ESMF_GeomMatch == ESMF_GEOMMATCH_INVALID) ESMF_GeomMatch=ESMF_GEOMMATCH_NONE + + ! Take this out for now, because it's not clear how the handle different kinds + ! of matching. +#if 0 + ! Check global result + l_global = .false. + if(present(globalflag)) l_global = globalflag + + if(l_global) then + call ESMF_VMGetCurrent(vm, rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, rcToReturn=rc)) return + call ESMF_VMGet(vm, petCount=npet, rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, rcToReturn=rc)) return + + localResult(1) = matchResult + globalResult(1) = 0 + call ESMF_VMAllReduce(vm, localResult, globalResult, & + 1, ESMF_REDUCE_SUM, rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, rcToReturn=rc)) return + + if(globalResult(1) == npet) then + ESMF_GridMatch = ESMF_GRIDMATCH_EXACT + else + ESMF_GridMatch = ESMF_GRIDMATCH_NONE + endif + endif +#endif + + ! return successfully + if (present(rc)) rc = ESMF_SUCCESS + + end function ESMF_GeomMatch +!------------------------------------------------------------------------------ + ! -------------------------- ESMF-public method ------------------------------- @@ -1941,7 +2122,76 @@ end function ESMF_GeomGetInit !------------------------------------------------------------------------------ +!------------------------------------------------------------------------------ +#undef ESMF_METHOD +#define ESMF_METHOD "ESMF_GeomMatchEqual" +!BOPI +! !IROUTINE: ESMF_GeomMatchEqual - Equality of GeomMatch statuses +! +! !INTERFACE: + impure elemental function ESMF_GeomMatchEqual(GeomMatch1, GeomMatch2) + +! !RETURN VALUE: + logical :: ESMF_GeomMatchEqual + +! !ARGUMENTS: + + type (ESMF_GeomMatch_Flag), intent(in) :: & + GeomMatch1, &! Two igeom statuses to compare for + GeomMatch2 ! equality + +! !DESCRIPTION: +! This routine compares two ESMF GeomMatch statuses to see if +! they are equivalent. +! +! The arguments are: +! \begin{description} +! \item[GeomMatch1, GeomMatch2] +! Two igeom statuses to compare for equality +! \end{description} +! +!EOPI + + ESMF_GeomMatchEqual = (GeomMatch1%geommatch == & + GeomMatch2%geommatch) + + end function ESMF_GeomMatchEqual +!------------------------------------------------------------------------------ +#undef ESMF_METHOD +#define ESMF_METHOD "ESMF_GeomMatchNotEqual" +!BOPI +! !IROUTINE: ESMF_GeomMatchNotEqual - Non-equality of GeomMatch statuses +! +! !INTERFACE: + impure elemental function ESMF_GeomMatchNotEqual(GeomMatch1, GeomMatch2) + +! !RETURN VALUE: + logical :: ESMF_GeomMatchNotEqual + +! !ARGUMENTS: + + type (ESMF_GeomMatch_Flag), intent(in) :: & + GeomMatch1, &! Two GeomMatch Statuses to compare for + GeomMatch2 ! inequality + +! !DESCRIPTION: +! This routine compares two ESMF GeomMatch statuses to see if +! they are unequal. +! +! The arguments are: +! \begin{description} +! \item[GeomMatch1, GeomMatch2] +! Two statuses of GeomMatchs to compare for inequality +! \end{description} +! +!EOPI + + ESMF_GeomMatchNotEqual = (GeomMatch1%geommatch /= & + GeomMatch2%geommatch) + + end function ESMF_GeomMatchNotEqual + !------------------------------------------------------------------------------ #undef ESMF_METHOD #define ESMF_METHOD "ESMF_GeomTypeEqual" diff --git a/src/Infrastructure/Geom/tests/ESMF_GeomUTest.F90 b/src/Infrastructure/Geom/tests/ESMF_GeomUTest.F90 new file mode 100644 index 0000000000..d8f70af5d6 --- /dev/null +++ b/src/Infrastructure/Geom/tests/ESMF_GeomUTest.F90 @@ -0,0 +1,242 @@ +! $Id$ +! +! Earth System Modeling Framework +! Copyright (c) 2002-2024, 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. +! +!============================================================================== +! +program ESMF_GeomUTest + +!------------------------------------------------------------------------------ + +#include "ESMF.h" +#include "ESMF_Macros.inc" + +!============================================================================== +!BOP +! !PROGRAM: ESMF_GeomTest - Check Grid Create Routines +! +! !DESCRIPTION: +! +! The code in this file drives F90 Grid Create unit tests. +! +!----------------------------------------------------------------------------- +! !USES: + use ESMF_TestMod ! test methods + use ESMF + + implicit none + +!------------------------------------------------------------------------------ +! The following line turns the CVS identifier string into a printable variable. + character(*), parameter :: version = & + '$Id$' +!------------------------------------------------------------------------------ + + ! cumulative result: count failures; no failures equals "all pass" + integer :: result = 0 + + ! individual test result code + integer :: localrc, rc, localPet, petCount + type(ESMF_VM) :: vm + + ! individual test failure message + character(ESMF_MAXSTR) :: failMsg + character(ESMF_MAXSTR) :: name, grid_name + + type(ESMF_Grid) :: grid1, grid2, gridAlias + type(ESMF_Geom) :: geom1, geom2, geomAlias + logical :: shouldBeFalse, shouldBeTrue + type(ESMF_GeomMatch_Flag) :: geomMatchFlag + + !----------------------------------------------------------------------------- + call ESMF_TestStart(ESMF_SRCLINE, rc=rc) + if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT) + !----------------------------------------------------------------------------- + + ! get global VM + call ESMF_VMGetGlobal(vm, rc=rc) + if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT) + call ESMF_VMGet(vm, localPet=localPet, petCount=petCount, rc=rc) + if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT) + + ! Create two different Grids to be used for testing below + grid1=ESMF_GridCreateNoPeriDim(maxIndex=(/100,100/), rc=localrc) + if (localrc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT) + + grid2=ESMF_GridCreateNoPeriDim(maxIndex=(/200,200/), rc=localrc) + if (localrc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT) + + + !------------------------------------------------------------------------ + !NEX_UTest + write(name, *) "Geom equality before assignment Test" + write(failMsg, *) "Did not return ESMF_SUCCESS" + shouldBeFalse = (geom1 == geom2) + call ESMF_Test(.not. shouldBeFalse, name, failMsg, result, ESMF_SRCLINE) + + !------------------------------------------------------------------------ + !NEX_UTest + write(name, *) "Geom non-equality before assignment Test" + write(failMsg, *) "Did not return ESMF_SUCCESS" + shouldBeTrue = (geom1 /= geom2) + call ESMF_Test(shouldBeTrue, name, failMsg, result, ESMF_SRCLINE) + + !------------------------------------------------------------------------ + !NEX_UTest + write(name, *) "Geom equality with alias test" + write(failMsg, *) "Did not return ESMF_SUCCESS" + + ! Init + rc=ESMF_SUCCESS + + ! Create geom + geom1=ESMF_GeomCreate(grid1, rc=localrc) + if (localrc /= ESMF_SUCCESS) rc=ESMF_FAILURE + + ! Assign alias + geomAlias=geom1 + + ! Test equality + shouldBeTrue = (geom1 == geomAlias) + + ! Get rid of geom1 + call ESMF_GeomDestroy(geom1, rc=localrc) + if (localrc /= ESMF_SUCCESS) rc=ESMF_FAILURE + + call ESMF_Test((shouldBeTrue .and. (rc==ESMF_SUCCESS)), name, failMsg, result, ESMF_SRCLINE) + + !------------------------------------------------------------------------ + !NEX_UTest + write(name, *) "Geom inequality with two different geoms" + write(failMsg, *) "Did not return ESMF_SUCCESS" + + ! Init + rc=ESMF_SUCCESS + + ! Create geom1 + geom1=ESMF_GeomCreate(grid1, rc=localrc) + if (localrc /= ESMF_SUCCESS) rc=ESMF_FAILURE + + ! Create geom2 + geom2=ESMF_GeomCreate(grid2, rc=localrc) + if (localrc /= ESMF_SUCCESS) rc=ESMF_FAILURE + + ! Test equality + shouldBeTrue = (geom1 /= geom2) + + ! Get rid of geom1 + call ESMF_GeomDestroy(geom1, rc=localrc) + if (localrc /= ESMF_SUCCESS) rc=ESMF_FAILURE + + ! Get rid of geom2 + call ESMF_GeomDestroy(geom2, rc=localrc) + if (localrc /= ESMF_SUCCESS) rc=ESMF_FAILURE + + call ESMF_Test((shouldBeTrue .and. (rc==ESMF_SUCCESS)), name, failMsg, result, ESMF_SRCLINE) + + + !------------------------------------------------------------------------ + !NEX_UTest + write(name, *) "Geom match with the same geoms" + write(failMsg, *) "Did not return ESMF_SUCCESS" + + ! Init + rc=ESMF_SUCCESS + + ! Create geom1 + geom1=ESMF_GeomCreate(grid1, rc=localrc) + if (localrc /= ESMF_SUCCESS) rc=ESMF_FAILURE + + ! Get Match + geomMatchFlag=ESMF_GeomMatch(geom1, geom1, rc=localrc) + if (localrc /= ESMF_SUCCESS) rc=ESMF_FAILURE + + + ! Get rid of geom1 + call ESMF_GeomDestroy(geom1, rc=localrc) + if (localrc /= ESMF_SUCCESS) rc=ESMF_FAILURE + + call ESMF_Test((geomMatchFlag == ESMF_GEOMMATCH_ALIAS) .and. (rc == ESMF_SUCCESS), & + name, failMsg, result, ESMF_SRCLINE) + + + !------------------------------------------------------------------------ + !NEX_UTest + write(name, *) "Geom match with different geoms with the same grid" + write(failMsg, *) "Did not return ESMF_SUCCESS" + + ! Init + rc=ESMF_SUCCESS + + ! Create geom1 + geom1=ESMF_GeomCreate(grid1, rc=localrc) + if (localrc /= ESMF_SUCCESS) rc=ESMF_FAILURE + + ! Create geom2 + geom2=ESMF_GeomCreate(grid1, rc=localrc) + if (localrc /= ESMF_SUCCESS) rc=ESMF_FAILURE + + ! Get Match + geomMatchFlag=ESMF_GeomMatch(geom1, geom2, rc=localrc) + if (localrc /= ESMF_SUCCESS) rc=ESMF_FAILURE + + ! Get rid of geom1 + call ESMF_GeomDestroy(geom1, rc=localrc) + if (localrc /= ESMF_SUCCESS) rc=ESMF_FAILURE + + ! Get rid of geom2 + call ESMF_GeomDestroy(geom2, rc=localrc) + if (localrc /= ESMF_SUCCESS) rc=ESMF_FAILURE + + call ESMF_Test((geomMatchFlag == ESMF_GEOMMATCH_GEOMALIAS), name, failMsg, result, ESMF_SRCLINE) + + + !------------------------------------------------------------------------ + !NEX_UTest + write(name, *) "Geom match with different geoms with different grids" + write(failMsg, *) "Did not return ESMF_SUCCESS" + + ! Init + rc=ESMF_SUCCESS + + ! Create geom1 + geom1=ESMF_GeomCreate(grid1, rc=localrc) + if (localrc /= ESMF_SUCCESS) rc=ESMF_FAILURE + + ! Create geom2 + geom2=ESMF_GeomCreate(grid2, rc=localrc) + if (localrc /= ESMF_SUCCESS) rc=ESMF_FAILURE + + ! Get Match + geomMatchFlag=ESMF_GeomMatch(geom1, geom2, rc=localrc) + if (localrc /= ESMF_SUCCESS) rc=ESMF_FAILURE + + ! Get rid of geom1 + call ESMF_GeomDestroy(geom1, rc=localrc) + if (localrc /= ESMF_SUCCESS) rc=ESMF_FAILURE + + ! Get rid of geom2 + call ESMF_GeomDestroy(geom2, rc=localrc) + if (localrc /= ESMF_SUCCESS) rc=ESMF_FAILURE + + call ESMF_Test((geomMatchFlag == ESMF_GEOMMATCH_NONE), name, failMsg, result, ESMF_SRCLINE) + + !------------------------ Cleanup after testing -------------------------------------------- + + ! Get rid of test Grids + call ESMF_GridDestroy(grid1) + call ESMF_GridDestroy(grid2) + + + !----------------------------------------------------------------------------- + ! Stop testing + call ESMF_TestEnd(ESMF_SRCLINE) + !----------------------------------------------------------------------------- + +end program ESMF_GeomUTest diff --git a/src/Infrastructure/Geom/tests/makefile b/src/Infrastructure/Geom/tests/makefile new file mode 100644 index 0000000000..cc3378cf34 --- /dev/null +++ b/src/Infrastructure/Geom/tests/makefile @@ -0,0 +1,35 @@ +# $Id$ + +ALL: build_unit_tests +run: run_unit_tests +run_uni: run_unit_tests_uni + +LOCDIR = src/Infrastructure/Grid/tests + +.NOTPARALLEL: +TESTS_BUILD = $(ESMF_TESTDIR)/ESMF_GeomUTest + +TESTS_RUN = RUN_ESMF_GeomUTest + +TESTS_RUN_UNI = RUN_ESMF_GeomUTest + +include ${ESMF_DIR}/makefile + +CLEANDIRS = +CLEANFILES = $(TESTS_BUILD) +CLOBBERDIRS = + +DIRS = + +# +# unit test targets +# + +# --- Grid Creation + +RUN_ESMF_GeomUTest: + $(MAKE) TNAME=Geom NP=4 ftest + +RUN_ESMF_GeomUTestUNI: + $(MAKE) TNAME=Geom NP=1 ftest + From 882f3be3755534efd006e46ff8c688219faf0e22 Mon Sep 17 00:00:00 2001 From: Robert Oehmke Date: Wed, 16 Oct 2024 12:03:20 -0600 Subject: [PATCH 069/207] Fix issue with mpiuni and Geom unit tests. --- src/Infrastructure/Geom/tests/makefile | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Infrastructure/Geom/tests/makefile b/src/Infrastructure/Geom/tests/makefile index cc3378cf34..c0fbec7a2a 100644 --- a/src/Infrastructure/Geom/tests/makefile +++ b/src/Infrastructure/Geom/tests/makefile @@ -11,7 +11,7 @@ TESTS_BUILD = $(ESMF_TESTDIR)/ESMF_GeomUTest TESTS_RUN = RUN_ESMF_GeomUTest -TESTS_RUN_UNI = RUN_ESMF_GeomUTest +TESTS_RUN_UNI = RUN_ESMF_GeomUTestUNI include ${ESMF_DIR}/makefile From c0ea79a84f83ca1b8f2fc0546ef2814ad5a3d1a0 Mon Sep 17 00:00:00 2001 From: Robert Oehmke Date: Wed, 16 Oct 2024 14:50:56 -0600 Subject: [PATCH 070/207] Take ESMF_RouteHandlePrint() out of the reference manual, because it isn't helpful for users. --- src/Infrastructure/Route/interface/ESMF_RHandle.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/Infrastructure/Route/interface/ESMF_RHandle.F90 b/src/Infrastructure/Route/interface/ESMF_RHandle.F90 index 7e5dcf2779..aaa5906319 100644 --- a/src/Infrastructure/Route/interface/ESMF_RHandle.F90 +++ b/src/Infrastructure/Route/interface/ESMF_RHandle.F90 @@ -1113,7 +1113,7 @@ end subroutine ESMF_RouteHandleAppend !------------------------------------------------------------------------------ #undef ESMF_METHOD #define ESMF_METHOD "ESMF_RouteHandlePrint" -!BOP +!BOPI ! !IROUTINE: ESMF_RouteHandlePrint - Print the contents of a RouteHandle ! !INTERFACE: @@ -1135,7 +1135,7 @@ subroutine ESMF_RouteHandlePrint(routehandle, keywordEnforcer, rc) ! Return code; equals {\tt ESMF\_SUCCESS} if there are no errors. ! \end{description} ! -!EOP +!EOPI !------------------------------------------------------------------------------ integer :: localrc ! local return code From 01694d9c784c665e80c4b2b4b8cd5bc36dc17fb1 Mon Sep 17 00:00:00 2001 From: Robert Oehmke Date: Thu, 17 Oct 2024 12:09:16 -0600 Subject: [PATCH 071/207] Add elem_coordinates to dual mesh. --- src/Infrastructure/Mesh/src/ESMCI_MeshDual.C | 187 +++++++++++-------- 1 file changed, 109 insertions(+), 78 deletions(-) diff --git a/src/Infrastructure/Mesh/src/ESMCI_MeshDual.C b/src/Infrastructure/Mesh/src/ESMCI_MeshDual.C index 234d918034..c06de4a5ee 100644 --- a/src/Infrastructure/Mesh/src/ESMCI_MeshDual.C +++ b/src/Infrastructure/Mesh/src/ESMCI_MeshDual.C @@ -81,6 +81,8 @@ namespace ESMCI { }; + void _fill_elem_fields(Mesh *dual_mesh, int sdim, double *elemCoords); + void get_unique_elems_around_node(MeshObj *node, Mesh *mesh, MDSS *tmp_mdss, int *_num_ids, UInt *ids); @@ -105,55 +107,6 @@ namespace ESMCI { } - // Add ghostcells to source mesh, because we need the surrounding - // cells - { - - // BOB: Use convenience function to comm. all fields -#if 0 - int num_snd=0; - MEField<> *snd[10],*rcv[10]; - - // Load coord field - MEField<> *psc = src_mesh->GetCoordField(); - snd[num_snd]=psc; - rcv[num_snd]=psc; - num_snd++; - - // Load element mask value field - MEField<> *psm = src_mesh->GetField("elem_mask_val"); - if (psm != NULL) { - snd[num_snd]=psm; - rcv[num_snd]=psm; - num_snd++; - } - - // Load element mask field - MEField<> *psem = src_mesh->GetField("elem_mask"); - if (psem != NULL) { - snd[num_snd]=psem; - rcv[num_snd]=psem; - num_snd++; - } - - // Load element coordinate field - MEField<> *psec = src_mesh->GetField("elem_coordinates"); - if (psec != NULL) { - snd[num_snd]=psec; - rcv[num_snd]=psec; - num_snd++; - } - - // Load frac2 field - MEField<> *psf = src_mesh->GetField("elem_frac2"); - if (psf != NULL) { - snd[num_snd]=psf; - rcv[num_snd]=psf; - num_snd++; - } -#endif - - #ifdef DEBUG_TRI { int nn = 0; @@ -186,12 +139,18 @@ namespace ESMCI { ESMCI_meshwrite(&src_mesh, fname, rc, len);} #endif - // Create ghost cells - src_mesh->CreateGhost(); + //// Add ghostcells to source mesh, because we need the surrounding cells + + // Create ghost cells + src_mesh->CreateGhost(); + + // Communicate values to ghost cells + src_mesh->GhostCommAllFields(); - // Communicate values to ghost cells - src_mesh->GhostCommAllFields(); + // If src_mesh is split, add newly created ghost elements to split_to_orig map + if (src_mesh->is_split) add_ghost_elems_to_split_orig_id_map(src_mesh); + #ifdef DEBUG_WRITE_MESH {int *rc; int len = 18; char fname[len]; @@ -224,11 +183,6 @@ namespace ESMCI { #endif - // If src_mesh is split, add newly created ghost elements to split_to_orig map - if (src_mesh->is_split) add_ghost_elems_to_split_orig_id_map(src_mesh); - } - - // Get some useful info int sdim=src_mesh->spatial_dim(); int pdim=src_mesh->parametric_dim(); @@ -248,6 +202,11 @@ namespace ESMCI { Throw() <<" Creation of a dual mesh requires element coordinates. \n"; } + MEField<> *src_node_coords=src_mesh->GetCoordField(); + if (!src_node_coords) { + Throw() <<" Creation of a dual mesh requires node coordinates. \n"; + } + // Iterate through all src elements counting the number and creating a map std::map id_to_index; @@ -336,10 +295,12 @@ namespace ESMCI { int *elemType=NULL; UInt *elemId=NULL; UInt *elemOwner=NULL; + double *elemCoords=NULL; if (max_num_elems>0) { elemType=new int[max_num_elems]; elemId=new UInt[max_num_elems]; elemOwner=new UInt[max_num_elems]; + elemCoords=new double[sdim*max_num_elems]; } int *elemConn=NULL; if (max_num_elemConn >0) { @@ -349,6 +310,7 @@ namespace ESMCI { // Iterate through src nodes creating elements int num_elems=0; int conn_pos=0; + int ec_pos=0; ni = src_mesh->node_begin(); for (; ni != ne; ++ni) { MeshObj &node=*ni; @@ -392,12 +354,17 @@ namespace ESMCI { elemOwner[num_elems]=node.get_owner(); // printf("%d# eId=%d eT=%d ::",Par::Rank(),elemId[num_elems],elemType[num_elems]); + + // Save coordinates + double *coords=src_node_coords->data(node); + for (auto d=0; d *elem_frac = dual_mesh->RegisterField("elem_frac", - MEFamilyDG0::instance(), MeshObj::ELEMENT, ctxt, 1, true); - } + // Register the elem Fields + Context ctxt; ctxt.flip(); + dual_mesh->RegisterField("elem_frac", + MEFamilyDG0::instance(), MeshObj::ELEMENT, ctxt, 1, true); + + dual_mesh->RegisterField("elem_frac2", + MEFamilyDG0::instance(), MeshObj::ELEMENT, ctxt, 1, true); + dual_mesh->RegisterField("elem_coordinates", + MEFamilyDG0::instance(), MeshObj::ELEMENT, ctxt, sdim, true); + + + // Change owners to be on the current communicator rather than the source mesh's communicator _change_owners_from_src_to_curr_comm(dual_mesh, src_mesh->orig_comm); @@ -839,8 +818,12 @@ namespace ESMCI { dual_mesh->build_sym_comm_rel(MeshObj::NODE); dual_mesh->Commit(); - + //// Fill Elem Fields + _fill_elem_fields(dual_mesh, sdim, elemCoords); + // Clean up remaining element info + if (elemCoords !=NULL) delete [] elemCoords; + // Output *_dual_mesh=dual_mesh; } @@ -1391,4 +1374,52 @@ void triangulate(int sdim, int num_p, double *p, double *td, int *ti, int *tri_i } +void _fill_elem_fields(Mesh *dual_mesh, int sdim, double *elemCoords) { + + + // Get end iterator + Mesh::const_iterator ee = dual_mesh->elem_end(); + + // Init frac to 1.0 + MEField<> *elem_frac=dual_mesh->GetField("elem_frac"); + if (elem_frac) { + for (Mesh::const_iterator ei = dual_mesh->elem_begin(); ei != ee; ++ei) { + const MeshObj &elem = *ei; + double *f=elem_frac->data(elem); + *f=1.0; + } + } + + // Init frac2 to 1.0 + MEField<> *elem_frac2=dual_mesh->GetField("elem_frac2"); + if (elem_frac2) { + for (Mesh::const_iterator ei = dual_mesh->elem_begin(); ei != ee; ++ei) { + const MeshObj &elem = *ei; + double *f=elem_frac2->data(elem); + *f=1.0; + } + } + + // Set element coordinates + MEField<> *elem_coords=dual_mesh->GetField("elem_coordinates"); + if (elem_coords) { + for (Mesh::const_iterator ei = dual_mesh->elem_begin(); ei != ee; ++ei) { + const MeshObj &elem = *ei; + + // Get data pointer to elem data + double *ecd =elem_coords->data(elem); + + // Get memory for input coord data + double *icd = elemCoords+sdim*elem.get_data_index(); + + // Copy + for (int d=0; d Date: Thu, 17 Oct 2024 13:30:09 -0600 Subject: [PATCH 072/207] Fix FindPython, add --cmake-args to ESMX (#306) * Find the most generic Python interpreter in standard paths * Add --cmake-args to ESMX_Builder.sh --- src/addon/ESMX/Driver/CMakeLists.txt | 3 +++ src/addon/ESMX/README.md | 6 +++++- src/apps/ESMX_Builder/ESMX_Builder.sh | 24 +++++++++++++++++++++++- 3 files changed, 31 insertions(+), 2 deletions(-) diff --git a/src/addon/ESMX/Driver/CMakeLists.txt b/src/addon/ESMX/Driver/CMakeLists.txt index 9bda54e302..ab75e98d17 100644 --- a/src/addon/ESMX/Driver/CMakeLists.txt +++ b/src/addon/ESMX/Driver/CMakeLists.txt @@ -2,6 +2,9 @@ cmake_minimum_required(VERSION 3.22) # load packages and modules list(APPEND CMAKE_MODULE_PATH ${CMAKE_CURRENT_LIST_DIR}/cmake) +set(Python_FIND_UNVERSIONED_NAMES "FIRST") +set(Python_FIND_FRAMEWORK "LAST") +set(Python_FIND_REGISTRY "LAST") find_package(Python 3.5 REQUIRED COMPONENTS Interpreter) find_package(ESMF 8.6.0 MODULE REQUIRED) include(FetchContent) diff --git a/src/addon/ESMX/README.md b/src/addon/ESMX/README.md index a5575da7e7..fe8de4cf1b 100644 --- a/src/addon/ESMX/README.md +++ b/src/addon/ESMX/README.md @@ -41,6 +41,7 @@ options: [--disable-comps=DISABLE_COMPS] [--build-type=BUILD_TYPE] or [-g] [--build-args=BUILD_ARGS] + [--cmake-args=CMAKE_ARGS] [--build-jobs=JOBS] [--load-modulefile=MODULEFILE] [--load-bashenv=BASHENV] @@ -68,7 +69,10 @@ where: --build-type=BUILD_TYPE build type; valid options are 'debug', 'release', 'relWithDebInfo' -g (default: release) (-g sets BUILD_TYPE to debug) - --build-args=BUILD_ARGS global cmake arguments (e.g. -DVAR=val) + --build-args=BUILD_ARGS build arguments passed to every component (e.g. -DVAR=val) + + --cmake-args=CMAKE_ARGS cmake arguments are used to configure cmake while building ESMX + (e.g. -DVAR=val) --build-jobs=BUILD_JOBS number of jobs used for building esmx and components diff --git a/src/apps/ESMX_Builder/ESMX_Builder.sh b/src/apps/ESMX_Builder/ESMX_Builder.sh index c5d239deb8..e1d557c848 100755 --- a/src/apps/ESMX_Builder/ESMX_Builder.sh +++ b/src/apps/ESMX_Builder/ESMX_Builder.sh @@ -29,7 +29,14 @@ usage () { printf " -g\n" printf " set --build-type=debug\n" printf " --build-args=BUILD_ARGS\n" - printf " cmake arguments (e.g. -DARG=VAL)\n" + printf " build args are passed to each component\n" + printf " arguments are not used to configure ESMX (see --cmake-args)\n" + printf " (e.g. --build-args=\"-DFOO=BAR\")\n" + printf " note: build_args in ESMX_BUILD_FILE supersedes --build-args\n" + printf " --cmake-args=CMAKE_ARGS\n" + printf " cmake args are used to configure cmake while building ESMX\n" + printf " arguments are not passed to components (see --build-args)\n" + printf " (e.g. --cmake-args=\"-DFOO=BAR\")\n" printf " --disable-comps=DISABLE_COMPS\n" printf " disable components\n" printf " --build-jobs=BUILD_JOBS\n" @@ -63,6 +70,12 @@ settings () { printf " INSTALL_PREFIX=${INSTALL_PREFIX}\n" printf " BUILD_TYPE=${BUILD_TYPE}\n" printf " BUILD_ARGS=${BUILD_ARGS}\n" + printf " CMAKE_ARGS=\n" + if [ ${#CMAKE_ARGS[@]} -gt 0 ]; then + for arg in "${CMAKE_ARGS[@]}"; do + printf " ${arg}\n" + done + fi printf " DISABLE_COMPS=${DISABLE_COMPS}\n" printf " BUILD_JOBS=${BUILD_JOBS}\n" printf " MODULEFILE=${MODULEFILE}\n" @@ -80,6 +93,7 @@ BUILD_FILE="esmxBuild.yaml" ESMF_ESMXDIR="" BUILD_TYPE="release" BUILD_ARGS="" +CMAKE_ARGS=() DISABLE_COMPS="" BUILD_JOBS="" BUILD_DIR="${CWD}/build" @@ -125,6 +139,9 @@ while [[ $# -gt 0 ]]; do --build-jobs=?*) BUILD_JOBS=${1#*=} ;; --build-jobs) usage_error "$1" "requires an argument" ;; --build-jobs=) usage_error "$1" "requires an argument" ;; + --cmake-args=?*) CMAKE_ARGS+=(${1#*=}) ;; + --cmake-args) usage_error "$1" "requires an argument" ;; + --cmake-args=) usage_error "$1" "requires an argument" ;; --disable-comps=?*) DISABLE_COMPS=${1#*=} DISABLE_COMPS=${DISABLE_COMPS/' '/','} DISABLE_COMPS=${DISABLE_COMPS/';'/','} ;; @@ -232,6 +249,11 @@ fi if [ ! -z "${BUILD_ARGS}" ]; then CMAKE_SETTINGS+=("-DESMX_BUILD_ARGS=${BUILD_ARGS}") fi +if [ ${#CMAKE_ARGS[@]} -gt 0 ]; then + for arg in "${CMAKE_ARGS[@]}"; do + CMAKE_SETTINGS+=("${arg}") + done +fi # make settings BUILD_SETTINGS=("") From bee6f8a2061aee9218349957a6423fee50d7de59 Mon Sep 17 00:00:00 2001 From: Robert Oehmke Date: Thu, 17 Oct 2024 13:59:45 -0600 Subject: [PATCH 073/207] Add original coordinates to mesh dual. --- src/Infrastructure/Mesh/src/ESMCI_MeshDual.C | 103 ++++++++++++++++--- 1 file changed, 91 insertions(+), 12 deletions(-) diff --git a/src/Infrastructure/Mesh/src/ESMCI_MeshDual.C b/src/Infrastructure/Mesh/src/ESMCI_MeshDual.C index c06de4a5ee..ae482df3d4 100644 --- a/src/Infrastructure/Mesh/src/ESMCI_MeshDual.C +++ b/src/Infrastructure/Mesh/src/ESMCI_MeshDual.C @@ -1,4 +1,3 @@ - // $Id: ESMCI_MeshRedist.C,v 1.23 2012/01/06 20:17:51 svasquez Exp $ // // Earth System Modeling Framework @@ -81,11 +80,13 @@ namespace ESMCI { }; - void _fill_elem_fields(Mesh *dual_mesh, int sdim, double *elemCoords); - void get_unique_elems_around_node(MeshObj *node, Mesh *mesh, MDSS *tmp_mdss, int *_num_ids, UInt *ids); + void _fill_elem_fields(Mesh *dual_mesh, int sdim, int orig_sdim, + double *elemCoords, double *elemOrigCoords); + + void _change_owners_from_src_to_curr_comm(Mesh *dual_mesh, MPI_Comm src_comm); @@ -185,6 +186,7 @@ namespace ESMCI { // Get some useful info int sdim=src_mesh->spatial_dim(); + int orig_sdim=src_mesh->orig_spatial_dim; int pdim=src_mesh->parametric_dim(); // Create Mesh @@ -193,19 +195,26 @@ namespace ESMCI { // Set Mesh dimensions dual_mesh->set_spatial_dimension(sdim); dual_mesh->set_parametric_dimension(pdim); - dual_mesh->orig_spatial_dim=src_mesh->orig_spatial_dim; + dual_mesh->orig_spatial_dim=orig_sdim; dual_mesh->coordsys=src_mesh->coordsys; // Get element coordinates - MEField<> *elem_coords=src_mesh->GetField("elem_coordinates"); - if (!elem_coords) { + MEField<> *src_elem_coords=src_mesh->GetField("elem_coordinates"); + if (!src_elem_coords) { Throw() <<" Creation of a dual mesh requires element coordinates. \n"; } + // Get original elem coordinates + MEField<> *src_elem_orig_coords=src_mesh->GetField("elem_orig_coordinates"); + + // Get node coordinates MEField<> *src_node_coords=src_mesh->GetCoordField(); if (!src_node_coords) { Throw() <<" Creation of a dual mesh requires node coordinates. \n"; } + + // Get original node coordinates + MEField<> *src_node_orig_coords=src_mesh->GetField("orig_coordinates"); // Iterate through all src elements counting the number and creating a map @@ -296,11 +305,13 @@ namespace ESMCI { UInt *elemId=NULL; UInt *elemOwner=NULL; double *elemCoords=NULL; + double *elemOrigCoords=NULL; if (max_num_elems>0) { elemType=new int[max_num_elems]; elemId=new UInt[max_num_elems]; elemOwner=new UInt[max_num_elems]; elemCoords=new double[sdim*max_num_elems]; + elemOrigCoords=new double[orig_sdim*max_num_elems]; } int *elemConn=NULL; if (max_num_elemConn >0) { @@ -311,6 +322,7 @@ namespace ESMCI { int num_elems=0; int conn_pos=0; int ec_pos=0; + int eoc_pos=0; ni = src_mesh->node_begin(); for (; ni != ne; ++ni) { MeshObj &node=*ni; @@ -361,6 +373,15 @@ namespace ESMCI { elemCoords[ec_pos]=coords[d]; ec_pos++; } + + // If present, save original coordinates + if (src_node_orig_coords) { + double *orig_coords=src_node_orig_coords->data(node); + for (auto od=0; od *dm_node_coord = dual_mesh->RegisterNodalField(*dual_mesh, "coordinates", sdim); + + IOField *dm_node_orig_coord=NULL; + if (src_elem_orig_coords) { + dm_node_orig_coord = dual_mesh->RegisterNodalField(*dual_mesh, "orig_coordinates", orig_sdim); + } IOField *dm_node_mask_val=NULL; MEField<> *elem_mask_val=src_mesh->GetField("elem_mask_val"); @@ -489,7 +515,7 @@ namespace ESMCI { MeshObj &node=*(nodes[pos]); // Get elem coord pointer - double *ec=elem_coords->data(elem); + double *ec=src_elem_coords->data(elem); // Get node coord pointer double *nc=dm_node_coord->data(node); @@ -500,6 +526,21 @@ namespace ESMCI { } // printf("%d# H1 id=%d pos=%d nc=%f %f ec=%f %f\n",Par::Rank(),node->get_id(),pos,nc[0],nc[1],ec[0],ec[1]); + + // Copy original coords + if (src_elem_orig_coords && dm_node_orig_coord) { + + // Get data pointers + double *eoc=src_elem_orig_coords->data(elem); + double *noc=dm_node_orig_coord->data(node); + + // Copy coords from elem to node + for (int od=0; oddata(elem); @@ -584,6 +625,7 @@ namespace ESMCI { UInt *elemId_wsplit=NULL; UInt *elemOwner_wsplit=NULL; double *elemCoords_wsplit=NULL; + double *elemOrigCoords_wsplit=NULL; // int *elemMaskIIArray_wsplit=NULL; //InterArray *elemMaskII_wsplit=NULL; @@ -598,6 +640,7 @@ namespace ESMCI { elemId_wsplit=new UInt[num_elems_wsplit]; elemOwner_wsplit=new UInt[num_elems_wsplit]; elemCoords_wsplit=new double[sdim*num_elems_wsplit]; + elemOrigCoords_wsplit=new double[orig_sdim*num_elems_wsplit]; #if 0 //// Setup for split mask @@ -692,6 +735,15 @@ namespace ESMCI { for (int d=0; dRegisterField("elem_coordinates", MEFamilyDG0::instance(), MeshObj::ELEMENT, ctxt, sdim, true); - - + + if (elemOrigCoords) { + dual_mesh->RegisterField("elem_orig_coordinates", + MEFamilyDG0::instance(), MeshObj::ELEMENT, ctxt, orig_sdim, true); + + } // Change owners to be on the current communicator rather than the source mesh's communicator _change_owners_from_src_to_curr_comm(dual_mesh, src_mesh->orig_comm); @@ -819,7 +877,7 @@ namespace ESMCI { dual_mesh->Commit(); //// Fill Elem Fields - _fill_elem_fields(dual_mesh, sdim, elemCoords); + _fill_elem_fields(dual_mesh, sdim, orig_sdim, elemCoords, elemOrigCoords); // Clean up remaining element info if (elemCoords !=NULL) delete [] elemCoords; @@ -1374,7 +1432,8 @@ void triangulate(int sdim, int num_p, double *p, double *td, int *ti, int *tri_i } -void _fill_elem_fields(Mesh *dual_mesh, int sdim, double *elemCoords) { +void _fill_elem_fields(Mesh *dual_mesh, int sdim, int orig_sdim, + double *elemCoords, double *elemOrigCoords) { // Get end iterator @@ -1402,7 +1461,7 @@ void _fill_elem_fields(Mesh *dual_mesh, int sdim, double *elemCoords) { // Set element coordinates MEField<> *elem_coords=dual_mesh->GetField("elem_coordinates"); - if (elem_coords) { + if (elem_coords && elemCoords) { for (Mesh::const_iterator ei = dual_mesh->elem_begin(); ei != ee; ++ei) { const MeshObj &elem = *ei; @@ -1418,6 +1477,26 @@ void _fill_elem_fields(Mesh *dual_mesh, int sdim, double *elemCoords) { } } } + + // Set element original coordinates + MEField<> *elem_orig_coords=dual_mesh->GetField("elem_orig_coordinates"); + if (elem_orig_coords && elemOrigCoords) { + for (Mesh::const_iterator ei = dual_mesh->elem_begin(); ei != ee; ++ei) { + const MeshObj &elem = *ei; + + // Get data pointer to elem data + double *eocd =elem_orig_coords->data(elem); + + // Get memory for input coord data + double *iocd = elemOrigCoords+orig_sdim*elem.get_data_index(); + + // Copy + for (int od=0; od Date: Thu, 17 Oct 2024 17:07:01 -0600 Subject: [PATCH 074/207] Add element masking to Mesh dual. --- src/Infrastructure/Mesh/src/ESMCI_MeshDual.C | 110 +++++++++++++++++-- 1 file changed, 98 insertions(+), 12 deletions(-) diff --git a/src/Infrastructure/Mesh/src/ESMCI_MeshDual.C b/src/Infrastructure/Mesh/src/ESMCI_MeshDual.C index ae482df3d4..694863d730 100644 --- a/src/Infrastructure/Mesh/src/ESMCI_MeshDual.C +++ b/src/Infrastructure/Mesh/src/ESMCI_MeshDual.C @@ -83,8 +83,10 @@ namespace ESMCI { void get_unique_elems_around_node(MeshObj *node, Mesh *mesh, MDSS *tmp_mdss, int *_num_ids, UInt *ids); + void _fill_elem_fields(Mesh *dual_mesh, int sdim, int orig_sdim, - double *elemCoords, double *elemOrigCoords); + double *elemCoords, double *elemOrigCoords, + double *elemMaskVal, double *elemMask); void _change_owners_from_src_to_curr_comm(Mesh *dual_mesh, MPI_Comm src_comm); @@ -93,7 +95,7 @@ namespace ESMCI { // Create a dual of the input Mesh // This adds ghostcells to the input mesh, // it also creates ghostcells for the dual mesh - void MeshDual(Mesh *src_mesh, Mesh **_dual_mesh) { +void MeshDual(Mesh *src_mesh, Mesh **_dual_mesh) { Trace __trace("MeshDual(Mesh *src_mesh, Mesh **dual_mesh)"); @@ -198,6 +200,7 @@ namespace ESMCI { dual_mesh->orig_spatial_dim=orig_sdim; dual_mesh->coordsys=src_mesh->coordsys; + // Get element coordinates MEField<> *src_elem_coords=src_mesh->GetField("elem_coordinates"); if (!src_elem_coords) { @@ -215,7 +218,11 @@ namespace ESMCI { // Get original node coordinates MEField<> *src_node_orig_coords=src_mesh->GetField("orig_coordinates"); - + + // Get node mask info + MEField<> *src_node_mask_val=src_mesh->GetField("node_mask_val"); + MEField<> *src_node_mask=src_mesh->GetField("mask"); + // Iterate through all src elements counting the number and creating a map std::map id_to_index; @@ -306,12 +313,16 @@ namespace ESMCI { UInt *elemOwner=NULL; double *elemCoords=NULL; double *elemOrigCoords=NULL; + double *elemMaskVal=NULL; + double *elemMask=NULL; if (max_num_elems>0) { elemType=new int[max_num_elems]; elemId=new UInt[max_num_elems]; elemOwner=new UInt[max_num_elems]; elemCoords=new double[sdim*max_num_elems]; - elemOrigCoords=new double[orig_sdim*max_num_elems]; + if (src_node_orig_coords) elemOrigCoords=new double[orig_sdim*max_num_elems]; + if (src_node_mask_val) elemMaskVal=new double[max_num_elems]; + if (src_node_mask) elemMask=new double[max_num_elems]; } int *elemConn=NULL; if (max_num_elemConn >0) { @@ -375,13 +386,25 @@ namespace ESMCI { } // If present, save original coordinates - if (src_node_orig_coords) { + if (elemOrigCoords && src_node_orig_coords) { double *orig_coords=src_node_orig_coords->data(node); for (auto od=0; oddata(node); + elemMaskVal[num_elems]=*nmv; + } + + // If present, save element mask value + if (elemMask && src_node_mask) { + double *nm=src_node_mask->data(node); + elemMask[num_elems]=*nm; + } // Next elem num_elems++; @@ -626,6 +649,8 @@ namespace ESMCI { UInt *elemOwner_wsplit=NULL; double *elemCoords_wsplit=NULL; double *elemOrigCoords_wsplit=NULL; + double *elemMaskVal_wsplit=NULL; + double *elemMask_wsplit=NULL; // int *elemMaskIIArray_wsplit=NULL; //InterArray *elemMaskII_wsplit=NULL; @@ -640,8 +665,10 @@ namespace ESMCI { elemId_wsplit=new UInt[num_elems_wsplit]; elemOwner_wsplit=new UInt[num_elems_wsplit]; elemCoords_wsplit=new double[sdim*num_elems_wsplit]; - elemOrigCoords_wsplit=new double[orig_sdim*num_elems_wsplit]; - + if (elemOrigCoords) elemOrigCoords_wsplit=new double[orig_sdim*num_elems_wsplit]; + if (elemMaskVal) elemMaskVal_wsplit=new double[num_elems_wsplit]; + if (elemMask) elemMask_wsplit=new double[num_elems_wsplit]; + #if 0 //// Setup for split mask int *elemMaskIIArray=NULL; @@ -744,6 +771,16 @@ namespace ESMCI { elem_orig_pnt_wsplit[od]=elem_orig_pnt[od]; } } + + // Set elem mask val + if (elemMaskVal) { + elemMaskVal_wsplit[split_elem_pos]=elemMaskVal[e]; + } + + // Set elem mask + if (elemMask) { + elemMask_wsplit[split_elem_pos]=elemMask[e]; + } // Next split element split_elem_pos++; @@ -792,7 +829,9 @@ namespace ESMCI { if (elemConn !=NULL) delete [] elemConn; if (elemCoords !=NULL) delete [] elemCoords; if (elemOrigCoords !=NULL) delete [] elemOrigCoords; - + if (elemMaskVal !=NULL) delete [] elemMaskVal; + if (elemMask !=NULL) delete [] elemMask; + // Use the new split list for the connection lists below num_elems=num_elems_wsplit; elemConn=elemConn_wsplit; @@ -801,6 +840,8 @@ namespace ESMCI { elemOwner=elemOwner_wsplit; elemCoords=elemCoords_wsplit; elemOrigCoords=elemOrigCoords_wsplit; + elemMaskVal=elemMaskVal_wsplit; + elemMask=elemMask_wsplit; #if 0 if (elemMaskII != NULL) { @@ -866,8 +907,21 @@ namespace ESMCI { if (elemOrigCoords) { dual_mesh->RegisterField("elem_orig_coordinates", MEFamilyDG0::instance(), MeshObj::ELEMENT, ctxt, orig_sdim, true); - + + } + + if (elemMaskVal) { + dual_mesh->RegisterField("elem_mask_val", + MEFamilyDG0::instance(), MeshObj::ELEMENT, ctxt, 1, true); + + } + + if (elemMask) { + dual_mesh->RegisterField("elem_mask", + MEFamilyDG0::instance(), MeshObj::ELEMENT, ctxt, 1, true); + } + // Change owners to be on the current communicator rather than the source mesh's communicator _change_owners_from_src_to_curr_comm(dual_mesh, src_mesh->orig_comm); @@ -876,11 +930,14 @@ namespace ESMCI { dual_mesh->build_sym_comm_rel(MeshObj::NODE); dual_mesh->Commit(); - //// Fill Elem Fields - _fill_elem_fields(dual_mesh, sdim, orig_sdim, elemCoords, elemOrigCoords); + // Fill Elem Fields + _fill_elem_fields(dual_mesh, sdim, orig_sdim, elemCoords, elemOrigCoords, elemMaskVal, elemMask); // Clean up remaining element info if (elemCoords !=NULL) delete [] elemCoords; + if (elemOrigCoords !=NULL) delete [] elemOrigCoords; + if (elemMaskVal !=NULL) delete [] elemMaskVal; + if (elemMask !=NULL) delete [] elemMask; // Output *_dual_mesh=dual_mesh; @@ -1433,7 +1490,8 @@ void triangulate(int sdim, int num_p, double *p, double *td, int *ti, int *tri_i void _fill_elem_fields(Mesh *dual_mesh, int sdim, int orig_sdim, - double *elemCoords, double *elemOrigCoords) { + double *elemCoords, double *elemOrigCoords, + double *elemMaskVal, double *elemMask) { // Get end iterator @@ -1496,6 +1554,34 @@ void _fill_elem_fields(Mesh *dual_mesh, int sdim, int orig_sdim, } } } + + // Set elem mask val + MEField<> *elem_mask_val=dual_mesh->GetField("elem_mask_val"); + if (elem_mask_val && elemMaskVal) { + for (Mesh::const_iterator ei = dual_mesh->elem_begin(); ei != ee; ++ei) { + const MeshObj &elem = *ei; + + // Get data pointer to elem data + double *emv = elem_mask_val->data(elem); + + // Set data from input + *emv=elemMaskVal[elem.get_data_index()]; + } + } + + // Set elem mask val + MEField<> *elem_mask=dual_mesh->GetField("elem_mask"); + if (elem_mask && elemMask) { + for (Mesh::const_iterator ei = dual_mesh->elem_begin(); ei != ee; ++ei) { + const MeshObj &elem = *ei; + + // Get data pointer to elem data + double *em = elem_mask->data(elem); + + // Set data from input + *em = elemMask[elem.get_data_index()]; + } + } } From c1f9118cda26f4a0a085174eebe6d2bd97cc5bf2 Mon Sep 17 00:00:00 2001 From: Robert Oehmke Date: Fri, 18 Oct 2024 12:16:21 -0600 Subject: [PATCH 075/207] Connect new transpose routehandle argument down through interface levels. --- .../Field/src/ESMF_FieldRegrid.F90 | 14 ++++++++++-- .../Mesh/include/ESMCI_MeshCap.h | 5 +++-- .../Mesh/include/ESMCI_Mesh_Regrid_Glue.h | 5 +++-- src/Infrastructure/Mesh/src/ESMCI_MeshCap.C | 10 +++++---- .../Mesh/src/ESMCI_Mesh_Regrid_Glue.C | 5 +++-- .../Regrid/interface/ESMCI_Regrid_F.C | 6 +++-- src/Infrastructure/Regrid/src/ESMF_Regrid.F90 | 22 ++++++++++++++++--- 7 files changed, 50 insertions(+), 17 deletions(-) diff --git a/src/Infrastructure/Field/src/ESMF_FieldRegrid.F90 b/src/Infrastructure/Field/src/ESMF_FieldRegrid.F90 index 34846258e4..5938139998 100644 --- a/src/Infrastructure/Field/src/ESMF_FieldRegrid.F90 +++ b/src/Infrastructure/Field/src/ESMF_FieldRegrid.F90 @@ -379,6 +379,7 @@ subroutine ESMF_FieldRegridStoreNX(srcField, dstField, keywordEnforcer, & routehandle, & factorList, factorIndexList, & weights, indices, & ! DEPRECATED ARGUMENTS + transposeRoutehandle, & srcFracField, dstFracField, & dstStatusField, & unmappedDstList, & @@ -410,6 +411,7 @@ subroutine ESMF_FieldRegridStoreNX(srcField, dstField, keywordEnforcer, & integer(ESMF_KIND_I4), pointer, optional :: factorIndexList(:,:) real(ESMF_KIND_R8), pointer, optional :: weights(:) ! DEPRECATED ARG integer(ESMF_KIND_I4), pointer, optional :: indices(:,:) ! DEPRECATED ARG + type(ESMF_RouteHandle), intent(inout), optional :: transposeRoutehandle type(ESMF_Field), intent(inout), optional :: srcFracField type(ESMF_Field), intent(inout), optional :: dstFracField type(ESMF_Field), intent(inout), optional :: dstStatusField @@ -463,7 +465,10 @@ subroutine ESMF_FieldRegridStoreNX(srcField, dstField, keywordEnforcer, & ! \item[8.6.0] Added argument {\tt vectorRegrid} to enable the user to turn on vector regridding. This ! functionality treats an undistributed dimension of the input Fields as the components of a vector and ! maps it through 3D Cartesian space to give more consistent results (especially near the pole) than -! just regridding the components individually. +! just regridding the components individually. +! +! \item[8.8.0] Added argument {\tt transposeRoutehandle} to enable the user to retrieve +! a routeHandle containing the transpose of the regrid sparse matrix. ! ! \end{description} ! \end{itemize} @@ -660,8 +665,11 @@ subroutine ESMF_FieldRegridStoreNX(srcField, dstField, keywordEnforcer, & ! The {\tt factorIndexList} array is allocated by the method and the user is responsible for deallocating it. ! \item [{[weights]}] ! \apiDeprecatedArgWithReplacement{factorList} -! \item [{[indices]}] +! \item [{[indices]}] ! \apiDeprecatedArgWithReplacement{factorIndexList} +! \item [transposeRoutehandle] +! A routeHandle to the transpose of the regrid sparse matrix. The +! transposed operation goes from {\tt dstField} to {\tt srcField}. ! \item [{[srcFracField]}] ! The fraction of each source cell participating in the regridding. Only ! valid when regridmethod is {\tt ESMF\_REGRIDMETHOD\_CONSERVE} or {\tt regridmethod=ESMF\_REGRIDMETHOD\_CONSERVE\_2ND}. @@ -1207,6 +1215,7 @@ subroutine ESMF_FieldRegridStoreNX(srcField, dstField, keywordEnforcer, & unmappedaction, localIgnoreDegenerate, & srcTermProcessing, pipeLineDepth, & routehandle, tmp_indices, tmp_weights, & + transposeRoutehandle, & unmappedDstList, & localCheckFlag, & localrc) @@ -1239,6 +1248,7 @@ subroutine ESMF_FieldRegridStoreNX(srcField, dstField, keywordEnforcer, & unmappedaction, localIgnoreDegenerate, & srcTermProcessing, pipeLineDepth, & routehandle, & + transposeRoutehandle=transposeRoutehandle, & unmappedDstList=unmappedDstList, & checkFlag=localCheckFlag, & rc=localrc) diff --git a/src/Infrastructure/Mesh/include/ESMCI_MeshCap.h b/src/Infrastructure/Mesh/include/ESMCI_MeshCap.h index 5bc2a27f5f..6ca8b729c7 100644 --- a/src/Infrastructure/Mesh/include/ESMCI_MeshCap.h +++ b/src/Infrastructure/Mesh/include/ESMCI_MeshCap.h @@ -285,8 +285,9 @@ namespace ESMCI { int *extrapNumInputLevels, int *unmappedaction, int *_ignoreDegenerate, int *srcTermProcessing, int *pipelineDepth, - ESMCI::RouteHandle **rh, int *has_rh, int *has_iw, - int *nentries, ESMCI::TempWeights **tweights, + ESMCI::RouteHandle **rh, int *has_rh, + int *has_iw,int *nentries, ESMCI::TempWeights **tweights, + ESMCI::RouteHandle **trh, int *has_trh, int *has_udl, int *_num_udl, ESMCI::TempUDL **_tudl, int *has_statusArray, ESMCI::Array **statusArray, int *checkFlag, diff --git a/src/Infrastructure/Mesh/include/ESMCI_Mesh_Regrid_Glue.h b/src/Infrastructure/Mesh/include/ESMCI_Mesh_Regrid_Glue.h index e03bf900a9..201bd2b2a8 100644 --- a/src/Infrastructure/Mesh/include/ESMCI_Mesh_Regrid_Glue.h +++ b/src/Infrastructure/Mesh/include/ESMCI_Mesh_Regrid_Glue.h @@ -62,8 +62,9 @@ void ESMCI_regrid_create(Mesh **meshsrcpp, ESMCI::Array **arraysrcpp, ESMCI::Poi int *extrapNumInputLevels, int *unmappedaction, int *_ignoreDegenerate, int *srcTermProcessing, int *pipelineDepth, - ESMCI::RouteHandle **rh, int *has_rh, int *has_iw, - int *nentries, ESMCI::TempWeights **tweights, + ESMCI::RouteHandle **rh, int *has_rh, + int *has_iw, int *nentries, ESMCI::TempWeights **tweights, + ESMCI::RouteHandle **trh, int *has_trh, int *has_udl, int *_num_udl, ESMCI::TempUDL **_tudl, int *has_statusArray, ESMCI::Array **statusArray, int *checkFlag, diff --git a/src/Infrastructure/Mesh/src/ESMCI_MeshCap.C b/src/Infrastructure/Mesh/src/ESMCI_MeshCap.C index 6fadeeaa7a..a6cf4ea4b0 100644 --- a/src/Infrastructure/Mesh/src/ESMCI_MeshCap.C +++ b/src/Infrastructure/Mesh/src/ESMCI_MeshCap.C @@ -1576,8 +1576,9 @@ void MeshCap::regrid_create( int *extrapNumInputLevels, int *unmappedaction, int *_ignoreDegenerate, int *srcTermProcessing, int *pipelineDepth, - ESMCI::RouteHandle **rh, int *has_rh, int *has_iw, - int *nentries, ESMCI::TempWeights **tweights, + ESMCI::RouteHandle **rh, int *has_rh, + int *has_iw, int *nentries, ESMCI::TempWeights **tweights, + ESMCI::RouteHandle **trh, int *has_trh, int *has_udl, int *_num_udl, ESMCI::TempUDL **_tudl, int *has_statusArray, ESMCI::Array **statusArray, int *checkFlag, @@ -1668,8 +1669,9 @@ void MeshCap::regrid_create( extrapNumInputLevels, unmappedaction, _ignoreDegenerate, srcTermProcessing, pipelineDepth, - rh, has_rh, has_iw, - nentries, tweights, + rh, has_rh, + has_iw, nentries, tweights, + trh, has_trh, has_udl, _num_udl, _tudl, has_statusArray, statusArray, checkFlag, diff --git a/src/Infrastructure/Mesh/src/ESMCI_Mesh_Regrid_Glue.C b/src/Infrastructure/Mesh/src/ESMCI_Mesh_Regrid_Glue.C index 982698e777..44404b1daf 100644 --- a/src/Infrastructure/Mesh/src/ESMCI_Mesh_Regrid_Glue.C +++ b/src/Infrastructure/Mesh/src/ESMCI_Mesh_Regrid_Glue.C @@ -99,8 +99,9 @@ void ESMCI_regrid_create( int *extrapNumInputLevels, int *unmappedaction, int *_ignoreDegenerate, int *srcTermProcessing, int *pipelineDepth, - ESMCI::RouteHandle **rh, int *has_rh, int *has_iw, - int *nentries, ESMCI::TempWeights **tweights, + ESMCI::RouteHandle **rh, int *has_rh, + int *has_iw, int *nentries, ESMCI::TempWeights **tweights, + ESMCI::RouteHandle **trh, int *has_trh, int *has_udl, int *_num_udl, ESMCI::TempUDL **_tudl, int *_has_statusArray, ESMCI::Array **_statusArray, int *_checkFlag, diff --git a/src/Infrastructure/Regrid/interface/ESMCI_Regrid_F.C b/src/Infrastructure/Regrid/interface/ESMCI_Regrid_F.C index deb33b93e9..8a1de18c87 100644 --- a/src/Infrastructure/Regrid/interface/ESMCI_Regrid_F.C +++ b/src/Infrastructure/Regrid/interface/ESMCI_Regrid_F.C @@ -66,6 +66,7 @@ extern "C" void FTN_X(c_esmc_regrid_create)(MeshCap **meshsrcpp, int *srcTermProcessing, int *pipelineDepth, ESMCI::RouteHandle **rh, int *has_rh, int *has_iw, int *nentries, ESMCI::TempWeights **tweights, + ESMCI::RouteHandle **trh, int *has_trh, int *has_udl, int *_num_udl, ESMCI::TempUDL **_tudl, int *has_statusArray, ESMCI::Array **statusArray, int *checkFlag, @@ -103,8 +104,9 @@ MeshCap::regrid_create(meshsrcpp, arraysrcpp, plsrcpp, extrapNumInputLevels, unmappedaction, _ignoreDegenerate, srcTermProcessing, pipelineDepth, - rh, has_rh, has_iw, - nentries, tweights, + rh, has_rh, + has_iw, nentries, tweights, + trh, has_trh, has_udl, _num_udl, _tudl, has_statusArray, statusArray, checkFlag, diff --git a/src/Infrastructure/Regrid/src/ESMF_Regrid.F90 b/src/Infrastructure/Regrid/src/ESMF_Regrid.F90 index 3ace9bbee7..636a4166e1 100644 --- a/src/Infrastructure/Regrid/src/ESMF_Regrid.F90 +++ b/src/Infrastructure/Regrid/src/ESMF_Regrid.F90 @@ -165,6 +165,7 @@ subroutine ESMF_RegridStore(srcMesh, srcArray, srcPointList, src_pl_used, & pipelineDepth, & routehandle, & indices, weights, & + transposeRoutehandle, & unmappedDstList, & checkFlag, & rc) @@ -194,6 +195,7 @@ subroutine ESMF_RegridStore(srcMesh, srcArray, srcPointList, src_pl_used, & integer, intent(inout), optional :: srcTermProcessing integer, intent(inout), optional :: pipelineDepth type(ESMF_RouteHandle), intent(inout), optional :: routehandle + type(ESMF_RouteHandle), intent(inout), optional :: transposeRoutehandle integer(ESMF_KIND_I4), pointer, optional :: indices(:,:) real(ESMF_KIND_R8), pointer, optional :: weights(:) integer(ESMF_KIND_I4), pointer, optional :: unmappedDstList(:) @@ -239,7 +241,7 @@ subroutine ESMF_RegridStore(srcMesh, srcArray, srcPointList, src_pl_used, & ! \end{description} !EOPI integer :: localrc - integer :: has_rh, has_iw, nentries + integer :: has_rh, has_trh, has_iw, nentries type(ESMF_TempWeights) :: tweights integer :: has_udl, num_udl type(ESMF_TempUDL) :: tudl @@ -262,7 +264,9 @@ subroutine ESMF_RegridStore(srcMesh, srcArray, srcPointList, src_pl_used, & endif ! Next, we require that the user request at least something - if (.not.(present(routehandle) .or. present(indices))) then + if (.not.(present(routehandle) .or. & + present(transposeRoutehandle) .or. & + present(indices))) then localrc = ESMF_RC_ARG_BAD if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return @@ -282,6 +286,10 @@ subroutine ESMF_RegridStore(srcMesh, srcArray, srcPointList, src_pl_used, & if (present(indices)) has_iw = 1 if (present(unmappedDstList)) has_udl = 1 + ! Record if transpose routehandle is present + has_trh = 0 + if (present(transposeRoutehandle)) has_trh = 1 + if (present(unmappedaction)) then localunmappedaction=unmappedaction else @@ -366,6 +374,7 @@ subroutine ESMF_RegridStore(srcMesh, srcArray, srcPointList, src_pl_used, & srcTermProcessing, pipelineDepth, & routehandle, has_rh, has_iw, & nentries, tweights, & + transposeRoutehandle, has_trh, & has_udl, num_udl, tudl, & has_statusArrayInt, statusArray, & checkFlagInt, & @@ -401,13 +410,20 @@ subroutine ESMF_RegridStore(srcMesh, srcArray, srcPointList, src_pl_used, & endif endif - ! Mark route handle created + ! Mark routeHandle created if (present(routeHandle)) then call ESMF_RouteHandleSetInitCreated(routeHandle, localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return endif + ! Mark transpose routeHandle created + if (present(transposeRoutehandle)) then + call ESMF_RouteHandleSetInitCreated(transposeRoutehandle, localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, rcToReturn=rc)) return + endif + rc = ESMF_SUCCESS end subroutine ESMF_RegridStore From 2f2f919d69e3d7aaa5d96e23aaf39690d538774b Mon Sep 17 00:00:00 2001 From: Robert Oehmke Date: Mon, 21 Oct 2024 12:17:16 -0600 Subject: [PATCH 076/207] Add initial version of transpose routeHandle code to regrid create. --- .../Mesh/src/ESMCI_Mesh_Regrid_Glue.C | 115 ++++++++++++++++-- 1 file changed, 105 insertions(+), 10 deletions(-) diff --git a/src/Infrastructure/Mesh/src/ESMCI_Mesh_Regrid_Glue.C b/src/Infrastructure/Mesh/src/ESMCI_Mesh_Regrid_Glue.C index 44404b1daf..f6a97675f5 100644 --- a/src/Infrastructure/Mesh/src/ESMCI_Mesh_Regrid_Glue.C +++ b/src/Infrastructure/Mesh/src/ESMCI_Mesh_Regrid_Glue.C @@ -613,6 +613,10 @@ void ESMCI_regrid_create( //TODO: also drop PointList objects here if possible to reduce Store() memory footrint #endif + + + //// Creation of routeHandle //// + #ifdef MEMLOG_on VM::logMemInfo(std::string("RegridCreate5.2")); #endif @@ -620,7 +624,7 @@ void ESMCI_regrid_create( ESMCI_REGRID_TRACE_ENTER("NativeMesh ArraySMMStore"); // Build the RouteHandle using ArraySMMStore() - if (*has_rh != 0) { + if (*has_rh) { // Set some flags enum ESMC_TypeKind_Flag tk = ESMC_TYPEKIND_R8; @@ -645,18 +649,99 @@ void ESMCI_regrid_create( ESMC_LogDefault.Write("c_esmc_regrid_create(): Returned from ArraySMMStore().", ESMC_LOGMSG_INFO); #endif + + + //// Creation of transpose routeHandle //// + #ifdef MEMLOG_on VM::logMemInfo(std::string("RegridCreate6.0")); #endif + + + // If requested, build the transpose RouteHandle using ArraySMMStore() + if (*has_trh) { - *nentries = num_entries; - // Clean up. If has_iw, then we will use the arrays to - // fill out the users pointers. These will be deleted following a copy. - if (*has_iw == 0) { - delete [] factors; - delete [] iientries; - *nentries = 0; - } else { + ESMCI_REGRID_TRACE_ENTER("NativeMesh Transpose ArraySMMStore"); + + // Allocate transpose matrix + int *transpose_iientries = new int[iientries_entry_size*num_entries]; + + // Init to beginning entries of factor index lists + int *entry=iientries; + int *t_entry=transpose_iientries; + + // Depending on size of matrix entries, loop constructing transpose matrix + if (iientries_entry_size == 2) { + + // Loop through entries + for (int i=0; i transpose_ii(transpose_iientries, 2, transpose_larg); + + // Call into Array sparse matrix multiply store to create RouteHandle + FTN_X(c_esmc_arraysmmstoreind4)(arraydstpp, arraysrcpp, trh, &tk, factors, + &num_entries, &transpose_ii, &ignoreUnmatched, + srcTermProcessing, pipelineDepth, &localrc); + if (ESMC_LogDefault.MsgFoundError(localrc, ESMCI_ERR_PASSTHRU, + ESMC_CONTEXT, NULL)) throw localrc; // bail out with exception + + // Get rid of transposed factor index list + delete [] transpose_iientries; + + ESMCI_REGRID_TRACE_EXIT("NativeMesh Transpose ArraySMMStore"); + +#ifdef PROGRESSLOG_on + ESMC_LogDefault.Write("c_esmc_regrid_create(): Returned from transpose ArraySMMStore().", ESMC_LOGMSG_INFO); +#endif + +#ifdef MEMLOG_on + VM::logMemInfo(std::string("RegridCreate7.0")); +#endif + } + + + + //// Output of weight matrix //// + + // If user has requested weights, then save them + if (*has_iw) { + // Record the number of entries + *nentries = num_entries; + // Save off the weights so the F90 caller can allocate arrays and // copy the values. if (num_entries>0) { @@ -669,11 +754,21 @@ void ESMCI_regrid_create( // Make sure copying method below takes this into account *tweights = NULL; } + + } else { //...else get rid of them + *nentries = 0; + delete [] factors; + delete [] iientries; } - // Setup structure to transfer unmappedDstList + + //// Handle output of unmapped destination list //// + + // Init info for transferring list *_num_udl=0; *_tudl=NULL; + + // If user wants umappedDstList, then setup structure to transfer it if (*has_udl) { // Get number of unmapped points int num_udl=unmappedDstList.size(); From 44adb0b171e1c8fd20896c61b39b7ebd509350ec Mon Sep 17 00:00:00 2001 From: Robert Oehmke Date: Mon, 21 Oct 2024 17:12:52 -0600 Subject: [PATCH 077/207] Fix ownership of nodes and elems. Add test for element coordinates. --- src/Infrastructure/Mesh/src/ESMCI_MeshDual.C | 88 +++ .../Mesh/tests/ESMF_MeshUTest.F90 | 655 +++++++++++++++++- 2 files changed, 737 insertions(+), 6 deletions(-) diff --git a/src/Infrastructure/Mesh/src/ESMCI_MeshDual.C b/src/Infrastructure/Mesh/src/ESMCI_MeshDual.C index 694863d730..76f53b0695 100644 --- a/src/Infrastructure/Mesh/src/ESMCI_MeshDual.C +++ b/src/Infrastructure/Mesh/src/ESMCI_MeshDual.C @@ -91,7 +91,11 @@ namespace ESMCI { void _change_owners_from_src_to_curr_comm(Mesh *dual_mesh, MPI_Comm src_comm); + void _set_elem_ownership_context_based_on_owned_pet(Mesh *dual_mesh); + void _set_node_ownership_context_based_on_owned_pet(Mesh *dual_mesh); + + // Create a dual of the input Mesh // This adds ghostcells to the input mesh, // it also creates ghostcells for the dual mesh @@ -926,6 +930,13 @@ void MeshDual(Mesh *src_mesh, Mesh **_dual_mesh) { // Change owners to be on the current communicator rather than the source mesh's communicator _change_owners_from_src_to_curr_comm(dual_mesh, src_mesh->orig_comm); + // Change context to match node PET ownership + _set_node_ownership_context_based_on_owned_pet(dual_mesh); + + // Change context to match elem PET ownership + _set_elem_ownership_context_based_on_owned_pet(dual_mesh); + + // Commit Mesh dual_mesh->build_sym_comm_rel(MeshObj::NODE); dual_mesh->Commit(); @@ -943,6 +954,83 @@ void MeshDual(Mesh *src_mesh, Mesh **_dual_mesh) { *_dual_mesh=dual_mesh; } + void _set_node_ownership_context_based_on_owned_pet(Mesh *dual_mesh) { + + //// Need to keep list of nodes because order may change + + // Reserve memory for list + std::vector node_list; + node_list.reserve(dual_mesh->num_nodes()); + + // Copy into list + MeshDB::iterator ei = dual_mesh->node_begin(), ee = dual_mesh->node_end(); + for (; ei != ee; ++ei) { + MeshObj &node=*ei; + + node_list.push_back(&node); + } + + // Loop setting owner and OWNER_ID + for (MeshObj *node : node_list) { + + // Setup for changing attribute + const Context &ctxt = GetMeshObjContext(*node); + Context newctxt(ctxt); + + // Set OWNED_ID appropriately + if (node->get_owner() == Par::Rank()) { + newctxt.set(Attr::OWNED_ID); + } else { + newctxt.clear(Attr::OWNED_ID); + } + + // If attribute has changed change in node + if (newctxt != ctxt) { + Attr attr(GetAttr(*node), newctxt); + dual_mesh->update_obj(node, attr); + } + } + } + + + void _set_elem_ownership_context_based_on_owned_pet(Mesh *dual_mesh) { + + //// Need to keep list of elems because order may change + + // Reserve memory for list + std::vector elem_list; + elem_list.reserve(dual_mesh->num_elems()); + + // Copy into list + MeshDB::iterator ei = dual_mesh->elem_begin(), ee = dual_mesh->elem_end(); + for (; ei != ee; ++ei) { + MeshObj &elem=*ei; + + elem_list.push_back(&elem); + } + + // Loop setting owner and OWNER_ID + for (MeshObj *elem : elem_list) { + + // Setup for changing attribute + const Context &ctxt = GetMeshObjContext(*elem); + Context newctxt(ctxt); + + // Set OWNED_ID appropriately + if (elem->get_owner() == Par::Rank()) { + newctxt.set(Attr::OWNED_ID); + } else { + newctxt.clear(Attr::OWNED_ID); + } + + // If attribute has changed change in elem + if (newctxt != ctxt) { + Attr attr(GetAttr(*elem), newctxt); + dual_mesh->update_obj(elem, attr); + } + } + } + void _change_owners_from_src_to_curr_comm(Mesh *dual_mesh, MPI_Comm src_comm) { diff --git a/src/Infrastructure/Mesh/tests/ESMF_MeshUTest.F90 b/src/Infrastructure/Mesh/tests/ESMF_MeshUTest.F90 index 656735a55e..515f163475 100644 --- a/src/Infrastructure/Mesh/tests/ESMF_MeshUTest.F90 +++ b/src/Infrastructure/Mesh/tests/ESMF_MeshUTest.F90 @@ -118,7 +118,7 @@ program ESMF_MeshUTest ! This surrounds all the tests to make turning off everything but one test easier -#if 1 +#if 0 !------------------------------------------------------------------------ @@ -2036,6 +2036,24 @@ program ESMF_MeshUTest call ESMF_Test(((rc .eq. ESMF_SUCCESS) .and. correct), name, failMsg, result, ESMF_SRCLINE) !----------------------------------------------------------------------------- +#endif + !----------------------------------------------------------------------------- + !NEX_UTest + write(name, *) "Mesh Create Dual with checking of element coords and masking" + write(failMsg, *) "Did not return ESMF_SUCCESS" + + ! initialize check variables + correct=.true. + rc=ESMF_SUCCESS + + ! Create Test mesh + call exhaustiveMeshDualTest(correct, rc=localrc) + if (localrc .ne. ESMF_SUCCESS) rc=ESMF_FAILURE + + call ESMF_Test(((rc .eq. ESMF_SUCCESS) .and. correct), name, failMsg, result, ESMF_SRCLINE) + !----------------------------------------------------------------------------- + +#if 0 !----------------------------------------------------------------------------- !NEX_UTest write(name, *) "Mesh Create and then Redist with a pentagon and hexagon element" @@ -2534,11 +2552,10 @@ program ESMF_MeshUTest rc=localrc) if (localrc .ne. ESMF_SUCCESS) rc=ESMF_FAILURE - - call ESMF_MeshWriteVTK(mesh, "elemArrayTst", & - elemArray1=maskArray, elemArray2=areaArray, & - rc=localrc) - if (localrc .ne. ESMF_SUCCESS) rc=ESMF_FAILURE +! call ESMF_MeshWriteVTK(mesh, "elemArrayTst", & +! elemArray1=maskArray, elemArray2=areaArray, & +! rc=localrc) +! if (localrc .ne. ESMF_SUCCESS) rc=ESMF_FAILURE ! get pointer to mask @@ -8250,6 +8267,632 @@ subroutine test_optionalNodeOwners(correct, rc) end subroutine test_optionalNodeOwners + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + ! + ! Creates the following mesh on + ! 1 or 4 PETs. Returns an error + ! if run on other than 1 or 4 PETs + ! + ! Mesh Ids + ! + ! 3.0 13 ------ 14 ------- 15 ------- 16 + ! | | | | + ! 2.5 | 7 | 8 | 9 | + ! | | | | + ! 2.0 9 ------- 10 ------- 11 ------- 12 + ! | | | | + ! 1.5 | 4 | 5 | 6 | + ! | | | | + ! 1.0 5 ------- 6 -------- 7 -------- 8 + ! | | | | + ! 0.5 | 1 | 2 | 3 | + ! | | | | + ! 0.0 1 ------- 2 -------- 3 -------- 4 + ! + ! 0.0 0.5 1.0 1.5 2.0 2.5 3.0 + ! + ! Node Ids at corners + ! Element Ids in centers + ! + !!!!! + ! + ! The owners for 1 PET are all Pet 0. + ! The owners for 4 PETs are as follows: + ! + ! Mesh Owners + ! + ! 3.0 2 ------- 2 -------- 3 -------- 3 + ! | | | | + ! | 2 | 2 | 3 | + ! | | | | + ! 2.0 2 ------- 2 -------- 3 -------- 3 + ! | | | | + ! | 2 | 2 | 3 | + ! | | | | + ! 1.0 0 ------- 0 -------- 1 -------- 1 + ! | | | | + ! | 0 | 1 | 1 | + ! | | | | + ! 0.0 0 ------- 0 -------- 1 -------- 1 + ! + ! 0.0 1.0 2.0 3.0 + ! + ! Node Owners at corners + ! Element Owners in centers + ! + +subroutine exhaustiveMeshDualTest(correct, rc) + logical :: correct + integer :: rc + + type(ESMF_Mesh):: mesh, dualMesh + integer, pointer :: nodeIds(:),nodeOwners(:),nodeMask(:),nodeIdsTst(:) + real(ESMF_KIND_R8), pointer :: nodeCoords(:), nodeCoordsTst(:) + real(ESMF_KIND_R8), pointer :: ownedNodeCoords(:) + integer :: numNodes, numOwnedNodes, numOwnedNodesTst + integer :: numElems,numOwnedElemsTst + integer :: numElemConns, numTriElems, numQuadElems + real(ESMF_KIND_R8), pointer :: elemCoords(:), elemCoordsTst(:) + integer, pointer :: elemIds(:),elemTypes(:),elemConn(:),elemMask(:), elemIdsTst(:) + integer :: petCount, localPet + type(ESMF_VM) :: vm + integer :: numOwnedElems + + ! get global VM + call ESMF_VMGetGlobal(vm, rc=rc) + if (rc /= ESMF_SUCCESS) return + call ESMF_VMGet(vm, localPet=localPet, petCount=petCount, rc=rc) + if (rc /= ESMF_SUCCESS) return + + ! return with an error if not 1 or 4 PETs + if ((petCount /= 1) .and. (petCount /=4)) then + rc=ESMF_FAILURE + return + endif + + + ! Setup mesh info depending on the + ! number of PETs + if (petCount .eq. 1) then + + ! Fill in node data + numNodes=16 + + !! node ids + allocate(nodeIds(numNodes)) + nodeIds=(/1,2,3,4,5,6,7,8, & + 9,10,11,12,13,14,& + 15,16/) + + !! node Coords + allocate(nodeCoords(numNodes*2)) + nodeCoords=(/0.0,0.0, & ! 1 + 1.0,0.0, & ! 2 + 2.0,0.0, & ! 3 + 3.0,0.0, & ! 4 + 0.0,1.0, & ! 5 + 1.0,1.0, & ! 6 + 2.0,1.0, & ! 7 + 3.0,1.0, & ! 8 + 0.0,2.0, & ! 9 + 1.0,2.0, & ! 10 + 2.0,2.0, & ! 11 + 3.0,2.0, & ! 12 + 0.0,3.0, & ! 13 + 1.0,3.0, & ! 14 + 2.0,3.0, & ! 15 + 3.0,3.0 /) ! 16 + + + !! node owners + allocate(nodeOwners(numNodes)) + nodeOwners=0 ! everything on proc 0 + + + ! Fill in elem data + numTriElems=0 + numQuadElems=9 + numElems=numTriElems+numQuadElems + numElemConns=3*numTriElems+4*numQuadElems + + !! elem ids + allocate(elemIds(numElems)) + elemIds=(/1,2,3,4,5,6,7,8,9/) + + !! elem types + allocate(elemTypes(numElems)) + elemTypes=(/ESMF_MESHELEMTYPE_QUAD, & ! 1 + ESMF_MESHELEMTYPE_QUAD, & ! 2 + ESMF_MESHELEMTYPE_QUAD, & ! 3 + ESMF_MESHELEMTYPE_QUAD, & ! 4 + ESMF_MESHELEMTYPE_QUAD, & ! 5 + ESMF_MESHELEMTYPE_QUAD, & ! 6 + ESMF_MESHELEMTYPE_QUAD, & ! 7 + ESMF_MESHELEMTYPE_QUAD, & ! 8 + ESMF_MESHELEMTYPE_QUAD/) ! 9 + + !! elem coords + allocate(elemCoords(2*numElems)) + elemCoords=(/0.5,0.5, & ! 1 + 1.5,0.5, & ! 2 + 2.5,0.5, & ! 3 + 0.5,1.5, & ! 4 + 1.5,1.5, & ! 5 + 2.5,1.5, & ! 6 + 0.5,2.5, & ! 7 + 1.5,2.5, & ! 8 + 2.5,2.5/) ! 9 + + !! elem conn + allocate(elemConn(numElemConns)) + elemConn=(/1,2,6,5, & ! 1 + 2,3,7,6, & ! 2 + 3,4,8,7, & ! 3 + 5,6,10,9, & ! 4 + 6,7,11,10, & ! 5 + 7,8,12,11, & ! 6 + 9,10,14,13, & ! 7 + 10,11,15,14, & ! 8 + 11,12,16,15/) ! 9 + + else if (petCount .eq. 4) then + ! Setup mesh data depending on PET + if (localPet .eq. 0) then + + ! Fill in node data + numNodes=4 + + !! node ids + allocate(nodeIds(numNodes)) + nodeIds=(/1,2,5,6/) + + !! node Coords + allocate(nodeCoords(numNodes*2)) + nodeCoords=(/0.0,0.0, & ! 1 + 1.0,0.0, & ! 2 + 0.0,1.0, & ! 5 + 1.0,1.0 /) ! 6 + + !! node owners + allocate(nodeOwners(numNodes)) + nodeOwners=0 ! everything on proc 0 + + ! Fill in elem data + numTriElems=0 + numQuadElems=1 + numElems=numTriElems+numQuadElems + numElemConns=3*numTriElems+4*numQuadElems + + !! elem ids + allocate(elemIds(numElems)) + elemIds=(/1/) + + !! elem types + allocate(elemTypes(numElems)) + elemTypes=(/ESMF_MESHELEMTYPE_QUAD/) ! 1 + + !! elem coords + allocate(elemCoords(2*numElems)) + elemCoords=(/0.5,0.5/) ! 1 + + !! elem conn + allocate(elemConn(numElemConns)) + elemConn=(/1,2,4,3/) ! 1 + + else if (localPet .eq. 1) then + + ! Fill in node data + numNodes=6 + + !! node ids + allocate(nodeIds(numNodes)) + nodeIds=(/2,3,4,6,7,8/) + + !! node Coords + allocate(nodeCoords(numNodes*2)) + nodeCoords=(/1.0,0.0, & ! 2 + 2.0,0.0, & ! 3 + 3.0,0.0, & ! 4 + 1.0,1.0, & ! 6 + 2.0,1.0, & ! 7 + 3.0,1.0 /) ! 8 + + + + !! node owners + allocate(nodeOwners(numNodes)) + nodeOwners=(/0, & ! 2 + 1, & ! 3 + 1, & ! 4 + 0, & ! 6 + 1, & ! 7 + 1/) ! 8 + + ! Fill in elem data + numTriElems=0 + numQuadElems=2 + numElems=numTriElems+numQuadElems + numElemConns=3*numTriElems+4*numQuadElems + + !! elem ids + allocate(elemIds(numElems)) + elemIds=(/2,3/) + + !! elem types + allocate(elemTypes(numElems)) + elemTypes=(/ESMF_MESHELEMTYPE_QUAD, & ! 2 + ESMF_MESHELEMTYPE_QUAD/) ! 3 + + !! elem coords + allocate(elemCoords(2*numElems)) + elemCoords=(/1.5,0.5, & ! 2 + 2.5,0.5/) ! 3 + + + !! elem conn + allocate(elemConn(numElemConns)) + elemConn=(/1,2,5,4, & ! 2 + 2,3,6,5/) ! 3 + + else if (localPet .eq. 2) then + + ! Fill in node data + numNodes=9 + + !! node ids + allocate(nodeIds(numNodes)) + nodeIds=(/5,6,7, & + 9,10,11, & + 13,14,15/) + + + !! node Coords + allocate(nodeCoords(numNodes*2)) + nodeCoords=(/0.0,1.0, & ! 5 + 1.0,1.0, & ! 6 + 2.0,1.0, & ! 7 + 0.0,2.0, & ! 9 + 1.0,2.0, & ! 10 + 2.0,2.0, & ! 11 + 0.0,3.0, & ! 13 + 1.0,3.0, & ! 14 + 2.0,3.0/) ! 15 + + + !! node owners + allocate(nodeOwners(numNodes)) + nodeOwners=(/0, & ! 5 + 0, & ! 6 + 1, & ! 7 + 2, & ! 9 + 2, & ! 10 + 3, & ! 11 + 2, & ! 13 + 2, & ! 14 + 3/) ! 15 + + + ! Fill in elem data + numTriElems=0 + numQuadElems=4 + numElems=numTriElems+numQuadElems + numElemConns=3*numTriElems+4*numQuadElems + + !! elem ids + allocate(elemIds(numElems)) + elemIds=(/4,5,7,8/) + + !! elem types + allocate(elemTypes(numElems)) + elemTypes=(/ESMF_MESHELEMTYPE_QUAD, & ! 4 + ESMF_MESHELEMTYPE_QUAD, & ! 5 + ESMF_MESHELEMTYPE_QUAD, & ! 7 + ESMF_MESHELEMTYPE_QUAD/) ! 8 + + + !! elem coords + allocate(elemCoords(2*numElems)) + elemCoords=(/0.5,1.5, & ! 4 + 1.5,1.5, & ! 5 + 0.5,2.5, & ! 7 + 1.5,2.5/) ! 8 + + !! elem conn + allocate(elemConn(numElemConns)) + elemConn=(/1,2,5,4, & ! 4 + 2,3,6,5, & ! 5 + 4,5,8,7, & ! 7 + 5,6,9,8/) ! 8 + else if (localPet .eq. 3) then + + ! Fill in node data + numNodes=6 + + !! node ids + allocate(nodeIds(numNodes)) + nodeIds=(/7,8,11,12,15,16/) + + !! node Coords + allocate(nodeCoords(numNodes*2)) + nodeCoords=(/2.0,1.0, & ! 7 + 3.0,1.0, & ! 8 + 2.0,2.0, & ! 11 + 3.0,2.0, & ! 12 + 2.0,3.0, & ! 15 + 3.0,3.0 /) ! 16 + + + !! node owners + allocate(nodeOwners(numNodes)) + nodeOwners=(/1, & ! 7 + 1, & ! 8 + 3, & ! 11 + 3, & ! 12 + 3, & ! 15 + 3/) ! 16 + + ! Fill in elem data + numTriElems=0 + numQuadElems=2 + numElems=numTriElems+numQuadElems + numElemConns=3*numTriElems+4*numQuadElems + + !! elem ids + allocate(elemIds(numElems)) + elemIds=(/6,9/) + + !! elem types + allocate(elemTypes(numElems)) + elemTypes=(/ESMF_MESHELEMTYPE_QUAD, & ! 6 + ESMF_MESHELEMTYPE_QUAD/) ! 9 + + !! elem coords + allocate(elemCoords(2*numElems)) + elemCoords=(/2.5,1.5, & ! 6 + 2.5,2.5/) ! 9 + + !! elem conn + allocate(elemConn(numElemConns)) + elemConn=(/1,2,4,3, & ! 6 + 3,4,6,5/) ! 9 + endif + endif + + + ! Create Mesh structure in 1 step + mesh=ESMF_MeshCreate(parametricDim=2,spatialDim=2, & + coordSys=ESMF_COORDSYS_SPH_DEG, & + nodeIds=nodeIds, nodeCoords=nodeCoords, & + nodeOwners=nodeOwners, elementIds=elemIds,& + elementTypes=elemTypes, elementConn=elemConn, & + elementCoords=elemCoords, & + rc=rc) + if (rc /= ESMF_SUCCESS) return + + ! deallocate node data + deallocate(nodeIds) + deallocate(nodeCoords) + deallocate(nodeOwners) + + ! deallocate elem data + deallocate(elemIds) + deallocate(elemTypes) + deallocate(elemCoords) + deallocate(elemConn) + + ! Create Dual Mesh + dualMesh=ESMF_MeshCreateDual(mesh, rc=rc) + if (rc /= ESMF_SUCCESS) return + + + call ESMF_MeshWrite(dualMesh, "dualMesh", rc=rc) + + ! Init correct + correct=.true. + + ! Get count info from dual + call ESMF_MeshGet(dualMesh, & + nodeCount=numNodes, & + elementCount=numElems, & + elementConnCount=numElemConns, & + numOwnedNodes=numOwnedNodes, & + numOwnedElements=numOwnedElems, & + rc=rc) + if (rc /= ESMF_SUCCESS) return + + ! ! DEBUG OUTPUT + ! write(*,*) localPEt,"# numNodes=",numNodes + ! write(*,*) localPEt,"# numElems=",numElems + ! write(*,*) localPEt,"# numElemConns=",numElemConns + ! write(*,*) localPEt,"# numOwnedNodes=",numOwnedNodes + ! write(*,*) localPEt,"# numOwnedElems=",numOwnedElems + + + ! Allocate space for arrays + allocate(nodeIds(numNodes)) + allocate(nodeIdsTst(numNodes)) + allocate(nodeCoords(2*numNodes)) + allocate(nodeCoordsTst(2*numNodes)) + allocate(nodeMask(numNodes)) + allocate(elemIds(numElems)) + allocate(elemIdsTst(numElems)) + allocate(elemMask(numElems)) + allocate(elemCoords(2*numElems)) + allocate(elemCoordsTst(2*numElems)) + + ! Get count info from dual + call ESMF_MeshGet(dualMesh, & + nodeIds=nodeIds, & + nodeCoords=nodeCoords, & +! nodeMask=nodeMask, & + elementIds=elemIds, & +! elementMask=elemMask, & + elementCoords=elemCoords, & + rc=rc) + if (rc /= ESMF_SUCCESS) return + + ! ! DEBUG OUTPUT + ! write(*,*) localPet,"# nodeIds=",nodeIds + ! write(*,*) localPet,"# nodeCoords=",nodeCoords + ! write(*,*) localPet,"# elemIds=",elemIds + ! write(*,*) localPet,"# elemCoords=",elemCoords + + + ! Check based on PetCount + if (petCount == 1) then + + ! Check Counts + if (numNodes /= 9) correct=.false. + if (numElems /= 4) correct=.false. + if (numElemConns /= 16) correct=.false. + if (numOwnedNodes /= 9) correct=.false. + if (numOwnedElems /= 4) correct=.false. + + ! Check node ids and coords + nodeIdsTst=(/1, 2, 3, 4, 5, 6, 7, 8, 9/) + nodeCoordsTst=(/0.50, 0.50, 1.5, 0.50, 2.5, 0.50, 0.50, 1.5, 1.5, 1.5, 2.5, 1.5, 0.50, 2.5, 1.5, 2.5, 2.5, 2.5/) + do i=1,numNodes + if (nodeIdsTst(i) /= nodeIds(i)) correct=.false. + if (nodeCoordsTst(2*i-1) /= nodeCoords(2*i-1)) correct=.false. + if (nodeCoordsTst(2*i) /= nodeCoords(2*i)) correct=.false. + enddo + + ! Check elem ids and coords + elemIdsTst=(/6, 7, 10, 11/) + elemCoordsTst=(/1.0, 1.0, 2.0, 1.0, 1.0, 2.0, 2.0, 2.0/) + do i=1,numElems + if (elemIdsTst(i) /= elemIds(i)) correct=.false. + if (elemCoordsTst(2*i-1) /= elemCoords(2*i-1)) correct=.false. + if (elemCoordsTst(2*i) /= elemCoords(2*i)) correct=.false. + enddo + + + else if (petCount == 4) then + if (localPet == 0) then + + ! Check Counts + if (numNodes /= 4) correct=.false. + if (numElems /= 1) correct=.false. + if (numElemConns /= 4) correct=.false. + if (numOwnedNodes /= 1) correct=.false. + if (numOwnedElems /= 1) correct=.false. + + ! Check node ids and coords + nodeIdsTst=(/1, 2, 4, 5/) + nodeCoordsTst=(/0.5, 0.5, 1.5, 0.5, 0.5, 1.5, 1.5, 1.5/) + do i=1,numNodes + if (nodeCoordsTst(2*i-1) /= nodeCoords(2*i-1)) correct=.false. + if (nodeCoordsTst(2*i) /= nodeCoords(2*i)) correct=.false. + enddo + + ! Check elem ids and coords + elemIdsTst=(/6/) + elemCoordsTst=(/1.0, 1.0/) + do i=1,numElems + if (elemIdsTst(i) /= elemIds(i)) correct=.false. + if (elemCoordsTst(2*i-1) /= elemCoords(2*i-1)) correct=.false. + if (elemCoordsTst(2*i) /= elemCoords(2*i)) correct=.false. + enddo + + else if (localPet == 1) then + + ! Check Counts + if (numNodes /= 6) correct=.false. + if (numElems /= 2) correct=.false. + if (numElemConns /= 8) correct=.false. + if (numOwnedNodes /= 2) correct=.false. + if (numOwnedElems /= 1) correct=.false. + + ! Check node ids and coords + nodeIdsTst=(/2, 3, 1, 4, 5, 6/) + nodeCoordsTst=(/1.5, 0.50, 2.5, 0.50, 0.50, 0.50, 0.50, 1.5, 1.5, 1.5, 2.5, 1.5/) + do i=1,numNodes + if (nodeCoordsTst(2*i-1) /= nodeCoords(2*i-1)) correct=.false. + if (nodeCoordsTst(2*i) /= nodeCoords(2*i)) correct=.false. + enddo + + ! Check elem ids and coords + elemIdsTst=(/7,6/) + elemCoordsTst=(/2.0, 1.0, 1.0, 1.0/) + do i=1,numElems + if (elemIdsTst(i) /= elemIds(i)) correct=.false. + if (elemCoordsTst(2*i-1) /= elemCoords(2*i-1)) correct=.false. + if (elemCoordsTst(2*i) /= elemCoords(2*i)) correct=.false. + enddo + + else if (localPet == 2) then + + ! Check Counts + if (numNodes /= 9) correct=.false. + if (numElems /= 4) correct=.false. + if (numElemConns /= 16) correct=.false. + if (numOwnedNodes /= 4) correct=.false. + if (numOwnedElems /= 1) correct=.false. + + ! Check node ids and coords + nodeIdsTst=(/4, 5, 7, 8, 1, 2, 3, 6, 9/) + nodeCoordsTst=(/0.50, 1.5, 1.5, 1.5, 0.50, 2.5, 1.5, 2.5, 0.50, 0.50, 1.5, 0.50, 2.5, 0.50, 2.5, 1.5, 2.5, 2.5/) + do i=1,numNodes + if (nodeCoordsTst(2*i-1) /= nodeCoords(2*i-1)) correct=.false. + if (nodeCoordsTst(2*i) /= nodeCoords(2*i)) correct=.false. + enddo + + ! Check elem ids and coords + elemIdsTst=(/10, 6, 7, 11/) + elemCoordsTst=(/1.0, 2.0, 1.0, 1.0, 2.0, 1.0, 2.0, 2.0/) + do i=1,numElems + if (elemIdsTst(i) /= elemIds(i)) correct=.false. + if (elemCoordsTst(2*i-1) /= elemCoords(2*i-1)) correct=.false. + if (elemCoordsTst(2*i) /= elemCoords(2*i)) correct=.false. + enddo + + else if (localPet == 3) then + + ! Check Counts + if (numNodes /= 6) correct=.false. + if (numElems /= 2) correct=.false. + if (numElemConns /= 8) correct=.false. + if (numOwnedNodes /= 2) correct=.false. + if (numOwnedElems /= 1) correct=.false. + + ! Check node ids and coords + nodeIdsTst=(/6, 9, 2, 3, 5, 8/) + nodeCoordsTst=(/2.50, 1.50, 2.50, 2.50, 1.50, 0.500, 2.50, 0.500, 1.50, 1.50, 1.50, 2.5/) + do i=1,numNodes + if (nodeCoordsTst(2*i-1) /= nodeCoords(2*i-1)) correct=.false. + if (nodeCoordsTst(2*i) /= nodeCoords(2*i)) correct=.false. + enddo + + ! Check elem ids and coords + elemIdsTst=(/11, 7/) + elemCoordsTst=(/2.0, 2.0, 2.0, 1.0/) + do i=1,numElems + if (elemIdsTst(i) /= elemIds(i)) correct=.false. + if (elemCoordsTst(2*i-1) /= elemCoords(2*i-1)) correct=.false. + if (elemCoordsTst(2*i) /= elemCoords(2*i)) correct=.false. + enddo + + else + rc=ESMF_FAILURE + return + endif + else + rc=ESMF_FAILURE + return + endif + + + ! Destroy meshes + call ESMF_MeshDestroy(dualMesh, rc=rc) + if (rc /= ESMF_SUCCESS) return + + call ESMF_MeshDestroy(mesh, rc=rc) + if (rc /= ESMF_SUCCESS) return + + +end subroutine exhaustiveMeshDualTest + + end program ESMF_MeshUTest From a3f4eff9c84bada07f23222122f109d62d1572db Mon Sep 17 00:00:00 2001 From: Robert Oehmke Date: Mon, 21 Oct 2024 17:35:56 -0600 Subject: [PATCH 078/207] Turn tests back on. --- .../Mesh/tests/ESMF_MeshUTest.F90 | 21 +++++++++++++++---- 1 file changed, 17 insertions(+), 4 deletions(-) diff --git a/src/Infrastructure/Mesh/tests/ESMF_MeshUTest.F90 b/src/Infrastructure/Mesh/tests/ESMF_MeshUTest.F90 index 515f163475..9016ae4288 100644 --- a/src/Infrastructure/Mesh/tests/ESMF_MeshUTest.F90 +++ b/src/Infrastructure/Mesh/tests/ESMF_MeshUTest.F90 @@ -118,7 +118,7 @@ program ESMF_MeshUTest ! This surrounds all the tests to make turning off everything but one test easier -#if 0 +#if 1 !------------------------------------------------------------------------ @@ -2053,7 +2053,7 @@ program ESMF_MeshUTest call ESMF_Test(((rc .eq. ESMF_SUCCESS) .and. correct), name, failMsg, result, ESMF_SRCLINE) !----------------------------------------------------------------------------- -#if 0 +#if 1 !----------------------------------------------------------------------------- !NEX_UTest write(name, *) "Mesh Create and then Redist with a pentagon and hexagon element" @@ -8364,6 +8364,7 @@ subroutine exhaustiveMeshDualTest(correct, rc) 9,10,11,12,13,14,& 15,16/) + !! node Coords allocate(nodeCoords(numNodes*2)) nodeCoords=(/0.0,0.0, & ! 1 @@ -8391,7 +8392,7 @@ subroutine exhaustiveMeshDualTest(correct, rc) ! Fill in elem data numTriElems=0 - numQuadElems=9 + numQuadElems=9 numElems=numTriElems+numQuadElems numElemConns=3*numTriElems+4*numQuadElems @@ -8880,8 +8881,20 @@ subroutine exhaustiveMeshDualTest(correct, rc) rc=ESMF_FAILURE return endif - + ! Deallocate + deallocate(nodeIds) + deallocate(nodeIdsTst) + deallocate(nodeCoords) + deallocate(nodeCoordsTst) + deallocate(nodeMask) + deallocate(elemIds) + deallocate(elemIdsTst) + deallocate(elemMask) + deallocate(elemCoords) + deallocate(elemCoordsTst) + + ! Destroy meshes call ESMF_MeshDestroy(dualMesh, rc=rc) if (rc /= ESMF_SUCCESS) return From 56edd9cd505c46a305602831ebda16bfc273b99a Mon Sep 17 00:00:00 2001 From: Gerhard Theurich Date: Thu, 24 Oct 2024 12:54:25 -0400 Subject: [PATCH 079/207] Compiles and links in MPIUNI mode on Discover with LLVM 20.0.0 Git hash 697744d. --- .../Linux.llvm.default/build_rules.mk | 76 ++++++------------- 1 file changed, 23 insertions(+), 53 deletions(-) diff --git a/build_config/Linux.llvm.default/build_rules.mk b/build_config/Linux.llvm.default/build_rules.mk index dd0b64ccde..b8ef8a125f 100644 --- a/build_config/Linux.llvm.default/build_rules.mk +++ b/build_config/Linux.llvm.default/build_rules.mk @@ -78,15 +78,6 @@ ESMF_CDEFAULT = mpicc ESMF_MPIRUNDEFAULT = mpirun $(ESMF_MPILAUNCHOPTIONS) ESMF_MPIMPMDRUNDEFAULT = mpiexec $(ESMF_MPILAUNCHOPTIONS) else -ifeq ($(ESMF_COMM),lam) -# LAM (assumed to be built with flang-new) ----------------------- -ESMF_CXXCOMPILECPPFLAGS+= -DESMF_NO_SIGUSR2 -ESMF_F90DEFAULT = mpif77 -ESMF_CXXDEFAULT = mpic++ -ESMF_CDEFAULT = mpicc -ESMF_MPIRUNDEFAULT = mpirun $(ESMF_MPILAUNCHOPTIONS) -ESMF_MPIMPMDRUNDEFAULT = mpiexec $(ESMF_MPILAUNCHOPTIONS) -else ifeq ($(ESMF_COMM),openmpi) # OpenMPI -------------------------------------------------- ifeq ($(shell $(ESMF_DIR)/scripts/available mpifort),mpifort) @@ -114,7 +105,6 @@ endif endif endif endif -endif ############################################################ # Print compiler version string @@ -126,7 +116,7 @@ ESMF_CCOMPILER_VERSION = ${ESMF_CCOMPILER} -v --version ############################################################ # Special debug flags # -ESMF_F90OPTFLAG_G += +ESMF_F90OPTFLAG_G += ############################################################ # Fortran symbol convention @@ -178,31 +168,31 @@ ESMF_CXXCOMPILEOPTS += -m32 ESMF_CXXLINKOPTS += -m32 ESMF_CCOMPILEOPTS += -m32 ESMF_CLINKOPTS += -m32 -ESMF_F90COMPILEOPTS += -m32 -ESMF_F90LINKOPTS += -m32 +ESMF_F90COMPILEOPTS += +ESMF_F90LINKOPTS += endif ifeq ($(ESMF_ABISTRING),x86_64_small) ESMF_CXXCOMPILEOPTS += -m64 -mcmodel=small ESMF_CXXLINKOPTS += -m64 -mcmodel=small ESMF_CCOMPILEOPTS += -m64 -mcmodel=small ESMF_CLINKOPTS += -m64 -mcmodel=small -ESMF_F90COMPILEOPTS += -m64 -mcmodel=small -ESMF_F90LINKOPTS += -m64 -mcmodel=small +ESMF_F90COMPILEOPTS += +ESMF_F90LINKOPTS += endif ifeq ($(ESMF_ABISTRING),x86_64_medium) ESMF_CXXCOMPILEOPTS += -m64 -mcmodel=medium ESMF_CXXLINKOPTS += -m64 -mcmodel=medium ESMF_CCOMPILEOPTS += -m64 -mcmodel=medium ESMF_CLINKOPTS += -m64 -mcmodel=medium -ESMF_F90COMPILEOPTS += -m64 -mcmodel=medium -ESMF_F90LINKOPTS += -m64 -mcmodel=medium +ESMF_F90COMPILEOPTS += +ESMF_F90LINKOPTS += endif ############################################################ # Conditionally add pthread compiler and linker flags # ifeq ($(ESMF_PTHREADS),ON) -ESMF_F90COMPILEOPTS += -pthread +ESMF_F90COMPILEOPTS += ESMF_CXXCOMPILEOPTS += -pthread ESMF_CCOMPILEOPTS += -pthread ESMF_F90LINKOPTS += -pthread @@ -213,22 +203,26 @@ endif ############################################################ # OpenMP compiler and linker flags # -ESMF_OPENMP=OFF -# ESMF_OPENMP_F90COMPILEOPTS += -fopenmp -# ESMF_OPENMP_CXXCOMPILEOPTS += -fopenmp -# ESMF_OPENMP_F90LINKOPTS += -fopenmp -# ESMF_OPENMP_CXXLINKOPTS += -fopenmp +ESMF_OPENMPDEFAULT = OFF +ESMF_OPENMP_F90COMPILEOPTS += -fopenmp +ESMF_OPENMP_CXXCOMPILEOPTS += -fopenmp +ESMF_OPENMP_F90LINKOPTS += -fopenmp +ESMF_OPENMP_CXXLINKOPTS += -fopenmp ############################################################ -# Need this until the file convention is fixed (then remove these two lines) +# OpenACC compiler and linker flags # -ESMF_F90COMPILEFREENOCPP = -ffree-form -ESMF_F90COMPILEFIXCPP = -cpp -ffixed-form +ESMF_OPENACCDEFAULT = OFF +ESMF_OPENACC_F90COMPILEOPTS += -fopenacc +ESMF_OPENACC_CXXCOMPILEOPTS += -fopenacc +ESMF_OPENACC_F90LINKOPTS += -fopenacc +ESMF_OPENACC_CXXLINKOPTS += -fopenacc ############################################################ -# Set unlimited line length limit for free format files +# Need this until the file convention is fixed (then remove these two lines) # -ESMF_F90COMPILEOPTS += -ffree-line-length-none +ESMF_F90COMPILEFREENOCPP = -ffree-form +ESMF_F90COMPILEFIXCPP = -cpp -ffixed-form ############################################################ # Set rpath syntax @@ -237,30 +231,6 @@ ESMF_F90RPATHPREFIX = -Wl,-rpath, ESMF_CXXRPATHPREFIX = -Wl,-rpath, ESMF_CRPATHPREFIX = -Wl,-rpath, -############################################################ -# Determine where gcc's libraries are located -# -# Note that the result of -print-file-name will be the full path to the file if it is found -# within the compiler installation, and simply the file name verbatim if it is NOT found. -ESMF_LIBSTDCXX := $(shell $(ESMF_CXXCOMPILER) $(ESMF_CXXCOMPILEOPTS) -print-file-name=libstdc++.so) -ifeq ($(ESMF_LIBSTDCXX),libstdc++.so) -ESMF_LIBSTDCXX := $(shell $(ESMF_CXXCOMPILER) $(ESMF_CXXCOMPILEOPTS) -print-file-name=libstdc++.a) -endif -ESMF_F90LINKPATHS += -L$(dir $(ESMF_LIBSTDCXX)) -ESMF_F90LINKRPATHS += $(ESMF_F90RPATHPREFIX)$(dir $(ESMF_LIBSTDCXX)) - -############################################################ -# Determine where flang-new's libraries are located -# -# Note that the result of -print-file-name will be the full path to the file if it is found -# within the compiler installation, and simply the file name verbatim if it is NOT found. -ESMF_LIBFLANG := $(shell $(ESMF_F90COMPILER) $(ESMF_F90COMPILEOPTS) -print-file-name=libflang.so) -ifeq ($(ESMF_LIBFLANG),libflang.so) -ESMF_LIBFLANG := $(shell $(ESMF_F90COMPILER) $(ESMF_F90COMPILEOPTS) -print-file-name=libflang.a) -endif -ESMF_CXXLINKPATHS += -L$(dir $(ESMF_LIBFLANG)) -ESMF_CXXLINKRPATHS += $(ESMF_CXXRPATHPREFIX)$(dir $(ESMF_LIBFLANG)) - ############################################################ # Link against libesmf.a using the F90 linker front-end # @@ -269,7 +239,7 @@ ESMF_F90LINKLIBS += -lrt -lstdc++ -ldl ############################################################ # Link against libesmf.a using the C++ linker front-end # -ESMF_CXXLINKLIBS += -lrt -lflang -lstdc++ -lm -ldl +ESMF_CXXLINKLIBS += -lrt -lFortranRuntime -lFortranDecimal -lstdc++ -lm -ldl ############################################################ # Linker option that ensures that the specified libraries are From 90b93530e119c0670b0d9f2e8856108a54123247 Mon Sep 17 00:00:00 2001 From: Gerhard Theurich Date: Thu, 24 Oct 2024 12:55:49 -0400 Subject: [PATCH 080/207] Construct logFileName in a way that works even if __FILE__ marco starts with "./" as is the case for LLVM flang-new. --- src/epilogue/src/ESMF_Test.F90 | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) diff --git a/src/epilogue/src/ESMF_Test.F90 b/src/epilogue/src/ESMF_Test.F90 index 5fc17b8a5a..faa22d9857 100644 --- a/src/epilogue/src/ESMF_Test.F90 +++ b/src/epilogue/src/ESMF_Test.F90 @@ -799,11 +799,10 @@ subroutine ESMF_TestStart(file, line, unit, rc) ! create a file name for the log file ! find locations of the underscore and period underScore = index (file, "_") - Period = index (file, ".") + Period = index (file, substring=".", back=.true.) ! search from back of string, + ! safe for ./file start logFileName = file(underScore+1:Period) // "Log" - - ! initialize the framework. if this fails, print a message directly ! because there is no guarentee that the log code will be working. call ESMF_Initialize(vm=globalVM, defaultlogfilename=logFileName, & From 9082e831996b128d0f800ba8fa8e9affd2645ce8 Mon Sep 17 00:00:00 2001 From: Gerhard Theurich Date: Thu, 24 Oct 2024 12:57:10 -0400 Subject: [PATCH 081/207] Correct usage of ESMF_LogFoundDeallocError() for deallocation errors. --- src/Infrastructure/Field/interface/ESMF_Field_C.F90 | 10 +++++----- .../FieldBundle/interface/ESMF_FieldBundle_C.F90 | 4 ++-- .../LocStream/interface/ESMF_LocStream_C.F90 | 6 +++--- src/Superstructure/Component/interface/ESMF_Comp_C.F90 | 6 +++--- src/Superstructure/State/interface/ESMF_State_C.F90 | 6 +++--- 5 files changed, 16 insertions(+), 16 deletions(-) diff --git a/src/Infrastructure/Field/interface/ESMF_Field_C.F90 b/src/Infrastructure/Field/interface/ESMF_Field_C.F90 index f634d2fe0f..2d750394ed 100644 --- a/src/Infrastructure/Field/interface/ESMF_Field_C.F90 +++ b/src/Infrastructure/Field/interface/ESMF_Field_C.F90 @@ -735,9 +735,9 @@ subroutine f_esmf_fieldcollectgarbage(field, rc) implicit none type(ESMF_Field) :: field - integer, intent(out) :: rc + integer, intent(out) :: rc - integer :: localrc + integer :: localrc ! initialize return code; assume routine not implemented localrc = ESMF_RC_NOT_IMPL @@ -751,15 +751,15 @@ subroutine f_esmf_fieldcollectgarbage(field, rc) if (ESMF_LogFoundError(localrc, & ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return - ! deallocate actual FieldType allocation + ! deallocate actual FieldType allocation !print *, "deallocate(field%ftypep)" deallocate(field%ftypep, stat=localrc) - if (ESMF_LogFoundAllocError(localrc, msg="Deallocating Field", & + if (ESMF_LogFoundDeallocError(localrc, msg="Deallocating Field", & ESMF_CONTEXT, rcToReturn=rc)) return endif nullify(field%ftypep) - ! return successfully + ! return successfully rc = ESMF_SUCCESS end subroutine f_esmf_fieldcollectgarbage diff --git a/src/Infrastructure/FieldBundle/interface/ESMF_FieldBundle_C.F90 b/src/Infrastructure/FieldBundle/interface/ESMF_FieldBundle_C.F90 index 366f16861c..6cbba80a56 100644 --- a/src/Infrastructure/FieldBundle/interface/ESMF_FieldBundle_C.F90 +++ b/src/Infrastructure/FieldBundle/interface/ESMF_FieldBundle_C.F90 @@ -94,9 +94,9 @@ subroutine f_esmf_fbundlecollectgarbage(fb, rc) ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, & rcToReturn=rc)) return - ! deallocate actual FieldBundleType allocation + ! deallocate actual FieldBundleType allocation deallocate(fb%this, stat=localrc) - if (ESMF_LogFoundAllocError(localrc, msg="Deallocating FieldBundle", & + if (ESMF_LogFoundDeallocError(localrc, msg="Deallocating FieldBundle", & ESMF_CONTEXT, & rcToReturn=rc)) return endif diff --git a/src/Infrastructure/LocStream/interface/ESMF_LocStream_C.F90 b/src/Infrastructure/LocStream/interface/ESMF_LocStream_C.F90 index 892eeedfe4..e3e3210550 100644 --- a/src/Infrastructure/LocStream/interface/ESMF_LocStream_C.F90 +++ b/src/Infrastructure/LocStream/interface/ESMF_LocStream_C.F90 @@ -211,15 +211,15 @@ subroutine f_esmf_locstreamcollectgarbage(locstream, rc) ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return - ! deallocate actual LocStreamType allocation + ! deallocate actual LocStreamType allocation if (associated(locstream%lstypep)) then deallocate(locstream%lstypep, stat=localrc) - if (ESMF_LogFoundAllocError(localrc, msg="Deallocating LocStream", & + if (ESMF_LogFoundDeallocError(localrc, msg="Deallocating LocStream", & ESMF_CONTEXT, rcToReturn=rc)) return endif nullify(locstream%lstypep) - ! return successfully + ! return successfully rc = ESMF_SUCCESS end subroutine f_esmf_locstreamcollectgarbage diff --git a/src/Superstructure/Component/interface/ESMF_Comp_C.F90 b/src/Superstructure/Component/interface/ESMF_Comp_C.F90 index 8bfbdfc9ae..e18736d1b3 100644 --- a/src/Superstructure/Component/interface/ESMF_Comp_C.F90 +++ b/src/Superstructure/Component/interface/ESMF_Comp_C.F90 @@ -511,15 +511,15 @@ recursive subroutine f_esmf_compcollectgarbage2(comp, rc) ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return - ! deallocate actual CompClass allocation + ! deallocate actual CompClass allocation if (associated(comp%compp)) then deallocate(comp%compp, stat=localrc) - if (ESMF_LogFoundAllocError(localrc, msg="Deallocating Comp", & + if (ESMF_LogFoundDeallocError(localrc, msg="Deallocating Comp", & ESMF_CONTEXT, rcToReturn=rc)) return endif nullify(comp%compp) - ! return successfully + ! return successfully rc = ESMF_SUCCESS end subroutine f_esmf_compcollectgarbage2 diff --git a/src/Superstructure/State/interface/ESMF_State_C.F90 b/src/Superstructure/State/interface/ESMF_State_C.F90 index 88f3f7eae9..e60c6c3e3d 100644 --- a/src/Superstructure/State/interface/ESMF_State_C.F90 +++ b/src/Superstructure/State/interface/ESMF_State_C.F90 @@ -476,16 +476,16 @@ subroutine f_esmf_statecollectgarbage(state, rc) ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, & rcToReturn=rc)) return - ! deallocate actual StateClass allocation + ! deallocate actual StateClass allocation deallocate(state%statep, stat=localrc) localrc = merge (ESMF_SUCCESS, ESMF_RC_MEM_DEALLOCATE, localrc == 0) - if (ESMF_LogFoundAllocError(localrc, msg="Deallocating State", & + if (ESMF_LogFoundDeallocError(localrc, msg="Deallocating State", & ESMF_CONTEXT, & rcToReturn=rc)) return endif nullify(state%statep) - ! return successfully + ! return successfully rc = ESMF_SUCCESS end subroutine f_esmf_statecollectgarbage From 4bbe8f244f567d60ca727d256bb8a5963100a208 Mon Sep 17 00:00:00 2001 From: Gerhard Theurich Date: Thu, 24 Oct 2024 10:08:00 -0700 Subject: [PATCH 082/207] Finally update a very much outdated comment that has been replicated across most of the build_rules.mk files. --- build_config/Cygwin.g95.default/build_rules.mk | 2 +- build_config/Cygwin.gfortran.default/build_rules.mk | 2 +- build_config/Darwin.absoft.default/build_rules.mk | 2 +- build_config/Darwin.g95.default/build_rules.mk | 2 +- build_config/Darwin.gfortran.default/build_rules.mk | 2 +- build_config/Darwin.gfortranclang.default/build_rules.mk | 2 +- build_config/Darwin.nag.default/build_rules.mk | 2 +- build_config/Darwin.pgi.default/build_rules.mk | 2 +- build_config/Linux.absoft.default/build_rules.mk | 2 +- build_config/Linux.absoftintel.default/build_rules.mk | 2 +- build_config/Linux.aocc.default/build_rules.mk | 2 +- build_config/Linux.arm.default/build_rules.mk | 2 +- build_config/Linux.g95.default/build_rules.mk | 2 +- build_config/Linux.gfortran.default/build_rules.mk | 2 +- build_config/Linux.gfortranclang.default/build_rules.mk | 2 +- build_config/Linux.intelgcc.default/build_rules.mk | 2 +- build_config/Linux.lahey.default/build_rules.mk | 2 +- build_config/Linux.llvm.default/build_rules.mk | 2 +- build_config/Linux.nag.default/build_rules.mk | 2 +- build_config/Linux.nagintel.default/build_rules.mk | 2 +- build_config/Linux.nvhpc.default/build_rules.mk | 2 +- build_config/Linux.pathscale.default/build_rules.mk | 2 +- build_config/Linux.pgi.default/build_rules.mk | 2 +- build_config/Linux.pgigcc.default/build_rules.mk | 2 +- build_config/MinGW.gfortran.default/build_rules.mk | 2 +- build_config/MinGW.intel.default/build_rules.mk | 2 +- build_config/MinGW.intelcl.default/build_rules.mk | 2 +- build_config/Unicos.aocc.default/build_rules.mk | 2 +- build_config/Unicos.gfortran.default/build_rules.mk | 2 +- build_config/Unicos.nvhpc.default/build_rules.mk | 2 +- build_config/Unicos.pathscale.default/build_rules.mk | 2 +- build_config/Unicos.pgi.default/build_rules.mk | 2 +- 32 files changed, 32 insertions(+), 32 deletions(-) diff --git a/build_config/Cygwin.g95.default/build_rules.mk b/build_config/Cygwin.g95.default/build_rules.mk index 35b59557f3..4760c75ede 100644 --- a/build_config/Cygwin.g95.default/build_rules.mk +++ b/build_config/Cygwin.g95.default/build_rules.mk @@ -142,7 +142,7 @@ ESMF_F90LINKOPTS += -march=k8 -m64 -mcmodel=medium endif ############################################################ -# Need this until the file convention is fixed (then remove these two lines) +# Explicit flags for handling specific format and cpp combos # ESMF_F90COMPILEFREENOCPP = -ffree-form ESMF_F90COMPILEFIXCPP = -cpp -ffixed-form diff --git a/build_config/Cygwin.gfortran.default/build_rules.mk b/build_config/Cygwin.gfortran.default/build_rules.mk index 7fad49a1eb..d915f6222c 100644 --- a/build_config/Cygwin.gfortran.default/build_rules.mk +++ b/build_config/Cygwin.gfortran.default/build_rules.mk @@ -150,7 +150,7 @@ ESMF_OPENMP_F90LINKOPTS += -fopenmp ESMF_OPENMP_CXXLINKOPTS += -fopenmp ############################################################ -# Need this until the file convention is fixed (then remove these two lines) +# Explicit flags for handling specific format and cpp combos # ESMF_F90COMPILEFREENOCPP = -ffree-form ESMF_F90COMPILEFIXCPP = -cpp -ffixed-form diff --git a/build_config/Darwin.absoft.default/build_rules.mk b/build_config/Darwin.absoft.default/build_rules.mk index 2a568fce09..9b9d9ac5f5 100644 --- a/build_config/Darwin.absoft.default/build_rules.mk +++ b/build_config/Darwin.absoft.default/build_rules.mk @@ -178,7 +178,7 @@ ESMF_CXXLINKOPTS += -pthread endif ############################################################ -# Need this until the file convention is fixed (then remove these two lines) +# Explicit flags for handling specific format and cpp combos # ESMF_F90COMPILEFREENOCPP = -ffree ESMF_F90COMPILEFIXCPP = -ffixed diff --git a/build_config/Darwin.g95.default/build_rules.mk b/build_config/Darwin.g95.default/build_rules.mk index 8189b5ec0d..537ed2877d 100644 --- a/build_config/Darwin.g95.default/build_rules.mk +++ b/build_config/Darwin.g95.default/build_rules.mk @@ -186,7 +186,7 @@ ESMF_CXXLINKOPTS += -pthread endif ############################################################ -# Need this until the file convention is fixed (then remove these two lines) +# Explicit flags for handling specific format and cpp combos # ESMF_F90COMPILEFREENOCPP = -ffree-form ESMF_F90COMPILEFIXCPP = -cpp -ffixed-form diff --git a/build_config/Darwin.gfortran.default/build_rules.mk b/build_config/Darwin.gfortran.default/build_rules.mk index d9ca7f54b1..8b312edf75 100644 --- a/build_config/Darwin.gfortran.default/build_rules.mk +++ b/build_config/Darwin.gfortran.default/build_rules.mk @@ -201,7 +201,7 @@ ESMF_OPENACC_F90LINKOPTS += -fopenacc ESMF_OPENACC_CXXLINKOPTS += -fopenacc ############################################################ -# Need this until the file convention is fixed (then remove these two lines) +# Explicit flags for handling specific format and cpp combos # ESMF_F90COMPILEFREENOCPP = -ffree-form ESMF_F90COMPILEFIXCPP = -cpp -ffixed-form diff --git a/build_config/Darwin.gfortranclang.default/build_rules.mk b/build_config/Darwin.gfortranclang.default/build_rules.mk index cec3f6ffe2..b14b78f751 100644 --- a/build_config/Darwin.gfortranclang.default/build_rules.mk +++ b/build_config/Darwin.gfortranclang.default/build_rules.mk @@ -209,7 +209,7 @@ ESMF_OPENMP_F90LINKOPTS += -fopenmp ESMF_OPENMP_CXXLINKOPTS += -Xpreprocessor -fopenmp ############################################################ -# Need this until the file convention is fixed (then remove these two lines) +# Explicit flags for handling specific format and cpp combos # ESMF_F90COMPILEFREENOCPP = -ffree-form ESMF_F90COMPILEFIXCPP = -cpp -ffixed-form diff --git a/build_config/Darwin.nag.default/build_rules.mk b/build_config/Darwin.nag.default/build_rules.mk index fa25523599..0e5772fac7 100644 --- a/build_config/Darwin.nag.default/build_rules.mk +++ b/build_config/Darwin.nag.default/build_rules.mk @@ -148,7 +148,7 @@ ESMF_F90LINKOPTS += -thread_safe endif ############################################################ -# Need this until the file convention is fixed (then remove these two lines) +# Explicit flags for handling specific format and cpp combos # ESMF_F90COMPILEFREECPP = -free -fpp ESMF_F90COMPILEFREENOCPP = -free diff --git a/build_config/Darwin.pgi.default/build_rules.mk b/build_config/Darwin.pgi.default/build_rules.mk index bb64511632..4c0c34a02b 100644 --- a/build_config/Darwin.pgi.default/build_rules.mk +++ b/build_config/Darwin.pgi.default/build_rules.mk @@ -214,7 +214,7 @@ ESMF_OPENACC_F90LINKOPTS += -acc -Minfo ESMF_OPENACC_CXXLINKOPTS += -acc -Minfo ############################################################ -# Need this until the file convention is fixed (then remove these two lines) +# Explicit flags for handling specific format and cpp combos # ESMF_F90COMPILEFREENOCPP = -Mfreeform ESMF_F90COMPILEFIXCPP = -Mpreprocess -Mnofreeform diff --git a/build_config/Linux.absoft.default/build_rules.mk b/build_config/Linux.absoft.default/build_rules.mk index 7800a154d4..e5fdbbe3d7 100644 --- a/build_config/Linux.absoft.default/build_rules.mk +++ b/build_config/Linux.absoft.default/build_rules.mk @@ -181,7 +181,7 @@ ESMF_PIO = OFF ESMF_F90IMOD = -p ############################################################ -# Need this until the file convention is fixed (then remove these two lines) +# Explicit flags for handling specific format and cpp combos # ESMF_F90COMPILEFREENOCPP = -ffree ESMF_F90COMPILEFIXCPP = -ffixed diff --git a/build_config/Linux.absoftintel.default/build_rules.mk b/build_config/Linux.absoftintel.default/build_rules.mk index cdfe2d2d60..7eebaec2ca 100644 --- a/build_config/Linux.absoftintel.default/build_rules.mk +++ b/build_config/Linux.absoftintel.default/build_rules.mk @@ -177,7 +177,7 @@ endif endif ############################################################ -# Need this until the file convention is fixed (then remove these two lines) +# Explicit flags for handling specific format and cpp combos # ESMF_F90COMPILEFREENOCPP = -ffree ESMF_F90COMPILEFIXCPP = -ffixed diff --git a/build_config/Linux.aocc.default/build_rules.mk b/build_config/Linux.aocc.default/build_rules.mk index 2573709d0d..026d708a8a 100644 --- a/build_config/Linux.aocc.default/build_rules.mk +++ b/build_config/Linux.aocc.default/build_rules.mk @@ -228,7 +228,7 @@ ESMF_OPENMP_F90LINKOPTS += -fopenmp ESMF_OPENMP_CXXLINKOPTS += -fopenmp ############################################################ -# Need this until the file convention is fixed (then remove these two lines) +# Explicit flags for handling specific format and cpp combos # ESMF_F90COMPILEFREENOCPP = -ffree-form ESMF_F90COMPILEFIXCPP = -cpp -ffixed-form diff --git a/build_config/Linux.arm.default/build_rules.mk b/build_config/Linux.arm.default/build_rules.mk index 59df706f20..291c7dc151 100644 --- a/build_config/Linux.arm.default/build_rules.mk +++ b/build_config/Linux.arm.default/build_rules.mk @@ -226,7 +226,7 @@ ESMF_OPENMP=OFF # ESMF_OPENMP_CXXLINKOPTS += -fopenmp ############################################################ -# Need this until the file convention is fixed (then remove these two lines) +# Explicit flags for handling specific format and cpp combos # ESMF_F90COMPILEFREENOCPP = -ffree-form ESMF_F90COMPILEFIXCPP = -cpp -ffixed-form diff --git a/build_config/Linux.g95.default/build_rules.mk b/build_config/Linux.g95.default/build_rules.mk index b023c6bdc8..c4c2597b24 100644 --- a/build_config/Linux.g95.default/build_rules.mk +++ b/build_config/Linux.g95.default/build_rules.mk @@ -195,7 +195,7 @@ ESMF_OPENMP_F90LINKOPTS += -fopenmp ESMF_OPENMP_CXXLINKOPTS += -fopenmp ############################################################ -# Need this until the file convention is fixed (then remove these two lines) +# Explicit flags for handling specific format and cpp combos # ESMF_F90COMPILEFREENOCPP = -ffree-form ESMF_F90COMPILEFIXCPP = -cpp -ffixed-form diff --git a/build_config/Linux.gfortran.default/build_rules.mk b/build_config/Linux.gfortran.default/build_rules.mk index ca7e355f67..45210897e3 100644 --- a/build_config/Linux.gfortran.default/build_rules.mk +++ b/build_config/Linux.gfortran.default/build_rules.mk @@ -232,7 +232,7 @@ ESMF_OPENACC_F90LINKOPTS += -fopenacc ESMF_OPENACC_CXXLINKOPTS += -fopenacc ############################################################ -# Need this until the file convention is fixed (then remove these two lines) +# Explicit flags for handling specific format and cpp combos # ESMF_F90COMPILEFREENOCPP = -ffree-form ESMF_F90COMPILEFIXCPP = -cpp -ffixed-form diff --git a/build_config/Linux.gfortranclang.default/build_rules.mk b/build_config/Linux.gfortranclang.default/build_rules.mk index 1585667530..337c3ae1a3 100644 --- a/build_config/Linux.gfortranclang.default/build_rules.mk +++ b/build_config/Linux.gfortranclang.default/build_rules.mk @@ -219,7 +219,7 @@ ESMF_OPENMP_F90LINKOPTS += -fopenmp ESMF_OPENMP_CXXLINKOPTS += -fopenmp ############################################################ -# Need this until the file convention is fixed (then remove these two lines) +# Explicit flags for handling specific format and cpp combos # ESMF_F90COMPILEFREENOCPP = -ffree-form ESMF_F90COMPILEFIXCPP = -cpp -ffixed-form diff --git a/build_config/Linux.intelgcc.default/build_rules.mk b/build_config/Linux.intelgcc.default/build_rules.mk index 82498710f7..719885d4a9 100644 --- a/build_config/Linux.intelgcc.default/build_rules.mk +++ b/build_config/Linux.intelgcc.default/build_rules.mk @@ -213,7 +213,7 @@ ESMF_OPENMP_CXXCOMPILEOPTS += -fopenmp ESMF_OPENMP_CXXLINKOPTS += -fopenmp ############################################################ -# Need this until the file convention is fixed (then remove these two lines) +# Explicit flags for handling specific format and cpp combos # ESMF_F90COMPILEFREENOCPP = -fpp0 -FR ESMF_F90COMPILEFIXCPP = -fpp diff --git a/build_config/Linux.lahey.default/build_rules.mk b/build_config/Linux.lahey.default/build_rules.mk index 22c29e0d6f..b404a3efb5 100644 --- a/build_config/Linux.lahey.default/build_rules.mk +++ b/build_config/Linux.lahey.default/build_rules.mk @@ -125,7 +125,7 @@ ESMF_OPENMP_F90LINKOPTS += -fopenmp ESMF_OPENMP_CXXLINKOPTS += -fopenmp ############################################################ -# Need this until the file convention is fixed (then remove these two lines) +# Explicit flags for handling specific format and cpp combos # ESMF_F90COMPILEFREENOCPP = --nfix ESMF_F90COMPILEFIXCPP = --fix -Cpp diff --git a/build_config/Linux.llvm.default/build_rules.mk b/build_config/Linux.llvm.default/build_rules.mk index b8ef8a125f..d3df8593ed 100644 --- a/build_config/Linux.llvm.default/build_rules.mk +++ b/build_config/Linux.llvm.default/build_rules.mk @@ -219,7 +219,7 @@ ESMF_OPENACC_F90LINKOPTS += -fopenacc ESMF_OPENACC_CXXLINKOPTS += -fopenacc ############################################################ -# Need this until the file convention is fixed (then remove these two lines) +# Explicit flags for handling specific format and cpp combos # ESMF_F90COMPILEFREENOCPP = -ffree-form ESMF_F90COMPILEFIXCPP = -cpp -ffixed-form diff --git a/build_config/Linux.nag.default/build_rules.mk b/build_config/Linux.nag.default/build_rules.mk index ac0ba3e988..8b0e88dc83 100644 --- a/build_config/Linux.nag.default/build_rules.mk +++ b/build_config/Linux.nag.default/build_rules.mk @@ -158,7 +158,7 @@ ESMF_OPENMP_F90LINKOPTS += -openmp ESMF_OPENMP_CXXLINKOPTS += -fopenmp ############################################################ -# Need this until the file convention is fixed (then remove these two lines) +# Explicit flags for handling specific format and cpp combos # ESMF_F90COMPILEFREENOCPP = -free ESMF_F90COMPILEFIXCPP = -fixed -fpp diff --git a/build_config/Linux.nagintel.default/build_rules.mk b/build_config/Linux.nagintel.default/build_rules.mk index 66ee2c09e9..85b215d106 100644 --- a/build_config/Linux.nagintel.default/build_rules.mk +++ b/build_config/Linux.nagintel.default/build_rules.mk @@ -149,7 +149,7 @@ ESMF_OPENMP_CXXLINKOPTS += -openmp endif ############################################################ -# Need this until the file convention is fixed (then remove these two lines) +# Explicit flags for handling specific format and cpp combos # ESMF_F90COMPILEFREENOCPP = -free ESMF_F90COMPILEFIXCPP = -fixed -fpp diff --git a/build_config/Linux.nvhpc.default/build_rules.mk b/build_config/Linux.nvhpc.default/build_rules.mk index c3ea694696..04b74930c8 100644 --- a/build_config/Linux.nvhpc.default/build_rules.mk +++ b/build_config/Linux.nvhpc.default/build_rules.mk @@ -203,7 +203,7 @@ ESMF_OPENACC_F90LINKOPTS += -acc -Minfo ESMF_OPENACC_CXXLINKOPTS += -acc -Minfo ############################################################ -# Need this until the file convention is fixed (then remove these two lines) +# Explicit flags for handling specific format and cpp combos # ESMF_F90COMPILEFREENOCPP = -Mfreeform ESMF_F90COMPILEFIXCPP = -Mpreprocess -Mnofreeform diff --git a/build_config/Linux.pathscale.default/build_rules.mk b/build_config/Linux.pathscale.default/build_rules.mk index 90ab51b9a6..10aec0f44d 100644 --- a/build_config/Linux.pathscale.default/build_rules.mk +++ b/build_config/Linux.pathscale.default/build_rules.mk @@ -124,7 +124,7 @@ ESMF_OPENMP_F90LINKOPTS += -mp ESMF_OPENMP_CXXLINKOPTS += -mp ############################################################ -# Need this until the file convention is fixed (then remove these two lines) +# Explicit flags for handling specific format and cpp combos # ESMF_F90COMPILEFREENOCPP = -freeform ESMF_F90COMPILEFIXCPP = -fixedform -cpp diff --git a/build_config/Linux.pgi.default/build_rules.mk b/build_config/Linux.pgi.default/build_rules.mk index 30def7de70..b4f9672213 100644 --- a/build_config/Linux.pgi.default/build_rules.mk +++ b/build_config/Linux.pgi.default/build_rules.mk @@ -250,7 +250,7 @@ ESMF_OPENACC_F90LINKOPTS += -acc -Minfo ESMF_OPENACC_CXXLINKOPTS += -acc -Minfo ############################################################ -# Need this until the file convention is fixed (then remove these two lines) +# Explicit flags for handling specific format and cpp combos # ESMF_F90COMPILEFREENOCPP = -Mfreeform ESMF_F90COMPILEFIXCPP = -Mpreprocess -Mnofreeform diff --git a/build_config/Linux.pgigcc.default/build_rules.mk b/build_config/Linux.pgigcc.default/build_rules.mk index 77cfe5ce18..3e77c3198f 100644 --- a/build_config/Linux.pgigcc.default/build_rules.mk +++ b/build_config/Linux.pgigcc.default/build_rules.mk @@ -172,7 +172,7 @@ ESMF_F90LINKPATHS += -L$(dir $(shell gcc -print-file-name=libstdc++.so)) ESMF_F90LINKLIBS += -lstdc++ ############################################################ -# Need this until the file convention is fixed (then remove these two lines) +# Explicit flags for handling specific format and cpp combos # ESMF_F90COMPILEFREENOCPP = -Mfreeform ESMF_F90COMPILEFIXCPP = -Mpreprocess -Mnofreeform diff --git a/build_config/MinGW.gfortran.default/build_rules.mk b/build_config/MinGW.gfortran.default/build_rules.mk index da9e9806c1..3d06a67b5d 100644 --- a/build_config/MinGW.gfortran.default/build_rules.mk +++ b/build_config/MinGW.gfortran.default/build_rules.mk @@ -158,7 +158,7 @@ ESMF_CXXCOMPILECPPFLAGS += -DNO_TIMES ESMF_PTHREADS := OFF ############################################################ -# Need this until the file convention is fixed (then remove these two lines) +# Explicit flags for handling specific format and cpp combos # ESMF_F90COMPILEFREENOCPP = -ffree-form ESMF_F90COMPILEFIXCPP = -cpp -ffixed-form diff --git a/build_config/MinGW.intel.default/build_rules.mk b/build_config/MinGW.intel.default/build_rules.mk index 2819996edc..22ca3307cf 100644 --- a/build_config/MinGW.intel.default/build_rules.mk +++ b/build_config/MinGW.intel.default/build_rules.mk @@ -141,7 +141,7 @@ ESMF_CXXLINKOPTS += -mcmodel=medium endif ############################################################ -# Need this until the file convention is fixed (then remove these two lines) +# Explicit flags for handling specific format and cpp combos # ESMF_F90COMPILEFREENOCPP = -fpp0 -FR ESMF_F90COMPILEFIXCPP = -fpp diff --git a/build_config/MinGW.intelcl.default/build_rules.mk b/build_config/MinGW.intelcl.default/build_rules.mk index 5f47fe8335..b3783a4490 100644 --- a/build_config/MinGW.intelcl.default/build_rules.mk +++ b/build_config/MinGW.intelcl.default/build_rules.mk @@ -139,7 +139,7 @@ ESMF_CXXLINKOPTS += -mcmodel=medium endif ############################################################ -# Need this until the file convention is fixed (then remove these two lines) +# Explicit flags for handling specific format and cpp combos # ESMF_F90COMPILEFREENOCPP = -fpp0 -FR ESMF_F90COMPILEFIXCPP = -fpp diff --git a/build_config/Unicos.aocc.default/build_rules.mk b/build_config/Unicos.aocc.default/build_rules.mk index 9b43f5f08d..2b5060d42c 100644 --- a/build_config/Unicos.aocc.default/build_rules.mk +++ b/build_config/Unicos.aocc.default/build_rules.mk @@ -115,7 +115,7 @@ ESMF_OPENACC_F90LINKOPTS += -fopenacc ESMF_OPENACC_CXXLINKOPTS += -fopenacc ############################################################ -# Need this until the file convention is fixed (then remove these two lines) +# Explicit flags for handling specific format and cpp combos # ESMF_F90COMPILEFREENOCPP = -ffree-form ESMF_F90COMPILEFIXCPP = -cpp -ffixed-form diff --git a/build_config/Unicos.gfortran.default/build_rules.mk b/build_config/Unicos.gfortran.default/build_rules.mk index e14483beb5..0366ce75b4 100644 --- a/build_config/Unicos.gfortran.default/build_rules.mk +++ b/build_config/Unicos.gfortran.default/build_rules.mk @@ -109,7 +109,7 @@ ESMF_OPENACC_F90LINKOPTS += -fopenacc ESMF_OPENACC_CXXLINKOPTS += -fopenacc ############################################################ -# Need this until the file convention is fixed (then remove these two lines) +# Explicit flags for handling specific format and cpp combos # ESMF_F90COMPILEFREENOCPP = -ffree-form ESMF_F90COMPILEFIXCPP = -cpp -ffixed-form diff --git a/build_config/Unicos.nvhpc.default/build_rules.mk b/build_config/Unicos.nvhpc.default/build_rules.mk index 34c6ea893e..c29d2f7ad4 100644 --- a/build_config/Unicos.nvhpc.default/build_rules.mk +++ b/build_config/Unicos.nvhpc.default/build_rules.mk @@ -126,7 +126,7 @@ ESMF_OPENACC_F90LINKOPTS += -acc -Minfo ESMF_OPENACC_CXXLINKOPTS += -acc -Minfo ############################################################ -# Need this until the file convention is fixed (then remove these two lines) +# Explicit flags for handling specific format and cpp combos # ESMF_F90COMPILEFREENOCPP = -Mfreeform ESMF_F90COMPILEFIXCPP = -Mpreprocess -Mnofreeform diff --git a/build_config/Unicos.pathscale.default/build_rules.mk b/build_config/Unicos.pathscale.default/build_rules.mk index 241bf85181..17afd19e71 100644 --- a/build_config/Unicos.pathscale.default/build_rules.mk +++ b/build_config/Unicos.pathscale.default/build_rules.mk @@ -78,7 +78,7 @@ ESMF_PTHREADS := OFF ESMF_OPENMP := OFF ############################################################ -# Need this until the file convention is fixed (then remove these two lines) +# Explicit flags for handling specific format and cpp combos # ESMF_F90COMPILEFREENOCPP = -freeform ESMF_F90COMPILEFIXCPP = -fixedform -cpp diff --git a/build_config/Unicos.pgi.default/build_rules.mk b/build_config/Unicos.pgi.default/build_rules.mk index 45e77f0c96..d00f8867dd 100644 --- a/build_config/Unicos.pgi.default/build_rules.mk +++ b/build_config/Unicos.pgi.default/build_rules.mk @@ -104,7 +104,7 @@ ESMF_PTHREADS := OFF ESMF_OPENMP := OFF ############################################################ -# Need this until the file convention is fixed (then remove these two lines) +# Explicit flags for handling specific format and cpp combos # ESMF_F90COMPILEFREENOCPP = -Mfreeform ESMF_F90COMPILEFIXCPP = -Mpreprocess -Mnofreeform From d50f8bfe0f7cf3569efadba212ff80e9887d9627 Mon Sep 17 00:00:00 2001 From: Gerhard Theurich Date: Thu, 24 Oct 2024 15:24:32 -0400 Subject: [PATCH 083/207] Minor clean-up and clarifying comment. --- build_config/Linux.aocc.default/build_rules.mk | 11 +---------- 1 file changed, 1 insertion(+), 10 deletions(-) diff --git a/build_config/Linux.aocc.default/build_rules.mk b/build_config/Linux.aocc.default/build_rules.mk index 026d708a8a..ec8afb3f94 100644 --- a/build_config/Linux.aocc.default/build_rules.mk +++ b/build_config/Linux.aocc.default/build_rules.mk @@ -13,6 +13,7 @@ ESMF_CPPDEFAULT = clang -E -P -x c ESMF_CXXCOMPILECPPFLAGS += -x c++ +# Need this until __aocc__ macro shows up in Fortran preprocessing ESMF_CPPFLAGS += -DESMF_COMPILER_AOCC ############################################################ @@ -80,15 +81,6 @@ ESMF_CDEFAULT = mpicc ESMF_MPIRUNDEFAULT = mpirun $(ESMF_MPILAUNCHOPTIONS) ESMF_MPIMPMDRUNDEFAULT = mpiexec $(ESMF_MPILAUNCHOPTIONS) else -ifeq ($(ESMF_COMM),lam) -# LAM (assumed to be built with gfortran) ----------------------- -ESMF_CXXCOMPILECPPFLAGS+= -DESMF_NO_SIGUSR2 -ESMF_F90DEFAULT = mpif77 -ESMF_CXXDEFAULT = mpic++ -ESMF_CDEFAULT = mpicc -ESMF_MPIRUNDEFAULT = mpirun $(ESMF_MPILAUNCHOPTIONS) -ESMF_MPIMPMDRUNDEFAULT = mpiexec $(ESMF_MPILAUNCHOPTIONS) -else ifeq ($(ESMF_COMM),openmpi) # OpenMPI -------------------------------------------------- ifeq ($(shell $(ESMF_DIR)/scripts/available mpifort),mpifort) @@ -116,7 +108,6 @@ endif endif endif endif -endif ############################################################ # Print compiler version string From 276e7ea2065bb419d97be5a4bf9d812e6c64fb29 Mon Sep 17 00:00:00 2001 From: Gerhard Theurich Date: Fri, 25 Oct 2024 12:22:59 -0400 Subject: [PATCH 084/207] NAG is strict about the width parameter for logical output format specificaion not being option, i.e. must specify! --- src/addon/NUOPC/src/NUOPC_Driver.F90 | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/src/addon/NUOPC/src/NUOPC_Driver.F90 b/src/addon/NUOPC/src/NUOPC_Driver.F90 index 6f37638290..71c7ad129d 100644 --- a/src/addon/NUOPC/src/NUOPC_Driver.F90 +++ b/src/addon/NUOPC/src/NUOPC_Driver.F90 @@ -2427,7 +2427,7 @@ recursive subroutine InitializeIPDv02p5(driver, importState, exportState, & return ! bail out ! optionally log info if (btest(verbosity,11)) then - write(msgString, "(A,l,A,I4)") trim(name)//& + write(msgString, "(A,L2,A,I4)") trim(name)//& ": InitializeDataComplete='"//trim(oldDataComplete)//& "', allUpdated=", allUpdated, ", updatedCount=", oldUpdatedCount call ESMF_LogWrite(msgString, ESMF_LOGMSG_INFO, rc=rc) @@ -2503,7 +2503,7 @@ recursive subroutine InitializeIPDv02p5(driver, importState, exportState, & ! optionally log info if (btest(verbosity,11)) then - write(msgString, "(A,l,A,I4)") trim(name)//& + write(msgString, "(A,L2,A,I4)") trim(name)//& ": InitializeDataComplete='"//trim(newDataComplete)//& "', allUpdated=", allUpdated, ", updatedCount=", newUpdatedCount call ESMF_LogWrite(msgString, ESMF_LOGMSG_INFO, rc=rc) @@ -2775,7 +2775,7 @@ recursive subroutine InitializeIPDv02p5Data(driver, importState, exportState,& return ! bail out if (btest(verbosity,11)) then - write(msgString, "(A,l)") trim(name)//& + write(msgString, "(A,L2)") trim(name)//& ": loopDataDependentInitialize() returned with dataDepAllComplete: ",& is%wrap%dataDepAllComplete call ESMF_LogWrite(msgString, ESMF_LOGMSG_INFO, rc=rc) @@ -3266,7 +3266,7 @@ recursive subroutine loopDataDependentInitialize(driver, & return ! bail out if (btest(verbosity,11)) then - write(msgString, "(A,I4,A,L)") & + write(msgString, "(A,I4,A,L2)") & trim(name)//": component ", i, "="//trim(compName)//& ", dataComplete (global): ", (helperOut==petCount) call ESMF_LogWrite(msgString, ESMF_LOGMSG_INFO, rc=rc) @@ -3377,7 +3377,7 @@ recursive subroutine loopDataDependentInitialize(driver, & if (helperOut > 0) someProgress=.true. ! toggle flag if (btest(verbosity,11)) then - write(msgString, "(A,I4,A,L)") & + write(msgString, "(A,I4,A,L2)") & trim(name)//": component ", i, "="//trim(compName)//& ", someProgress (global): ", someProgress call ESMF_LogWrite(msgString, ESMF_LOGMSG_INFO, rc=rc) @@ -3391,7 +3391,7 @@ recursive subroutine loopDataDependentInitialize(driver, & if (present(dataDepAllComplete)) dataDepAllComplete=allComplete if (btest(verbosity,11)) then - write(msgString, "(A,l,A,l,A,l)") & + write(msgString, "(A,L2,A,L2,A,L2)") & trim(name)//": someProgress=", someProgress, ", allComplete=", & allComplete, ", present(dataDepAllComplete)=", & present(dataDepAllComplete) From f2ba5d016a2b21a3b49ca34d3862e6069ced3cf4 Mon Sep 17 00:00:00 2001 From: Robert Oehmke Date: Fri, 25 Oct 2024 10:56:49 -0600 Subject: [PATCH 085/207] Copy contexts from src to dual mesh. --- src/Infrastructure/Mesh/src/ESMCI_MeshDual.C | 3 +++ 1 file changed, 3 insertions(+) diff --git a/src/Infrastructure/Mesh/src/ESMCI_MeshDual.C b/src/Infrastructure/Mesh/src/ESMCI_MeshDual.C index 76f53b0695..c00a8e7acc 100644 --- a/src/Infrastructure/Mesh/src/ESMCI_MeshDual.C +++ b/src/Infrastructure/Mesh/src/ESMCI_MeshDual.C @@ -897,6 +897,9 @@ void MeshDual(Mesh *src_mesh, Mesh **_dual_mesh) { if (elemConn !=NULL) delete [] elemConn; if (nodes !=NULL) delete [] nodes; + // Assume Contexts + dual_mesh->AssumeContexts(*src_mesh); + // Register the elem Fields Context ctxt; ctxt.flip(); dual_mesh->RegisterField("elem_frac", From bb0c56f60900f1d3eda404dbc9ae92aa79fc4573 Mon Sep 17 00:00:00 2001 From: Gerhard Theurich Date: Fri, 25 Oct 2024 13:17:42 -0400 Subject: [PATCH 086/207] NAG is strict about the "X" format specifiation needing a leading number of places to advance. --- src/addon/ESMX/Comps/ESMX_Data/ESMX_Data.F90 | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/src/addon/ESMX/Comps/ESMX_Data/ESMX_Data.F90 b/src/addon/ESMX/Comps/ESMX_Data/ESMX_Data.F90 index f190b7c4c9..2ca379a6e8 100644 --- a/src/addon/ESMX/Comps/ESMX_Data/ESMX_Data.F90 +++ b/src/addon/ESMX/Comps/ESMX_Data/ESMX_Data.F90 @@ -514,7 +514,7 @@ subroutine ModelAdvance(xdata, rc) ! write to standard out if (xstate%myid .eq. xstate%outid) then - write(*,'(A,X,A)') trim(xstate%cname)//": Model Advance",trim(clockString) + write(*,'(A,1X,A)') trim(xstate%cname)//": Model Advance",trim(clockString) endif ! sum import data from all PETs @@ -522,7 +522,7 @@ subroutine ModelAdvance(xdata, rc) errCount = 0 if (xstate%myid .eq. xstate%outid) then write(*,'(A)') trim(xstate%cname)//": Import Fields" - write(*,'(A,X,A25,X,A9,3(X,A9),X,A4)') & + write(*,'(A,1X,A25,1X,A9,3(1X,A9),1X,A4)') & trim(xstate%cname)//":", "FIELD", & "COUNT", "MEAN", & "MIN", "MAX", & @@ -533,7 +533,7 @@ subroutine ModelAdvance(xdata, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, file=__FILE__)) return if (xstate%myid .eq. xstate%outid) then - write(*,'(A,X,A25,X,I9,3(X,E9.2),X,L4)') & + write(*,'(A,1X,A25,1X,I9,3(1X,E9.2),1X,L4)') & trim(xstate%cname)//":", trim(xfield%stdn), & int(xfield%gsum(2)), xfield%gavg, & xfield%gmin(1), xfield%gmax(1), & @@ -547,7 +547,7 @@ subroutine ModelAdvance(xdata, rc) xfield => xstate%exp_flds_head if (xstate%myid .eq. xstate%outid) then write(*,'(A)') trim(xstate%cname)//": Export Fields" - write(*,'(A,X,A25,X,A9,3(X,A9))') & + write(*,'(A,1X,A25,1X,A9,3(1X,A9))') & trim(xstate%cname)//":", "FIELD", & "COUNT", "MEAN", & "MIN", "MAX" @@ -557,7 +557,7 @@ subroutine ModelAdvance(xdata, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, file=__FILE__)) return if (xstate%myid .eq. xstate%outid) then - write(*,'(A,X,A25,X,I9,3(X,E9.2))') & + write(*,'(A,1X,A25,1X,I9,3(1X,E9.2))') & trim(xstate%cname)//":", trim(xfield%stdn), & int(xfield%gsum(2)), xfield%gavg, & xfield%gmin(1), xfield%gmax(1) From 8f1430401888b2bddf943f8b07ac1dfabdf27b0e Mon Sep 17 00:00:00 2001 From: Robert Oehmke Date: Fri, 25 Oct 2024 11:21:53 -0600 Subject: [PATCH 087/207] Add deserialize debug output. --- src/Infrastructure/Mesh/src/ESMCI_Mesh_Glue.C | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) diff --git a/src/Infrastructure/Mesh/src/ESMCI_Mesh_Glue.C b/src/Infrastructure/Mesh/src/ESMCI_Mesh_Glue.C index 90b1024748..110138d66a 100644 --- a/src/Infrastructure/Mesh/src/ESMCI_Mesh_Glue.C +++ b/src/Infrastructure/Mesh/src/ESMCI_Mesh_Glue.C @@ -3368,7 +3368,12 @@ void ESMCI_meshdeserialize(Mesh **meshpp, // printf(" is_split=%d mnsi=%d\n",meshp->is_split,meshp->max_non_split_id); - + for (int i=0; iRegisterNodalField(*meshp, "coordinates", spatial_dim); From 9b830ff439e3d9358fa4e7a141aab62ee12df2bb Mon Sep 17 00:00:00 2001 From: Gerhard Theurich Date: Fri, 25 Oct 2024 13:24:09 -0400 Subject: [PATCH 088/207] Need the same work-around we use for INTEL_LLVM and NVHPC also for NAG. --- src/addon/ESMX/Driver/ESMX_Driver.F90 | 4 ++-- src/addon/NUOPC/src/NUOPC_Driver.F90 | 4 ++-- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/src/addon/ESMX/Driver/ESMX_Driver.F90 b/src/addon/ESMX/Driver/ESMX_Driver.F90 index eac2465c5f..39227b2e53 100644 --- a/src/addon/ESMX/Driver/ESMX_Driver.F90 +++ b/src/addon/ESMX/Driver/ESMX_Driver.F90 @@ -300,8 +300,8 @@ subroutine SetModelServices(driver, rc) if (inCompDef) then ! add child component with SetVM and SetServices in CompDef -#if defined (__INTEL_LLVM_COMPILER) || (__NVCOMPILER) -!TODO: remove once IFX, NVHPC, and PGI compilers work correctly w/o work-around +#if defined (__INTEL_LLVM_COMPILER) || defined (__NVCOMPILER) || defined (NAGFOR) +!TODO: remove once IFX, NVHPC, and NAG compilers work correctly w/o work-around call NUOPC_DriverAddGridCompPtr(driver, trim(compLabel), hconfig=hconfig, & compSetServicesRoutine=CompDef(j)%ssPtr, compSetVMRoutine=CompDef(j)%svPtr, & info=info, petList=petList, devList=devList, comp=comp, rc=rc) diff --git a/src/addon/NUOPC/src/NUOPC_Driver.F90 b/src/addon/NUOPC/src/NUOPC_Driver.F90 index 71c7ad129d..887e8083e7 100644 --- a/src/addon/NUOPC/src/NUOPC_Driver.F90 +++ b/src/addon/NUOPC/src/NUOPC_Driver.F90 @@ -116,7 +116,7 @@ module NUOPC_Driver ! Generic methods public NUOPC_DriverAddComp -#if defined (__INTEL_LLVM_COMPILER) || (__NVCOMPILER) +#if defined (__INTEL_LLVM_COMPILER) || defined (__NVCOMPILER) || defined (NAGFOR) public NUOPC_DriverAddGridCompPtr !TODO: remove once compliers are fixed #endif public NUOPC_DriverAddRunElement @@ -4526,7 +4526,7 @@ recursive subroutine FinalizeReset(driver, importState, exportState, clock, rc) !----------------------------------------------------------------------------- !----------------------------------------------------------------------------- -#if defined (__INTEL_LLVM_COMPILER) || defined (__NVCOMPILER) +#if defined (__INTEL_LLVM_COMPILER) || defined (__NVCOMPILER) || defined (NAGFOR) !----------------------------------------------------------------------------- !BOPI ! !IROUTINE: NUOPC_DriverAddComp - Add a GridComp child to a Driver using procedure pointers From c5b94cf4eeb63415b9fe537e578a681f26c3d3e1 Mon Sep 17 00:00:00 2001 From: Robert Oehmke Date: Fri, 25 Oct 2024 12:32:15 -0600 Subject: [PATCH 089/207] More debug to FieldReg. --- src/Infrastructure/Mesh/src/Legacy/ESMCI_FieldReg.C | 10 +++++++++- 1 file changed, 9 insertions(+), 1 deletion(-) diff --git a/src/Infrastructure/Mesh/src/Legacy/ESMCI_FieldReg.C b/src/Infrastructure/Mesh/src/Legacy/ESMCI_FieldReg.C index 81b4f779cc..85f65e852b 100644 --- a/src/Infrastructure/Mesh/src/Legacy/ESMCI_FieldReg.C +++ b/src/Infrastructure/Mesh/src/Legacy/ESMCI_FieldReg.C @@ -12,10 +12,13 @@ #include #include #include +#include "ESMCI_LogErr.h" #include #include + + //----------------------------------------------------------------------------- // leave the following line as-is; it will insert the cvs ident string // into the object file for tracking purposes. @@ -337,7 +340,12 @@ void FieldReg::Commit(MeshDB &mesh) { std::vector nvalSet; // keep track of sizes of _fields std::vector nvalSetObj; // keep track of sizes of _fields MEField<> &f = *fi->second; -//std::cout << "Imprinting MEField:" << f.name() << std::endl; + //std::cout << "Imprinting MEField:" << f.name() << std::endl; + + char buff[1024]; + sprintf(buff,"BOB: ord=%d MEField=%s",ord,f.name().c_str()); + ESMC_LogDefault.Write(buff, ESMC_LOGMSG_INFO); + f.ordinal = ord++; // Loop obj type KernelList::iterator ki = mesh.set_begin(), ke = mesh.set_end(), kn; From c413a871d81ebe3e907dea12b808cc16d5e92baa Mon Sep 17 00:00:00 2001 From: Robert Oehmke Date: Fri, 25 Oct 2024 14:06:21 -0600 Subject: [PATCH 090/207] Debugging and test a potential fix. --- src/Infrastructure/Mesh/src/ESMCI_MeshDual.C | 9 ++++++--- 1 file changed, 6 insertions(+), 3 deletions(-) diff --git a/src/Infrastructure/Mesh/src/ESMCI_MeshDual.C b/src/Infrastructure/Mesh/src/ESMCI_MeshDual.C index c00a8e7acc..98d74042f8 100644 --- a/src/Infrastructure/Mesh/src/ESMCI_MeshDual.C +++ b/src/Infrastructure/Mesh/src/ESMCI_MeshDual.C @@ -852,7 +852,7 @@ void MeshDual(Mesh *src_mesh, Mesh **_dual_mesh) { elemMaskII=elemMaskII_wsplit; } #endif - } + } // Build elements @@ -910,8 +910,11 @@ void MeshDual(Mesh *src_mesh, Mesh **_dual_mesh) { dual_mesh->RegisterField("elem_coordinates", MEFamilyDG0::instance(), MeshObj::ELEMENT, ctxt, sdim, true); - - if (elemOrigCoords) { +// if (elemOrigCoords) { + if (src_node_orig_coords) { + char buff[1024]; + sprintf(buff,"BOB: MeshDual: adding elem_orig_coordinates"); + ESMC_LogDefault.Write(buff, ESMC_LOGMSG_INFO); dual_mesh->RegisterField("elem_orig_coordinates", MEFamilyDG0::instance(), MeshObj::ELEMENT, ctxt, orig_sdim, true); From d3d609013ba9a27600531130f1acfc6db0674f4a Mon Sep 17 00:00:00 2001 From: Gerhard Theurich Date: Tue, 29 Oct 2024 14:53:49 -0700 Subject: [PATCH 091/207] Catch exceptions on the interface level to cover the case where the object has been destroyed and an exception is thrown. Also while space clean-up. --- .../DistGrid/interface/ESMCI_DistGrid_F.C | 916 +++++++++--------- 1 file changed, 479 insertions(+), 437 deletions(-) diff --git a/src/Infrastructure/DistGrid/interface/ESMCI_DistGrid_F.C b/src/Infrastructure/DistGrid/interface/ESMCI_DistGrid_F.C index 927389ceb0..1ce1bc489e 100644 --- a/src/Infrastructure/DistGrid/interface/ESMCI_DistGrid_F.C +++ b/src/Infrastructure/DistGrid/interface/ESMCI_DistGrid_F.C @@ -1,10 +1,10 @@ // $Id$ // // Earth System Modeling Framework -// Copyright (c) 2002-2024, 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, +// Copyright (c) 2002-2024, 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. // @@ -42,8 +42,8 @@ using namespace std; extern "C" { // - ESMF-public methods: - - void FTN_X(c_esmc_distgridcreatedg)(ESMCI::DistGrid **ptr, + + void FTN_X(c_esmc_distgridcreatedg)(ESMCI::DistGrid **ptr, ESMCI::DistGrid **dg, ESMCI::InterArray *firstExtra, ESMCI::InterArray *lastExtra, ESMC_IndexFlag *indexflag, ESMCI::InterArray *connectionList, ESMC_Logical *balanceflag, @@ -64,7 +64,7 @@ extern "C" { actualFlag = false; // not an actual member because VM present but NULL } #if 0 - printf("c_esmc_distgridcreatedg(): opt_vm=%p, actualFlag=%d\n", + printf("c_esmc_distgridcreatedg(): opt_vm=%p, actualFlag=%d\n", opt_vm, actualFlag); #endif ESMCI::DELayout *opt_delayout; @@ -89,21 +89,21 @@ extern "C" { // test for NULL pointer via macro before calling any class methods ESMCI_NULL_CHECK_PRC(ptr, rc) *ptr = ESMCI::DistGrid::create(*dg, firstExtra, lastExtra, - ESMC_NOT_PRESENT_FILTER(indexflag), connectionList, + ESMC_NOT_PRESENT_FILTER(indexflag), connectionList, balanceflagOpt, opt_delayout, opt_vm, actualFlag, &localrc); if (ESMC_LogDefault.MsgFoundError(localrc, ESMCI_ERR_PASSTHRU, ESMC_CONTEXT, ESMC_NOT_PRESENT_FILTER(rc))) return; // bail out // return successfully if (rc!=NULL) *rc = ESMF_SUCCESS; } - - void FTN_X(c_esmc_distgridcreaterd)(ESMCI::DistGrid **ptr, + + void FTN_X(c_esmc_distgridcreaterd)(ESMCI::DistGrid **ptr, ESMCI::InterArray *minIndex, ESMCI::InterArray *maxIndex, ESMCI::InterArray *regDecomp, - ESMCI::Decomp_Flag *decompflag, int *decompflagCount, + ESMCI::Decomp_Flag *decompflag, int *decompflagCount, ESMCI::InterArray *regDecompFirstExtra, ESMCI::InterArray *regDecompLastExtra, - ESMCI::InterArray *deLabelList, ESMC_IndexFlag *indexflag, + ESMCI::InterArray *deLabelList, ESMC_IndexFlag *indexflag, ESMCI::InterArray *connectionList, ESMCI::DELayout **delayout, ESMCI::VM **vm, ESMC_TypeKind_Flag *indexTK, int *rc){ @@ -115,7 +115,7 @@ extern "C" { ESMC_TypeKind_Flag opt_indexTK; // deal with optional arguments ESMCI::DELayout *opt_delayout; - if (ESMC_NOT_PRESENT_FILTER(delayout) == ESMC_NULL_POINTER) + if (ESMC_NOT_PRESENT_FILTER(delayout) == ESMC_NULL_POINTER) opt_delayout = NULL; else opt_delayout = *delayout; @@ -132,7 +132,7 @@ extern "C" { printf("c_esmc_distgridcreaterd(): opt_delayout=%p, opt_vm=%p, " "actualFlag=%d\n", opt_delayout, opt_vm, actualFlag); #endif - if (ESMC_NOT_PRESENT_FILTER(indexTK) == ESMC_NULL_POINTER) + if (ESMC_NOT_PRESENT_FILTER(indexTK) == ESMC_NULL_POINTER) opt_indexTK = ESMF_NOKIND; else opt_indexTK = *indexTK; if (actualFlag){ @@ -149,15 +149,15 @@ extern "C" { // return successfully if (rc!=NULL) *rc = ESMF_SUCCESS; } - - void FTN_X(c_esmc_distgridcreaterdt)(ESMCI::DistGrid **ptr, + + void FTN_X(c_esmc_distgridcreaterdt)(ESMCI::DistGrid **ptr, ESMCI::InterArray *minIndex, ESMCI::InterArray *maxIndex, ESMCI::InterArray *regDecomp, ESMCI::Decomp_Flag *decompflag, int *decompflagCount1, int *decompflagCount2, ESMCI::InterArray *regDecompFirstExtra, ESMCI::InterArray *regDecompLastExtra, - ESMCI::InterArray *deLabelList, ESMC_IndexFlag *indexflag, + ESMCI::InterArray *deLabelList, ESMC_IndexFlag *indexflag, ESMCI::InterArray *connectionList, ESMCI::DELayout **delayout, ESMCI::VM **vm, ESMC_TypeKind_Flag *indexTK, int *rc){ @@ -170,32 +170,32 @@ extern "C" { ESMCI::VM *opt_vm; ESMC_TypeKind_Flag opt_indexTK; // deal with optional arguments - if (ESMC_NOT_PRESENT_FILTER(delayout) == ESMC_NULL_POINTER) + if (ESMC_NOT_PRESENT_FILTER(delayout) == ESMC_NULL_POINTER) opt_delayout = NULL; else opt_delayout = *delayout; if (ESMC_NOT_PRESENT_FILTER(vm) == ESMC_NULL_POINTER) opt_vm = NULL; else opt_vm = *vm; - if (ESMC_NOT_PRESENT_FILTER(indexTK) == ESMC_NULL_POINTER) + if (ESMC_NOT_PRESENT_FILTER(indexTK) == ESMC_NULL_POINTER) opt_indexTK = ESMF_NOKIND; else opt_indexTK = *indexTK; // test for NULL pointer via macro before calling any class methods ESMCI_NULL_CHECK_PRC(ptr, rc) *ptr = ESMCI::DistGrid::create(minIndex, maxIndex, regDecomp, - decompflag, *decompflagCount1, *decompflagCount2, - regDecompFirstExtra, regDecompLastExtra, deLabelList, + decompflag, *decompflagCount1, *decompflagCount2, + regDecompFirstExtra, regDecompLastExtra, deLabelList, ESMC_NOT_PRESENT_FILTER(indexflag), connectionList, opt_delayout, opt_vm, &localrc, opt_indexTK); ESMC_LogDefault.MsgFoundError(localrc, ESMCI_ERR_PASSTHRU, ESMC_CONTEXT, ESMC_NOT_PRESENT_FILTER(rc)); } - - void FTN_X(c_esmc_distgridcreaterdf)(ESMCI::DistGrid **ptr, + + void FTN_X(c_esmc_distgridcreaterdf)(ESMCI::DistGrid **ptr, ESMCI::InterArray *minIndex, ESMCI::InterArray *maxIndex, ESMCI::InterArray *regDecomp, ESMCI::Decomp_Flag *decompflag, int *decompflagCount, ESMCI::InterArray *regDecompFirstExtra, ESMCI::InterArray *regDecompLastExtra, - ESMCI::InterArray *deLabelList, ESMC_IndexFlag *indexflag, + ESMCI::InterArray *deLabelList, ESMC_IndexFlag *indexflag, ESMCI::InterArray *connectionList, int *fastAxis, ESMCI::VM **vm, int *rc){ #undef ESMC_METHOD @@ -217,12 +217,12 @@ extern "C" { ESMC_CONTEXT, ESMC_NOT_PRESENT_FILTER(rc)); } - void FTN_X(c_esmc_distgridcreatedb)(ESMCI::DistGrid **ptr, + void FTN_X(c_esmc_distgridcreatedb)(ESMCI::DistGrid **ptr, ESMCI::InterArray *minIndex, ESMCI::InterArray *maxIndex, ESMCI::InterArray *deBlockList, - ESMCI::InterArray *deLabelList, ESMC_IndexFlag *indexflag, + ESMCI::InterArray *deLabelList, ESMC_IndexFlag *indexflag, ESMCI::InterArray *connectionList, - ESMCI::DELayout **delayout, ESMCI::VM **vm, ESMC_TypeKind_Flag *indexTK, + ESMCI::DELayout **delayout, ESMCI::VM **vm, ESMC_TypeKind_Flag *indexTK, int *rc){ #undef ESMC_METHOD #define ESMC_METHOD "c_esmc_distgridcreatedb()" @@ -233,12 +233,12 @@ extern "C" { ESMCI::VM *opt_vm; ESMC_TypeKind_Flag opt_indexTK; // deal with optional arguments - if (ESMC_NOT_PRESENT_FILTER(delayout) == ESMC_NULL_POINTER) + if (ESMC_NOT_PRESENT_FILTER(delayout) == ESMC_NULL_POINTER) opt_delayout = NULL; else opt_delayout = *delayout; if (ESMC_NOT_PRESENT_FILTER(vm) == ESMC_NULL_POINTER) opt_vm = NULL; else opt_vm = *vm; - if (ESMC_NOT_PRESENT_FILTER(indexTK) == ESMC_NULL_POINTER) + if (ESMC_NOT_PRESENT_FILTER(indexTK) == ESMC_NULL_POINTER) opt_indexTK = ESMF_NOKIND; else opt_indexTK = *indexTK; // test for NULL pointer via macro before calling any class methods @@ -249,13 +249,13 @@ extern "C" { ESMC_LogDefault.MsgFoundError(localrc, ESMCI_ERR_PASSTHRU, ESMC_CONTEXT, ESMC_NOT_PRESENT_FILTER(rc)); } - - void FTN_X(c_esmc_distgridcreatedbt)(ESMCI::DistGrid **ptr, + + void FTN_X(c_esmc_distgridcreatedbt)(ESMCI::DistGrid **ptr, ESMCI::InterArray *minIndex, ESMCI::InterArray *maxIndex, ESMCI::InterArray *deBlockList, ESMCI::InterArray *deToTileMap, - ESMCI::InterArray *deLabelList, ESMC_IndexFlag *indexflag, + ESMCI::InterArray *deLabelList, ESMC_IndexFlag *indexflag, ESMCI::InterArray *connectionList, - ESMCI::DELayout **delayout, ESMCI::VM **vm, ESMC_TypeKind_Flag *indexTK, + ESMCI::DELayout **delayout, ESMCI::VM **vm, ESMC_TypeKind_Flag *indexTK, int *rc){ #undef ESMC_METHOD #define ESMC_METHOD "c_esmc_distgridcreatedbt()" @@ -266,12 +266,12 @@ extern "C" { ESMCI::VM *opt_vm; ESMC_TypeKind_Flag opt_indexTK; // deal with optional arguments - if (ESMC_NOT_PRESENT_FILTER(delayout) == ESMC_NULL_POINTER) + if (ESMC_NOT_PRESENT_FILTER(delayout) == ESMC_NULL_POINTER) opt_delayout = NULL; else opt_delayout = *delayout; if (ESMC_NOT_PRESENT_FILTER(vm) == ESMC_NULL_POINTER) opt_vm = NULL; else opt_vm = *vm; - if (ESMC_NOT_PRESENT_FILTER(indexTK) == ESMC_NULL_POINTER) + if (ESMC_NOT_PRESENT_FILTER(indexTK) == ESMC_NULL_POINTER) opt_indexTK = ESMF_NOKIND; else opt_indexTK = *indexTK; // test for NULL pointer via macro before calling any class methods @@ -282,8 +282,8 @@ extern "C" { ESMC_LogDefault.MsgFoundError(localrc, ESMCI_ERR_PASSTHRU, ESMC_CONTEXT, ESMC_NOT_PRESENT_FILTER(rc)); } - - void FTN_X(c_esmc_distgriddestroy)(ESMCI::DistGrid **ptr, + + void FTN_X(c_esmc_distgriddestroy)(ESMCI::DistGrid **ptr, ESMC_Logical *noGarbage, int *rc){ #undef ESMC_METHOD #define ESMC_METHOD "c_esmc_distgriddestroy()" @@ -297,7 +297,7 @@ extern "C" { ESMCI_NULL_CHECK_PRC(ptr, rc) ESMCI_NULL_CHECK_PRC(*ptr, rc) ESMC_LogDefault.MsgFoundError(ESMCI::DistGrid::destroy(ptr, noGarbageOpt), - ESMCI_ERR_PASSTHRU, ESMC_CONTEXT, + ESMCI_ERR_PASSTHRU, ESMC_CONTEXT, ESMC_NOT_PRESENT_FILTER(rc)); } @@ -315,7 +315,7 @@ extern "C" { ESMCI::InterArray *tileListPDe, ESMCI::InterArray *indexCountPDimPDe, ESMCI::InterArray *collocationPDim, - ESMC_Logical *regDecompFlag, + ESMC_Logical *regDecompFlag, int *connectionCount, ESMCI::InterArray *connectionList, ESMC_TypeKind_Flag *indexTK, @@ -329,360 +329,374 @@ extern "C" { // test for NULL pointer via macro before calling any class methods ESMCI_NULL_CHECK_PRC(ptr, rc) ESMCI_NULL_CHECK_PRC(*ptr, rc) - // fill simple return values - if (ESMC_NOT_PRESENT_FILTER(delayout) != ESMC_NULL_POINTER) - *delayout = (*ptr)->getDELayout(); - if (ESMC_NOT_PRESENT_FILTER(tileCount) != ESMC_NULL_POINTER) - *tileCount = (*ptr)->getTileCount(); - if (ESMC_NOT_PRESENT_FILTER(deCount) != ESMC_NULL_POINTER) - *deCount = (*ptr)->getDELayout()->getDeCount(); - if (ESMC_NOT_PRESENT_FILTER(localDeCount) != ESMC_NULL_POINTER) - *localDeCount = (*ptr)->getDELayout()->getLocalDeCount(); - if (ESMC_NOT_PRESENT_FILTER(dimCount) != ESMC_NULL_POINTER) - *dimCount = (*ptr)->getDimCount(); - if (ESMC_NOT_PRESENT_FILTER(connectionCount) != ESMC_NULL_POINTER) - *connectionCount = (*ptr)->getConnectionCount(); - if (ESMC_NOT_PRESENT_FILTER(regDecompFlag) != ESMC_NULL_POINTER){ - if ((*ptr)->getRegDecomp()) - *regDecompFlag = ESMF_TRUE; - else - *regDecompFlag = ESMF_FALSE; - } - if (ESMC_NOT_PRESENT_FILTER(indexTK) != ESMC_NULL_POINTER) - *indexTK = (*ptr)->getIndexTK(); - if (ESMC_NOT_PRESENT_FILTER(indexflag) != ESMC_NULL_POINTER) - *indexflag = (*ptr)->getIndexflag(); - // fill minIndexPDimPTile - if (present(minIndexPDimPTile)){ - // minIndexPDimPTile was provided -> do some error checking - if ((minIndexPDimPTile)->dimCount != 2){ - ESMC_LogDefault.MsgFoundError(ESMC_RC_ARG_RANK, - "minIndexPDimPTile array must be of rank 2", ESMC_CONTEXT, rc); - return; - } - if ((minIndexPDimPTile)->extent[0] < (*ptr)->getDimCount()){ - ESMC_LogDefault.MsgFoundError(ESMC_RC_ARG_SIZE, - "1st dim of minIndexPDimPTile array must be of size 'dimCount'", - ESMC_CONTEXT, rc); - return; - } - if ((minIndexPDimPTile)->extent[1] < (*ptr)->getTileCount()){ - ESMC_LogDefault.MsgFoundError(ESMC_RC_ARG_SIZE, - "2nd dim of minIndexPDimPTile array must be of size 'tileCount'", - ESMC_CONTEXT, rc); - return; - } - // fill in the values: The interface allows to pass in minIndexPDimPTile - // arrays which are larger than dimCount x tileCount. Consequently it is - // necessary to memcpy strips of contiguous data since it cannot be - // assumed that all data ends up contiguous in the minIndexPDimPTile - // array. - for (int i=0; i<(*ptr)->getTileCount(); i++) - memcpy( - &((minIndexPDimPTile)->array[i*((minIndexPDimPTile)->extent[0])]), - &(((*ptr)->getMinIndexPDimPTile())[i*(*ptr)->getDimCount()]), - sizeof(int)*(*ptr)->getDimCount()); - } - // fill maxIndexPDimPTile - if (present(maxIndexPDimPTile)){ - // maxIndexPDimPTile was provided -> do some error checking - if ((maxIndexPDimPTile)->dimCount != 2){ - ESMC_LogDefault.MsgFoundError(ESMC_RC_ARG_RANK, - "maxIndexPDimPTile array must be of rank 2", ESMC_CONTEXT, rc); - return; - } - if ((maxIndexPDimPTile)->extent[0] < (*ptr)->getDimCount()){ - ESMC_LogDefault.MsgFoundError(ESMC_RC_ARG_SIZE, - "1st dim of maxIndexPDimPTile array must be of size 'dimCount'", - ESMC_CONTEXT, rc); - return; + try{ + // fill simple return values + if (ESMC_NOT_PRESENT_FILTER(delayout) != ESMC_NULL_POINTER) + *delayout = (*ptr)->getDELayout(); + if (ESMC_NOT_PRESENT_FILTER(tileCount) != ESMC_NULL_POINTER) + *tileCount = (*ptr)->getTileCount(); + if (ESMC_NOT_PRESENT_FILTER(deCount) != ESMC_NULL_POINTER) + *deCount = (*ptr)->getDELayout()->getDeCount(); + if (ESMC_NOT_PRESENT_FILTER(localDeCount) != ESMC_NULL_POINTER) + *localDeCount = (*ptr)->getDELayout()->getLocalDeCount(); + if (ESMC_NOT_PRESENT_FILTER(dimCount) != ESMC_NULL_POINTER) + *dimCount = (*ptr)->getDimCount(); + if (ESMC_NOT_PRESENT_FILTER(connectionCount) != ESMC_NULL_POINTER) + *connectionCount = (*ptr)->getConnectionCount(); + if (ESMC_NOT_PRESENT_FILTER(regDecompFlag) != ESMC_NULL_POINTER){ + if ((*ptr)->getRegDecomp()) + *regDecompFlag = ESMF_TRUE; + else + *regDecompFlag = ESMF_FALSE; } - if ((maxIndexPDimPTile)->extent[1] < (*ptr)->getTileCount()){ - ESMC_LogDefault.MsgFoundError(ESMC_RC_ARG_SIZE, - "2nd dim of maxIndexPDimPTile array must be of size 'tileCount'", - ESMC_CONTEXT, rc); - return; + if (ESMC_NOT_PRESENT_FILTER(indexTK) != ESMC_NULL_POINTER) + *indexTK = (*ptr)->getIndexTK(); + if (ESMC_NOT_PRESENT_FILTER(indexflag) != ESMC_NULL_POINTER) + *indexflag = (*ptr)->getIndexflag(); + // fill minIndexPDimPTile + if (present(minIndexPDimPTile)){ + // minIndexPDimPTile was provided -> do some error checking + if ((minIndexPDimPTile)->dimCount != 2){ + ESMC_LogDefault.MsgFoundError(ESMC_RC_ARG_RANK, + "minIndexPDimPTile array must be of rank 2", ESMC_CONTEXT, rc); + return; + } + if ((minIndexPDimPTile)->extent[0] < (*ptr)->getDimCount()){ + ESMC_LogDefault.MsgFoundError(ESMC_RC_ARG_SIZE, + "1st dim of minIndexPDimPTile array must be of size 'dimCount'", + ESMC_CONTEXT, rc); + return; + } + if ((minIndexPDimPTile)->extent[1] < (*ptr)->getTileCount()){ + ESMC_LogDefault.MsgFoundError(ESMC_RC_ARG_SIZE, + "2nd dim of minIndexPDimPTile array must be of size 'tileCount'", + ESMC_CONTEXT, rc); + return; + } + // fill in the values: The interface allows to pass in minIndexPDimPTile + // arrays which are larger than dimCount x tileCount. Consequently it is + // necessary to memcpy strips of contiguous data since it cannot be + // assumed that all data ends up contiguous in the minIndexPDimPTile + // array. + for (int i=0; i<(*ptr)->getTileCount(); i++) + memcpy( + &((minIndexPDimPTile)->array[i*((minIndexPDimPTile)->extent[0])]), + &(((*ptr)->getMinIndexPDimPTile())[i*(*ptr)->getDimCount()]), + sizeof(int)*(*ptr)->getDimCount()); } - // fill in the values: The interface allows to pass in maxIndexPDimPTile - // arrays which are larger than dimCount x tileCount. Consequently it is - // necessary to memcpy strips of contiguous data since it cannot be - // assumed that all data ends up contiguous in the maxIndexPDimPTile - // array. - for (int i=0; i<(*ptr)->getTileCount(); i++) - memcpy( - &((maxIndexPDimPTile)->array[i*((maxIndexPDimPTile)->extent[0])]), - &(((*ptr)->getMaxIndexPDimPTile())[i*(*ptr)->getDimCount()]), - sizeof(int)*(*ptr)->getDimCount()); - } - // fill elementCountPTile - if (present(elementCountPTile) || present(elementCountPTileI8)){ - // access the internal information - int tileCount = (*ptr)->getTileCount(); - const ESMC_I8 *access = (*ptr)->getElementCountPTile(); - if (present(elementCountPTile)){ - // elementCountPTile was provided -> do some error checking - if ((elementCountPTile)->dimCount != 1){ + // fill maxIndexPDimPTile + if (present(maxIndexPDimPTile)){ + // maxIndexPDimPTile was provided -> do some error checking + if ((maxIndexPDimPTile)->dimCount != 2){ ESMC_LogDefault.MsgFoundError(ESMC_RC_ARG_RANK, - "elementCountPTile array must be of rank 1", ESMC_CONTEXT, rc); + "maxIndexPDimPTile array must be of rank 2", ESMC_CONTEXT, rc); return; } - if ((elementCountPTile)->extent[0] < (*ptr)->getTileCount()){ + if ((maxIndexPDimPTile)->extent[0] < (*ptr)->getDimCount()){ ESMC_LogDefault.MsgFoundError(ESMC_RC_ARG_SIZE, - "1st dim of elementCountPTile array must be of size 'tileCount'", + "1st dim of maxIndexPDimPTile array must be of size 'dimCount'", ESMC_CONTEXT, rc); return; } - // fill in values - for (int i=0; i I4, with overflow check - (elementCountPTile)->array[i] = (int)(access[i]); - if ((ESMC_I8)(elementCountPTile)->array[i] != (access[i])){ - ESMC_LogDefault.MsgFoundError(ESMC_RC_ARG_BAD, - "Overflow detected in elementCountPTile after I8 -> I4 cast", + if ((maxIndexPDimPTile)->extent[1] < (*ptr)->getTileCount()){ + ESMC_LogDefault.MsgFoundError(ESMC_RC_ARG_SIZE, + "2nd dim of maxIndexPDimPTile array must be of size 'tileCount'", + ESMC_CONTEXT, rc); + return; + } + // fill in the values: The interface allows to pass in maxIndexPDimPTile + // arrays which are larger than dimCount x tileCount. Consequently it is + // necessary to memcpy strips of contiguous data since it cannot be + // assumed that all data ends up contiguous in the maxIndexPDimPTile + // array. + for (int i=0; i<(*ptr)->getTileCount(); i++) + memcpy( + &((maxIndexPDimPTile)->array[i*((maxIndexPDimPTile)->extent[0])]), + &(((*ptr)->getMaxIndexPDimPTile())[i*(*ptr)->getDimCount()]), + sizeof(int)*(*ptr)->getDimCount()); + } + // fill elementCountPTile + if (present(elementCountPTile) || present(elementCountPTileI8)){ + // access the internal information + int tileCount = (*ptr)->getTileCount(); + const ESMC_I8 *access = (*ptr)->getElementCountPTile(); + if (present(elementCountPTile)){ + // elementCountPTile was provided -> do some error checking + if ((elementCountPTile)->dimCount != 1){ + ESMC_LogDefault.MsgFoundError(ESMC_RC_ARG_RANK, + "elementCountPTile array must be of rank 1", ESMC_CONTEXT, rc); + return; + } + if ((elementCountPTile)->extent[0] < (*ptr)->getTileCount()){ + ESMC_LogDefault.MsgFoundError(ESMC_RC_ARG_SIZE, + "1st dim of elementCountPTile array must be of size 'tileCount'", + ESMC_CONTEXT, rc); + return; + } + // fill in values + for (int i=0; i I4, with overflow check + (elementCountPTile)->array[i] = (int)(access[i]); + if ((ESMC_I8)(elementCountPTile)->array[i] != (access[i])){ + ESMC_LogDefault.MsgFoundError(ESMC_RC_ARG_BAD, + "Overflow detected in elementCountPTile after I8 -> I4 cast", + ESMC_CONTEXT, rc); + return; + } + } + } + if (present(elementCountPTileI8)){ + // elementCountPTileI8 was provided -> do some error checking + if ((elementCountPTileI8)->dimCount != 1){ + ESMC_LogDefault.MsgFoundError(ESMC_RC_ARG_RANK, + "elementCountPTileI8 array must be of rank 1", ESMC_CONTEXT, rc); + return; + } + if ((elementCountPTileI8)->extent[0] < (*ptr)->getTileCount()){ + ESMC_LogDefault.MsgFoundError(ESMC_RC_ARG_SIZE, + "1st dim of elementCountPTileI8 array must be of size 'tileCount'", ESMC_CONTEXT, rc); return; } + // fill in values + memcpy((elementCountPTileI8)->array, access, sizeof(ESMC_I8)*tileCount); } } - if (present(elementCountPTileI8)){ - // elementCountPTileI8 was provided -> do some error checking - if ((elementCountPTileI8)->dimCount != 1){ + // fill minIndexPDimPDe + if (present(minIndexPDimPDe)){ + // minIndexPDimPDe was provided -> do some error checking + if ((minIndexPDimPDe)->dimCount != 2){ ESMC_LogDefault.MsgFoundError(ESMC_RC_ARG_RANK, - "elementCountPTileI8 array must be of rank 1", ESMC_CONTEXT, rc); + "minIndexPDimPDe array must be of rank 2", ESMC_CONTEXT, rc); return; } - if ((elementCountPTileI8)->extent[0] < (*ptr)->getTileCount()){ + if ((minIndexPDimPDe)->extent[0] < (*ptr)->getDimCount()){ ESMC_LogDefault.MsgFoundError(ESMC_RC_ARG_SIZE, - "1st dim of elementCountPTileI8 array must be of size 'tileCount'", + "1st dim of minIndexPDimPDe array must be of size 'dimCount'", ESMC_CONTEXT, rc); return; } - // fill in values - memcpy((elementCountPTileI8)->array, access, sizeof(ESMC_I8)*tileCount); - } - } - // fill minIndexPDimPDe - if (present(minIndexPDimPDe)){ - // minIndexPDimPDe was provided -> do some error checking - if ((minIndexPDimPDe)->dimCount != 2){ - ESMC_LogDefault.MsgFoundError(ESMC_RC_ARG_RANK, - "minIndexPDimPDe array must be of rank 2", ESMC_CONTEXT, rc); - return; - } - if ((minIndexPDimPDe)->extent[0] < (*ptr)->getDimCount()){ - ESMC_LogDefault.MsgFoundError(ESMC_RC_ARG_SIZE, - "1st dim of minIndexPDimPDe array must be of size 'dimCount'", - ESMC_CONTEXT, rc); - return; - } - if ((minIndexPDimPDe)->extent[1] < (*ptr)->getDELayout()->getDeCount()){ - ESMC_LogDefault.MsgFoundError(ESMC_RC_ARG_SIZE, - "2nd dim of minIndexPDimPDe array must be of size 'deCount'", - ESMC_CONTEXT, rc); - return; - } - // fill in the values: The interface allows to pass in minIndexPDimPDe - // arrays which are larger than dimCount x deCount. Consequently it is - // necessary to memcpy strips of contiguous data since it cannot be - // assumed that all data ends up contiguous in the minIndexPDimPDe - // array. - for (int i=0; i<(*ptr)->getDELayout()->getDeCount(); i++) - memcpy( - &((minIndexPDimPDe)->array[i*((minIndexPDimPDe)->extent[0])]), - &(((*ptr)->getMinIndexPDimPDe())[i*(*ptr)->getDimCount()]), - sizeof(int)*(*ptr)->getDimCount()); - } - // fill maxIndexPDimPDe - if (present(maxIndexPDimPDe)){ - // maxIndexPDimPDe was provided -> do some error checking - if ((maxIndexPDimPDe)->dimCount != 2){ - ESMC_LogDefault.MsgFoundError(ESMC_RC_ARG_RANK, - "maxIndexPDimPDe array must be of rank 2", ESMC_CONTEXT, rc); - return; - } - if ((maxIndexPDimPDe)->extent[0] < (*ptr)->getDimCount()){ - ESMC_LogDefault.MsgFoundError(ESMC_RC_ARG_SIZE, - "1st dim of maxIndexPDimPDe array must be of size 'dimCount'", - ESMC_CONTEXT, rc); - return; - } - if ((maxIndexPDimPDe)->extent[1] < (*ptr)->getDELayout()->getDeCount()){ - ESMC_LogDefault.MsgFoundError(ESMC_RC_ARG_SIZE, - "2nd dim of maxIndexPDimPDe array must be of size 'deCount'", - ESMC_CONTEXT, rc); - return; + if ((minIndexPDimPDe)->extent[1] < (*ptr)->getDELayout()->getDeCount()){ + ESMC_LogDefault.MsgFoundError(ESMC_RC_ARG_SIZE, + "2nd dim of minIndexPDimPDe array must be of size 'deCount'", + ESMC_CONTEXT, rc); + return; + } + // fill in the values: The interface allows to pass in minIndexPDimPDe + // arrays which are larger than dimCount x deCount. Consequently it is + // necessary to memcpy strips of contiguous data since it cannot be + // assumed that all data ends up contiguous in the minIndexPDimPDe + // array. + for (int i=0; i<(*ptr)->getDELayout()->getDeCount(); i++) + memcpy( + &((minIndexPDimPDe)->array[i*((minIndexPDimPDe)->extent[0])]), + &(((*ptr)->getMinIndexPDimPDe())[i*(*ptr)->getDimCount()]), + sizeof(int)*(*ptr)->getDimCount()); } - // fill in the values: The interface allows to pass in maxIndexPDimPDe - // arrays which are larger than dimCount x deCount. Consequently it is - // necessary to memcpy strips of contiguous data since it cannot be - // assumed that all data ends up contiguous in the maxIndexPDimPDe - // array. - for (int i=0; i<(*ptr)->getDELayout()->getDeCount(); i++) - memcpy( - &((maxIndexPDimPDe)->array[i*((maxIndexPDimPDe)->extent[0])]), - &(((*ptr)->getMaxIndexPDimPDe())[i*(*ptr)->getDimCount()]), - sizeof(int)*(*ptr)->getDimCount()); - } - // fill elementCountPDe - if (present(elementCountPDe) || present(elementCountPDeI8)){ - // access the internal information - int deCount = (*ptr)->getDELayout()->getDeCount(); - const ESMC_I8 *access = (*ptr)->getElementCountPDe(); - if (present(elementCountPDe)){ - // elementCountPDe was provided -> do some error checking - if ((elementCountPDe)->dimCount != 1){ + // fill maxIndexPDimPDe + if (present(maxIndexPDimPDe)){ + // maxIndexPDimPDe was provided -> do some error checking + if ((maxIndexPDimPDe)->dimCount != 2){ ESMC_LogDefault.MsgFoundError(ESMC_RC_ARG_RANK, - "elementCountPDe array must be of rank 1", ESMC_CONTEXT, rc); + "maxIndexPDimPDe array must be of rank 2", ESMC_CONTEXT, rc); return; } - if ((elementCountPDe)->extent[0] < (*ptr)->getDELayout()->getDeCount()){ + if ((maxIndexPDimPDe)->extent[0] < (*ptr)->getDimCount()){ ESMC_LogDefault.MsgFoundError(ESMC_RC_ARG_SIZE, - "1st dim of elementCountPDe array must be of size 'deCount'", + "1st dim of maxIndexPDimPDe array must be of size 'dimCount'", ESMC_CONTEXT, rc); return; } - // fill in values - for (int i=0; i I4, with overflow check - (elementCountPDe)->array[i] = (int)(access[i]); - if ((ESMC_I8)(elementCountPDe)->array[i] != (access[i])){ - ESMC_LogDefault.MsgFoundError(ESMC_RC_ARG_BAD, - "Overflow detected in elementCountPDe after I8 -> I4 cast", + if ((maxIndexPDimPDe)->extent[1] < (*ptr)->getDELayout()->getDeCount()){ + ESMC_LogDefault.MsgFoundError(ESMC_RC_ARG_SIZE, + "2nd dim of maxIndexPDimPDe array must be of size 'deCount'", + ESMC_CONTEXT, rc); + return; + } + // fill in the values: The interface allows to pass in maxIndexPDimPDe + // arrays which are larger than dimCount x deCount. Consequently it is + // necessary to memcpy strips of contiguous data since it cannot be + // assumed that all data ends up contiguous in the maxIndexPDimPDe + // array. + for (int i=0; i<(*ptr)->getDELayout()->getDeCount(); i++) + memcpy( + &((maxIndexPDimPDe)->array[i*((maxIndexPDimPDe)->extent[0])]), + &(((*ptr)->getMaxIndexPDimPDe())[i*(*ptr)->getDimCount()]), + sizeof(int)*(*ptr)->getDimCount()); + } + // fill elementCountPDe + if (present(elementCountPDe) || present(elementCountPDeI8)){ + // access the internal information + int deCount = (*ptr)->getDELayout()->getDeCount(); + const ESMC_I8 *access = (*ptr)->getElementCountPDe(); + if (present(elementCountPDe)){ + // elementCountPDe was provided -> do some error checking + if ((elementCountPDe)->dimCount != 1){ + ESMC_LogDefault.MsgFoundError(ESMC_RC_ARG_RANK, + "elementCountPDe array must be of rank 1", ESMC_CONTEXT, rc); + return; + } + if ((elementCountPDe)->extent[0] < (*ptr)->getDELayout()->getDeCount()){ + ESMC_LogDefault.MsgFoundError(ESMC_RC_ARG_SIZE, + "1st dim of elementCountPDe array must be of size 'deCount'", ESMC_CONTEXT, rc); return; } + // fill in values + for (int i=0; i I4, with overflow check + (elementCountPDe)->array[i] = (int)(access[i]); + if ((ESMC_I8)(elementCountPDe)->array[i] != (access[i])){ + ESMC_LogDefault.MsgFoundError(ESMC_RC_ARG_BAD, + "Overflow detected in elementCountPDe after I8 -> I4 cast", + ESMC_CONTEXT, rc); + return; + } + } + } + if (present(elementCountPDeI8)){ + // elementCountPDeI8 was provided -> do some error checking + if ((elementCountPDeI8)->dimCount != 1){ + ESMC_LogDefault.MsgFoundError(ESMC_RC_ARG_RANK, + "elementCountPDeI8 array must be of rank 1", ESMC_CONTEXT, rc); + return; + } + if ((elementCountPDeI8)->extent[0] < (*ptr)->getDELayout()->getDeCount()){ + ESMC_LogDefault.MsgFoundError(ESMC_RC_ARG_SIZE, + "1st dim of elementCountPDeI8 array must be of size 'deCount'", + ESMC_CONTEXT, rc); + return; + } + // fill in values + memcpy((elementCountPDeI8)->array, access, sizeof(ESMC_I8)*deCount); } } - if (present(elementCountPDeI8)){ - // elementCountPDeI8 was provided -> do some error checking - if ((elementCountPDeI8)->dimCount != 1){ + // fill localDeToDeMap + if (present(localDeToDeMap)){ + // localDeToDeMap was provided -> do some error checking + if ((localDeToDeMap)->dimCount != 1){ ESMC_LogDefault.MsgFoundError(ESMC_RC_ARG_RANK, - "elementCountPDeI8 array must be of rank 1", ESMC_CONTEXT, rc); + "localDeToDeMap array must be of rank 1", ESMC_CONTEXT, rc); return; } - if ((elementCountPDeI8)->extent[0] < (*ptr)->getDELayout()->getDeCount()){ + if ((localDeToDeMap)->extent[0] < (*ptr)->getDELayout()->getLocalDeCount()){ ESMC_LogDefault.MsgFoundError(ESMC_RC_ARG_SIZE, - "1st dim of elementCountPDeI8 array must be of size 'deCount'", + "1st dim of localDeToDeMap array must be of size 'localDeCount'", ESMC_CONTEXT, rc); return; } // fill in values - memcpy((elementCountPDeI8)->array, access, sizeof(ESMC_I8)*deCount); - } - } - // fill localDeToDeMap - if (present(localDeToDeMap)){ - // localDeToDeMap was provided -> do some error checking - if ((localDeToDeMap)->dimCount != 1){ - ESMC_LogDefault.MsgFoundError(ESMC_RC_ARG_RANK, - "localDeToDeMap array must be of rank 1", ESMC_CONTEXT, rc); - return; - } - if ((localDeToDeMap)->extent[0] < (*ptr)->getDELayout()->getLocalDeCount()){ - ESMC_LogDefault.MsgFoundError(ESMC_RC_ARG_SIZE, - "1st dim of localDeToDeMap array must be of size 'localDeCount'", - ESMC_CONTEXT, rc); - return; - } - // fill in values - memcpy((localDeToDeMap)->array, (*ptr)->getDELayout()->getLocalDeToDeMap(), - sizeof(int)*(*ptr)->getDELayout()->getLocalDeCount()); - } - // fill tileListPDe - if (present(tileListPDe)){ - // tileListPDe was provided -> do some error checking - if ((tileListPDe)->dimCount != 1){ - ESMC_LogDefault.MsgFoundError(ESMC_RC_ARG_RANK, - "tileListPDe array must be of rank 1", ESMC_CONTEXT, rc); - return; - } - if ((tileListPDe)->extent[0] < (*ptr)->getDELayout()->getDeCount()){ - ESMC_LogDefault.MsgFoundError(ESMC_RC_ARG_SIZE, - "1st dim of tileListPDe array must be of size 'deCount'", - ESMC_CONTEXT, rc); - return; + memcpy((localDeToDeMap)->array, (*ptr)->getDELayout()->getLocalDeToDeMap(), + sizeof(int)*(*ptr)->getDELayout()->getLocalDeCount()); } - // fill in values - memcpy((tileListPDe)->array, (*ptr)->getTileListPDe(), - sizeof(int)*(*ptr)->getDELayout()->getDeCount()); - } - // fill indexCountPDimPDe - if (present(indexCountPDimPDe)){ - // indexCountPDimPDe was provided -> do some error checking - if ((indexCountPDimPDe)->dimCount != 2){ - ESMC_LogDefault.MsgFoundError(ESMC_RC_ARG_RANK, - "indexCountPDimPDe array must be of rank 2", ESMC_CONTEXT, rc); - return; - } - if ((indexCountPDimPDe)->extent[0] < (*ptr)->getDimCount()){ - ESMC_LogDefault.MsgFoundError(ESMC_RC_ARG_SIZE, - "1st dim of indexCountPDimPDe array must be of size 'dimCount'", - ESMC_CONTEXT, rc); - return; - } - if ((indexCountPDimPDe)->extent[1] < - (*ptr)->getDELayout()->getDeCount()){ - ESMC_LogDefault.MsgFoundError(ESMC_RC_ARG_SIZE, - "2nd dim of indexCountPDimPDe array must be of size 'deCount'", - ESMC_CONTEXT, rc); - return; - } - // fill in the values: The interface allows to pass in indexCountPDimPDe - // arrays which are larger than dimCount x deCount. Consequently it is - // necessary to memcpy strips of contiguous data since it cannot be - // assumed that all data ends up contiguous in the indexCountPDimPDe - // array. - for (int i=0; i<(*ptr)->getDELayout()->getDeCount(); i++) - memcpy( - &((indexCountPDimPDe)->array[i*((indexCountPDimPDe)->extent[0])]), - &(((*ptr)->getIndexCountPDimPDe())[i*(*ptr)->getDimCount()]), - sizeof(int)*(*ptr)->getDimCount()); - } - // fill collocationPDim - if (present(collocationPDim)){ - // collocationPDim was provided -> do some error checking - if ((collocationPDim)->dimCount != 1){ - ESMC_LogDefault.MsgFoundError(ESMC_RC_ARG_RANK, - "collocationPDim array must be of rank 1", ESMC_CONTEXT, rc); - return; - } - if ((collocationPDim)->extent[0] < (*ptr)->getDimCount()){ - ESMC_LogDefault.MsgFoundError(ESMC_RC_ARG_SIZE, - "1st dim of collocationPDim array must be of size 'dimCount'", - ESMC_CONTEXT, rc); - return; - } - // fill in values - memcpy((collocationPDim)->array, (*ptr)->getCollocationPDim(), - sizeof(int)*((*ptr)->getDimCount())); - } - // fill connectionList - if (present(connectionList)){ - // connectionList was provided -> do some error checking - if ((connectionList)->dimCount != 2){ - ESMC_LogDefault.MsgFoundError(ESMC_RC_ARG_RANK, - "connectionList array must be of rank 2", ESMC_CONTEXT, rc); - return; + // fill tileListPDe + if (present(tileListPDe)){ + // tileListPDe was provided -> do some error checking + if ((tileListPDe)->dimCount != 1){ + ESMC_LogDefault.MsgFoundError(ESMC_RC_ARG_RANK, + "tileListPDe array must be of rank 1", ESMC_CONTEXT, rc); + return; + } + if ((tileListPDe)->extent[0] < (*ptr)->getDELayout()->getDeCount()){ + ESMC_LogDefault.MsgFoundError(ESMC_RC_ARG_SIZE, + "1st dim of tileListPDe array must be of size 'deCount'", + ESMC_CONTEXT, rc); + return; + } + // fill in values + memcpy((tileListPDe)->array, (*ptr)->getTileListPDe(), + sizeof(int)*(*ptr)->getDELayout()->getDeCount()); } - if ((connectionList)->extent[0] < 2*((*ptr)->getDimCount()) + 2){ - ESMC_LogDefault.MsgFoundError(ESMC_RC_ARG_SIZE, - "1st dim of connectionList array must be of size '2*dimCount + 2'", - ESMC_CONTEXT, rc); - return; + // fill indexCountPDimPDe + if (present(indexCountPDimPDe)){ + // indexCountPDimPDe was provided -> do some error checking + if ((indexCountPDimPDe)->dimCount != 2){ + ESMC_LogDefault.MsgFoundError(ESMC_RC_ARG_RANK, + "indexCountPDimPDe array must be of rank 2", ESMC_CONTEXT, rc); + return; + } + if ((indexCountPDimPDe)->extent[0] < (*ptr)->getDimCount()){ + ESMC_LogDefault.MsgFoundError(ESMC_RC_ARG_SIZE, + "1st dim of indexCountPDimPDe array must be of size 'dimCount'", + ESMC_CONTEXT, rc); + return; + } + if ((indexCountPDimPDe)->extent[1] < + (*ptr)->getDELayout()->getDeCount()){ + ESMC_LogDefault.MsgFoundError(ESMC_RC_ARG_SIZE, + "2nd dim of indexCountPDimPDe array must be of size 'deCount'", + ESMC_CONTEXT, rc); + return; + } + // fill in the values: The interface allows to pass in indexCountPDimPDe + // arrays which are larger than dimCount x deCount. Consequently it is + // necessary to memcpy strips of contiguous data since it cannot be + // assumed that all data ends up contiguous in the indexCountPDimPDe + // array. + for (int i=0; i<(*ptr)->getDELayout()->getDeCount(); i++) + memcpy( + &((indexCountPDimPDe)->array[i*((indexCountPDimPDe)->extent[0])]), + &(((*ptr)->getIndexCountPDimPDe())[i*(*ptr)->getDimCount()]), + sizeof(int)*(*ptr)->getDimCount()); } - if ((connectionList)->extent[1] < (*ptr)->getConnectionCount()){ - ESMC_LogDefault.MsgFoundError(ESMC_RC_ARG_SIZE, - "2nd dim of connectionList array must be of size 'connectionCount'", - ESMC_CONTEXT, rc); - return; + // fill collocationPDim + if (present(collocationPDim)){ + // collocationPDim was provided -> do some error checking + if ((collocationPDim)->dimCount != 1){ + ESMC_LogDefault.MsgFoundError(ESMC_RC_ARG_RANK, + "collocationPDim array must be of rank 1", ESMC_CONTEXT, rc); + return; + } + if ((collocationPDim)->extent[0] < (*ptr)->getDimCount()){ + ESMC_LogDefault.MsgFoundError(ESMC_RC_ARG_SIZE, + "1st dim of collocationPDim array must be of size 'dimCount'", + ESMC_CONTEXT, rc); + return; + } + // fill in values + memcpy((collocationPDim)->array, (*ptr)->getCollocationPDim(), + sizeof(int)*((*ptr)->getDimCount())); } - // fill in the values: - for (int i=0; i<(*ptr)->getConnectionCount(); i++){ - memcpy( - &((connectionList)->array[i*((connectionList)->extent[0])]), - ((*ptr)->getConnectionList())[i], - sizeof(int)*(2*((*ptr)->getDimCount())+2)); + // fill connectionList + if (present(connectionList)){ + // connectionList was provided -> do some error checking + if ((connectionList)->dimCount != 2){ + ESMC_LogDefault.MsgFoundError(ESMC_RC_ARG_RANK, + "connectionList array must be of rank 2", ESMC_CONTEXT, rc); + return; + } + if ((connectionList)->extent[0] < 2*((*ptr)->getDimCount()) + 2){ + ESMC_LogDefault.MsgFoundError(ESMC_RC_ARG_SIZE, + "1st dim of connectionList array must be of size '2*dimCount + 2'", + ESMC_CONTEXT, rc); + return; + } + if ((connectionList)->extent[1] < (*ptr)->getConnectionCount()){ + ESMC_LogDefault.MsgFoundError(ESMC_RC_ARG_SIZE, + "2nd dim of connectionList array must be of size 'connectionCount'", + ESMC_CONTEXT, rc); + return; + } + // fill in the values: + for (int i=0; i<(*ptr)->getConnectionCount(); i++){ + memcpy( + &((connectionList)->array[i*((connectionList)->extent[0])]), + ((*ptr)->getConnectionList())[i], + sizeof(int)*(2*((*ptr)->getDimCount())+2)); + } } + }catch(int localrc){ + if (ESMC_LogDefault.MsgFoundError(localrc, ESMCI_ERR_PASSTHRU, + ESMC_CONTEXT, rc)) + return; // bail out + }catch(std::exception &x){ + ESMC_LogDefault.MsgFoundError(ESMC_RC_INTNRL_BAD, x.what(), ESMC_CONTEXT, + rc); + return; // bail out + }catch(...){ + ESMC_LogDefault.MsgFoundError(ESMC_RC_INTNRL_BAD, "- Caught exception", + ESMC_CONTEXT, rc); + return; } // return successfully if (rc!=NULL) *rc = ESMF_SUCCESS; @@ -690,8 +704,8 @@ extern "C" { void FTN_X(c_esmc_distgridgetplocalde)(ESMCI::DistGrid **ptr, int *localDeArg, int *collocationArg, ESMC_Logical *arbSeqIndexFlag, - ESMCI::InterArray *seqIndexList, - ESMCI::InterArray *seqIndexListI8, + ESMCI::InterArray *seqIndexList, + ESMCI::InterArray *seqIndexListI8, int *elementCount, ESMC_I8 *elementCountI8, int *rc){ #undef ESMC_METHOD #define ESMC_METHOD "c_esmc_distgridgetplocalde()" @@ -701,62 +715,76 @@ extern "C" { // test for NULL pointer via macro before calling any class methods ESMCI_NULL_CHECK_PRC(ptr, rc) ESMCI_NULL_CHECK_PRC(*ptr, rc) - // shift input indices - int localDe = *localDeArg; // already base 0 - // check input values - int localDeCount = (*ptr)->getDELayout()->getLocalDeCount(); - if (localDe < 0 || localDe > localDeCount-1){ - ESMC_LogDefault.MsgFoundError(ESMC_RC_ARG_BAD, - "Specified local DE out of bounds", ESMC_CONTEXT, - ESMC_NOT_PRESENT_FILTER(rc)); - return; - } - // check incoming collocation argument - int diffCollocationCount = (*ptr)->getDiffCollocationCount(); - const int *collocationTable = (*ptr)->getCollocationTable(); - int collocation; - int collIndex; - if (ESMC_NOT_PRESENT_FILTER(collocationArg) != ESMC_NULL_POINTER){ - collocation = *collocationArg; - int i; - for (i=0; igetDELayout()->getLocalDeCount(); + if (localDe < 0 || localDe > localDeCount-1){ + ESMC_LogDefault.MsgFoundError(ESMC_RC_ARG_BAD, + "Specified local DE out of bounds", ESMC_CONTEXT, ESMC_NOT_PRESENT_FILTER(rc)); return; } - collIndex = i; - }else{ - collocation = collocationTable[0]; // default to first collocation - collIndex = 0; - } - void const *arbSeqIndexList = - (*ptr)->getArbSeqIndexList(localDe, collocation, &localrc); - if (ESMC_LogDefault.MsgFoundError(localrc, ESMCI_ERR_PASSTHRU, - ESMC_CONTEXT, ESMC_NOT_PRESENT_FILTER(rc))) return; - if (ESMC_NOT_PRESENT_FILTER(arbSeqIndexFlag) != ESMC_NULL_POINTER){ - if (arbSeqIndexList) - *arbSeqIndexFlag = ESMF_TRUE; - else - *arbSeqIndexFlag = ESMF_FALSE; + // check incoming collocation argument + int diffCollocationCount = (*ptr)->getDiffCollocationCount(); + const int *collocationTable = (*ptr)->getCollocationTable(); + int collocation; + int collIndex; + if (ESMC_NOT_PRESENT_FILTER(collocationArg) != ESMC_NULL_POINTER){ + collocation = *collocationArg; + int i; + for (i=0; igetArbSeqIndexList(localDe, collocation, &localrc); + if (ESMC_LogDefault.MsgFoundError(localrc, ESMCI_ERR_PASSTHRU, + ESMC_CONTEXT, ESMC_NOT_PRESENT_FILTER(rc))) return; + if (ESMC_NOT_PRESENT_FILTER(arbSeqIndexFlag) != ESMC_NULL_POINTER){ + if (arbSeqIndexList) + *arbSeqIndexFlag = ESMF_TRUE; + else + *arbSeqIndexFlag = ESMF_FALSE; + } + // fill seqIndexList + localrc = (*ptr)->fillSeqIndexList(seqIndexList, localDe, collocation); + if (ESMC_LogDefault.MsgFoundError(localrc, ESMCI_ERR_PASSTHRU, + ESMC_CONTEXT, ESMC_NOT_PRESENT_FILTER(rc))) return; + // fill seqIndexListI8 + localrc = (*ptr)->fillSeqIndexList(seqIndexListI8, localDe, collocation); + if (ESMC_LogDefault.MsgFoundError(localrc, ESMCI_ERR_PASSTHRU, + ESMC_CONTEXT, ESMC_NOT_PRESENT_FILTER(rc))) return; + // set elementCount + int *const *elementCountPCollPLocalDe = + (*ptr)->getElementCountPCollPLocalDe(); + if (ESMC_NOT_PRESENT_FILTER(elementCount) != ESMC_NULL_POINTER) + *elementCount = elementCountPCollPLocalDe[collIndex][localDe]; + if (ESMC_NOT_PRESENT_FILTER(elementCountI8) != ESMC_NULL_POINTER) + *elementCountI8 = (ESMC_I8)elementCountPCollPLocalDe[collIndex][localDe]; + }catch(int localrc){ + if (ESMC_LogDefault.MsgFoundError(localrc, ESMCI_ERR_PASSTHRU, + ESMC_CONTEXT, rc)) + return; // bail out + }catch(std::exception &x){ + ESMC_LogDefault.MsgFoundError(ESMC_RC_INTNRL_BAD, x.what(), ESMC_CONTEXT, + rc); + return; // bail out + }catch(...){ + ESMC_LogDefault.MsgFoundError(ESMC_RC_INTNRL_BAD, "- Caught exception", + ESMC_CONTEXT, rc); + return; } - // fill seqIndexList - localrc = (*ptr)->fillSeqIndexList(seqIndexList, localDe, collocation); - if (ESMC_LogDefault.MsgFoundError(localrc, ESMCI_ERR_PASSTHRU, - ESMC_CONTEXT, ESMC_NOT_PRESENT_FILTER(rc))) return; - // fill seqIndexListI8 - localrc = (*ptr)->fillSeqIndexList(seqIndexListI8, localDe, collocation); - if (ESMC_LogDefault.MsgFoundError(localrc, ESMCI_ERR_PASSTHRU, - ESMC_CONTEXT, ESMC_NOT_PRESENT_FILTER(rc))) return; - // set elementCount - int *const *elementCountPCollPLocalDe = - (*ptr)->getElementCountPCollPLocalDe(); - if (ESMC_NOT_PRESENT_FILTER(elementCount) != ESMC_NULL_POINTER) - *elementCount = elementCountPCollPLocalDe[collIndex][localDe]; - if (ESMC_NOT_PRESENT_FILTER(elementCountI8) != ESMC_NULL_POINTER) - *elementCountI8 = (ESMC_I8)elementCountPCollPLocalDe[collIndex][localDe]; // return successfully if (ESMC_NOT_PRESENT_FILTER(rc)) *rc = ESMF_SUCCESS; } @@ -771,34 +799,48 @@ extern "C" { // test for NULL pointer via macro before calling any class methods ESMCI_NULL_CHECK_PRC(ptr, rc) ESMCI_NULL_CHECK_PRC(*ptr, rc) - // shift input indices - int localDe = *localDeArg; // already base 0 - int dim = *dimArg - 1; // shift to base 0 - // fill indexList - if (present(indexList)){ - // indexList provided -> get indexListPtr & do some error checking - // getIndexListPDimPLocalDe() checks localDe and dim for range! - const int *indexListPtr = - (*ptr)->getIndexListPDimPLocalDe(localDe, dim+1, &localrc); - if (ESMC_LogDefault.MsgFoundError(localrc, ESMCI_ERR_PASSTHRU, - ESMC_CONTEXT, ESMC_NOT_PRESENT_FILTER(rc))) return; - if ((indexList)->dimCount != 1){ - ESMC_LogDefault.MsgFoundError(ESMC_RC_ARG_RANK, - "indexList array must be of rank 1", ESMC_CONTEXT, rc); - return; - } - if ((indexList)->extent[0] < - ((*ptr)->getIndexCountPDimPDe())[(*ptr)->getDELayout()-> - getLocalDeToDeMap()[localDe] * (*ptr)->getDimCount()+dim]){ - ESMC_LogDefault.MsgFoundError(ESMC_RC_ARG_SIZE, - "1st dimension of indexList array size insufficiently", - ESMC_CONTEXT, rc); - return; + try{ + // shift input indices + int localDe = *localDeArg; // already base 0 + int dim = *dimArg - 1; // shift to base 0 + // fill indexList + if (present(indexList)){ + // indexList provided -> get indexListPtr & do some error checking + // getIndexListPDimPLocalDe() checks localDe and dim for range! + const int *indexListPtr = + (*ptr)->getIndexListPDimPLocalDe(localDe, dim+1, &localrc); + if (ESMC_LogDefault.MsgFoundError(localrc, ESMCI_ERR_PASSTHRU, + ESMC_CONTEXT, ESMC_NOT_PRESENT_FILTER(rc))) return; + if ((indexList)->dimCount != 1){ + ESMC_LogDefault.MsgFoundError(ESMC_RC_ARG_RANK, + "indexList array must be of rank 1", ESMC_CONTEXT, rc); + return; + } + if ((indexList)->extent[0] < + ((*ptr)->getIndexCountPDimPDe())[(*ptr)->getDELayout()-> + getLocalDeToDeMap()[localDe] * (*ptr)->getDimCount()+dim]){ + ESMC_LogDefault.MsgFoundError(ESMC_RC_ARG_SIZE, + "1st dimension of indexList array size insufficiently", + ESMC_CONTEXT, rc); + return; + } + // fill in the values + memcpy((indexList)->array, indexListPtr, + sizeof(int) * (*ptr)->getIndexCountPDimPDe()[((*ptr)->getDELayout()-> + getLocalDeToDeMap()[localDe] * (*ptr)->getDimCount()+dim)]); } - // fill in the values - memcpy((indexList)->array, indexListPtr, - sizeof(int) * (*ptr)->getIndexCountPDimPDe()[((*ptr)->getDELayout()-> - getLocalDeToDeMap()[localDe] * (*ptr)->getDimCount()+dim)]); + }catch(int localrc){ + if (ESMC_LogDefault.MsgFoundError(localrc, ESMCI_ERR_PASSTHRU, + ESMC_CONTEXT, rc)) + return; // bail out + }catch(std::exception &x){ + ESMC_LogDefault.MsgFoundError(ESMC_RC_INTNRL_BAD, x.what(), ESMC_CONTEXT, + rc); + return; // bail out + }catch(...){ + ESMC_LogDefault.MsgFoundError(ESMC_RC_INTNRL_BAD, "- Caught exception", + ESMC_CONTEXT, rc); + return; } // return successfully if (rc!=NULL) *rc = ESMF_SUCCESS; @@ -826,7 +868,7 @@ extern "C" { rc); return; // bail out }catch(...){ - ESMC_LogDefault.MsgFoundError(ESMC_RC_INTNRL_BAD, "- Caught exception", + ESMC_LogDefault.MsgFoundError(ESMC_RC_INTNRL_BAD, "- Caught exception", ESMC_CONTEXT, rc); return; } @@ -845,7 +887,7 @@ extern "C" { if (ESMC_LogDefault.MsgFoundError(localrc, ESMCI_ERR_PASSTHRU, ESMC_CONTEXT, ESMC_NOT_PRESENT_FILTER(rc))) return; } - + void FTN_X(c_esmc_distgridprint)(ESMCI::DistGrid **ptr, int *rc){ #undef ESMC_METHOD #define ESMC_METHOD "c_esmc_distgridprint()" @@ -860,7 +902,7 @@ extern "C" { // Flush before crossing language interface to ensure correct output order fflush(stdout); } - + void FTN_X(c_esmc_distgridvalidate)(ESMCI::DistGrid **ptr, int *rc){ #undef ESMC_METHOD #define ESMC_METHOD "c_esmc_distgridvalidate()" @@ -873,7 +915,7 @@ extern "C" { ESMCI_ERR_PASSTHRU, ESMC_CONTEXT, ESMC_NOT_PRESENT_FILTER(rc)); } - + void FTN_X(c_esmc_distgridconnection)( ESMCI::InterArray *connection, int *tileIndexA, int *tileIndexB, ESMCI::InterArray *positionVector, @@ -886,7 +928,7 @@ extern "C" { // Call into the actual C++ method wrapped inside LogErr handling ESMC_LogDefault.MsgFoundError( ESMCI::DistGrid::connection(connection, *tileIndexA, - *tileIndexB, positionVector, orientationVector), + *tileIndexB, positionVector, orientationVector), ESMCI_ERR_PASSTHRU, ESMC_CONTEXT, ESMC_NOT_PRESENT_FILTER(rc)); } @@ -899,7 +941,7 @@ extern "C" { if (rc!=NULL) *rc = ESMC_RC_NOT_IMPL; // Call into the actual C++ method wrapped inside LogErr handling ESMC_LogDefault.MsgFoundError( - ESMCI::DistGrid::regDecompSetCubic(regDecomp, *deCount), + ESMCI::DistGrid::regDecompSetCubic(regDecomp, *deCount), ESMCI_ERR_PASSTHRU, ESMC_CONTEXT, ESMC_NOT_PRESENT_FILTER(rc)); } @@ -918,9 +960,9 @@ extern "C" { ESMCI_ERR_PASSTHRU, ESMC_CONTEXT, ESMC_NOT_PRESENT_FILTER(rc)); } - + void FTN_X(c_esmc_distgridsetarbseqindex)( - ESMCI::DistGrid **ptr, ESMCI::InterArray *arbSeqIndex, + ESMCI::DistGrid **ptr, ESMCI::InterArray *arbSeqIndex, int *localDe, int *collocation, int *rc){ #undef ESMC_METHOD #define ESMC_METHOD "c_esmc_distgridsetarbseqindex()" @@ -936,7 +978,7 @@ extern "C" { } void FTN_X(c_esmc_distgridsetarbseqindexi8)( - ESMCI::DistGrid **ptr, ESMCI::InterArray *arbSeqIndex, + ESMCI::DistGrid **ptr, ESMCI::InterArray *arbSeqIndex, int *localDe, int *collocation, int *rc){ #undef ESMC_METHOD #define ESMC_METHOD "c_esmc_distgridsetarbseqindex()" @@ -950,7 +992,7 @@ extern "C" { ESMCI_ERR_PASSTHRU, ESMC_CONTEXT, ESMC_NOT_PRESENT_FILTER(rc)); } - + void FTN_X(c_esmc_distgridserialize)(ESMCI::DistGrid **distgrid, char *buf, int *length, int *offset, ESMC_InquireFlag *inquireflag, int *rc, ESMCI_FortranStrLenArg buf_l){ From 89c32c3d4fc292a775e10a5c3a2a18523b24c2b6 Mon Sep 17 00:00:00 2001 From: Robert Oehmke Date: Tue, 29 Oct 2024 22:00:35 -0600 Subject: [PATCH 092/207] Add test of node and element masks across Mesh dual. --- .../Mesh/tests/ESMF_MeshUTest.F90 | 74 +++++++++++++++++-- 1 file changed, 68 insertions(+), 6 deletions(-) diff --git a/src/Infrastructure/Mesh/tests/ESMF_MeshUTest.F90 b/src/Infrastructure/Mesh/tests/ESMF_MeshUTest.F90 index 9016ae4288..0ec7dfe43b 100644 --- a/src/Infrastructure/Mesh/tests/ESMF_MeshUTest.F90 +++ b/src/Infrastructure/Mesh/tests/ESMF_MeshUTest.F90 @@ -8364,6 +8364,14 @@ subroutine exhaustiveMeshDualTest(correct, rc) 9,10,11,12,13,14,& 15,16/) + !! node mask + !! (Ids + 10) + allocate(nodeMask(numNodes)) + nodeMask=(/11,12,13,14,15,16,17,18, & + 19,20,21,22,23,24,& + 25,26/) + + !! node Coords allocate(nodeCoords(numNodes*2)) @@ -8400,6 +8408,12 @@ subroutine exhaustiveMeshDualTest(correct, rc) allocate(elemIds(numElems)) elemIds=(/1,2,3,4,5,6,7,8,9/) + !! elem mask + !! (Ids+100) + allocate(elemMask(numElems)) + elemMask=(/101,102,103,104,105,106,107,108,109/) + + !! elem types allocate(elemTypes(numElems)) elemTypes=(/ESMF_MESHELEMTYPE_QUAD, & ! 1 @@ -8447,6 +8461,12 @@ subroutine exhaustiveMeshDualTest(correct, rc) allocate(nodeIds(numNodes)) nodeIds=(/1,2,5,6/) + !! node mask + !! (ids+10) + allocate(nodeMask(numNodes)) + nodeMask=(/11,12,15,16/) + + !! node Coords allocate(nodeCoords(numNodes*2)) nodeCoords=(/0.0,0.0, & ! 1 @@ -8468,6 +8488,11 @@ subroutine exhaustiveMeshDualTest(correct, rc) allocate(elemIds(numElems)) elemIds=(/1/) + !! elem mask + !! (ids+100) + allocate(elemMask(numElems)) + elemMask=(/101/) + !! elem types allocate(elemTypes(numElems)) elemTypes=(/ESMF_MESHELEMTYPE_QUAD/) ! 1 @@ -8489,6 +8514,11 @@ subroutine exhaustiveMeshDualTest(correct, rc) allocate(nodeIds(numNodes)) nodeIds=(/2,3,4,6,7,8/) + !! node mask + !! (ids+10) + allocate(nodeMask(numNodes)) + nodeMask=(/12,13,14,16,17,18/) + !! node Coords allocate(nodeCoords(numNodes*2)) nodeCoords=(/1.0,0.0, & ! 2 @@ -8519,6 +8549,12 @@ subroutine exhaustiveMeshDualTest(correct, rc) allocate(elemIds(numElems)) elemIds=(/2,3/) + !! elem mask + !! (ids+100) + allocate(elemMask(numElems)) + elemMask=(/102,103/) + + !! elem types allocate(elemTypes(numElems)) elemTypes=(/ESMF_MESHELEMTYPE_QUAD, & ! 2 @@ -8545,7 +8581,14 @@ subroutine exhaustiveMeshDualTest(correct, rc) nodeIds=(/5,6,7, & 9,10,11, & 13,14,15/) - + + !! node mask + !! (ids+10) + allocate(nodeMask(numNodes)) + nodeMask=(/15,16,17, & + 19,20,21, & + 23,24,25/) + !! node Coords allocate(nodeCoords(numNodes*2)) @@ -8583,6 +8626,11 @@ subroutine exhaustiveMeshDualTest(correct, rc) allocate(elemIds(numElems)) elemIds=(/4,5,7,8/) + !! elem mask + !! (ids+100) + allocate(elemMask(numElems)) + elemMask=(/104,105,107,108/) + !! elem types allocate(elemTypes(numElems)) elemTypes=(/ESMF_MESHELEMTYPE_QUAD, & ! 4 @@ -8613,6 +8661,11 @@ subroutine exhaustiveMeshDualTest(correct, rc) allocate(nodeIds(numNodes)) nodeIds=(/7,8,11,12,15,16/) + !! node mask + !! (ids+10) + allocate(nodeMask(numNodes)) + nodeMask=(/17,18,21,22,25,26/) + !! node Coords allocate(nodeCoords(numNodes*2)) nodeCoords=(/2.0,1.0, & ! 7 @@ -8642,6 +8695,11 @@ subroutine exhaustiveMeshDualTest(correct, rc) allocate(elemIds(numElems)) elemIds=(/6,9/) + !! elem mask + !! (ids+100) + allocate(elemMask(numElems)) + elemMask=(/106,109/) + !! elem types allocate(elemTypes(numElems)) elemTypes=(/ESMF_MESHELEMTYPE_QUAD, & ! 6 @@ -8664,9 +8722,9 @@ subroutine exhaustiveMeshDualTest(correct, rc) mesh=ESMF_MeshCreate(parametricDim=2,spatialDim=2, & coordSys=ESMF_COORDSYS_SPH_DEG, & nodeIds=nodeIds, nodeCoords=nodeCoords, & - nodeOwners=nodeOwners, elementIds=elemIds,& - elementTypes=elemTypes, elementConn=elemConn, & - elementCoords=elemCoords, & + nodeOwners=nodeOwners, nodeMask=nodeMask, & + elementIds=elemIds, elementTypes=elemTypes, elementConn=elemConn, & + elementCoords=elemCoords, elementMask=elemMask, & rc=rc) if (rc /= ESMF_SUCCESS) return @@ -8674,12 +8732,14 @@ subroutine exhaustiveMeshDualTest(correct, rc) deallocate(nodeIds) deallocate(nodeCoords) deallocate(nodeOwners) + deallocate(nodeMask) ! deallocate elem data deallocate(elemIds) deallocate(elemTypes) deallocate(elemCoords) deallocate(elemConn) + deallocate(elemMask) ! Create Dual Mesh dualMesh=ESMF_MeshCreateDual(mesh, rc=rc) @@ -8725,9 +8785,9 @@ subroutine exhaustiveMeshDualTest(correct, rc) call ESMF_MeshGet(dualMesh, & nodeIds=nodeIds, & nodeCoords=nodeCoords, & -! nodeMask=nodeMask, & + nodeMask=nodeMask, & elementIds=elemIds, & -! elementMask=elemMask, & + elementMask=elemMask, & elementCoords=elemCoords, & rc=rc) if (rc /= ESMF_SUCCESS) return @@ -8754,6 +8814,7 @@ subroutine exhaustiveMeshDualTest(correct, rc) nodeCoordsTst=(/0.50, 0.50, 1.5, 0.50, 2.5, 0.50, 0.50, 1.5, 1.5, 1.5, 2.5, 1.5, 0.50, 2.5, 1.5, 2.5, 2.5, 2.5/) do i=1,numNodes if (nodeIdsTst(i) /= nodeIds(i)) correct=.false. + if (nodeMask(i) /= nodeIds(i)+100) correct=.false. if (nodeCoordsTst(2*i-1) /= nodeCoords(2*i-1)) correct=.false. if (nodeCoordsTst(2*i) /= nodeCoords(2*i)) correct=.false. enddo @@ -8763,6 +8824,7 @@ subroutine exhaustiveMeshDualTest(correct, rc) elemCoordsTst=(/1.0, 1.0, 2.0, 1.0, 1.0, 2.0, 2.0, 2.0/) do i=1,numElems if (elemIdsTst(i) /= elemIds(i)) correct=.false. + if (elemMask(i) /= elemIds(i)+10) correct=.false. if (elemCoordsTst(2*i-1) /= elemCoords(2*i-1)) correct=.false. if (elemCoordsTst(2*i) /= elemCoords(2*i)) correct=.false. enddo From 678625acdb9dbeac7a76d355c67e6f0745cd8708 Mon Sep 17 00:00:00 2001 From: Robert Oehmke Date: Wed, 30 Oct 2024 14:58:19 -0600 Subject: [PATCH 093/207] Fix original coordinates and masking in dual. Also take out some debug output. --- src/Infrastructure/Mesh/src/ESMCI_MeshDual.C | 41 +++++++++++-------- src/Infrastructure/Mesh/src/ESMCI_Mesh_Glue.C | 6 --- .../Mesh/src/Legacy/ESMCI_FieldReg.C | 4 -- .../Mesh/tests/ESMF_MeshUTest.F90 | 2 +- 4 files changed, 25 insertions(+), 28 deletions(-) diff --git a/src/Infrastructure/Mesh/src/ESMCI_MeshDual.C b/src/Infrastructure/Mesh/src/ESMCI_MeshDual.C index 98d74042f8..61fc91ea6e 100644 --- a/src/Infrastructure/Mesh/src/ESMCI_MeshDual.C +++ b/src/Infrastructure/Mesh/src/ESMCI_MeshDual.C @@ -228,6 +228,17 @@ void MeshDual(Mesh *src_mesh, Mesh **_dual_mesh) { MEField<> *src_node_mask=src_mesh->GetField("mask"); + // Detect what optional fields should be present in the dual + bool dual_has_elemOrigCoords=false; + if (src_node_orig_coords) dual_has_elemOrigCoords=true; + + bool dual_has_elemMaskVal=false; + if (src_node_mask_val) dual_has_elemMaskVal=true; + + bool dual_has_elemMask=false; + if (src_node_mask) dual_has_elemMask=true; + + // Iterate through all src elements counting the number and creating a map std::map id_to_index; int pos=0; @@ -324,9 +335,9 @@ void MeshDual(Mesh *src_mesh, Mesh **_dual_mesh) { elemId=new UInt[max_num_elems]; elemOwner=new UInt[max_num_elems]; elemCoords=new double[sdim*max_num_elems]; - if (src_node_orig_coords) elemOrigCoords=new double[orig_sdim*max_num_elems]; - if (src_node_mask_val) elemMaskVal=new double[max_num_elems]; - if (src_node_mask) elemMask=new double[max_num_elems]; + if (dual_has_elemOrigCoords) elemOrigCoords=new double[orig_sdim*max_num_elems]; + if (dual_has_elemMaskVal) elemMaskVal=new double[max_num_elems]; + if (dual_has_elemMask) elemMask=new double[max_num_elems]; } int *elemConn=NULL; if (max_num_elemConn >0) { @@ -669,9 +680,9 @@ void MeshDual(Mesh *src_mesh, Mesh **_dual_mesh) { elemId_wsplit=new UInt[num_elems_wsplit]; elemOwner_wsplit=new UInt[num_elems_wsplit]; elemCoords_wsplit=new double[sdim*num_elems_wsplit]; - if (elemOrigCoords) elemOrigCoords_wsplit=new double[orig_sdim*num_elems_wsplit]; - if (elemMaskVal) elemMaskVal_wsplit=new double[num_elems_wsplit]; - if (elemMask) elemMask_wsplit=new double[num_elems_wsplit]; + if (dual_has_elemOrigCoords) elemOrigCoords_wsplit=new double[orig_sdim*num_elems_wsplit]; + if (dual_has_elemMaskVal) elemMaskVal_wsplit=new double[num_elems_wsplit]; + if (dual_has_elemMask) elemMask_wsplit=new double[num_elems_wsplit]; #if 0 //// Setup for split mask @@ -768,7 +779,7 @@ void MeshDual(Mesh *src_mesh, Mesh **_dual_mesh) { } // Set orig element coords. - if (elemOrigCoords) { + if (elemOrigCoords && elemOrigCoords_wsplit) { double *elem_orig_pnt=elemOrigCoords+orig_sdim*e; double *elem_orig_pnt_wsplit=elemOrigCoords_wsplit+orig_sdim*split_elem_pos; for (int od=0; odRegisterField("elem_coordinates", MEFamilyDG0::instance(), MeshObj::ELEMENT, ctxt, sdim, true); -// if (elemOrigCoords) { - if (src_node_orig_coords) { - char buff[1024]; - sprintf(buff,"BOB: MeshDual: adding elem_orig_coordinates"); - ESMC_LogDefault.Write(buff, ESMC_LOGMSG_INFO); + + if (dual_has_elemOrigCoords) { dual_mesh->RegisterField("elem_orig_coordinates", MEFamilyDG0::instance(), MeshObj::ELEMENT, ctxt, orig_sdim, true); - } - if (elemMaskVal) { + if (dual_has_elemMaskVal) { dual_mesh->RegisterField("elem_mask_val", MEFamilyDG0::instance(), MeshObj::ELEMENT, ctxt, 1, true); } - if (elemMask) { + if (dual_has_elemMask) { dual_mesh->RegisterField("elem_mask", MEFamilyDG0::instance(), MeshObj::ELEMENT, ctxt, 1, true); diff --git a/src/Infrastructure/Mesh/src/ESMCI_Mesh_Glue.C b/src/Infrastructure/Mesh/src/ESMCI_Mesh_Glue.C index 110138d66a..08f764546a 100644 --- a/src/Infrastructure/Mesh/src/ESMCI_Mesh_Glue.C +++ b/src/Infrastructure/Mesh/src/ESMCI_Mesh_Glue.C @@ -3367,12 +3367,6 @@ void ESMCI_meshdeserialize(Mesh **meshpp, meshp->max_non_split_id=max_non_split_id; // printf(" is_split=%d mnsi=%d\n",meshp->is_split,meshp->max_non_split_id); - - for (int i=0; i nvalSetObj; // keep track of sizes of _fields MEField<> &f = *fi->second; //std::cout << "Imprinting MEField:" << f.name() << std::endl; - - char buff[1024]; - sprintf(buff,"BOB: ord=%d MEField=%s",ord,f.name().c_str()); - ESMC_LogDefault.Write(buff, ESMC_LOGMSG_INFO); f.ordinal = ord++; // Loop obj type diff --git a/src/Infrastructure/Mesh/tests/ESMF_MeshUTest.F90 b/src/Infrastructure/Mesh/tests/ESMF_MeshUTest.F90 index 0ec7dfe43b..82439f1c7d 100644 --- a/src/Infrastructure/Mesh/tests/ESMF_MeshUTest.F90 +++ b/src/Infrastructure/Mesh/tests/ESMF_MeshUTest.F90 @@ -2039,7 +2039,7 @@ program ESMF_MeshUTest #endif !----------------------------------------------------------------------------- !NEX_UTest - write(name, *) "Mesh Create Dual with checking of element coords and masking" + write(name, *) "Mesh create dual with element coords and masking" write(failMsg, *) "Did not return ESMF_SUCCESS" ! initialize check variables From 6bfd140dcaa4597652729efa5f1feb116f7c2867 Mon Sep 17 00:00:00 2001 From: Robert Oehmke Date: Thu, 31 Oct 2024 13:30:10 -0600 Subject: [PATCH 094/207] Simple test and some adjustments for transpose RH. --- .../Field/src/ESMF_FieldRegrid.F90 | 4 +- .../Field/tests/ESMF_FieldRegridUTest.F90 | 562 +++++++++++++++++- 2 files changed, 562 insertions(+), 4 deletions(-) diff --git a/src/Infrastructure/Field/src/ESMF_FieldRegrid.F90 b/src/Infrastructure/Field/src/ESMF_FieldRegrid.F90 index 5938139998..c40d411a6b 100644 --- a/src/Infrastructure/Field/src/ESMF_FieldRegrid.F90 +++ b/src/Infrastructure/Field/src/ESMF_FieldRegrid.F90 @@ -667,8 +667,8 @@ subroutine ESMF_FieldRegridStoreNX(srcField, dstField, keywordEnforcer, & ! \apiDeprecatedArgWithReplacement{factorList} ! \item [{[indices]}] ! \apiDeprecatedArgWithReplacement{factorIndexList} -! \item [transposeRoutehandle] -! A routeHandle to the transpose of the regrid sparse matrix. The +! \item [transposeRoutehandle] +! A routeHandle for the transpose of the regrid sparse matrix. The ! transposed operation goes from {\tt dstField} to {\tt srcField}. ! \item [{[srcFracField]}] ! The fraction of each source cell participating in the regridding. Only diff --git a/src/Infrastructure/Field/tests/ESMF_FieldRegridUTest.F90 b/src/Infrastructure/Field/tests/ESMF_FieldRegridUTest.F90 index 97007e3763..dbd2aa38ab 100644 --- a/src/Infrastructure/Field/tests/ESMF_FieldRegridUTest.F90 +++ b/src/Infrastructure/Field/tests/ESMF_FieldRegridUTest.F90 @@ -1549,6 +1549,22 @@ program ESMF_FieldRegridUTest ! return result call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE) !------------------------------------------------------------------------ + + !------------------------------------------------------------------------ + !EX_UTest + ! Test regrid matrix + write(failMsg, *) "Test unsuccessful" + write(name, *) "Test regrid transpose." + + ! initialize + rc=ESMF_SUCCESS + + ! do test + call test_regrid_transpose(rc) + + ! return result + call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE) + !------------------------------------------------------------------------ #endif #endif @@ -46924,8 +46940,550 @@ end subroutine test_sph_vec_blnr_csG_to_llG_p + subroutine test_regrid_transpose(rc) + integer, intent(out) :: rc + logical :: correct + integer :: localrc + type(ESMF_Grid) :: srcGrid + type(ESMF_Grid) :: dstGrid + type(ESMF_Field) :: srcField + type(ESMF_Field) :: dstField + type(ESMF_Field) :: tmpField + type(ESMF_Field) :: xdstField + type(ESMF_Field) :: xsrcField + type(ESMF_Array) :: dstArray + type(ESMF_Array) :: srcArray + type(ESMF_Array) :: tmpArray + type(ESMF_RouteHandle) :: routeHandle + type(ESMF_RouteHandle) :: transposeRouteHandle + type(ESMF_ArraySpec) :: arrayspec + type(ESMF_VM) :: vm + real(ESMF_KIND_R8), pointer :: farrayPtrXC(:,:) + real(ESMF_KIND_R8), pointer :: farrayPtrYC(:,:) + real(ESMF_KIND_R8), pointer :: farrayPtr1DXC(:) + real(ESMF_KIND_R8), pointer :: farrayPtr1DYC(:) + real(ESMF_KIND_R8), pointer :: farrayPtr(:,:,:), farrayPtr2(:,:) + real(ESMF_KIND_R8), pointer :: xfarrayPtr(:,:,:) + real(ESMF_KIND_R8), pointer :: tmpfarrayPtr(:,:) + integer :: clbnd(2),cubnd(2) + integer :: fclbnd(3),fcubnd(3) + integer :: i1,i2,i3, index(2) + integer :: lDE, srclocalDECount, dstlocalDECount + real(ESMF_KIND_R8) :: coord(2) + character(len=ESMF_MAXSTR) :: string + integer src_nx, src_ny, dst_nx, dst_ny + integer num_arrays + real(ESMF_KIND_R8) :: dx,dy + + real(ESMF_KIND_R8) :: src_dx, src_dy + real(ESMF_KIND_R8) :: dst_dx, dst_dy + + real(ESMF_KIND_R8) :: lon, lat, theta, phi + real(ESMF_KIND_R8), parameter :: DEG2RAD = 3.141592653589793/180.0_ESMF_KIND_R8 + + integer :: localPet, petCount - - + ! result code + integer :: finalrc + + ! init success flag + correct=.true. + + rc=ESMF_SUCCESS + + ! get pet info + call ESMF_VMGetGlobal(vm, rc=localrc) + if (ESMF_LogFoundError(localrc, & + ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, rcToReturn=rc)) return + + call ESMF_VMGet(vm, petCount=petCount, localPet=localpet, rc=localrc) + if (ESMF_LogFoundError(localrc, & + ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, rcToReturn=rc)) return + + + + ! Src Grid + srcGrid=ESMF_GridCreate1PeriDimUfrm(maxIndex=(/180,180/),& + minCornerCoord=(/0.0_ESMF_KIND_R8,-90.0_ESMF_KIND_R8/), & + maxCornerCoord=(/360.0_ESMF_KIND_R8,90.0_ESMF_KIND_R8/), & + regDecomp=(/1,petCount/), & + staggerLocList=(/ESMF_STAGGERLOC_CENTER/), & + rc=localrc) + if (localrc /=ESMF_SUCCESS) then + rc=ESMF_FAILURE + return + endif + + + ! Src Field + srcField = ESMF_FieldCreate(srcGrid, typekind=ESMF_TYPEKIND_R8, & + ungriddedLBound=(/1/), ungriddedUBound=(/2/), & ! 2D vector + staggerloc=ESMF_STAGGERLOC_CENTER, name="source", rc=localrc) + if (localrc /=ESMF_SUCCESS) then + rc=ESMF_FAILURE + return + endif + + + ! Exact src Field + xsrcField = ESMF_FieldCreate(srcGrid, typekind=ESMF_TYPEKIND_R8, & + ungriddedLBound=(/1/), ungriddedUBound=(/2/), & ! 2D vector + staggerloc=ESMF_STAGGERLOC_CENTER, name="source exact", rc=localrc) + if (localrc /=ESMF_SUCCESS) then + rc=ESMF_FAILURE + return + endif + + + ! Get srcArray from Field + call ESMF_FieldGet(srcField, array=srcArray, rc=localrc) + if (localrc /=ESMF_SUCCESS) then + rc=ESMF_FAILURE + return + endif + + + ! Get number of local DEs + call ESMF_GridGet(srcGrid, localDECount=srclocalDECount, rc=localrc) + if (localrc /=ESMF_SUCCESS) then + rc=ESMF_FAILURE + return + endif + + + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + ! Destination grid + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + + + ! Setup dest. grid + ! Make a grid that still matches up with identical points, but is + ! only the center, so that matrix is identity, but the src/dst indices aren't + ! the same, this'll let us test the trasponse where the indices will change. + dstGrid=ESMF_GridCreate1PeriDimUfrm(maxIndex=(/180,90/),& + minCornerCoord=(/0.0_ESMF_KIND_R8,-45.0_ESMF_KIND_R8/), & + maxCornerCoord=(/360.0_ESMF_KIND_R8,45.0_ESMF_KIND_R8/), & + regDecomp=(/1,petCount/), & + staggerLocList=(/ESMF_STAGGERLOC_CENTER/), & + rc=localrc) + if (localrc /=ESMF_SUCCESS) then + rc=ESMF_FAILURE + return + endif + + + ! Create Fields + dstField = ESMF_FieldCreate(dstGrid, typekind=ESMF_TYPEKIND_R8, & + ungriddedLBound=(/1/), ungriddedUBound=(/2/), & ! 2D vector + staggerloc=ESMF_STAGGERLOC_CENTER, name="dest", rc=localrc) + if (localrc /=ESMF_SUCCESS) then + rc=ESMF_FAILURE + return + endif + + xdstField = ESMF_FieldCreate(dstGrid, typekind=ESMF_TYPEKIND_R8, & + ungriddedLBound=(/1/), ungriddedUBound=(/2/), & ! 2D vector + staggerloc=ESMF_STAGGERLOC_CENTER, name="xdest", rc=localrc) + if (localrc /=ESMF_SUCCESS) then + rc=ESMF_FAILURE + return + endif + + + ! Get dstArray from Field + call ESMF_FieldGet(dstField, array=dstArray, rc=localrc) + if (localrc /=ESMF_SUCCESS) then + rc=ESMF_FAILURE + return + endif + + + ! Get number of local DEs + call ESMF_GridGet(dstGrid, localDECount=dstlocalDECount, rc=localrc) + if (localrc /=ESMF_SUCCESS) then + rc=ESMF_FAILURE + return + endif + + +#if 0 + call ESMF_GridWriteVTK(srcGrid,staggerloc=ESMF_STAGGERLOC_CENTER, & + filename="srcGrid", rc=localrc) + if (localrc /=ESMF_SUCCESS) then + rc=ESMF_FAILURE + return + endif +#endif + + !! Create routehandles + call ESMF_FieldRegridStore( & + srcField, & + dstField=dstField, & + routeHandle=routeHandle, & + transposeRouteHandle=transposeRouteHandle, & + regridmethod=ESMF_REGRIDMETHOD_NEAREST_STOD, & ! Gives a nice matrix full of just 1.0 + rc=localrc) + if (localrc /=ESMF_SUCCESS) then + rc=ESMF_FAILURE + return + endif + + + + !!!!! Forward direction fill Src and init Dst and check results !!!! + + + ! Fill src data + do lDE=0,srclocalDECount-1 + + !! get coord 1 + call ESMF_GridGetCoord(srcGrid, localDE=lDE, staggerLoc=ESMF_STAGGERLOC_CENTER, coordDim=1, & + farrayPtr=farrayPtr1DXC, rc=localrc) + if (localrc /=ESMF_SUCCESS) then + rc=ESMF_FAILURE + return + endif + + call ESMF_GridGetCoord(srcGrid, localDE=lDE, staggerLoc=ESMF_STAGGERLOC_CENTER, coordDim=2, & + farrayPtr=farrayPtr1DYC, rc=localrc) + if (localrc /=ESMF_SUCCESS) then + rc=ESMF_FAILURE + return + endif + + + ! get src pointer + call ESMF_FieldGet(srcField, lDE, farrayPtr, & + computationalLBound=fclbnd, computationalUBound=fcubnd, & + rc=localrc) + if (localrc /=ESMF_SUCCESS) then + rc=ESMF_FAILURE + return + endif + + !! Set Field value + do i1=fclbnd(1),fcubnd(1) + + ! Get X coord from Grid + lon = farrayPtr1DXC(i1) + theta = DEG2RAD*(lon) + + do i2=fclbnd(2),fcubnd(2) + + ! Get Y coord from Grid + lat = farrayPtr1DYC(i2) + phi = DEG2RAD*(90.-lat) + + ! initialize source field to lon and lat + farrayPtr(i1,i2,1)=lon + farrayPtr(i1,i2,2)=lat + enddo + enddo + + enddo ! lDE + + ! Init Dst and set exact answers + do lDE=0,dstlocalDECount-1 + + !! get coords + call ESMF_GridGetCoord(dstGrid, localDE=lDE, staggerLoc=ESMF_STAGGERLOC_CENTER, coordDim=1, & + farrayPtr=farrayPtr1DXC,rc=localrc) + if (localrc /=ESMF_SUCCESS) then + rc=ESMF_FAILURE + return + endif + + call ESMF_GridGetCoord(dstGrid, localDE=lDE, staggerLoc=ESMF_STAGGERLOC_CENTER, coordDim=2, & + farrayPtr=farrayPtr1DYC, rc=localrc) + if (localrc /=ESMF_SUCCESS) then + rc=ESMF_FAILURE + return + endif + + + call ESMF_FieldGet(dstField, lDE, farrayPtr, & + computationalLBound=fclbnd, computationalUBound=fcubnd, & + rc=localrc) + if (localrc /=ESMF_SUCCESS) then + rc=ESMF_FAILURE + return + endif + + + call ESMF_FieldGet(xdstField, lDE, xfarrayPtr, rc=localrc) + if (localrc /=ESMF_SUCCESS) then + rc=ESMF_FAILURE + return + endif + + + !! Set Field value + do i1=fclbnd(1),fcubnd(1) + + ! Get X coord from Grid + lon = farrayPtr1DXC(i1) + theta = DEG2RAD*(lon) + + do i2=fclbnd(2),fcubnd(2) + + ! Get Y coord from Grid + lat = farrayPtr1DYC(i2) + phi = DEG2RAD*(90.-lat) + + ! Init exact field to lon and lat + xfarrayPtr(i1,i2,1) = lon + xfarrayPtr(i1,i2,2) = lat + + ! initialize destination field + farrayPtr(i1,i2,1)=1000.0 + farrayPtr(i1,i2,2)=1000.0 + enddo + enddo + + enddo ! lDE + + ! Do regrid + call ESMF_FieldRegrid(srcField, dstField, routeHandle, rc=localrc) + if (localrc /=ESMF_SUCCESS) then + rc=ESMF_FAILURE + return + endif + + + ! Check results + do lDE=0,dstlocalDECount-1 + + call ESMF_FieldGet(dstField, lDE, farrayPtr, & + computationalLBound=fclbnd, computationalUBound=fcubnd, & + rc=localrc) + if (localrc /=ESMF_SUCCESS) then + rc=ESMF_FAILURE + return + endif + + call ESMF_FieldGet(xdstField, lDE, xfarrayPtr, & + rc=localrc) + if (localrc /=ESMF_SUCCESS) then + rc=ESMF_FAILURE + return + endif + + + !! Make sure things look ok + do i1=fclbnd(1),fcubnd(1) + do i2=fclbnd(2),fcubnd(2) + do i3=fclbnd(3),fcubnd(3) + ! if working everything should be close to exact answer + if (abs(farrayPtr(i1,i2,i3)-xfarrayPtr(i1,i2,i3)) .gt. 1.0E-10) then + ! write(*,*) i1,i2,i3," ",farrayPtr(i1,i2,i3),xfarrayPtr(i1,i2,i3) + correct=.false. + endif + enddo + enddo + enddo + + enddo ! lDE + +#if 0 + call ESMF_GridWriteVTK(srcGrid,staggerloc=ESMF_STAGGERLOC_CENTER, & + filename="srcGrid", array1=srcArray, & + rc=localrc) + if (localrc /=ESMF_SUCCESS) then + rc=ESMF_FAILURE + return + endif + + call ESMF_GridWriteVTK(dstGrid,staggerloc=ESMF_STAGGERLOC_CENTER, & + filename="dstGrid", array1=dstArray, & + rc=localrc) + if (localrc /=ESMF_SUCCESS) then + rc=ESMF_FAILURE + return + endif +#endif + + ! Get rid of forward routehandle + call ESMF_FieldRegridRelease(routeHandle, rc=localrc) + if (localrc /=ESMF_SUCCESS) then + rc=ESMF_FAILURE + return + endif + + + + !!!!! Backward direction fill Dst and init Src and check results !!!! + + + ! Fill dst data + do lDE=0,dstlocalDECount-1 + + !! get coords + call ESMF_GridGetCoord(dstGrid, localDE=lDE, staggerLoc=ESMF_STAGGERLOC_CENTER, coordDim=1, & + farrayPtr=farrayPtr1DXC,rc=localrc) + if (localrc /=ESMF_SUCCESS) then + rc=ESMF_FAILURE + return + endif + + call ESMF_GridGetCoord(dstGrid, localDE=lDE, staggerLoc=ESMF_STAGGERLOC_CENTER, coordDim=2, & + farrayPtr=farrayPtr1DYC, rc=localrc) + if (localrc /=ESMF_SUCCESS) then + rc=ESMF_FAILURE + return + endif + + + call ESMF_FieldGet(dstField, lDE, farrayPtr, & + computationalLBound=fclbnd, computationalUBound=fcubnd, & + rc=localrc) + if (localrc /=ESMF_SUCCESS) then + rc=ESMF_FAILURE + return + endif + + + !! Set Field value + do i1=fclbnd(1),fcubnd(1) + + ! Get X coord from Grid + lon = farrayPtr1DXC(i1) + theta = DEG2RAD*(lon) + + do i2=fclbnd(2),fcubnd(2) + + ! Get Y coord from Grid + lat = farrayPtr1DYC(i2) + phi = DEG2RAD*(90.-lat) + + ! initialize destination field + farrayPtr(i1,i2,1)=lon + farrayPtr(i1,i2,2)=lat + enddo + enddo + + enddo ! lDE + + + ! Init Src and set exact answers + do lDE=0,srclocalDECount-1 + + !! get coord 1 + call ESMF_GridGetCoord(srcGrid, localDE=lDE, staggerLoc=ESMF_STAGGERLOC_CENTER, coordDim=1, & + farrayPtr=farrayPtr1DXC, rc=localrc) + if (localrc /=ESMF_SUCCESS) then + rc=ESMF_FAILURE + return + endif + + call ESMF_GridGetCoord(srcGrid, localDE=lDE, staggerLoc=ESMF_STAGGERLOC_CENTER, coordDim=2, & + farrayPtr=farrayPtr1DYC, rc=localrc) + if (localrc /=ESMF_SUCCESS) then + rc=ESMF_FAILURE + return + endif + + + ! get src pointer + call ESMF_FieldGet(srcField, lDE, farrayPtr, & + computationalLBound=fclbnd, computationalUBound=fcubnd, & + rc=localrc) + if (localrc /=ESMF_SUCCESS) then + rc=ESMF_FAILURE + return + endif + + ! Get exact src pointer + call ESMF_FieldGet(xsrcField, lDE, xfarrayPtr, & + rc=localrc) + if (localrc /=ESMF_SUCCESS) then + rc=ESMF_FAILURE + return + endif + + + !! Set Field value + do i1=fclbnd(1),fcubnd(1) + + ! Get X coord from Grid + lon = farrayPtr1DXC(i1) + theta = DEG2RAD*(lon) + + do i2=fclbnd(2),fcubnd(2) + + ! Get Y coord from Grid + lat = farrayPtr1DYC(i2) + phi = DEG2RAD*(90.-lat) + + ! initialize source field to bad value + farrayPtr(i1,i2,1)=1000.00 + farrayPtr(i1,i2,2)=1000.00 + + ! initialize exact source field to lon,lat + xfarrayPtr(i1,i2,1)=lon + xfarrayPtr(i1,i2,2)=lat + + enddo + enddo + + enddo ! lDE + + + ! Do traspose regrid + call ESMF_FieldRegrid(dstField, srcField, transposeRouteHandle, & + zeroregion=ESMF_REGION_SELECT, rc=localrc) + if (localrc /=ESMF_SUCCESS) then + rc=ESMF_FAILURE + return + endif + + + ! TODO: Check results + + + ! Get rid of transpose routehandle + call ESMF_FieldRegridRelease(transposeRouteHandle, rc=localrc) + if (localrc /=ESMF_SUCCESS) then + rc=ESMF_FAILURE + return + endif + + + ! Destroy the Fields + call ESMF_FieldDestroy(srcField, rc=localrc) + if (localrc /=ESMF_SUCCESS) then + rc=ESMF_FAILURE + return + endif + + call ESMF_FieldDestroy(dstField, rc=localrc) + if (localrc /=ESMF_SUCCESS) then + rc=ESMF_FAILURE + return + endif + + + ! Free the grids + call ESMF_GridDestroy(srcGrid, rc=localrc) + if (localrc /=ESMF_SUCCESS) then + rc=ESMF_FAILURE + return + endif + + call ESMF_GridDestroy(dstGrid, rc=localrc) + if (localrc /=ESMF_SUCCESS) then + rc=ESMF_FAILURE + return + endif + + ! return answer based on correct flag + if (correct) then + rc=ESMF_SUCCESS + else + rc=ESMF_FAILURE + endif + + end subroutine test_regrid_transpose end program ESMF_FieldRegridUTest From adea0323ae648cd95621ba7fc8fec300868e1302 Mon Sep 17 00:00:00 2001 From: Robert Oehmke Date: Sun, 3 Nov 2024 16:35:37 -0700 Subject: [PATCH 095/207] Set masking on all mesh objects before doing regridding, otherwise old masking values can sometimes remain in inactive ghostcells. --- src/Infrastructure/Mesh/src/ESMCI_Mesh_Glue.C | 25 ++++++++----------- 1 file changed, 10 insertions(+), 15 deletions(-) diff --git a/src/Infrastructure/Mesh/src/ESMCI_Mesh_Glue.C b/src/Infrastructure/Mesh/src/ESMCI_Mesh_Glue.C index 08f764546a..6a85f780d3 100644 --- a/src/Infrastructure/Mesh/src/ESMCI_Mesh_Glue.C +++ b/src/Infrastructure/Mesh/src/ESMCI_Mesh_Glue.C @@ -3367,7 +3367,8 @@ void ESMCI_meshdeserialize(Mesh **meshpp, meshp->max_non_split_id=max_non_split_id; // printf(" is_split=%d mnsi=%d\n",meshp->is_split,meshp->max_non_split_id); - + + // Register fields Context ctxt; ctxt.flip(); // Needed below for element registration if (fields_present[0]) meshp->RegisterNodalField(*meshp, "coordinates", spatial_dim); @@ -4925,10 +4926,8 @@ void ESMCI_meshturnoncellmask(Mesh **meshpp, ESMCI::InterArray *maskValuesA if ((elem_mask_val!=NULL) && (elem_mask !=NULL)) { - // Loop through elements setting values - // Here we depend on the fact that data index for elements - // is set as the position in the local array above - Mesh::iterator ei = mesh.elem_begin(), ee = mesh.elem_end(); + // Loop through all elements setting values + Mesh::iterator ei = mesh.elem_begin_all(), ee = mesh.elem_end_all(); for (; ei != ee; ++ei) { MeshObj &elem = *ei; @@ -5024,10 +5023,8 @@ void ESMCI_meshturnoffcellmask(Mesh **meshpp, int *rc) { if ((elem_mask_val!=NULL) && (elem_mask !=NULL)) { - // Loop through elements setting values - // Here we depend on the fact that data index for elements - // is set as the position in the local array above - Mesh::iterator ei = mesh.elem_begin(), ee = mesh.elem_end(); + // Loop through all elements setting values + Mesh::iterator ei = mesh.elem_begin_all(), ee = mesh.elem_end_all(); for (; ei != ee; ++ei) { MeshObj &elem = *ei; @@ -5124,8 +5121,8 @@ void ESMCI_meshturnonnodemask(Mesh **meshpp, ESMCI::InterArray *maskValuesA if ((node_mask_val!=NULL) && (node_mask !=NULL)) { - // Loop through nodes setting values - Mesh::iterator ni = mesh.node_begin(), ne = mesh.node_end(); + // Loop through all nodes setting values + Mesh::iterator ni = mesh.node_begin_all(), ne = mesh.node_end_all(); for (; ni != ne; ++ni) { MeshObj &node = *ni; @@ -5219,10 +5216,8 @@ void ESMCI_meshturnoffnodemask(Mesh **meshpp, int *rc) { if ((node_mask_val!=NULL) && (node_mask !=NULL)) { - // Loop through elements setting values - // Here we depend on the fact that data index for elements - // is set as the position in the local array above - Mesh::iterator ni = mesh.node_begin(), ne = mesh.node_end(); + // Loop through all nodes setting values + Mesh::iterator ni = mesh.node_begin_all(), ne = mesh.node_end_all(); for (; ni != ne; ++ni) { MeshObj &node = *ni; From 9313a45e2add8b2cdad0b9a55aaf4096d535aaa7 Mon Sep 17 00:00:00 2001 From: Robert Oehmke Date: Sun, 3 Nov 2024 17:09:24 -0700 Subject: [PATCH 096/207] Init elem frac to 0.0 in GToM cell. --- src/Infrastructure/Mesh/src/ESMCI_Mesh_GToM_Glue.C | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Infrastructure/Mesh/src/ESMCI_Mesh_GToM_Glue.C b/src/Infrastructure/Mesh/src/ESMCI_Mesh_GToM_Glue.C index 869014c0b3..ac130022d3 100644 --- a/src/Infrastructure/Mesh/src/ESMCI_Mesh_GToM_Glue.C +++ b/src/Infrastructure/Mesh/src/ESMCI_Mesh_GToM_Glue.C @@ -1784,7 +1784,7 @@ Par::Out() << "\tnot in mesh!!" << std::endl; // Init fracs if (efields[GTOM_EFIELD_FRAC]) { double *d=efields[GTOM_EFIELD_FRAC]->data(elem); - *d=1.0; + *d=0.0; } if (efields[GTOM_EFIELD_FRAC2]) { From 3e33d87d3bf562e3014a165e8c88d9fca45d10f7 Mon Sep 17 00:00:00 2001 From: Robert Oehmke Date: Mon, 4 Nov 2024 09:43:21 -0700 Subject: [PATCH 097/207] Further additions to transpose routeHandle and better test. --- .../Field/tests/ESMF_FieldRegridUTest.F90 | 45 +++++++++++++++++-- 1 file changed, 42 insertions(+), 3 deletions(-) diff --git a/src/Infrastructure/Field/tests/ESMF_FieldRegridUTest.F90 b/src/Infrastructure/Field/tests/ESMF_FieldRegridUTest.F90 index dbd2aa38ab..f03838f4b6 100644 --- a/src/Infrastructure/Field/tests/ESMF_FieldRegridUTest.F90 +++ b/src/Infrastructure/Field/tests/ESMF_FieldRegridUTest.F90 @@ -1554,7 +1554,7 @@ program ESMF_FieldRegridUTest !EX_UTest ! Test regrid matrix write(failMsg, *) "Test unsuccessful" - write(name, *) "Test regrid transpose." + write(name, *) "Test transpose regrid routeHandle." ! initialize rc=ESMF_SUCCESS @@ -47061,7 +47061,7 @@ subroutine test_regrid_transpose(rc) ! Setup dest. grid ! Make a grid that still matches up with identical points, but is ! only the center, so that matrix is identity, but the src/dst indices aren't - ! the same, this'll let us test the trasponse where the indices will change. + ! the same, this'll let us test the transponse where the indices will change. dstGrid=ESMF_GridCreate1PeriDimUfrm(maxIndex=(/180,90/),& minCornerCoord=(/0.0_ESMF_KIND_R8,-45.0_ESMF_KIND_R8/), & maxCornerCoord=(/360.0_ESMF_KIND_R8,45.0_ESMF_KIND_R8/), & @@ -47439,8 +47439,47 @@ subroutine test_regrid_transpose(rc) endif - ! TODO: Check results + + ! Check results + do lDE=0,srclocalDECount-1 + + call ESMF_FieldGet(srcField, lDE, farrayPtr, & + computationalLBound=fclbnd, computationalUBound=fcubnd, & + rc=localrc) + if (localrc /=ESMF_SUCCESS) then + rc=ESMF_FAILURE + return + endif + + call ESMF_FieldGet(xsrcField, lDE, xfarrayPtr, & + rc=localrc) + if (localrc /=ESMF_SUCCESS) then + rc=ESMF_FAILURE + return + endif + + !! Make sure things look ok + do i1=fclbnd(1),fcubnd(1) + do i2=fclbnd(2),fcubnd(2) + do i3=fclbnd(3),fcubnd(3) + + ! Skip values close to 1000.0 because those are the ones that + ! won't have been regridded to. + if (abs(farrayPtr(i1,i2,i3) - 1000.0) .lt. 1.0E-10) cycle + + ! if working everything should be close to exact answer + if (abs(farrayPtr(i1,i2,i3)-xfarrayPtr(i1,i2,i3)) .gt. 1.0E-10) then +! write(*,*) "T:",i1,i2,i3," ",farrayPtr(i1,i2,i3),xfarrayPtr(i1,i2,i3) + correct=.false. + endif + enddo + enddo + enddo + + enddo ! lDE + + ! Get rid of transpose routehandle call ESMF_FieldRegridRelease(transposeRouteHandle, rc=localrc) From ddea1b148073cb95be97c07a54e4e5d1ce82f4cd Mon Sep 17 00:00:00 2001 From: Gerhard Theurich Date: Mon, 4 Nov 2024 10:58:25 -0800 Subject: [PATCH 098/207] Minor formatting changes: indentation and logging. --- .../src/ESMF_StateReconcile.F90 | 214 +++++++++--------- 1 file changed, 104 insertions(+), 110 deletions(-) diff --git a/src/Superstructure/StateReconcile/src/ESMF_StateReconcile.F90 b/src/Superstructure/StateReconcile/src/ESMF_StateReconcile.F90 index bc272e3ff6..c6a4f8c332 100644 --- a/src/Superstructure/StateReconcile/src/ESMF_StateReconcile.F90 +++ b/src/Superstructure/StateReconcile/src/ESMF_StateReconcile.F90 @@ -210,35 +210,33 @@ subroutine ESMF_StateReconcile(state, keywordEnforcer, vm, checkflag, rc) end if #if 0 - block - character(ESMF_MAXSTR) :: stateName - call ESMF_StateGet(state, name=stateName, rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, & - rcToReturn=rc)) return - call ESMF_LogWrite("StateReconcile() for State: "//trim(stateName), & - ESMF_LOGMSG_DEBUG, rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, & - rcToReturn=rc)) return - end block + block + character(ESMF_MAXSTR) :: stateName + call ESMF_StateGet(state, name=stateName, rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, & + rcToReturn=rc)) return + call ESMF_LogWrite("StateReconcile() for State: "//trim(stateName), & + ESMF_LOGMSG_DEBUG, rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, & + rcToReturn=rc)) return + end block #endif #if 0 - block - type(ESMF_InfoDescribe) :: idesc - ! Log a JSON State representation ----------------------------------------- - call idesc%Initialize(createInfo=.true., addObjectInfo=.true., rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, rcToReturn=rc)) return - call idesc%Update(state, "", rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, rcToReturn=rc)) return - call ESMF_LogWrite("InfoDescribe before Reconcile=", rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, rcToReturn=rc)) return - call ESMF_LogWrite("state_json_before_reconcile="//ESMF_InfoDump(idesc%info), rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, rcToReturn=rc)) return - call idesc%Destroy(rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, rcToReturn=rc)) return - end block + block + type(ESMF_InfoDescribe) :: idesc + ! Log a JSON State representation ----------------------------------------- + call idesc%Initialize(createInfo=.true., addObjectInfo=.true., rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, rcToReturn=rc)) return + call idesc%Update(state, "", rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, rcToReturn=rc)) return + call ESMF_LogWrite("state_json_before_reconcile="//ESMF_InfoDump(idesc%info), rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, rcToReturn=rc)) return + call idesc%Destroy(rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, rcToReturn=rc)) return + end block #endif #if 0 @@ -326,94 +324,92 @@ subroutine ESMF_StateReconcile(state, keywordEnforcer, vm, checkflag, rc) rcToReturn=rc)) return endif - if (localCheckFlag) then - if (profile) then - call ESMF_TraceRegionEnter("JSON cross PET check", rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, & - rcToReturn=rc)) return - endif - block - type(ESMF_InfoDescribe) :: idesc - character(:), allocatable :: jsonStr, testStr - integer :: size(1), localPet - ! Log a JSON State representation ----------------------------------------- - call idesc%Initialize(createInfo=.true., addObjectInfo=.true., rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, rcToReturn=rc)) return - call idesc%Update(state, "", rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, rcToReturn=rc)) return - jsonStr = "state_json_after_reassemble="//ESMF_InfoDump(idesc%info) + if (localCheckFlag) then + if (profile) then + call ESMF_TraceRegionEnter("JSON cross PET check", rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, & + rcToReturn=rc)) return + endif + block + type(ESMF_InfoDescribe) :: idesc + character(:), allocatable :: jsonStr, testStr + integer :: size(1), localPet + ! Log a JSON State representation ----------------------------------------- + call idesc%Initialize(createInfo=.true., addObjectInfo=.true., rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, rcToReturn=rc)) return + call idesc%Update(state, "", rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, rcToReturn=rc)) return + jsonStr = "state_json_after_reassemble="//ESMF_InfoDump(idesc%info) #if 1 - call ESMF_LogWrite("InfoDescribe after InfoCacheReassembleFields=", rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, rcToReturn=rc)) return - call ESMF_LogWrite(jsonStr, rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, rcToReturn=rc)) return + call ESMF_LogWrite(jsonStr, rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, rcToReturn=rc)) return #endif - call idesc%Destroy(rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, rcToReturn=rc)) return + call idesc%Destroy(rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, rcToReturn=rc)) return #if 1 - ! check match across all PETs of VM - size(1) = len(jsonStr) - call ESMF_VMBroadcast(localvm, size, count=1, rootPet=0, rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, rcToReturn=rc)) return - call ESMF_VMGet(localvm, localPet=localPet, rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, rcToReturn=rc)) return - if (localPet==0) then - call ESMF_VMBroadcast(localvm, jsonStr, count=size(1), rootPet=0, rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, rcToReturn=rc)) return - else - allocate(character(len=size(1))::testStr) - call ESMF_VMBroadcast(localvm, testStr, count=size(1), rootPet=0, rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, rcToReturn=rc)) return - if (testStr/=jsonStr) then - ! not a perfect match -> see if the differences are acceptable - ! these are differences in the values of attributes, which show up in - ! the bundled esmf and nuopc test cases... these diffs are begnin. - isFlag = ESMF_UtilStringDiffMatch(jsonStr, testStr, & - minusStringList = ["None ", & - "All ", & - "1 ", & - "2 ", & - " ", & - " ", & - "M ", & - "DEF ", & - "UL ", & - " ", & - "driverChild " & - ], & - plusStringList = ["All ", & - "None ", & - "2 ", & - "1 ", & - "DEF ", & - "UL ", & - " ", & - " ", & - " ", & - "M ", & - "DEFAULT" & - ], rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & - rcToReturn=rc)) return - if (.not.isFlag) then - ! found unexpected/unacceptable differences - call ESMF_LogSetError(ESMF_RC_INTNRL_INCONS, & - msg="StateReconcile() failed!! Not all PETs hold same content!!", & - ESMF_CONTEXT, rcToReturn=rc) - return + ! check match across all PETs of VM + size(1) = len(jsonStr) + call ESMF_VMBroadcast(localvm, size, count=1, rootPet=0, rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, rcToReturn=rc)) return + call ESMF_VMGet(localvm, localPet=localPet, rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, rcToReturn=rc)) return + if (localPet==0) then + call ESMF_VMBroadcast(localvm, jsonStr, count=size(1), rootPet=0, rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, rcToReturn=rc)) return + else + allocate(character(len=size(1))::testStr) + call ESMF_VMBroadcast(localvm, testStr, count=size(1), rootPet=0, rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, rcToReturn=rc)) return + if (testStr/=jsonStr) then + ! not a perfect match -> see if the differences are acceptable + ! these are differences in the values of attributes, which show up in + ! the bundled esmf and nuopc test cases... these diffs are begnin. + isFlag = ESMF_UtilStringDiffMatch(jsonStr, testStr, & + minusStringList = ["None ", & + "All ", & + "1 ", & + "2 ", & + " ", & + " ", & + "M ", & + "DEF ", & + "UL ", & + " ", & + "driverChild " & + ], & + plusStringList = ["All ", & + "None ", & + "2 ", & + "1 ", & + "DEF ", & + "UL ", & + " ", & + " ", & + " ", & + "M ", & + "DEFAULT" & + ], rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & + rcToReturn=rc)) return + if (.not.isFlag) then + ! found unexpected/unacceptable differences + call ESMF_LogSetError(ESMF_RC_INTNRL_INCONS, & + msg="StateReconcile() failed!! Not all PETs hold same content!!", & + ESMF_CONTEXT, rcToReturn=rc) + return + endif + endif endif - endif - endif #endif - end block - if (profile) then - call ESMF_TraceRegionExit("JSON cross PET check", rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, & - rcToReturn=rc)) return + end block + if (profile) then + call ESMF_TraceRegionExit("JSON cross PET check", rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, & + rcToReturn=rc)) return + endif endif - endif if (present(rc)) rc = ESMF_SUCCESS @@ -995,8 +991,6 @@ subroutine ESMF_StateReconcile_driver(state, vm, rc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, rcToReturn=rc)) return call idesc%Update(state, "", rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, rcToReturn=rc)) return - call ESMF_LogWrite("InfoDescribe AFTER VMId collection=", rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, rcToReturn=rc)) return call ESMF_LogWrite("state_json_after_vmid="//ESMF_InfoDump(idesc%info), rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, rcToReturn=rc)) return call idesc%Destroy(rc=localrc) From 55e0667e2a621861164e785d5c770d81d1df531d Mon Sep 17 00:00:00 2001 From: Gerhard Theurich Date: Mon, 4 Nov 2024 10:59:26 -0800 Subject: [PATCH 099/207] Exercise `checkflag=.true.` in StateReconcile unit tests. --- .../tests/ESMF_StateReconcileProxyUTest.F90 | 4 +-- .../tests/ESMF_StateReconcileUTest.F90 | 28 +++++++++---------- 2 files changed, 16 insertions(+), 16 deletions(-) diff --git a/src/Superstructure/StateReconcile/tests/ESMF_StateReconcileProxyUTest.F90 b/src/Superstructure/StateReconcile/tests/ESMF_StateReconcileProxyUTest.F90 index eee7c5c869..646b1f9ef1 100644 --- a/src/Superstructure/StateReconcile/tests/ESMF_StateReconcileProxyUTest.F90 +++ b/src/Superstructure/StateReconcile/tests/ESMF_StateReconcileProxyUTest.F90 @@ -277,7 +277,7 @@ program ESMF_StateReconcileProxyUTest ! Reconcile the State !NEX_UTest_Multi_Proc_Only - call ESMF_StateReconcile(exportState, rc=rc) + call ESMF_StateReconcile(exportState, checkflag=.true., rc=rc) write(name, *) "Reconciling a State" write(failMsg, *) "Did not return ESMF_SUCCESS" call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE) @@ -357,7 +357,7 @@ program ESMF_StateReconcileProxyUTest ! Re-Reconcile the State !NEX_UTest_Multi_Proc_Only - call ESMF_StateReconcile(exportState, rc=rc) + call ESMF_StateReconcile(exportState, checkflag=.true., rc=rc) write(name, *) "Re-Reconciling a State" write(failMsg, *) "Did not return ESMF_SUCCESS" call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE) diff --git a/src/Superstructure/StateReconcile/tests/ESMF_StateReconcileUTest.F90 b/src/Superstructure/StateReconcile/tests/ESMF_StateReconcileUTest.F90 index 1c38d14114..44fc076f81 100644 --- a/src/Superstructure/StateReconcile/tests/ESMF_StateReconcileUTest.F90 +++ b/src/Superstructure/StateReconcile/tests/ESMF_StateReconcileUTest.F90 @@ -815,7 +815,7 @@ program ESMF_StateReconcileUTest !------------------------------------------------------------------------- !NEX_UTest_Multi_Proc_Only - call ESMF_StateReconcile(state1, vm=vm, rc=rc) + call ESMF_StateReconcile(state1, vm=vm, checkflag=.true., rc=rc) write(failMsg, *) "Did not return ESMF_SUCCESS" write(name, *) "Calling StateReconcile in concurrent mode" call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE) @@ -847,7 +847,7 @@ program ESMF_StateReconcileUTest !------------------------------------------------------------------------- !NEX_UTest_Multi_Proc_Only ! Test redundant reconcile - call ESMF_StateReconcile(state1, vm=vm, rc=rc) + call ESMF_StateReconcile(state1, vm=vm, checkflag=.true., rc=rc) write(failMsg, *) "Did not return ESMF_SUCCESS" write(name, *) "Calling 2nd StateReconcile in concurrent mode" call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE) @@ -1016,7 +1016,7 @@ program ESMF_StateReconcileUTest !------------------------------------------------------------------------- !NEX_UTest_Multi_Proc_Only - call ESMF_StateReconcile(state1, vm=vm, rc=rc) + call ESMF_StateReconcile(state1, vm=vm, checkflag=.true., rc=rc) write(failMsg, *) "Did not return ESMF_SUCCESS" write(name, *) "Calling StateReconcile in sequential mode" call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE) @@ -1031,7 +1031,7 @@ program ESMF_StateReconcileUTest !------------------------------------------------------------------------- !NEX_UTest_Multi_Proc_Only ! Test redundant reconcile - call ESMF_StateReconcile(state1, vm=vm, rc=rc) + call ESMF_StateReconcile(state1, vm=vm, checkflag=.true., rc=rc) write(failMsg, *) "Did not return ESMF_SUCCESS" write(name, *) "Calling 2nd StateReconcile in sequential mode" call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE) @@ -1187,7 +1187,7 @@ program ESMF_StateReconcileUTest !------------------------------------------------------------------------- !NEX_UTest_Multi_Proc_Only - call ESMF_StateReconcile(state1, vm=vm, rc=rc) + call ESMF_StateReconcile(state1, vm=vm, checkflag=.true., rc=rc) write(failMsg, *) "Did not return ESMF_SUCCESS" write(name, *) "Calling StateReconcile in run-in-parent mode" call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE) @@ -1202,7 +1202,7 @@ program ESMF_StateReconcileUTest !------------------------------------------------------------------------- !NEX_UTest_Multi_Proc_Only ! Test redundant reconcile - call ESMF_StateReconcile(state1, vm=vm, rc=rc) + call ESMF_StateReconcile(state1, vm=vm, checkflag=.true., rc=rc) write(failMsg, *) "Did not return ESMF_SUCCESS" write(name, *) "Calling 2nd StateReconcile in run-in-parent mode" call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE) @@ -1302,7 +1302,7 @@ program ESMF_StateReconcileUTest !------------------------------------------------------------------------- !NEX_UTest_Multi_Proc_Only - call ESMF_StateReconcile(state2, rc=rc) + call ESMF_StateReconcile(state2, checkflag=.true., rc=rc) write(failMsg, *) "Did not return ESMF_SUCCESS" write(name, *) "Calling initial reconcile for rereconcile tests" call ESMF_Test((rc == ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE) @@ -1327,7 +1327,7 @@ program ESMF_StateReconcileUTest !------------------------------------------------------------------------- !NEX_UTest_Multi_Proc_Only - call ESMF_StateReconcile(state2, rc=rc) + call ESMF_StateReconcile(state2, checkflag=.true., rc=rc) write(failMsg, *) "Did not return ESMF_SUCCESS" write(name, *) "Re-reconciling State test" call ESMF_Test((rc == ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE) @@ -1409,7 +1409,7 @@ program ESMF_StateReconcileUTest !------------------------------------------------------------------------- !NEX_UTest_Multi_Proc_Only - call ESMF_StateReconcile(state=state3, rc=rc) + call ESMF_StateReconcile(state=state3, checkflag=.true., rc=rc) write(failMsg, *) "Did not return ESMF_SUCCESS" write(name, *) "Calling StateReconcile of nested State test" call ESMF_Test((rc == ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE) @@ -1490,7 +1490,7 @@ program ESMF_StateReconcileUTest !NEX_UTest_Multi_Proc_Only write(failMsg, *) "Did not return ESMF_SUCCESS" write(name, *) "Reconciling state before adding Attributes" - call ESMF_StateReconcile(state_attr, rc=rc) + call ESMF_StateReconcile(state_attr, checkflag=.true., rc=rc) call ESMF_Test((rc == ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE) !------------------------------------------------------------------------- @@ -1508,7 +1508,7 @@ program ESMF_StateReconcileUTest !NEX_UTest_Multi_Proc_Only write(failMsg, *) "Did not return ESMF_SUCCESS" write(name, *) "Reconciling state with Base attribute test" - call ESMF_StateReconcile (state_attr, rc=rc) + call ESMF_StateReconcile (state_attr, checkflag=.true., rc=rc) call ESMF_Test((rc == ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE) !------------------------------------------------------------------------- @@ -1571,7 +1571,7 @@ program ESMF_StateReconcileUTest !NEX_UTest_Multi_Proc_Only write(failMsg, *) "Did not return ESMF_SUCCESS" write(name, *) "Reconciling state with Field and Attribute test" - call ESMF_StateReconcile (state_attr, rc=rc) + call ESMF_StateReconcile (state_attr, checkflag=.true., rc=rc) call ESMF_Test((rc == ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE) !------------------------------------------------------------------------- @@ -1708,7 +1708,7 @@ program ESMF_StateReconcileUTest !NEX_UTest_Multi_Proc_Only write(failMsg, *) "Did not return ESMF_SUCCESS" write(name, *) "Reconcile State for shared Grid test" - call ESMF_StateReconcile (state_sgrid, rc=rc) + call ESMF_StateReconcile (state_sgrid, checkflag=.true., rc=rc) call ESMF_Test(rc == ESMF_SUCCESS, name, failMsg, result, ESMF_SRCLINE) !------------------------------------------------------------------------- @@ -1758,7 +1758,7 @@ program ESMF_StateReconcileUTest !NEX_UTest_Multi_Proc_Only write(failMsg, *) "Did not return ESMF_SUCCESS" write(name, *) "Re-reconcile State for shared Grid test" - call ESMF_StateReconcile (state_sgrid, rc=rc) + call ESMF_StateReconcile (state_sgrid, checkflag=.true., rc=rc) call ESMF_Test(rc == ESMF_SUCCESS, name, failMsg, result, ESMF_SRCLINE) !------------------------------------------------------------------------- From 268d358070928f6d781297529f4447542fe35f57 Mon Sep 17 00:00:00 2001 From: Gerhard Theurich Date: Mon, 4 Nov 2024 11:22:28 -0800 Subject: [PATCH 100/207] More small formatting and unused variable cleanup. --- .../src/ESMF_StateReconcile.F90 | 29 +++++++++---------- 1 file changed, 13 insertions(+), 16 deletions(-) diff --git a/src/Superstructure/StateReconcile/src/ESMF_StateReconcile.F90 b/src/Superstructure/StateReconcile/src/ESMF_StateReconcile.F90 index c6a4f8c332..c692a95cea 100644 --- a/src/Superstructure/StateReconcile/src/ESMF_StateReconcile.F90 +++ b/src/Superstructure/StateReconcile/src/ESMF_StateReconcile.F90 @@ -770,7 +770,6 @@ subroutine ESMF_StateReconcile_driver(state, vm, rc) logical, parameter :: trace = .false. logical, parameter :: profile = .true. - character(160) :: prefixStr type(ESMF_VMId), allocatable, target :: vmIdMap(:) type(ESMF_VMId), pointer :: vmIdMap_ptr(:) type(ESMF_VMId), pointer :: vmIdSingleComp @@ -781,10 +780,7 @@ subroutine ESMF_StateReconcile_driver(state, vm, rc) type(ESMF_AttReconcileFlag) :: attreconflag - character(len=ESMF_MAXSTR) :: logmsg - type(ESMF_InfoCache) :: info_cache - type(ESMF_InfoDescribe) :: idesc ! ------------------------------------------------------------------------- localrc = ESMF_RC_NOT_IMPL @@ -985,16 +981,19 @@ subroutine ESMF_StateReconcile_driver(state, vm, rc) if (meminfo) call ESMF_VMLogMemInfo ("after (1) Construct send arrays") #if 0 - ! Log a JSON State representation ----------------------------------------- - call idesc%Initialize(createInfo=.true., addObjectInfo=.true., & - vmIdMap=vmIdMap_ptr, rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, rcToReturn=rc)) return - call idesc%Update(state, "", rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, rcToReturn=rc)) return - call ESMF_LogWrite("state_json_after_vmid="//ESMF_InfoDump(idesc%info), rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, rcToReturn=rc)) return - call idesc%Destroy(rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, rcToReturn=rc)) return + block + type(ESMF_InfoDescribe) :: idesc + ! Log a JSON State representation ----------------------------------------- + call idesc%Initialize(createInfo=.true., addObjectInfo=.true., & + vmIdMap=vmIdMap_ptr, rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, rcToReturn=rc)) return + call idesc%Update(state, "", rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, rcToReturn=rc)) return + call ESMF_LogWrite("state_json_after_vmid="//ESMF_InfoDump(idesc%info), rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, rcToReturn=rc)) return + call idesc%Destroy(rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, rcToReturn=rc)) return + end block #endif ! ------------------------------------------------------------------------- @@ -2037,7 +2036,6 @@ subroutine ESMF_ReconcileDeserialize (state, vm, obj_buffer, attreconflag, rc) integer :: i, idx integer :: stateitem_type character(ESMF_MAXSTR) :: errstring - logical :: found integer :: mypet @@ -4677,7 +4675,6 @@ subroutine ESMF_ReconcileZappedProxies(state, rc) type(ESMF_FieldType) :: tempFieldType type(ESMF_FieldBundle) :: tempFB type(ESMF_FieldBundleType) :: tempFBType - character(len=80) :: msgString ! Initialize return code; assume routine not implemented if (present(rc)) rc = ESMF_RC_NOT_IMPL From 7158fe2c1d8694127fa469c11fcfd8443d31a3d3 Mon Sep 17 00:00:00 2001 From: Gerhard Theurich Date: Mon, 4 Nov 2024 12:25:53 -0800 Subject: [PATCH 101/207] Rename for consistency: mypet -> localPet, npets -> petCount --- .../src/ESMF_StateReconcile.F90 | 323 +++++++++--------- 1 file changed, 160 insertions(+), 163 deletions(-) diff --git a/src/Superstructure/StateReconcile/src/ESMF_StateReconcile.F90 b/src/Superstructure/StateReconcile/src/ESMF_StateReconcile.F90 index c692a95cea..f7e5a37e0f 100644 --- a/src/Superstructure/StateReconcile/src/ESMF_StateReconcile.F90 +++ b/src/Superstructure/StateReconcile/src/ESMF_StateReconcile.F90 @@ -747,7 +747,7 @@ subroutine ESMF_StateReconcile_driver(state, vm, rc) !EOPI integer :: localrc integer :: memstat - integer :: mypet, npets + integer :: localPet, petCount integer, pointer :: nitems_buf(:) type (ESMF_StateItemWrap), pointer :: siwrap(:) @@ -788,21 +788,18 @@ subroutine ESMF_StateReconcile_driver(state, vm, rc) ! Attributes must be reconciled to de-duplicate Field geometry proxies attreconflag = ESMF_ATTRECONCILE_ON - if (meminfo) call ESMF_VMLogMemInfo ("entering ESMF_StateReconcile_driver") + if (meminfo) call ESMF_VMLogMemInfo("entering ESMF_StateReconcile_driver") - call ESMF_VMGet(vm, localPet=mypet, petCount=npets, rc=localrc) + call ESMF_VMGet(vm, localPet=localPet, petCount=petCount, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, & rcToReturn=rc)) return if (debug) then - do, i=0, npets-1 - if (i == mypet) then - call ESMF_StatePrint (state) - call ESMF_UtilIOUnitFlush (6) - end if - call ESMF_VMBarrier (vm) - end do + call ESMF_StateLog(state, rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, & + rcToReturn=rc)) return end if ! ------------------------------------------------------------------------- @@ -1214,7 +1211,7 @@ subroutine ESMF_ReconcileMultiCompCase() call ESMF_ReconcileDebugPrint (ESMF_METHOD // & ': *** Step 3 - Exchange Ids/VMIds') end if - allocate (id_info(0:npets-1), stat=memstat) + allocate (id_info(0:petCount-1), stat=memstat) if (ESMF_LogFoundAllocError(memstat, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, & rcToReturn=rc)) return @@ -1369,7 +1366,7 @@ subroutine ESMF_ReconcileMultiCompCase() call ESMF_ReconcileDebugPrint (ESMF_METHOD // & ': *** Step 7 - Exchange serialized objects') end if - allocate (items_recv(0:npets-1), stat=memstat) + allocate (items_recv(0:petCount-1), stat=memstat) if (ESMF_LogFoundAllocError(memstat, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, & rcToReturn=rc)) return @@ -1409,10 +1406,10 @@ subroutine ESMF_ReconcileMultiCompCase() call ESMF_ReconcileDebugPrint (ESMF_METHOD // & ': *** Step 8 - Deserialize needs') end if - do, i=0, npets-1 + do, i=0, petCount-1 if (debug) then write (*, '(a,i0,a,i0,a,l1)') & - ' PET ', mypet, ': Deserializing from PET ', i, & + ' PET ', localPet, ': Deserializing from PET ', i, & ', associated (items_recv(i)%cptr) =', associated (items_recv(i)%cptr) end if if (associated (items_recv(i)%cptr)) then @@ -1653,7 +1650,7 @@ subroutine ESMF_ReconcileCompareNeeds (vm, id, vmid, id_info, rc) integer :: localrc integer :: memstat - integer :: mypet, npets + integer :: localPet, petCount integer :: i, j, k logical :: needed character(ESMF_MAXSTR) :: msgstring @@ -1672,7 +1669,7 @@ subroutine ESMF_ReconcileCompareNeeds (vm, id, vmid, id_info, rc) ! Sanity checks - call ESMF_VMGet (vm, localPet=mypet, petCount=npets, rc=localrc) + call ESMF_VMGet (vm, localPet=localPet, petCount=petCount, rc=localrc) if (ESMF_LogFoundError (localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, & rcToReturn=rc)) return @@ -1683,14 +1680,14 @@ subroutine ESMF_ReconcileCompareNeeds (vm, id, vmid, id_info, rc) rcToReturn=rc)) return end if - if (size (id_info) /= npets) then - if (ESMF_LogFoundError (ESMF_RC_INTNRL_INCONS, msg='size (id_info) /= npets', & + if (size (id_info) /= petCount) then + if (ESMF_LogFoundError (ESMF_RC_INTNRL_INCONS, msg='size (id_info) /= petCount', & ESMF_CONTEXT, & rcToReturn=rc)) return end if if (debug) then - print *, ' PET ', mypet, ': id/vmid sizes =', size (id), size (vmid) + print *, ' PET ', localPet, ': id/vmid sizes =', size (id), size (vmid) end if ! Check other PETs contents to see if there are objects this PET needs @@ -1702,17 +1699,17 @@ subroutine ESMF_ReconcileCompareNeeds (vm, id, vmid, id_info, rc) ! call ESMF_ReconcileDebugPrint (ESMF_METHOD // & ! ': computing id_info%needed') - do, i=0, npets-1 + do, i=0, petCount-1 id_info(i)%needed = .false. - if (i == mypet) cycle + if (i == localPet) cycle do, j = 1, ubound (id_info(i)%id, 1) needed = .true. -! print *, ' PET', mypet, ': setting needed to .true.', j, k +! print *, ' PET', localPet, ': setting needed to .true.', j, k do, k = 1, ubound (id, 1) if (id(k) == id_info(i)%id(j)) then if (vmid(k) == id_info(i)%vmid(j)) then -! print *, ' PET', mypet, ': setting needed to .false.', j, k +! print *, ' PET', localPet, ': setting needed to .false.', j, k needed = .false. exit end if @@ -1720,7 +1717,7 @@ subroutine ESMF_ReconcileCompareNeeds (vm, id, vmid, id_info, rc) end do if (needed) then -! print *, ' PET', mypet, ': calling insert, associated =', associated (needs_list) +! print *, ' PET', localPet, ': calling insert, associated =', associated (needs_list) call needs_list_insert (needs_list, pet_1=i, & id_1=id_info(i)%id(j), & vmid_1=id_info(i)%vmid(j), & @@ -1751,8 +1748,8 @@ subroutine ESMF_ReconcileCompareNeeds (vm, id, vmid, id_info, rc) if (debug) then - do, j=0, npets-1 - if (j == myPet) then + do, j=0, petCount-1 + if (j == localPet) then do, i=0, ubound (id_info, 1) write (msgstring,'(2a,i0,a,i0,a)') ESMF_METHOD, & ': pet', j, ': id_info%needed(',i,') =' @@ -1789,7 +1786,7 @@ recursive subroutine needs_list_deallocate (needs_list_1, rc_1) rcToReturn=rc_1)) return if (associated (needs_list_1%next)) then -! print *, 'pet', mypet, ': needs_list_deallocate: recursing' +! print *, 'pet', localPet, ': needs_list_deallocate: recursing' call needs_list_deallocate (needs_list_1%next, rc_1=localrc_1) if (ESMF_LogFoundError (localrc_1, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, & @@ -1826,14 +1823,14 @@ subroutine needs_list_insert (needs_list_1, pet_1, & rc_1 = ESMF_SUCCESS if (.not. associated (needs_list_1)) then -! print *, 'pet', mypet, ': needs_list_insert: creating needs_list_1' +! print *, 'pet', localPet, ': needs_list_insert: creating needs_list_1' allocate (needs_list_1, stat=memstat_1) if (ESMF_LogFoundAllocError (memstat_1, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, & rcToReturn=rc_1)) return allocate ( & - needs_list_1%offerers(0:npets-1), & - needs_list_1%position(0:npets-1), & + needs_list_1%offerers(0:petCount-1), & + needs_list_1%position(0:petCount-1), & stat=memstat_1) if (ESMF_LogFoundAllocError (memstat_1, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, & @@ -1852,28 +1849,28 @@ subroutine needs_list_insert (needs_list_1, pet_1, & do if (id_1 == needslist_p%id .and. & vmid_1 == needslist_p%vmid) then -! print *, 'pet', mypet, ': needs_list_insert: marking match and returing' +! print *, 'pet', localPet, ': needs_list_insert: marking match and returing' needslist_p%offerers(pet_1) = .true. needslist_p%position(pet_1) = position return end if if (.not. associated (needslist_p%next)) exit -! print *, 'pet', mypet, ': needs_list_insert: advancing to next entry' +! print *, 'pet', localPet, ': needs_list_insert: advancing to next entry' needslist_p => needslist_p%next end do ! At the end of the list, but no matches found. So add new entry. -! print *, 'pet', mypet, ': needs_list_insert: creating needslist_p entry' +! print *, 'pet', localPet, ': needs_list_insert: creating needslist_p entry' allocate (needslist_p%next, stat=memstat_1) if (ESMF_LogFoundAllocError (memstat_1, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, & rcToReturn=rc_1)) return needslist_p => needslist_p%next allocate ( & - needslist_p%offerers(0:npets-1), & - needslist_p%position(0:npets-1), & + needslist_p%offerers(0:petCount-1), & + needslist_p%position(0:petCount-1), & stat=memstat_1) if (ESMF_LogFoundAllocError (memstat_1, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, & @@ -1896,18 +1893,18 @@ subroutine needs_list_print (needs_list_1) call ESMF_UtilIOUnitFlush (ESMF_UtilIOStdout) call ESMF_VMBarrier (vm) - do, i=0, npets-1 - if (i == mypet) then + do, i=0, petCount-1 + if (i == localPet) then if (associated (needs_list_1)) then needs_list_next => needs_list_1 do - print *, 'PET', mypet, ': offerers =', needs_list_next%offerers, & + print *, 'PET', localPet, ': offerers =', needs_list_next%offerers, & ', position =', needs_list_next%position if (.not. associated (needs_list_next%next)) exit needs_list_next => needs_list_next%next end do else - print *, 'PET', mypet, ': Needs list empty' + print *, 'PET', localPet, ': Needs list empty' end if call ESMF_UtilIOUnitFlush (ESMF_UtilIOStdout) end if @@ -1927,7 +1924,7 @@ subroutine needs_list_select (needs_list_1, id_info_1) integer :: i, idx integer :: offer_first, offer_last logical :: found_first - real :: rand_nos(0:npets-1) + real :: rand_nos(0:petCount-1) needslist_p => needs_list_1 @@ -1941,9 +1938,9 @@ subroutine needs_list_select (needs_list_1, id_info_1) if (.not. associated (needslist_p)) exit ! Find first and last offering PETs offer_first = 0 - offer_last = npets-1 + offer_last = petCount-1 found_first = .false. - do, i=0, npets-1 + do, i=0, petCount-1 if (needslist_p%offerers(i)) then if (.not. found_first) then offer_first = i @@ -1954,15 +1951,15 @@ subroutine needs_list_select (needs_list_1, id_info_1) end do ! Use a hash to select a starting index between the bounds - idx = int (rand_nos(myPet) * (offer_last-offer_first) + offer_first) -! print *, 'pet', mypet, ': offer_first, offer_last, starting idx =', offer_first, offer_last, idx - do, i=0, npets-1 + idx = int (rand_nos(localPet) * (offer_last-offer_first) + offer_first) +! print *, 'pet', localPet, ': offer_first, offer_last, starting idx =', offer_first, offer_last, idx + do, i=0, petCount-1 if (needslist_p%offerers(idx)) then -! print *, 'pet', mypet, ': needs_list_select: setting position', idx, ' to true' +! print *, 'pet', localPet, ': needs_list_select: setting position', idx, ' to true' id_info_1(idx)%needed(needslist_p%position(idx)) = .true. exit end if - idx = mod (idx+1, npets) + idx = mod (idx+1, petCount) end do needslist_p => needslist_p%next end do @@ -1971,9 +1968,9 @@ subroutine needs_list_select (needs_list_1, id_info_1) ! Simply select the first offering PET. do if (.not. associated (needslist_p)) exit - do, i=0, npets-1 + do, i=0, petCount-1 if (needslist_p%offerers(i)) then -! print *, 'pet', mypet, ': needs_list_select: setting position', i, ' to true' +! print *, 'pet', localPet, ': needs_list_select: setting position', i, ' to true' id_info_1(i)%needed(needslist_p%position(i)) = .true. exit end if @@ -2037,19 +2034,19 @@ subroutine ESMF_ReconcileDeserialize (state, vm, obj_buffer, attreconflag, rc) integer :: stateitem_type character(ESMF_MAXSTR) :: errstring - integer :: mypet + integer :: localPet logical, parameter :: debug = .false. logical, parameter :: trace = .false. ! Sanity checks - call ESMF_VMGet (vm, localPet=mypet, rc=localrc) + call ESMF_VMGet (vm, localPet=localPet, rc=localrc) if (ESMF_LogFoundError (localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, & rcToReturn=rc)) return if (trace) then - print *, ' pet', mypet, & + print *, ' pet', localPet, & ': *** Step 0 - sanity checks' end if @@ -2057,7 +2054,7 @@ subroutine ESMF_ReconcileDeserialize (state, vm, obj_buffer, attreconflag, rc) source=obj_buffer(0:ESMF_SIZEOF_DEFINT-1), & mold =needs_count) if (debug) then - print *, ESMF_METHOD, ': PET', mypet, ', needs_count =', needs_count + print *, ESMF_METHOD, ': PET', localPet, ', needs_count =', needs_count end if ! ------------------------------------------------------------------------- @@ -2098,7 +2095,7 @@ subroutine ESMF_ReconcileDeserialize (state, vm, obj_buffer, attreconflag, rc) ! Deserialize items if (trace) then - print *, ' pet', mypet, & + print *, ' pet', localPet, & ': *** Step 1 - main deserialization loop' end if buffer_offset = ESMF_SIZEOF_DEFINT * (2 + 2*needs_count) ! Skip past count, pad, and offset/type tables @@ -2154,7 +2151,7 @@ subroutine ESMF_ReconcileDeserialize (state, vm, obj_buffer, attreconflag, rc) case (ESMF_STATEITEM_ARRAY%ot) if (debug) then - print *, " PET", mypet, & + print *, " PET", localPet, & ": deserializing Array, offset =", buffer_offset end if call c_ESMC_ArrayDeserialize(array, obj_buffer, buffer_offset, & @@ -2251,7 +2248,7 @@ subroutine ESMF_ReconcileDeserialize (state, vm, obj_buffer, attreconflag, rc) end do ! needs_count if (trace) then - print *, ' pet', mypet, & + print *, ' pet', localPet, & ': *** Deserialization complete' end if @@ -2306,7 +2303,7 @@ subroutine ESMF_ReconcileDeserializeAll(state, vm, buffer, attreconflag, rc) integer :: stateitem_type character(ESMF_MAXSTR) :: errstring character(ESMF_MAXSTR) :: name - integer :: mypet + integer :: localPet logical, parameter :: debug = .false. logical, parameter :: trace = .false. @@ -2317,7 +2314,7 @@ subroutine ESMF_ReconcileDeserializeAll(state, vm, buffer, attreconflag, rc) ! XMRKX ! ! VM information for debug output - call ESMF_VMGet (vm, localPet=mypet, rc=localrc) + call ESMF_VMGet (vm, localPet=localPet, rc=localrc) if (ESMF_LogFoundError (localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, & rcToReturn=rc)) return @@ -2388,7 +2385,7 @@ subroutine ESMF_ReconcileDeserializeAll(state, vm, buffer, attreconflag, rc) case (ESMF_STATEITEM_ARRAY%ot) if (debug) then - print *, " PET", mypet, & + print *, " PET", localPet, & ": deserializing Array pos =",posBuffer end if call c_ESMC_ArrayDeserialize(array, buffer, posBuffer, & @@ -2510,7 +2507,7 @@ subroutine ESMF_ReconcileExchgAttributes (state, vm, rc) integer :: buffer_size(1) integer :: i, pass - integer :: mypet, npets + integer :: localPet, petCount integer :: offset type(ESMF_InquireFlag) :: inqflag type(ESMF_Info) :: base_info, base_temp_info @@ -2520,7 +2517,7 @@ subroutine ESMF_ReconcileExchgAttributes (state, vm, rc) rc = ESMF_RC_NOT_IMPL - call ESMF_VMGet(vm, localPet=mypet, petCount=npets, rc=localrc) + call ESMF_VMGet(vm, localPet=localPet, petCount=petCount, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, & rcToReturn=rc)) return @@ -2582,7 +2579,7 @@ subroutine ESMF_ReconcileExchgAttributes (state, vm, rc) ESMF_CONTEXT, & rcToReturn=rc)) return endif - allocate (recv_sizes(0:npets-1), stat=memstat) + allocate (recv_sizes(0:petCount-1), stat=memstat) if (ESMF_LogFoundAllocError(memstat, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, & rcToReturn=rc)) return @@ -2615,7 +2612,7 @@ subroutine ESMF_ReconcileExchgAttributes (state, vm, rc) endif if (debug) then print *, ESMF_METHOD, & - ': PET', mypet, ': Base sizes recved are:', recv_sizes + ': PET', localPet, ': Base sizes recved are:', recv_sizes end if ! Exchange serialized buffers @@ -2627,19 +2624,19 @@ subroutine ESMF_ReconcileExchgAttributes (state, vm, rc) endif allocate ( & buffer_recv(0:sum (recv_sizes)-1), & - recv_offsets(0:npets-1), stat=memstat) + recv_offsets(0:petCount-1), stat=memstat) if (ESMF_LogFoundAllocError(memstat, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, & rcToReturn=rc)) return recv_offsets(0) = 0 - do, i=1, npets-1 + do, i=1, petCount-1 recv_offsets(i) = recv_offsets(i-1)+recv_sizes(i-1) end do if (debug) then print *, ESMF_METHOD, & - ': PET', mypet, ': Base offsets recved are:', recv_offsets + ': PET', localPet, ': Base offsets recved are:', recv_offsets end if if (profile) then @@ -2676,8 +2673,8 @@ subroutine ESMF_ReconcileExchgAttributes (state, vm, rc) ESMF_CONTEXT, & rcToReturn=rc)) return endif - do, i=0, npets-1 - if (i /= mypet) then + do, i=0, petCount-1 + if (i /= localPet) then base_temp = ESMF_BaseDeserializeWoGarbage(buffer_recv, & offset=recv_offsets(i), attreconflag=ESMF_ATTRECONCILE_ON, rc=localrc) if (ESMF_LogFoundError(localrc, & @@ -2772,7 +2769,7 @@ subroutine ESMF_ReconcileExchgIDInfo (vm, & !EOPI integer :: localrc - integer :: mypet, npets + integer :: localPet, petCount integer :: send_pet integer, allocatable :: counts_buf_send(:), counts_buf_recv(:) integer, allocatable :: displs_buf_send(:), displs_buf_recv(:) @@ -2789,7 +2786,7 @@ subroutine ESMF_ReconcileExchgIDInfo (vm, & if (meminfo) call ESMF_VMLogMemInfo ('entering ESMF_ReconcileExchgIDInfo') - call ESMF_VMGet(vm, localPet=mypet, petCount=npets, rc=localrc) + call ESMF_VMGet(vm, localPet=localPet, petCount=petCount, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, & rcToReturn=rc)) return @@ -2802,13 +2799,13 @@ subroutine ESMF_ReconcileExchgIDInfo (vm, & rcToReturn=rc)) return end if - if (size (id_info) /= npets) then + if (size (id_info) /= petCount) then if (ESMF_LogFoundError(ESMF_RC_ARG_BAD, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, & rcToReturn=rc)) return end if - if (size (nitems_buf) /= npets) then + if (size (nitems_buf) /= petCount) then if (ESMF_LogFoundError(ESMF_RC_ARG_BAD, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, & rcToReturn=rc)) return @@ -2828,7 +2825,7 @@ subroutine ESMF_ReconcileExchgIDInfo (vm, & ! Broadcast each Id to all the other PETs. Since the number of items per ! PET can vary, use AllToAllV. - do, i=0, npets-1 + do, i=0, petCount-1 allocate ( & id_info(i)% id (0:nitems_buf(i)), & id_info(i)%vmid (0:nitems_buf(i)), & @@ -2845,30 +2842,30 @@ subroutine ESMF_ReconcileExchgIDInfo (vm, & ! First, compute counts and displacements for AllToAllV calls. Note that ! sending displacements are always zero, since each PET is broadcasting - allocate (counts_buf_send(0:npets-1), displs_buf_send(0:npets-1), & - counts_buf_recv(0:npets-1), displs_buf_recv(0:npets-1), & + allocate (counts_buf_send(0:petCount-1), displs_buf_send(0:petCount-1), & + counts_buf_recv(0:petCount-1), displs_buf_recv(0:petCount-1), & stat=memstat) if (ESMF_LogFoundAllocError(memstat, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, & rcToReturn=rc)) return ! Add 1 to take the State itself (element 0) into account - counts_buf_send = nitems_buf(mypet) + 1 + counts_buf_send = nitems_buf(localPet) + 1 counts_buf_recv = nitems_buf + 1 displs_buf_send = 0 ! Always zero, since local PET is broadcasting displs_buf_recv(0) = 0 - do, i=1, npets-1 + do, i=1, petCount-1 displs_buf_recv(i) = displs_buf_recv(i-1) + counts_buf_recv(i-1) end do if (debug) then - do, i=0, npets-1 - if (i == mypet) then - write (6,*) ESMF_METHOD, ': pet', mypet, ': counts_buf_send =', counts_buf_send - write (6,*) ESMF_METHOD, ': pet', mypet, ': displs_buf_send =', displs_buf_send - write (6,*) ESMF_METHOD, ': pet', mypet, ': counts_buf_recv =', counts_buf_recv - write (6,*) ESMF_METHOD, ': pet', mypet, ': displs_buf_recv =', displs_buf_recv + do, i=0, petCount-1 + if (i == localPet) then + write (6,*) ESMF_METHOD, ': pet', localPet, ': counts_buf_send =', counts_buf_send + write (6,*) ESMF_METHOD, ': pet', localPet, ': displs_buf_send =', displs_buf_send + write (6,*) ESMF_METHOD, ': pet', localPet, ': counts_buf_recv =', counts_buf_recv + write (6,*) ESMF_METHOD, ': pet', localPet, ': displs_buf_recv =', displs_buf_recv call ESMF_UtilIOUnitFlush (ESMF_UtilIOStdout) end if call ESMF_VMBarrier (vm) @@ -2902,7 +2899,7 @@ subroutine ESMF_ReconcileExchgIDInfo (vm, & if (meminfo) call ESMF_VMLogMemInfo ('tp ESMF_ReconcileExchgIDInfo - after VMAllGatherV for Base Ids') ipos = 0 - do, i=0, npets-1 + do, i=0, petCount-1 id_info(i)%id = id_recv(ipos:ipos+counts_buf_recv(i)-1) ipos = ipos + counts_buf_recv(i) end do @@ -2924,14 +2921,14 @@ subroutine ESMF_ReconcileExchgIDInfo (vm, & if (meminfo) call ESMF_VMLogMemInfo ('tp ESMF_ReconcileExchgIDInfo - after VMAllGatherV for Base Ids') ipos = 0 - do, i=0, npets-1 + do, i=0, petCount-1 id_info(i)%vmid = vm_intids_recv(ipos:ipos+counts_buf_recv(i)-1) ipos = ipos + counts_buf_recv(i) end do ! if (debug) then -! do, j=0, npets-1 -! if (j == myPet) then +! do, j=0, petCount-1 +! if (j == localPet) then ! do, i=0, ubound (id_info, 1) ! write (6,*) 'pet', j, ': id_info%id =', id_info(i)%id ! call ESMF_UtilIOUnitFlush (ESMF_UtilIOStdout) @@ -2969,7 +2966,7 @@ subroutine ESMF_ReconcileExchgIDInfo (vm, & rcToReturn=rc)) return ipos = 0 - do, i=0, npets-1 + do, i=0, petCount-1 call ESMF_VMIdCopy ( & dest =id_info(i)%vmid, & source=vmid_recv(ipos:ipos+counts_buf_recv(i)-1), & @@ -2990,14 +2987,14 @@ subroutine ESMF_ReconcileExchgIDInfo (vm, & ': VMIdCopying...') end if call ESMF_VMIdCopy ( & - dest=id_info(mypet)%vmid, & + dest=id_info(localPet)%vmid, & source=vmid, & rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, & rcToReturn=rc)) return - do, send_pet=0, npets-1 + do, send_pet=0, petCount-1 if (debug) then call ESMF_ReconcileDebugPrint (ESMF_METHOD // & ': broadcasting VMId, using rootPet ' // iToS (send_pet), & @@ -3055,7 +3052,7 @@ subroutine ESMF_ReconcileExchgItems (vm, id_info, recv_items, recv_buffer, rc) integer :: localrc integer :: memstat - integer :: mypet, npets + integer :: localPet, petCount integer :: i integer :: itemcount, itemcount_global, itemcount_local integer :: offset_pos @@ -3078,21 +3075,21 @@ subroutine ESMF_ReconcileExchgItems (vm, id_info, recv_items, recv_buffer, rc) localrc = ESMF_RC_NOT_IMPL - call ESMF_VMGet(vm, localPet=mypet, petCount=npets, rc=localrc) + call ESMF_VMGet(vm, localPet=localPet, petCount=petCount, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, & rcToReturn=rc)) return - if (size (id_info) /= npets) then + if (size (id_info) /= petCount) then if (ESMF_LogFoundError(ESMF_RC_INTNRL_INCONS, & - msg="size (id_info) /= npets", & + msg="size (id_info) /= petCount", & ESMF_CONTEXT, & rcToReturn=rc)) return end if - if (size (recv_items) /= npets) then + if (size (recv_items) /= petCount) then if (ESMF_LogFoundError(ESMF_RC_INTNRL_INCONS, & - msg="size (recv_items) /= npets", & + msg="size (recv_items) /= petCount", & ESMF_CONTEXT, & rcToReturn=rc)) return end if @@ -3100,14 +3097,14 @@ subroutine ESMF_ReconcileExchgItems (vm, id_info, recv_items, recv_buffer, rc) ! Set up send counts, offsets, and buffer. allocate ( & - counts_send (0:npets-1), & - offsets_send(0:npets-1), & + counts_send (0:petCount-1), & + offsets_send(0:petCount-1), & stat=memstat) if (ESMF_LogFoundAllocError(memstat, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, & rcToReturn=rc)) return - do, i=0, npets-1 + do, i=0, petCount-1 if (associated (id_info(i)%item_buffer)) then counts_send(i) = size (id_info(i)%item_buffer) else @@ -3115,7 +3112,7 @@ subroutine ESMF_ReconcileExchgItems (vm, id_info, recv_items, recv_buffer, rc) end if end do - itemcount_local = counts_send(mypet) + itemcount_local = counts_send(localPet) itemcount_global = sum (counts_send) allocate ( & @@ -3126,7 +3123,7 @@ subroutine ESMF_ReconcileExchgItems (vm, id_info, recv_items, recv_buffer, rc) rcToReturn=rc)) return offset_pos = 0 - do, i=0, npets-1 + do, i=0, petCount-1 itemcount = counts_send(i) offsets_send(i) = offset_pos if (associated (id_info(i)%item_buffer)) then @@ -3140,7 +3137,7 @@ subroutine ESMF_ReconcileExchgItems (vm, id_info, recv_items, recv_buffer, rc) ! for PETs to exchange the buffer sizes they are sending to each other. allocate ( & - counts_recv(0:npets-1), & + counts_recv(0:petCount-1), & stat=memstat) if (ESMF_LogFoundAllocError(memstat, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, & @@ -3166,13 +3163,13 @@ subroutine ESMF_ReconcileExchgItems (vm, id_info, recv_items, recv_buffer, rc) rcToReturn=rc)) return endif if (debug) then - print *, ESMF_METHOD, ': PET', mypet, ': serialized buffer sizes', & + print *, ESMF_METHOD, ': PET', localPet, ': serialized buffer sizes', & ': counts_send =', counts_send, & ', counts_recv =', counts_recv end if allocate ( & - offsets_recv(0:npets-1), & + offsets_recv(0:petCount-1), & recv_buffer(0:max (0, sum (counts_recv)-1)), & stat=memstat) if (ESMF_LogFoundAllocError(memstat, ESMF_ERR_PASSTHRU, & @@ -3180,7 +3177,7 @@ subroutine ESMF_ReconcileExchgItems (vm, id_info, recv_items, recv_buffer, rc) rcToReturn=rc)) return offset_pos = 0 - do, i=0, npets-1 + do, i=0, petCount-1 itemcount = counts_recv(i) offsets_recv(i) = offset_pos offset_pos = offset_pos + itemcount @@ -3227,7 +3224,7 @@ subroutine ESMF_ReconcileExchgItems (vm, id_info, recv_items, recv_buffer, rc) ! Copy recv buffers into recv_items - do, i=0, npets-1 + do, i=0, petCount-1 itemcount = counts_recv(i) if (itemcount > 0) then offset_pos = offsets_recv(i) @@ -3300,7 +3297,7 @@ subroutine ESMF_ReconcileExchgNeeds (vm, id_info, recv_needs, rc) integer :: localrc integer :: memstat - integer :: mypet, npets + integer :: localPet, petCount integer :: i integer :: itemcount, itemcount_global, itemcount_local integer :: offset_pos @@ -3322,14 +3319,14 @@ subroutine ESMF_ReconcileExchgNeeds (vm, id_info, recv_needs, rc) rcToReturn=rc)) return end if - call ESMF_VMGet(vm, localPet=mypet, petCount=npets, rc=localrc) + call ESMF_VMGet(vm, localPet=localPet, petCount=petCount, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, & rcToReturn=rc)) return - if (size (id_info) /= npets) then + if (size (id_info) /= petCount) then if (ESMF_LogFoundError(ESMF_RC_INTNRL_INCONS, & - msg="size (id_info) /= npets", & + msg="size (id_info) /= petCount", & ESMF_CONTEXT, & rcToReturn=rc)) return end if @@ -3338,18 +3335,18 @@ subroutine ESMF_ReconcileExchgNeeds (vm, id_info, recv_needs, rc) ! can have differing numbers of items to offer. allocate ( & - counts_send (0:npets-1), & - offsets_send(0:npets-1), & + counts_send (0:petCount-1), & + offsets_send(0:petCount-1), & stat=memstat) if (ESMF_LogFoundAllocError(memstat, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, & rcToReturn=rc)) return - do, i=0, npets-1 + do, i=0, petCount-1 counts_send(i) = size (id_info(i)%needed) end do - itemcount_local = counts_send(mypet) + itemcount_local = counts_send(localPet) itemcount_global = sum (counts_send) allocate ( & @@ -3360,7 +3357,7 @@ subroutine ESMF_ReconcileExchgNeeds (vm, id_info, recv_needs, rc) rcToReturn=rc)) return offset_pos = 0 - do, i=0, npets-1 + do, i=0, petCount-1 itemcount = counts_send(i) offsets_send(i) = offset_pos buffer_send(offset_pos:offset_pos+itemcount-1) = id_info(i)%needed @@ -3373,16 +3370,16 @@ subroutine ESMF_ReconcileExchgNeeds (vm, id_info, recv_needs, rc) ! which of my items. allocate ( & - counts_recv (0:npets-1), & - offsets_recv(0:npets-1), & - buffer_recv(0:itemcount_local*npets-1), & - recv_needs(itemcount_local,0:npets-1), stat=memstat) + counts_recv (0:petCount-1), & + offsets_recv(0:petCount-1), & + buffer_recv(0:itemcount_local*petCount-1), & + recv_needs(itemcount_local,0:petCount-1), stat=memstat) if (ESMF_LogFoundAllocError(memstat, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, & rcToReturn=rc)) return counts_recv = itemcount_local - offsets_recv = itemcount_local * (/ (i,i=0, npets-1) /) + offsets_recv = itemcount_local * (/ (i,i=0, petCount-1) /) buffer_recv = .false. ! AlltoAllV @@ -3416,16 +3413,16 @@ subroutine ESMF_ReconcileExchgNeeds (vm, id_info, recv_needs, rc) ! Copy recv buffers into recv_needs - do, i=0, npets-1 + do, i=0, petCount-1 itemcount = counts_recv(i) offset_pos = offsets_recv(i) recv_needs(:,i) = buffer_recv(offset_pos:offset_pos+itemcount-1) end do if (debug) then - do, i=0, npets-1 + do, i=0, petCount-1 write (msgstring,'(a,i0,a,i0,a)') & - ' PET ', mypet, ': needs that PET ', i, ' requested are:' + ' PET ', localPet, ': needs that PET ', i, ' requested are:' write (6,*) trim (msgstring), recv_needs(:,i) call ESMF_UtilIOUnitFlush (ESMF_UtilIOStdout) end do @@ -3650,7 +3647,7 @@ subroutine ESMF_ReconcileInitialize (state, vm, & integer :: localrc integer :: memstat integer :: nitems_local(1) - integer :: mypet, npets + integer :: localPet, petCount logical, parameter :: profile = .true. @@ -3662,7 +3659,7 @@ subroutine ESMF_ReconcileInitialize (state, vm, & rcToReturn=rc)) return end if - call ESMF_VMGet(vm, localPet=mypet, petCount=npets, rc=localrc) + call ESMF_VMGet(vm, localPet=localPet, petCount=petCount, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, & rcToReturn=rc)) return @@ -3707,7 +3704,7 @@ subroutine ESMF_ReconcileInitialize (state, vm, & end if ! All PETs send their item counts to all the other PETs for recv array sizing. - allocate (nitems_all(0:npets-1), stat=memstat) + allocate (nitems_all(0:petCount-1), stat=memstat) if (ESMF_LogFoundAllocError(memstat, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, & rcToReturn=rc)) return @@ -3799,7 +3796,7 @@ subroutine ESMF_ReconcileSerialize (state, vm, siwrap, & character(ESMF_MAXSTR) :: errstring integer :: i - integer :: mypet, npets, pet + integer :: localPet, petCount, pet logical, parameter :: debug=.false. logical, parameter :: trace=.false. @@ -3808,7 +3805,7 @@ subroutine ESMF_ReconcileSerialize (state, vm, siwrap, & localrc = ESMF_RC_NOT_IMPL - call ESMF_VMGet(vm, localPet=mypet, petCount=npets, rc=localrc) + call ESMF_VMGet(vm, localPet=localPet, petCount=petCount, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, & rcToReturn=rc)) return @@ -3842,7 +3839,7 @@ subroutine ESMF_ReconcileSerialize (state, vm, siwrap, & pet_needs(i)%needed = any (needs_list(i,:)) end do if (debug) then - print *, ' PET', mypet, & + print *, ' PET', localPet, & ': needed_items array: ', pet_needs%needed end if @@ -3909,7 +3906,7 @@ subroutine ESMF_ReconcileSerialize (state, vm, siwrap, & case (ESMF_STATEITEM_FIELDBUNDLE%ot) if (debug) then - print *, ' PET', mypet, & + print *, ' PET', localPet, & ': serializing FieldBundle, pass =', pass, ', offset =', buffer_offset end if call ESMF_FieldBundleSerialize(stateitem%datap%fbp, & @@ -3922,7 +3919,7 @@ subroutine ESMF_ReconcileSerialize (state, vm, siwrap, & case (ESMF_STATEITEM_FIELD%ot) if (debug) then - print *, ' PET', mypet, & + print *, ' PET', localPet, & ': serializing Field, pass =', pass, ', offset =', buffer_offset end if call ESMF_FieldSerialize(stateitem%datap%fp, & @@ -3935,7 +3932,7 @@ subroutine ESMF_ReconcileSerialize (state, vm, siwrap, & case (ESMF_STATEITEM_ARRAY%ot) if (debug) then - print *, ' PET', mypet, & + print *, ' PET', localPet, & ': serialized Array, pass =', pass, ', offset =', buffer_offset end if call c_ESMC_ArraySerialize(stateitem%datap%ap, & @@ -3948,7 +3945,7 @@ subroutine ESMF_ReconcileSerialize (state, vm, siwrap, & case (ESMF_STATEITEM_ARRAYBUNDLE%ot) if (debug) then - print *, ' PET', mypet, & + print *, ' PET', localPet, & ': serializing ArrayBundle, pass =', pass, ', offset =', buffer_offset end if call c_ESMC_ArrayBundleSerialize(stateitem%datap%abp, & @@ -3961,7 +3958,7 @@ subroutine ESMF_ReconcileSerialize (state, vm, siwrap, & case (ESMF_STATEITEM_STATE%ot) if (debug) then - print *, ' PET', mypet, & + print *, ' PET', localPet, & ': serializing subState, pass =', pass, ', offset =', buffer_offset end if wrapper%statep => stateitem%datap%spp @@ -3976,7 +3973,7 @@ subroutine ESMF_ReconcileSerialize (state, vm, siwrap, & case (ESMF_STATEITEM_ROUTEHANDLE%ot) if (debug) then - print *, ' PET', mypet, & + print *, ' PET', localPet, & ': ignoring RouteHandle, pass =', pass end if ! Do nothing for RouteHandles. There is no need to reconcile them. @@ -3997,7 +3994,7 @@ subroutine ESMF_ReconcileSerialize (state, vm, siwrap, & case default localrc = ESMF_RC_INTNRL_INCONS if (debug) then - print *, ' PET', mypet, & + print *, ' PET', localPet, & ': serialization error in default case. Returning ESMF_RC_INTNRL_INCONS' end if @@ -4012,7 +4009,7 @@ subroutine ESMF_ReconcileSerialize (state, vm, siwrap, & #endif if (debug) then - print *, ' PET', mypet, & + print *, ' PET', localPet, & ': item serialized, pass =', pass, ', new offset =', buffer_offset, & merge (" (calc'ed)", " (actual) ", pass == 1) end if @@ -4036,10 +4033,10 @@ subroutine ESMF_ReconcileSerialize (state, vm, siwrap, & call ESMF_ReconcileDebugPrint (ESMF_METHOD // & ': *** Step 3 - Create per-PET serialized buffers') end if - do, pet=0, npets-1 + do, pet=0, petCount-1 needs_count = count (needs_list(:,pet)) if (debug .and. needs_count > 0) then - print *, ' PET', mypet, & + print *, ' PET', localPet, & ': needs_count =', needs_count, ', for PET', pet end if if (needs_count == 0) then @@ -4056,7 +4053,7 @@ subroutine ESMF_ReconcileSerialize (state, vm, siwrap, & end do if (debug) then - print *, ' PET', mypet, & + print *, ' PET', localPet, & ': computed buffer_offset =', buffer_offset, ', for PET', pet end if @@ -4097,7 +4094,7 @@ subroutine ESMF_ReconcileSerialize (state, vm, siwrap, & if (lbufsize == 0) cycle if (debug) then - print *, ' PET', mypet, & + print *, ' PET', localPet, & ': packing at buffer_offset =', buffer_offset, ', for PET', pet, & ', item =', item end if @@ -4192,7 +4189,7 @@ subroutine ESMF_ReconcileSerializeAll(state, vm, siwrap, & integer :: sizeFakeBuffer integer :: itemSize type(ESMF_InquireFlag) :: inqflag - integer :: mypet, npets, pet + integer :: localPet, petCount, pet ! XMRKX ! @@ -4200,7 +4197,7 @@ subroutine ESMF_ReconcileSerializeAll(state, vm, siwrap, & localrc = ESMF_RC_NOT_IMPL ! Get vm info - call ESMF_VMGet(vm, localPet=mypet, petCount=npets, rc=localrc) + call ESMF_VMGet(vm, localPet=localPet, petCount=petCount, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, & rcToReturn=rc)) return @@ -4251,7 +4248,7 @@ subroutine ESMF_ReconcileSerializeAll(state, vm, siwrap, & ESMF_CONTEXT, & rcToReturn=rc)) return if (debug) then - print *, ' PET', mypet, & + print *, ' PET', localPet, & ' Getting FieldBundle size=',itemSize end if @@ -4264,7 +4261,7 @@ subroutine ESMF_ReconcileSerializeAll(state, vm, siwrap, & ESMF_CONTEXT, & rcToReturn=rc)) return if (debug) then - print *, ' PET', mypet, & + print *, ' PET', localPet, & ' Getting Field size=',itemSize end if @@ -4277,7 +4274,7 @@ subroutine ESMF_ReconcileSerializeAll(state, vm, siwrap, & ESMF_CONTEXT, & rcToReturn=rc)) return if (debug) then - print *, ' PET', mypet, & + print *, ' PET', localPet, & ' Getting Array size=',itemSize end if @@ -4290,7 +4287,7 @@ subroutine ESMF_ReconcileSerializeAll(state, vm, siwrap, & ESMF_CONTEXT, & rcToReturn=rc)) return if (debug) then - print *, ' PET', mypet, & + print *, ' PET', localPet, & ' Getting ArrayBundle size=',itemSize end if @@ -4305,7 +4302,7 @@ subroutine ESMF_ReconcileSerializeAll(state, vm, siwrap, & ESMF_CONTEXT, & rcToReturn=rc)) return if (debug) then - print *, ' PET', mypet, & + print *, ' PET', localPet, & ' Getting State size=',itemSize end if @@ -4320,7 +4317,7 @@ subroutine ESMF_ReconcileSerializeAll(state, vm, siwrap, & ESMF_CONTEXT, & rcToReturn=rc)) return if (debug) then - print *, ' PET', mypet, & + print *, ' PET', localPet, & ' Getting Unknown size=',itemSize end if @@ -4381,7 +4378,7 @@ subroutine ESMF_ReconcileSerializeAll(state, vm, siwrap, & select case (itemType) case (ESMF_STATEITEM_FIELDBUNDLE%ot) if (debug) then - print *, ' PET', mypet, & + print *, ' PET', localPet, & ' Getting FieldBundle pos=',posBuffer end if call ESMF_FieldBundleSerialize(stateItem%datap%fbp, & @@ -4394,7 +4391,7 @@ subroutine ESMF_ReconcileSerializeAll(state, vm, siwrap, & case (ESMF_STATEITEM_FIELD%ot) if (debug) then - print *, ' PET', mypet, & + print *, ' PET', localPet, & ' Getting Field pos=',posBuffer end if call ESMF_FieldSerialize(stateItem%datap%fp, & @@ -4407,7 +4404,7 @@ subroutine ESMF_ReconcileSerializeAll(state, vm, siwrap, & case (ESMF_STATEITEM_ARRAY%ot) if (debug) then - print *, ' PET', mypet, & + print *, ' PET', localPet, & ' Getting Array pos=',posBuffer end if call c_ESMC_ArraySerialize(stateitem%datap%ap, & @@ -4420,7 +4417,7 @@ subroutine ESMF_ReconcileSerializeAll(state, vm, siwrap, & case (ESMF_STATEITEM_ARRAYBUNDLE%ot) if (debug) then - print *, ' PET', mypet, & + print *, ' PET', localPet, & ' Getting ArrayBundle pos=',posBuffer end if call c_ESMC_ArrayBundleSerialize(stateitem%datap%abp, & @@ -4433,7 +4430,7 @@ subroutine ESMF_ReconcileSerializeAll(state, vm, siwrap, & case (ESMF_STATEITEM_STATE%ot) if (debug) then - print *, ' PET', mypet, & + print *, ' PET', localPet, & ' Getting State pos=',posBuffer end if wrapper%statep => stateitem%datap%spp @@ -4452,7 +4449,7 @@ subroutine ESMF_ReconcileSerializeAll(state, vm, siwrap, & case (ESMF_STATEITEM_UNKNOWN%ot) if (debug) then - print *, ' PET', mypet, & + print *, ' PET', localPet, & ' Getting Unknown pos=',posBuffer end if call c_ESMC_StringSerialize(stateitem%namep, & @@ -4899,17 +4896,17 @@ function ESMF_ReconcileAllRC (vm, rc) result (rc_return) integer :: rc_send(1) integer, allocatable :: rc_all(:) - integer :: mypet, npets + integer :: localPet, petCount - call ESMF_VMGet(vm, localpet=mypet, petCount=npets) - allocate (rc_all(npets)) + call ESMF_VMGet(vm, localpet=localPet, petCount=petCount) + allocate (rc_all(petCount)) rc_send = rc call ESMF_VMGather (vm, & sendData=rc_send, recvData=rc_all, count=1, & rootPet=0) call ESMF_VMBroadcast (vm, & - bcstData=rc_all, count=npets, & + bcstData=rc_all, count=petCount, & rootPet=0) rc_return = rc @@ -4931,7 +4928,7 @@ subroutine ESMF_ReconcileDebugPrint (text, multitext, ask, rc) type(ESMF_VM) :: vm integer :: localrc - integer :: mypet, npets + integer :: localPet, petCount character(16) :: answer character(10) :: time logical :: localask @@ -4941,7 +4938,7 @@ subroutine ESMF_ReconcileDebugPrint (text, multitext, ask, rc) ESMF_CONTEXT, & rcToReturn=rc)) return - call ESMF_VMGet(vm, localPet=mypet, petCount=npets, rc=localrc) + call ESMF_VMGet(vm, localPet=localPet, petCount=petCount, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, & rcToReturn=rc)) return @@ -4955,7 +4952,7 @@ subroutine ESMF_ReconcileDebugPrint (text, multitext, ask, rc) #if 0 call ESMF_UtilIOUnitFlush (ESMF_UtilIOStdout) call ESMF_VMBarrier (vm) - if (mypet == 0) then + if (localPet == 0) then call date_and_time (time=time) write (ESMF_UtilIOStdout,*) & time(1:2), ':', time(3:4), ':', time(5:), ': ', text @@ -4978,7 +4975,7 @@ subroutine ESMF_ReconcileDebugPrint (text, multitext, ask, rc) end if if (localask) then - if (mypet == 0) then + if (localPet == 0) then write (ESMF_UtilIOStdout,'(a)') 'Proceed?' call ESMF_UtilIOUnitFlush (ESMF_UtilIOStdout) read (ESMF_UtilIOStdin,'(a)') answer From a20b1f99824e7b7447137b5bb13a766ba4222b82 Mon Sep 17 00:00:00 2001 From: Gerhard Theurich Date: Mon, 4 Nov 2024 15:14:28 -0800 Subject: [PATCH 102/207] Cleanup interface and its (internal) documentation. --- .../src/ESMF_StateReconcile.F90 | 24 +++++++++++-------- 1 file changed, 14 insertions(+), 10 deletions(-) diff --git a/src/Superstructure/StateReconcile/src/ESMF_StateReconcile.F90 b/src/Superstructure/StateReconcile/src/ESMF_StateReconcile.F90 index f7e5a37e0f..fc329bc508 100644 --- a/src/Superstructure/StateReconcile/src/ESMF_StateReconcile.F90 +++ b/src/Superstructure/StateReconcile/src/ESMF_StateReconcile.F90 @@ -1489,12 +1489,12 @@ end subroutine ESMF_StateReconcile_driver subroutine ESMF_ReconcileSingleCompCase(state, vm, vmId, attreconflag, siwrap, rc) ! ! !ARGUMENTS: - type(ESMF_State), intent(inout) :: state - type(ESMF_VM), intent(in) :: vm - type(ESMF_VMId), pointer :: vmId ! intent(in) - type(ESMF_AttReconcileFlag), intent(in) :: attreconflag - type(ESMF_StateItemWrap), pointer :: siwrap(:) ! intent(in) - integer, intent(out) :: rc + type(ESMF_State), intent(inout) :: state + type(ESMF_VM), intent(in) :: vm + type(ESMF_VMId), pointer, intent(in) :: vmId + type(ESMF_AttReconcileFlag), intent(in) :: attreconflag + type(ESMF_StateItemWrap), pointer, intent(in) :: siwrap(:) + integer, intent(out) :: rc ! ! !DESCRIPTION: ! @@ -1503,13 +1503,17 @@ subroutine ESMF_ReconcileSingleCompCase(state, vm, vmId, attreconflag, siwrap, r ! ! The arguments are: ! \begin{description} +! \item[state] +! The {\tt ESMF\_State} to reconcile. ! \item[vm] -! The ESMF\_VM} object across which the state is reconciled. +! The {\tt ESMF\_VM} object across which the state is reconciled. ! \item[vmId] -! The ESMF\_VMId} of the single component who ownes all objects present +! The {\tt ESMF\_VMId} of the single component who ownes all objects present ! in the state. -! \item[rootPet] -! The lowest PET that holds actual objects. +! \item[attreconflag] +! Flag indicating whether attributes need to be reconciled. +! \item[siwrap] +! List of local state items. ! \item[rc] ! Return code; equals {\tt ESMF\_SUCCESS} if there are no errors. ! \end{description} From 74fdd3d2d49b5dcb6a68b0cdd66d11020a9b6942 Mon Sep 17 00:00:00 2001 From: Robert Oehmke Date: Tue, 5 Nov 2024 09:15:11 -0700 Subject: [PATCH 103/207] Fix test to have new regrid arguments. --- src/Infrastructure/Mesh/tests/ESMCI_MCT.C | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/src/Infrastructure/Mesh/tests/ESMCI_MCT.C b/src/Infrastructure/Mesh/tests/ESMCI_MCT.C index a7d80b4fa9..6a5ec8ebef 100644 --- a/src/Infrastructure/Mesh/tests/ESMCI_MCT.C +++ b/src/Infrastructure/Mesh/tests/ESMCI_MCT.C @@ -861,6 +861,8 @@ class MCT { int has_iw = 0; int nentries = 0; ESMCI::TempWeights *tweights = NULL; + ESMCI::RouteHandle *trh = NULL; + int has_trh = 0; int has_udl = 0; int num_udl = 0; ESMCI::TempUDL *tudl = NULL; @@ -885,7 +887,8 @@ class MCT { &ignore_degenerate, &src_term_processing, &pipeline_depth, &rh, &has_rh, - &has_iw, &nentries, &tweights, + &has_iw, &nentries, &tweights, + &trh, &has_trh, &has_udl, &num_udl, &tudl, &has_status_array, &dummy_status_array, &check_flag, &localrc); From 3756c45b8f614f1f3ac86b34d427190b508dd55f Mon Sep 17 00:00:00 2001 From: Gerhard Theurich Date: Tue, 5 Nov 2024 14:54:23 -0800 Subject: [PATCH 104/207] Minor cleanup around DistGrid matching... and error message. --- src/Infrastructure/Field/src/ESMF_Field.F90 | 28 ++++++++++++--------- 1 file changed, 16 insertions(+), 12 deletions(-) diff --git a/src/Infrastructure/Field/src/ESMF_Field.F90 b/src/Infrastructure/Field/src/ESMF_Field.F90 index 60ce5f98a2..f3d63f85b3 100644 --- a/src/Infrastructure/Field/src/ESMF_Field.F90 +++ b/src/Infrastructure/Field/src/ESMF_Field.F90 @@ -280,11 +280,12 @@ subroutine ESMF_FieldValidate(field, keywordEnforcer, rc) integer, allocatable :: distgridToGridMap(:) integer, allocatable :: distgridToPackedArrayMap(:) integer, allocatable :: arrayCompUBnd(:, :), arrayCompLBnd(:, :) - type(ESMF_DistGrid) :: arrayDistGrid, gridDistGrid - type(ESMF_GridDecompType) :: decompType - type(ESMF_GeomType_Flag) :: geomtype - type(ESMF_Grid) :: grid - type(ESMF_Status) :: basestatus + type(ESMF_DistGrid) :: arrayDistGrid, geomDistGrid + type(ESMF_GridDecompType) :: decompType + type(ESMF_GeomType_Flag) :: geomtype + type(ESMF_Grid) :: grid + type(ESMF_Status) :: basestatus + type(ESMF_DistGridMatch_Flag) :: dgMatch ! Initialize localrc = ESMF_RC_NOT_IMPL @@ -342,7 +343,7 @@ subroutine ESMF_FieldValidate(field, keywordEnforcer, rc) endif ! get grid dim and extents for the local piece call ESMF_GeomGet(ftypep%geom, dimCount=gridrank, & - distgrid=gridDistGrid, localDECount=localDECount, rc=localrc) + distgrid=geomDistGrid, localDECount=localDECount, rc=localrc) if (localrc .ne. ESMF_SUCCESS) then call ESMF_LogSetError(rcToCheck=ESMF_RC_OBJ_BAD, & msg="Cannot retrieve distgrid, gridrank, localDECount from ftypep%grid", & @@ -379,13 +380,16 @@ subroutine ESMF_FieldValidate(field, keywordEnforcer, rc) msg="Cannot retrieve dimCount, localDECount, arrayDistGrid, arrayrank from ftypep%array", & ESMF_CONTEXT, rcToReturn=rc) return - endif - - ! Verify the distgrids in array and grid match. - if(ESMF_DistGridMatch(gridDistGrid, arrayDistGrid, rc=localrc) & - < ESMF_DISTGRIDMATCH_EXACT) then + endif + + ! Verify the distgrids in array and geom match. + dgMatch = ESMF_DistGridMatch(geomDistGrid, arrayDistGrid, rc=localrc) + if (ESMF_LogFoundError(localrc, & + ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, rcToReturn=rc)) return + if(dgMatch < ESMF_DISTGRIDMATCH_EXACT) then call ESMF_LogSetError(rcToCheck=ESMF_RC_OBJ_BAD, & - msg="grid DistGrid does not match array DistGrid", & + msg="geom DistGrid does not match array DistGrid", & ESMF_CONTEXT, rcToReturn=rc) return endif From 7393f87a901af215ebea0cd696e6421383ebc048 Mon Sep 17 00:00:00 2001 From: Gerhard Theurich Date: Tue, 5 Nov 2024 15:07:41 -0800 Subject: [PATCH 105/207] Add DistGrid match check between Geom object and shared Array into Field sharing code. --- src/addon/NUOPC/src/NUOPC_Connector.F90 | 58 ++++++++++++++++++++++++- 1 file changed, 56 insertions(+), 2 deletions(-) diff --git a/src/addon/NUOPC/src/NUOPC_Connector.F90 b/src/addon/NUOPC/src/NUOPC_Connector.F90 index b73f2ebb26..88fda7b503 100644 --- a/src/addon/NUOPC/src/NUOPC_Connector.F90 +++ b/src/addon/NUOPC/src/NUOPC_Connector.F90 @@ -4582,6 +4582,8 @@ subroutine ShareFieldWithGrid(acceptorField, providerField, name, rc) integer :: stat integer :: localPet type(ESMF_State) :: state + type(ESMF_DistGrid) :: gridDG, arrayDG + type(ESMF_DistGridMatch_Flag) :: dgMatch ! set RC rc = ESMF_SUCCESS @@ -4629,10 +4631,32 @@ subroutine ShareFieldWithGrid(acceptorField, providerField, name, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, file=trim(name)//":"//FILENAME)) return ! bail out endif - ! obtain the array from provider to be shared with acceptor + + ! obtain the array from provider to be shared with acceptor, effectively + ! sharing the provider data allocation with the acceptor field call ESMF_FieldGet(providerField, array=array, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, file=trim(name)//":"//FILENAME)) return + + ! access grid and array DistGrids to ensure match level is high enough + ! to support field sharing + call ESMF_GridGet(grid, staggerloc=staggerloc, distgrid=gridDG, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=trim(name)//":"//FILENAME)) return + call ESMF_ArrayGet(array, distgrid=arrayDG, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=trim(name)//":"//FILENAME)) return + dgMatch = ESMF_DistGridMatch(gridDG, arrayDG, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=trim(name)//":"//FILENAME)) return + if (dgMatch < ESMF_DISTGRIDMATCH_EXACT) then + call ESMF_LogSetError(ESMF_RC_ARG_INCOMP, & + msg="The available Grid does not support Field sharing!",& + line=__LINE__, file=trim(name)//":"//FILENAME, & + rcToReturn=rc) + return ! bail out + endif + ! obtain the vm from provider to create the new field on the provider vm ! This way shared fields will only be send/receive during Timestamp ! propagation on actvive PETs. This is what you expect for a shared field. @@ -4730,6 +4754,8 @@ subroutine ShareFieldWithMesh(acceptorField, providerField, name, rc) integer :: stat integer :: localPet type(ESMF_State) :: state + type(ESMF_DistGrid) :: meshDG, arrayDG + type(ESMF_DistGridMatch_Flag) :: dgMatch ! set RC rc = ESMF_SUCCESS @@ -4773,10 +4799,38 @@ subroutine ShareFieldWithMesh(acceptorField, providerField, name, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, file=trim(name)//":"//FILENAME)) return ! bail out endif - ! obtain the array from provider to be shared with acceptor + + ! obtain the array from provider to be shared with acceptor, effectively + ! sharing the provider data allocation with the acceptor field call ESMF_FieldGet(providerField, array=array, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, file=trim(name)//":"//FILENAME)) return + + ! access mesh and array DistGrids to ensure match level is high enough + ! to support field sharing + if (meshloc == ESMF_MESHLOC_NODE) then + call ESMF_MeshGet(mesh, nodalDistgrid=meshDG, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=trim(name)//":"//FILENAME)) return + else + call ESMF_MeshGet(mesh, elementDistgrid=meshDG, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=trim(name)//":"//FILENAME)) return + endif + call ESMF_ArrayGet(array, distgrid=arrayDG, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=trim(name)//":"//FILENAME)) return + dgMatch = ESMF_DistGridMatch(meshDG, arrayDG, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=trim(name)//":"//FILENAME)) return + if (dgMatch < ESMF_DISTGRIDMATCH_EXACT) then + call ESMF_LogSetError(ESMF_RC_ARG_INCOMP, & + msg="The available Mesh does not support Field sharing!",& + line=__LINE__, file=trim(name)//":"//FILENAME, & + rcToReturn=rc) + return ! bail out + endif + ! obtain the vm from provider to create the new field on the provider vm ! This way shared fields will only be send/receive during Timestamp ! propagation on actvive PETs. This is what you expect for a shared field. From 93a7b1a6d03fd043769977db32b4bd4f7503493b Mon Sep 17 00:00:00 2001 From: Robert Oehmke Date: Tue, 5 Nov 2024 16:08:50 -0700 Subject: [PATCH 106/207] Fix error message. --- src/Infrastructure/Mesh/src/ESMCI_MeshDual.C | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Infrastructure/Mesh/src/ESMCI_MeshDual.C b/src/Infrastructure/Mesh/src/ESMCI_MeshDual.C index 61fc91ea6e..a099f502ff 100644 --- a/src/Infrastructure/Mesh/src/ESMCI_MeshDual.C +++ b/src/Infrastructure/Mesh/src/ESMCI_MeshDual.C @@ -105,7 +105,7 @@ void MeshDual(Mesh *src_mesh, Mesh **_dual_mesh) { // Don't currently support duals of 3D Meshes if (src_mesh->parametric_dim()>2) { - Throw() <<" Creation of a dual mesh isn't supported for Meshes of parametric dim greater than 3.\n"; + Throw() <<" Creation of a dual mesh isn't supported for Meshes of parametric dim greater than 2.\n"; } // Need element coordinates From b59a5b3bb6c2fc1f2bece9c350249be60989b9ae Mon Sep 17 00:00:00 2001 From: Gerhard Theurich Date: Tue, 5 Nov 2024 15:18:42 -0800 Subject: [PATCH 107/207] Improved Reconcile logging for development and debugging. --- .../src/ESMF_StateReconcile.F90 | 144 ++++++++++++------ 1 file changed, 97 insertions(+), 47 deletions(-) diff --git a/src/Superstructure/StateReconcile/src/ESMF_StateReconcile.F90 b/src/Superstructure/StateReconcile/src/ESMF_StateReconcile.F90 index fc329bc508..fb3f8a386c 100644 --- a/src/Superstructure/StateReconcile/src/ESMF_StateReconcile.F90 +++ b/src/Superstructure/StateReconcile/src/ESMF_StateReconcile.F90 @@ -11,6 +11,7 @@ ! #define ESMF_FILENAME "ESMF_StateReconcile.F90" ! +#define RECONCILE_LOG_on #define RECONCILE_ZAP_LOG_off ! ! ESMF StateReconcile module @@ -209,18 +210,18 @@ subroutine ESMF_StateReconcile(state, keywordEnforcer, vm, checkflag, rc) rcToReturn=rc)) return end if -#if 0 +#ifdef RECONCILE_LOG_on block character(ESMF_MAXSTR) :: stateName call ESMF_StateGet(state, name=stateName, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, & - rcToReturn=rc)) return + ESMF_CONTEXT, & + rcToReturn=rc)) return call ESMF_LogWrite("StateReconcile() for State: "//trim(stateName), & ESMF_LOGMSG_DEBUG, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, & - rcToReturn=rc)) return + ESMF_CONTEXT, & + rcToReturn=rc)) return end block #endif @@ -267,15 +268,23 @@ subroutine ESMF_StateReconcile(state, keywordEnforcer, vm, checkflag, rc) rcToReturn=rc)) return endif +#ifdef RECONCILE_LOG_on + block + character(160):: msgStr + write(msgStr,*) "StateReconcile() isNoop: ", isNoop + call ESMF_LogWrite(msgStr, ESMF_LOGMSG_DEBUG, rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, & + rcToReturn=rc)) return + end block +#endif + if (isNoop) then -!call ESMF_LogWrite("returning early with isNoop=.true.", ESMF_LOGMSG_DEBUG, rc=localrc) ! successful early return because of NOOP condition if (present(rc)) rc = ESMF_SUCCESS return endif -!call ESMF_LogWrite("continue with isNoop=.false.", ESMF_LOGMSG_DEBUG, rc=localrc) - ! Each PET broadcasts the object ID lists and compares them to what ! they get back. Missing objects are sent so they can be recreated ! on the PETs without those objects as "proxy" objects. Eventually @@ -950,6 +959,36 @@ subroutine ESMF_StateReconcile_driver(state, vm, rc) endif endif +#ifdef RECONCILE_LOG_on + block + character(160):: msgStr + write(msgStr,*) "ESMF_StateReconcile_driver() size(vmids_send): ", & + size(vmids_send) + call ESMF_LogWrite(msgStr, ESMF_LOGMSG_DEBUG, rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, & + rcToReturn=rc)) return + write(msgStr,*) "ESMF_StateReconcile_driver() size(vmIdMap): ", & + size(vmIdMap) + call ESMF_LogWrite(msgStr, ESMF_LOGMSG_DEBUG, rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, & + rcToReturn=rc)) return + write(msgStr,*) "ESMF_StateReconcile_driver() size(vmintids_send): ", & + size(vmintids_send) + call ESMF_LogWrite(msgStr, ESMF_LOGMSG_DEBUG, rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, & + rcToReturn=rc)) return + write(msgStr,*) "ESMF_StateReconcile_driver() local-singleCompCaseFlag: ", & + singleCompCaseFlag + call ESMF_LogWrite(msgStr, ESMF_LOGMSG_DEBUG, rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, & + rcToReturn=rc)) return + end block +#endif + ! ensure global consistency of the final result singleCompCaseFlagInt(1) = 0 if (singleCompCaseFlag) singleCompCaseFlagInt(1) = 1 @@ -960,6 +999,18 @@ subroutine ESMF_StateReconcile_driver(state, vm, rc) rcToReturn=rc)) return singleCompCaseFlag = (singleCompCaseInt(1)==1) ! globally consistent result +#ifdef RECONCILE_LOG_on + block + character(160):: msgStr + write(msgStr,*) "ESMF_StateReconcile_driver() global-singleCompCaseFlag: ", & + singleCompCaseFlag + call ESMF_LogWrite(msgStr, ESMF_LOGMSG_DEBUG, rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, & + rcToReturn=rc)) return + end block +#endif + if (profile) then call ESMF_TraceRegionExit("Decide between cases", rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & @@ -1049,23 +1100,11 @@ subroutine ESMF_StateReconcile_driver(state, vm, rc) !singleCompCaseFlag = .false. !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -#if 0 -block - character(160):: msgStr - write(msgStr,*) "size(vmintids_send): ", size(vmintids_send) - call ESMF_LogWrite(msgStr, ESMF_LOGMSG_DEBUG, rc=rc) - write(msgStr,*) "size(vmIdMap): ", size(vmIdMap) - call ESMF_LogWrite(msgStr, ESMF_LOGMSG_DEBUG, rc=rc) - write(msgStr,*) "singleCompCaseFlag: ", singleCompCaseFlag - call ESMF_LogWrite(msgStr, ESMF_LOGMSG_DEBUG, rc=rc) -end block -#endif - if (singleCompCaseFlag) then ! CASE: a single component interacting with a state ! ------------------------------------------------------------------------ if (profile) then - call ESMF_TraceRegionEnter("ESMF_ReconcileSingleCompCase", rc=localrc) + call ESMF_TraceRegionEnter("(2<) ESMF_ReconcileSingleCompCase", rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, & rcToReturn=rc)) return @@ -1078,7 +1117,7 @@ subroutine ESMF_StateReconcile_driver(state, vm, rc) rcToReturn=rc)) return ! ------------------------------------------------------------------------ if (profile) then - call ESMF_TraceRegionExit("ESMF_ReconcileSingleCompCase", rc=localrc) + call ESMF_TraceRegionExit("(2<) ESMF_ReconcileSingleCompCase", rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, & rcToReturn=rc)) return @@ -1088,7 +1127,7 @@ subroutine ESMF_StateReconcile_driver(state, vm, rc) ! CASE: multiple components interacting with a state ! ------------------------------------------------------------------------ if (profile) then - call ESMF_TraceRegionEnter("ESMF_ReconcileMultiCompCase", rc=localrc) + call ESMF_TraceRegionEnter("(2<) ESMF_ReconcileMultiCompCase", rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, & rcToReturn=rc)) return @@ -1097,7 +1136,7 @@ subroutine ESMF_StateReconcile_driver(state, vm, rc) call ESMF_ReconcileMultiCompCase() ! ------------------------------------------------------------------------ if (profile) then - call ESMF_TraceRegionExit("ESMF_ReconcileMultiCompCase", rc=localrc) + call ESMF_TraceRegionExit("(2<) ESMF_ReconcileMultiCompCase", rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, & rcToReturn=rc)) return @@ -1552,14 +1591,20 @@ subroutine ESMF_ReconcileSingleCompCase(state, vm, vmId, attreconflag, siwrap, r return endif -#if 0 -block - character(160) :: msgStr - write(msgStr,*) "SingleCompCase rootVas=", rootVas - call ESMF_LogWrite(msgStr, ESMF_LOGMSG_DEBUG, rc=localrc) - write(msgStr,*) "SingleCompCase rootPet=", rootPet - call ESMF_LogWrite(msgStr, ESMF_LOGMSG_DEBUG, rc=localrc) -end block +#ifdef RECONCILE_LOG_on + block + character(160) :: msgStr + write(msgStr,*) "SingleCompCase rootVas=", rootVas + call ESMF_LogWrite(msgStr, ESMF_LOGMSG_DEBUG, rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, & + rcToReturn=rc)) return + write(msgStr,*) "SingleCompCase rootPet=", rootPet + call ESMF_LogWrite(msgStr, ESMF_LOGMSG_DEBUG, rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, & + rcToReturn=rc)) return + end block #endif ! Serialize on rootPet @@ -1588,12 +1633,15 @@ subroutine ESMF_ReconcileSingleCompCase(state, vm, vmId, attreconflag, siwrap, r if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return -#if 0 -block - character(160) :: msgStr - write(msgStr,*) "isFlag=", isFlag - call ESMF_LogWrite(msgStr, ESMF_LOGMSG_DEBUG, rc=localrc) -end block +#ifdef RECONCILE_LOG_on + block + character(160) :: msgStr + write(msgStr,*) "SingleCompCase PET active isFlag=", isFlag + call ESMF_LogWrite(msgStr, ESMF_LOGMSG_DEBUG, rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, & + rcToReturn=rc)) return + end block #endif ! only inactive PETs deserialize the buffer received from rootPet @@ -4512,7 +4560,9 @@ subroutine ESMF_ReconcileZapProxies(state, rc) character(len=ESMF_MAXSTR) :: thisname type(ESMF_FieldType), pointer :: fieldp type(ESMF_FieldBundleType), pointer :: fbpthis - character(len=80) :: msgString +#ifdef RECONCILE_ZAP_LOG_on + character(len=160) :: msgString +#endif ! Initialize return code; assume routine not implemented if (present(rc)) rc = ESMF_RC_NOT_IMPL @@ -4558,8 +4608,8 @@ subroutine ESMF_ReconcileZapProxies(state, rc) ESMF_CONTEXT, rcToReturn=rc)) return #ifdef RECONCILE_ZAP_LOG_on -write(msgString,*) "ESMF_ReconcileZapProxies Field: "//trim(thisname), & - itemList(i)%si%proxyFlag +write(msgString,*) "ESMF_ReconcileZapProxies Field proxyFlag(old): "//& + trim(thisname), itemList(i)%si%proxyFlag call ESMF_LogWrite(msgString, ESMF_LOGMSG_DEBUG, rc=localrc) #endif @@ -4570,8 +4620,8 @@ subroutine ESMF_ReconcileZapProxies(state, rc) rcToReturn=rc)) return #ifdef RECONCILE_ZAP_LOG_on -write(msgString,*) "ESMF_ReconcileZapProxies Field: "//trim(thisname), & - itemList(i)%si%proxyFlag +write(msgString,*) "ESMF_ReconcileZapProxies Field proxyFlag(new): "//& + trim(thisname), itemList(i)%si%proxyFlag call ESMF_LogWrite(msgString, ESMF_LOGMSG_DEBUG, rc=localrc) #endif @@ -4583,8 +4633,8 @@ subroutine ESMF_ReconcileZapProxies(state, rc) ESMF_CONTEXT, rcToReturn=rc)) return #ifdef RECONCILE_ZAP_LOG_on -write(msgString,*) "ESMF_ReconcileZapProxies Field: "//trim(thisname), & - itemList(i)%si%proxyFlag +write(msgString,*) "ESMF_ReconcileZapProxies FieldBundle proxyFlag(old): "//& + trim(thisname), itemList(i)%si%proxyFlag call ESMF_LogWrite(msgString, ESMF_LOGMSG_DEBUG, rc=localrc) #endif @@ -4595,8 +4645,8 @@ subroutine ESMF_ReconcileZapProxies(state, rc) rcToReturn=rc)) return #ifdef RECONCILE_ZAP_LOG_on -write(msgString,*) "ESMF_ReconcileZapProxies Field: "//trim(thisname), & - itemList(i)%si%proxyFlag +write(msgString,*) "ESMF_ReconcileZapProxies FieldBundle proxyFlag(new): "//& + trim(thisname), itemList(i)%si%proxyFlag call ESMF_LogWrite(msgString, ESMF_LOGMSG_DEBUG, rc=localrc) #endif From a5b0cd2470f2f7495fffa301010e8458cbd43498 Mon Sep 17 00:00:00 2001 From: Gerhard Theurich Date: Tue, 5 Nov 2024 18:15:13 -0800 Subject: [PATCH 108/207] Move metadata handling for unique geometries into ESMF_StateReconcile_driver() level for consistency. --- .../src/ESMF_StateReconcile.F90 | 63 ++++++++----------- 1 file changed, 26 insertions(+), 37 deletions(-) diff --git a/src/Superstructure/StateReconcile/src/ESMF_StateReconcile.F90 b/src/Superstructure/StateReconcile/src/ESMF_StateReconcile.F90 index fb3f8a386c..258b65ead8 100644 --- a/src/Superstructure/StateReconcile/src/ESMF_StateReconcile.F90 +++ b/src/Superstructure/StateReconcile/src/ESMF_StateReconcile.F90 @@ -311,28 +311,6 @@ subroutine ESMF_StateReconcile(state, keywordEnforcer, vm, checkflag, rc) rcToReturn=rc)) return endif - if (profile) then - call ESMF_TraceRegionEnter("ESMF_InfoCacheReassembleFields", rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, & - rcToReturn=rc)) return - endif - - ! Traverse the State hierarchy and fix Field references to a shared geometry - call ESMF_InfoCacheReassembleFields(state, state, rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, rcToReturn=rc)) return - - ! Traverse the state hierarchy and remove reconcile-specific attributes - call ESMF_InfoCacheReassembleFieldsFinalize(state, rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, rcToReturn=rc)) return - - if (profile) then - call ESMF_TraceRegionExit("ESMF_InfoCacheReassembleFields", rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, & - rcToReturn=rc)) return - endif - if (localCheckFlag) then if (profile) then call ESMF_TraceRegionEnter("JSON cross PET check", rc=localrc) @@ -1046,7 +1024,7 @@ subroutine ESMF_StateReconcile_driver(state, vm, rc) ! ------------------------------------------------------------------------- if (profile) then - call ESMF_TraceRegionEnter("(2) Update Field metadata", rc=localrc) + call ESMF_TraceRegionEnter("(2) Set Field metadata for unique geometries", rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, & rcToReturn=rc)) return @@ -1062,12 +1040,6 @@ subroutine ESMF_StateReconcile_driver(state, vm, rc) ! geometry objects and maintain sufficient information to re-establish ! references once the objects have been communicated and deserialized. ! ------------------------------------------------------------------------- - if (profile) then - call ESMF_TraceRegionEnter("info_cache for unique geometries", rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, & - rcToReturn=rc)) return - endif call info_cache%Initialize(localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, rcToReturn=rc)) return @@ -1078,16 +1050,9 @@ subroutine ESMF_StateReconcile_driver(state, vm, rc) call info_cache%Destroy(localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, rcToReturn=rc)) return - if (profile) then - call ESMF_TraceRegionExit("info_cache for unique geometries", rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, & - rcToReturn=rc)) return - endif - ! ------------------------------------------------------------------------- if (profile) then - call ESMF_TraceRegionExit("(2) Update Field metadata", rc=localrc) + call ESMF_TraceRegionExit("(2) Set Field metadata for unique geometries", rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, & rcToReturn=rc)) return @@ -1223,6 +1188,30 @@ subroutine ESMF_StateReconcile_driver(state, vm, rc) ! ------------------------------------------------------------------------- if (meminfo) call ESMF_VMLogMemInfo ("(X+1) Reconcile Zapped Proxies") + if (profile) then + call ESMF_TraceRegionEnter("(X+2) Use Field metadata for unique geometries", rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, & + rcToReturn=rc)) return + endif + + ! Traverse the State hierarchy and fix Field references to a shared geometry + call ESMF_InfoCacheReassembleFields(state, state, rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, rcToReturn=rc)) return + + ! Traverse the state hierarchy and remove reconcile-specific attributes + call ESMF_InfoCacheReassembleFieldsFinalize(state, rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, rcToReturn=rc)) return + + if (profile) then + call ESMF_TraceRegionExit("(X+2) Use Field metadata for unique geometries", rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, & + rcToReturn=rc)) return + endif + ! ------------------------------------------------------------------------- + if (meminfo) call ESMF_VMLogMemInfo ("(X+2) Use Field metadata for unique geometries") + if (trace) then call ESMF_ReconcileDebugPrint (ESMF_METHOD // ': Complete!') call ESMF_VMBarrier (vm) From 02751c9f8a280b7e60b8ce6a963d1f9cb6b14c62 Mon Sep 17 00:00:00 2001 From: Gerhard Theurich Date: Wed, 6 Nov 2024 11:56:01 -0800 Subject: [PATCH 109/207] Improve RECONCILE_ZAP_LOG_on output. --- .../src/ESMF_StateReconcile.F90 | 53 ++++++++++++++++--- 1 file changed, 46 insertions(+), 7 deletions(-) diff --git a/src/Superstructure/StateReconcile/src/ESMF_StateReconcile.F90 b/src/Superstructure/StateReconcile/src/ESMF_StateReconcile.F90 index 258b65ead8..15ce776de2 100644 --- a/src/Superstructure/StateReconcile/src/ESMF_StateReconcile.F90 +++ b/src/Superstructure/StateReconcile/src/ESMF_StateReconcile.F90 @@ -12,7 +12,7 @@ #define ESMF_FILENAME "ESMF_StateReconcile.F90" ! #define RECONCILE_LOG_on -#define RECONCILE_ZAP_LOG_off +#define RECONCILE_ZAP_LOG_on ! ! ESMF StateReconcile module module ESMF_StateReconcileMod @@ -199,7 +199,7 @@ subroutine ESMF_StateReconcile(state, keywordEnforcer, vm, checkflag, rc) if (present(checkFlag)) localCheckFlag = checkFlag !TODO: turn this .true. when working on StateReoncile, so all tests validate! -!localCheckFlag = .true. ! force checking +localCheckFlag = .true. ! force checking if (present (vm)) then localvm = vm @@ -1060,6 +1060,22 @@ subroutine ESMF_StateReconcile_driver(state, vm, rc) ! ------------------------------------------------------------------------- if (meminfo) call ESMF_VMLogMemInfo ("after (2) Update Field metadata") +#if 1 + block + type(ESMF_InfoDescribe) :: idesc + ! Log a JSON State representation ----------------------------------------- + call idesc%Initialize(createInfo=.true., addObjectInfo=.true., & + vmIdMap=vmIdMap_ptr, rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, rcToReturn=rc)) return + call idesc%Update(state, "", rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, rcToReturn=rc)) return + call ESMF_LogWrite("state_json_after_set_field_meta="//ESMF_InfoDump(idesc%info), rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, rcToReturn=rc)) return + call idesc%Destroy(rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, rcToReturn=rc)) return + end block +#endif + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !TODO: Remove this once done with testing! !singleCompCaseFlag = .false. @@ -4654,6 +4670,11 @@ subroutine ESMF_ReconcileZapProxies(state, rc) if (ESMF_LogFoundError(localrc, & ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return +#ifdef RECONCILE_ZAP_LOG_on +write(msgString,*) "ESMF_ReconcileZapProxies zapping from State: "//& + trim(thisname) +call ESMF_LogWrite(msgString, ESMF_LOGMSG_DEBUG, rc=localrc) +#endif end if end do endif @@ -4761,7 +4782,7 @@ subroutine ESMF_ReconcileZappedProxies(state, rc) #endif if (associated (zapList(k)%si)) then #ifdef RECONCILE_ZAP_LOG_on -call ESMF_LogWrite("ESMF_ReconcileZappedProxies(): found associated zapList object", & +call ESMF_LogWrite("ESMF_ReconcileZappedProxies(): found valid zapList object", & ESMF_LOGMSG_DEBUG, rc=localrc) #endif ! Note that only Fields and FieldBundles receive the restoration @@ -4781,13 +4802,13 @@ subroutine ESMF_ReconcileZappedProxies(state, rc) ESMF_CONTEXT, rcToReturn=rc)) & return #ifdef RECONCILE_ZAP_LOG_on -call ESMF_LogWrite("ESMF_ReconcileZappedProxies(): checking Field: "//trim(name), & +call ESMF_LogWrite("ESMF_ReconcileZappedProxies(): checking for name match Field: "//trim(name), & ESMF_LOGMSG_DEBUG, rc=localrc) #endif if (name == thisname) then zapFlag(k) = .false. ! indicate that proxy has been restored #ifdef RECONCILE_ZAP_LOG_on -call ESMF_LogWrite("ESMF_ReconcileZappedProxies(): found Field: "//trim(name), & +call ESMF_LogWrite("ESMF_ReconcileZappedProxies(): restore persistent proxy for Field: "//trim(name), & ESMF_LOGMSG_DEBUG, rc=localrc) #endif ! Bend pointers and copy contents to result in the desired @@ -4817,13 +4838,13 @@ subroutine ESMF_ReconcileZappedProxies(state, rc) ESMF_CONTEXT, rcToReturn=rc)) & return #ifdef RECONCILE_ZAP_LOG_on -call ESMF_LogWrite("ESMF_ReconcileZappedProxies(): checking FieldBundle: "//trim(name), & +call ESMF_LogWrite("ESMF_ReconcileZappedProxies(): checking for name match FieldBundle: "//trim(name), & ESMF_LOGMSG_DEBUG, rc=localrc) #endif if (name == thisname) then zapFlag(k) = .false. ! indicate that proxy has been restored #ifdef RECONCILE_ZAP_LOG_on -call ESMF_LogWrite("ESMF_ReconcileZappedProxies(): found FieldBundle: "//trim(name), & +call ESMF_LogWrite("ESMF_ReconcileZappedProxies(): restore persistent proxy for FieldBundle: "//trim(name), & ESMF_LOGMSG_DEBUG, rc=localrc) #endif ! Bend pointers and copy contents to result in the desired @@ -4861,6 +4882,15 @@ subroutine ESMF_ReconcileZappedProxies(state, rc) do k=1, size(zapFlag) if (zapFlag(k)) then if (zapList(k)%si%otype==ESMF_STATEITEM_FIELD) then +#ifdef RECONCILE_ZAP_LOG_on +call ESMF_FieldGet(zapList(k)%si%datap%fp, name=name, rc=localrc) +if (ESMF_LogFoundError(localrc, & + ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, rcToReturn=rc)) & + return +call ESMF_LogWrite("ESMF_ReconcileZappedProxies(): destroy with noGarbage unrestored Field: "//trim(name), & + ESMF_LOGMSG_DEBUG, rc=localrc) +#endif call ESMF_FieldDestroy(zapList(k)%si%datap%fp, & noGarbage=.true., rc=localrc) if (ESMF_LogFoundError(localrc, & @@ -4868,6 +4898,15 @@ subroutine ESMF_ReconcileZappedProxies(state, rc) ESMF_CONTEXT, rcToReturn=rc)) & return else if (zapList(k)%si%otype==ESMF_STATEITEM_FIELDBUNDLE) then +#ifdef RECONCILE_ZAP_LOG_on +call ESMF_FieldBundleGet(zapList(k)%si%datap%fbp, name=name, rc=localrc) +if (ESMF_LogFoundError(localrc, & + ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, rcToReturn=rc)) & + return +call ESMF_LogWrite("ESMF_ReconcileZappedProxies(): destroy with noGarbage unrestored FieldBundle: "//trim(name), & + ESMF_LOGMSG_DEBUG, rc=localrc) +#endif call ESMF_FieldBundleDestroy(zapList(k)%si%datap%fbp, & noGarbage=.true., rc=localrc) if (ESMF_LogFoundError(localrc, & From 2c4febaaf9f6f6e7c5e57294c7aef231b322d89f Mon Sep 17 00:00:00 2001 From: Gerhard Theurich Date: Thu, 7 Nov 2024 11:20:18 -0800 Subject: [PATCH 110/207] Macro to easily turn on/off unique geom treatment in proxies via the Info based implementation. Keep it turned ON for now. --- .../StateReconcile/src/ESMF_StateReconcile.F90 | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/src/Superstructure/StateReconcile/src/ESMF_StateReconcile.F90 b/src/Superstructure/StateReconcile/src/ESMF_StateReconcile.F90 index 15ce776de2..15d3762634 100644 --- a/src/Superstructure/StateReconcile/src/ESMF_StateReconcile.F90 +++ b/src/Superstructure/StateReconcile/src/ESMF_StateReconcile.F90 @@ -11,6 +11,8 @@ ! #define ESMF_FILENAME "ESMF_StateReconcile.F90" ! +#define UNIQUE_GEOM_INFO_TREAT_on +! #define RECONCILE_LOG_on #define RECONCILE_ZAP_LOG_on ! @@ -1022,6 +1024,7 @@ subroutine ESMF_StateReconcile_driver(state, vm, rc) end block #endif +#ifdef UNIQUE_GEOM_INFO_TREAT_on ! ------------------------------------------------------------------------- if (profile) then call ESMF_TraceRegionEnter("(2) Set Field metadata for unique geometries", rc=localrc) @@ -1059,6 +1062,7 @@ subroutine ESMF_StateReconcile_driver(state, vm, rc) endif ! ------------------------------------------------------------------------- if (meminfo) call ESMF_VMLogMemInfo ("after (2) Update Field metadata") +#endif #if 1 block @@ -1204,6 +1208,7 @@ subroutine ESMF_StateReconcile_driver(state, vm, rc) ! ------------------------------------------------------------------------- if (meminfo) call ESMF_VMLogMemInfo ("(X+1) Reconcile Zapped Proxies") +#ifdef UNIQUE_GEOM_INFO_TREAT_on if (profile) then call ESMF_TraceRegionEnter("(X+2) Use Field metadata for unique geometries", rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & @@ -1227,6 +1232,7 @@ subroutine ESMF_StateReconcile_driver(state, vm, rc) endif ! ------------------------------------------------------------------------- if (meminfo) call ESMF_VMLogMemInfo ("(X+2) Use Field metadata for unique geometries") +#endif if (trace) then call ESMF_ReconcileDebugPrint (ESMF_METHOD // ': Complete!') From 21cd763480618e418521543508b1b6203314997b Mon Sep 17 00:00:00 2001 From: Gerhard Theurich Date: Thu, 7 Nov 2024 11:23:08 -0800 Subject: [PATCH 111/207] Improved object logging. --- .../DistGrid/src/ESMCI_DistGrid.C | 6 +++++- src/Infrastructure/Field/src/ESMF_FieldHalo.F90 | 17 +++++++++++++++++ src/Infrastructure/VM/interface/ESMCI_VM_F.C | 5 ++++- .../State/src/ESMF_StateAPI.cppF90 | 2 +- 4 files changed, 27 insertions(+), 3 deletions(-) diff --git a/src/Infrastructure/DistGrid/src/ESMCI_DistGrid.C b/src/Infrastructure/DistGrid/src/ESMCI_DistGrid.C index cea2f6f378..0b40538372 100644 --- a/src/Infrastructure/DistGrid/src/ESMCI_DistGrid.C +++ b/src/Infrastructure/DistGrid/src/ESMCI_DistGrid.C @@ -3937,6 +3937,10 @@ void DistGrid::log( msg << prefix << "--- DistGrid::log() start --------------------------------"; ESMC_LogDefault.Write(msg.str(), msgType); + msg.str(""); // clear + msg << prefix << this; + ESMC_LogDefault.Write(msg.str(), msgType); + if (ESMC_BaseGetStatus()!=ESMF_STATUS_READY){ msg.str(""); // clear msg << prefix << "DistGrid object is invalid! Not created or deleted!"; @@ -3944,7 +3948,7 @@ void DistGrid::log( }else{ msg.str(""); // clear msg << prefix << "DistGrid object is valid!" - << " "; + << ""; ESMC_LogDefault.Write(msg.str(), msgType); } msg.str(""); // clear diff --git a/src/Infrastructure/Field/src/ESMF_FieldHalo.F90 b/src/Infrastructure/Field/src/ESMF_FieldHalo.F90 index a0e79daea8..914cab9346 100644 --- a/src/Infrastructure/Field/src/ESMF_FieldHalo.F90 +++ b/src/Infrastructure/Field/src/ESMF_FieldHalo.F90 @@ -482,6 +482,7 @@ subroutine ESMF_FieldLog(field, keywordEnforcer, prefix, logMsgFlag, deepFlag, r integer :: rank, dimCount character(ESMF_MAXSTR) :: name, tempString character(800) :: msgString + type(ESMF_Array) :: array ! initialize return code; assume routine not implemented localrc = ESMF_RC_NOT_IMPL @@ -539,6 +540,8 @@ subroutine ESMF_FieldLog(field, keywordEnforcer, prefix, logMsgFlag, deepFlag, r ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return + call c_esmc_vmlogpointer(field, prefix, logMsg) + if (fieldStatus == ESMF_FIELDSTATUS_COMPLETE) then call ESMF_FieldGet(field, typekind=typekind, rank=rank, & dimCount=dimCount, rc=localrc) @@ -558,6 +561,20 @@ subroutine ESMF_FieldLog(field, keywordEnforcer, prefix, logMsgFlag, deepFlag, r if (ESMF_LogFoundError(localrc, & ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return + + if (deepLog) then + call ESMF_FieldGet(field, array=array, rc=localrc) + if (ESMF_LogFoundError(localrc, & + ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, rcToReturn=rc)) return + call ESMF_ArrayLog(array, & + prefix=ESMF_StringConcat(prefix, "! "), & + logMsgFlag=logMsg, deepFlag=deepLog, rc=localrc) + if (ESMF_LogFoundError(localrc, & + ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, rcToReturn=rc)) return + endif + endif endif diff --git a/src/Infrastructure/VM/interface/ESMCI_VM_F.C b/src/Infrastructure/VM/interface/ESMCI_VM_F.C index e268fd1ba2..dcddc63950 100644 --- a/src/Infrastructure/VM/interface/ESMCI_VM_F.C +++ b/src/Infrastructure/VM/interface/ESMCI_VM_F.C @@ -1980,7 +1980,10 @@ extern "C" { std::string prefixStr(prefix, prefix_l); std::stringstream msg; msg << prefixStr << ptr; - if (ptr) msg << " => " << *(void **)ptr; + if (ptr){ + msg << " => " << *(void **)ptr; + if (*(void **)ptr) msg << " => " << **(void ***)ptr; + } ESMC_LogDefault.Write(msg.str(), *logMsgFlag); } diff --git a/src/Superstructure/State/src/ESMF_StateAPI.cppF90 b/src/Superstructure/State/src/ESMF_StateAPI.cppF90 index 481df85880..3e786803e4 100644 --- a/src/Superstructure/State/src/ESMF_StateAPI.cppF90 +++ b/src/Superstructure/State/src/ESMF_StateAPI.cppF90 @@ -1896,7 +1896,7 @@ type(ESMF_KeywordEnforcer), optional:: keywordEnforcer ! must use keywords below ESMF_CONTEXT, rcToReturn=rc)) return call ESMF_FieldLog(field, & prefix=ESMF_StringConcat(prefix, "! "), & - logMsgFlag=logMsg, rc=localrc) + logMsgFlag=logMsg, deepFlag=deepLog, rc=localrc) if (ESMF_LogFoundError(localrc, & ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return From 7451968dd41ecc4ced7d7ef7f5eed8bd09d7f894 Mon Sep 17 00:00:00 2001 From: Gerhard Theurich Date: Thu, 7 Nov 2024 11:29:44 -0800 Subject: [PATCH 112/207] Improved object logging. --- src/Infrastructure/Array/src/ESMCI_Array.C | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/src/Infrastructure/Array/src/ESMCI_Array.C b/src/Infrastructure/Array/src/ESMCI_Array.C index ab8b24c704..cb57c7f4e7 100644 --- a/src/Infrastructure/Array/src/ESMCI_Array.C +++ b/src/Infrastructure/Array/src/ESMCI_Array.C @@ -4151,13 +4151,17 @@ void Array::log( msg << prefix << "--- Array::log() start -----------------------------------"; ESMC_LogDefault.Write(msg.str(), msgType); + msg.str(""); // clear + msg << prefix << this; + ESMC_LogDefault.Write(msg.str(), msgType); + if (ESMC_BaseGetStatus()!=ESMF_STATUS_READY){ msg.str(""); // clear msg << prefix << "Array object is invalid! Not created or deleted!"; ESMC_LogDefault.Write(msg.str(), msgType); }else{ msg.str(""); // clear - msg << prefix << " "; + msg << prefix << ""; ESMC_LogDefault.Write(msg.str(), msgType); if (deepFlag) getDistGrid()->log(prefix+"! ", msgType, deepFlag); } From 3f86c8923081a993a6eb06d7099f29bb4b57f2ab Mon Sep 17 00:00:00 2001 From: Gerhard Theurich Date: Thu, 7 Nov 2024 11:31:16 -0800 Subject: [PATCH 113/207] Debug logging in Array::serialize() and Array::deserialize() to help debugging of SingleCompCase Reconcile. --- src/Infrastructure/Array/src/ESMCI_Array.C | 24 ++++++++++++++++++++++ 1 file changed, 24 insertions(+) diff --git a/src/Infrastructure/Array/src/ESMCI_Array.C b/src/Infrastructure/Array/src/ESMCI_Array.C index cb57c7f4e7..63389bdee1 100644 --- a/src/Infrastructure/Array/src/ESMCI_Array.C +++ b/src/Infrastructure/Array/src/ESMCI_Array.C @@ -4487,8 +4487,21 @@ int Array::serialize( *ip++ = distgridToPackedArrayMap[i]; *ip++ = tensorElementCount; *ip++ = replicatedDimCount; +// *ip++ = replicatedDimCount; } else ip += 3 + 2*tensorCount + 2*distgrid->getDimCount () + rank; +// ip += 4 + 2*tensorCount + 2*distgrid->getDimCount () + rank; + +if (inquireflag != ESMF_INQUIREONLY){ + std::stringstream msg; + msg << "Array::serialize():" << __LINE__ << " name: " << getName() + << " rank=" << rank + << " tensorCount=" << tensorCount + << " distgrid->getDimCount()=" << distgrid->getDimCount() + << " tensorElementCount=" << tensorElementCount + << " replicatedDimCount=" << *(ip-1); + ESMC_LogDefault.Write(msg.str(), ESMC_LOGMSG_DEBUG); +} // fix offset cp = (char *)ip; @@ -4580,6 +4593,17 @@ int Array::deserialize( distgridToPackedArrayMap[i] = *ip++; tensorElementCount = *ip++; replicatedDimCount = *ip++; +// ip++; +{ + std::stringstream msg; + msg << "Array::deserialize():" << __LINE__ << " name: " << getName() + << " rank=" << rank + << " tensorCount=" << tensorCount + << " distgrid->getDimCount()=" << distgrid->getDimCount() + << " tensorElementCount=" << tensorElementCount + << " replicatedDimCount=" << replicatedDimCount; + ESMC_LogDefault.Write(msg.str(), ESMC_LOGMSG_DEBUG); +} // fix offset cp = (char *)ip; From 4c4dbdbb6d92bcc518cc14cadc8bad8392e2329c Mon Sep 17 00:00:00 2001 From: Gerhard Theurich Date: Tue, 29 Oct 2024 14:53:49 -0700 Subject: [PATCH 114/207] Catch exceptions on the interface level to cover the case where the object has been destroyed and an exception is thrown. Also while space clean-up. --- .../DistGrid/interface/ESMCI_DistGrid_F.C | 916 +++++++++--------- 1 file changed, 479 insertions(+), 437 deletions(-) diff --git a/src/Infrastructure/DistGrid/interface/ESMCI_DistGrid_F.C b/src/Infrastructure/DistGrid/interface/ESMCI_DistGrid_F.C index 927389ceb0..1ce1bc489e 100644 --- a/src/Infrastructure/DistGrid/interface/ESMCI_DistGrid_F.C +++ b/src/Infrastructure/DistGrid/interface/ESMCI_DistGrid_F.C @@ -1,10 +1,10 @@ // $Id$ // // Earth System Modeling Framework -// Copyright (c) 2002-2024, 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, +// Copyright (c) 2002-2024, 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. // @@ -42,8 +42,8 @@ using namespace std; extern "C" { // - ESMF-public methods: - - void FTN_X(c_esmc_distgridcreatedg)(ESMCI::DistGrid **ptr, + + void FTN_X(c_esmc_distgridcreatedg)(ESMCI::DistGrid **ptr, ESMCI::DistGrid **dg, ESMCI::InterArray *firstExtra, ESMCI::InterArray *lastExtra, ESMC_IndexFlag *indexflag, ESMCI::InterArray *connectionList, ESMC_Logical *balanceflag, @@ -64,7 +64,7 @@ extern "C" { actualFlag = false; // not an actual member because VM present but NULL } #if 0 - printf("c_esmc_distgridcreatedg(): opt_vm=%p, actualFlag=%d\n", + printf("c_esmc_distgridcreatedg(): opt_vm=%p, actualFlag=%d\n", opt_vm, actualFlag); #endif ESMCI::DELayout *opt_delayout; @@ -89,21 +89,21 @@ extern "C" { // test for NULL pointer via macro before calling any class methods ESMCI_NULL_CHECK_PRC(ptr, rc) *ptr = ESMCI::DistGrid::create(*dg, firstExtra, lastExtra, - ESMC_NOT_PRESENT_FILTER(indexflag), connectionList, + ESMC_NOT_PRESENT_FILTER(indexflag), connectionList, balanceflagOpt, opt_delayout, opt_vm, actualFlag, &localrc); if (ESMC_LogDefault.MsgFoundError(localrc, ESMCI_ERR_PASSTHRU, ESMC_CONTEXT, ESMC_NOT_PRESENT_FILTER(rc))) return; // bail out // return successfully if (rc!=NULL) *rc = ESMF_SUCCESS; } - - void FTN_X(c_esmc_distgridcreaterd)(ESMCI::DistGrid **ptr, + + void FTN_X(c_esmc_distgridcreaterd)(ESMCI::DistGrid **ptr, ESMCI::InterArray *minIndex, ESMCI::InterArray *maxIndex, ESMCI::InterArray *regDecomp, - ESMCI::Decomp_Flag *decompflag, int *decompflagCount, + ESMCI::Decomp_Flag *decompflag, int *decompflagCount, ESMCI::InterArray *regDecompFirstExtra, ESMCI::InterArray *regDecompLastExtra, - ESMCI::InterArray *deLabelList, ESMC_IndexFlag *indexflag, + ESMCI::InterArray *deLabelList, ESMC_IndexFlag *indexflag, ESMCI::InterArray *connectionList, ESMCI::DELayout **delayout, ESMCI::VM **vm, ESMC_TypeKind_Flag *indexTK, int *rc){ @@ -115,7 +115,7 @@ extern "C" { ESMC_TypeKind_Flag opt_indexTK; // deal with optional arguments ESMCI::DELayout *opt_delayout; - if (ESMC_NOT_PRESENT_FILTER(delayout) == ESMC_NULL_POINTER) + if (ESMC_NOT_PRESENT_FILTER(delayout) == ESMC_NULL_POINTER) opt_delayout = NULL; else opt_delayout = *delayout; @@ -132,7 +132,7 @@ extern "C" { printf("c_esmc_distgridcreaterd(): opt_delayout=%p, opt_vm=%p, " "actualFlag=%d\n", opt_delayout, opt_vm, actualFlag); #endif - if (ESMC_NOT_PRESENT_FILTER(indexTK) == ESMC_NULL_POINTER) + if (ESMC_NOT_PRESENT_FILTER(indexTK) == ESMC_NULL_POINTER) opt_indexTK = ESMF_NOKIND; else opt_indexTK = *indexTK; if (actualFlag){ @@ -149,15 +149,15 @@ extern "C" { // return successfully if (rc!=NULL) *rc = ESMF_SUCCESS; } - - void FTN_X(c_esmc_distgridcreaterdt)(ESMCI::DistGrid **ptr, + + void FTN_X(c_esmc_distgridcreaterdt)(ESMCI::DistGrid **ptr, ESMCI::InterArray *minIndex, ESMCI::InterArray *maxIndex, ESMCI::InterArray *regDecomp, ESMCI::Decomp_Flag *decompflag, int *decompflagCount1, int *decompflagCount2, ESMCI::InterArray *regDecompFirstExtra, ESMCI::InterArray *regDecompLastExtra, - ESMCI::InterArray *deLabelList, ESMC_IndexFlag *indexflag, + ESMCI::InterArray *deLabelList, ESMC_IndexFlag *indexflag, ESMCI::InterArray *connectionList, ESMCI::DELayout **delayout, ESMCI::VM **vm, ESMC_TypeKind_Flag *indexTK, int *rc){ @@ -170,32 +170,32 @@ extern "C" { ESMCI::VM *opt_vm; ESMC_TypeKind_Flag opt_indexTK; // deal with optional arguments - if (ESMC_NOT_PRESENT_FILTER(delayout) == ESMC_NULL_POINTER) + if (ESMC_NOT_PRESENT_FILTER(delayout) == ESMC_NULL_POINTER) opt_delayout = NULL; else opt_delayout = *delayout; if (ESMC_NOT_PRESENT_FILTER(vm) == ESMC_NULL_POINTER) opt_vm = NULL; else opt_vm = *vm; - if (ESMC_NOT_PRESENT_FILTER(indexTK) == ESMC_NULL_POINTER) + if (ESMC_NOT_PRESENT_FILTER(indexTK) == ESMC_NULL_POINTER) opt_indexTK = ESMF_NOKIND; else opt_indexTK = *indexTK; // test for NULL pointer via macro before calling any class methods ESMCI_NULL_CHECK_PRC(ptr, rc) *ptr = ESMCI::DistGrid::create(minIndex, maxIndex, regDecomp, - decompflag, *decompflagCount1, *decompflagCount2, - regDecompFirstExtra, regDecompLastExtra, deLabelList, + decompflag, *decompflagCount1, *decompflagCount2, + regDecompFirstExtra, regDecompLastExtra, deLabelList, ESMC_NOT_PRESENT_FILTER(indexflag), connectionList, opt_delayout, opt_vm, &localrc, opt_indexTK); ESMC_LogDefault.MsgFoundError(localrc, ESMCI_ERR_PASSTHRU, ESMC_CONTEXT, ESMC_NOT_PRESENT_FILTER(rc)); } - - void FTN_X(c_esmc_distgridcreaterdf)(ESMCI::DistGrid **ptr, + + void FTN_X(c_esmc_distgridcreaterdf)(ESMCI::DistGrid **ptr, ESMCI::InterArray *minIndex, ESMCI::InterArray *maxIndex, ESMCI::InterArray *regDecomp, ESMCI::Decomp_Flag *decompflag, int *decompflagCount, ESMCI::InterArray *regDecompFirstExtra, ESMCI::InterArray *regDecompLastExtra, - ESMCI::InterArray *deLabelList, ESMC_IndexFlag *indexflag, + ESMCI::InterArray *deLabelList, ESMC_IndexFlag *indexflag, ESMCI::InterArray *connectionList, int *fastAxis, ESMCI::VM **vm, int *rc){ #undef ESMC_METHOD @@ -217,12 +217,12 @@ extern "C" { ESMC_CONTEXT, ESMC_NOT_PRESENT_FILTER(rc)); } - void FTN_X(c_esmc_distgridcreatedb)(ESMCI::DistGrid **ptr, + void FTN_X(c_esmc_distgridcreatedb)(ESMCI::DistGrid **ptr, ESMCI::InterArray *minIndex, ESMCI::InterArray *maxIndex, ESMCI::InterArray *deBlockList, - ESMCI::InterArray *deLabelList, ESMC_IndexFlag *indexflag, + ESMCI::InterArray *deLabelList, ESMC_IndexFlag *indexflag, ESMCI::InterArray *connectionList, - ESMCI::DELayout **delayout, ESMCI::VM **vm, ESMC_TypeKind_Flag *indexTK, + ESMCI::DELayout **delayout, ESMCI::VM **vm, ESMC_TypeKind_Flag *indexTK, int *rc){ #undef ESMC_METHOD #define ESMC_METHOD "c_esmc_distgridcreatedb()" @@ -233,12 +233,12 @@ extern "C" { ESMCI::VM *opt_vm; ESMC_TypeKind_Flag opt_indexTK; // deal with optional arguments - if (ESMC_NOT_PRESENT_FILTER(delayout) == ESMC_NULL_POINTER) + if (ESMC_NOT_PRESENT_FILTER(delayout) == ESMC_NULL_POINTER) opt_delayout = NULL; else opt_delayout = *delayout; if (ESMC_NOT_PRESENT_FILTER(vm) == ESMC_NULL_POINTER) opt_vm = NULL; else opt_vm = *vm; - if (ESMC_NOT_PRESENT_FILTER(indexTK) == ESMC_NULL_POINTER) + if (ESMC_NOT_PRESENT_FILTER(indexTK) == ESMC_NULL_POINTER) opt_indexTK = ESMF_NOKIND; else opt_indexTK = *indexTK; // test for NULL pointer via macro before calling any class methods @@ -249,13 +249,13 @@ extern "C" { ESMC_LogDefault.MsgFoundError(localrc, ESMCI_ERR_PASSTHRU, ESMC_CONTEXT, ESMC_NOT_PRESENT_FILTER(rc)); } - - void FTN_X(c_esmc_distgridcreatedbt)(ESMCI::DistGrid **ptr, + + void FTN_X(c_esmc_distgridcreatedbt)(ESMCI::DistGrid **ptr, ESMCI::InterArray *minIndex, ESMCI::InterArray *maxIndex, ESMCI::InterArray *deBlockList, ESMCI::InterArray *deToTileMap, - ESMCI::InterArray *deLabelList, ESMC_IndexFlag *indexflag, + ESMCI::InterArray *deLabelList, ESMC_IndexFlag *indexflag, ESMCI::InterArray *connectionList, - ESMCI::DELayout **delayout, ESMCI::VM **vm, ESMC_TypeKind_Flag *indexTK, + ESMCI::DELayout **delayout, ESMCI::VM **vm, ESMC_TypeKind_Flag *indexTK, int *rc){ #undef ESMC_METHOD #define ESMC_METHOD "c_esmc_distgridcreatedbt()" @@ -266,12 +266,12 @@ extern "C" { ESMCI::VM *opt_vm; ESMC_TypeKind_Flag opt_indexTK; // deal with optional arguments - if (ESMC_NOT_PRESENT_FILTER(delayout) == ESMC_NULL_POINTER) + if (ESMC_NOT_PRESENT_FILTER(delayout) == ESMC_NULL_POINTER) opt_delayout = NULL; else opt_delayout = *delayout; if (ESMC_NOT_PRESENT_FILTER(vm) == ESMC_NULL_POINTER) opt_vm = NULL; else opt_vm = *vm; - if (ESMC_NOT_PRESENT_FILTER(indexTK) == ESMC_NULL_POINTER) + if (ESMC_NOT_PRESENT_FILTER(indexTK) == ESMC_NULL_POINTER) opt_indexTK = ESMF_NOKIND; else opt_indexTK = *indexTK; // test for NULL pointer via macro before calling any class methods @@ -282,8 +282,8 @@ extern "C" { ESMC_LogDefault.MsgFoundError(localrc, ESMCI_ERR_PASSTHRU, ESMC_CONTEXT, ESMC_NOT_PRESENT_FILTER(rc)); } - - void FTN_X(c_esmc_distgriddestroy)(ESMCI::DistGrid **ptr, + + void FTN_X(c_esmc_distgriddestroy)(ESMCI::DistGrid **ptr, ESMC_Logical *noGarbage, int *rc){ #undef ESMC_METHOD #define ESMC_METHOD "c_esmc_distgriddestroy()" @@ -297,7 +297,7 @@ extern "C" { ESMCI_NULL_CHECK_PRC(ptr, rc) ESMCI_NULL_CHECK_PRC(*ptr, rc) ESMC_LogDefault.MsgFoundError(ESMCI::DistGrid::destroy(ptr, noGarbageOpt), - ESMCI_ERR_PASSTHRU, ESMC_CONTEXT, + ESMCI_ERR_PASSTHRU, ESMC_CONTEXT, ESMC_NOT_PRESENT_FILTER(rc)); } @@ -315,7 +315,7 @@ extern "C" { ESMCI::InterArray *tileListPDe, ESMCI::InterArray *indexCountPDimPDe, ESMCI::InterArray *collocationPDim, - ESMC_Logical *regDecompFlag, + ESMC_Logical *regDecompFlag, int *connectionCount, ESMCI::InterArray *connectionList, ESMC_TypeKind_Flag *indexTK, @@ -329,360 +329,374 @@ extern "C" { // test for NULL pointer via macro before calling any class methods ESMCI_NULL_CHECK_PRC(ptr, rc) ESMCI_NULL_CHECK_PRC(*ptr, rc) - // fill simple return values - if (ESMC_NOT_PRESENT_FILTER(delayout) != ESMC_NULL_POINTER) - *delayout = (*ptr)->getDELayout(); - if (ESMC_NOT_PRESENT_FILTER(tileCount) != ESMC_NULL_POINTER) - *tileCount = (*ptr)->getTileCount(); - if (ESMC_NOT_PRESENT_FILTER(deCount) != ESMC_NULL_POINTER) - *deCount = (*ptr)->getDELayout()->getDeCount(); - if (ESMC_NOT_PRESENT_FILTER(localDeCount) != ESMC_NULL_POINTER) - *localDeCount = (*ptr)->getDELayout()->getLocalDeCount(); - if (ESMC_NOT_PRESENT_FILTER(dimCount) != ESMC_NULL_POINTER) - *dimCount = (*ptr)->getDimCount(); - if (ESMC_NOT_PRESENT_FILTER(connectionCount) != ESMC_NULL_POINTER) - *connectionCount = (*ptr)->getConnectionCount(); - if (ESMC_NOT_PRESENT_FILTER(regDecompFlag) != ESMC_NULL_POINTER){ - if ((*ptr)->getRegDecomp()) - *regDecompFlag = ESMF_TRUE; - else - *regDecompFlag = ESMF_FALSE; - } - if (ESMC_NOT_PRESENT_FILTER(indexTK) != ESMC_NULL_POINTER) - *indexTK = (*ptr)->getIndexTK(); - if (ESMC_NOT_PRESENT_FILTER(indexflag) != ESMC_NULL_POINTER) - *indexflag = (*ptr)->getIndexflag(); - // fill minIndexPDimPTile - if (present(minIndexPDimPTile)){ - // minIndexPDimPTile was provided -> do some error checking - if ((minIndexPDimPTile)->dimCount != 2){ - ESMC_LogDefault.MsgFoundError(ESMC_RC_ARG_RANK, - "minIndexPDimPTile array must be of rank 2", ESMC_CONTEXT, rc); - return; - } - if ((minIndexPDimPTile)->extent[0] < (*ptr)->getDimCount()){ - ESMC_LogDefault.MsgFoundError(ESMC_RC_ARG_SIZE, - "1st dim of minIndexPDimPTile array must be of size 'dimCount'", - ESMC_CONTEXT, rc); - return; - } - if ((minIndexPDimPTile)->extent[1] < (*ptr)->getTileCount()){ - ESMC_LogDefault.MsgFoundError(ESMC_RC_ARG_SIZE, - "2nd dim of minIndexPDimPTile array must be of size 'tileCount'", - ESMC_CONTEXT, rc); - return; - } - // fill in the values: The interface allows to pass in minIndexPDimPTile - // arrays which are larger than dimCount x tileCount. Consequently it is - // necessary to memcpy strips of contiguous data since it cannot be - // assumed that all data ends up contiguous in the minIndexPDimPTile - // array. - for (int i=0; i<(*ptr)->getTileCount(); i++) - memcpy( - &((minIndexPDimPTile)->array[i*((minIndexPDimPTile)->extent[0])]), - &(((*ptr)->getMinIndexPDimPTile())[i*(*ptr)->getDimCount()]), - sizeof(int)*(*ptr)->getDimCount()); - } - // fill maxIndexPDimPTile - if (present(maxIndexPDimPTile)){ - // maxIndexPDimPTile was provided -> do some error checking - if ((maxIndexPDimPTile)->dimCount != 2){ - ESMC_LogDefault.MsgFoundError(ESMC_RC_ARG_RANK, - "maxIndexPDimPTile array must be of rank 2", ESMC_CONTEXT, rc); - return; - } - if ((maxIndexPDimPTile)->extent[0] < (*ptr)->getDimCount()){ - ESMC_LogDefault.MsgFoundError(ESMC_RC_ARG_SIZE, - "1st dim of maxIndexPDimPTile array must be of size 'dimCount'", - ESMC_CONTEXT, rc); - return; + try{ + // fill simple return values + if (ESMC_NOT_PRESENT_FILTER(delayout) != ESMC_NULL_POINTER) + *delayout = (*ptr)->getDELayout(); + if (ESMC_NOT_PRESENT_FILTER(tileCount) != ESMC_NULL_POINTER) + *tileCount = (*ptr)->getTileCount(); + if (ESMC_NOT_PRESENT_FILTER(deCount) != ESMC_NULL_POINTER) + *deCount = (*ptr)->getDELayout()->getDeCount(); + if (ESMC_NOT_PRESENT_FILTER(localDeCount) != ESMC_NULL_POINTER) + *localDeCount = (*ptr)->getDELayout()->getLocalDeCount(); + if (ESMC_NOT_PRESENT_FILTER(dimCount) != ESMC_NULL_POINTER) + *dimCount = (*ptr)->getDimCount(); + if (ESMC_NOT_PRESENT_FILTER(connectionCount) != ESMC_NULL_POINTER) + *connectionCount = (*ptr)->getConnectionCount(); + if (ESMC_NOT_PRESENT_FILTER(regDecompFlag) != ESMC_NULL_POINTER){ + if ((*ptr)->getRegDecomp()) + *regDecompFlag = ESMF_TRUE; + else + *regDecompFlag = ESMF_FALSE; } - if ((maxIndexPDimPTile)->extent[1] < (*ptr)->getTileCount()){ - ESMC_LogDefault.MsgFoundError(ESMC_RC_ARG_SIZE, - "2nd dim of maxIndexPDimPTile array must be of size 'tileCount'", - ESMC_CONTEXT, rc); - return; + if (ESMC_NOT_PRESENT_FILTER(indexTK) != ESMC_NULL_POINTER) + *indexTK = (*ptr)->getIndexTK(); + if (ESMC_NOT_PRESENT_FILTER(indexflag) != ESMC_NULL_POINTER) + *indexflag = (*ptr)->getIndexflag(); + // fill minIndexPDimPTile + if (present(minIndexPDimPTile)){ + // minIndexPDimPTile was provided -> do some error checking + if ((minIndexPDimPTile)->dimCount != 2){ + ESMC_LogDefault.MsgFoundError(ESMC_RC_ARG_RANK, + "minIndexPDimPTile array must be of rank 2", ESMC_CONTEXT, rc); + return; + } + if ((minIndexPDimPTile)->extent[0] < (*ptr)->getDimCount()){ + ESMC_LogDefault.MsgFoundError(ESMC_RC_ARG_SIZE, + "1st dim of minIndexPDimPTile array must be of size 'dimCount'", + ESMC_CONTEXT, rc); + return; + } + if ((minIndexPDimPTile)->extent[1] < (*ptr)->getTileCount()){ + ESMC_LogDefault.MsgFoundError(ESMC_RC_ARG_SIZE, + "2nd dim of minIndexPDimPTile array must be of size 'tileCount'", + ESMC_CONTEXT, rc); + return; + } + // fill in the values: The interface allows to pass in minIndexPDimPTile + // arrays which are larger than dimCount x tileCount. Consequently it is + // necessary to memcpy strips of contiguous data since it cannot be + // assumed that all data ends up contiguous in the minIndexPDimPTile + // array. + for (int i=0; i<(*ptr)->getTileCount(); i++) + memcpy( + &((minIndexPDimPTile)->array[i*((minIndexPDimPTile)->extent[0])]), + &(((*ptr)->getMinIndexPDimPTile())[i*(*ptr)->getDimCount()]), + sizeof(int)*(*ptr)->getDimCount()); } - // fill in the values: The interface allows to pass in maxIndexPDimPTile - // arrays which are larger than dimCount x tileCount. Consequently it is - // necessary to memcpy strips of contiguous data since it cannot be - // assumed that all data ends up contiguous in the maxIndexPDimPTile - // array. - for (int i=0; i<(*ptr)->getTileCount(); i++) - memcpy( - &((maxIndexPDimPTile)->array[i*((maxIndexPDimPTile)->extent[0])]), - &(((*ptr)->getMaxIndexPDimPTile())[i*(*ptr)->getDimCount()]), - sizeof(int)*(*ptr)->getDimCount()); - } - // fill elementCountPTile - if (present(elementCountPTile) || present(elementCountPTileI8)){ - // access the internal information - int tileCount = (*ptr)->getTileCount(); - const ESMC_I8 *access = (*ptr)->getElementCountPTile(); - if (present(elementCountPTile)){ - // elementCountPTile was provided -> do some error checking - if ((elementCountPTile)->dimCount != 1){ + // fill maxIndexPDimPTile + if (present(maxIndexPDimPTile)){ + // maxIndexPDimPTile was provided -> do some error checking + if ((maxIndexPDimPTile)->dimCount != 2){ ESMC_LogDefault.MsgFoundError(ESMC_RC_ARG_RANK, - "elementCountPTile array must be of rank 1", ESMC_CONTEXT, rc); + "maxIndexPDimPTile array must be of rank 2", ESMC_CONTEXT, rc); return; } - if ((elementCountPTile)->extent[0] < (*ptr)->getTileCount()){ + if ((maxIndexPDimPTile)->extent[0] < (*ptr)->getDimCount()){ ESMC_LogDefault.MsgFoundError(ESMC_RC_ARG_SIZE, - "1st dim of elementCountPTile array must be of size 'tileCount'", + "1st dim of maxIndexPDimPTile array must be of size 'dimCount'", ESMC_CONTEXT, rc); return; } - // fill in values - for (int i=0; i I4, with overflow check - (elementCountPTile)->array[i] = (int)(access[i]); - if ((ESMC_I8)(elementCountPTile)->array[i] != (access[i])){ - ESMC_LogDefault.MsgFoundError(ESMC_RC_ARG_BAD, - "Overflow detected in elementCountPTile after I8 -> I4 cast", + if ((maxIndexPDimPTile)->extent[1] < (*ptr)->getTileCount()){ + ESMC_LogDefault.MsgFoundError(ESMC_RC_ARG_SIZE, + "2nd dim of maxIndexPDimPTile array must be of size 'tileCount'", + ESMC_CONTEXT, rc); + return; + } + // fill in the values: The interface allows to pass in maxIndexPDimPTile + // arrays which are larger than dimCount x tileCount. Consequently it is + // necessary to memcpy strips of contiguous data since it cannot be + // assumed that all data ends up contiguous in the maxIndexPDimPTile + // array. + for (int i=0; i<(*ptr)->getTileCount(); i++) + memcpy( + &((maxIndexPDimPTile)->array[i*((maxIndexPDimPTile)->extent[0])]), + &(((*ptr)->getMaxIndexPDimPTile())[i*(*ptr)->getDimCount()]), + sizeof(int)*(*ptr)->getDimCount()); + } + // fill elementCountPTile + if (present(elementCountPTile) || present(elementCountPTileI8)){ + // access the internal information + int tileCount = (*ptr)->getTileCount(); + const ESMC_I8 *access = (*ptr)->getElementCountPTile(); + if (present(elementCountPTile)){ + // elementCountPTile was provided -> do some error checking + if ((elementCountPTile)->dimCount != 1){ + ESMC_LogDefault.MsgFoundError(ESMC_RC_ARG_RANK, + "elementCountPTile array must be of rank 1", ESMC_CONTEXT, rc); + return; + } + if ((elementCountPTile)->extent[0] < (*ptr)->getTileCount()){ + ESMC_LogDefault.MsgFoundError(ESMC_RC_ARG_SIZE, + "1st dim of elementCountPTile array must be of size 'tileCount'", + ESMC_CONTEXT, rc); + return; + } + // fill in values + for (int i=0; i I4, with overflow check + (elementCountPTile)->array[i] = (int)(access[i]); + if ((ESMC_I8)(elementCountPTile)->array[i] != (access[i])){ + ESMC_LogDefault.MsgFoundError(ESMC_RC_ARG_BAD, + "Overflow detected in elementCountPTile after I8 -> I4 cast", + ESMC_CONTEXT, rc); + return; + } + } + } + if (present(elementCountPTileI8)){ + // elementCountPTileI8 was provided -> do some error checking + if ((elementCountPTileI8)->dimCount != 1){ + ESMC_LogDefault.MsgFoundError(ESMC_RC_ARG_RANK, + "elementCountPTileI8 array must be of rank 1", ESMC_CONTEXT, rc); + return; + } + if ((elementCountPTileI8)->extent[0] < (*ptr)->getTileCount()){ + ESMC_LogDefault.MsgFoundError(ESMC_RC_ARG_SIZE, + "1st dim of elementCountPTileI8 array must be of size 'tileCount'", ESMC_CONTEXT, rc); return; } + // fill in values + memcpy((elementCountPTileI8)->array, access, sizeof(ESMC_I8)*tileCount); } } - if (present(elementCountPTileI8)){ - // elementCountPTileI8 was provided -> do some error checking - if ((elementCountPTileI8)->dimCount != 1){ + // fill minIndexPDimPDe + if (present(minIndexPDimPDe)){ + // minIndexPDimPDe was provided -> do some error checking + if ((minIndexPDimPDe)->dimCount != 2){ ESMC_LogDefault.MsgFoundError(ESMC_RC_ARG_RANK, - "elementCountPTileI8 array must be of rank 1", ESMC_CONTEXT, rc); + "minIndexPDimPDe array must be of rank 2", ESMC_CONTEXT, rc); return; } - if ((elementCountPTileI8)->extent[0] < (*ptr)->getTileCount()){ + if ((minIndexPDimPDe)->extent[0] < (*ptr)->getDimCount()){ ESMC_LogDefault.MsgFoundError(ESMC_RC_ARG_SIZE, - "1st dim of elementCountPTileI8 array must be of size 'tileCount'", + "1st dim of minIndexPDimPDe array must be of size 'dimCount'", ESMC_CONTEXT, rc); return; } - // fill in values - memcpy((elementCountPTileI8)->array, access, sizeof(ESMC_I8)*tileCount); - } - } - // fill minIndexPDimPDe - if (present(minIndexPDimPDe)){ - // minIndexPDimPDe was provided -> do some error checking - if ((minIndexPDimPDe)->dimCount != 2){ - ESMC_LogDefault.MsgFoundError(ESMC_RC_ARG_RANK, - "minIndexPDimPDe array must be of rank 2", ESMC_CONTEXT, rc); - return; - } - if ((minIndexPDimPDe)->extent[0] < (*ptr)->getDimCount()){ - ESMC_LogDefault.MsgFoundError(ESMC_RC_ARG_SIZE, - "1st dim of minIndexPDimPDe array must be of size 'dimCount'", - ESMC_CONTEXT, rc); - return; - } - if ((minIndexPDimPDe)->extent[1] < (*ptr)->getDELayout()->getDeCount()){ - ESMC_LogDefault.MsgFoundError(ESMC_RC_ARG_SIZE, - "2nd dim of minIndexPDimPDe array must be of size 'deCount'", - ESMC_CONTEXT, rc); - return; - } - // fill in the values: The interface allows to pass in minIndexPDimPDe - // arrays which are larger than dimCount x deCount. Consequently it is - // necessary to memcpy strips of contiguous data since it cannot be - // assumed that all data ends up contiguous in the minIndexPDimPDe - // array. - for (int i=0; i<(*ptr)->getDELayout()->getDeCount(); i++) - memcpy( - &((minIndexPDimPDe)->array[i*((minIndexPDimPDe)->extent[0])]), - &(((*ptr)->getMinIndexPDimPDe())[i*(*ptr)->getDimCount()]), - sizeof(int)*(*ptr)->getDimCount()); - } - // fill maxIndexPDimPDe - if (present(maxIndexPDimPDe)){ - // maxIndexPDimPDe was provided -> do some error checking - if ((maxIndexPDimPDe)->dimCount != 2){ - ESMC_LogDefault.MsgFoundError(ESMC_RC_ARG_RANK, - "maxIndexPDimPDe array must be of rank 2", ESMC_CONTEXT, rc); - return; - } - if ((maxIndexPDimPDe)->extent[0] < (*ptr)->getDimCount()){ - ESMC_LogDefault.MsgFoundError(ESMC_RC_ARG_SIZE, - "1st dim of maxIndexPDimPDe array must be of size 'dimCount'", - ESMC_CONTEXT, rc); - return; - } - if ((maxIndexPDimPDe)->extent[1] < (*ptr)->getDELayout()->getDeCount()){ - ESMC_LogDefault.MsgFoundError(ESMC_RC_ARG_SIZE, - "2nd dim of maxIndexPDimPDe array must be of size 'deCount'", - ESMC_CONTEXT, rc); - return; + if ((minIndexPDimPDe)->extent[1] < (*ptr)->getDELayout()->getDeCount()){ + ESMC_LogDefault.MsgFoundError(ESMC_RC_ARG_SIZE, + "2nd dim of minIndexPDimPDe array must be of size 'deCount'", + ESMC_CONTEXT, rc); + return; + } + // fill in the values: The interface allows to pass in minIndexPDimPDe + // arrays which are larger than dimCount x deCount. Consequently it is + // necessary to memcpy strips of contiguous data since it cannot be + // assumed that all data ends up contiguous in the minIndexPDimPDe + // array. + for (int i=0; i<(*ptr)->getDELayout()->getDeCount(); i++) + memcpy( + &((minIndexPDimPDe)->array[i*((minIndexPDimPDe)->extent[0])]), + &(((*ptr)->getMinIndexPDimPDe())[i*(*ptr)->getDimCount()]), + sizeof(int)*(*ptr)->getDimCount()); } - // fill in the values: The interface allows to pass in maxIndexPDimPDe - // arrays which are larger than dimCount x deCount. Consequently it is - // necessary to memcpy strips of contiguous data since it cannot be - // assumed that all data ends up contiguous in the maxIndexPDimPDe - // array. - for (int i=0; i<(*ptr)->getDELayout()->getDeCount(); i++) - memcpy( - &((maxIndexPDimPDe)->array[i*((maxIndexPDimPDe)->extent[0])]), - &(((*ptr)->getMaxIndexPDimPDe())[i*(*ptr)->getDimCount()]), - sizeof(int)*(*ptr)->getDimCount()); - } - // fill elementCountPDe - if (present(elementCountPDe) || present(elementCountPDeI8)){ - // access the internal information - int deCount = (*ptr)->getDELayout()->getDeCount(); - const ESMC_I8 *access = (*ptr)->getElementCountPDe(); - if (present(elementCountPDe)){ - // elementCountPDe was provided -> do some error checking - if ((elementCountPDe)->dimCount != 1){ + // fill maxIndexPDimPDe + if (present(maxIndexPDimPDe)){ + // maxIndexPDimPDe was provided -> do some error checking + if ((maxIndexPDimPDe)->dimCount != 2){ ESMC_LogDefault.MsgFoundError(ESMC_RC_ARG_RANK, - "elementCountPDe array must be of rank 1", ESMC_CONTEXT, rc); + "maxIndexPDimPDe array must be of rank 2", ESMC_CONTEXT, rc); return; } - if ((elementCountPDe)->extent[0] < (*ptr)->getDELayout()->getDeCount()){ + if ((maxIndexPDimPDe)->extent[0] < (*ptr)->getDimCount()){ ESMC_LogDefault.MsgFoundError(ESMC_RC_ARG_SIZE, - "1st dim of elementCountPDe array must be of size 'deCount'", + "1st dim of maxIndexPDimPDe array must be of size 'dimCount'", ESMC_CONTEXT, rc); return; } - // fill in values - for (int i=0; i I4, with overflow check - (elementCountPDe)->array[i] = (int)(access[i]); - if ((ESMC_I8)(elementCountPDe)->array[i] != (access[i])){ - ESMC_LogDefault.MsgFoundError(ESMC_RC_ARG_BAD, - "Overflow detected in elementCountPDe after I8 -> I4 cast", + if ((maxIndexPDimPDe)->extent[1] < (*ptr)->getDELayout()->getDeCount()){ + ESMC_LogDefault.MsgFoundError(ESMC_RC_ARG_SIZE, + "2nd dim of maxIndexPDimPDe array must be of size 'deCount'", + ESMC_CONTEXT, rc); + return; + } + // fill in the values: The interface allows to pass in maxIndexPDimPDe + // arrays which are larger than dimCount x deCount. Consequently it is + // necessary to memcpy strips of contiguous data since it cannot be + // assumed that all data ends up contiguous in the maxIndexPDimPDe + // array. + for (int i=0; i<(*ptr)->getDELayout()->getDeCount(); i++) + memcpy( + &((maxIndexPDimPDe)->array[i*((maxIndexPDimPDe)->extent[0])]), + &(((*ptr)->getMaxIndexPDimPDe())[i*(*ptr)->getDimCount()]), + sizeof(int)*(*ptr)->getDimCount()); + } + // fill elementCountPDe + if (present(elementCountPDe) || present(elementCountPDeI8)){ + // access the internal information + int deCount = (*ptr)->getDELayout()->getDeCount(); + const ESMC_I8 *access = (*ptr)->getElementCountPDe(); + if (present(elementCountPDe)){ + // elementCountPDe was provided -> do some error checking + if ((elementCountPDe)->dimCount != 1){ + ESMC_LogDefault.MsgFoundError(ESMC_RC_ARG_RANK, + "elementCountPDe array must be of rank 1", ESMC_CONTEXT, rc); + return; + } + if ((elementCountPDe)->extent[0] < (*ptr)->getDELayout()->getDeCount()){ + ESMC_LogDefault.MsgFoundError(ESMC_RC_ARG_SIZE, + "1st dim of elementCountPDe array must be of size 'deCount'", ESMC_CONTEXT, rc); return; } + // fill in values + for (int i=0; i I4, with overflow check + (elementCountPDe)->array[i] = (int)(access[i]); + if ((ESMC_I8)(elementCountPDe)->array[i] != (access[i])){ + ESMC_LogDefault.MsgFoundError(ESMC_RC_ARG_BAD, + "Overflow detected in elementCountPDe after I8 -> I4 cast", + ESMC_CONTEXT, rc); + return; + } + } + } + if (present(elementCountPDeI8)){ + // elementCountPDeI8 was provided -> do some error checking + if ((elementCountPDeI8)->dimCount != 1){ + ESMC_LogDefault.MsgFoundError(ESMC_RC_ARG_RANK, + "elementCountPDeI8 array must be of rank 1", ESMC_CONTEXT, rc); + return; + } + if ((elementCountPDeI8)->extent[0] < (*ptr)->getDELayout()->getDeCount()){ + ESMC_LogDefault.MsgFoundError(ESMC_RC_ARG_SIZE, + "1st dim of elementCountPDeI8 array must be of size 'deCount'", + ESMC_CONTEXT, rc); + return; + } + // fill in values + memcpy((elementCountPDeI8)->array, access, sizeof(ESMC_I8)*deCount); } } - if (present(elementCountPDeI8)){ - // elementCountPDeI8 was provided -> do some error checking - if ((elementCountPDeI8)->dimCount != 1){ + // fill localDeToDeMap + if (present(localDeToDeMap)){ + // localDeToDeMap was provided -> do some error checking + if ((localDeToDeMap)->dimCount != 1){ ESMC_LogDefault.MsgFoundError(ESMC_RC_ARG_RANK, - "elementCountPDeI8 array must be of rank 1", ESMC_CONTEXT, rc); + "localDeToDeMap array must be of rank 1", ESMC_CONTEXT, rc); return; } - if ((elementCountPDeI8)->extent[0] < (*ptr)->getDELayout()->getDeCount()){ + if ((localDeToDeMap)->extent[0] < (*ptr)->getDELayout()->getLocalDeCount()){ ESMC_LogDefault.MsgFoundError(ESMC_RC_ARG_SIZE, - "1st dim of elementCountPDeI8 array must be of size 'deCount'", + "1st dim of localDeToDeMap array must be of size 'localDeCount'", ESMC_CONTEXT, rc); return; } // fill in values - memcpy((elementCountPDeI8)->array, access, sizeof(ESMC_I8)*deCount); - } - } - // fill localDeToDeMap - if (present(localDeToDeMap)){ - // localDeToDeMap was provided -> do some error checking - if ((localDeToDeMap)->dimCount != 1){ - ESMC_LogDefault.MsgFoundError(ESMC_RC_ARG_RANK, - "localDeToDeMap array must be of rank 1", ESMC_CONTEXT, rc); - return; - } - if ((localDeToDeMap)->extent[0] < (*ptr)->getDELayout()->getLocalDeCount()){ - ESMC_LogDefault.MsgFoundError(ESMC_RC_ARG_SIZE, - "1st dim of localDeToDeMap array must be of size 'localDeCount'", - ESMC_CONTEXT, rc); - return; - } - // fill in values - memcpy((localDeToDeMap)->array, (*ptr)->getDELayout()->getLocalDeToDeMap(), - sizeof(int)*(*ptr)->getDELayout()->getLocalDeCount()); - } - // fill tileListPDe - if (present(tileListPDe)){ - // tileListPDe was provided -> do some error checking - if ((tileListPDe)->dimCount != 1){ - ESMC_LogDefault.MsgFoundError(ESMC_RC_ARG_RANK, - "tileListPDe array must be of rank 1", ESMC_CONTEXT, rc); - return; - } - if ((tileListPDe)->extent[0] < (*ptr)->getDELayout()->getDeCount()){ - ESMC_LogDefault.MsgFoundError(ESMC_RC_ARG_SIZE, - "1st dim of tileListPDe array must be of size 'deCount'", - ESMC_CONTEXT, rc); - return; + memcpy((localDeToDeMap)->array, (*ptr)->getDELayout()->getLocalDeToDeMap(), + sizeof(int)*(*ptr)->getDELayout()->getLocalDeCount()); } - // fill in values - memcpy((tileListPDe)->array, (*ptr)->getTileListPDe(), - sizeof(int)*(*ptr)->getDELayout()->getDeCount()); - } - // fill indexCountPDimPDe - if (present(indexCountPDimPDe)){ - // indexCountPDimPDe was provided -> do some error checking - if ((indexCountPDimPDe)->dimCount != 2){ - ESMC_LogDefault.MsgFoundError(ESMC_RC_ARG_RANK, - "indexCountPDimPDe array must be of rank 2", ESMC_CONTEXT, rc); - return; - } - if ((indexCountPDimPDe)->extent[0] < (*ptr)->getDimCount()){ - ESMC_LogDefault.MsgFoundError(ESMC_RC_ARG_SIZE, - "1st dim of indexCountPDimPDe array must be of size 'dimCount'", - ESMC_CONTEXT, rc); - return; - } - if ((indexCountPDimPDe)->extent[1] < - (*ptr)->getDELayout()->getDeCount()){ - ESMC_LogDefault.MsgFoundError(ESMC_RC_ARG_SIZE, - "2nd dim of indexCountPDimPDe array must be of size 'deCount'", - ESMC_CONTEXT, rc); - return; - } - // fill in the values: The interface allows to pass in indexCountPDimPDe - // arrays which are larger than dimCount x deCount. Consequently it is - // necessary to memcpy strips of contiguous data since it cannot be - // assumed that all data ends up contiguous in the indexCountPDimPDe - // array. - for (int i=0; i<(*ptr)->getDELayout()->getDeCount(); i++) - memcpy( - &((indexCountPDimPDe)->array[i*((indexCountPDimPDe)->extent[0])]), - &(((*ptr)->getIndexCountPDimPDe())[i*(*ptr)->getDimCount()]), - sizeof(int)*(*ptr)->getDimCount()); - } - // fill collocationPDim - if (present(collocationPDim)){ - // collocationPDim was provided -> do some error checking - if ((collocationPDim)->dimCount != 1){ - ESMC_LogDefault.MsgFoundError(ESMC_RC_ARG_RANK, - "collocationPDim array must be of rank 1", ESMC_CONTEXT, rc); - return; - } - if ((collocationPDim)->extent[0] < (*ptr)->getDimCount()){ - ESMC_LogDefault.MsgFoundError(ESMC_RC_ARG_SIZE, - "1st dim of collocationPDim array must be of size 'dimCount'", - ESMC_CONTEXT, rc); - return; - } - // fill in values - memcpy((collocationPDim)->array, (*ptr)->getCollocationPDim(), - sizeof(int)*((*ptr)->getDimCount())); - } - // fill connectionList - if (present(connectionList)){ - // connectionList was provided -> do some error checking - if ((connectionList)->dimCount != 2){ - ESMC_LogDefault.MsgFoundError(ESMC_RC_ARG_RANK, - "connectionList array must be of rank 2", ESMC_CONTEXT, rc); - return; + // fill tileListPDe + if (present(tileListPDe)){ + // tileListPDe was provided -> do some error checking + if ((tileListPDe)->dimCount != 1){ + ESMC_LogDefault.MsgFoundError(ESMC_RC_ARG_RANK, + "tileListPDe array must be of rank 1", ESMC_CONTEXT, rc); + return; + } + if ((tileListPDe)->extent[0] < (*ptr)->getDELayout()->getDeCount()){ + ESMC_LogDefault.MsgFoundError(ESMC_RC_ARG_SIZE, + "1st dim of tileListPDe array must be of size 'deCount'", + ESMC_CONTEXT, rc); + return; + } + // fill in values + memcpy((tileListPDe)->array, (*ptr)->getTileListPDe(), + sizeof(int)*(*ptr)->getDELayout()->getDeCount()); } - if ((connectionList)->extent[0] < 2*((*ptr)->getDimCount()) + 2){ - ESMC_LogDefault.MsgFoundError(ESMC_RC_ARG_SIZE, - "1st dim of connectionList array must be of size '2*dimCount + 2'", - ESMC_CONTEXT, rc); - return; + // fill indexCountPDimPDe + if (present(indexCountPDimPDe)){ + // indexCountPDimPDe was provided -> do some error checking + if ((indexCountPDimPDe)->dimCount != 2){ + ESMC_LogDefault.MsgFoundError(ESMC_RC_ARG_RANK, + "indexCountPDimPDe array must be of rank 2", ESMC_CONTEXT, rc); + return; + } + if ((indexCountPDimPDe)->extent[0] < (*ptr)->getDimCount()){ + ESMC_LogDefault.MsgFoundError(ESMC_RC_ARG_SIZE, + "1st dim of indexCountPDimPDe array must be of size 'dimCount'", + ESMC_CONTEXT, rc); + return; + } + if ((indexCountPDimPDe)->extent[1] < + (*ptr)->getDELayout()->getDeCount()){ + ESMC_LogDefault.MsgFoundError(ESMC_RC_ARG_SIZE, + "2nd dim of indexCountPDimPDe array must be of size 'deCount'", + ESMC_CONTEXT, rc); + return; + } + // fill in the values: The interface allows to pass in indexCountPDimPDe + // arrays which are larger than dimCount x deCount. Consequently it is + // necessary to memcpy strips of contiguous data since it cannot be + // assumed that all data ends up contiguous in the indexCountPDimPDe + // array. + for (int i=0; i<(*ptr)->getDELayout()->getDeCount(); i++) + memcpy( + &((indexCountPDimPDe)->array[i*((indexCountPDimPDe)->extent[0])]), + &(((*ptr)->getIndexCountPDimPDe())[i*(*ptr)->getDimCount()]), + sizeof(int)*(*ptr)->getDimCount()); } - if ((connectionList)->extent[1] < (*ptr)->getConnectionCount()){ - ESMC_LogDefault.MsgFoundError(ESMC_RC_ARG_SIZE, - "2nd dim of connectionList array must be of size 'connectionCount'", - ESMC_CONTEXT, rc); - return; + // fill collocationPDim + if (present(collocationPDim)){ + // collocationPDim was provided -> do some error checking + if ((collocationPDim)->dimCount != 1){ + ESMC_LogDefault.MsgFoundError(ESMC_RC_ARG_RANK, + "collocationPDim array must be of rank 1", ESMC_CONTEXT, rc); + return; + } + if ((collocationPDim)->extent[0] < (*ptr)->getDimCount()){ + ESMC_LogDefault.MsgFoundError(ESMC_RC_ARG_SIZE, + "1st dim of collocationPDim array must be of size 'dimCount'", + ESMC_CONTEXT, rc); + return; + } + // fill in values + memcpy((collocationPDim)->array, (*ptr)->getCollocationPDim(), + sizeof(int)*((*ptr)->getDimCount())); } - // fill in the values: - for (int i=0; i<(*ptr)->getConnectionCount(); i++){ - memcpy( - &((connectionList)->array[i*((connectionList)->extent[0])]), - ((*ptr)->getConnectionList())[i], - sizeof(int)*(2*((*ptr)->getDimCount())+2)); + // fill connectionList + if (present(connectionList)){ + // connectionList was provided -> do some error checking + if ((connectionList)->dimCount != 2){ + ESMC_LogDefault.MsgFoundError(ESMC_RC_ARG_RANK, + "connectionList array must be of rank 2", ESMC_CONTEXT, rc); + return; + } + if ((connectionList)->extent[0] < 2*((*ptr)->getDimCount()) + 2){ + ESMC_LogDefault.MsgFoundError(ESMC_RC_ARG_SIZE, + "1st dim of connectionList array must be of size '2*dimCount + 2'", + ESMC_CONTEXT, rc); + return; + } + if ((connectionList)->extent[1] < (*ptr)->getConnectionCount()){ + ESMC_LogDefault.MsgFoundError(ESMC_RC_ARG_SIZE, + "2nd dim of connectionList array must be of size 'connectionCount'", + ESMC_CONTEXT, rc); + return; + } + // fill in the values: + for (int i=0; i<(*ptr)->getConnectionCount(); i++){ + memcpy( + &((connectionList)->array[i*((connectionList)->extent[0])]), + ((*ptr)->getConnectionList())[i], + sizeof(int)*(2*((*ptr)->getDimCount())+2)); + } } + }catch(int localrc){ + if (ESMC_LogDefault.MsgFoundError(localrc, ESMCI_ERR_PASSTHRU, + ESMC_CONTEXT, rc)) + return; // bail out + }catch(std::exception &x){ + ESMC_LogDefault.MsgFoundError(ESMC_RC_INTNRL_BAD, x.what(), ESMC_CONTEXT, + rc); + return; // bail out + }catch(...){ + ESMC_LogDefault.MsgFoundError(ESMC_RC_INTNRL_BAD, "- Caught exception", + ESMC_CONTEXT, rc); + return; } // return successfully if (rc!=NULL) *rc = ESMF_SUCCESS; @@ -690,8 +704,8 @@ extern "C" { void FTN_X(c_esmc_distgridgetplocalde)(ESMCI::DistGrid **ptr, int *localDeArg, int *collocationArg, ESMC_Logical *arbSeqIndexFlag, - ESMCI::InterArray *seqIndexList, - ESMCI::InterArray *seqIndexListI8, + ESMCI::InterArray *seqIndexList, + ESMCI::InterArray *seqIndexListI8, int *elementCount, ESMC_I8 *elementCountI8, int *rc){ #undef ESMC_METHOD #define ESMC_METHOD "c_esmc_distgridgetplocalde()" @@ -701,62 +715,76 @@ extern "C" { // test for NULL pointer via macro before calling any class methods ESMCI_NULL_CHECK_PRC(ptr, rc) ESMCI_NULL_CHECK_PRC(*ptr, rc) - // shift input indices - int localDe = *localDeArg; // already base 0 - // check input values - int localDeCount = (*ptr)->getDELayout()->getLocalDeCount(); - if (localDe < 0 || localDe > localDeCount-1){ - ESMC_LogDefault.MsgFoundError(ESMC_RC_ARG_BAD, - "Specified local DE out of bounds", ESMC_CONTEXT, - ESMC_NOT_PRESENT_FILTER(rc)); - return; - } - // check incoming collocation argument - int diffCollocationCount = (*ptr)->getDiffCollocationCount(); - const int *collocationTable = (*ptr)->getCollocationTable(); - int collocation; - int collIndex; - if (ESMC_NOT_PRESENT_FILTER(collocationArg) != ESMC_NULL_POINTER){ - collocation = *collocationArg; - int i; - for (i=0; igetDELayout()->getLocalDeCount(); + if (localDe < 0 || localDe > localDeCount-1){ + ESMC_LogDefault.MsgFoundError(ESMC_RC_ARG_BAD, + "Specified local DE out of bounds", ESMC_CONTEXT, ESMC_NOT_PRESENT_FILTER(rc)); return; } - collIndex = i; - }else{ - collocation = collocationTable[0]; // default to first collocation - collIndex = 0; - } - void const *arbSeqIndexList = - (*ptr)->getArbSeqIndexList(localDe, collocation, &localrc); - if (ESMC_LogDefault.MsgFoundError(localrc, ESMCI_ERR_PASSTHRU, - ESMC_CONTEXT, ESMC_NOT_PRESENT_FILTER(rc))) return; - if (ESMC_NOT_PRESENT_FILTER(arbSeqIndexFlag) != ESMC_NULL_POINTER){ - if (arbSeqIndexList) - *arbSeqIndexFlag = ESMF_TRUE; - else - *arbSeqIndexFlag = ESMF_FALSE; + // check incoming collocation argument + int diffCollocationCount = (*ptr)->getDiffCollocationCount(); + const int *collocationTable = (*ptr)->getCollocationTable(); + int collocation; + int collIndex; + if (ESMC_NOT_PRESENT_FILTER(collocationArg) != ESMC_NULL_POINTER){ + collocation = *collocationArg; + int i; + for (i=0; igetArbSeqIndexList(localDe, collocation, &localrc); + if (ESMC_LogDefault.MsgFoundError(localrc, ESMCI_ERR_PASSTHRU, + ESMC_CONTEXT, ESMC_NOT_PRESENT_FILTER(rc))) return; + if (ESMC_NOT_PRESENT_FILTER(arbSeqIndexFlag) != ESMC_NULL_POINTER){ + if (arbSeqIndexList) + *arbSeqIndexFlag = ESMF_TRUE; + else + *arbSeqIndexFlag = ESMF_FALSE; + } + // fill seqIndexList + localrc = (*ptr)->fillSeqIndexList(seqIndexList, localDe, collocation); + if (ESMC_LogDefault.MsgFoundError(localrc, ESMCI_ERR_PASSTHRU, + ESMC_CONTEXT, ESMC_NOT_PRESENT_FILTER(rc))) return; + // fill seqIndexListI8 + localrc = (*ptr)->fillSeqIndexList(seqIndexListI8, localDe, collocation); + if (ESMC_LogDefault.MsgFoundError(localrc, ESMCI_ERR_PASSTHRU, + ESMC_CONTEXT, ESMC_NOT_PRESENT_FILTER(rc))) return; + // set elementCount + int *const *elementCountPCollPLocalDe = + (*ptr)->getElementCountPCollPLocalDe(); + if (ESMC_NOT_PRESENT_FILTER(elementCount) != ESMC_NULL_POINTER) + *elementCount = elementCountPCollPLocalDe[collIndex][localDe]; + if (ESMC_NOT_PRESENT_FILTER(elementCountI8) != ESMC_NULL_POINTER) + *elementCountI8 = (ESMC_I8)elementCountPCollPLocalDe[collIndex][localDe]; + }catch(int localrc){ + if (ESMC_LogDefault.MsgFoundError(localrc, ESMCI_ERR_PASSTHRU, + ESMC_CONTEXT, rc)) + return; // bail out + }catch(std::exception &x){ + ESMC_LogDefault.MsgFoundError(ESMC_RC_INTNRL_BAD, x.what(), ESMC_CONTEXT, + rc); + return; // bail out + }catch(...){ + ESMC_LogDefault.MsgFoundError(ESMC_RC_INTNRL_BAD, "- Caught exception", + ESMC_CONTEXT, rc); + return; } - // fill seqIndexList - localrc = (*ptr)->fillSeqIndexList(seqIndexList, localDe, collocation); - if (ESMC_LogDefault.MsgFoundError(localrc, ESMCI_ERR_PASSTHRU, - ESMC_CONTEXT, ESMC_NOT_PRESENT_FILTER(rc))) return; - // fill seqIndexListI8 - localrc = (*ptr)->fillSeqIndexList(seqIndexListI8, localDe, collocation); - if (ESMC_LogDefault.MsgFoundError(localrc, ESMCI_ERR_PASSTHRU, - ESMC_CONTEXT, ESMC_NOT_PRESENT_FILTER(rc))) return; - // set elementCount - int *const *elementCountPCollPLocalDe = - (*ptr)->getElementCountPCollPLocalDe(); - if (ESMC_NOT_PRESENT_FILTER(elementCount) != ESMC_NULL_POINTER) - *elementCount = elementCountPCollPLocalDe[collIndex][localDe]; - if (ESMC_NOT_PRESENT_FILTER(elementCountI8) != ESMC_NULL_POINTER) - *elementCountI8 = (ESMC_I8)elementCountPCollPLocalDe[collIndex][localDe]; // return successfully if (ESMC_NOT_PRESENT_FILTER(rc)) *rc = ESMF_SUCCESS; } @@ -771,34 +799,48 @@ extern "C" { // test for NULL pointer via macro before calling any class methods ESMCI_NULL_CHECK_PRC(ptr, rc) ESMCI_NULL_CHECK_PRC(*ptr, rc) - // shift input indices - int localDe = *localDeArg; // already base 0 - int dim = *dimArg - 1; // shift to base 0 - // fill indexList - if (present(indexList)){ - // indexList provided -> get indexListPtr & do some error checking - // getIndexListPDimPLocalDe() checks localDe and dim for range! - const int *indexListPtr = - (*ptr)->getIndexListPDimPLocalDe(localDe, dim+1, &localrc); - if (ESMC_LogDefault.MsgFoundError(localrc, ESMCI_ERR_PASSTHRU, - ESMC_CONTEXT, ESMC_NOT_PRESENT_FILTER(rc))) return; - if ((indexList)->dimCount != 1){ - ESMC_LogDefault.MsgFoundError(ESMC_RC_ARG_RANK, - "indexList array must be of rank 1", ESMC_CONTEXT, rc); - return; - } - if ((indexList)->extent[0] < - ((*ptr)->getIndexCountPDimPDe())[(*ptr)->getDELayout()-> - getLocalDeToDeMap()[localDe] * (*ptr)->getDimCount()+dim]){ - ESMC_LogDefault.MsgFoundError(ESMC_RC_ARG_SIZE, - "1st dimension of indexList array size insufficiently", - ESMC_CONTEXT, rc); - return; + try{ + // shift input indices + int localDe = *localDeArg; // already base 0 + int dim = *dimArg - 1; // shift to base 0 + // fill indexList + if (present(indexList)){ + // indexList provided -> get indexListPtr & do some error checking + // getIndexListPDimPLocalDe() checks localDe and dim for range! + const int *indexListPtr = + (*ptr)->getIndexListPDimPLocalDe(localDe, dim+1, &localrc); + if (ESMC_LogDefault.MsgFoundError(localrc, ESMCI_ERR_PASSTHRU, + ESMC_CONTEXT, ESMC_NOT_PRESENT_FILTER(rc))) return; + if ((indexList)->dimCount != 1){ + ESMC_LogDefault.MsgFoundError(ESMC_RC_ARG_RANK, + "indexList array must be of rank 1", ESMC_CONTEXT, rc); + return; + } + if ((indexList)->extent[0] < + ((*ptr)->getIndexCountPDimPDe())[(*ptr)->getDELayout()-> + getLocalDeToDeMap()[localDe] * (*ptr)->getDimCount()+dim]){ + ESMC_LogDefault.MsgFoundError(ESMC_RC_ARG_SIZE, + "1st dimension of indexList array size insufficiently", + ESMC_CONTEXT, rc); + return; + } + // fill in the values + memcpy((indexList)->array, indexListPtr, + sizeof(int) * (*ptr)->getIndexCountPDimPDe()[((*ptr)->getDELayout()-> + getLocalDeToDeMap()[localDe] * (*ptr)->getDimCount()+dim)]); } - // fill in the values - memcpy((indexList)->array, indexListPtr, - sizeof(int) * (*ptr)->getIndexCountPDimPDe()[((*ptr)->getDELayout()-> - getLocalDeToDeMap()[localDe] * (*ptr)->getDimCount()+dim)]); + }catch(int localrc){ + if (ESMC_LogDefault.MsgFoundError(localrc, ESMCI_ERR_PASSTHRU, + ESMC_CONTEXT, rc)) + return; // bail out + }catch(std::exception &x){ + ESMC_LogDefault.MsgFoundError(ESMC_RC_INTNRL_BAD, x.what(), ESMC_CONTEXT, + rc); + return; // bail out + }catch(...){ + ESMC_LogDefault.MsgFoundError(ESMC_RC_INTNRL_BAD, "- Caught exception", + ESMC_CONTEXT, rc); + return; } // return successfully if (rc!=NULL) *rc = ESMF_SUCCESS; @@ -826,7 +868,7 @@ extern "C" { rc); return; // bail out }catch(...){ - ESMC_LogDefault.MsgFoundError(ESMC_RC_INTNRL_BAD, "- Caught exception", + ESMC_LogDefault.MsgFoundError(ESMC_RC_INTNRL_BAD, "- Caught exception", ESMC_CONTEXT, rc); return; } @@ -845,7 +887,7 @@ extern "C" { if (ESMC_LogDefault.MsgFoundError(localrc, ESMCI_ERR_PASSTHRU, ESMC_CONTEXT, ESMC_NOT_PRESENT_FILTER(rc))) return; } - + void FTN_X(c_esmc_distgridprint)(ESMCI::DistGrid **ptr, int *rc){ #undef ESMC_METHOD #define ESMC_METHOD "c_esmc_distgridprint()" @@ -860,7 +902,7 @@ extern "C" { // Flush before crossing language interface to ensure correct output order fflush(stdout); } - + void FTN_X(c_esmc_distgridvalidate)(ESMCI::DistGrid **ptr, int *rc){ #undef ESMC_METHOD #define ESMC_METHOD "c_esmc_distgridvalidate()" @@ -873,7 +915,7 @@ extern "C" { ESMCI_ERR_PASSTHRU, ESMC_CONTEXT, ESMC_NOT_PRESENT_FILTER(rc)); } - + void FTN_X(c_esmc_distgridconnection)( ESMCI::InterArray *connection, int *tileIndexA, int *tileIndexB, ESMCI::InterArray *positionVector, @@ -886,7 +928,7 @@ extern "C" { // Call into the actual C++ method wrapped inside LogErr handling ESMC_LogDefault.MsgFoundError( ESMCI::DistGrid::connection(connection, *tileIndexA, - *tileIndexB, positionVector, orientationVector), + *tileIndexB, positionVector, orientationVector), ESMCI_ERR_PASSTHRU, ESMC_CONTEXT, ESMC_NOT_PRESENT_FILTER(rc)); } @@ -899,7 +941,7 @@ extern "C" { if (rc!=NULL) *rc = ESMC_RC_NOT_IMPL; // Call into the actual C++ method wrapped inside LogErr handling ESMC_LogDefault.MsgFoundError( - ESMCI::DistGrid::regDecompSetCubic(regDecomp, *deCount), + ESMCI::DistGrid::regDecompSetCubic(regDecomp, *deCount), ESMCI_ERR_PASSTHRU, ESMC_CONTEXT, ESMC_NOT_PRESENT_FILTER(rc)); } @@ -918,9 +960,9 @@ extern "C" { ESMCI_ERR_PASSTHRU, ESMC_CONTEXT, ESMC_NOT_PRESENT_FILTER(rc)); } - + void FTN_X(c_esmc_distgridsetarbseqindex)( - ESMCI::DistGrid **ptr, ESMCI::InterArray *arbSeqIndex, + ESMCI::DistGrid **ptr, ESMCI::InterArray *arbSeqIndex, int *localDe, int *collocation, int *rc){ #undef ESMC_METHOD #define ESMC_METHOD "c_esmc_distgridsetarbseqindex()" @@ -936,7 +978,7 @@ extern "C" { } void FTN_X(c_esmc_distgridsetarbseqindexi8)( - ESMCI::DistGrid **ptr, ESMCI::InterArray *arbSeqIndex, + ESMCI::DistGrid **ptr, ESMCI::InterArray *arbSeqIndex, int *localDe, int *collocation, int *rc){ #undef ESMC_METHOD #define ESMC_METHOD "c_esmc_distgridsetarbseqindex()" @@ -950,7 +992,7 @@ extern "C" { ESMCI_ERR_PASSTHRU, ESMC_CONTEXT, ESMC_NOT_PRESENT_FILTER(rc)); } - + void FTN_X(c_esmc_distgridserialize)(ESMCI::DistGrid **distgrid, char *buf, int *length, int *offset, ESMC_InquireFlag *inquireflag, int *rc, ESMCI_FortranStrLenArg buf_l){ From 8797d8c5525796bbd0fb1cb08f52db01dd151499 Mon Sep 17 00:00:00 2001 From: Gerhard Theurich Date: Thu, 7 Nov 2024 14:33:53 -0800 Subject: [PATCH 115/207] Catch exceptions when directly interacting with C++ layer. --- .../Grid/interface/ESMCI_Grid_F.C | 469 +++++++++--------- 1 file changed, 240 insertions(+), 229 deletions(-) diff --git a/src/Infrastructure/Grid/interface/ESMCI_Grid_F.C b/src/Infrastructure/Grid/interface/ESMCI_Grid_F.C index edfaf56bdc..90ff0f574f 100644 --- a/src/Infrastructure/Grid/interface/ESMCI_Grid_F.C +++ b/src/Infrastructure/Grid/interface/ESMCI_Grid_F.C @@ -474,254 +474,265 @@ void c_esmc_grid_get_from_proto(ESMCI::Grid **_grid, // Get Grid pointer grid=*_grid; - decompType = grid->getDecompType(); - - //Initialize return code - localrc = ESMC_RC_NOT_IMPL; - if (_rc!=NULL) *_rc = ESMC_RC_NOT_IMPL; - - // make sure status is correct - if (grid->getStatus() < ESMC_GRIDSTATUS_SHAPE_READY) { - - // Get information from the protogrid - c_esmc_grid_get_from_proto(_grid, - _coordTypeKind, - _dimCount, - _tileCount, - _distgrid, - _staggerLocCount, - _distgridToGridMap, - _coordSys, - _coordDimCount, - _arbDim, - _rank, - _arbDimCount, - _coordDimMap, - _gridEdgeLWidth, - _gridEdgeUWidth, - _gridAlign, - _indexflag, - _localDECount, - &localrc); - if(ESMC_LogDefault.MsgFoundError(localrc, ESMCI_ERR_PASSTHRU, - ESMC_CONTEXT, ESMC_NOT_PRESENT_FILTER(_rc))) return; - - // return success - if (_rc!=NULL) *_rc = ESMF_SUCCESS; - return; - } - - // Use grid access methods to retrieve information separately - // I'm a little leary of putting this much logic in an interface call, but - // it makes things less convoluted to do it this way. - - // get some useful info - distDimCount=grid->getDistDimCount(); - dimCount = grid->getDimCount(); - - // coordTypeKind - if (ESMC_NOT_PRESENT_FILTER(_coordTypeKind) != ESMC_NULL_POINTER) - *_coordTypeKind = grid->getTypeKind(); - - // dimCount - if (ESMC_NOT_PRESENT_FILTER(_dimCount) != ESMC_NULL_POINTER) - *_dimCount = dimCount; - - // localDeCount - if (ESMC_NOT_PRESENT_FILTER(_localDECount) != ESMC_NULL_POINTER) - *_localDECount = grid->getDistGrid()->getDELayout()->getLocalDeCount(); - - // tileCount - if (ESMC_NOT_PRESENT_FILTER(_tileCount) != ESMC_NULL_POINTER) - *_tileCount = grid->getTileCount(); - - // distgrid - if (ESMC_NOT_PRESENT_FILTER(_distgrid) != ESMC_NULL_POINTER) - *_distgrid = (ESMCI::DistGrid *)grid->getDistGrid(); - - // staggerLocCount - if (ESMC_NOT_PRESENT_FILTER(_staggerLocCount) != ESMC_NULL_POINTER) - *_staggerLocCount = grid->getStaggerLocCount(); - - // coordSys - if (ESMC_NOT_PRESENT_FILTER(_coordSys) != ESMC_NULL_POINTER) - *_coordSys = grid->getCoordSys(); - - // get distgridToGridMap - if (present(_distgridToGridMap)){ - // Error check - if ((_distgridToGridMap)->dimCount != 1){ - ESMC_LogDefault.MsgFoundError(ESMC_RC_ARG_RANK, - "- distgridToGridMap array must be of rank 1", ESMC_CONTEXT, - ESMC_NOT_PRESENT_FILTER(_rc)); - return; - } + try{ + decompType = grid->getDecompType(); + + //Initialize return code + localrc = ESMC_RC_NOT_IMPL; + if (_rc!=NULL) *_rc = ESMC_RC_NOT_IMPL; + + // make sure status is correct + if (grid->getStatus() < ESMC_GRIDSTATUS_SHAPE_READY) { + + // Get information from the protogrid + c_esmc_grid_get_from_proto(_grid, + _coordTypeKind, + _dimCount, + _tileCount, + _distgrid, + _staggerLocCount, + _distgridToGridMap, + _coordSys, + _coordDimCount, + _arbDim, + _rank, + _arbDimCount, + _coordDimMap, + _gridEdgeLWidth, + _gridEdgeUWidth, + _gridAlign, + _indexflag, + _localDECount, + &localrc); + if(ESMC_LogDefault.MsgFoundError(localrc, ESMCI_ERR_PASSTHRU, + ESMC_CONTEXT, ESMC_NOT_PRESENT_FILTER(_rc))) return; + + // return success + if (_rc!=NULL) *_rc = ESMF_SUCCESS; + return; + } + + // Use grid access methods to retrieve information separately + // I'm a little leary of putting this much logic in an interface call, but + // it makes things less convoluted to do it this way. + + // get some useful info + distDimCount=grid->getDistDimCount(); + dimCount = grid->getDimCount(); + + // coordTypeKind + if (ESMC_NOT_PRESENT_FILTER(_coordTypeKind) != ESMC_NULL_POINTER) + *_coordTypeKind = grid->getTypeKind(); + + // dimCount + if (ESMC_NOT_PRESENT_FILTER(_dimCount) != ESMC_NULL_POINTER) + *_dimCount = dimCount; + + // localDeCount + if (ESMC_NOT_PRESENT_FILTER(_localDECount) != ESMC_NULL_POINTER) + *_localDECount = grid->getDistGrid()->getDELayout()->getLocalDeCount(); + + // tileCount + if (ESMC_NOT_PRESENT_FILTER(_tileCount) != ESMC_NULL_POINTER) + *_tileCount = grid->getTileCount(); + + // distgrid + if (ESMC_NOT_PRESENT_FILTER(_distgrid) != ESMC_NULL_POINTER) + *_distgrid = (ESMCI::DistGrid *)grid->getDistGrid(); + + // staggerLocCount + if (ESMC_NOT_PRESENT_FILTER(_staggerLocCount) != ESMC_NULL_POINTER) + *_staggerLocCount = grid->getStaggerLocCount(); + + // coordSys + if (ESMC_NOT_PRESENT_FILTER(_coordSys) != ESMC_NULL_POINTER) + *_coordSys = grid->getCoordSys(); + + // get distgridToGridMap + if (present(_distgridToGridMap)){ + // Error check + if ((_distgridToGridMap)->dimCount != 1){ + ESMC_LogDefault.MsgFoundError(ESMC_RC_ARG_RANK, + "- distgridToGridMap array must be of rank 1", ESMC_CONTEXT, + ESMC_NOT_PRESENT_FILTER(_rc)); + return; + } - if (decompType == ESMC_GRID_NONARBITRARY) { - if ((_distgridToGridMap)->extent[0] < dimCount){ - ESMC_LogDefault.MsgFoundError(ESMC_RC_ARG_SIZE, - "- distgridToGridMap array must be of size = the distributed rank of the Grid", - ESMC_CONTEXT, ESMC_NOT_PRESENT_FILTER(_rc)); - return; - } - // fill in distgridToGridMap, and convert it to 1-based - distgridToGridMap=grid->getDistgridToGridMap(); - for (int i=0; iarray[i]=distgridToGridMap[i]+1; - } - } else { - int totaldim = (_distgridToGridMap)->extent[0]; - if (totaldim < distDimCount){ - ESMC_LogDefault.MsgFoundError(ESMC_RC_ARG_SIZE, - "- distgridToGridMap array must be of size = the distributed rank of the Grid", - ESMC_CONTEXT, ESMC_NOT_PRESENT_FILTER(_rc)); - return; - } - // fill in distgridToGridMap, and convert it to 1-based - distgridToGridMap=grid->getDistgridToGridMap(); - for (int i=0; iarray[i]=distgridToGridMap[i]+1; - } - for (int i=distDimCount; iarray[i]=0; - } + if (decompType == ESMC_GRID_NONARBITRARY) { + if ((_distgridToGridMap)->extent[0] < dimCount){ + ESMC_LogDefault.MsgFoundError(ESMC_RC_ARG_SIZE, + "- distgridToGridMap array must be of size = the distributed rank of the Grid", + ESMC_CONTEXT, ESMC_NOT_PRESENT_FILTER(_rc)); + return; + } + // fill in distgridToGridMap, and convert it to 1-based + distgridToGridMap=grid->getDistgridToGridMap(); + for (int i=0; iarray[i]=distgridToGridMap[i]+1; + } + } else { + int totaldim = (_distgridToGridMap)->extent[0]; + if (totaldim < distDimCount){ + ESMC_LogDefault.MsgFoundError(ESMC_RC_ARG_SIZE, + "- distgridToGridMap array must be of size = the distributed rank of the Grid", + ESMC_CONTEXT, ESMC_NOT_PRESENT_FILTER(_rc)); + return; + } + // fill in distgridToGridMap, and convert it to 1-based + distgridToGridMap=grid->getDistgridToGridMap(); + for (int i=0; iarray[i]=distgridToGridMap[i]+1; + } + for (int i=distDimCount; iarray[i]=0; + } + } } - } - // get coordDimCount - if (present(_coordDimCount)){ - // Error check - if ((_coordDimCount)->dimCount != 1){ - ESMC_LogDefault.MsgFoundError(ESMC_RC_ARG_RANK, - "- coordDimCount array must be of rank 1", - ESMC_CONTEXT, ESMC_NOT_PRESENT_FILTER(_rc)); - return; - } - if ((_coordDimCount)->extent[0] < dimCount){ - ESMC_LogDefault.MsgFoundError(ESMC_RC_ARG_SIZE, - "- coordDimCount array must be of size = the rank of the Grid", - ESMC_CONTEXT, ESMC_NOT_PRESENT_FILTER(_rc)); - return; + // get coordDimCount + if (present(_coordDimCount)){ + // Error check + if ((_coordDimCount)->dimCount != 1){ + ESMC_LogDefault.MsgFoundError(ESMC_RC_ARG_RANK, + "- coordDimCount array must be of rank 1", + ESMC_CONTEXT, ESMC_NOT_PRESENT_FILTER(_rc)); + return; + } + if ((_coordDimCount)->extent[0] < dimCount){ + ESMC_LogDefault.MsgFoundError(ESMC_RC_ARG_SIZE, + "- coordDimCount array must be of size = the rank of the Grid", + ESMC_CONTEXT, ESMC_NOT_PRESENT_FILTER(_rc)); + return; + } + // fill in coordDimCount + memcpy((_coordDimCount)->array, grid->getCoordDimCount(), sizeof(int) * dimCount); } - // fill in coordDimCount - memcpy((_coordDimCount)->array, grid->getCoordDimCount(), sizeof(int) * dimCount); - } - // get coordDimMap - if (present(_coordDimMap)){ - // Error check - if ((_coordDimMap)->dimCount != 2){ - ESMC_LogDefault.MsgFoundError(ESMC_RC_ARG_RANK, - "- coordDimMap array must be of rank 2", - ESMC_CONTEXT, ESMC_NOT_PRESENT_FILTER(_rc)); - return; - } - if (((_coordDimMap)->extent[0] < dimCount) || ((_coordDimMap)->extent[1] < dimCount)){ - ESMC_LogDefault.MsgFoundError(ESMC_RC_ARG_SIZE, - "- coordDimMap array must be of size = the rank of the Grid", - ESMC_CONTEXT, ESMC_NOT_PRESENT_FILTER(_rc)); - return; - } - // fill in coordDimMap - int k=0; - int **coordDimMap=grid->getCoordDimMap(); - for (int i=0; iarray[k]=coordDimMap[j][i]+1; // Convert back to 1-based - k++; + // get coordDimMap + if (present(_coordDimMap)){ + // Error check + if ((_coordDimMap)->dimCount != 2){ + ESMC_LogDefault.MsgFoundError(ESMC_RC_ARG_RANK, + "- coordDimMap array must be of rank 2", + ESMC_CONTEXT, ESMC_NOT_PRESENT_FILTER(_rc)); + return; + } + if (((_coordDimMap)->extent[0] < dimCount) || ((_coordDimMap)->extent[1] < dimCount)){ + ESMC_LogDefault.MsgFoundError(ESMC_RC_ARG_SIZE, + "- coordDimMap array must be of size = the rank of the Grid", + ESMC_CONTEXT, ESMC_NOT_PRESENT_FILTER(_rc)); + return; + } + // fill in coordDimMap + int k=0; + int **coordDimMap=grid->getCoordDimMap(); + for (int i=0; iarray[k]=coordDimMap[j][i]+1; // Convert back to 1-based + k++; + } } } - } - // find number of dimensions distributed arbitrarily - dimCount1 = grid->getDistGrid()->getDimCount(); - distDimCount = dimCount - dimCount1 + 1; + // find number of dimensions distributed arbitrarily + dimCount1 = grid->getDistGrid()->getDimCount(); + distDimCount = dimCount - dimCount1 + 1; - // get arbDim - if (ESMC_NOT_PRESENT_FILTER(_arbDim) != ESMC_NULL_POINTER) { - *_arbDim = grid->getArbDim(); - } - - // get rank -- same as distGrid dimCount - if (ESMC_NOT_PRESENT_FILTER(_rank) != ESMC_NULL_POINTER) { - *_rank = dimCount1; - } - - // get arbDimCount - if (ESMC_NOT_PRESENT_FILTER(_arbDimCount) != ESMC_NULL_POINTER) { - if (decompType == ESMC_GRID_NONARBITRARY) { - *_arbDimCount = 0; - } else { - *_arbDimCount = distDimCount; + // get arbDim + if (ESMC_NOT_PRESENT_FILTER(_arbDim) != ESMC_NULL_POINTER) { + *_arbDim = grid->getArbDim(); } - } - // get gridEdgeLWidth - if (present(_gridEdgeLWidth)){ - // Error check - if ((_gridEdgeLWidth)->dimCount != 1){ - ESMC_LogDefault.MsgFoundError(ESMC_RC_ARG_RANK, - "- gridEdgeLWidth array must be of rank 1", ESMC_CONTEXT, - ESMC_NOT_PRESENT_FILTER(_rc)); - return; + // get rank -- same as distGrid dimCount + if (ESMC_NOT_PRESENT_FILTER(_rank) != ESMC_NULL_POINTER) { + *_rank = dimCount1; } - if ((_gridEdgeLWidth)->extent[0] < dimCount){ - ESMC_LogDefault.MsgFoundError(ESMC_RC_ARG_SIZE, - "- gridEdgeLWidth array must be of size = the rank of the Grid", - ESMC_CONTEXT, ESMC_NOT_PRESENT_FILTER(_rc)); - return; - } - // fill in gridEdgeLWidth - memcpy((_gridEdgeLWidth)->array, grid->getGridEdgeLWidth(), sizeof(int) * dimCount); - } - // get gridEdgeUWidth - if (present(_gridEdgeUWidth)){ - // Error check - if ((_gridEdgeUWidth)->dimCount != 1){ - ESMC_LogDefault.MsgFoundError(ESMC_RC_ARG_RANK, - "- gridEdgeUWidth array must be of rank 1", ESMC_CONTEXT, - ESMC_NOT_PRESENT_FILTER(_rc)); - return; - } - if ((_gridEdgeUWidth)->extent[0] < dimCount){ - ESMC_LogDefault.MsgFoundError(ESMC_RC_ARG_SIZE, - "- gridEdgeUWidth array must be of size = the rank of the Grid", - ESMC_CONTEXT, ESMC_NOT_PRESENT_FILTER(_rc)); - return; + // get arbDimCount + if (ESMC_NOT_PRESENT_FILTER(_arbDimCount) != ESMC_NULL_POINTER) { + if (decompType == ESMC_GRID_NONARBITRARY) { + *_arbDimCount = 0; + } else { + *_arbDimCount = distDimCount; + } } - // fill in gridEdgeUWidth - memcpy((_gridEdgeUWidth)->array, grid->getGridEdgeUWidth(), sizeof(int) * dimCount); - } - // get gridAlign - if (present(_gridAlign)){ - // Error check - if ((_gridAlign)->dimCount != 1){ - ESMC_LogDefault.MsgFoundError(ESMC_RC_ARG_RANK, - "- gridAlign array must be of rank 1", ESMC_CONTEXT, - ESMC_NOT_PRESENT_FILTER(_rc)); - return; - } - if ((_gridAlign)->extent[0] < dimCount){ - ESMC_LogDefault.MsgFoundError(ESMC_RC_ARG_SIZE, - "- gridAlign array must be of size = the rank of the Grid", ESMC_CONTEXT, - ESMC_NOT_PRESENT_FILTER(_rc)); - return; + // get gridEdgeLWidth + if (present(_gridEdgeLWidth)){ + // Error check + if ((_gridEdgeLWidth)->dimCount != 1){ + ESMC_LogDefault.MsgFoundError(ESMC_RC_ARG_RANK, + "- gridEdgeLWidth array must be of rank 1", ESMC_CONTEXT, + ESMC_NOT_PRESENT_FILTER(_rc)); + return; + } + if ((_gridEdgeLWidth)->extent[0] < dimCount){ + ESMC_LogDefault.MsgFoundError(ESMC_RC_ARG_SIZE, + "- gridEdgeLWidth array must be of size = the rank of the Grid", + ESMC_CONTEXT, ESMC_NOT_PRESENT_FILTER(_rc)); + return; + } + // fill in gridEdgeLWidth + memcpy((_gridEdgeLWidth)->array, grid->getGridEdgeLWidth(), sizeof(int) * dimCount); + } + + // get gridEdgeUWidth + if (present(_gridEdgeUWidth)){ + // Error check + if ((_gridEdgeUWidth)->dimCount != 1){ + ESMC_LogDefault.MsgFoundError(ESMC_RC_ARG_RANK, + "- gridEdgeUWidth array must be of rank 1", ESMC_CONTEXT, + ESMC_NOT_PRESENT_FILTER(_rc)); + return; + } + if ((_gridEdgeUWidth)->extent[0] < dimCount){ + ESMC_LogDefault.MsgFoundError(ESMC_RC_ARG_SIZE, + "- gridEdgeUWidth array must be of size = the rank of the Grid", + ESMC_CONTEXT, ESMC_NOT_PRESENT_FILTER(_rc)); + return; + } + // fill in gridEdgeUWidth + memcpy((_gridEdgeUWidth)->array, grid->getGridEdgeUWidth(), sizeof(int) * dimCount); + } + + // get gridAlign + if (present(_gridAlign)){ + // Error check + if ((_gridAlign)->dimCount != 1){ + ESMC_LogDefault.MsgFoundError(ESMC_RC_ARG_RANK, + "- gridAlign array must be of rank 1", ESMC_CONTEXT, + ESMC_NOT_PRESENT_FILTER(_rc)); + return; + } + if ((_gridAlign)->extent[0] < dimCount){ + ESMC_LogDefault.MsgFoundError(ESMC_RC_ARG_SIZE, + "- gridAlign array must be of size = the rank of the Grid", ESMC_CONTEXT, + ESMC_NOT_PRESENT_FILTER(_rc)); + return; + } + // fill in gridAlign + memcpy((_gridAlign)->array, grid->getGridAlign(), sizeof(int) * dimCount); } - // fill in gridAlign - memcpy((_gridAlign)->array, grid->getGridAlign(), sizeof(int) * dimCount); - } - - - - // indexflag - if (ESMC_NOT_PRESENT_FILTER(_indexflag) != ESMC_NULL_POINTER) - *_indexflag = grid->getIndexFlag(); + // indexflag + if (ESMC_NOT_PRESENT_FILTER(_indexflag) != ESMC_NULL_POINTER) + *_indexflag = grid->getIndexFlag(); + }catch(int localrc){ + if (ESMC_LogDefault.MsgFoundError(localrc, ESMCI_ERR_PASSTHRU, + ESMC_CONTEXT, _rc)) + return; // bail out + }catch(std::exception &x){ + ESMC_LogDefault.MsgFoundError(ESMC_RC_INTNRL_BAD, x.what(), ESMC_CONTEXT, + _rc); + return; // bail out + }catch(...){ + ESMC_LogDefault.MsgFoundError(ESMC_RC_INTNRL_BAD, "- Caught exception", + ESMC_CONTEXT, _rc); + return; + } // return success if (_rc!=NULL) *_rc = ESMF_SUCCESS; } From 4eab2da21eaa1dfff8cf0ef47ce99531ebf6b103 Mon Sep 17 00:00:00 2001 From: Gerhard Theurich Date: Thu, 7 Nov 2024 15:39:07 -0800 Subject: [PATCH 116/207] Add option to turn off internal object Destroy for proxies, and add documentation indicating why this might be necessary. For no though leave it active until we find cases where this might need to change. --- .../Field/src/ESMF_FieldCreate.cppF90 | 31 +++++++++++++------ 1 file changed, 22 insertions(+), 9 deletions(-) diff --git a/src/Infrastructure/Field/src/ESMF_FieldCreate.cppF90 b/src/Infrastructure/Field/src/ESMF_FieldCreate.cppF90 index be1f75a76f..c649f6a833 100644 --- a/src/Infrastructure/Field/src/ESMF_FieldCreate.cppF90 +++ b/src/Infrastructure/Field/src/ESMF_FieldCreate.cppF90 @@ -5363,9 +5363,17 @@ type(ESMF_KeywordEnforcer), optional:: keywordEnforcer ! must use keywords below if (ftype%is_proxy .or. ftype%geomb_internal) then if (ftype%is_proxy) then - ! proxies destroy their actual geometry object, but must leave +#if 1 +!gjt: Destroying geom object for proxies might not be a good idea. If this +!gjt: every cases issues, then we might want to disable it here. +!gjt: Disable, because proxy geoms might be used outside the original the +!gjt: proxy field... cannot destroy here, but instead must keep proxy the +!gjt: geom alive!!! + + ! Proxies destroy their actual geometry object, but must leave ! in garbage collection because multiple fields might be referencing - ! the same actual geometry object, and try to destroy + ! the same actual geometry object, and try to destroy. Garbage + ! collection makes those double destroy calls safe noops. call ESMF_GeomGet(ftype%geom, geomtype=geomtype, rc=localrc) if (ESMF_LogFoundError(localrc, & @@ -5421,14 +5429,19 @@ type(ESMF_KeywordEnforcer), optional:: keywordEnforcer ! must use keywords below ESMF_CONTEXT, rcToReturn=rc) return endif - + ! the Geom needs to be destroyed + call ESMF_GeomDestroy(ftype%geom, rc=localrc) + if (ESMF_LogFoundError(localrc, & + ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, rcToReturn=rc)) return +#endif + else + ! the Geom needs to be destroyed + call ESMF_GeomDestroy(ftype%geom, rc=localrc) + if (ESMF_LogFoundError(localrc, & + ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, rcToReturn=rc)) return endif - - ! proxy or not, the Geom needs to be destroyed - call ESMF_GeomDestroy(ftype%geom, rc=localrc) - if (ESMF_LogFoundError(localrc, & - ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, rcToReturn=rc)) return endif ftype%status = ESMF_FIELDSTATUS_UNINIT ! mark invalid From 566924c9e04b717afc2d8719df4031f87b03cf82 Mon Sep 17 00:00:00 2001 From: Gerhard Theurich Date: Thu, 7 Nov 2024 18:13:13 -0800 Subject: [PATCH 117/207] Lift ESMF_ReconcileMultiCompCase() code out of ESMF_StateReconcile_driver() in preparation for a new implementation. --- .../src/ESMF_StateReconcile.F90 | 122 +++++++++++++++--- 1 file changed, 105 insertions(+), 17 deletions(-) diff --git a/src/Superstructure/StateReconcile/src/ESMF_StateReconcile.F90 b/src/Superstructure/StateReconcile/src/ESMF_StateReconcile.F90 index 15d3762634..20e4dd41c8 100644 --- a/src/Superstructure/StateReconcile/src/ESMF_StateReconcile.F90 +++ b/src/Superstructure/StateReconcile/src/ESMF_StateReconcile.F90 @@ -14,7 +14,7 @@ #define UNIQUE_GEOM_INFO_TREAT_on ! #define RECONCILE_LOG_on -#define RECONCILE_ZAP_LOG_on +#define RECONCILE_ZAP_LOG_off ! ! ESMF StateReconcile module module ESMF_StateReconcileMod @@ -745,18 +745,9 @@ subroutine ESMF_StateReconcile_driver(state, vm, rc) type(ESMF_VMId), pointer :: vmids_send(:) integer, allocatable, target :: vmintids_send(:) - type(ESMF_ReconcileIDInfo), allocatable :: id_info(:) - - logical, pointer :: recvd_needs_matrix(:,:) - - type(ESMF_CharPtr), allocatable :: items_recv(:) - character, pointer :: buffer_recv(:) - - integer :: i - - logical, parameter :: debug = .false. + logical, parameter :: debug = .false. logical, parameter :: meminfo = .false. - logical, parameter :: trace = .false. + logical, parameter :: trace = .false. logical, parameter :: profile = .true. type(ESMF_VMId), allocatable, target :: vmIdMap(:) @@ -1118,7 +1109,13 @@ subroutine ESMF_StateReconcile_driver(state, vm, rc) rcToReturn=rc)) return endif ! ------------------------------------------------------------------------ - call ESMF_ReconcileMultiCompCase() + call ESMF_ReconcileMultiCompCase(state, vm=vm, vmId=vmIdSingleComp, & + attreconflag=attreconflag, siwrap=siwrap, ids_send=ids_send, & + vmids_send=vmids_send, vmintids_send=vmintids_send, & + nitems_buf=nitems_buf, rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, & + rcToReturn=rc)) return ! ------------------------------------------------------------------------ if (profile) then call ESMF_TraceRegionExit("(2<) ESMF_ReconcileMultiCompCase", rc=localrc) @@ -1242,9 +1239,87 @@ subroutine ESMF_StateReconcile_driver(state, vm, rc) if (meminfo) call ESMF_VMLogMemInfo ("exiting ESMF_StateReconcile_driver") - contains + end subroutine ESMF_StateReconcile_driver - subroutine ESMF_ReconcileMultiCompCase() +!------------------------------------------------------------------------------ +#undef ESMF_METHOD +#define ESMF_METHOD "ESMF_ReconcileSingleCompCase" +!BOPI +! !IROUTINE: ESMF_ReconcileSingleCompCase +! +! !INTERFACE: + subroutine ESMF_ReconcileMultiCompCase(state, vm, vmId, attreconflag, siwrap, & + ids_send, vmids_send, vmintids_send, nitems_buf, rc) +! +! !ARGUMENTS: + type(ESMF_State), intent(inout) :: state + type(ESMF_VM), intent(in) :: vm + type(ESMF_VMId), pointer, intent(in) :: vmId + type(ESMF_AttReconcileFlag), intent(in) :: attreconflag + type(ESMF_StateItemWrap), pointer, intent(in) :: siwrap(:) + integer, pointer, intent(in) :: ids_send(:) + type(ESMF_VMId), pointer, intent(in) :: vmids_send(:) + integer, pointer, intent(in) :: vmintids_send(:) + integer, pointer, intent(in) :: nitems_buf(:) + integer, intent(out) :: rc +! +! !DESCRIPTION: +! +! Handle the multi component reconciliation case. This is the expected +! situation under NUOPC rules. +! +! The arguments are: +! \begin{description} +! \item[state] +! The {\tt ESMF\_State} to reconcile. +! \item[vm] +! The {\tt ESMF\_VM} object across which the state is reconciled. +! \item[vmId] +! The {\tt ESMF\_VMId} of the single component who ownes all objects present +! in the state. +! \item[attreconflag] +! Flag indicating whether attributes need to be reconciled. +! \item[siwrap] +! List of local state items. +! \item[rc] +! Return code; equals {\tt ESMF\_SUCCESS} if there are no errors. +! \end{description} +!EOPI + + integer :: localrc + integer :: memstat + integer :: localPet, petCount + integer :: i + + type(ESMF_ReconcileIDInfo), allocatable :: id_info(:) + type(ESMF_CharPtr), allocatable :: items_recv(:) + logical, pointer :: recvd_needs_matrix(:,:) + character, pointer :: buffer_recv(:) + + logical, parameter :: meminfo = .false. + logical, parameter :: profile = .true. + + rc = ESMF_SUCCESS + +#ifdef RECONCILE_LOG_on + block + character(ESMF_MAXSTR) :: stateName + call ESMF_StateGet(state, name=stateName, rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, & + rcToReturn=rc)) return + call ESMF_LogWrite("ESMF_ReconcileMultiCompCase() for State: "//trim(stateName), & + ESMF_LOGMSG_DEBUG, rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, & + rcToReturn=rc)) return + end block +#endif + + call ESMF_VMGet(vm, petCount=petCount, localPet=localPet, rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, & + rcToReturn=rc)) return ! ------------------------------------------------------------------------- ! (3) All PETs send their items Ids and VMIds to all the other PETs, @@ -1527,8 +1602,6 @@ subroutine ESMF_ReconcileMultiCompCase() end subroutine ESMF_ReconcileMultiCompCase - end subroutine ESMF_StateReconcile_driver - !------------------------------------------------------------------------------ #undef ESMF_METHOD #define ESMF_METHOD "ESMF_ReconcileSingleCompCase" @@ -1577,6 +1650,21 @@ subroutine ESMF_ReconcileSingleCompCase(state, vm, vmId, attreconflag, siwrap, r rc = ESMF_SUCCESS +#ifdef RECONCILE_LOG_on + block + character(ESMF_MAXSTR) :: stateName + call ESMF_StateGet(state, name=stateName, rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, & + rcToReturn=rc)) return + call ESMF_LogWrite("ESMF_ReconcileSingleCompCase() for State: "//trim(stateName), & + ESMF_LOGMSG_DEBUG, rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, & + rcToReturn=rc)) return + end block +#endif + call ESMF_VMGet(vm, petCount=petCount, localPet=localPet, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, & From 9bc007ed56323cd16a99fd9832c6a1a6cdf750c3 Mon Sep 17 00:00:00 2001 From: Gerhard Theurich Date: Thu, 7 Nov 2024 19:12:20 -0800 Subject: [PATCH 118/207] Insert ESMF_ReconcileMultiCompCaseNEW() to start working toward a new multi-comp case implementation. --- .../src/ESMF_StateReconcile.F90 | 82 +++++++++++++++++-- 1 file changed, 74 insertions(+), 8 deletions(-) diff --git a/src/Superstructure/StateReconcile/src/ESMF_StateReconcile.F90 b/src/Superstructure/StateReconcile/src/ESMF_StateReconcile.F90 index 20e4dd41c8..a0e84b18e4 100644 --- a/src/Superstructure/StateReconcile/src/ESMF_StateReconcile.F90 +++ b/src/Superstructure/StateReconcile/src/ESMF_StateReconcile.F90 @@ -1109,7 +1109,7 @@ subroutine ESMF_StateReconcile_driver(state, vm, rc) rcToReturn=rc)) return endif ! ------------------------------------------------------------------------ - call ESMF_ReconcileMultiCompCase(state, vm=vm, vmId=vmIdSingleComp, & + call ESMF_ReconcileMultiCompCaseNEW(state, vm=vm, & attreconflag=attreconflag, siwrap=siwrap, ids_send=ids_send, & vmids_send=vmids_send, vmintids_send=vmintids_send, & nitems_buf=nitems_buf, rc=localrc) @@ -1243,18 +1243,87 @@ end subroutine ESMF_StateReconcile_driver !------------------------------------------------------------------------------ #undef ESMF_METHOD -#define ESMF_METHOD "ESMF_ReconcileSingleCompCase" +#define ESMF_METHOD "ESMF_ReconcileMultiCompCaseNEW" !BOPI -! !IROUTINE: ESMF_ReconcileSingleCompCase +! !IROUTINE: ESMF_ReconcileMultiCompCaseNEW ! ! !INTERFACE: - subroutine ESMF_ReconcileMultiCompCase(state, vm, vmId, attreconflag, siwrap, & + subroutine ESMF_ReconcileMultiCompCaseNEW(state, vm, attreconflag, siwrap, & + ids_send, vmids_send, vmintids_send, nitems_buf, rc) +! +! !ARGUMENTS: + type(ESMF_State), intent(inout) :: state + type(ESMF_VM), intent(in) :: vm + type(ESMF_AttReconcileFlag), intent(in) :: attreconflag + type(ESMF_StateItemWrap), pointer, intent(in) :: siwrap(:) + integer, pointer, intent(in) :: ids_send(:) + type(ESMF_VMId), pointer, intent(in) :: vmids_send(:) + integer, pointer, intent(in) :: vmintids_send(:) + integer, pointer, intent(in) :: nitems_buf(:) + integer, intent(out) :: rc +! +! !DESCRIPTION: +! +! Handle the multi component reconciliation case. This is the expected +! situation under NUOPC rules. +! +! The arguments are: +! \begin{description} +! \item[state] +! The {\tt ESMF\_State} to reconcile. +! \item[vm] +! The {\tt ESMF\_VM} object across which the state is reconciled. +! \item[attreconflag] +! Flag indicating whether attributes need to be reconciled. +! \item[siwrap] +! List of local state items. +! \item[rc] +! Return code; equals {\tt ESMF\_SUCCESS} if there are no errors. +! \end{description} +!EOPI + + integer :: localrc + + rc = ESMF_SUCCESS + +#ifdef RECONCILE_LOG_on + block + character(ESMF_MAXSTR) :: stateName + call ESMF_StateGet(state, name=stateName, rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, & + rcToReturn=rc)) return + call ESMF_LogWrite("ESMF_ReconcileMultiCompCaseNEW() for State: "//trim(stateName), & + ESMF_LOGMSG_DEBUG, rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, & + rcToReturn=rc)) return + end block +#endif + + call ESMF_ReconcileMultiCompCase(state, vm=vm, & + attreconflag=attreconflag, siwrap=siwrap, ids_send=ids_send, & + vmids_send=vmids_send, vmintids_send=vmintids_send, & + nitems_buf=nitems_buf, rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, & + rcToReturn=rc)) return + + end subroutine ESMF_ReconcileMultiCompCaseNEW + +!------------------------------------------------------------------------------ +#undef ESMF_METHOD +#define ESMF_METHOD "ESMF_ReconcileMultiCompCase" +!BOPI +! !IROUTINE: ESMF_ReconcileMultiCompCase +! +! !INTERFACE: + subroutine ESMF_ReconcileMultiCompCase(state, vm, attreconflag, siwrap, & ids_send, vmids_send, vmintids_send, nitems_buf, rc) ! ! !ARGUMENTS: type(ESMF_State), intent(inout) :: state type(ESMF_VM), intent(in) :: vm - type(ESMF_VMId), pointer, intent(in) :: vmId type(ESMF_AttReconcileFlag), intent(in) :: attreconflag type(ESMF_StateItemWrap), pointer, intent(in) :: siwrap(:) integer, pointer, intent(in) :: ids_send(:) @@ -1274,9 +1343,6 @@ subroutine ESMF_ReconcileMultiCompCase(state, vm, vmId, attreconflag, siwrap, & ! The {\tt ESMF\_State} to reconcile. ! \item[vm] ! The {\tt ESMF\_VM} object across which the state is reconciled. -! \item[vmId] -! The {\tt ESMF\_VMId} of the single component who ownes all objects present -! in the state. ! \item[attreconflag] ! Flag indicating whether attributes need to be reconciled. ! \item[siwrap] From bc8e9c30797386eab9e4be124c8fc397b78bb1b6 Mon Sep 17 00:00:00 2001 From: Gerhard Theurich Date: Fri, 8 Nov 2024 08:43:37 -0800 Subject: [PATCH 119/207] Cleaner separation between new and old multi-comp-case implementation. Keep old one as brute-force method. --- .../src/ESMF_StateReconcile.F90 | 89 ++++++++++++------- 1 file changed, 58 insertions(+), 31 deletions(-) diff --git a/src/Superstructure/StateReconcile/src/ESMF_StateReconcile.F90 b/src/Superstructure/StateReconcile/src/ESMF_StateReconcile.F90 index a0e84b18e4..06c12bafec 100644 --- a/src/Superstructure/StateReconcile/src/ESMF_StateReconcile.F90 +++ b/src/Superstructure/StateReconcile/src/ESMF_StateReconcile.F90 @@ -1081,21 +1081,18 @@ subroutine ESMF_StateReconcile_driver(state, vm, rc) ! ------------------------------------------------------------------------ if (profile) then call ESMF_TraceRegionEnter("(2<) ESMF_ReconcileSingleCompCase", rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, & + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & rcToReturn=rc)) return endif ! ------------------------------------------------------------------------ call ESMF_ReconcileSingleCompCase(state, vm=vm, vmId=vmIdSingleComp, & attreconflag=attreconflag, siwrap=siwrap, rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, & + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & rcToReturn=rc)) return ! ------------------------------------------------------------------------ if (profile) then call ESMF_TraceRegionExit("(2<) ESMF_ReconcileSingleCompCase", rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, & + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & rcToReturn=rc)) return endif ! ------------------------------------------------------------------------ @@ -1104,18 +1101,24 @@ subroutine ESMF_StateReconcile_driver(state, vm, rc) ! ------------------------------------------------------------------------ if (profile) then call ESMF_TraceRegionEnter("(2<) ESMF_ReconcileMultiCompCase", rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, & + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & rcToReturn=rc)) return endif ! ------------------------------------------------------------------------ - call ESMF_ReconcileMultiCompCaseNEW(state, vm=vm, & + call ESMF_ReconcileMultiCompCase(state, vm=vm, vmIdMap=vmIdMap_ptr, & attreconflag=attreconflag, siwrap=siwrap, ids_send=ids_send, & vmids_send=vmids_send, vmintids_send=vmintids_send, & nitems_buf=nitems_buf, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, & + ESMF_CONTEXT, rcToReturn=rc)) return +#if 1 + call ESMF_ReconcileBruteForce(state, vm=vm, & + attreconflag=attreconflag, siwrap=siwrap, ids_send=ids_send, & + vmids_send=vmids_send, vmintids_send=vmintids_send, & + nitems_buf=nitems_buf, rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & rcToReturn=rc)) return +#endif ! ------------------------------------------------------------------------ if (profile) then call ESMF_TraceRegionExit("(2<) ESMF_ReconcileMultiCompCase", rc=localrc) @@ -1243,17 +1246,18 @@ end subroutine ESMF_StateReconcile_driver !------------------------------------------------------------------------------ #undef ESMF_METHOD -#define ESMF_METHOD "ESMF_ReconcileMultiCompCaseNEW" +#define ESMF_METHOD "ESMF_ReconcileMultiCompCase" !BOPI -! !IROUTINE: ESMF_ReconcileMultiCompCaseNEW +! !IROUTINE: ESMF_ReconcileMultiCompCase ! ! !INTERFACE: - subroutine ESMF_ReconcileMultiCompCaseNEW(state, vm, attreconflag, siwrap, & - ids_send, vmids_send, vmintids_send, nitems_buf, rc) + subroutine ESMF_ReconcileMultiCompCase(state, vm, vmIdMap, attreconflag, & + siwrap, ids_send, vmids_send, vmintids_send, nitems_buf, rc) ! ! !ARGUMENTS: type(ESMF_State), intent(inout) :: state type(ESMF_VM), intent(in) :: vm + type(ESMF_VMId), pointer, intent(in) :: vmIdMap(:) type(ESMF_AttReconcileFlag), intent(in) :: attreconflag type(ESMF_StateItemWrap), pointer, intent(in) :: siwrap(:) integer, pointer, intent(in) :: ids_send(:) @@ -1283,6 +1287,11 @@ subroutine ESMF_ReconcileMultiCompCaseNEW(state, vm, attreconflag, siwrap, & !EOPI integer :: localrc + integer :: i, todoCount + logical :: isFlag + type(ESMF_VMId) :: vmId + + integer, allocatable :: todoList(:) ! holds integer vmIds to do rc = ESMF_SUCCESS @@ -1290,35 +1299,53 @@ subroutine ESMF_ReconcileMultiCompCaseNEW(state, vm, attreconflag, siwrap, & block character(ESMF_MAXSTR) :: stateName call ESMF_StateGet(state, name=stateName, rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, & + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & rcToReturn=rc)) return - call ESMF_LogWrite("ESMF_ReconcileMultiCompCaseNEW() for State: "//trim(stateName), & + call ESMF_LogWrite("ESMF_ReconcileMultiCompCase() for State: "//trim(stateName), & ESMF_LOGMSG_DEBUG, rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, & + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & rcToReturn=rc)) return end block #endif - call ESMF_ReconcileMultiCompCase(state, vm=vm, & - attreconflag=attreconflag, siwrap=siwrap, ids_send=ids_send, & - vmids_send=vmids_send, vmintids_send=vmintids_send, & - nitems_buf=nitems_buf, rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, & + call ESMF_VMGetVMId(vm, vmId=vmId, rc=localrc) ! vmId of current VM context + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & rcToReturn=rc)) return - end subroutine ESMF_ReconcileMultiCompCaseNEW + allocate(todoList(size(vmidMap))) + todoCount=0 + do i=1, size(vmidMap) + ! see if vmIdMap(i) has the same vmKey as the current VM context + isFlag = ESMF_VMIdCompare(vmIdMap(i), vmId, keyOnly=.true., rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & + rcToReturn=rc)) return + if (.not.isFlag) then + ! vmIdMap(i) is from a component that needs to be handled here + todoCount = todoCount + 1 + todoList(todoCount) = i ! add "i" to the todo list + endif + enddo + +#ifdef RECONCILE_LOG_on + block + character(160) :: msgStr + write(msgStr,*) "ESMF_ReconcileMultiCompCase todoCount=", todoCount + call ESMF_LogWrite(msgStr, ESMF_LOGMSG_DEBUG, rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & + rcToReturn=rc)) return + end block +#endif + + end subroutine ESMF_ReconcileMultiCompCase !------------------------------------------------------------------------------ #undef ESMF_METHOD -#define ESMF_METHOD "ESMF_ReconcileMultiCompCase" +#define ESMF_METHOD "ESMF_ReconcileBruteForce" !BOPI -! !IROUTINE: ESMF_ReconcileMultiCompCase +! !IROUTINE: ESMF_ReconcileBruteForce ! ! !INTERFACE: - subroutine ESMF_ReconcileMultiCompCase(state, vm, attreconflag, siwrap, & + subroutine ESMF_ReconcileBruteForce(state, vm, attreconflag, siwrap, & ids_send, vmids_send, vmintids_send, nitems_buf, rc) ! ! !ARGUMENTS: @@ -1374,7 +1401,7 @@ subroutine ESMF_ReconcileMultiCompCase(state, vm, attreconflag, siwrap, & if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, & rcToReturn=rc)) return - call ESMF_LogWrite("ESMF_ReconcileMultiCompCase() for State: "//trim(stateName), & + call ESMF_LogWrite("ESMF_ReconcileBruteForce() for State: "//trim(stateName), & ESMF_LOGMSG_DEBUG, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, & @@ -1666,7 +1693,7 @@ subroutine ESMF_ReconcileMultiCompCase(state, vm, attreconflag, siwrap, & ESMF_CONTEXT, & rcToReturn=rc)) return - end subroutine ESMF_ReconcileMultiCompCase + end subroutine ESMF_ReconcileBruteForce !------------------------------------------------------------------------------ #undef ESMF_METHOD From e8d786ffa69c9a73c90ace0c3be2a5b012ad0f42 Mon Sep 17 00:00:00 2001 From: Gerhard Theurich Date: Fri, 8 Nov 2024 11:12:38 -0800 Subject: [PATCH 120/207] Extend ESMF_ReconcileSerializeAll() to selectively only handle top level objects that are of the specified VMId. Leverage this to implement the new ESMF_ReconcileMultiCompCase(). However, for now keep ESMF_ReconcileBruteForce() active instead. --- .../src/ESMF_StateReconcile.F90 | 296 ++++++++++++------ 1 file changed, 203 insertions(+), 93 deletions(-) diff --git a/src/Superstructure/StateReconcile/src/ESMF_StateReconcile.F90 b/src/Superstructure/StateReconcile/src/ESMF_StateReconcile.F90 index 06c12bafec..b8dd3d0c09 100644 --- a/src/Superstructure/StateReconcile/src/ESMF_StateReconcile.F90 +++ b/src/Superstructure/StateReconcile/src/ESMF_StateReconcile.F90 @@ -1087,7 +1087,7 @@ subroutine ESMF_StateReconcile_driver(state, vm, rc) ! ------------------------------------------------------------------------ call ESMF_ReconcileSingleCompCase(state, vm=vm, vmId=vmIdSingleComp, & attreconflag=attreconflag, siwrap=siwrap, rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & rcToReturn=rc)) return ! ------------------------------------------------------------------------ if (profile) then @@ -1105,13 +1105,14 @@ subroutine ESMF_StateReconcile_driver(state, vm, rc) rcToReturn=rc)) return endif ! ------------------------------------------------------------------------ +#if 0 call ESMF_ReconcileMultiCompCase(state, vm=vm, vmIdMap=vmIdMap_ptr, & attreconflag=attreconflag, siwrap=siwrap, ids_send=ids_send, & vmids_send=vmids_send, vmintids_send=vmintids_send, & nitems_buf=nitems_buf, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return -#if 1 +#else call ESMF_ReconcileBruteForce(state, vm=vm, & attreconflag=attreconflag, siwrap=siwrap, ids_send=ids_send, & vmids_send=vmids_send, vmintids_send=vmintids_send, & @@ -1253,6 +1254,7 @@ end subroutine ESMF_StateReconcile_driver ! !INTERFACE: subroutine ESMF_ReconcileMultiCompCase(state, vm, vmIdMap, attreconflag, & siwrap, ids_send, vmids_send, vmintids_send, nitems_buf, rc) +!!!TODO: clean out any dummy arguments not actually needed!!!! ! ! !ARGUMENTS: type(ESMF_State), intent(inout) :: state @@ -1291,7 +1293,8 @@ subroutine ESMF_ReconcileMultiCompCase(state, vm, vmIdMap, attreconflag, & logical :: isFlag type(ESMF_VMId) :: vmId - integer, allocatable :: todoList(:) ! holds integer vmIds to do + integer, allocatable :: todoList(:) ! holds integer vmIds to do + type(ESMF_VMId), pointer :: vmIdSingleComp rc = ESMF_SUCCESS @@ -1299,11 +1302,11 @@ subroutine ESMF_ReconcileMultiCompCase(state, vm, vmIdMap, attreconflag, & block character(ESMF_MAXSTR) :: stateName call ESMF_StateGet(state, name=stateName, rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & rcToReturn=rc)) return call ESMF_LogWrite("ESMF_ReconcileMultiCompCase() for State: "//trim(stateName), & ESMF_LOGMSG_DEBUG, rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & rcToReturn=rc)) return end block #endif @@ -1336,6 +1339,16 @@ subroutine ESMF_ReconcileMultiCompCase(state, vm, vmIdMap, attreconflag, & end block #endif + !TODO: Don't actually need these two separate loops first one will be + !TODO: enough, just directly call into the SingleCompCase from there! + do i=1, todoCount + vmIdSingleComp => vmIdMap(i) + call ESMF_ReconcileSingleCompCase(state, vm=vm, vmId=vmIdSingleComp, & + attreconflag=attreconflag, siwrap=siwrap, rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & + rcToReturn=rc)) return + enddo + end subroutine ESMF_ReconcileMultiCompCase !------------------------------------------------------------------------------ @@ -1801,7 +1814,7 @@ subroutine ESMF_ReconcileSingleCompCase(state, vm, vmId, attreconflag, siwrap, r ! Serialize on rootPet if (localPet==rootPet) then - call ESMF_ReconcileSerializeAll(state, vm, siwrap, attreconflag, & + call ESMF_ReconcileSerializeAll(state, vm, vmId, siwrap, attreconflag, & buffer, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return @@ -4227,13 +4240,10 @@ subroutine ESMF_ReconcileSerialize (state, vm, siwrap, & if (debug) then print *, ESMF_METHOD, ': serializing unknown: ', trim (stateitem%namep) end if - call c_ESMC_StringSerialize(stateitem%namep, & - obj_buffer, lbufsize, buffer_offset, & - inqflag, & - localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, & - rcToReturn=rc)) return + write (errstring, '(a)') 'can''t serialize unknown type!!' + if (ESMF_LogFoundError(ESMF_RC_INTNRL_INCONS, msg=errstring, & + ESMF_CONTEXT, & + rcToReturn=rc)) return case default localrc = ESMF_RC_INTNRL_INCONS @@ -4394,12 +4404,13 @@ end subroutine ESMF_ReconcileSerialize ! !IROUTINE: ESMF_ReconcileSerializeAll ! ! !INTERFACE: - subroutine ESMF_ReconcileSerializeAll(state, vm, siwrap, & + subroutine ESMF_ReconcileSerializeAll(state, vm, vmid, siwrap, & attreconflag, buffer, rc) ! ! !ARGUMENTS: type (ESMF_State), intent(in) :: state type (ESMF_VM), intent(in) :: vm + type (ESMF_VMId), pointer, intent(in) :: vmId ! vmId for which to serialize type (ESMF_StateItemWrap), intent(in) :: siwrap(:) type(ESMF_AttReconcileFlag),intent(in) :: attreconflag character, pointer :: buffer(:) @@ -4434,6 +4445,9 @@ subroutine ESMF_ReconcileSerializeAll(state, vm, siwrap, & integer :: itemSize type(ESMF_InquireFlag) :: inqflag integer :: localPet, petCount, pet + type(ESMF_VM) :: vmItem + type(ESMF_VMId) :: vmIdItem + logical :: isFlag ! XMRKX ! @@ -4484,75 +4498,125 @@ subroutine ESMF_ReconcileSerializeAll(state, vm, siwrap, & ! Get size of item to serialize select case (itemType) case (ESMF_STATEITEM_FIELDBUNDLE%ot) - call ESMF_FieldBundleSerialize(stateItem%datap%fbp, & + call ESMF_FieldBundleGet(stateItem%datap%fbp, vm=vmItem, rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & + rcToReturn=rc)) return + call ESMF_VMGetVMId(vmItem, vmId=vmIdItem, rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & + rcToReturn=rc)) return + isFlag = ESMF_VMIdCompare(vmIdItem, vmId, rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & + rcToReturn=rc)) return + if (isFlag) then + ! object has the correct VMId -> serialize + call ESMF_FieldBundleSerialize(stateItem%datap%fbp, & fakeBuffer, sizeFakeBuffer, itemSize, & attreconflag=attreconflag, inquireflag=inqflag, & rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, & + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & rcToReturn=rc)) return - if (debug) then - print *, ' PET', localPet, & + if (debug) then + print *, ' PET', localPet, & ' Getting FieldBundle size=',itemSize - end if - + end if + endif case (ESMF_STATEITEM_FIELD%ot) - call ESMF_FieldSerialize(stateItem%datap%fp, & + call ESMF_FieldGet(stateItem%datap%fp, vm=vmItem, rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & + rcToReturn=rc)) return + call ESMF_VMGetVMId(vmItem, vmId=vmIdItem, rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & + rcToReturn=rc)) return + isFlag = ESMF_VMIdCompare(vmIdItem, vmId, rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & + rcToReturn=rc)) return + if (isFlag) then + ! object has the correct VMId -> serialize + call ESMF_FieldSerialize(stateItem%datap%fp, & fakeBuffer, sizeFakeBuffer, itemSize, & attreconflag=attreconflag, inquireflag=inqflag, & rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, & + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & rcToReturn=rc)) return - if (debug) then - print *, ' PET', localPet, & + if (debug) then + print *, ' PET', localPet, & ' Getting Field size=',itemSize - end if - + end if + endif case (ESMF_STATEITEM_ARRAY%ot) - call c_ESMC_ArraySerialize(stateitem%datap%ap, & + call ESMF_ArrayGet(stateItem%datap%ap, vm=vmItem, rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & + rcToReturn=rc)) return + call ESMF_VMGetVMId(vmItem, vmId=vmIdItem, rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & + rcToReturn=rc)) return + isFlag = ESMF_VMIdCompare(vmIdItem, vmId, rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & + rcToReturn=rc)) return + if (isFlag) then + ! object has the correct VMId -> serialize + call c_ESMC_ArraySerialize(stateitem%datap%ap, & fakeBuffer, sizeFakeBuffer, itemSize, & attreconflag, inqflag, & localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, & + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & rcToReturn=rc)) return - if (debug) then - print *, ' PET', localPet, & + if (debug) then + print *, ' PET', localPet, & ' Getting Array size=',itemSize - end if - + end if + endif case (ESMF_STATEITEM_ARRAYBUNDLE%ot) - call c_ESMC_ArrayBundleSerialize(stateitem%datap%abp, & + call ESMF_ArrayBundleGet(stateItem%datap%abp, vm=vmItem, rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & + rcToReturn=rc)) return + call ESMF_VMGetVMId(vmItem, vmId=vmIdItem, rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & + rcToReturn=rc)) return + isFlag = ESMF_VMIdCompare(vmIdItem, vmId, rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & + rcToReturn=rc)) return + if (isFlag) then + ! object has the correct VMId -> serialize + call c_ESMC_ArrayBundleSerialize(stateitem%datap%abp, & fakeBuffer, sizeFakeBuffer, itemSize, & attreconflag, inqflag, & localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, & + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & rcToReturn=rc)) return - if (debug) then - print *, ' PET', localPet, & + if (debug) then + print *, ' PET', localPet, & ' Getting ArrayBundle size=',itemSize - end if - + end if + endif case (ESMF_STATEITEM_STATE%ot) wrapper%statep => stateitem%datap%spp ESMF_INIT_SET_CREATED(wrapper) - call ESMF_StateSerialize(wrapper, & - fakeBuffer, sizeFakeBuffer, itemSize, & + call ESMF_StateGet(wrapper, vm=vmItem, rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & + rcToReturn=rc)) return + call ESMF_VMGetVMId(vmItem, vmId=vmIdItem, rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & + rcToReturn=rc)) return + isFlag = ESMF_VMIdCompare(vmIdItem, vmId, rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & + rcToReturn=rc)) return + if (isFlag) then + ! object has the correct VMId -> serialize + call ESMF_StateSerialize(wrapper, & + fakeBuffer, sizeFakeBuffer, itemSize, & attreconflag=attreconflag, inquireflag=inqflag, & rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, & + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & rcToReturn=rc)) return - if (debug) then - print *, ' PET', localPet, & + if (debug) then + print *, ' PET', localPet, & ' Getting State size=',itemSize - end if - + end if + endif case (ESMF_STATEITEM_ROUTEHANDLE%ot) ! Do nothing for RouteHandles. There is no need to reconcile them. - +#if 0 case (ESMF_STATEITEM_UNKNOWN%ot) call c_ESMC_StringSerialize(stateitem%namep, & fakeBuffer, sizeFakeBuffer, itemSize, & @@ -4564,7 +4628,7 @@ subroutine ESMF_ReconcileSerializeAll(state, vm, siwrap, & print *, ' PET', localPet, & ' Getting Unknown size=',itemSize end if - +#endif case default if (ESMF_LogFoundError(ESMF_RC_INTNRL_INCONS, & msg="Unrecognized item type.", & @@ -4588,7 +4652,6 @@ subroutine ESMF_ReconcileSerializeAll(state, vm, siwrap, & rcToReturn=rc)) return - !!!!! Serialize information into buffer !!!!! ! Start position of buffer @@ -4620,78 +4683,127 @@ subroutine ESMF_ReconcileSerializeAll(state, vm, siwrap, & ! Add serialized items select case (itemType) - case (ESMF_STATEITEM_FIELDBUNDLE%ot) - if (debug) then - print *, ' PET', localPet, & + case (ESMF_STATEITEM_FIELDBUNDLE%ot) + call ESMF_FieldBundleGet(stateItem%datap%fbp, vm=vmItem, rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & + rcToReturn=rc)) return + call ESMF_VMGetVMId(vmItem, vmId=vmIdItem, rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & + rcToReturn=rc)) return + isFlag = ESMF_VMIdCompare(vmIdItem, vmId, rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & + rcToReturn=rc)) return + if (isFlag) then + ! object has the correct VMId -> serialize + if (debug) then + print *, ' PET', localPet, & ' Getting FieldBundle pos=',posBuffer - end if - call ESMF_FieldBundleSerialize(stateItem%datap%fbp, & + end if + call ESMF_FieldBundleSerialize(stateItem%datap%fbp, & buffer, sizeBuffer, posBuffer, & attreconflag=attreconflag, inquireflag=inqflag, & rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, & + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & rcToReturn=rc)) return - - case (ESMF_STATEITEM_FIELD%ot) + endif + case (ESMF_STATEITEM_FIELD%ot) + call ESMF_FieldGet(stateItem%datap%fp, vm=vmItem, rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & + rcToReturn=rc)) return + call ESMF_VMGetVMId(vmItem, vmId=vmIdItem, rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & + rcToReturn=rc)) return + isFlag = ESMF_VMIdCompare(vmIdItem, vmId, rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & + rcToReturn=rc)) return + if (isFlag) then + ! object has the correct VMId -> serialize if (debug) then print *, ' PET', localPet, & ' Getting Field pos=',posBuffer end if call ESMF_FieldSerialize(stateItem%datap%fp, & - buffer, sizeBuffer, posBuffer, & + buffer, sizeBuffer, posBuffer, & attreconflag=attreconflag, inquireflag=inqflag, & rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, & + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & rcToReturn=rc)) return - - case (ESMF_STATEITEM_ARRAY%ot) + endif + case (ESMF_STATEITEM_ARRAY%ot) + call ESMF_ArrayGet(stateItem%datap%ap, vm=vmItem, rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & + rcToReturn=rc)) return + call ESMF_VMGetVMId(vmItem, vmId=vmIdItem, rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & + rcToReturn=rc)) return + isFlag = ESMF_VMIdCompare(vmIdItem, vmId, rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & + rcToReturn=rc)) return + if (isFlag) then + ! object has the correct VMId -> serialize if (debug) then print *, ' PET', localPet, & ' Getting Array pos=',posBuffer end if call c_ESMC_ArraySerialize(stateitem%datap%ap, & - buffer, sizeBuffer, posBuffer, & + buffer, sizeBuffer, posBuffer, & attreconflag, inqflag, & localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, & + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & rcToReturn=rc)) return - - case (ESMF_STATEITEM_ARRAYBUNDLE%ot) + endif + case (ESMF_STATEITEM_ARRAYBUNDLE%ot) + call ESMF_ArrayBundleGet(stateItem%datap%abp, vm=vmItem, rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & + rcToReturn=rc)) return + call ESMF_VMGetVMId(vmItem, vmId=vmIdItem, rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & + rcToReturn=rc)) return + isFlag = ESMF_VMIdCompare(vmIdItem, vmId, rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & + rcToReturn=rc)) return + if (isFlag) then + ! object has the correct VMId -> serialize if (debug) then print *, ' PET', localPet, & ' Getting ArrayBundle pos=',posBuffer end if call c_ESMC_ArrayBundleSerialize(stateitem%datap%abp, & - buffer, sizeBuffer, posBuffer, & + buffer, sizeBuffer, posBuffer, & attreconflag, inqflag, & localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, & + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & rcToReturn=rc)) return - - case (ESMF_STATEITEM_STATE%ot) + endif + case (ESMF_STATEITEM_STATE%ot) + wrapper%statep => stateitem%datap%spp + ESMF_INIT_SET_CREATED(wrapper) + call ESMF_StateGet(wrapper, vm=vmItem, rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & + rcToReturn=rc)) return + call ESMF_VMGetVMId(vmItem, vmId=vmIdItem, rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & + rcToReturn=rc)) return + isFlag = ESMF_VMIdCompare(vmIdItem, vmId, rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & + rcToReturn=rc)) return + if (isFlag) then + ! object has the correct VMId -> serialize if (debug) then print *, ' PET', localPet, & ' Getting State pos=',posBuffer end if - wrapper%statep => stateitem%datap%spp - ESMF_INIT_SET_CREATED(wrapper) call ESMF_StateSerialize(wrapper, & - buffer, sizeBuffer, posBuffer, & + buffer, sizeBuffer, posBuffer, & attreconflag=attreconflag, inquireflag=inqflag, & rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, & + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & rcToReturn=rc)) return - - - case (ESMF_STATEITEM_ROUTEHANDLE%ot) + endif + case (ESMF_STATEITEM_ROUTEHANDLE%ot) ! Do nothing for RouteHandles. There is no need to reconcile them. - - case (ESMF_STATEITEM_UNKNOWN%ot) +#if 0 + case (ESMF_STATEITEM_UNKNOWN%ot) if (debug) then print *, ' PET', localPet, & ' Getting Unknown pos=',posBuffer @@ -4702,23 +4814,21 @@ subroutine ESMF_ReconcileSerializeAll(state, vm, siwrap, & if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, & rcToReturn=rc)) return - - - case default +#endif + case default if (ESMF_LogFoundError(ESMF_RC_INTNRL_INCONS, & msg="Unrecognized item type.", & ESMF_CONTEXT, & rcToReturn=rc)) return - end select + end select enddo - + ! Return success rc = ESMF_SUCCESS end subroutine ESMF_ReconcileSerializeAll - !------------------------------------------------------------------------------ #undef ESMF_METHOD #define ESMF_METHOD "ESMF_ReconcileZapProxies" From 38792746baf2e9f15cac3b6e17065348370ab17c Mon Sep 17 00:00:00 2001 From: Gerhard Theurich Date: Fri, 8 Nov 2024 15:09:14 -0800 Subject: [PATCH 121/207] Correctly use todoList when setting the vmIdSingleComp inside multiComp case. Minor formatting changes. --- .../src/ESMF_StateReconcile.F90 | 288 +++++++++--------- 1 file changed, 150 insertions(+), 138 deletions(-) diff --git a/src/Superstructure/StateReconcile/src/ESMF_StateReconcile.F90 b/src/Superstructure/StateReconcile/src/ESMF_StateReconcile.F90 index b8dd3d0c09..e5421182ba 100644 --- a/src/Superstructure/StateReconcile/src/ESMF_StateReconcile.F90 +++ b/src/Superstructure/StateReconcile/src/ESMF_StateReconcile.F90 @@ -1085,10 +1085,19 @@ subroutine ESMF_StateReconcile_driver(state, vm, rc) rcToReturn=rc)) return endif ! ------------------------------------------------------------------------ +#if 1 call ESMF_ReconcileSingleCompCase(state, vm=vm, vmId=vmIdSingleComp, & attreconflag=attreconflag, siwrap=siwrap, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & rcToReturn=rc)) return +#else + call ESMF_ReconcileMultiCompCase(state, vm=vm, vmIdMap=vmIdMap_ptr, & + attreconflag=attreconflag, siwrap=siwrap, ids_send=ids_send, & + vmids_send=vmids_send, vmintids_send=vmintids_send, & + nitems_buf=nitems_buf, rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, rcToReturn=rc)) return +#endif ! ------------------------------------------------------------------------ if (profile) then call ESMF_TraceRegionExit("(2<) ESMF_ReconcileSingleCompCase", rc=localrc) @@ -1342,7 +1351,7 @@ subroutine ESMF_ReconcileMultiCompCase(state, vm, vmIdMap, attreconflag, & !TODO: Don't actually need these two separate loops first one will be !TODO: enough, just directly call into the SingleCompCase from there! do i=1, todoCount - vmIdSingleComp => vmIdMap(i) + vmIdSingleComp => vmIdMap(todoList(i)) call ESMF_ReconcileSingleCompCase(state, vm=vm, vmId=vmIdSingleComp, & attreconflag=attreconflag, siwrap=siwrap, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & @@ -1809,6 +1818,11 @@ subroutine ESMF_ReconcileSingleCompCase(state, vm, vmId, attreconflag, siwrap, r if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, & rcToReturn=rc)) return + write(msgStr,*) "SingleCompCase size(siwrap)=", size(siwrap) + call ESMF_LogWrite(msgStr, ESMF_LOGMSG_DEBUG, rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, & + rcToReturn=rc)) return end block #endif @@ -4497,154 +4511,152 @@ subroutine ESMF_ReconcileSerializeAll(state, vm, vmid, siwrap, & ! Get size of item to serialize select case (itemType) - case (ESMF_STATEITEM_FIELDBUNDLE%ot) - call ESMF_FieldBundleGet(stateItem%datap%fbp, vm=vmItem, rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & - rcToReturn=rc)) return - call ESMF_VMGetVMId(vmItem, vmId=vmIdItem, rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & - rcToReturn=rc)) return - isFlag = ESMF_VMIdCompare(vmIdItem, vmId, rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & - rcToReturn=rc)) return - if (isFlag) then - ! object has the correct VMId -> serialize - call ESMF_FieldBundleSerialize(stateItem%datap%fbp, & - fakeBuffer, sizeFakeBuffer, itemSize, & - attreconflag=attreconflag, inquireflag=inqflag, & - rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & - rcToReturn=rc)) return - if (debug) then - print *, ' PET', localPet, & - ' Getting FieldBundle size=',itemSize - end if - endif - case (ESMF_STATEITEM_FIELD%ot) - call ESMF_FieldGet(stateItem%datap%fp, vm=vmItem, rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & - rcToReturn=rc)) return - call ESMF_VMGetVMId(vmItem, vmId=vmIdItem, rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & - rcToReturn=rc)) return - isFlag = ESMF_VMIdCompare(vmIdItem, vmId, rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & - rcToReturn=rc)) return - if (isFlag) then - ! object has the correct VMId -> serialize - call ESMF_FieldSerialize(stateItem%datap%fp, & - fakeBuffer, sizeFakeBuffer, itemSize, & - attreconflag=attreconflag, inquireflag=inqflag, & - rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & - rcToReturn=rc)) return - if (debug) then - print *, ' PET', localPet, & - ' Getting Field size=',itemSize - end if - endif - case (ESMF_STATEITEM_ARRAY%ot) - call ESMF_ArrayGet(stateItem%datap%ap, vm=vmItem, rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & - rcToReturn=rc)) return - call ESMF_VMGetVMId(vmItem, vmId=vmIdItem, rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & - rcToReturn=rc)) return - isFlag = ESMF_VMIdCompare(vmIdItem, vmId, rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & - rcToReturn=rc)) return - if (isFlag) then - ! object has the correct VMId -> serialize - call c_ESMC_ArraySerialize(stateitem%datap%ap, & - fakeBuffer, sizeFakeBuffer, itemSize, & - attreconflag, inqflag, & - localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & - rcToReturn=rc)) return - if (debug) then - print *, ' PET', localPet, & - ' Getting Array size=',itemSize - end if - endif - case (ESMF_STATEITEM_ARRAYBUNDLE%ot) - call ESMF_ArrayBundleGet(stateItem%datap%abp, vm=vmItem, rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & - rcToReturn=rc)) return - call ESMF_VMGetVMId(vmItem, vmId=vmIdItem, rc=localrc) + case (ESMF_STATEITEM_FIELDBUNDLE%ot) + call ESMF_FieldBundleGet(stateItem%datap%fbp, vm=vmItem, rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & + rcToReturn=rc)) return + call ESMF_VMGetVMId(vmItem, vmId=vmIdItem, rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & + rcToReturn=rc)) return + isFlag = ESMF_VMIdCompare(vmIdItem, vmId, rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & + rcToReturn=rc)) return + if (isFlag) then + ! object has the correct VMId -> serialize + call ESMF_FieldBundleSerialize(stateItem%datap%fbp, & + fakeBuffer, sizeFakeBuffer, itemSize, & + attreconflag=attreconflag, inquireflag=inqflag, & + rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & - rcToReturn=rc)) return - isFlag = ESMF_VMIdCompare(vmIdItem, vmId, rc=localrc) + rcToReturn=rc)) return + if (debug) then + print *, ' PET', localPet, & + ' Getting FieldBundle size=',itemSize + end if + endif + case (ESMF_STATEITEM_FIELD%ot) + call ESMF_FieldGet(stateItem%datap%fp, vm=vmItem, rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & + rcToReturn=rc)) return + call ESMF_VMGetVMId(vmItem, vmId=vmIdItem, rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & + rcToReturn=rc)) return + isFlag = ESMF_VMIdCompare(vmIdItem, vmId, rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & + rcToReturn=rc)) return + if (isFlag) then + ! object has the correct VMId -> serialize + call ESMF_FieldSerialize(stateItem%datap%fp, & + fakeBuffer, sizeFakeBuffer, itemSize, & + attreconflag=attreconflag, inquireflag=inqflag, & + rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & - rcToReturn=rc)) return - if (isFlag) then - ! object has the correct VMId -> serialize - call c_ESMC_ArrayBundleSerialize(stateitem%datap%abp, & - fakeBuffer, sizeFakeBuffer, itemSize, & - attreconflag, inqflag, & - localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & - rcToReturn=rc)) return - if (debug) then - print *, ' PET', localPet, & - ' Getting ArrayBundle size=',itemSize - end if - endif - case (ESMF_STATEITEM_STATE%ot) - wrapper%statep => stateitem%datap%spp - ESMF_INIT_SET_CREATED(wrapper) - call ESMF_StateGet(wrapper, vm=vmItem, rc=localrc) + rcToReturn=rc)) return + if (debug) then + print *, ' PET', localPet, & + ' Getting Field size=',itemSize + end if + endif + case (ESMF_STATEITEM_ARRAY%ot) + call ESMF_ArrayGet(stateItem%datap%ap, vm=vmItem, rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & + rcToReturn=rc)) return + call ESMF_VMGetVMId(vmItem, vmId=vmIdItem, rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & + rcToReturn=rc)) return + isFlag = ESMF_VMIdCompare(vmIdItem, vmId, rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & + rcToReturn=rc)) return + if (isFlag) then + ! object has the correct VMId -> serialize + call c_ESMC_ArraySerialize(stateitem%datap%ap, & + fakeBuffer, sizeFakeBuffer, itemSize, & + attreconflag, inqflag, & + localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & - rcToReturn=rc)) return - call ESMF_VMGetVMId(vmItem, vmId=vmIdItem, rc=localrc) + rcToReturn=rc)) return + if (debug) then + print *, ' PET', localPet, & + ' Getting Array size=',itemSize + end if + endif + case (ESMF_STATEITEM_ARRAYBUNDLE%ot) + call ESMF_ArrayBundleGet(stateItem%datap%abp, vm=vmItem, rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & + rcToReturn=rc)) return + call ESMF_VMGetVMId(vmItem, vmId=vmIdItem, rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & + rcToReturn=rc)) return + isFlag = ESMF_VMIdCompare(vmIdItem, vmId, rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & + rcToReturn=rc)) return + if (isFlag) then + ! object has the correct VMId -> serialize + call c_ESMC_ArrayBundleSerialize(stateitem%datap%abp, & + fakeBuffer, sizeFakeBuffer, itemSize, & + attreconflag, inqflag, & + localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & - rcToReturn=rc)) return - isFlag = ESMF_VMIdCompare(vmIdItem, vmId, rc=localrc) + rcToReturn=rc)) return + if (debug) then + print *, ' PET', localPet, & + ' Getting ArrayBundle size=',itemSize + end if + endif + case (ESMF_STATEITEM_STATE%ot) + wrapper%statep => stateitem%datap%spp + ESMF_INIT_SET_CREATED(wrapper) + call ESMF_StateGet(wrapper, vm=vmItem, rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & + rcToReturn=rc)) return + call ESMF_VMGetVMId(vmItem, vmId=vmIdItem, rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & + rcToReturn=rc)) return + isFlag = ESMF_VMIdCompare(vmIdItem, vmId, rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & + rcToReturn=rc)) return + if (isFlag) then + ! object has the correct VMId -> serialize + call ESMF_StateSerialize(wrapper, & + fakeBuffer, sizeFakeBuffer, itemSize, & + attreconflag=attreconflag, inquireflag=inqflag, & + rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & - rcToReturn=rc)) return - if (isFlag) then - ! object has the correct VMId -> serialize - call ESMF_StateSerialize(wrapper, & - fakeBuffer, sizeFakeBuffer, itemSize, & - attreconflag=attreconflag, inquireflag=inqflag, & - rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & - rcToReturn=rc)) return - if (debug) then - print *, ' PET', localPet, & - ' Getting State size=',itemSize - end if - endif - case (ESMF_STATEITEM_ROUTEHANDLE%ot) - ! Do nothing for RouteHandles. There is no need to reconcile them. -#if 0 - case (ESMF_STATEITEM_UNKNOWN%ot) - call c_ESMC_StringSerialize(stateitem%namep, & - fakeBuffer, sizeFakeBuffer, itemSize, & - inqflag, localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, & - rcToReturn=rc)) return + rcToReturn=rc)) return if (debug) then - print *, ' PET', localPet, & - ' Getting Unknown size=',itemSize + print *, ' PET', localPet, & + ' Getting State size=',itemSize end if + endif + case (ESMF_STATEITEM_ROUTEHANDLE%ot) + ! Do nothing for RouteHandles. There is no need to reconcile them. +#if 0 + case (ESMF_STATEITEM_UNKNOWN%ot) + call c_ESMC_StringSerialize(stateitem%namep, & + fakeBuffer, sizeFakeBuffer, itemSize, & + inqflag, localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, & + rcToReturn=rc)) return + if (debug) then + print *, ' PET', localPet, & + ' Getting Unknown size=',itemSize + end if #endif - case default - if (ESMF_LogFoundError(ESMF_RC_INTNRL_INCONS, & - msg="Unrecognized item type.", & - ESMF_CONTEXT, & - rcToReturn=rc)) return - end select + case default + if (ESMF_LogFoundError(ESMF_RC_INTNRL_INCONS, & + msg="Unrecognized item type.", & + ESMF_CONTEXT, & + rcToReturn=rc)) return + end select - ! Update buffer size by itemSize - sizeBuffer = sizeBuffer + itemSize + ! Update buffer size by itemSize + sizeBuffer = sizeBuffer + itemSize enddo ! Get rid of fakeBuffer deallocate(fakeBuffer) - - !!!!! Allocate buffer to serialize into !!!!! allocate(buffer(sizeBuffer), stat=memstat) if (ESMF_LogFoundAllocError(memstat, ESMF_ERR_PASSTHRU, & @@ -4815,13 +4827,13 @@ subroutine ESMF_ReconcileSerializeAll(state, vm, vmid, siwrap, & ESMF_CONTEXT, & rcToReturn=rc)) return #endif - case default + case default if (ESMF_LogFoundError(ESMF_RC_INTNRL_INCONS, & msg="Unrecognized item type.", & ESMF_CONTEXT, & rcToReturn=rc)) return - end select - enddo + end select + enddo ! Return success rc = ESMF_SUCCESS From aaab4a66e407af6ca252eb99ff408b375faa6df5 Mon Sep 17 00:00:00 2001 From: Robert Oehmke Date: Fri, 8 Nov 2024 16:59:52 -0700 Subject: [PATCH 122/207] Fix issue wih inconsistent serialize/deserialize buffer indexing in C and Fortran. --- .../StateReconcile/src/ESMF_StateReconcile.F90 | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) diff --git a/src/Superstructure/StateReconcile/src/ESMF_StateReconcile.F90 b/src/Superstructure/StateReconcile/src/ESMF_StateReconcile.F90 index e5421182ba..45ee517d42 100644 --- a/src/Superstructure/StateReconcile/src/ESMF_StateReconcile.F90 +++ b/src/Superstructure/StateReconcile/src/ESMF_StateReconcile.F90 @@ -1840,7 +1840,7 @@ subroutine ESMF_ReconcileSingleCompCase(state, vm, vmId, attreconflag, siwrap, r if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return - if (localPet/=rootPet) allocate(buffer(sizeBuffer(1))) + if (localPet/=rootPet) allocate(buffer(0:sizeBuffer(1)-1)) call ESMF_VMBroadcast(vm, buffer, count=sizeBuffer(1), rootPet=rootPet, & rc=localrc) @@ -2591,7 +2591,7 @@ subroutine ESMF_ReconcileDeserializeAll(state, vm, buffer, attreconflag, rc) rcToReturn=rc)) return ! Set start position of buffer - posBuffer = 1 + posBuffer = 0 ! Get the number of items to add numNewItems = transfer ( & @@ -4485,7 +4485,7 @@ subroutine ESMF_ReconcileSerializeAll(state, vm, vmid, siwrap, & sizeBuffer=ESMF_SIZEOF_DEFINT ! Allocate a fake buffer for passing in when asking for size - allocate(fakeBuffer(ESMF_SIZEOF_DEFINT)) + allocate(fakeBuffer(0:ESMF_SIZEOF_DEFINT-1)) ! Fake buffer size sizeFakeBuffer=size(fakeBuffer) @@ -4658,7 +4658,7 @@ subroutine ESMF_ReconcileSerializeAll(state, vm, vmid, siwrap, & deallocate(fakeBuffer) !!!!! Allocate buffer to serialize into !!!!! - allocate(buffer(sizeBuffer), stat=memstat) + allocate(buffer(0:sizeBuffer-1), stat=memstat) if (ESMF_LogFoundAllocError(memstat, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, & rcToReturn=rc)) return @@ -4667,12 +4667,12 @@ subroutine ESMF_ReconcileSerializeAll(state, vm, vmid, siwrap, & !!!!! Serialize information into buffer !!!!! ! Start position of buffer - posBuffer = 1 + posBuffer = 0 ! Put item count in buffer buffer(posBuffer:posBuffer+ESMF_SIZEOF_DEFINT-1) = transfer ( & source=numStateItems, & - mold=buffer(1:ESMF_SIZEOF_DEFINT)) + mold=buffer(0:ESMF_SIZEOF_DEFINT-1)) posBuffer = posbuffer + ESMF_SIZEOF_DEFINT ! Set flag to actually serialize @@ -4690,7 +4690,7 @@ subroutine ESMF_ReconcileSerializeAll(state, vm, vmid, siwrap, & ! Add item type to buffer buffer(posBuffer:posBuffer+ESMF_SIZEOF_DEFINT-1) = transfer (& source=itemType, & - mold =buffer(1:ESMF_SIZEOF_DEFINT)) + mold =buffer(0:ESMF_SIZEOF_DEFINT-1)) posBuffer = posbuffer + ESMF_SIZEOF_DEFINT ! Add serialized items From 2c4c15ca9308c9e57b385736c497e0273b6d170f Mon Sep 17 00:00:00 2001 From: Gerhard Theurich Date: Fri, 8 Nov 2024 16:03:01 -0800 Subject: [PATCH 123/207] Use ESMF_ReconcileMultiCompCase() even for single-comp-case for testing. Use ESMF_ReconcileMultiCompCase() instead of ESMF_ReconcileBruteForce() for multi-comp. Skip over any possible proxy objects during serialization. More logging. --- .../src/ESMF_StateReconcile.F90 | 277 +++++++++++++----- 1 file changed, 207 insertions(+), 70 deletions(-) diff --git a/src/Superstructure/StateReconcile/src/ESMF_StateReconcile.F90 b/src/Superstructure/StateReconcile/src/ESMF_StateReconcile.F90 index e5421182ba..c14cc81937 100644 --- a/src/Superstructure/StateReconcile/src/ESMF_StateReconcile.F90 +++ b/src/Superstructure/StateReconcile/src/ESMF_StateReconcile.F90 @@ -1085,7 +1085,7 @@ subroutine ESMF_StateReconcile_driver(state, vm, rc) rcToReturn=rc)) return endif ! ------------------------------------------------------------------------ -#if 1 +#if 0 call ESMF_ReconcileSingleCompCase(state, vm=vm, vmId=vmIdSingleComp, & attreconflag=attreconflag, siwrap=siwrap, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & @@ -1114,7 +1114,7 @@ subroutine ESMF_StateReconcile_driver(state, vm, rc) rcToReturn=rc)) return endif ! ------------------------------------------------------------------------ -#if 0 +#if 1 call ESMF_ReconcileMultiCompCase(state, vm=vm, vmIdMap=vmIdMap_ptr, & attreconflag=attreconflag, siwrap=siwrap, ids_send=ids_send, & vmids_send=vmids_send, vmintids_send=vmintids_send, & @@ -1810,18 +1810,15 @@ subroutine ESMF_ReconcileSingleCompCase(state, vm, vmId, attreconflag, siwrap, r character(160) :: msgStr write(msgStr,*) "SingleCompCase rootVas=", rootVas call ESMF_LogWrite(msgStr, ESMF_LOGMSG_DEBUG, rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, & + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & rcToReturn=rc)) return write(msgStr,*) "SingleCompCase rootPet=", rootPet call ESMF_LogWrite(msgStr, ESMF_LOGMSG_DEBUG, rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, & + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & rcToReturn=rc)) return write(msgStr,*) "SingleCompCase size(siwrap)=", size(siwrap) call ESMF_LogWrite(msgStr, ESMF_LOGMSG_DEBUG, rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, & + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & rcToReturn=rc)) return end block #endif @@ -1840,6 +1837,16 @@ subroutine ESMF_ReconcileSingleCompCase(state, vm, vmId, attreconflag, siwrap, r if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return +#ifdef RECONCILE_LOG_on + block + character(160) :: msgStr + write(msgStr,*) "SingleCompCase sizeBuffer=", sizeBuffer(1) + call ESMF_LogWrite(msgStr, ESMF_LOGMSG_DEBUG, rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & + rcToReturn=rc)) return + end block +#endif + if (localPet/=rootPet) allocate(buffer(sizeBuffer(1))) call ESMF_VMBroadcast(vm, buffer, count=sizeBuffer(1), rootPet=rootPet, & @@ -2583,7 +2590,14 @@ subroutine ESMF_ReconcileDeserializeAll(state, vm, buffer, attreconflag, rc) integer :: sizeBuffer, posBuffer ! XMRKX ! - + +#ifdef RECONCILE_LOG_on + call ESMF_LogWrite("ESMF_ReconcileDeserializeAll()", & + ESMF_LOGMSG_DEBUG, rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & + rcToReturn=rc)) return +#endif + ! VM information for debug output call ESMF_VMGet (vm, localPet=localPet, rc=localrc) if (ESMF_LogFoundError (localrc, ESMF_ERR_PASSTHRU, & @@ -4461,13 +4475,21 @@ subroutine ESMF_ReconcileSerializeAll(state, vm, vmid, siwrap, & integer :: localPet, petCount, pet type(ESMF_VM) :: vmItem type(ESMF_VMId) :: vmIdItem + type(ESMF_Pointer) :: thisItem logical :: isFlag ! XMRKX ! - + ! Init to not implemented localrc = ESMF_RC_NOT_IMPL +#ifdef RECONCILE_LOG_on + call ESMF_LogWrite("ESMF_ReconcileSerializeAll()", & + ESMF_LOGMSG_DEBUG, rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & + rcToReturn=rc)) return +#endif + ! Get vm info call ESMF_VMGet(vm, localPet=localPet, petCount=petCount, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & @@ -4514,13 +4536,19 @@ subroutine ESMF_ReconcileSerializeAll(state, vm, vmid, siwrap, & case (ESMF_STATEITEM_FIELDBUNDLE%ot) call ESMF_FieldBundleGet(stateItem%datap%fbp, vm=vmItem, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & - rcToReturn=rc)) return - call ESMF_VMGetVMId(vmItem, vmId=vmIdItem, rc=localrc) + rcToReturn=rc)) return + call ESMF_VMGetThis(vmItem, thisItem, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & + rcToReturn=rc)) return + isFlag = (thisItem /= ESMF_NULL_POINTER) ! not a proxy + if (isFlag) then + call ESMF_VMGetVMId(vmItem, vmId=vmIdItem, rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & rcToReturn=rc)) return - isFlag = ESMF_VMIdCompare(vmIdItem, vmId, rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & + isFlag = ESMF_VMIdCompare(vmIdItem, vmId, rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & rcToReturn=rc)) return + endif if (isFlag) then ! object has the correct VMId -> serialize call ESMF_FieldBundleSerialize(stateItem%datap%fbp, & @@ -4529,21 +4557,38 @@ subroutine ESMF_ReconcileSerializeAll(state, vm, vmid, siwrap, & rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & rcToReturn=rc)) return - if (debug) then - print *, ' PET', localPet, & - ' Getting FieldBundle size=',itemSize - end if +#ifdef RECONCILE_LOG_on + block + character(ESMF_MAXSTR) :: itemName + character(160) :: msgStr + call ESMF_FieldBundleGet(stateItem%datap%fbp, name=itemName, & + rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & + rcToReturn=rc)) return + write(msgStr,*) "Serialize FieldBundle '"//trim(itemName)//"' "//& + " size=", itemSize + call ESMF_LogWrite(msgStr, ESMF_LOGMSG_DEBUG, rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & + rcToReturn=rc)) return + end block +#endif endif case (ESMF_STATEITEM_FIELD%ot) call ESMF_FieldGet(stateItem%datap%fp, vm=vmItem, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & - rcToReturn=rc)) return - call ESMF_VMGetVMId(vmItem, vmId=vmIdItem, rc=localrc) + rcToReturn=rc)) return + call ESMF_VMGetThis(vmItem, thisItem, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & + rcToReturn=rc)) return + isFlag = (thisItem /= ESMF_NULL_POINTER) ! not a proxy + if (isFlag) then + call ESMF_VMGetVMId(vmItem, vmId=vmIdItem, rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & rcToReturn=rc)) return - isFlag = ESMF_VMIdCompare(vmIdItem, vmId, rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & + isFlag = ESMF_VMIdCompare(vmIdItem, vmId, rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & rcToReturn=rc)) return + endif if (isFlag) then ! object has the correct VMId -> serialize call ESMF_FieldSerialize(stateItem%datap%fp, & @@ -4552,21 +4597,38 @@ subroutine ESMF_ReconcileSerializeAll(state, vm, vmid, siwrap, & rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & rcToReturn=rc)) return - if (debug) then - print *, ' PET', localPet, & - ' Getting Field size=',itemSize - end if +#ifdef RECONCILE_LOG_on + block + character(ESMF_MAXSTR) :: itemName + character(160) :: msgStr + call ESMF_FieldGet(stateItem%datap%fp, name=itemName, & + rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & + rcToReturn=rc)) return + write(msgStr,*) "Serialize Field '"//trim(itemName)//"' "//& + " size=", itemSize + call ESMF_LogWrite(msgStr, ESMF_LOGMSG_DEBUG, rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & + rcToReturn=rc)) return + end block +#endif endif case (ESMF_STATEITEM_ARRAY%ot) call ESMF_ArrayGet(stateItem%datap%ap, vm=vmItem, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & - rcToReturn=rc)) return - call ESMF_VMGetVMId(vmItem, vmId=vmIdItem, rc=localrc) + rcToReturn=rc)) return + call ESMF_VMGetThis(vmItem, thisItem, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & + rcToReturn=rc)) return + isFlag = (thisItem /= ESMF_NULL_POINTER) ! not a proxy + if (isFlag) then + call ESMF_VMGetVMId(vmItem, vmId=vmIdItem, rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & rcToReturn=rc)) return - isFlag = ESMF_VMIdCompare(vmIdItem, vmId, rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & + isFlag = ESMF_VMIdCompare(vmIdItem, vmId, rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & rcToReturn=rc)) return + endif if (isFlag) then ! object has the correct VMId -> serialize call c_ESMC_ArraySerialize(stateitem%datap%ap, & @@ -4575,21 +4637,38 @@ subroutine ESMF_ReconcileSerializeAll(state, vm, vmid, siwrap, & localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & rcToReturn=rc)) return - if (debug) then - print *, ' PET', localPet, & - ' Getting Array size=',itemSize - end if +#ifdef RECONCILE_LOG_on + block + character(ESMF_MAXSTR) :: itemName + character(160) :: msgStr + call ESMF_ArrayGet(stateItem%datap%ap, name=itemName, & + rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & + rcToReturn=rc)) return + write(msgStr,*) "Serialize Array '"//trim(itemName)//"' "//& + " size=", itemSize + call ESMF_LogWrite(msgStr, ESMF_LOGMSG_DEBUG, rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & + rcToReturn=rc)) return + end block +#endif endif case (ESMF_STATEITEM_ARRAYBUNDLE%ot) call ESMF_ArrayBundleGet(stateItem%datap%abp, vm=vmItem, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & - rcToReturn=rc)) return - call ESMF_VMGetVMId(vmItem, vmId=vmIdItem, rc=localrc) + rcToReturn=rc)) return + call ESMF_VMGetThis(vmItem, thisItem, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & + rcToReturn=rc)) return + isFlag = (thisItem /= ESMF_NULL_POINTER) ! not a proxy + if (isFlag) then + call ESMF_VMGetVMId(vmItem, vmId=vmIdItem, rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & rcToReturn=rc)) return - isFlag = ESMF_VMIdCompare(vmIdItem, vmId, rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & + isFlag = ESMF_VMIdCompare(vmIdItem, vmId, rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & rcToReturn=rc)) return + endif if (isFlag) then ! object has the correct VMId -> serialize call c_ESMC_ArrayBundleSerialize(stateitem%datap%abp, & @@ -4598,23 +4677,40 @@ subroutine ESMF_ReconcileSerializeAll(state, vm, vmid, siwrap, & localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & rcToReturn=rc)) return - if (debug) then - print *, ' PET', localPet, & - ' Getting ArrayBundle size=',itemSize - end if +#ifdef RECONCILE_LOG_on + block + character(ESMF_MAXSTR) :: itemName + character(160) :: msgStr + call ESMF_ArrayBundleGet(stateItem%datap%abp, name=itemName, & + rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & + rcToReturn=rc)) return + write(msgStr,*) "Serialize ArrayBundle '"//trim(itemName)//"' "//& + " size=", itemSize + call ESMF_LogWrite(msgStr, ESMF_LOGMSG_DEBUG, rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & + rcToReturn=rc)) return + end block +#endif endif case (ESMF_STATEITEM_STATE%ot) wrapper%statep => stateitem%datap%spp ESMF_INIT_SET_CREATED(wrapper) call ESMF_StateGet(wrapper, vm=vmItem, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & - rcToReturn=rc)) return - call ESMF_VMGetVMId(vmItem, vmId=vmIdItem, rc=localrc) + rcToReturn=rc)) return + call ESMF_VMGetThis(vmItem, thisItem, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & + rcToReturn=rc)) return + isFlag = (thisItem /= ESMF_NULL_POINTER) ! not a proxy + if (isFlag) then + call ESMF_VMGetVMId(vmItem, vmId=vmIdItem, rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & rcToReturn=rc)) return - isFlag = ESMF_VMIdCompare(vmIdItem, vmId, rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & + isFlag = ESMF_VMIdCompare(vmIdItem, vmId, rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & rcToReturn=rc)) return + endif if (isFlag) then ! object has the correct VMId -> serialize call ESMF_StateSerialize(wrapper, & @@ -4623,10 +4719,21 @@ subroutine ESMF_ReconcileSerializeAll(state, vm, vmid, siwrap, & rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & rcToReturn=rc)) return - if (debug) then - print *, ' PET', localPet, & - ' Getting State size=',itemSize - end if +#ifdef RECONCILE_LOG_on + block + character(ESMF_MAXSTR) :: itemName + character(160) :: msgStr + call ESMF_StateGet(wrapper, name=itemName, & + rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & + rcToReturn=rc)) return + write(msgStr,*) "Serialize State '"//trim(itemName)//"' "//& + " size=", itemSize + call ESMF_LogWrite(msgStr, ESMF_LOGMSG_DEBUG, rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & + rcToReturn=rc)) return + end block +#endif endif case (ESMF_STATEITEM_ROUTEHANDLE%ot) ! Do nothing for RouteHandles. There is no need to reconcile them. @@ -4698,13 +4805,19 @@ subroutine ESMF_ReconcileSerializeAll(state, vm, vmid, siwrap, & case (ESMF_STATEITEM_FIELDBUNDLE%ot) call ESMF_FieldBundleGet(stateItem%datap%fbp, vm=vmItem, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & - rcToReturn=rc)) return - call ESMF_VMGetVMId(vmItem, vmId=vmIdItem, rc=localrc) + rcToReturn=rc)) return + call ESMF_VMGetThis(vmItem, thisItem, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & + rcToReturn=rc)) return + isFlag = (thisItem /= ESMF_NULL_POINTER) ! not a proxy + if (isFlag) then + call ESMF_VMGetVMId(vmItem, vmId=vmIdItem, rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & rcToReturn=rc)) return - isFlag = ESMF_VMIdCompare(vmIdItem, vmId, rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & + isFlag = ESMF_VMIdCompare(vmIdItem, vmId, rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & rcToReturn=rc)) return + endif if (isFlag) then ! object has the correct VMId -> serialize if (debug) then @@ -4721,13 +4834,19 @@ subroutine ESMF_ReconcileSerializeAll(state, vm, vmid, siwrap, & case (ESMF_STATEITEM_FIELD%ot) call ESMF_FieldGet(stateItem%datap%fp, vm=vmItem, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & - rcToReturn=rc)) return - call ESMF_VMGetVMId(vmItem, vmId=vmIdItem, rc=localrc) + rcToReturn=rc)) return + call ESMF_VMGetThis(vmItem, thisItem, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & + rcToReturn=rc)) return + isFlag = (thisItem /= ESMF_NULL_POINTER) ! not a proxy + if (isFlag) then + call ESMF_VMGetVMId(vmItem, vmId=vmIdItem, rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & rcToReturn=rc)) return - isFlag = ESMF_VMIdCompare(vmIdItem, vmId, rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & + isFlag = ESMF_VMIdCompare(vmIdItem, vmId, rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & rcToReturn=rc)) return + endif if (isFlag) then ! object has the correct VMId -> serialize if (debug) then @@ -4744,13 +4863,19 @@ subroutine ESMF_ReconcileSerializeAll(state, vm, vmid, siwrap, & case (ESMF_STATEITEM_ARRAY%ot) call ESMF_ArrayGet(stateItem%datap%ap, vm=vmItem, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & - rcToReturn=rc)) return - call ESMF_VMGetVMId(vmItem, vmId=vmIdItem, rc=localrc) + rcToReturn=rc)) return + call ESMF_VMGetThis(vmItem, thisItem, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & + rcToReturn=rc)) return + isFlag = (thisItem /= ESMF_NULL_POINTER) ! not a proxy + if (isFlag) then + call ESMF_VMGetVMId(vmItem, vmId=vmIdItem, rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & rcToReturn=rc)) return - isFlag = ESMF_VMIdCompare(vmIdItem, vmId, rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & + isFlag = ESMF_VMIdCompare(vmIdItem, vmId, rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & rcToReturn=rc)) return + endif if (isFlag) then ! object has the correct VMId -> serialize if (debug) then @@ -4767,13 +4892,19 @@ subroutine ESMF_ReconcileSerializeAll(state, vm, vmid, siwrap, & case (ESMF_STATEITEM_ARRAYBUNDLE%ot) call ESMF_ArrayBundleGet(stateItem%datap%abp, vm=vmItem, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & - rcToReturn=rc)) return - call ESMF_VMGetVMId(vmItem, vmId=vmIdItem, rc=localrc) + rcToReturn=rc)) return + call ESMF_VMGetThis(vmItem, thisItem, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & + rcToReturn=rc)) return + isFlag = (thisItem /= ESMF_NULL_POINTER) ! not a proxy + if (isFlag) then + call ESMF_VMGetVMId(vmItem, vmId=vmIdItem, rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & rcToReturn=rc)) return - isFlag = ESMF_VMIdCompare(vmIdItem, vmId, rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & + isFlag = ESMF_VMIdCompare(vmIdItem, vmId, rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & rcToReturn=rc)) return + endif if (isFlag) then ! object has the correct VMId -> serialize if (debug) then @@ -4792,13 +4923,19 @@ subroutine ESMF_ReconcileSerializeAll(state, vm, vmid, siwrap, & ESMF_INIT_SET_CREATED(wrapper) call ESMF_StateGet(wrapper, vm=vmItem, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & - rcToReturn=rc)) return - call ESMF_VMGetVMId(vmItem, vmId=vmIdItem, rc=localrc) + rcToReturn=rc)) return + call ESMF_VMGetThis(vmItem, thisItem, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & + rcToReturn=rc)) return + isFlag = (thisItem /= ESMF_NULL_POINTER) ! not a proxy + if (isFlag) then + call ESMF_VMGetVMId(vmItem, vmId=vmIdItem, rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & rcToReturn=rc)) return - isFlag = ESMF_VMIdCompare(vmIdItem, vmId, rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & + isFlag = ESMF_VMIdCompare(vmIdItem, vmId, rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & rcToReturn=rc)) return + endif if (isFlag) then ! object has the correct VMId -> serialize if (debug) then From 1aa9f68508444826b9ae8b3d4fe3b9b72bc5bdc3 Mon Sep 17 00:00:00 2001 From: Robert Oehmke Date: Mon, 11 Nov 2024 17:06:49 -0700 Subject: [PATCH 124/207] Add shell of new Field reset method. --- .../Field/src/ESMF_FieldEmpty.cppF90 | 105 ++++++++++++++++++ 1 file changed, 105 insertions(+) diff --git a/src/Infrastructure/Field/src/ESMF_FieldEmpty.cppF90 b/src/Infrastructure/Field/src/ESMF_FieldEmpty.cppF90 index 19886384ef..66d8de0dfa 100644 --- a/src/Infrastructure/Field/src/ESMF_FieldEmpty.cppF90 +++ b/src/Infrastructure/Field/src/ESMF_FieldEmpty.cppF90 @@ -53,6 +53,7 @@ module ESMF_FieldEmptyMod !------------------------------------------------------------------------------ ! !PUBLIC MEMBER FUNCTIONS: public ESMF_FieldEmptyCreate + public ESMF_FieldEmptyReset public ESMF_FieldEmptySet public ESMF_FieldEmptyComplete public ESMF_FieldConstructIANew ! For internal ESMF use only @@ -4314,6 +4315,110 @@ type(ESMF_KeywordEnforcer), optional:: keywordEnforcer ! must use keywords below end function ESMF_FieldEmptyCreate !------------------------------------------------------------------------------ + +!------------------------------------------------------------------------------ +^undef ESMF_METHOD +^define ESMF_METHOD "ESMF_FieldEmptyReset" +!BOP +! !IROUTINE: ESMF_FieldEmptyReset - Reset a Field back to an earlier status. + +! !INTERFACE: + subroutine ESMF_FieldEmptyReset(field, status, keywordEnforcer, vm, rc) + +! +! !ARGUMENTS: + type(ESMF_Field), intent(inout) :: field + type(ESMF_FieldStatus_Flag), intent(in) :: status +type(ESMF_KeywordEnforcer), optional:: keywordEnforcer ! must use keywords below + type(ESMF_VM), intent(in), optional :: vm + integer, intent(out), optional :: rc +! +! +! !DESCRIPTION: +! Reset an {\tt ESMF\_Field} to a less complete status. After this +! operation, methods appropriate to the new status can be used on the Field. +! For example, if reset to status {\tt ESMF\_FIELDSTATUS\_EMPTY}, then {\tt ESMF\_FieldEmpySet()} +! could be used to set a new Grid in the Field. +! +! The arguments are: +! \begin{description} +! \item [field] +! The {\tt ESMF\_Field} object to reset. +! \item [status] +! The new status to set the Field to. +! \item[{[vm]}] +! If present, the Field object will only be accessed, and the Grid object +! set, on those PETs contained in the specified {\tt ESMF\_VM} object. +! The default is to assume the VM of the current context. +! \item [{[rc]}] +! Return code; equals {\tt ESMF\_SUCCESS} if there are no errors. +! \end{description} +! +!EOP +!------------------------------------------------------------------------------ + type(ESMF_FieldStatus_Flag) :: currStatus + integer :: localrc + type(ESMF_Pointer) :: vmThis + logical :: actualFlag + + if(present(rc)) rc = ESMF_RC_NOT_IMPL + localrc = ESMF_RC_NOT_IMPL + + ESMF_INIT_CHECK_DEEP(ESMF_FieldGetInit,field,rc) + + ! Error check status + if(status == ESMF_FIELDSTATUS_UNINIT) then + call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_WRONG, & + msg="FieldEmptyReset - cannot reset a Field to an uninitialized status.", & + ESMF_CONTEXT, rcToReturn=rc) + return + endif + + + ! Must make sure the local PET is associated with an actual member + actualFlag = .true. + if (present(vm)) then + ESMF_INIT_CHECK_DEEP(ESMF_VMGetInit, vm, rc) + call ESMF_VMGetThis(vm, vmThis) + if (vmThis == ESMF_NULL_POINTER) then + actualFlag = .false. ! local PET is not for an actual member + endif + endif + + ! Just return success, if not an actual member + if (.not. actualFlag) then + if(present(rc)) rc = ESMF_SUCCESS + return + endif + + ! Get field's current status + call ESMF_FieldGet(field, status=currStatus, rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, rcToReturn=rc)) return + + + ! Change Field based on new status and current status + if (status == ESMF_FIELDSTATUS_EMPTY) then + + else if (status == ESMF_FIELDSTATUS_GRIDSET) then + + else if (status == ESMF_FIELDSTATUS_COMPLETE) then + + else + call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_WRONG, & + msg="unknown status type", & + ESMF_CONTEXT, rcToReturn=rc) + return + endif + + ! Set new status + field%ftypep%status = status + + ! Return success + if(present(rc)) rc = ESMF_SUCCESS + + end subroutine ESMF_FieldEmptyReset +!------------------------------------------------------------------------------ !------------------------------------------------------------------------------ ^undef ESMF_METHOD ^define ESMF_METHOD "ESMF_FieldEmptySetGeom" From deca50e5f176dea348e88b943ab699097911826a Mon Sep 17 00:00:00 2001 From: Gerhard Theurich Date: Tue, 12 Nov 2024 08:45:27 -0800 Subject: [PATCH 125/207] Correctly handle skipping of top level State items that are not handled by during specific instance of the ESMF_ReconcileSerializeAll() call. --- .../src/ESMF_StateReconcile.F90 | 70 ++++++++++++++++--- 1 file changed, 60 insertions(+), 10 deletions(-) diff --git a/src/Superstructure/StateReconcile/src/ESMF_StateReconcile.F90 b/src/Superstructure/StateReconcile/src/ESMF_StateReconcile.F90 index 014b19adfe..7dffad581c 100644 --- a/src/Superstructure/StateReconcile/src/ESMF_StateReconcile.F90 +++ b/src/Superstructure/StateReconcile/src/ESMF_StateReconcile.F90 @@ -4477,6 +4477,7 @@ subroutine ESMF_ReconcileSerializeAll(state, vm, vmid, siwrap, & type(ESMF_VMId) :: vmIdItem type(ESMF_Pointer) :: thisItem logical :: isFlag + integer :: numActualItems ! XMRKX ! @@ -4515,6 +4516,9 @@ subroutine ESMF_ReconcileSerializeAll(state, vm, vmid, siwrap, & ! Set flag to only check size inqflag = ESMF_INQUIREONLY + + numActualItems = 0 + ! Loop State items computing size do item=1,numStateItems @@ -4524,9 +4528,6 @@ subroutine ESMF_ReconcileSerializeAll(state, vm, vmid, siwrap, & ! Get item type itemType = stateitem%otype%ot - ! Add item type's size - sizeBuffer = sizeBuffer + ESMF_SIZEOF_DEFINT - ! Init itemSize to 0, so when we ask for the offset, ! we are also getting the size itemSize=0 @@ -4572,6 +4573,8 @@ subroutine ESMF_ReconcileSerializeAll(state, vm, vmid, siwrap, & rcToReturn=rc)) return end block #endif + else + cycle endif case (ESMF_STATEITEM_FIELD%ot) call ESMF_FieldGet(stateItem%datap%fp, vm=vmItem, rc=localrc) @@ -4612,6 +4615,8 @@ subroutine ESMF_ReconcileSerializeAll(state, vm, vmid, siwrap, & rcToReturn=rc)) return end block #endif + else + cycle endif case (ESMF_STATEITEM_ARRAY%ot) call ESMF_ArrayGet(stateItem%datap%ap, vm=vmItem, rc=localrc) @@ -4652,6 +4657,8 @@ subroutine ESMF_ReconcileSerializeAll(state, vm, vmid, siwrap, & rcToReturn=rc)) return end block #endif + else + cycle endif case (ESMF_STATEITEM_ARRAYBUNDLE%ot) call ESMF_ArrayBundleGet(stateItem%datap%abp, vm=vmItem, rc=localrc) @@ -4692,6 +4699,8 @@ subroutine ESMF_ReconcileSerializeAll(state, vm, vmid, siwrap, & rcToReturn=rc)) return end block #endif + else + cycle endif case (ESMF_STATEITEM_STATE%ot) wrapper%statep => stateitem%datap%spp @@ -4734,6 +4743,8 @@ subroutine ESMF_ReconcileSerializeAll(state, vm, vmid, siwrap, & rcToReturn=rc)) return end block #endif + else + cycle endif case (ESMF_STATEITEM_ROUTEHANDLE%ot) ! Do nothing for RouteHandles. There is no need to reconcile them. @@ -4757,6 +4768,11 @@ subroutine ESMF_ReconcileSerializeAll(state, vm, vmid, siwrap, & rcToReturn=rc)) return end select + numActualItems = numActualItems + 1 + + ! Add item type's size + sizeBuffer = sizeBuffer + ESMF_SIZEOF_DEFINT + ! Update buffer size by itemSize sizeBuffer = sizeBuffer + itemSize enddo @@ -4778,7 +4794,7 @@ subroutine ESMF_ReconcileSerializeAll(state, vm, vmid, siwrap, & ! Put item count in buffer buffer(posBuffer:posBuffer+ESMF_SIZEOF_DEFINT-1) = transfer ( & - source=numStateItems, & + source=numActualItems, & mold=buffer(0:ESMF_SIZEOF_DEFINT-1)) posBuffer = posbuffer + ESMF_SIZEOF_DEFINT @@ -4794,12 +4810,6 @@ subroutine ESMF_ReconcileSerializeAll(state, vm, vmid, siwrap, & ! Get item type itemType = stateitem%otype%ot - ! Add item type to buffer - buffer(posBuffer:posBuffer+ESMF_SIZEOF_DEFINT-1) = transfer (& - source=itemType, & - mold =buffer(0:ESMF_SIZEOF_DEFINT-1)) - posBuffer = posbuffer + ESMF_SIZEOF_DEFINT - ! Add serialized items select case (itemType) case (ESMF_STATEITEM_FIELDBUNDLE%ot) @@ -4820,6 +4830,12 @@ subroutine ESMF_ReconcileSerializeAll(state, vm, vmid, siwrap, & endif if (isFlag) then ! object has the correct VMId -> serialize + ! Add item type to buffer + buffer(posBuffer:posBuffer+ESMF_SIZEOF_DEFINT-1) = transfer (& + source=itemType, & + mold =buffer(0:ESMF_SIZEOF_DEFINT-1)) + posBuffer = posbuffer + ESMF_SIZEOF_DEFINT + if (debug) then print *, ' PET', localPet, & ' Getting FieldBundle pos=',posBuffer @@ -4830,6 +4846,8 @@ subroutine ESMF_ReconcileSerializeAll(state, vm, vmid, siwrap, & rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & rcToReturn=rc)) return + else + cycle endif case (ESMF_STATEITEM_FIELD%ot) call ESMF_FieldGet(stateItem%datap%fp, vm=vmItem, rc=localrc) @@ -4849,6 +4867,12 @@ subroutine ESMF_ReconcileSerializeAll(state, vm, vmid, siwrap, & endif if (isFlag) then ! object has the correct VMId -> serialize + ! Add item type to buffer + buffer(posBuffer:posBuffer+ESMF_SIZEOF_DEFINT-1) = transfer (& + source=itemType, & + mold =buffer(0:ESMF_SIZEOF_DEFINT-1)) + posBuffer = posbuffer + ESMF_SIZEOF_DEFINT + if (debug) then print *, ' PET', localPet, & ' Getting Field pos=',posBuffer @@ -4859,6 +4883,8 @@ subroutine ESMF_ReconcileSerializeAll(state, vm, vmid, siwrap, & rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & rcToReturn=rc)) return + else + cycle endif case (ESMF_STATEITEM_ARRAY%ot) call ESMF_ArrayGet(stateItem%datap%ap, vm=vmItem, rc=localrc) @@ -4878,6 +4904,12 @@ subroutine ESMF_ReconcileSerializeAll(state, vm, vmid, siwrap, & endif if (isFlag) then ! object has the correct VMId -> serialize + ! Add item type to buffer + buffer(posBuffer:posBuffer+ESMF_SIZEOF_DEFINT-1) = transfer (& + source=itemType, & + mold =buffer(0:ESMF_SIZEOF_DEFINT-1)) + posBuffer = posbuffer + ESMF_SIZEOF_DEFINT + if (debug) then print *, ' PET', localPet, & ' Getting Array pos=',posBuffer @@ -4888,6 +4920,8 @@ subroutine ESMF_ReconcileSerializeAll(state, vm, vmid, siwrap, & localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & rcToReturn=rc)) return + else + cycle endif case (ESMF_STATEITEM_ARRAYBUNDLE%ot) call ESMF_ArrayBundleGet(stateItem%datap%abp, vm=vmItem, rc=localrc) @@ -4907,6 +4941,12 @@ subroutine ESMF_ReconcileSerializeAll(state, vm, vmid, siwrap, & endif if (isFlag) then ! object has the correct VMId -> serialize + ! Add item type to buffer + buffer(posBuffer:posBuffer+ESMF_SIZEOF_DEFINT-1) = transfer (& + source=itemType, & + mold =buffer(0:ESMF_SIZEOF_DEFINT-1)) + posBuffer = posbuffer + ESMF_SIZEOF_DEFINT + if (debug) then print *, ' PET', localPet, & ' Getting ArrayBundle pos=',posBuffer @@ -4917,6 +4957,8 @@ subroutine ESMF_ReconcileSerializeAll(state, vm, vmid, siwrap, & localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & rcToReturn=rc)) return + else + cycle endif case (ESMF_STATEITEM_STATE%ot) wrapper%statep => stateitem%datap%spp @@ -4938,6 +4980,12 @@ subroutine ESMF_ReconcileSerializeAll(state, vm, vmid, siwrap, & endif if (isFlag) then ! object has the correct VMId -> serialize + ! Add item type to buffer + buffer(posBuffer:posBuffer+ESMF_SIZEOF_DEFINT-1) = transfer (& + source=itemType, & + mold =buffer(0:ESMF_SIZEOF_DEFINT-1)) + posBuffer = posbuffer + ESMF_SIZEOF_DEFINT + if (debug) then print *, ' PET', localPet, & ' Getting State pos=',posBuffer @@ -4948,6 +4996,8 @@ subroutine ESMF_ReconcileSerializeAll(state, vm, vmid, siwrap, & rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & rcToReturn=rc)) return + else + cycle endif case (ESMF_STATEITEM_ROUTEHANDLE%ot) ! Do nothing for RouteHandles. There is no need to reconcile them. From edbf358d4b05a7d7ac3229e5956587d57d35cb13 Mon Sep 17 00:00:00 2001 From: Gerhard Theurich Date: Tue, 12 Nov 2024 12:08:39 -0800 Subject: [PATCH 126/207] Implement the "keySuper" option to ESMF_VMIdCompare() that allows testing for superset condition between VMId keys. --- src/Infrastructure/VM/include/ESMCI_VM.h | 3 +- src/Infrastructure/VM/interface/ESMCI_VM_F.C | 8 +++-- src/Infrastructure/VM/interface/ESMF_VM.F90 | 19 ++++++++++-- src/Infrastructure/VM/src/ESMCI_VM.C | 32 +++++++++++--------- 4 files changed, 41 insertions(+), 21 deletions(-) diff --git a/src/Infrastructure/VM/include/ESMCI_VM.h b/src/Infrastructure/VM/include/ESMCI_VM.h index d3a006f654..6485784abf 100644 --- a/src/Infrastructure/VM/include/ESMCI_VM.h +++ b/src/Infrastructure/VM/include/ESMCI_VM.h @@ -82,7 +82,8 @@ class VMId { namespace ESMCI { // ESMCI::VMId methods: -bool VMIdCompare(const VMId *vmID1, const VMId *vmID2, bool keyOnly=false); +bool VMIdCompare(const VMId *vmID1, const VMId *vmID2, bool keyOnly=false, + bool keySuper=false); bool VMIdIsLocalPetActive(const VMId *vmID); bool VMIdLessThan(const VMId *vmID1, const VMId *vmID2); int VMIdCopy(VMId *vmIDdst, VMId *vmIDsrc); diff --git a/src/Infrastructure/VM/interface/ESMCI_VM_F.C b/src/Infrastructure/VM/interface/ESMCI_VM_F.C index dcddc63950..68fe1a3a68 100644 --- a/src/Infrastructure/VM/interface/ESMCI_VM_F.C +++ b/src/Infrastructure/VM/interface/ESMCI_VM_F.C @@ -1660,7 +1660,8 @@ extern "C" { } void FTN_X(c_esmc_vmidcompare)(ESMCI::VMId **vmid1, ESMCI::VMId **vmid2, - ESMC_Logical *keyOnly, ESMC_Logical *result, int *rc){ + ESMC_Logical *keyOnly, ESMC_Logical *keySuper, ESMC_Logical *result, + int *rc){ #undef ESMC_METHOD #define ESMC_METHOD "c_esmc_vmidcompare()" // Initialize return code; assume routine not implemented @@ -1670,9 +1671,12 @@ extern "C" { ESMCI_NULL_CHECK_PRC(vmid2, rc) ESMCI_NULL_CHECK_PRC(result, rc) bool keyOnlyOpt = false; // default + bool keySuperOpt = false; // default if (ESMC_NOT_PRESENT_FILTER(keyOnly) != ESMC_NULL_POINTER) if (*keyOnly == ESMF_TRUE) keyOnlyOpt = true; - bool resultBool = ESMCI::VMIdCompare(*vmid1, *vmid2, keyOnlyOpt); + if (ESMC_NOT_PRESENT_FILTER(keySuper) != ESMC_NULL_POINTER) + if (*keySuper == ESMF_TRUE) keySuperOpt = true; + bool resultBool = ESMCI::VMIdCompare(*vmid1, *vmid2, keyOnlyOpt, keySuperOpt); *result = resultBool ? ESMF_TRUE : ESMF_FALSE; // return successfully if (rc!=NULL) *rc = ESMF_SUCCESS; diff --git a/src/Infrastructure/VM/interface/ESMF_VM.F90 b/src/Infrastructure/VM/interface/ESMF_VM.F90 index c79810b8a8..025a1521de 100644 --- a/src/Infrastructure/VM/interface/ESMF_VM.F90 +++ b/src/Infrastructure/VM/interface/ESMF_VM.F90 @@ -10354,7 +10354,7 @@ end subroutine ESMF_VMPlanMinThreads ! !IROUTINE: ESMF_VMIdCompare - Compare two ESMF_VMId objects ! !INTERFACE: - function ESMF_VMIdCompare(vmId1, vmId2, keyOnly, rc) + function ESMF_VMIdCompare(vmId1, vmId2, keyOnly, keySuper, rc) ! ! !RETURN VALUE: logical :: ESMF_VMIdCompare @@ -10363,6 +10363,7 @@ function ESMF_VMIdCompare(vmId1, vmId2, keyOnly, rc) type(ESMF_VMId), intent(in) :: vmId1 type(ESMF_VMId), intent(in) :: vmId2 logical, intent(in), optional :: keyOnly + logical, intent(in), optional :: keySuper integer, intent(out), optional :: rc ! ! !DESCRIPTION: @@ -10377,6 +10378,13 @@ function ESMF_VMIdCompare(vmId1, vmId2, keyOnly, rc) ! \item[{[keyOnly]}] ! For {\tt .true.} only compare the vmKey parts. Default is ! {\tt .false.}. +! \item[{[keySuper]}] +! Only considered when {\tt keyOnly=.true.}!!! +! For {\tt .true.} return {\tt .true.} for {\tt vmId1} keys whose active +! bits are a superset (not necessarily strict) of bits active in +! {\tt vmId2}. Return {\tt .false.} otherwise. +! Default is {\tt .false.}, i.e. an exact key match is needed to return +! {\tt .true.}. ! \item[{[rc]}] ! Return code; equals {\tt ESMF\_SUCCESS} if there are no errors. ! \end{description} @@ -10384,7 +10392,7 @@ function ESMF_VMIdCompare(vmId1, vmId2, keyOnly, rc) !EOPI !------------------------------------------------------------------------------ integer :: localrc ! local return code - type(ESMF_Logical) :: tf, keyOnlyOpt + type(ESMF_Logical) :: tf, keyOnlyOpt, keySuperOpt ! initialize return code; assume routine not implemented localrc = ESMF_RC_NOT_IMPL @@ -10395,8 +10403,13 @@ function ESMF_VMIdCompare(vmId1, vmId2, keyOnly, rc) if (keyOnly) keyOnlyOpt = ESMF_TRUE endif + keySuperOpt = ESMF_FALSE + if (present(keySuper)) then + if (keySuper) keySuperOpt = ESMF_TRUE + endif + ! Call into the C++ interface - call c_ESMC_VMIdCompare(vmId1, vmId2, keyOnlyOpt, tf, localrc) + call c_ESMC_VMIdCompare(vmId1, vmId2, keyOnlyOpt, keySuperOpt, tf, localrc) ESMF_VMIdCompare = tf == ESMF_TRUE if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return diff --git a/src/Infrastructure/VM/src/ESMCI_VM.C b/src/Infrastructure/VM/src/ESMCI_VM.C index 9a0bcfa31d..4533196705 100644 --- a/src/Infrastructure/VM/src/ESMCI_VM.C +++ b/src/Infrastructure/VM/src/ESMCI_VM.C @@ -139,19 +139,19 @@ static bool esmfFinalized = false; #undef ESMC_METHOD #define ESMC_METHOD "ESMCI::VMKeyCompare()" -static bool VMKeyCompare(unsigned char *vmKey1, unsigned char *vmKey2){ +static bool VMKeyCompare(unsigned char *vmKey1, unsigned char *vmKey2, + bool super=false){ if (vmKey1==vmKey2) return true; // quick return for identical pointers -#if 1 - return std::memcmp(vmKey1, vmKey2, vmKeyWidth) == 0; -#else - int i; - for (i=0; ivmKey, vmID2->vmKey); + return VMKeyCompare(vmID1->vmKey, vmID2->vmKey, keySuper); } //----------------------------------------------------------------------------- From 0e075dc8881f46982be0264399c76ad5d3734b74 Mon Sep 17 00:00:00 2001 From: Gerhard Theurich Date: Tue, 12 Nov 2024 12:54:18 -0800 Subject: [PATCH 127/207] Leverage testing for superset vmKey to correctly decide which vmIDs need to be handled during ESMF_ReconcileMultiCompCase(). --- .../src/ESMF_StateReconcile.F90 | 42 ++++++++++++++----- 1 file changed, 31 insertions(+), 11 deletions(-) diff --git a/src/Superstructure/StateReconcile/src/ESMF_StateReconcile.F90 b/src/Superstructure/StateReconcile/src/ESMF_StateReconcile.F90 index 7dffad581c..10e5958073 100644 --- a/src/Superstructure/StateReconcile/src/ESMF_StateReconcile.F90 +++ b/src/Superstructure/StateReconcile/src/ESMF_StateReconcile.F90 @@ -936,26 +936,22 @@ subroutine ESMF_StateReconcile_driver(state, vm, rc) write(msgStr,*) "ESMF_StateReconcile_driver() size(vmids_send): ", & size(vmids_send) call ESMF_LogWrite(msgStr, ESMF_LOGMSG_DEBUG, rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, & + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & rcToReturn=rc)) return write(msgStr,*) "ESMF_StateReconcile_driver() size(vmIdMap): ", & size(vmIdMap) call ESMF_LogWrite(msgStr, ESMF_LOGMSG_DEBUG, rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, & + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & rcToReturn=rc)) return write(msgStr,*) "ESMF_StateReconcile_driver() size(vmintids_send): ", & size(vmintids_send) call ESMF_LogWrite(msgStr, ESMF_LOGMSG_DEBUG, rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, & + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & rcToReturn=rc)) return write(msgStr,*) "ESMF_StateReconcile_driver() local-singleCompCaseFlag: ", & singleCompCaseFlag call ESMF_LogWrite(msgStr, ESMF_LOGMSG_DEBUG, rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, & + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & rcToReturn=rc)) return end block #endif @@ -1324,15 +1320,39 @@ subroutine ESMF_ReconcileMultiCompCase(state, vm, vmIdMap, attreconflag, & if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & rcToReturn=rc)) return +#ifdef RECONCILE_LOG_on + call ESMF_VMIdLog(vmId, prefix="ESMF_ReconcileMultiCompCase() context: ", & + logMsgFlag=ESMF_LOGMSG_DEBUG, rc=localrc) ! vmId of current VM context + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & + rcToReturn=rc)) return +#endif + allocate(todoList(size(vmidMap))) todoCount=0 do i=1, size(vmidMap) - ! see if vmIdMap(i) has the same vmKey as the current VM context - isFlag = ESMF_VMIdCompare(vmIdMap(i), vmId, keyOnly=.true., rc=localrc) + ! see if vmIdMap(i) vmKey is a superset of the current context vmKey + isFlag = ESMF_VMIdCompare(vmIdMap(i), vmId, keyOnly=.true., & + keySuper=.true., rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & rcToReturn=rc)) return +#ifdef RECONCILE_LOG_on + block + character(160) :: msgStr + write(msgStr,*) "ESMF_ReconcileMultiCompCase vmIdMap(", i, "): " + call ESMF_VMIdLog(vmIdMap(i), prefix=trim(msgStr), & + logMsgFlag=ESMF_LOGMSG_DEBUG, rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & + rcToReturn=rc)) return + write(msgStr,*) "ESMF_ReconcileMultiCompCase vmIdMap(", i, "): "// & + " is superset: ", isFlag + call ESMF_LogWrite(trim(msgStr), ESMF_LOGMSG_DEBUG, rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & + rcToReturn=rc)) return + end block +#endif if (.not.isFlag) then - ! vmIdMap(i) is from a component that needs to be handled here + ! objects on vmIdMap(i) are not defined on a superset of PETs of the + ! reconciling context -> needs to be done todoCount = todoCount + 1 todoList(todoCount) = i ! add "i" to the todo list endif From 8a3464d343cdf47e35640e77f9d4c2532a841163 Mon Sep 17 00:00:00 2001 From: Gerhard Theurich Date: Tue, 12 Nov 2024 13:13:25 -0800 Subject: [PATCH 128/207] Clean-up and code simplification. --- .../src/ESMF_StateReconcile.F90 | 63 +++++-------------- 1 file changed, 17 insertions(+), 46 deletions(-) diff --git a/src/Superstructure/StateReconcile/src/ESMF_StateReconcile.F90 b/src/Superstructure/StateReconcile/src/ESMF_StateReconcile.F90 index 10e5958073..c13a2e1d80 100644 --- a/src/Superstructure/StateReconcile/src/ESMF_StateReconcile.F90 +++ b/src/Superstructure/StateReconcile/src/ESMF_StateReconcile.F90 @@ -1088,9 +1088,7 @@ subroutine ESMF_StateReconcile_driver(state, vm, rc) rcToReturn=rc)) return #else call ESMF_ReconcileMultiCompCase(state, vm=vm, vmIdMap=vmIdMap_ptr, & - attreconflag=attreconflag, siwrap=siwrap, ids_send=ids_send, & - vmids_send=vmids_send, vmintids_send=vmintids_send, & - nitems_buf=nitems_buf, rc=localrc) + attreconflag=attreconflag, siwrap=siwrap, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return #endif @@ -1112,9 +1110,7 @@ subroutine ESMF_StateReconcile_driver(state, vm, rc) ! ------------------------------------------------------------------------ #if 1 call ESMF_ReconcileMultiCompCase(state, vm=vm, vmIdMap=vmIdMap_ptr, & - attreconflag=attreconflag, siwrap=siwrap, ids_send=ids_send, & - vmids_send=vmids_send, vmintids_send=vmintids_send, & - nitems_buf=nitems_buf, rc=localrc) + attreconflag=attreconflag, siwrap=siwrap, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return #else @@ -1258,8 +1254,7 @@ end subroutine ESMF_StateReconcile_driver ! ! !INTERFACE: subroutine ESMF_ReconcileMultiCompCase(state, vm, vmIdMap, attreconflag, & - siwrap, ids_send, vmids_send, vmintids_send, nitems_buf, rc) -!!!TODO: clean out any dummy arguments not actually needed!!!! + siwrap, rc) ! ! !ARGUMENTS: type(ESMF_State), intent(inout) :: state @@ -1267,23 +1262,21 @@ subroutine ESMF_ReconcileMultiCompCase(state, vm, vmIdMap, attreconflag, & type(ESMF_VMId), pointer, intent(in) :: vmIdMap(:) type(ESMF_AttReconcileFlag), intent(in) :: attreconflag type(ESMF_StateItemWrap), pointer, intent(in) :: siwrap(:) - integer, pointer, intent(in) :: ids_send(:) - type(ESMF_VMId), pointer, intent(in) :: vmids_send(:) - integer, pointer, intent(in) :: vmintids_send(:) - integer, pointer, intent(in) :: nitems_buf(:) integer, intent(out) :: rc ! ! !DESCRIPTION: ! -! Handle the multi component reconciliation case. This is the expected -! situation under NUOPC rules. +! Handle the multi component reconciliation case. This is the general case +! supported by ESMF, where multiple components interact with the same State. ! ! The arguments are: ! \begin{description} ! \item[state] ! The {\tt ESMF\_State} to reconcile. ! \item[vm] -! The {\tt ESMF\_VM} object across which the state is reconciled. +! The {\tt ESMF\_VM} object across which to reconcile {\tt state}. +! \item[vmIdMap] +! List of {\tt ESMF\_VMId} objects present in {\tt state}. ! \item[attreconflag] ! Flag indicating whether attributes need to be reconciled. ! \item[siwrap] @@ -1293,13 +1286,10 @@ subroutine ESMF_ReconcileMultiCompCase(state, vm, vmIdMap, attreconflag, & ! \end{description} !EOPI - integer :: localrc - integer :: i, todoCount - logical :: isFlag - type(ESMF_VMId) :: vmId - - integer, allocatable :: todoList(:) ! holds integer vmIds to do - type(ESMF_VMId), pointer :: vmIdSingleComp + integer :: localrc, i + logical :: isFlag + type(ESMF_VMId) :: vmId + type(ESMF_VMId), pointer :: vmIdSingleComp rc = ESMF_SUCCESS @@ -1327,8 +1317,6 @@ subroutine ESMF_ReconcileMultiCompCase(state, vm, vmIdMap, attreconflag, & rcToReturn=rc)) return #endif - allocate(todoList(size(vmidMap))) - todoCount=0 do i=1, size(vmidMap) ! see if vmIdMap(i) vmKey is a superset of the current context vmKey isFlag = ESMF_VMIdCompare(vmIdMap(i), vmId, keyOnly=.true., & @@ -1353,31 +1341,14 @@ subroutine ESMF_ReconcileMultiCompCase(state, vm, vmIdMap, attreconflag, & if (.not.isFlag) then ! objects on vmIdMap(i) are not defined on a superset of PETs of the ! reconciling context -> needs to be done - todoCount = todoCount + 1 - todoList(todoCount) = i ! add "i" to the todo list + vmIdSingleComp => vmIdMap(i) + call ESMF_ReconcileSingleCompCase(state, vm=vm, vmId=vmIdSingleComp, & + attreconflag=attreconflag, siwrap=siwrap, rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & + rcToReturn=rc)) return endif enddo -#ifdef RECONCILE_LOG_on - block - character(160) :: msgStr - write(msgStr,*) "ESMF_ReconcileMultiCompCase todoCount=", todoCount - call ESMF_LogWrite(msgStr, ESMF_LOGMSG_DEBUG, rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & - rcToReturn=rc)) return - end block -#endif - - !TODO: Don't actually need these two separate loops first one will be - !TODO: enough, just directly call into the SingleCompCase from there! - do i=1, todoCount - vmIdSingleComp => vmIdMap(todoList(i)) - call ESMF_ReconcileSingleCompCase(state, vm=vm, vmId=vmIdSingleComp, & - attreconflag=attreconflag, siwrap=siwrap, rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & - rcToReturn=rc)) return - enddo - end subroutine ESMF_ReconcileMultiCompCase !------------------------------------------------------------------------------ From 557114dd0aa12d036daec5dcfd77ca748208f695 Mon Sep 17 00:00:00 2001 From: Gerhard Theurich Date: Tue, 12 Nov 2024 15:01:32 -0800 Subject: [PATCH 129/207] Code documentation, clean-up, and alignment internal APIs. --- .../src/ESMF_StateReconcile.F90 | 95 +++++++++---------- 1 file changed, 46 insertions(+), 49 deletions(-) diff --git a/src/Superstructure/StateReconcile/src/ESMF_StateReconcile.F90 b/src/Superstructure/StateReconcile/src/ESMF_StateReconcile.F90 index c13a2e1d80..5be6bfec28 100644 --- a/src/Superstructure/StateReconcile/src/ESMF_StateReconcile.F90 +++ b/src/Superstructure/StateReconcile/src/ESMF_StateReconcile.F90 @@ -1374,8 +1374,8 @@ subroutine ESMF_ReconcileBruteForce(state, vm, attreconflag, siwrap, & ! ! !DESCRIPTION: ! -! Handle the multi component reconciliation case. This is the expected -! situation under NUOPC rules. +! Brute force reconciliation across all of the PETs using Alltoall +! communications. This should be able to reconcile any conceivable situation. ! ! The arguments are: ! \begin{description} @@ -1735,10 +1735,9 @@ subroutine ESMF_ReconcileSingleCompCase(state, vm, vmId, attreconflag, siwrap, r ! \item[state] ! The {\tt ESMF\_State} to reconcile. ! \item[vm] -! The {\tt ESMF\_VM} object across which the state is reconciled. +! The {\tt ESMF\_VM} object across which to reconcile {\tt state}. ! \item[vmId] -! The {\tt ESMF\_VMId} of the single component who ownes all objects present -! in the state. +! The {\tt ESMF\_VMId} of the objects in {\tt state} to reconcile. ! \item[attreconflag] ! Flag indicating whether attributes need to be reconciled. ! \item[siwrap] @@ -1760,32 +1759,27 @@ subroutine ESMF_ReconcileSingleCompCase(state, vm, vmId, attreconflag, siwrap, r block character(ESMF_MAXSTR) :: stateName call ESMF_StateGet(state, name=stateName, rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, & + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & rcToReturn=rc)) return call ESMF_LogWrite("ESMF_ReconcileSingleCompCase() for State: "//trim(stateName), & ESMF_LOGMSG_DEBUG, rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, & + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & rcToReturn=rc)) return end block #endif call ESMF_VMGet(vm, petCount=petCount, localPet=localPet, 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_VMIdGet(vmId, leftMostOnBit=rootVas, 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 - ! search for PET in VM that executes on rootVas + ! search for PET in VM that executes on rootVas -> use as rootPet do rootPet=0, petCount-1 call ESMF_VMGet(vm, pet=rootPet, vas=vas, rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, & + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & rcToReturn=rc)) return if (vas==rootVas) exit ! found enddo @@ -1816,17 +1810,17 @@ subroutine ESMF_ReconcileSingleCompCase(state, vm, vmId, attreconflag, siwrap, r ! Serialize on rootPet if (localPet==rootPet) then - call ESMF_ReconcileSerializeAll(state, vm, vmId, siwrap, attreconflag, & + call ESMF_ReconcileSerializeAll(state, vm, vmId, attreconflag, siwrap, & buffer, 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 sizeBuffer(1) = size(buffer) endif ! Broadcast buffer across all PETs call ESMF_VMBroadcast(vm, sizeBuffer, count=1, rootPet=rootPet, 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 #ifdef RECONCILE_LOG_on block @@ -1842,31 +1836,30 @@ subroutine ESMF_ReconcileSingleCompCase(state, vm, vmId, attreconflag, siwrap, r call ESMF_VMBroadcast(vm, buffer, count=sizeBuffer(1), rootPet=rootPet, & 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 ! determine if local PET is active under the vmId call ESMF_VMIdGet(vmId, isLocalPetActive=isFlag, 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 #ifdef RECONCILE_LOG_on block character(160) :: msgStr write(msgStr,*) "SingleCompCase PET active isFlag=", isFlag call ESMF_LogWrite(msgStr, ESMF_LOGMSG_DEBUG, rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, & + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & rcToReturn=rc)) return end block #endif ! only inactive PETs deserialize the buffer received from rootPet if (.not.isFlag) then - call ESMF_ReconcileDeserializeAll(state, vm, buffer, attreconflag, & + call ESMF_ReconcileDeserializeAll(state, vm, attreconflag, buffer, & 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 endif ! Get rid of buffer @@ -2533,14 +2526,14 @@ end subroutine ESMF_ReconcileDeserialize ! !IROUTINE: ESMF_ReconcileDeserializeAll ! !INTERFACE: - subroutine ESMF_ReconcileDeserializeAll(state, vm, buffer, attreconflag, rc) + subroutine ESMF_ReconcileDeserializeAll(state, vm, attreconflag, buffer, rc) ! ! !ARGUMENTS: - type (ESMF_State), intent(inout):: state - type (ESMF_VM), intent(in) :: vm - character, pointer :: buffer(:) ! intent(in) - type(ESMF_AttReconcileFlag),intent(in) :: attreconflag - integer, intent(out) :: rc + type (ESMF_State), intent(inout) :: state + type (ESMF_VM), intent(in) :: vm + type(ESMF_AttReconcileFlag),intent(in):: attreconflag + character, pointer,intent(in) :: buffer(:) + integer, intent(out) :: rc ! ! !DESCRIPTION: ! Builds proxy items for each of the items in the buffer. @@ -2551,10 +2544,10 @@ subroutine ESMF_ReconcileDeserializeAll(state, vm, buffer, attreconflag, rc) ! {\tt ESMF\_State} to add proxy objects to. ! \item[vm] ! {\tt ESMF\_VM} to use. -! \item[buffer] -! Buffer of serialized State objects (intent(in)) ! \item[attreconflag] ! Flag to indicate attribute reconciliation. +! \item[buffer] +! Buffer of serialized State objects (intent(in)) ! \item[rc] ! Return code; equals {\tt ESMF\_SUCCESS} if there are no errors. ! \end{description} @@ -4423,16 +4416,16 @@ end subroutine ESMF_ReconcileSerialize ! !IROUTINE: ESMF_ReconcileSerializeAll ! ! !INTERFACE: - subroutine ESMF_ReconcileSerializeAll(state, vm, vmid, siwrap, & - attreconflag, buffer, rc) + subroutine ESMF_ReconcileSerializeAll(state, vm, vmid, attreconflag, siwrap, & + buffer, rc) ! ! !ARGUMENTS: type (ESMF_State), intent(in) :: state type (ESMF_VM), intent(in) :: vm - type (ESMF_VMId), pointer, intent(in) :: vmId ! vmId for which to serialize - type (ESMF_StateItemWrap), intent(in) :: siwrap(:) + type (ESMF_VMId), pointer, intent(in) :: vmId type(ESMF_AttReconcileFlag),intent(in) :: attreconflag - character, pointer :: buffer(:) + type (ESMF_StateItemWrap), intent(in) :: siwrap(:) + character, pointer :: buffer(:) integer, intent(out) :: rc ! ! !DESCRIPTION: @@ -4440,13 +4433,17 @@ subroutine ESMF_ReconcileSerializeAll(state, vm, vmid, siwrap, & ! The arguments are: ! \begin{description} ! \item[state] -! {\tt ESMF\_State} to collect information from. +! The {\tt ESMF\_State} to collect information from. +! \item[vm] +! The {\tt ESMF\_VM} object across which to reconcile {\tt state}. +! \item[vmId] +! The {\tt ESMF\_VMId} of the objects in {\tt state} to reconcile. ! \item[siwrap] -! State items in the state. -! \item[needs\_list] -! List of State items that need to be sent to other PETs +! List of local state items. ! \item[attreconflag] ! Flag to indicate attribute reconciliation. +! \item[buffer] +! Buffer ! \item[rc] ! Return code; equals {\tt ESMF\_SUCCESS} if there are no errors. ! \end{description} From 944cc3458e1b6a18212509e095a965298d8f16b7 Mon Sep 17 00:00:00 2001 From: Gerhard Theurich Date: Tue, 12 Nov 2024 15:03:23 -0800 Subject: [PATCH 130/207] Revert "Debug logging in Array::serialize() and Array::deserialize() to help" This reverts commit 3f86c8923081a993a6eb06d7099f29bb4b57f2ab. --- src/Infrastructure/Array/src/ESMCI_Array.C | 24 ---------------------- 1 file changed, 24 deletions(-) diff --git a/src/Infrastructure/Array/src/ESMCI_Array.C b/src/Infrastructure/Array/src/ESMCI_Array.C index 63389bdee1..cb57c7f4e7 100644 --- a/src/Infrastructure/Array/src/ESMCI_Array.C +++ b/src/Infrastructure/Array/src/ESMCI_Array.C @@ -4487,21 +4487,8 @@ int Array::serialize( *ip++ = distgridToPackedArrayMap[i]; *ip++ = tensorElementCount; *ip++ = replicatedDimCount; -// *ip++ = replicatedDimCount; } else ip += 3 + 2*tensorCount + 2*distgrid->getDimCount () + rank; -// ip += 4 + 2*tensorCount + 2*distgrid->getDimCount () + rank; - -if (inquireflag != ESMF_INQUIREONLY){ - std::stringstream msg; - msg << "Array::serialize():" << __LINE__ << " name: " << getName() - << " rank=" << rank - << " tensorCount=" << tensorCount - << " distgrid->getDimCount()=" << distgrid->getDimCount() - << " tensorElementCount=" << tensorElementCount - << " replicatedDimCount=" << *(ip-1); - ESMC_LogDefault.Write(msg.str(), ESMC_LOGMSG_DEBUG); -} // fix offset cp = (char *)ip; @@ -4593,17 +4580,6 @@ int Array::deserialize( distgridToPackedArrayMap[i] = *ip++; tensorElementCount = *ip++; replicatedDimCount = *ip++; -// ip++; -{ - std::stringstream msg; - msg << "Array::deserialize():" << __LINE__ << " name: " << getName() - << " rank=" << rank - << " tensorCount=" << tensorCount - << " distgrid->getDimCount()=" << distgrid->getDimCount() - << " tensorElementCount=" << tensorElementCount - << " replicatedDimCount=" << replicatedDimCount; - ESMC_LogDefault.Write(msg.str(), ESMC_LOGMSG_DEBUG); -} // fix offset cp = (char *)ip; From 8d5d752503c0231a3dd5651c560e6b07afb02e56 Mon Sep 17 00:00:00 2001 From: Gerhard Theurich Date: Tue, 12 Nov 2024 18:05:44 -0800 Subject: [PATCH 131/207] Complete handling of zapped but unrestored top-level proxies. Also add better comments to better document proxy zapping approach. --- .../src/ESMF_StateReconcile.F90 | 101 +++++++++++++----- 1 file changed, 76 insertions(+), 25 deletions(-) diff --git a/src/Superstructure/StateReconcile/src/ESMF_StateReconcile.F90 b/src/Superstructure/StateReconcile/src/ESMF_StateReconcile.F90 index 5be6bfec28..742cece744 100644 --- a/src/Superstructure/StateReconcile/src/ESMF_StateReconcile.F90 +++ b/src/Superstructure/StateReconcile/src/ESMF_StateReconcile.F90 @@ -3892,8 +3892,7 @@ end subroutine ESMF_ReconcileGetStateIDInfo ! !IROUTINE: ESMF_ReconcileInitialize ! ! !INTERFACE: - subroutine ESMF_ReconcileInitialize (state, vm, & - siwrap, nitems_all, rc) + subroutine ESMF_ReconcileInitialize(state, vm, siwrap, nitems_all, rc) ! ! !ARGUMENTS: type (ESMF_State), intent(inout) :: state @@ -5030,17 +5029,17 @@ subroutine ESMF_ReconcileZapProxies(state, rc) integer, intent(out), optional :: rc ! ! !DESCRIPTION: -! Proxy objects are identified and removed from the State. Information about -! the zapped proxies is kept in the State for later handling during the -! companion method ESMF_ReconcileZappedProxies(). +! All top-level proxy objects (regardless of type) are identified and removed +! from {\tt state}. Information about the zapped proxies is kept in the State +! for later handling during the companion method ESMF_ReconcileZappedProxies(). ! -! The arguments are: -! \begin{description} -! \item[state] -! The State from which to zap proxies. -! \item[{[rc]}] -! Return code; equals {\tt ESMF\_SUCCESS} if there are no errors. -! \end{description} +! The arguments are: +! \begin{description} +! \item[state] +! The State from which to zap proxies. +! \item[{[rc]}] +! Return code; equals {\tt ESMF\_SUCCESS} if there are no errors. +! \end{description} ! !EOPI integer :: localrc, i @@ -5187,25 +5186,26 @@ subroutine ESMF_ReconcileZappedProxies(state, rc) integer, intent(out), optional :: rc ! ! !DESCRIPTION: -! Proxy objects that have been zapped from the State during a previous -! call to the companion method ESMF_ReconcileZapProxies() must now be handled -! after the reconcile work is done. Potentially new proxies have been -! created, and the internal information of those new proxies must be copied -! under the old proxy wrappers, then old wrappers must replace the new ones +! Top-level proxy objects that have been zapped from the State during a +! previous call to the companion method ESMF_ReconcileZapProxies() must now be +! handled after the reconcile work is done. There is special handling for +! Field and FieldBundle objects for which new proxies have been +! created. The internal information of those new proxies must be copied +! under the old proxy wrappers. Old wrappers must replace the new ones ! inside the State. Finally the old inside members must be cleaned up. ! There is also a chance that zapped proxy are not associated with new proxy ! counter parts (e.g. if the actual objects have been removed from the State). ! In that case the old proxy object must be cleaned up for good by removing ! it from the garbage collection. ! -! The arguments are: -! \begin{description} -! \item[state] -! The State from which proxies have been zapped and must either be -! restored or completely removed from the garbage collection. -! \item[{[rc]}] -! Return code; equals {\tt ESMF\_SUCCESS} if there are no errors. -! \end{description} +! The arguments are: +! \begin{description} +! \item[state] +! The State from which proxies have been zapped and must either be +! restored or completely removed from the garbage collection. +! \item[{[rc]}] +! Return code; equals {\tt ESMF\_SUCCESS} if there are no errors. +! \end{description} ! !EOPI integer :: localrc, i, k @@ -5220,6 +5220,7 @@ subroutine ESMF_ReconcileZappedProxies(state, rc) type(ESMF_FieldType) :: tempFieldType type(ESMF_FieldBundle) :: tempFB type(ESMF_FieldBundleType) :: tempFBType + type(ESMF_State) :: wrapper ! Initialize return code; assume routine not implemented if (present(rc)) rc = ESMF_RC_NOT_IMPL @@ -5397,6 +5398,56 @@ subroutine ESMF_ReconcileZappedProxies(state, rc) ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) & return + else if (zapList(k)%si%otype==ESMF_STATEITEM_ARRAY) then +#ifdef RECONCILE_ZAP_LOG_on +call ESMF_ArrayGet(zapList(k)%si%datap%ap, name=name, rc=localrc) +if (ESMF_LogFoundError(localrc, & + ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, rcToReturn=rc)) & + return +call ESMF_LogWrite("ESMF_ReconcileZappedProxies(): destroy with noGarbage unrestored Array: "//trim(name), & + ESMF_LOGMSG_DEBUG, rc=localrc) +#endif + call ESMF_ArrayDestroy(zapList(k)%si%datap%ap, & + noGarbage=.true., rc=localrc) + if (ESMF_LogFoundError(localrc, & + ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, rcToReturn=rc)) & + return + else if (zapList(k)%si%otype==ESMF_STATEITEM_ARRAYBUNDLE) then +#ifdef RECONCILE_ZAP_LOG_on +call ESMF_ArrayBundleGet(zapList(k)%si%datap%abp, name=name, rc=localrc) +if (ESMF_LogFoundError(localrc, & + ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, rcToReturn=rc)) & + return +call ESMF_LogWrite("ESMF_ReconcileZappedProxies(): destroy with noGarbage unrestored ArrayBundle: "//trim(name), & + ESMF_LOGMSG_DEBUG, rc=localrc) +#endif + call ESMF_ArrayBundleDestroy(zapList(k)%si%datap%abp, & + noGarbage=.true., rc=localrc) + if (ESMF_LogFoundError(localrc, & + ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, rcToReturn=rc)) & + return + else if (zapList(k)%si%otype==ESMF_STATEITEM_STATE) then + wrapper%statep => zapList(k)%si%datap%spp + ESMF_INIT_SET_CREATED(wrapper) +#ifdef RECONCILE_ZAP_LOG_on +call ESMF_StateGet(wrapper, name=name, rc=localrc) +if (ESMF_LogFoundError(localrc, & + ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, rcToReturn=rc)) & + return +call ESMF_LogWrite("ESMF_ReconcileZappedProxies(): destroy with noGarbage unrestored State: "//trim(name), & + ESMF_LOGMSG_DEBUG, rc=localrc) +#endif + call ESMF_StateDestroy(wrapper, & + noGarbage=.true., rc=localrc) + if (ESMF_LogFoundError(localrc, & + ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, rcToReturn=rc)) & + return endif ! deallocate the associated StateItem if (associated(zapList(k)%si)) deallocate(zapList(k)%si) From 2c35d71d9f03cff7b7026b09dc297f3de2459256 Mon Sep 17 00:00:00 2001 From: Gerhard Theurich Date: Tue, 12 Nov 2024 18:24:55 -0800 Subject: [PATCH 132/207] Remove the proxy check for top-level items since it is not needed because top level proxies are zapped already. --- .../src/ESMF_StateReconcile.F90 | 142 +++++------------- 1 file changed, 40 insertions(+), 102 deletions(-) diff --git a/src/Superstructure/StateReconcile/src/ESMF_StateReconcile.F90 b/src/Superstructure/StateReconcile/src/ESMF_StateReconcile.F90 index 742cece744..4b6a83fd92 100644 --- a/src/Superstructure/StateReconcile/src/ESMF_StateReconcile.F90 +++ b/src/Superstructure/StateReconcile/src/ESMF_StateReconcile.F90 @@ -4462,7 +4462,6 @@ subroutine ESMF_ReconcileSerializeAll(state, vm, vmid, attreconflag, siwrap, & integer :: localPet, petCount, pet type(ESMF_VM) :: vmItem type(ESMF_VMId) :: vmIdItem - type(ESMF_Pointer) :: thisItem logical :: isFlag integer :: numActualItems @@ -4502,7 +4501,6 @@ subroutine ESMF_ReconcileSerializeAll(state, vm, vmid, attreconflag, siwrap, & ! Set flag to only check size inqflag = ESMF_INQUIREONLY - numActualItems = 0 @@ -4525,18 +4523,12 @@ subroutine ESMF_ReconcileSerializeAll(state, vm, vmid, attreconflag, siwrap, & call ESMF_FieldBundleGet(stateItem%datap%fbp, vm=vmItem, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & rcToReturn=rc)) return - call ESMF_VMGetThis(vmItem, thisItem, rc=localrc) + call ESMF_VMGetVMId(vmItem, vmId=vmIdItem, rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & + rcToReturn=rc)) return + isFlag = ESMF_VMIdCompare(vmIdItem, vmId, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & rcToReturn=rc)) return - isFlag = (thisItem /= ESMF_NULL_POINTER) ! not a proxy - if (isFlag) then - call ESMF_VMGetVMId(vmItem, vmId=vmIdItem, rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & - rcToReturn=rc)) return - isFlag = ESMF_VMIdCompare(vmIdItem, vmId, rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & - rcToReturn=rc)) return - endif if (isFlag) then ! object has the correct VMId -> serialize call ESMF_FieldBundleSerialize(stateItem%datap%fbp, & @@ -4567,18 +4559,12 @@ subroutine ESMF_ReconcileSerializeAll(state, vm, vmid, attreconflag, siwrap, & call ESMF_FieldGet(stateItem%datap%fp, vm=vmItem, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & rcToReturn=rc)) return - call ESMF_VMGetThis(vmItem, thisItem, rc=localrc) + call ESMF_VMGetVMId(vmItem, vmId=vmIdItem, rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & + rcToReturn=rc)) return + isFlag = ESMF_VMIdCompare(vmIdItem, vmId, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & rcToReturn=rc)) return - isFlag = (thisItem /= ESMF_NULL_POINTER) ! not a proxy - if (isFlag) then - call ESMF_VMGetVMId(vmItem, vmId=vmIdItem, rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & - rcToReturn=rc)) return - isFlag = ESMF_VMIdCompare(vmIdItem, vmId, rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & - rcToReturn=rc)) return - endif if (isFlag) then ! object has the correct VMId -> serialize call ESMF_FieldSerialize(stateItem%datap%fp, & @@ -4609,18 +4595,12 @@ subroutine ESMF_ReconcileSerializeAll(state, vm, vmid, attreconflag, siwrap, & call ESMF_ArrayGet(stateItem%datap%ap, vm=vmItem, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & rcToReturn=rc)) return - call ESMF_VMGetThis(vmItem, thisItem, rc=localrc) + call ESMF_VMGetVMId(vmItem, vmId=vmIdItem, rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & + rcToReturn=rc)) return + isFlag = ESMF_VMIdCompare(vmIdItem, vmId, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & rcToReturn=rc)) return - isFlag = (thisItem /= ESMF_NULL_POINTER) ! not a proxy - if (isFlag) then - call ESMF_VMGetVMId(vmItem, vmId=vmIdItem, rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & - rcToReturn=rc)) return - isFlag = ESMF_VMIdCompare(vmIdItem, vmId, rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & - rcToReturn=rc)) return - endif if (isFlag) then ! object has the correct VMId -> serialize call c_ESMC_ArraySerialize(stateitem%datap%ap, & @@ -4651,18 +4631,12 @@ subroutine ESMF_ReconcileSerializeAll(state, vm, vmid, attreconflag, siwrap, & call ESMF_ArrayBundleGet(stateItem%datap%abp, vm=vmItem, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & rcToReturn=rc)) return - call ESMF_VMGetThis(vmItem, thisItem, rc=localrc) + call ESMF_VMGetVMId(vmItem, vmId=vmIdItem, rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & + rcToReturn=rc)) return + isFlag = ESMF_VMIdCompare(vmIdItem, vmId, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & rcToReturn=rc)) return - isFlag = (thisItem /= ESMF_NULL_POINTER) ! not a proxy - if (isFlag) then - call ESMF_VMGetVMId(vmItem, vmId=vmIdItem, rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & - rcToReturn=rc)) return - isFlag = ESMF_VMIdCompare(vmIdItem, vmId, rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & - rcToReturn=rc)) return - endif if (isFlag) then ! object has the correct VMId -> serialize call c_ESMC_ArrayBundleSerialize(stateitem%datap%abp, & @@ -4695,18 +4669,12 @@ subroutine ESMF_ReconcileSerializeAll(state, vm, vmid, attreconflag, siwrap, & call ESMF_StateGet(wrapper, vm=vmItem, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & rcToReturn=rc)) return - call ESMF_VMGetThis(vmItem, thisItem, rc=localrc) + call ESMF_VMGetVMId(vmItem, vmId=vmIdItem, rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & + rcToReturn=rc)) return + isFlag = ESMF_VMIdCompare(vmIdItem, vmId, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & rcToReturn=rc)) return - isFlag = (thisItem /= ESMF_NULL_POINTER) ! not a proxy - if (isFlag) then - call ESMF_VMGetVMId(vmItem, vmId=vmIdItem, rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & - rcToReturn=rc)) return - isFlag = ESMF_VMIdCompare(vmIdItem, vmId, rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & - rcToReturn=rc)) return - endif if (isFlag) then ! object has the correct VMId -> serialize call ESMF_StateSerialize(wrapper, & @@ -4803,18 +4771,12 @@ subroutine ESMF_ReconcileSerializeAll(state, vm, vmid, attreconflag, siwrap, & call ESMF_FieldBundleGet(stateItem%datap%fbp, vm=vmItem, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & rcToReturn=rc)) return - call ESMF_VMGetThis(vmItem, thisItem, rc=localrc) + call ESMF_VMGetVMId(vmItem, vmId=vmIdItem, rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & + rcToReturn=rc)) return + isFlag = ESMF_VMIdCompare(vmIdItem, vmId, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & rcToReturn=rc)) return - isFlag = (thisItem /= ESMF_NULL_POINTER) ! not a proxy - if (isFlag) then - call ESMF_VMGetVMId(vmItem, vmId=vmIdItem, rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & - rcToReturn=rc)) return - isFlag = ESMF_VMIdCompare(vmIdItem, vmId, rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & - rcToReturn=rc)) return - endif if (isFlag) then ! object has the correct VMId -> serialize ! Add item type to buffer @@ -4840,18 +4802,12 @@ subroutine ESMF_ReconcileSerializeAll(state, vm, vmid, attreconflag, siwrap, & call ESMF_FieldGet(stateItem%datap%fp, vm=vmItem, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & rcToReturn=rc)) return - call ESMF_VMGetThis(vmItem, thisItem, rc=localrc) + call ESMF_VMGetVMId(vmItem, vmId=vmIdItem, rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & + rcToReturn=rc)) return + isFlag = ESMF_VMIdCompare(vmIdItem, vmId, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & rcToReturn=rc)) return - isFlag = (thisItem /= ESMF_NULL_POINTER) ! not a proxy - if (isFlag) then - call ESMF_VMGetVMId(vmItem, vmId=vmIdItem, rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & - rcToReturn=rc)) return - isFlag = ESMF_VMIdCompare(vmIdItem, vmId, rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & - rcToReturn=rc)) return - endif if (isFlag) then ! object has the correct VMId -> serialize ! Add item type to buffer @@ -4877,18 +4833,12 @@ subroutine ESMF_ReconcileSerializeAll(state, vm, vmid, attreconflag, siwrap, & call ESMF_ArrayGet(stateItem%datap%ap, vm=vmItem, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & rcToReturn=rc)) return - call ESMF_VMGetThis(vmItem, thisItem, rc=localrc) + call ESMF_VMGetVMId(vmItem, vmId=vmIdItem, rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & + rcToReturn=rc)) return + isFlag = ESMF_VMIdCompare(vmIdItem, vmId, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & rcToReturn=rc)) return - isFlag = (thisItem /= ESMF_NULL_POINTER) ! not a proxy - if (isFlag) then - call ESMF_VMGetVMId(vmItem, vmId=vmIdItem, rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & - rcToReturn=rc)) return - isFlag = ESMF_VMIdCompare(vmIdItem, vmId, rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & - rcToReturn=rc)) return - endif if (isFlag) then ! object has the correct VMId -> serialize ! Add item type to buffer @@ -4914,18 +4864,12 @@ subroutine ESMF_ReconcileSerializeAll(state, vm, vmid, attreconflag, siwrap, & call ESMF_ArrayBundleGet(stateItem%datap%abp, vm=vmItem, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & rcToReturn=rc)) return - call ESMF_VMGetThis(vmItem, thisItem, rc=localrc) + call ESMF_VMGetVMId(vmItem, vmId=vmIdItem, rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & + rcToReturn=rc)) return + isFlag = ESMF_VMIdCompare(vmIdItem, vmId, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & rcToReturn=rc)) return - isFlag = (thisItem /= ESMF_NULL_POINTER) ! not a proxy - if (isFlag) then - call ESMF_VMGetVMId(vmItem, vmId=vmIdItem, rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & - rcToReturn=rc)) return - isFlag = ESMF_VMIdCompare(vmIdItem, vmId, rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & - rcToReturn=rc)) return - endif if (isFlag) then ! object has the correct VMId -> serialize ! Add item type to buffer @@ -4953,18 +4897,12 @@ subroutine ESMF_ReconcileSerializeAll(state, vm, vmid, attreconflag, siwrap, & call ESMF_StateGet(wrapper, vm=vmItem, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & rcToReturn=rc)) return - call ESMF_VMGetThis(vmItem, thisItem, rc=localrc) + call ESMF_VMGetVMId(vmItem, vmId=vmIdItem, rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & + rcToReturn=rc)) return + isFlag = ESMF_VMIdCompare(vmIdItem, vmId, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & rcToReturn=rc)) return - isFlag = (thisItem /= ESMF_NULL_POINTER) ! not a proxy - if (isFlag) then - call ESMF_VMGetVMId(vmItem, vmId=vmIdItem, rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & - rcToReturn=rc)) return - isFlag = ESMF_VMIdCompare(vmIdItem, vmId, rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & - rcToReturn=rc)) return - endif if (isFlag) then ! object has the correct VMId -> serialize ! Add item type to buffer From 4decd3f51ebc59e5c36127013a846839a94e0bfa Mon Sep 17 00:00:00 2001 From: Gerhard Theurich Date: Wed, 13 Nov 2024 14:05:25 -0800 Subject: [PATCH 133/207] In ESMF_ReconcileSingleCompCase() Construct a list of items that need to be handled by the root PET. Call ESMF_ReconcileSerializeAll() with that list for more efficiency. --- .../src/ESMF_StateReconcile.F90 | 654 ++++++------------ 1 file changed, 226 insertions(+), 428 deletions(-) diff --git a/src/Superstructure/StateReconcile/src/ESMF_StateReconcile.F90 b/src/Superstructure/StateReconcile/src/ESMF_StateReconcile.F90 index 4b6a83fd92..97fa7998c3 100644 --- a/src/Superstructure/StateReconcile/src/ESMF_StateReconcile.F90 +++ b/src/Superstructure/StateReconcile/src/ESMF_StateReconcile.F90 @@ -913,7 +913,10 @@ subroutine ESMF_StateReconcile_driver(state, vm, rc) nullify(vmIdSingleComp) if (size(vmIdMap)==1) then singleCompCaseFlag = all(vmintids_send(1:)==1) - if (singleCompCaseFlag) vmIdSingleComp => vmIdMap(1) + if (singleCompCaseFlag) then + singleCompIndex = 1 + vmIdSingleComp => vmIdMap(singleCompIndex) + endif else if (size(vmIdMap)==2) then singleCompCaseFlag = all(vmintids_send(1:)==1) & .or.all(vmintids_send(1:)==2) @@ -1083,12 +1086,15 @@ subroutine ESMF_StateReconcile_driver(state, vm, rc) ! ------------------------------------------------------------------------ #if 0 call ESMF_ReconcileSingleCompCase(state, vm=vm, vmId=vmIdSingleComp, & - attreconflag=attreconflag, siwrap=siwrap, rc=localrc) + vmIntId=singleCompIndex, & + attreconflag=attreconflag, siwrap=siwrap, vmintids_send=vmintids_send, & + rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & rcToReturn=rc)) return #else call ESMF_ReconcileMultiCompCase(state, vm=vm, vmIdMap=vmIdMap_ptr, & - attreconflag=attreconflag, siwrap=siwrap, rc=localrc) + attreconflag=attreconflag, siwrap=siwrap, vmintids_send=vmintids_send, & + rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return #endif @@ -1110,7 +1116,8 @@ subroutine ESMF_StateReconcile_driver(state, vm, rc) ! ------------------------------------------------------------------------ #if 1 call ESMF_ReconcileMultiCompCase(state, vm=vm, vmIdMap=vmIdMap_ptr, & - attreconflag=attreconflag, siwrap=siwrap, rc=localrc) + attreconflag=attreconflag, siwrap=siwrap, vmintids_send=vmintids_send, & + rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return #else @@ -1254,7 +1261,7 @@ end subroutine ESMF_StateReconcile_driver ! ! !INTERFACE: subroutine ESMF_ReconcileMultiCompCase(state, vm, vmIdMap, attreconflag, & - siwrap, rc) + siwrap, vmintids_send, rc) ! ! !ARGUMENTS: type(ESMF_State), intent(inout) :: state @@ -1262,6 +1269,7 @@ subroutine ESMF_ReconcileMultiCompCase(state, vm, vmIdMap, attreconflag, & type(ESMF_VMId), pointer, intent(in) :: vmIdMap(:) type(ESMF_AttReconcileFlag), intent(in) :: attreconflag type(ESMF_StateItemWrap), pointer, intent(in) :: siwrap(:) + integer, pointer, intent(in) :: vmintids_send(:) integer, intent(out) :: rc ! ! !DESCRIPTION: @@ -1281,6 +1289,8 @@ subroutine ESMF_ReconcileMultiCompCase(state, vm, vmIdMap, attreconflag, & ! Flag indicating whether attributes need to be reconciled. ! \item[siwrap] ! List of local state items. +! \item[vmintids_send] +! The integer VMId for each local state item. ! \item[rc] ! Return code; equals {\tt ESMF\_SUCCESS} if there are no errors. ! \end{description} @@ -1339,11 +1349,12 @@ subroutine ESMF_ReconcileMultiCompCase(state, vm, vmIdMap, attreconflag, & end block #endif if (.not.isFlag) then - ! objects on vmIdMap(i) are not defined on a superset of PETs of the - ! reconciling context -> needs to be done + ! objects with vmIdMap(i) are not defined on all PETs of the + ! reconciling context -> need to reconcile vmIdSingleComp => vmIdMap(i) call ESMF_ReconcileSingleCompCase(state, vm=vm, vmId=vmIdSingleComp, & - attreconflag=attreconflag, siwrap=siwrap, rc=localrc) + vmIntId=i, attreconflag=attreconflag, siwrap=siwrap, & + vmintids_send=vmintids_send, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & rcToReturn=rc)) return endif @@ -1715,15 +1726,18 @@ end subroutine ESMF_ReconcileBruteForce ! !IROUTINE: ESMF_ReconcileSingleCompCase ! ! !INTERFACE: - subroutine ESMF_ReconcileSingleCompCase(state, vm, vmId, attreconflag, siwrap, rc) + subroutine ESMF_ReconcileSingleCompCase(state, vm, vmId, vmIntId, & + attreconflag, siwrap, vmintids_send, rc) ! ! !ARGUMENTS: - type(ESMF_State), intent(inout) :: state - type(ESMF_VM), intent(in) :: vm - type(ESMF_VMId), pointer, intent(in) :: vmId - type(ESMF_AttReconcileFlag), intent(in) :: attreconflag - type(ESMF_StateItemWrap), pointer, intent(in) :: siwrap(:) - integer, intent(out) :: rc + type(ESMF_State), intent(inout) :: state + type(ESMF_VM), intent(in) :: vm + type(ESMF_VMId), pointer, intent(in) :: vmId + integer, intent(in) :: vmIntId + type(ESMF_AttReconcileFlag), intent(in) :: attreconflag + type(ESMF_StateItemWrap), pointer, intent(in) :: siwrap(:) + integer, pointer, intent(in) :: vmintids_send(:) + integer, intent(out) :: rc ! ! !DESCRIPTION: ! @@ -1738,20 +1752,25 @@ subroutine ESMF_ReconcileSingleCompCase(state, vm, vmId, attreconflag, siwrap, r ! The {\tt ESMF\_VM} object across which to reconcile {\tt state}. ! \item[vmId] ! The {\tt ESMF\_VMId} of the objects in {\tt state} to reconcile. +! \item[vmIntId] +! The integer VMId of the objects in {\tt state} to reconcile. ! \item[attreconflag] ! Flag indicating whether attributes need to be reconciled. ! \item[siwrap] ! List of local state items. +! \item[vmintids_send] +! The integer VMId for each local state item. ! \item[rc] ! Return code; equals {\tt ESMF\_SUCCESS} if there are no errors. ! \end{description} !EOPI - integer :: localrc - integer :: petCount, localPet, rootVas, rootPet, vas - integer :: sizeBuffer(1) - logical :: isFlag - character, pointer :: buffer(:) + integer :: localrc, i + integer :: petCount, localPet, rootVas, rootPet, vas + integer :: sizeBuffer(1), itemCount + logical :: isFlag + character, pointer :: buffer(:) + integer, allocatable :: itemList(:) rc = ESMF_SUCCESS @@ -1776,7 +1795,7 @@ subroutine ESMF_ReconcileSingleCompCase(state, vm, vmId, attreconflag, siwrap, r if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & rcToReturn=rc)) return - ! search for PET in VM that executes on rootVas -> use as rootPet + ! search for first PET in VM that executes on rootVas -> use as rootPet do rootPet=0, petCount-1 call ESMF_VMGet(vm, pet=rootPet, vas=vas, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & @@ -1808,13 +1827,26 @@ subroutine ESMF_ReconcileSingleCompCase(state, vm, vmId, attreconflag, siwrap, r end block #endif - ! Serialize on rootPet + ! On rootPet: construct itemList and serialize if (localPet==rootPet) then - call ESMF_ReconcileSerializeAll(state, vm, vmId, attreconflag, siwrap, & - buffer, rc=localrc) + ! itemList to hold indices into siwrap(:) of objects that need to be sent + allocate(itemList(ubound(vmintids_send,1))) ! max number of items possible + itemCount=0 + do i=1, size(itemList) + if (vmintids_send(i)==vmIntId) then + ! the integer VMId of object "i" matches that of handled single comp + itemCount = itemCount+1 + itemList(itemCount) = i + endif + enddo + ! serialize all items in itemList + call ESMF_ReconcileSerializeAll(state, itemList, itemCount, & + attreconflag, siwrap, buffer, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & rcToReturn=rc)) return sizeBuffer(1) = size(buffer) + ! cleanup + deallocate(itemList) endif ! Broadcast buffer across all PETs @@ -2573,8 +2605,6 @@ subroutine ESMF_ReconcileDeserializeAll(state, vm, attreconflag, buffer, rc) integer :: itemType integer :: sizeBuffer, posBuffer -! XMRKX ! - #ifdef RECONCILE_LOG_on call ESMF_LogWrite("ESMF_ReconcileDeserializeAll()", & ESMF_LOGMSG_DEBUG, rc=localrc) @@ -4415,16 +4445,16 @@ end subroutine ESMF_ReconcileSerialize ! !IROUTINE: ESMF_ReconcileSerializeAll ! ! !INTERFACE: - subroutine ESMF_ReconcileSerializeAll(state, vm, vmid, attreconflag, siwrap, & - buffer, rc) + subroutine ESMF_ReconcileSerializeAll(state, itemList, itemCount, & + attreconflag, siwrap, buffer, rc) ! ! !ARGUMENTS: - type (ESMF_State), intent(in) :: state - type (ESMF_VM), intent(in) :: vm - type (ESMF_VMId), pointer, intent(in) :: vmId + type(ESMF_State), intent(in) :: state + integer, intent(in) :: itemList(:) + integer, intent(in) :: itemCount type(ESMF_AttReconcileFlag),intent(in) :: attreconflag - type (ESMF_StateItemWrap), intent(in) :: siwrap(:) - character, pointer :: buffer(:) + type(ESMF_StateItemWrap), intent(in) :: siwrap(:) + character, pointer, intent(out) :: buffer(:) integer, intent(out) :: rc ! ! !DESCRIPTION: @@ -4433,14 +4463,14 @@ subroutine ESMF_ReconcileSerializeAll(state, vm, vmid, attreconflag, siwrap, & ! \begin{description} ! \item[state] ! The {\tt ESMF\_State} to collect information from. -! \item[vm] -! The {\tt ESMF\_VM} object across which to reconcile {\tt state}. -! \item[vmId] -! The {\tt ESMF\_VMId} of the objects in {\tt state} to reconcile. -! \item[siwrap] -! List of local state items. +! \item[itemList] +! List of indices into siwrap(:) for items that need to be serialized. +! \item[itemCount] +! Number of items in itemList. The incoming allocation might be larger. ! \item[attreconflag] ! Flag to indicate attribute reconciliation. +! \item[siwrap] +! List of local state items. ! \item[buffer] ! Buffer ! \item[rc] @@ -4448,67 +4478,46 @@ subroutine ESMF_ReconcileSerializeAll(state, vm, vmid, attreconflag, siwrap, & ! \end{description} !EOPI - integer :: localrc - integer :: memstat - integer :: item,numStateItems + integer :: localrc, i + integer :: memstat type(ESMF_StateItem), pointer :: stateItem - type(ESMF_State) :: wrapper - integer :: itemType - integer :: sizeBuffer, posBuffer - character, pointer :: fakeBuffer(:) ! Fake buffer for passing when getting sizes - integer :: sizeFakeBuffer - integer :: itemSize - type(ESMF_InquireFlag) :: inqflag - integer :: localPet, petCount, pet - type(ESMF_VM) :: vmItem - type(ESMF_VMId) :: vmIdItem - logical :: isFlag - integer :: numActualItems - - ! XMRKX ! + type(ESMF_State) :: wrapper + integer :: itemType + integer :: itemSize + integer :: sizeBuffer, posBuffer + character, pointer :: fakeBuffer(:) ! when inquiring sizes + integer :: sizeFakeBuffer + type(ESMF_InquireFlag) :: inqflag ! Init to not implemented localrc = ESMF_RC_NOT_IMPL #ifdef RECONCILE_LOG_on - call ESMF_LogWrite("ESMF_ReconcileSerializeAll()", & - ESMF_LOGMSG_DEBUG, rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & - rcToReturn=rc)) return + call ESMF_LogWrite("ESMF_ReconcileSerializeAll()", & + ESMF_LOGMSG_DEBUG, rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & + rcToReturn=rc)) return #endif - ! Get vm info - call ESMF_VMGet(vm, localPet=localPet, petCount=petCount, rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, & - rcToReturn=rc)) return + !!!!! Calculate buffer size !!!!! - - ! Get the number of items - numStateItems = size (siwrap) + ! Start with number of items + sizeBuffer=ESMF_SIZEOF_DEFINT - - !!!!! Calculate buffer size !!!!! - - ! Start with number of items - sizeBuffer=ESMF_SIZEOF_DEFINT + ! Allocate a fake buffer for passing in when asking for size + allocate(fakeBuffer(0:ESMF_SIZEOF_DEFINT-1)) - ! Allocate a fake buffer for passing in when asking for size - allocate(fakeBuffer(0:ESMF_SIZEOF_DEFINT-1)) - - ! Fake buffer size - sizeFakeBuffer=size(fakeBuffer) - - ! Set flag to only check size - inqflag = ESMF_INQUIREONLY + ! Fake buffer size + sizeFakeBuffer=size(fakeBuffer) - numActualItems = 0 + ! Set flag to only check size + inqflag = ESMF_INQUIREONLY - ! Loop State items computing size - do item=1,numStateItems + ! Loop over items in itemList and determine buffer size needed + do i=1, itemCount ! Get one State Item - stateItem => siwrap(item)%si + stateItem => siwrap(itemList(i))%si ! Get item type itemType = stateitem%otype%ot @@ -4520,430 +4529,219 @@ subroutine ESMF_ReconcileSerializeAll(state, vm, vmid, attreconflag, siwrap, & ! Get size of item to serialize select case (itemType) case (ESMF_STATEITEM_FIELDBUNDLE%ot) - call ESMF_FieldBundleGet(stateItem%datap%fbp, vm=vmItem, rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & - rcToReturn=rc)) return - call ESMF_VMGetVMId(vmItem, vmId=vmIdItem, rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & - rcToReturn=rc)) return - isFlag = ESMF_VMIdCompare(vmIdItem, vmId, rc=localrc) + call ESMF_FieldBundleSerialize(stateItem%datap%fbp, & + fakeBuffer, sizeFakeBuffer, itemSize, & + attreconflag=attreconflag, inquireflag=inqflag, & + rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & rcToReturn=rc)) return - if (isFlag) then - ! object has the correct VMId -> serialize - call ESMF_FieldBundleSerialize(stateItem%datap%fbp, & - fakeBuffer, sizeFakeBuffer, itemSize, & - attreconflag=attreconflag, inquireflag=inqflag, & +#ifdef RECONCILE_LOG_on + block + character(ESMF_MAXSTR) :: itemName + character(160) :: msgStr + call ESMF_FieldBundleGet(stateItem%datap%fbp, name=itemName, & rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & rcToReturn=rc)) return -#ifdef RECONCILE_LOG_on - block - character(ESMF_MAXSTR) :: itemName - character(160) :: msgStr - call ESMF_FieldBundleGet(stateItem%datap%fbp, name=itemName, & - rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & - rcToReturn=rc)) return - write(msgStr,*) "Serialize FieldBundle '"//trim(itemName)//"' "//& - " size=", itemSize - call ESMF_LogWrite(msgStr, ESMF_LOGMSG_DEBUG, rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & - rcToReturn=rc)) return - end block + write(msgStr,*) "Serialize FieldBundle '"//trim(itemName)//"' "//& + " size=", itemSize + call ESMF_LogWrite(msgStr, ESMF_LOGMSG_DEBUG, rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & + rcToReturn=rc)) return + end block #endif - else - cycle - endif case (ESMF_STATEITEM_FIELD%ot) - call ESMF_FieldGet(stateItem%datap%fp, vm=vmItem, rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & - rcToReturn=rc)) return - call ESMF_VMGetVMId(vmItem, vmId=vmIdItem, rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & - rcToReturn=rc)) return - isFlag = ESMF_VMIdCompare(vmIdItem, vmId, rc=localrc) + call ESMF_FieldSerialize(stateItem%datap%fp, & + fakeBuffer, sizeFakeBuffer, itemSize, & + attreconflag=attreconflag, inquireflag=inqflag, & + rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & rcToReturn=rc)) return - if (isFlag) then - ! object has the correct VMId -> serialize - call ESMF_FieldSerialize(stateItem%datap%fp, & - fakeBuffer, sizeFakeBuffer, itemSize, & - attreconflag=attreconflag, inquireflag=inqflag, & +#ifdef RECONCILE_LOG_on + block + character(ESMF_MAXSTR) :: itemName + character(160) :: msgStr + call ESMF_FieldGet(stateItem%datap%fp, name=itemName, & rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & rcToReturn=rc)) return -#ifdef RECONCILE_LOG_on - block - character(ESMF_MAXSTR) :: itemName - character(160) :: msgStr - call ESMF_FieldGet(stateItem%datap%fp, name=itemName, & - rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & - rcToReturn=rc)) return - write(msgStr,*) "Serialize Field '"//trim(itemName)//"' "//& - " size=", itemSize - call ESMF_LogWrite(msgStr, ESMF_LOGMSG_DEBUG, rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & - rcToReturn=rc)) return - end block + write(msgStr,*) "Serialize Field '"//trim(itemName)//"' "//& + " size=", itemSize + call ESMF_LogWrite(msgStr, ESMF_LOGMSG_DEBUG, rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & + rcToReturn=rc)) return + end block #endif - else - cycle - endif case (ESMF_STATEITEM_ARRAY%ot) - call ESMF_ArrayGet(stateItem%datap%ap, vm=vmItem, rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & - rcToReturn=rc)) return - call ESMF_VMGetVMId(vmItem, vmId=vmIdItem, rc=localrc) + call c_ESMC_ArraySerialize(stateitem%datap%ap, & + fakeBuffer, sizeFakeBuffer, itemSize, & + attreconflag, inqflag, & + localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & rcToReturn=rc)) return - isFlag = ESMF_VMIdCompare(vmIdItem, vmId, rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & - rcToReturn=rc)) return - if (isFlag) then - ! object has the correct VMId -> serialize - call c_ESMC_ArraySerialize(stateitem%datap%ap, & - fakeBuffer, sizeFakeBuffer, itemSize, & - attreconflag, inqflag, & - localrc) +#ifdef RECONCILE_LOG_on + block + character(ESMF_MAXSTR) :: itemName + character(160) :: msgStr + call ESMF_ArrayGet(stateItem%datap%ap, name=itemName, & + rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & rcToReturn=rc)) return -#ifdef RECONCILE_LOG_on - block - character(ESMF_MAXSTR) :: itemName - character(160) :: msgStr - call ESMF_ArrayGet(stateItem%datap%ap, name=itemName, & - rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & - rcToReturn=rc)) return - write(msgStr,*) "Serialize Array '"//trim(itemName)//"' "//& - " size=", itemSize - call ESMF_LogWrite(msgStr, ESMF_LOGMSG_DEBUG, rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & - rcToReturn=rc)) return - end block + write(msgStr,*) "Serialize Array '"//trim(itemName)//"' "//& + " size=", itemSize + call ESMF_LogWrite(msgStr, ESMF_LOGMSG_DEBUG, rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & + rcToReturn=rc)) return + end block #endif - else - cycle - endif case (ESMF_STATEITEM_ARRAYBUNDLE%ot) - call ESMF_ArrayBundleGet(stateItem%datap%abp, vm=vmItem, rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & - rcToReturn=rc)) return - call ESMF_VMGetVMId(vmItem, vmId=vmIdItem, rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & - rcToReturn=rc)) return - isFlag = ESMF_VMIdCompare(vmIdItem, vmId, rc=localrc) + call c_ESMC_ArrayBundleSerialize(stateitem%datap%abp, & + fakeBuffer, sizeFakeBuffer, itemSize, & + attreconflag, inqflag, & + localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & rcToReturn=rc)) return - if (isFlag) then - ! object has the correct VMId -> serialize - call c_ESMC_ArrayBundleSerialize(stateitem%datap%abp, & - fakeBuffer, sizeFakeBuffer, itemSize, & - attreconflag, inqflag, & - localrc) +#ifdef RECONCILE_LOG_on + block + character(ESMF_MAXSTR) :: itemName + character(160) :: msgStr + call ESMF_ArrayBundleGet(stateItem%datap%abp, name=itemName, & + rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & rcToReturn=rc)) return -#ifdef RECONCILE_LOG_on - block - character(ESMF_MAXSTR) :: itemName - character(160) :: msgStr - call ESMF_ArrayBundleGet(stateItem%datap%abp, name=itemName, & - rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & - rcToReturn=rc)) return - write(msgStr,*) "Serialize ArrayBundle '"//trim(itemName)//"' "//& - " size=", itemSize - call ESMF_LogWrite(msgStr, ESMF_LOGMSG_DEBUG, rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & - rcToReturn=rc)) return - end block + write(msgStr,*) "Serialize ArrayBundle '"//trim(itemName)//"' "//& + " size=", itemSize + call ESMF_LogWrite(msgStr, ESMF_LOGMSG_DEBUG, rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & + rcToReturn=rc)) return + end block #endif - else - cycle - endif case (ESMF_STATEITEM_STATE%ot) wrapper%statep => stateitem%datap%spp ESMF_INIT_SET_CREATED(wrapper) - call ESMF_StateGet(wrapper, vm=vmItem, rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & - rcToReturn=rc)) return - call ESMF_VMGetVMId(vmItem, vmId=vmIdItem, rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & - rcToReturn=rc)) return - isFlag = ESMF_VMIdCompare(vmIdItem, vmId, rc=localrc) + call ESMF_StateSerialize(wrapper, & + fakeBuffer, sizeFakeBuffer, itemSize, & + attreconflag=attreconflag, inquireflag=inqflag, & + rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & rcToReturn=rc)) return - if (isFlag) then - ! object has the correct VMId -> serialize - call ESMF_StateSerialize(wrapper, & - fakeBuffer, sizeFakeBuffer, itemSize, & - attreconflag=attreconflag, inquireflag=inqflag, & +#ifdef RECONCILE_LOG_on + block + character(ESMF_MAXSTR) :: itemName + character(160) :: msgStr + call ESMF_StateGet(wrapper, name=itemName, & rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & rcToReturn=rc)) return -#ifdef RECONCILE_LOG_on - block - character(ESMF_MAXSTR) :: itemName - character(160) :: msgStr - call ESMF_StateGet(wrapper, name=itemName, & - rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & - rcToReturn=rc)) return - write(msgStr,*) "Serialize State '"//trim(itemName)//"' "//& - " size=", itemSize - call ESMF_LogWrite(msgStr, ESMF_LOGMSG_DEBUG, rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & - rcToReturn=rc)) return - end block + write(msgStr,*) "Serialize State '"//trim(itemName)//"' "//& + " size=", itemSize + call ESMF_LogWrite(msgStr, ESMF_LOGMSG_DEBUG, rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & + rcToReturn=rc)) return + end block #endif - else - cycle - endif case (ESMF_STATEITEM_ROUTEHANDLE%ot) - ! Do nothing for RouteHandles. There is no need to reconcile them. -#if 0 - case (ESMF_STATEITEM_UNKNOWN%ot) - call c_ESMC_StringSerialize(stateitem%namep, & - fakeBuffer, sizeFakeBuffer, itemSize, & - inqflag, localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, & - rcToReturn=rc)) return - if (debug) then - print *, ' PET', localPet, & - ' Getting Unknown size=',itemSize - end if -#endif + ! Do nothing for RouteHandles. There is no need to reconcile them. case default - if (ESMF_LogFoundError(ESMF_RC_INTNRL_INCONS, & + call ESMF_LogSetError(ESMF_RC_INTNRL_INCONS, & msg="Unrecognized item type.", & ESMF_CONTEXT, & - rcToReturn=rc)) return + rcToReturn=rc) + return end select - numActualItems = numActualItems + 1 - ! Add item type's size sizeBuffer = sizeBuffer + ESMF_SIZEOF_DEFINT ! Update buffer size by itemSize sizeBuffer = sizeBuffer + itemSize - enddo + enddo - ! Get rid of fakeBuffer - deallocate(fakeBuffer) + ! Get rid of fakeBuffer + deallocate(fakeBuffer) - !!!!! Allocate buffer to serialize into !!!!! - allocate(buffer(0:sizeBuffer-1), stat=memstat) - if (ESMF_LogFoundAllocError(memstat, ESMF_ERR_PASSTHRU, & + !!!!! Allocate buffer to serialize into !!!!! + allocate(buffer(0:sizeBuffer-1), stat=memstat) + if (ESMF_LogFoundAllocError(memstat, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, & rcToReturn=rc)) return + !!!!! Serialize information into buffer !!!!! - !!!!! Serialize information into buffer !!!!! - - ! Start position of buffer - posBuffer = 0 + ! Start position of buffer + posBuffer = 0 - ! Put item count in buffer - buffer(posBuffer:posBuffer+ESMF_SIZEOF_DEFINT-1) = transfer ( & - source=numActualItems, & + ! Put item count in buffer + buffer(posBuffer:posBuffer+ESMF_SIZEOF_DEFINT-1) = transfer ( & + source=itemCount, & mold=buffer(0:ESMF_SIZEOF_DEFINT-1)) - posBuffer = posbuffer + ESMF_SIZEOF_DEFINT + posBuffer = posbuffer + ESMF_SIZEOF_DEFINT + + ! Set flag to actually serialize + inqflag = ESMF_NOINQUIRE - ! Set flag to actually serialize - inqflag = ESMF_NOINQUIRE - - ! Loop State items adding to buffer - do item=1,numStateItems + ! Loop over items in itemList and add to buffer + do i=1, itemCount ! Get one State Item - stateItem => siwrap(item)%si + stateItem => siwrap(itemList(i))%si ! Get item type itemType = stateitem%otype%ot - ! Add serialized items - select case (itemType) - case (ESMF_STATEITEM_FIELDBUNDLE%ot) - call ESMF_FieldBundleGet(stateItem%datap%fbp, vm=vmItem, rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & - rcToReturn=rc)) return - call ESMF_VMGetVMId(vmItem, vmId=vmIdItem, rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & - rcToReturn=rc)) return - isFlag = ESMF_VMIdCompare(vmIdItem, vmId, rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & - rcToReturn=rc)) return - if (isFlag) then - ! object has the correct VMId -> serialize ! Add item type to buffer buffer(posBuffer:posBuffer+ESMF_SIZEOF_DEFINT-1) = transfer (& source=itemType, & mold =buffer(0:ESMF_SIZEOF_DEFINT-1)) posBuffer = posbuffer + ESMF_SIZEOF_DEFINT - if (debug) then - print *, ' PET', localPet, & - ' Getting FieldBundle pos=',posBuffer - end if - call ESMF_FieldBundleSerialize(stateItem%datap%fbp, & - buffer, sizeBuffer, posBuffer, & - attreconflag=attreconflag, inquireflag=inqflag, & - rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & - rcToReturn=rc)) return - else - cycle - endif - case (ESMF_STATEITEM_FIELD%ot) - call ESMF_FieldGet(stateItem%datap%fp, vm=vmItem, rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & - rcToReturn=rc)) return - call ESMF_VMGetVMId(vmItem, vmId=vmIdItem, rc=localrc) + ! Add serialized items + select case (itemType) + case (ESMF_STATEITEM_FIELDBUNDLE%ot) + call ESMF_FieldBundleSerialize(stateItem%datap%fbp, & + buffer, sizeBuffer, posBuffer, & + attreconflag=attreconflag, inquireflag=inqflag, & + rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & - rcToReturn=rc)) return - isFlag = ESMF_VMIdCompare(vmIdItem, vmId, rc=localrc) + rcToReturn=rc)) return + case (ESMF_STATEITEM_FIELD%ot) + call ESMF_FieldSerialize(stateItem%datap%fp, & + buffer, sizeBuffer, posBuffer, & + attreconflag=attreconflag, inquireflag=inqflag, & + rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & - rcToReturn=rc)) return - if (isFlag) then - ! object has the correct VMId -> serialize - ! Add item type to buffer - buffer(posBuffer:posBuffer+ESMF_SIZEOF_DEFINT-1) = transfer (& - source=itemType, & - mold =buffer(0:ESMF_SIZEOF_DEFINT-1)) - posBuffer = posbuffer + ESMF_SIZEOF_DEFINT - - if (debug) then - print *, ' PET', localPet, & - ' Getting Field pos=',posBuffer - end if - call ESMF_FieldSerialize(stateItem%datap%fp, & - buffer, sizeBuffer, posBuffer, & - attreconflag=attreconflag, inquireflag=inqflag, & - rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & - rcToReturn=rc)) return - else - cycle - endif + rcToReturn=rc)) return case (ESMF_STATEITEM_ARRAY%ot) - call ESMF_ArrayGet(stateItem%datap%ap, vm=vmItem, rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & - rcToReturn=rc)) return - call ESMF_VMGetVMId(vmItem, vmId=vmIdItem, rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & - rcToReturn=rc)) return - isFlag = ESMF_VMIdCompare(vmIdItem, vmId, rc=localrc) + call c_ESMC_ArraySerialize(stateitem%datap%ap, & + buffer, sizeBuffer, posBuffer, & + attreconflag, inqflag, & + localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & - rcToReturn=rc)) return - if (isFlag) then - ! object has the correct VMId -> serialize - ! Add item type to buffer - buffer(posBuffer:posBuffer+ESMF_SIZEOF_DEFINT-1) = transfer (& - source=itemType, & - mold =buffer(0:ESMF_SIZEOF_DEFINT-1)) - posBuffer = posbuffer + ESMF_SIZEOF_DEFINT - - if (debug) then - print *, ' PET', localPet, & - ' Getting Array pos=',posBuffer - end if - call c_ESMC_ArraySerialize(stateitem%datap%ap, & - buffer, sizeBuffer, posBuffer, & - attreconflag, inqflag, & - localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & - rcToReturn=rc)) return - else - cycle - endif + rcToReturn=rc)) return case (ESMF_STATEITEM_ARRAYBUNDLE%ot) - call ESMF_ArrayBundleGet(stateItem%datap%abp, vm=vmItem, rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & - rcToReturn=rc)) return - call ESMF_VMGetVMId(vmItem, vmId=vmIdItem, rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & - rcToReturn=rc)) return - isFlag = ESMF_VMIdCompare(vmIdItem, vmId, rc=localrc) + call c_ESMC_ArrayBundleSerialize(stateitem%datap%abp, & + buffer, sizeBuffer, posBuffer, & + attreconflag, inqflag, & + localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & - rcToReturn=rc)) return - if (isFlag) then - ! object has the correct VMId -> serialize - ! Add item type to buffer - buffer(posBuffer:posBuffer+ESMF_SIZEOF_DEFINT-1) = transfer (& - source=itemType, & - mold =buffer(0:ESMF_SIZEOF_DEFINT-1)) - posBuffer = posbuffer + ESMF_SIZEOF_DEFINT - - if (debug) then - print *, ' PET', localPet, & - ' Getting ArrayBundle pos=',posBuffer - end if - call c_ESMC_ArrayBundleSerialize(stateitem%datap%abp, & - buffer, sizeBuffer, posBuffer, & - attreconflag, inqflag, & - localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & - rcToReturn=rc)) return - else - cycle - endif + rcToReturn=rc)) return case (ESMF_STATEITEM_STATE%ot) wrapper%statep => stateitem%datap%spp ESMF_INIT_SET_CREATED(wrapper) - call ESMF_StateGet(wrapper, vm=vmItem, rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & - rcToReturn=rc)) return - call ESMF_VMGetVMId(vmItem, vmId=vmIdItem, rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & - rcToReturn=rc)) return - isFlag = ESMF_VMIdCompare(vmIdItem, vmId, rc=localrc) + call ESMF_StateSerialize(wrapper, & + buffer, sizeBuffer, posBuffer, & + attreconflag=attreconflag, inquireflag=inqflag, & + rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & - rcToReturn=rc)) return - if (isFlag) then - ! object has the correct VMId -> serialize - ! Add item type to buffer - buffer(posBuffer:posBuffer+ESMF_SIZEOF_DEFINT-1) = transfer (& - source=itemType, & - mold =buffer(0:ESMF_SIZEOF_DEFINT-1)) - posBuffer = posbuffer + ESMF_SIZEOF_DEFINT - - if (debug) then - print *, ' PET', localPet, & - ' Getting State pos=',posBuffer - end if - call ESMF_StateSerialize(wrapper, & - buffer, sizeBuffer, posBuffer, & - attreconflag=attreconflag, inquireflag=inqflag, & - rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & - rcToReturn=rc)) return - else - cycle - endif + rcToReturn=rc)) return case (ESMF_STATEITEM_ROUTEHANDLE%ot) ! Do nothing for RouteHandles. There is no need to reconcile them. -#if 0 - case (ESMF_STATEITEM_UNKNOWN%ot) - if (debug) then - print *, ' PET', localPet, & - ' Getting Unknown pos=',posBuffer - end if - call c_ESMC_StringSerialize(stateitem%namep, & - buffer, sizeBuffer, posBuffer, & - inqflag, localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, & - rcToReturn=rc)) return -#endif case default - if (ESMF_LogFoundError(ESMF_RC_INTNRL_INCONS, & + call ESMF_LogSetError(ESMF_RC_INTNRL_INCONS, & msg="Unrecognized item type.", & ESMF_CONTEXT, & - rcToReturn=rc)) return + rcToReturn=rc) + return end select enddo From e91dfa894229a33fb0909a25050fa686daf33ce8 Mon Sep 17 00:00:00 2001 From: Gerhard Theurich Date: Wed, 13 Nov 2024 14:12:12 -0800 Subject: [PATCH 134/207] Move subroutines so new Reconcile() implementation code is in closer proximity, and further up in the source file. --- .../src/ESMF_StateReconcile.F90 | 3668 ++++++++--------- 1 file changed, 1832 insertions(+), 1836 deletions(-) diff --git a/src/Superstructure/StateReconcile/src/ESMF_StateReconcile.F90 b/src/Superstructure/StateReconcile/src/ESMF_StateReconcile.F90 index 97fa7998c3..efbadc4174 100644 --- a/src/Superstructure/StateReconcile/src/ESMF_StateReconcile.F90 +++ b/src/Superstructure/StateReconcile/src/ESMF_StateReconcile.F90 @@ -1364,57 +1364,56 @@ end subroutine ESMF_ReconcileMultiCompCase !------------------------------------------------------------------------------ #undef ESMF_METHOD -#define ESMF_METHOD "ESMF_ReconcileBruteForce" +#define ESMF_METHOD "ESMF_ReconcileSingleCompCase" !BOPI -! !IROUTINE: ESMF_ReconcileBruteForce +! !IROUTINE: ESMF_ReconcileSingleCompCase ! ! !INTERFACE: - subroutine ESMF_ReconcileBruteForce(state, vm, attreconflag, siwrap, & - ids_send, vmids_send, vmintids_send, nitems_buf, rc) + subroutine ESMF_ReconcileSingleCompCase(state, vm, vmId, vmIntId, & + attreconflag, siwrap, vmintids_send, rc) ! ! !ARGUMENTS: type(ESMF_State), intent(inout) :: state type(ESMF_VM), intent(in) :: vm + type(ESMF_VMId), pointer, intent(in) :: vmId + integer, intent(in) :: vmIntId type(ESMF_AttReconcileFlag), intent(in) :: attreconflag type(ESMF_StateItemWrap), pointer, intent(in) :: siwrap(:) - integer, pointer, intent(in) :: ids_send(:) - type(ESMF_VMId), pointer, intent(in) :: vmids_send(:) integer, pointer, intent(in) :: vmintids_send(:) - integer, pointer, intent(in) :: nitems_buf(:) integer, intent(out) :: rc ! ! !DESCRIPTION: ! -! Brute force reconciliation across all of the PETs using Alltoall -! communications. This should be able to reconcile any conceivable situation. +! Handle the single component reconciliation case. This is the expected +! situation under NUOPC rules. ! ! The arguments are: ! \begin{description} ! \item[state] ! The {\tt ESMF\_State} to reconcile. ! \item[vm] -! The {\tt ESMF\_VM} object across which the state is reconciled. +! The {\tt ESMF\_VM} object across which to reconcile {\tt state}. +! \item[vmId] +! The {\tt ESMF\_VMId} of the objects in {\tt state} to reconcile. +! \item[vmIntId] +! The integer VMId of the objects in {\tt state} to reconcile. ! \item[attreconflag] ! Flag indicating whether attributes need to be reconciled. ! \item[siwrap] ! List of local state items. +! \item[vmintids_send] +! The integer VMId for each local state item. ! \item[rc] ! Return code; equals {\tt ESMF\_SUCCESS} if there are no errors. ! \end{description} !EOPI - integer :: localrc - integer :: memstat - integer :: localPet, petCount - integer :: i - - type(ESMF_ReconcileIDInfo), allocatable :: id_info(:) - type(ESMF_CharPtr), allocatable :: items_recv(:) - logical, pointer :: recvd_needs_matrix(:,:) - character, pointer :: buffer_recv(:) - - logical, parameter :: meminfo = .false. - logical, parameter :: profile = .true. + integer :: localrc, i + integer :: petCount, localPet, rootVas, rootPet, vas + integer :: sizeBuffer(1), itemCount + logical :: isFlag + character, pointer :: buffer(:) + integer, allocatable :: itemList(:) rc = ESMF_SUCCESS @@ -1422,482 +1421,1011 @@ subroutine ESMF_ReconcileBruteForce(state, vm, attreconflag, siwrap, & block character(ESMF_MAXSTR) :: stateName call ESMF_StateGet(state, name=stateName, rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, & + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & rcToReturn=rc)) return - call ESMF_LogWrite("ESMF_ReconcileBruteForce() for State: "//trim(stateName), & + call ESMF_LogWrite("ESMF_ReconcileSingleCompCase() for State: "//trim(stateName), & ESMF_LOGMSG_DEBUG, rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, & + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & rcToReturn=rc)) return end block #endif call ESMF_VMGet(vm, petCount=petCount, localPet=localPet, rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, & - rcToReturn=rc)) return - - ! ------------------------------------------------------------------------- - ! (3) All PETs send their items Ids and VMIds to all the other PETs, - ! then create local directories of which PETs have which ids/VMIds. - ! ------------------------------------------------------------------------- - if (profile) then - call ESMF_TraceRegionEnter("(3) Send arrays exchange", rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, & - rcToReturn=rc)) return - endif - ! ------------------------------------------------------------------------- - if (trace) then - call ESMF_ReconcileDebugPrint (ESMF_METHOD // & - ': *** Step 3 - Exchange Ids/VMIds') - end if - allocate (id_info(0:petCount-1), stat=memstat) - if (ESMF_LogFoundAllocError(memstat, ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, & + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & rcToReturn=rc)) return - call ESMF_ReconcileExchgIDInfo (vm, & - nitems_buf=nitems_buf, & - id=ids_send, & - vmid=vmintids_send, & - id_info=id_info, & - rc=localrc) - if (debug) & - localrc = ESMF_ReconcileAllRC (vm, localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, & + + call ESMF_VMIdGet(vmId, leftMostOnBit=rootVas, rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & rcToReturn=rc)) return - ! ------------------------------------------------------------------------- - if (profile) then - call ESMF_TraceRegionExit("(3) Send arrays exchange", rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, & + + ! search for first PET in VM that executes on rootVas -> use as rootPet + do rootPet=0, petCount-1 + call ESMF_VMGet(vm, pet=rootPet, vas=vas, rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & rcToReturn=rc)) return + if (vas==rootVas) exit ! found + enddo + if (rootPet==petCount) then + call ESMF_LogSetError(ESMF_RC_INTNRL_INCONS, & + msg="Could not find PET that executes on the identified VAS", & + ESMF_CONTEXT, rcToReturn=rc) + return endif - ! ------------------------------------------------------------------------- - if (meminfo) call ESMF_VMLogMemInfo ("after (3) Send arrays exchange") - -! At this point, each PET knows what items can be found on all of -! the other PETs. The id_info array has global PET info in it. - ! ------------------------------------------------------------------------- - ! (4) Construct needs list. Receiving PETs compare IDs and VMIds - ! in their send ID/VMId array with what was received from the - ! currently-being-processed sending PET. Note that multiple PETs - ! can 'offer' an item. - ! ------------------------------------------------------------------------- - if (profile) then - call ESMF_TraceRegionEnter("(4) Construct needs list", rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, & +#ifdef RECONCILE_LOG_on + block + character(160) :: msgStr + write(msgStr,*) "SingleCompCase rootVas=", rootVas + call ESMF_LogWrite(msgStr, ESMF_LOGMSG_DEBUG, rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & rcToReturn=rc)) return - endif - ! ------------------------------------------------------------------------- - if (trace) then - call ESMF_ReconcileDebugPrint (ESMF_METHOD // & - ': *** Step 4 - Compare and create needs arrays') - end if - call ESMF_ReconcileCompareNeeds (vm, & - id= ids_send, & - vmid=vmintids_send, & - id_info=id_info, & - rc=localrc) - if (debug) & - localrc = ESMF_ReconcileAllRC (vm, localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, & + write(msgStr,*) "SingleCompCase rootPet=", rootPet + call ESMF_LogWrite(msgStr, ESMF_LOGMSG_DEBUG, rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & rcToReturn=rc)) return - ! ------------------------------------------------------------------------- - if (profile) then - call ESMF_TraceRegionExit("(4) Construct needs list", rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, & + write(msgStr,*) "SingleCompCase size(siwrap)=", size(siwrap) + call ESMF_LogWrite(msgStr, ESMF_LOGMSG_DEBUG, rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & rcToReturn=rc)) return - endif - ! ------------------------------------------------------------------------- - if (meminfo) call ESMF_VMLogMemInfo ("after (4) Construct needs list") + end block +#endif - ! ------------------------------------------------------------------------- - ! (5) Communicate needs back to the offering PETs. - ! Send to each offering PET a buffer containing 'needed' array - ! specifying which items are needed. The array is the same size as, - ! and corresponds to, the ID and VMId arrays that were previously - ! offered. - ! ------------------------------------------------------------------------- - if (profile) then - call ESMF_TraceRegionEnter("(5) Communicate needs back", rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, & + ! On rootPet: construct itemList and serialize + if (localPet==rootPet) then + ! itemList to hold indices into siwrap(:) of objects that need to be sent + allocate(itemList(ubound(vmintids_send,1))) ! max number of items possible + itemCount=0 + do i=1, size(itemList) + if (vmintids_send(i)==vmIntId) then + ! the integer VMId of object "i" matches that of handled single comp + itemCount = itemCount+1 + itemList(itemCount) = i + endif + enddo + ! serialize all items in itemList + call ESMF_ReconcileSerializeAll(state, itemList, itemCount, & + attreconflag, siwrap, buffer, rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & rcToReturn=rc)) return + sizeBuffer(1) = size(buffer) + ! cleanup + deallocate(itemList) endif - ! ------------------------------------------------------------------------- - if (trace) then - call ESMF_ReconcileDebugPrint (ESMF_METHOD // & - ': *** Step 5 - Exchange needs') - end if - recvd_needs_matrix => null () - call ESMF_ReconcileExchgNeeds (vm, & - id_info=id_info, & - recv_needs=recvd_needs_matrix, & - rc=localrc) - if (debug) & - localrc = ESMF_ReconcileAllRC (vm, localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, & + + ! Broadcast buffer across all PETs + call ESMF_VMBroadcast(vm, sizeBuffer, count=1, rootPet=rootPet, rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & + rcToReturn=rc)) return + +#ifdef RECONCILE_LOG_on + block + character(160) :: msgStr + write(msgStr,*) "SingleCompCase sizeBuffer=", sizeBuffer(1) + call ESMF_LogWrite(msgStr, ESMF_LOGMSG_DEBUG, rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & rcToReturn=rc)) return - ! ------------------------------------------------------------------------- - if (profile) then - call ESMF_TraceRegionExit("(5) Communicate needs back", rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, & + end block +#endif + + if (localPet/=rootPet) allocate(buffer(0:sizeBuffer(1)-1)) + + call ESMF_VMBroadcast(vm, buffer, count=sizeBuffer(1), rootPet=rootPet, & + rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & + rcToReturn=rc)) return + + ! determine if local PET is active under the vmId + call ESMF_VMIdGet(vmId, isLocalPetActive=isFlag, rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & + rcToReturn=rc)) return + +#ifdef RECONCILE_LOG_on + block + character(160) :: msgStr + write(msgStr,*) "SingleCompCase PET active isFlag=", isFlag + call ESMF_LogWrite(msgStr, ESMF_LOGMSG_DEBUG, rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & rcToReturn=rc)) return - endif - ! ------------------------------------------------------------------------- - if (meminfo) call ESMF_VMLogMemInfo ("after (5) Communicate needs back") + end block +#endif - ! ------------------------------------------------------------------------- - ! (6) Serialize needed objects - ! ------------------------------------------------------------------------- - if (profile) then - call ESMF_TraceRegionEnter("(6) Serialize needed objects", rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, & + ! only inactive PETs deserialize the buffer received from rootPet + if (.not.isFlag) then + call ESMF_ReconcileDeserializeAll(state, vm, attreconflag, buffer, & + rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & rcToReturn=rc)) return endif - ! ------------------------------------------------------------------------- - if (trace) then - call ESMF_ReconcileDebugPrint (ESMF_METHOD // & - ': *** Step 6 - Serialize needs', ask=.false.) - end if - call ESMF_ReconcileSerialize (state, vm, siwrap, & - needs_list=recvd_needs_matrix, & - attreconflag=attreconflag, & - id_info=id_info, & - rc=localrc) - if (debug) & - localrc = ESMF_ReconcileAllRC (vm, localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, & - rcToReturn=rc)) return - deallocate (recvd_needs_matrix, stat=memstat) - if (ESMF_LogFoundDeallocError(memstat, ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, & - rcToReturn=rc)) return - ! ------------------------------------------------------------------------- - if (profile) then - call ESMF_TraceRegionExit("(6) Serialize needed objects", rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, & - rcToReturn=rc)) return - endif - ! ------------------------------------------------------------------------- - if (meminfo) call ESMF_VMLogMemInfo ("after (6) Serialize needed objects") - - ! ------------------------------------------------------------------------- - ! (7) Send/receive serialized objects to whoever needed them - ! ------------------------------------------------------------------------- - if (profile) then - call ESMF_TraceRegionEnter("(7) Send/receive serialized objects", rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, & - rcToReturn=rc)) return - endif - ! ------------------------------------------------------------------------- - if (trace) then - call ESMF_ReconcileDebugPrint (ESMF_METHOD // & - ': *** Step 7 - Exchange serialized objects') - end if - allocate (items_recv(0:petCount-1), stat=memstat) - if (ESMF_LogFoundAllocError(memstat, ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, & - rcToReturn=rc)) return - buffer_recv => null () - call ESMF_ReconcileExchgItems (vm, & - id_info=id_info, & - recv_items=items_recv, & ! %cptr aliased to portions of buffer_recv - recv_buffer=buffer_recv, & - rc=localrc) - if (debug) & - localrc = ESMF_ReconcileAllRC (vm, localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, & - rcToReturn=rc)) return - ! ------------------------------------------------------------------------- - if (profile) then - call ESMF_TraceRegionExit("(7) Send/receive serialized objects", rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, & - rcToReturn=rc)) return - endif - ! ------------------------------------------------------------------------- - if (meminfo) call ESMF_VMLogMemInfo ("after (7) Send/receive serialized objects") - - ! ------------------------------------------------------------------------- - ! (8) Deserialize received objects and create proxies (recurse on - ! nested States as needed) - ! ------------------------------------------------------------------------- - if (profile) then - call ESMF_TraceRegionEnter("(8) Deserialize received objects and create proxies", rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, & - rcToReturn=rc)) return - endif - ! ------------------------------------------------------------------------- - if (trace) then - call ESMF_ReconcileDebugPrint (ESMF_METHOD // & - ': *** Step 8 - Deserialize needs') - end if - do, i=0, petCount-1 - if (debug) then - write (*, '(a,i0,a,i0,a,l1)') & - ' PET ', localPet, ': Deserializing from PET ', i, & - ', associated (items_recv(i)%cptr) =', associated (items_recv(i)%cptr) - end if - if (associated (items_recv(i)%cptr)) then - if (debug) then - print *, ' items_recv(', lbound (items_recv(i)%cptr), & - ':', ubound (items_recv(i)%cptr), ')' - end if - call ESMF_ReconcileDeserialize (state, vm, & - obj_buffer=items_recv(i)%cptr, & - attreconflag=attreconflag, & - rc=localrc) - else - localrc = ESMF_SUCCESS - end if - if (debug) & - localrc = ESMF_ReconcileAllRC (vm, localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, & - rcToReturn=rc)) return - end do - if (trace) then - call ESMF_ReconcileDebugPrint (ESMF_METHOD // & - ': *** Step 8 - Complete') - end if - - ! ------------------------------------------------------------------------- - if (profile) then - call ESMF_TraceRegionExit("(8) Deserialize received objects and create proxies", rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, & - rcToReturn=rc)) return - endif - ! ------------------------------------------------------------------------- - if (meminfo) call ESMF_VMLogMemInfo ("after (8) Deserialize received objects and create proxies") - - ! Clean up - - if (associated (buffer_recv)) then - deallocate (buffer_recv, stat=memstat) - if (ESMF_LogFoundDeallocError (memstat, ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, & - rcToReturn=rc)) return - end if - do, i=0, ubound (id_info, 1) - if (associated (id_info(i)%id)) then - deallocate (id_info(i)%id, id_info(i)%vmid, id_info(i)%needed, & - stat=memstat) - if (ESMF_LogFoundDeallocError(memstat, ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, & - rcToReturn=rc)) return - end if - if (associated (id_info(i)%item_buffer)) then - deallocate (id_info(i)%item_buffer, & - stat=memstat) - if (ESMF_LogFoundDeallocError(memstat, ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, & - rcToReturn=rc)) return - end if - end do - deallocate (id_info, stat=memstat) - if (ESMF_LogFoundDeallocError(memstat, ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, & - rcToReturn=rc)) return + ! Get rid of buffer + deallocate(buffer) - end subroutine ESMF_ReconcileBruteForce + end subroutine ESMF_ReconcileSingleCompCase !------------------------------------------------------------------------------ #undef ESMF_METHOD -#define ESMF_METHOD "ESMF_ReconcileSingleCompCase" +#define ESMF_METHOD "ESMF_ReconcileSerializeAll" !BOPI -! !IROUTINE: ESMF_ReconcileSingleCompCase +! !IROUTINE: ESMF_ReconcileSerializeAll ! ! !INTERFACE: - subroutine ESMF_ReconcileSingleCompCase(state, vm, vmId, vmIntId, & - attreconflag, siwrap, vmintids_send, rc) + subroutine ESMF_ReconcileSerializeAll(state, itemList, itemCount, & + attreconflag, siwrap, buffer, rc) ! ! !ARGUMENTS: - type(ESMF_State), intent(inout) :: state - type(ESMF_VM), intent(in) :: vm - type(ESMF_VMId), pointer, intent(in) :: vmId - integer, intent(in) :: vmIntId - type(ESMF_AttReconcileFlag), intent(in) :: attreconflag - type(ESMF_StateItemWrap), pointer, intent(in) :: siwrap(:) - integer, pointer, intent(in) :: vmintids_send(:) - integer, intent(out) :: rc + type(ESMF_State), intent(in) :: state + integer, intent(in) :: itemList(:) + integer, intent(in) :: itemCount + type(ESMF_AttReconcileFlag),intent(in) :: attreconflag + type(ESMF_StateItemWrap), intent(in) :: siwrap(:) + character, pointer, intent(out) :: buffer(:) + integer, intent(out) :: rc ! ! !DESCRIPTION: ! -! Handle the single component reconciliation case. This is the expected -! situation under NUOPC rules. -! ! The arguments are: ! \begin{description} ! \item[state] -! The {\tt ESMF\_State} to reconcile. -! \item[vm] -! The {\tt ESMF\_VM} object across which to reconcile {\tt state}. -! \item[vmId] -! The {\tt ESMF\_VMId} of the objects in {\tt state} to reconcile. -! \item[vmIntId] -! The integer VMId of the objects in {\tt state} to reconcile. +! The {\tt ESMF\_State} to collect information from. +! \item[itemList] +! List of indices into siwrap(:) for items that need to be serialized. +! \item[itemCount] +! Number of items in itemList. The incoming allocation might be larger. ! \item[attreconflag] -! Flag indicating whether attributes need to be reconciled. +! Flag to indicate attribute reconciliation. ! \item[siwrap] ! List of local state items. -! \item[vmintids_send] -! The integer VMId for each local state item. +! \item[buffer] +! Buffer ! \item[rc] ! Return code; equals {\tt ESMF\_SUCCESS} if there are no errors. ! \end{description} !EOPI - integer :: localrc, i - integer :: petCount, localPet, rootVas, rootPet, vas - integer :: sizeBuffer(1), itemCount - logical :: isFlag - character, pointer :: buffer(:) - integer, allocatable :: itemList(:) + integer :: localrc, i + integer :: memstat + type(ESMF_StateItem), pointer :: stateItem + type(ESMF_State) :: wrapper + integer :: itemType + integer :: itemSize + integer :: sizeBuffer, posBuffer + character, pointer :: fakeBuffer(:) ! when inquiring sizes + integer :: sizeFakeBuffer + type(ESMF_InquireFlag) :: inqflag - rc = ESMF_SUCCESS + ! Init to not implemented + localrc = ESMF_RC_NOT_IMPL #ifdef RECONCILE_LOG_on - block - character(ESMF_MAXSTR) :: stateName - call ESMF_StateGet(state, name=stateName, rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & - rcToReturn=rc)) return - call ESMF_LogWrite("ESMF_ReconcileSingleCompCase() for State: "//trim(stateName), & - ESMF_LOGMSG_DEBUG, rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & - rcToReturn=rc)) return - end block + call ESMF_LogWrite("ESMF_ReconcileSerializeAll()", & + ESMF_LOGMSG_DEBUG, rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & + rcToReturn=rc)) return #endif - call ESMF_VMGet(vm, petCount=petCount, localPet=localPet, rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & - rcToReturn=rc)) return + !!!!! Calculate buffer size !!!!! - call ESMF_VMIdGet(vmId, leftMostOnBit=rootVas, rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & - rcToReturn=rc)) return + ! Start with number of items + sizeBuffer=ESMF_SIZEOF_DEFINT - ! search for first PET in VM that executes on rootVas -> use as rootPet - do rootPet=0, petCount-1 - call ESMF_VMGet(vm, pet=rootPet, vas=vas, rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & - rcToReturn=rc)) return - if (vas==rootVas) exit ! found - enddo - if (rootPet==petCount) then - call ESMF_LogSetError(ESMF_RC_INTNRL_INCONS, & - msg="Could not find PET that executes on the identified VAS", & - ESMF_CONTEXT, rcToReturn=rc) - return - endif + ! Allocate a fake buffer for passing in when asking for size + allocate(fakeBuffer(0:ESMF_SIZEOF_DEFINT-1)) -#ifdef RECONCILE_LOG_on - block - character(160) :: msgStr - write(msgStr,*) "SingleCompCase rootVas=", rootVas - call ESMF_LogWrite(msgStr, ESMF_LOGMSG_DEBUG, rc=localrc) + ! Fake buffer size + sizeFakeBuffer=size(fakeBuffer) + + ! Set flag to only check size + inqflag = ESMF_INQUIREONLY + + ! Loop over items in itemList and determine buffer size needed + do i=1, itemCount + + ! Get one State Item + stateItem => siwrap(itemList(i))%si + + ! Get item type + itemType = stateitem%otype%ot + + ! Init itemSize to 0, so when we ask for the offset, + ! we are also getting the size + itemSize=0 + + ! Get size of item to serialize + select case (itemType) + case (ESMF_STATEITEM_FIELDBUNDLE%ot) + call ESMF_FieldBundleSerialize(stateItem%datap%fbp, & + fakeBuffer, sizeFakeBuffer, itemSize, & + attreconflag=attreconflag, inquireflag=inqflag, & + rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & + rcToReturn=rc)) return +#ifdef RECONCILE_LOG_on + block + character(ESMF_MAXSTR) :: itemName + character(160) :: msgStr + call ESMF_FieldBundleGet(stateItem%datap%fbp, name=itemName, & + rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & + rcToReturn=rc)) return + write(msgStr,*) "Serialize FieldBundle '"//trim(itemName)//"' "//& + " size=", itemSize + call ESMF_LogWrite(msgStr, ESMF_LOGMSG_DEBUG, rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & + rcToReturn=rc)) return + end block +#endif + case (ESMF_STATEITEM_FIELD%ot) + call ESMF_FieldSerialize(stateItem%datap%fp, & + fakeBuffer, sizeFakeBuffer, itemSize, & + attreconflag=attreconflag, inquireflag=inqflag, & + rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & + rcToReturn=rc)) return +#ifdef RECONCILE_LOG_on + block + character(ESMF_MAXSTR) :: itemName + character(160) :: msgStr + call ESMF_FieldGet(stateItem%datap%fp, name=itemName, & + rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & + rcToReturn=rc)) return + write(msgStr,*) "Serialize Field '"//trim(itemName)//"' "//& + " size=", itemSize + call ESMF_LogWrite(msgStr, ESMF_LOGMSG_DEBUG, rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & + rcToReturn=rc)) return + end block +#endif + case (ESMF_STATEITEM_ARRAY%ot) + call c_ESMC_ArraySerialize(stateitem%datap%ap, & + fakeBuffer, sizeFakeBuffer, itemSize, & + attreconflag, inqflag, & + localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & + rcToReturn=rc)) return +#ifdef RECONCILE_LOG_on + block + character(ESMF_MAXSTR) :: itemName + character(160) :: msgStr + call ESMF_ArrayGet(stateItem%datap%ap, name=itemName, & + rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & + rcToReturn=rc)) return + write(msgStr,*) "Serialize Array '"//trim(itemName)//"' "//& + " size=", itemSize + call ESMF_LogWrite(msgStr, ESMF_LOGMSG_DEBUG, rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & + rcToReturn=rc)) return + end block +#endif + case (ESMF_STATEITEM_ARRAYBUNDLE%ot) + call c_ESMC_ArrayBundleSerialize(stateitem%datap%abp, & + fakeBuffer, sizeFakeBuffer, itemSize, & + attreconflag, inqflag, & + localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & + rcToReturn=rc)) return +#ifdef RECONCILE_LOG_on + block + character(ESMF_MAXSTR) :: itemName + character(160) :: msgStr + call ESMF_ArrayBundleGet(stateItem%datap%abp, name=itemName, & + rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & + rcToReturn=rc)) return + write(msgStr,*) "Serialize ArrayBundle '"//trim(itemName)//"' "//& + " size=", itemSize + call ESMF_LogWrite(msgStr, ESMF_LOGMSG_DEBUG, rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & + rcToReturn=rc)) return + end block +#endif + case (ESMF_STATEITEM_STATE%ot) + wrapper%statep => stateitem%datap%spp + ESMF_INIT_SET_CREATED(wrapper) + call ESMF_StateSerialize(wrapper, & + fakeBuffer, sizeFakeBuffer, itemSize, & + attreconflag=attreconflag, inquireflag=inqflag, & + rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & + rcToReturn=rc)) return +#ifdef RECONCILE_LOG_on + block + character(ESMF_MAXSTR) :: itemName + character(160) :: msgStr + call ESMF_StateGet(wrapper, name=itemName, & + rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & + rcToReturn=rc)) return + write(msgStr,*) "Serialize State '"//trim(itemName)//"' "//& + " size=", itemSize + call ESMF_LogWrite(msgStr, ESMF_LOGMSG_DEBUG, rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & + rcToReturn=rc)) return + end block +#endif + case (ESMF_STATEITEM_ROUTEHANDLE%ot) + ! Do nothing for RouteHandles. There is no need to reconcile them. + case default + call ESMF_LogSetError(ESMF_RC_INTNRL_INCONS, & + msg="Unrecognized item type.", & + ESMF_CONTEXT, & + rcToReturn=rc) + return + end select + + ! Add item type's size + sizeBuffer = sizeBuffer + ESMF_SIZEOF_DEFINT + + ! Update buffer size by itemSize + sizeBuffer = sizeBuffer + itemSize + enddo + + ! Get rid of fakeBuffer + deallocate(fakeBuffer) + + !!!!! Allocate buffer to serialize into !!!!! + allocate(buffer(0:sizeBuffer-1), stat=memstat) + if (ESMF_LogFoundAllocError(memstat, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, & + rcToReturn=rc)) return + + !!!!! Serialize information into buffer !!!!! + + ! Start position of buffer + posBuffer = 0 + + ! Put item count in buffer + buffer(posBuffer:posBuffer+ESMF_SIZEOF_DEFINT-1) = transfer ( & + source=itemCount, & + mold=buffer(0:ESMF_SIZEOF_DEFINT-1)) + posBuffer = posbuffer + ESMF_SIZEOF_DEFINT + + ! Set flag to actually serialize + inqflag = ESMF_NOINQUIRE + + ! Loop over items in itemList and add to buffer + do i=1, itemCount + + ! Get one State Item + stateItem => siwrap(itemList(i))%si + + ! Get item type + itemType = stateitem%otype%ot + + ! Add item type to buffer + buffer(posBuffer:posBuffer+ESMF_SIZEOF_DEFINT-1) = transfer (& + source=itemType, & + mold =buffer(0:ESMF_SIZEOF_DEFINT-1)) + posBuffer = posbuffer + ESMF_SIZEOF_DEFINT + + ! Add serialized items + select case (itemType) + case (ESMF_STATEITEM_FIELDBUNDLE%ot) + call ESMF_FieldBundleSerialize(stateItem%datap%fbp, & + buffer, sizeBuffer, posBuffer, & + attreconflag=attreconflag, inquireflag=inqflag, & + rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & + rcToReturn=rc)) return + case (ESMF_STATEITEM_FIELD%ot) + call ESMF_FieldSerialize(stateItem%datap%fp, & + buffer, sizeBuffer, posBuffer, & + attreconflag=attreconflag, inquireflag=inqflag, & + rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & + rcToReturn=rc)) return + case (ESMF_STATEITEM_ARRAY%ot) + call c_ESMC_ArraySerialize(stateitem%datap%ap, & + buffer, sizeBuffer, posBuffer, & + attreconflag, inqflag, & + localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & + rcToReturn=rc)) return + case (ESMF_STATEITEM_ARRAYBUNDLE%ot) + call c_ESMC_ArrayBundleSerialize(stateitem%datap%abp, & + buffer, sizeBuffer, posBuffer, & + attreconflag, inqflag, & + localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & + rcToReturn=rc)) return + case (ESMF_STATEITEM_STATE%ot) + wrapper%statep => stateitem%datap%spp + ESMF_INIT_SET_CREATED(wrapper) + call ESMF_StateSerialize(wrapper, & + buffer, sizeBuffer, posBuffer, & + attreconflag=attreconflag, inquireflag=inqflag, & + rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & + rcToReturn=rc)) return + case (ESMF_STATEITEM_ROUTEHANDLE%ot) + ! Do nothing for RouteHandles. There is no need to reconcile them. + case default + call ESMF_LogSetError(ESMF_RC_INTNRL_INCONS, & + msg="Unrecognized item type.", & + ESMF_CONTEXT, & + rcToReturn=rc) + return + end select + enddo + + ! Return success + rc = ESMF_SUCCESS + + end subroutine ESMF_ReconcileSerializeAll + +!------------------------------------------------------------------------------ +#undef ESMF_METHOD +#define ESMF_METHOD "ESMF_ReconcileDeserializeAll" +!BOPI +! !IROUTINE: ESMF_ReconcileDeserializeAll + +! !INTERFACE: + subroutine ESMF_ReconcileDeserializeAll(state, vm, attreconflag, buffer, rc) +! +! !ARGUMENTS: + type (ESMF_State), intent(inout) :: state + type (ESMF_VM), intent(in) :: vm + type(ESMF_AttReconcileFlag),intent(in):: attreconflag + character, pointer,intent(in) :: buffer(:) + integer, intent(out) :: rc +! +! !DESCRIPTION: +! Builds proxy items for each of the items in the buffer. +! +! The arguments are: +! \begin{description} +! \item[state] +! {\tt ESMF\_State} to add proxy objects to. +! \item[vm] +! {\tt ESMF\_VM} to use. +! \item[attreconflag] +! Flag to indicate attribute reconciliation. +! \item[buffer] +! Buffer of serialized State objects (intent(in)) +! \item[rc] +! Return code; equals {\tt ESMF\_SUCCESS} if there are no errors. +! \end{description} +!EOPI + + integer :: localrc + integer :: memstat + + type(ESMF_FieldBundle) :: fieldbundle + type(ESMF_Field) :: field + type(ESMF_Array) :: array + type(ESMF_ArrayBundle) :: arraybundle + type(ESMF_State) :: substate + + integer :: stateitem_type + character(ESMF_MAXSTR) :: errstring + character(ESMF_MAXSTR) :: name + integer :: localPet + logical, parameter :: debug = .false. + logical, parameter :: trace = .false. + + integer :: item, numNewItems + integer :: itemType + integer :: sizeBuffer, posBuffer + +#ifdef RECONCILE_LOG_on + call ESMF_LogWrite("ESMF_ReconcileDeserializeAll()", & + ESMF_LOGMSG_DEBUG, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & rcToReturn=rc)) return - write(msgStr,*) "SingleCompCase rootPet=", rootPet - call ESMF_LogWrite(msgStr, ESMF_LOGMSG_DEBUG, rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & +#endif + + ! VM information for debug output + call ESMF_VMGet (vm, localPet=localPet, rc=localrc) + if (ESMF_LogFoundError (localrc, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, & + rcToReturn=rc)) return + + ! Set start position of buffer + posBuffer = 0 + + ! Get the number of items to add + numNewItems = transfer ( & + source=buffer(posBuffer:posBuffer+ESMF_SIZEOF_DEFINT-1), & + mold = numNewItems) + posBuffer = posbuffer + ESMF_SIZEOF_DEFINT + + ! Loop getting new items + do item=1, numNewItems + + ! Get item type + itemType = transfer ( & + source=buffer(posBuffer:posBuffer+ESMF_SIZEOF_DEFINT-1), & + mold = itemType) + posBuffer = posbuffer + ESMF_SIZEOF_DEFINT + + ! Get items + select case (itemType) + case (ESMF_STATEITEM_FIELDBUNDLE%ot) + if (debug) then + print *, "deserializing FieldBundle, pos =",posBuffer + end if + fieldbundle = ESMF_FieldBundleDeserialize(buffer, posBuffer, & + attreconflag=attreconflag, rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, & + rcToReturn=rc)) return + + call ESMF_StateAdd(state, fieldbundle, & + addflag=.true., proxyflag=.true., & + rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, & + rcToReturn=rc)) return + + case (ESMF_STATEITEM_FIELD%ot) + if (debug) then + print *, "deserializing Field, pos =", posBuffer + end if + field = ESMF_FieldDeserialize(buffer, posBuffer, & + attreconflag=attreconflag, rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, & + rcToReturn=rc)) return + + ! Debug + call ESMF_FieldGet(field, name=name, rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, & + rcToReturn=rc)) return + + if (debug) then + print *, "created field, ready to add to local state" + end if + + call ESMF_StateAdd(state, field, & + addflag=.true., proxyflag=.true., & + rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, & + rcToReturn=rc)) return + + case (ESMF_STATEITEM_ARRAY%ot) + if (debug) then + print *, " PET", localPet, & + ": deserializing Array pos =",posBuffer + end if + call c_ESMC_ArrayDeserialize(array, buffer, posBuffer, & + attreconflag, localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, & + rcToReturn=rc)) return + + ! Set init code + call ESMF_ArraySetInitCreated(array, rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, & + rcToReturn=rc)) return + + call ESMF_StateAdd(state, array, & + addflag=.true., proxyflag=.true., & + rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, & + rcToReturn=rc)) return + + case (ESMF_STATEITEM_ARRAYBUNDLE%ot) + if (debug) then + print *, "deserializing ArrayBundle pos =",posBuffer + end if + call c_ESMC_ArrayBundleDeserialize(arraybundle, buffer, posBuffer, & + attreconflag, localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, & + rcToReturn=rc)) return + + ! Set init code + call ESMF_ArrayBundleSetInitCreated(arraybundle, rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, & + rcToReturn=rc)) return + + call ESMF_StateAdd(state, arraybundle, & + addflag=.true., proxyflag=.true., & + rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, & + rcToReturn=rc)) return + + case (ESMF_STATEITEM_STATE%ot) + if (debug) then + print *, "deserializing nested State pos =",posBuffer + end if + substate = ESMF_StateDeserialize(vm, buffer, posBuffer, & + attreconflag=attreconflag, rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, & + rcToReturn=rc)) return + + call ESMF_StateAdd(state, substate, & + addflag=.true., proxyflag=.true., & + rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, & + rcToReturn=rc)) return + + case (ESMF_STATEITEM_UNKNOWN%ot) + write (errstring, '(a,i0)') 'can''t deserialize unknown type: ', itemType + if (ESMF_LogFoundError(ESMF_RC_INTNRL_INCONS, msg=errstring, & + ESMF_CONTEXT, & + rcToReturn=rc)) return + + case default + write (errstring, '(a,i0)') 'can''t deserialize unsupported type: ', itemType + if (ESMF_LogFoundError(ESMF_RC_INTNRL_INCONS, msg=errstring, & + ESMF_CONTEXT, & + rcToReturn=rc)) return + end select + + enddo + + + ! Return success + rc = ESMF_SUCCESS + + end subroutine ESMF_ReconcileDeserializeAll + +!------------------------------------------------------------------------------ +#undef ESMF_METHOD +#define ESMF_METHOD "ESMF_ReconcileBruteForce" +!BOPI +! !IROUTINE: ESMF_ReconcileBruteForce +! +! !INTERFACE: + subroutine ESMF_ReconcileBruteForce(state, vm, attreconflag, siwrap, & + ids_send, vmids_send, vmintids_send, nitems_buf, rc) +! +! !ARGUMENTS: + type(ESMF_State), intent(inout) :: state + type(ESMF_VM), intent(in) :: vm + type(ESMF_AttReconcileFlag), intent(in) :: attreconflag + type(ESMF_StateItemWrap), pointer, intent(in) :: siwrap(:) + integer, pointer, intent(in) :: ids_send(:) + type(ESMF_VMId), pointer, intent(in) :: vmids_send(:) + integer, pointer, intent(in) :: vmintids_send(:) + integer, pointer, intent(in) :: nitems_buf(:) + integer, intent(out) :: rc +! +! !DESCRIPTION: +! +! Brute force reconciliation across all of the PETs using Alltoall +! communications. This should be able to reconcile any conceivable situation. +! +! The arguments are: +! \begin{description} +! \item[state] +! The {\tt ESMF\_State} to reconcile. +! \item[vm] +! The {\tt ESMF\_VM} object across which the state is reconciled. +! \item[attreconflag] +! Flag indicating whether attributes need to be reconciled. +! \item[siwrap] +! List of local state items. +! \item[rc] +! Return code; equals {\tt ESMF\_SUCCESS} if there are no errors. +! \end{description} +!EOPI + + integer :: localrc + integer :: memstat + integer :: localPet, petCount + integer :: i + + type(ESMF_ReconcileIDInfo), allocatable :: id_info(:) + type(ESMF_CharPtr), allocatable :: items_recv(:) + logical, pointer :: recvd_needs_matrix(:,:) + character, pointer :: buffer_recv(:) + + logical, parameter :: meminfo = .false. + logical, parameter :: profile = .true. + + rc = ESMF_SUCCESS + +#ifdef RECONCILE_LOG_on + block + character(ESMF_MAXSTR) :: stateName + call ESMF_StateGet(state, name=stateName, rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, & + rcToReturn=rc)) return + call ESMF_LogWrite("ESMF_ReconcileBruteForce() for State: "//trim(stateName), & + ESMF_LOGMSG_DEBUG, rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, & + rcToReturn=rc)) return + end block +#endif + + call ESMF_VMGet(vm, petCount=petCount, localPet=localPet, rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, & + rcToReturn=rc)) return + + ! ------------------------------------------------------------------------- + ! (3) All PETs send their items Ids and VMIds to all the other PETs, + ! then create local directories of which PETs have which ids/VMIds. + ! ------------------------------------------------------------------------- + if (profile) then + call ESMF_TraceRegionEnter("(3) Send arrays exchange", rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, & + rcToReturn=rc)) return + endif + ! ------------------------------------------------------------------------- + if (trace) then + call ESMF_ReconcileDebugPrint (ESMF_METHOD // & + ': *** Step 3 - Exchange Ids/VMIds') + end if + allocate (id_info(0:petCount-1), stat=memstat) + if (ESMF_LogFoundAllocError(memstat, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, & + rcToReturn=rc)) return + call ESMF_ReconcileExchgIDInfo (vm, & + nitems_buf=nitems_buf, & + id=ids_send, & + vmid=vmintids_send, & + id_info=id_info, & + rc=localrc) + if (debug) & + localrc = ESMF_ReconcileAllRC (vm, localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, & + rcToReturn=rc)) return + ! ------------------------------------------------------------------------- + if (profile) then + call ESMF_TraceRegionExit("(3) Send arrays exchange", rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, & + rcToReturn=rc)) return + endif + ! ------------------------------------------------------------------------- + if (meminfo) call ESMF_VMLogMemInfo ("after (3) Send arrays exchange") + +! At this point, each PET knows what items can be found on all of +! the other PETs. The id_info array has global PET info in it. + + ! ------------------------------------------------------------------------- + ! (4) Construct needs list. Receiving PETs compare IDs and VMIds + ! in their send ID/VMId array with what was received from the + ! currently-being-processed sending PET. Note that multiple PETs + ! can 'offer' an item. + ! ------------------------------------------------------------------------- + if (profile) then + call ESMF_TraceRegionEnter("(4) Construct needs list", rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, & + rcToReturn=rc)) return + endif + ! ------------------------------------------------------------------------- + if (trace) then + call ESMF_ReconcileDebugPrint (ESMF_METHOD // & + ': *** Step 4 - Compare and create needs arrays') + end if + call ESMF_ReconcileCompareNeeds (vm, & + id= ids_send, & + vmid=vmintids_send, & + id_info=id_info, & + rc=localrc) + if (debug) & + localrc = ESMF_ReconcileAllRC (vm, localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, & rcToReturn=rc)) return - write(msgStr,*) "SingleCompCase size(siwrap)=", size(siwrap) - call ESMF_LogWrite(msgStr, ESMF_LOGMSG_DEBUG, rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & + ! ------------------------------------------------------------------------- + if (profile) then + call ESMF_TraceRegionExit("(4) Construct needs list", rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, & rcToReturn=rc)) return - end block -#endif + endif + ! ------------------------------------------------------------------------- + if (meminfo) call ESMF_VMLogMemInfo ("after (4) Construct needs list") - ! On rootPet: construct itemList and serialize - if (localPet==rootPet) then - ! itemList to hold indices into siwrap(:) of objects that need to be sent - allocate(itemList(ubound(vmintids_send,1))) ! max number of items possible - itemCount=0 - do i=1, size(itemList) - if (vmintids_send(i)==vmIntId) then - ! the integer VMId of object "i" matches that of handled single comp - itemCount = itemCount+1 - itemList(itemCount) = i - endif - enddo - ! serialize all items in itemList - call ESMF_ReconcileSerializeAll(state, itemList, itemCount, & - attreconflag, siwrap, buffer, rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & + ! ------------------------------------------------------------------------- + ! (5) Communicate needs back to the offering PETs. + ! Send to each offering PET a buffer containing 'needed' array + ! specifying which items are needed. The array is the same size as, + ! and corresponds to, the ID and VMId arrays that were previously + ! offered. + ! ------------------------------------------------------------------------- + if (profile) then + call ESMF_TraceRegionEnter("(5) Communicate needs back", rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, & + rcToReturn=rc)) return + endif + ! ------------------------------------------------------------------------- + if (trace) then + call ESMF_ReconcileDebugPrint (ESMF_METHOD // & + ': *** Step 5 - Exchange needs') + end if + recvd_needs_matrix => null () + call ESMF_ReconcileExchgNeeds (vm, & + id_info=id_info, & + recv_needs=recvd_needs_matrix, & + rc=localrc) + if (debug) & + localrc = ESMF_ReconcileAllRC (vm, localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, & + rcToReturn=rc)) return + ! ------------------------------------------------------------------------- + if (profile) then + call ESMF_TraceRegionExit("(5) Communicate needs back", rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, & rcToReturn=rc)) return - sizeBuffer(1) = size(buffer) - ! cleanup - deallocate(itemList) endif + ! ------------------------------------------------------------------------- + if (meminfo) call ESMF_VMLogMemInfo ("after (5) Communicate needs back") - ! Broadcast buffer across all PETs - call ESMF_VMBroadcast(vm, sizeBuffer, count=1, rootPet=rootPet, rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & - rcToReturn=rc)) return + ! ------------------------------------------------------------------------- + ! (6) Serialize needed objects + ! ------------------------------------------------------------------------- + if (profile) then + call ESMF_TraceRegionEnter("(6) Serialize needed objects", rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, & + rcToReturn=rc)) return + endif + ! ------------------------------------------------------------------------- + if (trace) then + call ESMF_ReconcileDebugPrint (ESMF_METHOD // & + ': *** Step 6 - Serialize needs', ask=.false.) + end if + call ESMF_ReconcileSerialize (state, vm, siwrap, & + needs_list=recvd_needs_matrix, & + attreconflag=attreconflag, & + id_info=id_info, & + rc=localrc) + if (debug) & + localrc = ESMF_ReconcileAllRC (vm, localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, & + rcToReturn=rc)) return + deallocate (recvd_needs_matrix, stat=memstat) + if (ESMF_LogFoundDeallocError(memstat, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, & + rcToReturn=rc)) return + ! ------------------------------------------------------------------------- + if (profile) then + call ESMF_TraceRegionExit("(6) Serialize needed objects", rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, & + rcToReturn=rc)) return + endif + ! ------------------------------------------------------------------------- + if (meminfo) call ESMF_VMLogMemInfo ("after (6) Serialize needed objects") -#ifdef RECONCILE_LOG_on - block - character(160) :: msgStr - write(msgStr,*) "SingleCompCase sizeBuffer=", sizeBuffer(1) - call ESMF_LogWrite(msgStr, ESMF_LOGMSG_DEBUG, rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & + ! ------------------------------------------------------------------------- + ! (7) Send/receive serialized objects to whoever needed them + ! ------------------------------------------------------------------------- + if (profile) then + call ESMF_TraceRegionEnter("(7) Send/receive serialized objects", rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, & rcToReturn=rc)) return - end block -#endif + endif + ! ------------------------------------------------------------------------- + if (trace) then + call ESMF_ReconcileDebugPrint (ESMF_METHOD // & + ': *** Step 7 - Exchange serialized objects') + end if + allocate (items_recv(0:petCount-1), stat=memstat) + if (ESMF_LogFoundAllocError(memstat, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, & + rcToReturn=rc)) return + buffer_recv => null () + call ESMF_ReconcileExchgItems (vm, & + id_info=id_info, & + recv_items=items_recv, & ! %cptr aliased to portions of buffer_recv + recv_buffer=buffer_recv, & + rc=localrc) + if (debug) & + localrc = ESMF_ReconcileAllRC (vm, localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, & + rcToReturn=rc)) return + ! ------------------------------------------------------------------------- + if (profile) then + call ESMF_TraceRegionExit("(7) Send/receive serialized objects", rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, & + rcToReturn=rc)) return + endif + ! ------------------------------------------------------------------------- + if (meminfo) call ESMF_VMLogMemInfo ("after (7) Send/receive serialized objects") - if (localPet/=rootPet) allocate(buffer(0:sizeBuffer(1)-1)) + ! ------------------------------------------------------------------------- + ! (8) Deserialize received objects and create proxies (recurse on + ! nested States as needed) + ! ------------------------------------------------------------------------- + if (profile) then + call ESMF_TraceRegionEnter("(8) Deserialize received objects and create proxies", rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, & + rcToReturn=rc)) return + endif + ! ------------------------------------------------------------------------- + if (trace) then + call ESMF_ReconcileDebugPrint (ESMF_METHOD // & + ': *** Step 8 - Deserialize needs') + end if + do, i=0, petCount-1 + if (debug) then + write (*, '(a,i0,a,i0,a,l1)') & + ' PET ', localPet, ': Deserializing from PET ', i, & + ', associated (items_recv(i)%cptr) =', associated (items_recv(i)%cptr) + end if + if (associated (items_recv(i)%cptr)) then + if (debug) then + print *, ' items_recv(', lbound (items_recv(i)%cptr), & + ':', ubound (items_recv(i)%cptr), ')' + end if + call ESMF_ReconcileDeserialize (state, vm, & + obj_buffer=items_recv(i)%cptr, & + attreconflag=attreconflag, & + rc=localrc) + else + localrc = ESMF_SUCCESS + end if + if (debug) & + localrc = ESMF_ReconcileAllRC (vm, localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, & + rcToReturn=rc)) return + end do + if (trace) then + call ESMF_ReconcileDebugPrint (ESMF_METHOD // & + ': *** Step 8 - Complete') + end if - call ESMF_VMBroadcast(vm, buffer, count=sizeBuffer(1), rootPet=rootPet, & - rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & - rcToReturn=rc)) return + ! ------------------------------------------------------------------------- + if (profile) then + call ESMF_TraceRegionExit("(8) Deserialize received objects and create proxies", rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, & + rcToReturn=rc)) return + endif + ! ------------------------------------------------------------------------- + if (meminfo) call ESMF_VMLogMemInfo ("after (8) Deserialize received objects and create proxies") - ! determine if local PET is active under the vmId - call ESMF_VMIdGet(vmId, isLocalPetActive=isFlag, rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & - rcToReturn=rc)) return + ! Clean up -#ifdef RECONCILE_LOG_on - block - character(160) :: msgStr - write(msgStr,*) "SingleCompCase PET active isFlag=", isFlag - call ESMF_LogWrite(msgStr, ESMF_LOGMSG_DEBUG, rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & - rcToReturn=rc)) return - end block -#endif + if (associated (buffer_recv)) then + deallocate (buffer_recv, stat=memstat) + if (ESMF_LogFoundDeallocError (memstat, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, & + rcToReturn=rc)) return + end if - ! only inactive PETs deserialize the buffer received from rootPet - if (.not.isFlag) then - call ESMF_ReconcileDeserializeAll(state, vm, attreconflag, buffer, & - rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & + do, i=0, ubound (id_info, 1) + if (associated (id_info(i)%id)) then + deallocate (id_info(i)%id, id_info(i)%vmid, id_info(i)%needed, & + stat=memstat) + if (ESMF_LogFoundDeallocError(memstat, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, & + rcToReturn=rc)) return + end if + if (associated (id_info(i)%item_buffer)) then + deallocate (id_info(i)%item_buffer, & + stat=memstat) + if (ESMF_LogFoundDeallocError(memstat, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, & + rcToReturn=rc)) return + end if + end do + deallocate (id_info, stat=memstat) + if (ESMF_LogFoundDeallocError(memstat, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, & rcToReturn=rc)) return - endif - ! Get rid of buffer - deallocate(buffer) - - end subroutine ESMF_ReconcileSingleCompCase + end subroutine ESMF_ReconcileBruteForce !------------------------------------------------------------------------------ #undef ESMF_METHOD @@ -2471,247 +2999,8 @@ subroutine ESMF_ReconcileDeserialize (state, vm, obj_buffer, attreconflag, rc) if (debug) then print *, "deserializing ArrayBundle, offset =", buffer_offset end if - call c_ESMC_ArrayBundleDeserialize(arraybundle, obj_buffer, & - buffer_offset, attreconflag, localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, & - rcToReturn=rc)) return - - ! Set init code - call ESMF_ArrayBundleSetInitCreated(arraybundle, rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, & - rcToReturn=rc)) return - - call ESMF_StateAdd(state, arraybundle, & - addflag=.true., proxyflag=.true., & - rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, & - rcToReturn=rc)) return - - case (ESMF_STATEITEM_STATE%ot) - if (debug) then - print *, "deserializing nested State, offset =", buffer_offset - end if - substate = ESMF_StateDeserialize(vm, obj_buffer, buffer_offset, & - attreconflag=attreconflag, rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, & - rcToReturn=rc)) return - - call ESMF_StateAdd(state, substate, & - addflag=.true., proxyflag=.true., & - rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, & - rcToReturn=rc)) return - - case (ESMF_STATEITEM_UNKNOWN%ot) - write (errstring, '(a,i0)') 'can''t deserialize unknown type: ', stateitem_type - if (ESMF_LogFoundError(ESMF_RC_INTNRL_INCONS, msg=errstring, & - ESMF_CONTEXT, & - rcToReturn=rc)) return - - case default - write (errstring, '(a,i0)') 'can''t deserialize unsupported type: ', stateitem_type - if (ESMF_LogFoundError(ESMF_RC_INTNRL_INCONS, msg=errstring, & - ESMF_CONTEXT, & - rcToReturn=rc)) return - end select - -#if 0 - ! Use offset from table in case of an early exit from a deserialize method - -#if !defined (__G95__) - buffer_offset = transfer ( & - source=obj_buffer((i+1)*ESMF_SIZEOF_DEFINT:(i+2)*ESMF_SIZEOF_DEFINT-1), & - mold =i) -#else - ! g95 snapshots prior to April 4, 2010 have a bug in TRANSFER. - ! The following works around it. - buffer_offset = ESMF_Reconcile_g95_getint ( & - source=obj_buffer((i+1)*ESMF_SIZEOF_DEFINT:(i+2)*ESMF_SIZEOF_DEFINT-1)) -#endif - - if (debug) then - print *, ' buffer offset after item loop =', buffer_offset - end if -#endif - - end do ! needs_count - - if (trace) then - print *, ' pet', localPet, & - ': *** Deserialization complete' - end if - - rc = ESMF_SUCCESS - - end subroutine ESMF_ReconcileDeserialize - - -!------------------------------------------------------------------------------ -#undef ESMF_METHOD -#define ESMF_METHOD "ESMF_ReconcileDeserializeAll" -!BOPI -! !IROUTINE: ESMF_ReconcileDeserializeAll - -! !INTERFACE: - subroutine ESMF_ReconcileDeserializeAll(state, vm, attreconflag, buffer, rc) -! -! !ARGUMENTS: - type (ESMF_State), intent(inout) :: state - type (ESMF_VM), intent(in) :: vm - type(ESMF_AttReconcileFlag),intent(in):: attreconflag - character, pointer,intent(in) :: buffer(:) - integer, intent(out) :: rc -! -! !DESCRIPTION: -! Builds proxy items for each of the items in the buffer. -! -! The arguments are: -! \begin{description} -! \item[state] -! {\tt ESMF\_State} to add proxy objects to. -! \item[vm] -! {\tt ESMF\_VM} to use. -! \item[attreconflag] -! Flag to indicate attribute reconciliation. -! \item[buffer] -! Buffer of serialized State objects (intent(in)) -! \item[rc] -! Return code; equals {\tt ESMF\_SUCCESS} if there are no errors. -! \end{description} -!EOPI - - integer :: localrc - integer :: memstat - - type(ESMF_FieldBundle) :: fieldbundle - type(ESMF_Field) :: field - type(ESMF_Array) :: array - type(ESMF_ArrayBundle) :: arraybundle - type(ESMF_State) :: substate - - integer :: stateitem_type - character(ESMF_MAXSTR) :: errstring - character(ESMF_MAXSTR) :: name - integer :: localPet - logical, parameter :: debug = .false. - logical, parameter :: trace = .false. - - integer :: item, numNewItems - integer :: itemType - integer :: sizeBuffer, posBuffer - -#ifdef RECONCILE_LOG_on - call ESMF_LogWrite("ESMF_ReconcileDeserializeAll()", & - ESMF_LOGMSG_DEBUG, rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & - rcToReturn=rc)) return -#endif - - ! VM information for debug output - call ESMF_VMGet (vm, localPet=localPet, rc=localrc) - if (ESMF_LogFoundError (localrc, ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, & - rcToReturn=rc)) return - - ! Set start position of buffer - posBuffer = 0 - - ! Get the number of items to add - numNewItems = transfer ( & - source=buffer(posBuffer:posBuffer+ESMF_SIZEOF_DEFINT-1), & - mold = numNewItems) - posBuffer = posbuffer + ESMF_SIZEOF_DEFINT - - ! Loop getting new items - do item=1, numNewItems - - ! Get item type - itemType = transfer ( & - source=buffer(posBuffer:posBuffer+ESMF_SIZEOF_DEFINT-1), & - mold = itemType) - posBuffer = posbuffer + ESMF_SIZEOF_DEFINT - - ! Get items - select case (itemType) - case (ESMF_STATEITEM_FIELDBUNDLE%ot) - if (debug) then - print *, "deserializing FieldBundle, pos =",posBuffer - end if - fieldbundle = ESMF_FieldBundleDeserialize(buffer, posBuffer, & - attreconflag=attreconflag, rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, & - rcToReturn=rc)) return - - call ESMF_StateAdd(state, fieldbundle, & - addflag=.true., proxyflag=.true., & - rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, & - rcToReturn=rc)) return - - case (ESMF_STATEITEM_FIELD%ot) - if (debug) then - print *, "deserializing Field, pos =", posBuffer - end if - field = ESMF_FieldDeserialize(buffer, posBuffer, & - attreconflag=attreconflag, rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, & - rcToReturn=rc)) return - - ! Debug - call ESMF_FieldGet(field, name=name, rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, & - rcToReturn=rc)) return - - if (debug) then - print *, "created field, ready to add to local state" - end if - - call ESMF_StateAdd(state, field, & - addflag=.true., proxyflag=.true., & - rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, & - rcToReturn=rc)) return - - case (ESMF_STATEITEM_ARRAY%ot) - if (debug) then - print *, " PET", localPet, & - ": deserializing Array pos =",posBuffer - end if - call c_ESMC_ArrayDeserialize(array, buffer, posBuffer, & - attreconflag, localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, & - rcToReturn=rc)) return - - ! Set init code - call ESMF_ArraySetInitCreated(array, rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, & - rcToReturn=rc)) return - - call ESMF_StateAdd(state, array, & - addflag=.true., proxyflag=.true., & - rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, & - rcToReturn=rc)) return - - case (ESMF_STATEITEM_ARRAYBUNDLE%ot) - if (debug) then - print *, "deserializing ArrayBundle pos =",posBuffer - end if - call c_ESMC_ArrayBundleDeserialize(arraybundle, buffer, posBuffer, & - attreconflag, localrc) + call c_ESMC_ArrayBundleDeserialize(arraybundle, obj_buffer, & + buffer_offset, attreconflag, localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, & rcToReturn=rc)) return @@ -2731,9 +3020,9 @@ subroutine ESMF_ReconcileDeserializeAll(state, vm, attreconflag, buffer, rc) case (ESMF_STATEITEM_STATE%ot) if (debug) then - print *, "deserializing nested State pos =",posBuffer + print *, "deserializing nested State, offset =", buffer_offset end if - substate = ESMF_StateDeserialize(vm, buffer, posBuffer, & + substate = ESMF_StateDeserialize(vm, obj_buffer, buffer_offset, & attreconflag=attreconflag, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, & @@ -2747,27 +3036,48 @@ subroutine ESMF_ReconcileDeserializeAll(state, vm, attreconflag, buffer, rc) rcToReturn=rc)) return case (ESMF_STATEITEM_UNKNOWN%ot) - write (errstring, '(a,i0)') 'can''t deserialize unknown type: ', itemType + write (errstring, '(a,i0)') 'can''t deserialize unknown type: ', stateitem_type if (ESMF_LogFoundError(ESMF_RC_INTNRL_INCONS, msg=errstring, & ESMF_CONTEXT, & rcToReturn=rc)) return case default - write (errstring, '(a,i0)') 'can''t deserialize unsupported type: ', itemType + write (errstring, '(a,i0)') 'can''t deserialize unsupported type: ', stateitem_type if (ESMF_LogFoundError(ESMF_RC_INTNRL_INCONS, msg=errstring, & ESMF_CONTEXT, & rcToReturn=rc)) return end select - - enddo +#if 0 + ! Use offset from table in case of an early exit from a deserialize method + +#if !defined (__G95__) + buffer_offset = transfer ( & + source=obj_buffer((i+1)*ESMF_SIZEOF_DEFINT:(i+2)*ESMF_SIZEOF_DEFINT-1), & + mold =i) +#else + ! g95 snapshots prior to April 4, 2010 have a bug in TRANSFER. + ! The following works around it. + buffer_offset = ESMF_Reconcile_g95_getint ( & + source=obj_buffer((i+1)*ESMF_SIZEOF_DEFINT:(i+2)*ESMF_SIZEOF_DEFINT-1)) +#endif + + if (debug) then + print *, ' buffer offset after item loop =', buffer_offset + end if +#endif + + end do ! needs_count + + if (trace) then + print *, ' pet', localPet, & + ': *** Deserialization complete' + end if - ! Return success rc = ESMF_SUCCESS - end subroutine ESMF_ReconcileDeserializeAll + end subroutine ESMF_ReconcileDeserialize - !------------------------------------------------------------------------------ #undef ESMF_METHOD #define ESMF_METHOD "ESMF_ReconcileExchgAttributes" @@ -3293,302 +3603,57 @@ subroutine ESMF_ReconcileExchgIDInfo (vm, & ESMF_CONTEXT, & rcToReturn=rc)) return - do, send_pet=0, petCount-1 - if (debug) then - call ESMF_ReconcileDebugPrint (ESMF_METHOD // & - ': broadcasting VMId, using rootPet ' // iToS (send_pet), & - ask=.false.) - end if - call ESMF_VMBcastVMId (vm, & - bcstData=id_info(send_pet)%vmid, & - count=size (id_info(send_pet)%vmid), & - rootPet=send_pet, rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, & - rcToReturn=rc)) return - end do -#endif - - rc = localrc - - if (meminfo) call ESMF_VMLogMemInfo ('exiting ESMF_ReconcileExchgIDInfo') - - end subroutine ESMF_ReconcileExchgIDInfo - -!------------------------------------------------------------------------------ -#undef ESMF_METHOD -#define ESMF_METHOD "ESMF_ReconcileExchgItems" -!BOPI -! !IROUTINE: ESMF_ReconcileExchgItems -! -! !INTERFACE: - subroutine ESMF_ReconcileExchgItems (vm, id_info, recv_items, recv_buffer, rc) -! -! !ARGUMENTS: - type(ESMF_VM), intent(in) :: vm - type(ESMF_ReconcileIDInfo), intent(in) :: id_info(0:) - type(ESMF_CharPtr), intent(out) :: recv_items(0:) - character, pointer :: recv_buffer(:) ! intent(out) - integer, intent(out) :: rc -! -! !DESCRIPTION: -! -! Performs alltoallv communications of serialized data from offering PETs -! to PETs requesting items. -! -! The arguments are: -! \begin{description} -! \item[vm] -! The current {\tt ESMF\_VM} (virtual machine). -! \item[id_info] -! Array of arrays of global VMId info. -! \item[recv_items] -! Array of arrays of serialized item data. -! \item[rc] -! Return code; equals {\tt ESMF\_SUCCESS} if there are no errors. -! \end{description} -!EOPI - - integer :: localrc - integer :: memstat - integer :: localPet, petCount - integer :: i - integer :: itemcount, itemcount_global, itemcount_local - integer :: offset_pos - - integer, allocatable :: counts_recv(:), counts_send(:) - integer, allocatable :: offsets_recv(:), offsets_send(:) - character, allocatable :: buffer_send(:) - - character, pointer :: cptr_tmp(:) - - logical, parameter :: debug = .false. - logical, parameter :: meminfo = .false. - logical, parameter :: profile = .true. - - character(len=ESMF_MAXSTR) :: logmsg - - ! ------------------------------------------------------------------------- - - if (meminfo) call ESMF_VMLogMemInfo("entering ESMF_ReconcileExchgItems") - - localrc = ESMF_RC_NOT_IMPL - - call ESMF_VMGet(vm, localPet=localPet, petCount=petCount, rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, & - rcToReturn=rc)) return - - if (size (id_info) /= petCount) then - if (ESMF_LogFoundError(ESMF_RC_INTNRL_INCONS, & - msg="size (id_info) /= petCount", & - ESMF_CONTEXT, & - rcToReturn=rc)) return - end if - - if (size (recv_items) /= petCount) then - if (ESMF_LogFoundError(ESMF_RC_INTNRL_INCONS, & - msg="size (recv_items) /= petCount", & - ESMF_CONTEXT, & - rcToReturn=rc)) return - end if - -! Set up send counts, offsets, and buffer. - - allocate ( & - counts_send (0:petCount-1), & - offsets_send(0:petCount-1), & - stat=memstat) - if (ESMF_LogFoundAllocError(memstat, ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, & - rcToReturn=rc)) return - - do, i=0, petCount-1 - if (associated (id_info(i)%item_buffer)) then - counts_send(i) = size (id_info(i)%item_buffer) - else - counts_send(i) = 0 - end if - end do - - itemcount_local = counts_send(localPet) - itemcount_global = sum (counts_send) - - allocate ( & - buffer_send(0:max (0,itemcount_global-1)), & - stat=memstat) - if (ESMF_LogFoundAllocError(memstat, ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, & - rcToReturn=rc)) return - - offset_pos = 0 - do, i=0, petCount-1 - itemcount = counts_send(i) - offsets_send(i) = offset_pos - if (associated (id_info(i)%item_buffer)) then - buffer_send(offset_pos:offset_pos+itemcount-1) = id_info(i)%item_buffer - end if - offset_pos = offset_pos + itemcount - end do - -! Set up recv counts, offsets, and buffer. Since there will be a different -! buffer size from each remote PET, an AllToAll communication is necessary -! for PETs to exchange the buffer sizes they are sending to each other. - - allocate ( & - counts_recv(0:petCount-1), & - stat=memstat) - if (ESMF_LogFoundAllocError(memstat, ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, & - rcToReturn=rc)) return - - if (profile) then - call ESMF_TraceRegionEnter("ESMF_VMAllToAll", rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, & - rcToReturn=rc)) return - endif - call ESMF_VMAllToAll (vm, & - sendData=counts_send, sendCount=1, & - recvData=counts_recv, recvCount=1, & - rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, & - rcToReturn=rc)) return - if (profile) then - call ESMF_TraceRegionExit("ESMF_VMAllToAll", rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, & - rcToReturn=rc)) return - endif - if (debug) then - print *, ESMF_METHOD, ': PET', localPet, ': serialized buffer sizes', & - ': counts_send =', counts_send, & - ', counts_recv =', counts_recv - end if - - allocate ( & - offsets_recv(0:petCount-1), & - recv_buffer(0:max (0, sum (counts_recv)-1)), & - stat=memstat) - if (ESMF_LogFoundAllocError(memstat, ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, & - rcToReturn=rc)) return - - offset_pos = 0 - do, i=0, petCount-1 - itemcount = counts_recv(i) - offsets_recv(i) = offset_pos - offset_pos = offset_pos + itemcount - end do - -#if 0 - write(logmsg, *) SIZE(buffer_send) - call ESMF_LogWrite("SIZE(buffer_send)="//TRIM(logmsg), rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, rcToReturn=rc)) return - write(logmsg, *) SIZE(recv_buffer) - call ESMF_LogWrite("SIZE(recv_buffer)="//TRIM(logmsg), rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, rcToReturn=rc)) return -#endif - - ! AlltoAllV - - if (profile) then - call ESMF_TraceRegionEnter("ESMF_VMAllToAllV", rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, & - rcToReturn=rc)) return - endif - call ESMF_VMAllToAllV (vm, & - sendData=buffer_send, sendCounts=counts_send, sendOffsets=offsets_send, & - recvData=recv_buffer, recvCounts=counts_recv, recvOffsets=offsets_recv, & - rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, & - rcToReturn=rc)) return - if (profile) then - call ESMF_TraceRegionExit("ESMF_VMAllToAllV", rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, & - rcToReturn=rc)) return - endif - - if (meminfo) call ESMF_VMLogMemInfo("tp ESMF_ReconcileExchgItems: after ESMF_VMAllToAllV") - - deallocate (buffer_send, counts_send, offsets_send, & - stat=memstat) - if (ESMF_LogFoundDeallocError (memstat, ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, & - rcToReturn=rc)) return - - ! Copy recv buffers into recv_items - - do, i=0, petCount-1 - itemcount = counts_recv(i) - if (itemcount > 0) then - offset_pos = offsets_recv(i) -#if 1 - ! Fortran 2003 version - recv_items(i)%cptr(0:) => recv_buffer(offset_pos:offset_pos+itemcount-1) -#else - ! Fortran 90/95 version - cptr_tmp => recv_buffer(offset_pos:offset_pos+itemcount-1) - ! cptr_tmp is 1-based. Convert to 0-based. - call ptr_assoc_zero (cptr_tmp, itemcount, recv_items(i)%cptr) -! print *, 'associated cptr(', lbound (recv_items(i)%cptr,1), ':', ubound (recv_items(i)%cptr,1), ')' -#endif - else - recv_items(i)%cptr => null () + do, send_pet=0, petCount-1 + if (debug) then + call ESMF_ReconcileDebugPrint (ESMF_METHOD // & + ': broadcasting VMId, using rootPet ' // iToS (send_pet), & + ask=.false.) end if + call ESMF_VMBcastVMId (vm, & + bcstData=id_info(send_pet)%vmid, & + count=size (id_info(send_pet)%vmid), & + rootPet=send_pet, rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, & + rcToReturn=rc)) return end do +#endif rc = localrc - if (meminfo) call ESMF_VMLogMemInfo("exiting ESMF_ReconcileExchgItems") - - contains - - subroutine ptr_assoc_zero (cbuffer, itemcount, cptr) - integer, intent(in) :: itemcount - character, intent(in), target :: cbuffer(0:itemcount-1) - character, pointer :: cptr(:) - - cptr => cbuffer - - end subroutine + if (meminfo) call ESMF_VMLogMemInfo ('exiting ESMF_ReconcileExchgIDInfo') - end subroutine ESMF_ReconcileExchgItems + end subroutine ESMF_ReconcileExchgIDInfo !------------------------------------------------------------------------------ #undef ESMF_METHOD -#define ESMF_METHOD "ESMF_ReconcileExchgNeeds" +#define ESMF_METHOD "ESMF_ReconcileExchgItems" !BOPI -! !IROUTINE: ESMF_ReconcileExchgNeeds +! !IROUTINE: ESMF_ReconcileExchgItems ! ! !INTERFACE: - subroutine ESMF_ReconcileExchgNeeds (vm, id_info, recv_needs, rc) + subroutine ESMF_ReconcileExchgItems (vm, id_info, recv_items, recv_buffer, rc) ! ! !ARGUMENTS: type(ESMF_VM), intent(in) :: vm type(ESMF_ReconcileIDInfo), intent(in) :: id_info(0:) - logical, pointer :: recv_needs(:,:) ! intent(out) + type(ESMF_CharPtr), intent(out) :: recv_items(0:) + character, pointer :: recv_buffer(:) ! intent(out) integer, intent(out) :: rc ! ! !DESCRIPTION: ! -! Performs alltoallv communications from needy PETs to PETs which offer -! items they need. +! Performs alltoallv communications of serialized data from offering PETs +! to PETs requesting items. ! ! The arguments are: ! \begin{description} ! \item[vm] ! The current {\tt ESMF\_VM} (virtual machine). ! \item[id_info] -! Array of arrays of global VMId info. The 'needed' flags indicate -! which items are needed from which offering PETs. -! \item[recv_needs] -! Array of needy PETs and their needs. If a flag is set, the PET -! needs the item. +! Array of arrays of global VMId info. +! \item[recv_items] +! Array of arrays of serialized item data. ! \item[rc] ! Return code; equals {\tt ESMF\_SUCCESS} if there are no errors. ! \end{description} @@ -3601,22 +3666,23 @@ subroutine ESMF_ReconcileExchgNeeds (vm, id_info, recv_needs, rc) integer :: itemcount, itemcount_global, itemcount_local integer :: offset_pos - integer, allocatable :: counts_recv(:), counts_send(:) - integer, allocatable :: offsets_recv(:), offsets_send(:) - logical, allocatable :: buffer_recv(:), buffer_send(:) + integer, allocatable :: counts_recv(:), counts_send(:) + integer, allocatable :: offsets_recv(:), offsets_send(:) + character, allocatable :: buffer_send(:) - character(ESMF_MAXSTR) :: msgstring + character, pointer :: cptr_tmp(:) logical, parameter :: debug = .false. + logical, parameter :: meminfo = .false. logical, parameter :: profile = .true. - localrc = ESMF_RC_NOT_IMPL + character(len=ESMF_MAXSTR) :: logmsg - if (associated (recv_needs)) then - if (ESMF_LogFoundError(ESMF_RC_ARG_BAD, ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, & - rcToReturn=rc)) return - end if + ! ------------------------------------------------------------------------- + + if (meminfo) call ESMF_VMLogMemInfo("entering ESMF_ReconcileExchgItems") + + localrc = ESMF_RC_NOT_IMPL call ESMF_VMGet(vm, localPet=localPet, petCount=petCount, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & @@ -3630,8 +3696,14 @@ subroutine ESMF_ReconcileExchgNeeds (vm, id_info, recv_needs, rc) rcToReturn=rc)) return end if -! Set up send counts, offsets, and buffer. Note that each remote PET -! can have differing numbers of items to offer. + if (size (recv_items) /= petCount) then + if (ESMF_LogFoundError(ESMF_RC_INTNRL_INCONS, & + msg="size (recv_items) /= petCount", & + ESMF_CONTEXT, & + rcToReturn=rc)) return + end if + +! Set up send counts, offsets, and buffer. allocate ( & counts_send (0:petCount-1), & @@ -3642,14 +3714,18 @@ subroutine ESMF_ReconcileExchgNeeds (vm, id_info, recv_needs, rc) rcToReturn=rc)) return do, i=0, petCount-1 - counts_send(i) = size (id_info(i)%needed) + if (associated (id_info(i)%item_buffer)) then + counts_send(i) = size (id_info(i)%item_buffer) + else + counts_send(i) = 0 + end if end do itemcount_local = counts_send(localPet) itemcount_global = sum (counts_send) allocate ( & - buffer_send(0:itemcount_global-1), & + buffer_send(0:max (0,itemcount_global-1)), & stat=memstat) if (ESMF_LogFoundAllocError(memstat, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, & @@ -3659,284 +3735,170 @@ subroutine ESMF_ReconcileExchgNeeds (vm, id_info, recv_needs, rc) do, i=0, petCount-1 itemcount = counts_send(i) offsets_send(i) = offset_pos - buffer_send(offset_pos:offset_pos+itemcount-1) = id_info(i)%needed + if (associated (id_info(i)%item_buffer)) then + buffer_send(offset_pos:offset_pos+itemcount-1) = id_info(i)%item_buffer + end if offset_pos = offset_pos + itemcount end do -! Each remote PET should return a buffer that is the same -! size as the number of items on the local PET. So the recv_needs -! buffer can be a simple rectangular matrix of which PETs need -! which of my items. - - allocate ( & - counts_recv (0:petCount-1), & - offsets_recv(0:petCount-1), & - buffer_recv(0:itemcount_local*petCount-1), & - recv_needs(itemcount_local,0:petCount-1), stat=memstat) - if (ESMF_LogFoundAllocError(memstat, ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, & - rcToReturn=rc)) return - - counts_recv = itemcount_local - offsets_recv = itemcount_local * (/ (i,i=0, petCount-1) /) - buffer_recv = .false. - - ! AlltoAllV - - if (trace) then - call ESMF_ReconcileDebugPrint (ESMF_METHOD // & - ': calling VMAllToAll') - end if - - if (profile) then - call ESMF_TraceRegionEnter("ESMF_VMAllToAllV", rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, & - rcToReturn=rc)) return - endif - - call ESMF_VMAllToAllV (vm, & - sendData=buffer_send, sendCounts=counts_send, sendOffsets=offsets_send, & - recvData=buffer_recv, recvCounts=counts_recv, recvOffsets=offsets_recv, & - rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, & - rcToReturn=rc)) return - - if (profile) then - call ESMF_TraceRegionExit("ESMF_VMAllToAllV", rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, & - rcToReturn=rc)) return - endif - - ! Copy recv buffers into recv_needs - - do, i=0, petCount-1 - itemcount = counts_recv(i) - offset_pos = offsets_recv(i) - recv_needs(:,i) = buffer_recv(offset_pos:offset_pos+itemcount-1) - end do - - if (debug) then - do, i=0, petCount-1 - write (msgstring,'(a,i0,a,i0,a)') & - ' PET ', localPet, ': needs that PET ', i, ' requested are:' - write (6,*) trim (msgstring), recv_needs(:,i) - call ESMF_UtilIOUnitFlush (ESMF_UtilIOStdout) - end do - end if - - rc = localrc - - end subroutine ESMF_ReconcileExchgNeeds - -!------------------------------------------------------------------------------ -#undef ESMF_METHOD -#define ESMF_METHOD "ESMF_ReconcileGetStateIDInfo" -!BOPI -! !IROUTINE: ESMF_ReconcileGetStateIDInfo -! -! !INTERFACE: - subroutine ESMF_ReconcileGetStateIDInfo (state, siwrap, id, vmid, rc) -! -! !ARGUMENTS: - type (ESMF_State), intent(in) :: state - type(ESMF_StateItemWrap), pointer :: siwrap(:)! intent(in) - integer, pointer :: id(:) ! intent(out) - type(ESMF_VMId), pointer :: vmid(:) ! intent(out) - integer, intent(out) :: rc -! -! !DESCRIPTION: -! -! The arguments are: -! \begin{description} -! \item[state] -! {\tt ESMF\_State} to collect information from. -! \item[siwrap] -! Pointers to the items in the State -! \item[id] -! The object ids of the State itself (in element 0) and the items -! contained within it. It does not return the IDs of nested State -! items. -! \item[vmid] -! The object VMIds of the State itself (in element 0) and the items -! contained within it. It does not return the IDs of nested State -! items. Note that since VMId is a deep object class, the vmid array -! has aliases to existing VMId objects, rather than copies of them. -! \item[rc] -! Return code; equals {\tt ESMF\_SUCCESS} if there are no errors. -! \end{description} -!EOPI - - type(ESMF_Array), pointer :: arrayp - type(ESMF_ArrayBundle), pointer :: abundlep - type(ESMF_FieldType), pointer :: fieldp - type(ESMF_FieldBundleType), pointer :: fbundlep - type(ESMF_RouteHandle), pointer :: rhandlep - type(ESMF_StateClass), pointer :: statep - - integer :: localrc - integer :: i - integer :: memstat - integer :: nitems - - localrc = ESMF_RC_NOT_IMPL - - if (associated (id) .or. associated (vmid)) then - if (ESMF_LogFoundError(ESMF_RC_ARG_BAD, & - ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, rcToReturn=rc)) return - end if - - if (associated (siwrap)) then - nitems = size (siwrap) - else - nitems = 0 - end if - +! Set up recv counts, offsets, and buffer. Since there will be a different +! buffer size from each remote PET, an AllToAll communication is necessary +! for PETs to exchange the buffer sizes they are sending to each other. + allocate ( & - id(0:nitems), & - vmid(0:nitems), & + counts_recv(0:petCount-1), & stat=memstat) if (ESMF_LogFoundAllocError(memstat, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, & rcToReturn=rc)) return -! Element 0s are for the State itself - - statep => state%statep - - call ESMF_BaseGetID(statep%base, id(0), rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & + if (profile) then + call ESMF_TraceRegionEnter("ESMF_VMAllToAll", rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, & rcToReturn=rc)) return - - call ESMF_BaseGetVMId(statep%base, vmid(0), rc=localrc) + endif + call ESMF_VMAllToAll (vm, & + sendData=counts_send, sendCount=1, & + recvData=counts_recv, recvCount=1, & + rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, & rcToReturn=rc)) return + if (profile) then + call ESMF_TraceRegionExit("ESMF_VMAllToAll", rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, & + rcToReturn=rc)) return + endif + if (debug) then + print *, ESMF_METHOD, ': PET', localPet, ': serialized buffer sizes', & + ': counts_send =', counts_send, & + ', counts_recv =', counts_recv + end if -! Loop over each item - - do, i=1, nitems - - select case (siwrap(i)%si%otype%ot) - - case (ESMF_STATEITEM_ARRAY%ot) - arrayp => siwrap(i)%si%datap%ap - - call c_ESMC_GetID(arrayp, id(i), localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, & - rcToReturn=rc)) return - - call c_ESMC_GetVMId(arrayp, vmid(i), localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, & - rcToReturn=rc)) return - - case (ESMF_STATEITEM_ARRAYBUNDLE%ot) - abundlep => siwrap(i)%si%datap%abp - - call c_ESMC_GetID(abundlep, id(i), localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, & - rcToReturn=rc)) return - - call c_ESMC_GetVMId(abundlep, vmid(i), localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, & - rcToReturn=rc)) return - - case (ESMF_STATEITEM_FIELD%ot) - fieldp => siwrap(i)%si%datap%fp%ftypep - - call ESMF_BaseGetID(fieldp%base, id(i), rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, & - rcToReturn=rc)) return + allocate ( & + offsets_recv(0:petCount-1), & + recv_buffer(0:max (0, sum (counts_recv)-1)), & + stat=memstat) + if (ESMF_LogFoundAllocError(memstat, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, & + rcToReturn=rc)) return - call ESMF_BaseGetVMID(fieldp%base, vmid(i), rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, & - rcToReturn=rc)) return + offset_pos = 0 + do, i=0, petCount-1 + itemcount = counts_recv(i) + offsets_recv(i) = offset_pos + offset_pos = offset_pos + itemcount + end do - case (ESMF_STATEITEM_FIELDBUNDLE%ot) - fbundlep => siwrap(i)%si%datap%fbp%this +#if 0 + write(logmsg, *) SIZE(buffer_send) + call ESMF_LogWrite("SIZE(buffer_send)="//TRIM(logmsg), rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, rcToReturn=rc)) return + write(logmsg, *) SIZE(recv_buffer) + call ESMF_LogWrite("SIZE(recv_buffer)="//TRIM(logmsg), rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, rcToReturn=rc)) return +#endif - call ESMF_BaseGetID(fbundlep%base, id(i), rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, & - rcToReturn=rc)) return + ! AlltoAllV - call ESMF_BaseGetVMID(fbundlep%base, vmid(i), rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, & - rcToReturn=rc)) return + if (profile) then + call ESMF_TraceRegionEnter("ESMF_VMAllToAllV", rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, & + rcToReturn=rc)) return + endif + call ESMF_VMAllToAllV (vm, & + sendData=buffer_send, sendCounts=counts_send, sendOffsets=offsets_send, & + recvData=recv_buffer, recvCounts=counts_recv, recvOffsets=offsets_recv, & + rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, & + rcToReturn=rc)) return + if (profile) then + call ESMF_TraceRegionExit("ESMF_VMAllToAllV", rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, & + rcToReturn=rc)) return + endif - case (ESMF_STATEITEM_ROUTEHANDLE%ot) - rhandlep => siwrap(i)%si%datap%rp + if (meminfo) call ESMF_VMLogMemInfo("tp ESMF_ReconcileExchgItems: after ESMF_VMAllToAllV") - call c_ESMC_GetID(rhandlep, id(i), localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, & - rcToReturn=rc)) return + deallocate (buffer_send, counts_send, offsets_send, & + stat=memstat) + if (ESMF_LogFoundDeallocError (memstat, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, & + rcToReturn=rc)) return - call c_ESMC_GetVMId(rhandlep, vmid(i), localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, & - rcToReturn=rc)) return + ! Copy recv buffers into recv_items - case (ESMF_STATEITEM_STATE%ot) - statep => siwrap(i)%si%datap%spp + do, i=0, petCount-1 + itemcount = counts_recv(i) + if (itemcount > 0) then + offset_pos = offsets_recv(i) +#if 1 + ! Fortran 2003 version + recv_items(i)%cptr(0:) => recv_buffer(offset_pos:offset_pos+itemcount-1) +#else + ! Fortran 90/95 version + cptr_tmp => recv_buffer(offset_pos:offset_pos+itemcount-1) + ! cptr_tmp is 1-based. Convert to 0-based. + call ptr_assoc_zero (cptr_tmp, itemcount, recv_items(i)%cptr) +! print *, 'associated cptr(', lbound (recv_items(i)%cptr,1), ':', ubound (recv_items(i)%cptr,1), ')' +#endif + else + recv_items(i)%cptr => null () + end if + end do - call ESMF_BaseGetID(statep%base, id(i), rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, & - rcToReturn=rc)) return + rc = localrc - call ESMF_BaseGetVMID(statep%base, vmid(i), rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, & - rcToReturn=rc)) return + if (meminfo) call ESMF_VMLogMemInfo("exiting ESMF_ReconcileExchgItems") - case default - if (ESMF_LogFoundError(ESMF_RC_INTNRL_INCONS, & - msg="Unknown State item type", & - ESMF_CONTEXT, & - rcToReturn=rc)) return + contains - end select + subroutine ptr_assoc_zero (cbuffer, itemcount, cptr) + integer, intent(in) :: itemcount + character, intent(in), target :: cbuffer(0:itemcount-1) + character, pointer :: cptr(:) - end do + cptr => cbuffer - rc = ESMF_SUCCESS + end subroutine - end subroutine ESMF_ReconcileGetStateIDInfo + end subroutine ESMF_ReconcileExchgItems !------------------------------------------------------------------------------ #undef ESMF_METHOD -#define ESMF_METHOD "ESMF_ReconcileInitialize" +#define ESMF_METHOD "ESMF_ReconcileExchgNeeds" !BOPI -! !IROUTINE: ESMF_ReconcileInitialize +! !IROUTINE: ESMF_ReconcileExchgNeeds ! ! !INTERFACE: - subroutine ESMF_ReconcileInitialize(state, vm, siwrap, nitems_all, rc) + subroutine ESMF_ReconcileExchgNeeds (vm, id_info, recv_needs, rc) ! ! !ARGUMENTS: - type (ESMF_State), intent(inout) :: state - type (ESMF_VM), intent(in) :: vm - type (ESMF_StateItemWrap), pointer :: siwrap(:) ! intent(out) - integer, pointer :: nitems_all(:) ! intent(out) - integer, intent(out) :: rc + type(ESMF_VM), intent(in) :: vm + type(ESMF_ReconcileIDInfo), intent(in) :: id_info(0:) + logical, pointer :: recv_needs(:,:) ! intent(out) + integer, intent(out) :: rc ! ! !DESCRIPTION: ! +! Performs alltoallv communications from needy PETs to PETs which offer +! items they need. +! ! The arguments are: ! \begin{description} -! \item[state] -! {\tt ESMF\_State} to collect information from. +! \item[vm] +! The current {\tt ESMF\_VM} (virtual machine). +! \item[id_info] +! Array of arrays of global VMId info. The 'needed' flags indicate +! which items are needed from which offering PETs. +! \item[recv_needs] +! Array of needy PETs and their needs. If a flag is set, the PET +! needs the item. ! \item[rc] ! Return code; equals {\tt ESMF\_SUCCESS} if there are no errors. ! \end{description} @@ -3944,15 +3906,24 @@ subroutine ESMF_ReconcileInitialize(state, vm, siwrap, nitems_all, rc) integer :: localrc integer :: memstat - integer :: nitems_local(1) integer :: localPet, petCount + integer :: i + integer :: itemcount, itemcount_global, itemcount_local + integer :: offset_pos + integer, allocatable :: counts_recv(:), counts_send(:) + integer, allocatable :: offsets_recv(:), offsets_send(:) + logical, allocatable :: buffer_recv(:), buffer_send(:) + + character(ESMF_MAXSTR) :: msgstring + + logical, parameter :: debug = .false. logical, parameter :: profile = .true. localrc = ESMF_RC_NOT_IMPL - if (associated (siwrap) .or. associated (nitems_all)) then - if (ESMF_LogFoundError(ESMF_RC_ARG_BAD, ESMF_ERR_PASSTHRU, & + if (associated (recv_needs)) then + if (ESMF_LogFoundError(ESMF_RC_ARG_BAD, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, & rcToReturn=rc)) return end if @@ -3962,91 +3933,129 @@ subroutine ESMF_ReconcileInitialize(state, vm, siwrap, nitems_all, rc) ESMF_CONTEXT, & rcToReturn=rc)) return - ! Brute force removal of all existing proxies from the State - ! to handle the re-reconcile case. If State items were removed - ! between reconciles, there should be no proxies for them. - ! - ! TODO: Consider maintaining a flag in the state. Perform - ! a communication step to see if any removals have taken place. - ! Conditionally zap the proxies depending on whether it is actually - ! needed. - if (profile) then - call ESMF_TraceRegionEnter("ESMF_ReconcileZapProxies", rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, & - rcToReturn=rc)) return - endif - call ESMF_ReconcileZapProxies (state, localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, & - rcToReturn=rc)) return - if (profile) then - call ESMF_TraceRegionExit("ESMF_ReconcileZapProxies", rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & + if (size (id_info) /= petCount) then + if (ESMF_LogFoundError(ESMF_RC_INTNRL_INCONS, & + msg="size (id_info) /= petCount", & + ESMF_CONTEXT, & + rcToReturn=rc)) return + end if + +! Set up send counts, offsets, and buffer. Note that each remote PET +! can have differing numbers of items to offer. + + allocate ( & + counts_send (0:petCount-1), & + offsets_send(0:petCount-1), & + stat=memstat) + if (ESMF_LogFoundAllocError(memstat, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, & rcToReturn=rc)) return - endif - ! Obtain local PET item list - siwrap => null () - call ESMF_ContainerGet (state%statep%stateContainer, & - itemList=siwrap, rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & + do, i=0, petCount-1 + counts_send(i) = size (id_info(i)%needed) + end do + + itemcount_local = counts_send(localPet) + itemcount_global = sum (counts_send) + + allocate ( & + buffer_send(0:itemcount_global-1), & + stat=memstat) + if (ESMF_LogFoundAllocError(memstat, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, & rcToReturn=rc)) return - if (associated (siwrap)) then - nitems_local(1) = size (siwrap) - else - nitems_local(1) = 0 - end if + offset_pos = 0 + do, i=0, petCount-1 + itemcount = counts_send(i) + offsets_send(i) = offset_pos + buffer_send(offset_pos:offset_pos+itemcount-1) = id_info(i)%needed + offset_pos = offset_pos + itemcount + end do - ! All PETs send their item counts to all the other PETs for recv array sizing. - allocate (nitems_all(0:petCount-1), stat=memstat) +! Each remote PET should return a buffer that is the same +! size as the number of items on the local PET. So the recv_needs +! buffer can be a simple rectangular matrix of which PETs need +! which of my items. + + allocate ( & + counts_recv (0:petCount-1), & + offsets_recv(0:petCount-1), & + buffer_recv(0:itemcount_local*petCount-1), & + recv_needs(itemcount_local,0:petCount-1), stat=memstat) if (ESMF_LogFoundAllocError(memstat, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, & rcToReturn=rc)) return + counts_recv = itemcount_local + offsets_recv = itemcount_local * (/ (i,i=0, petCount-1) /) + buffer_recv = .false. + + ! AlltoAllV + + if (trace) then + call ESMF_ReconcileDebugPrint (ESMF_METHOD // & + ': calling VMAllToAll') + end if + if (profile) then - call ESMF_TraceRegionEnter("ESMF_VMAllGather", rc=localrc) + call ESMF_TraceRegionEnter("ESMF_VMAllToAllV", rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, & rcToReturn=rc)) return endif - call ESMF_VMAllGather (vm, & - sendData=nitems_local, recvData=nitems_all, & - count=1, rc=localrc) + + call ESMF_VMAllToAllV (vm, & + sendData=buffer_send, sendCounts=counts_send, sendOffsets=offsets_send, & + recvData=buffer_recv, recvCounts=counts_recv, recvOffsets=offsets_recv, & + rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, & rcToReturn=rc)) return + if (profile) then - call ESMF_TraceRegionExit("ESMF_VMAllGather", rc=localrc) + call ESMF_TraceRegionExit("ESMF_VMAllToAllV", rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, & rcToReturn=rc)) return endif - end subroutine ESMF_ReconcileInitialize + ! Copy recv buffers into recv_needs + + do, i=0, petCount-1 + itemcount = counts_recv(i) + offset_pos = offsets_recv(i) + recv_needs(:,i) = buffer_recv(offset_pos:offset_pos+itemcount-1) + end do + + if (debug) then + do, i=0, petCount-1 + write (msgstring,'(a,i0,a,i0,a)') & + ' PET ', localPet, ': needs that PET ', i, ' requested are:' + write (6,*) trim (msgstring), recv_needs(:,i) + call ESMF_UtilIOUnitFlush (ESMF_UtilIOStdout) + end do + end if + + rc = localrc + + end subroutine ESMF_ReconcileExchgNeeds !------------------------------------------------------------------------------ #undef ESMF_METHOD -#define ESMF_METHOD "ESMF_ReconcileSerialize" +#define ESMF_METHOD "ESMF_ReconcileGetStateIDInfo" !BOPI -! !IROUTINE: ESMF_ReconcileSerialize +! !IROUTINE: ESMF_ReconcileGetStateIDInfo ! ! !INTERFACE: - subroutine ESMF_ReconcileSerialize (state, vm, siwrap, & - needs_list, attreconflag, & - id_info, rc) + subroutine ESMF_ReconcileGetStateIDInfo (state, siwrap, id, vmid, rc) ! ! !ARGUMENTS: - type (ESMF_State), intent(in) :: state - type (ESMF_VM), intent(in) :: vm - type (ESMF_StateItemWrap), intent(in) :: siwrap(:) - logical, intent(in) :: needs_list(:,0:) - type(ESMF_AttReconcileFlag),intent(in) :: attreconflag - type(ESMF_ReconcileIDInfo), intent(inout) :: id_info(0:) - integer, intent(out) :: rc + type (ESMF_State), intent(in) :: state + type(ESMF_StateItemWrap), pointer :: siwrap(:)! intent(in) + integer, pointer :: id(:) ! intent(out) + type(ESMF_VMId), pointer :: vmid(:) ! intent(out) + integer, intent(out) :: rc ! ! !DESCRIPTION: ! @@ -4055,701 +4064,688 @@ subroutine ESMF_ReconcileSerialize (state, vm, siwrap, & ! \item[state] ! {\tt ESMF\_State} to collect information from. ! \item[siwrap] -! State items in the state. -! \item[needs\_list] -! List of State items that need to be sent to other PETs -! \item[attreconflag] -! Flag to indicate attribute reconciliation. -! \item[id\_info] -! IDInfo array containing buffers of serialized State objects (intent(out)) +! Pointers to the items in the State +! \item[id] +! The object ids of the State itself (in element 0) and the items +! contained within it. It does not return the IDs of nested State +! items. +! \item[vmid] +! The object VMIds of the State itself (in element 0) and the items +! contained within it. It does not return the IDs of nested State +! items. Note that since VMId is a deep object class, the vmid array +! has aliases to existing VMId objects, rather than copies of them. ! \item[rc] ! Return code; equals {\tt ESMF\_SUCCESS} if there are no errors. ! \end{description} !EOPI - integer :: localrc - integer :: memstat - - type PetNeeds_t - logical :: needed = .false. - integer :: obj_type - character(1), pointer :: obj_buffer(:) => null () - integer :: buffer_size = 0 ! Actual space used in obj_buffer. May be - ! smaller than size(obj_buffer) - end type - - type(PetNeeds_t), allocatable :: pet_needs(:) - - character(1), pointer :: obj_buffer(:) - integer, allocatable :: type_table(:) - type(ESMF_StateItem), pointer :: stateitem - type(ESMF_InquireFlag) :: inqflag - type(ESMF_State) :: wrapper - - integer :: buffer_offset - integer :: needs_count - integer :: item, nitems - integer :: lbufsize - integer :: pass + type(ESMF_Array), pointer :: arrayp + type(ESMF_ArrayBundle), pointer :: abundlep + type(ESMF_FieldType), pointer :: fieldp + type(ESMF_FieldBundleType), pointer :: fbundlep + type(ESMF_RouteHandle), pointer :: rhandlep + type(ESMF_StateClass), pointer :: statep - character(ESMF_MAXSTR) :: errstring + integer :: localrc integer :: i - integer :: localPet, petCount, pet - - logical, parameter :: debug=.false. - logical, parameter :: trace=.false. - character(len=ESMF_MAXSTR) :: logmsg - integer :: needs_count_debug + integer :: memstat + integer :: nitems localrc = ESMF_RC_NOT_IMPL - call ESMF_VMGet(vm, localPet=localPet, petCount=petCount, rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, & - rcToReturn=rc)) return - -! Sanity check: siwrap and needs list must be the same size. - - if (ubound (siwrap, 1) /= ubound (needs_list, 1)) then - write (errstring, '(a,i0,a,i0)') & - 'siwrap ubound =', ubound (siwrap, 1), & - '/= needs_list ubound =', ubound (needs_list, 1) - call ESMF_LogWrite (msg=errstring, logmsgFlag=ESMF_LOGMSG_ERROR, ESMF_CONTEXT) - if (ESMF_LogFoundError(ESMF_RC_INTNRL_INCONS, & - msg="ubound (siwrap) /= ubound (needs_list)", & - ESMF_CONTEXT, & - rcToReturn=rc)) return + if (associated (id) .or. associated (vmid)) then + if (ESMF_LogFoundError(ESMF_RC_ARG_BAD, & + ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, rcToReturn=rc)) return end if - nitems = size (siwrap) - ! Find the union of all the needs for this PET. - if (trace) then - call ESMF_ReconcileDebugPrint (ESMF_METHOD // & - ': *** Step 1 - Find union of needs') + if (associated (siwrap)) then + nitems = size (siwrap) + else + nitems = 0 end if - allocate (pet_needs(nitems), & + + allocate ( & + id(0:nitems), & + vmid(0:nitems), & stat=memstat) if (ESMF_LogFoundAllocError(memstat, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, & rcToReturn=rc)) return - do, i=1, nitems - pet_needs(i)%needed = any (needs_list(i,:)) - end do - if (debug) then - print *, ' PET', localPet, & - ': needed_items array: ', pet_needs%needed - end if +! Element 0s are for the State itself - ! Serialize all needed objects - if (trace) then - call ESMF_ReconcileDebugPrint (ESMF_METHOD // & - ': *** Step 2 - Serialize all needed objects') - end if - allocate (type_table(nitems), & - stat=memstat) - if (ESMF_LogFoundAllocError(memstat, ESMF_ERR_PASSTHRU, & + statep => state%statep + + call ESMF_BaseGetID(statep%base, id(0), rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, & rcToReturn=rc)) return - item_loop: & - do, item = 1, nitems - - ! Make two passes through each needed item. The first time to calculate - ! the size of the buffer, and the second time to perform the actual - ! serialization. - if (.not. pet_needs(item)%needed) cycle item_loop + call ESMF_BaseGetVMId(statep%base, vmid(0), rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, & + rcToReturn=rc)) return - pass_loop: & - do, pass = 1, 2 - select case (pass) - ! Pass 1 finds the required buffer length to serialize the item. - case (1) - ! Allocate a very small buffer to avoid possible null pointer - ! references in the serialization routines. - inqflag = ESMF_INQUIREONLY - allocate (obj_buffer(0:ESMF_SIZEOF_DEFINT-1), stat=memstat) - if (ESMF_LogFoundAllocError(memstat, ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, & - rcToReturn=rc)) return - buffer_offset = 0 +! Loop over each item - ! Pass 2 performs the actual serialization. - case (2) - inqflag = ESMF_NOINQUIRE - deallocate (obj_buffer, stat=memstat) - if (ESMF_LogFoundDeallocError(memstat, ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, & - rcToReturn=rc)) return + do, i=1, nitems - if (debug) then - print *, ESMF_METHOD, ': allocating obj_buffer bounds = (0:', buffer_offset-1, ')' - end if + select case (siwrap(i)%si%otype%ot) - allocate (obj_buffer(0:buffer_offset-1), stat=memstat) - if (ESMF_LogFoundAllocError(memstat, ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, & - rcToReturn=rc)) return - buffer_offset = 0 + case (ESMF_STATEITEM_ARRAY%ot) + arrayp => siwrap(i)%si%datap%ap - end select + call c_ESMC_GetID(arrayp, id(i), localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, & + rcToReturn=rc)) return - lbufsize = size (obj_buffer) + call c_ESMC_GetVMId(arrayp, vmid(i), localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, & + rcToReturn=rc)) return - stateitem => siwrap(item)%si - type_table(item) = stateitem%otype%ot + case (ESMF_STATEITEM_ARRAYBUNDLE%ot) + abundlep => siwrap(i)%si%datap%abp - ! serialize item - select case (stateitem%otype%ot) + call c_ESMC_GetID(abundlep, id(i), localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, & + rcToReturn=rc)) return - case (ESMF_STATEITEM_FIELDBUNDLE%ot) - if (debug) then - print *, ' PET', localPet, & - ': serializing FieldBundle, pass =', pass, ', offset =', buffer_offset - end if - call ESMF_FieldBundleSerialize(stateitem%datap%fbp, & - obj_buffer, lbufsize, buffer_offset, & - attreconflag=attreconflag, inquireflag=inqflag, & - rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, & - rcToReturn=rc)) return + call c_ESMC_GetVMId(abundlep, vmid(i), localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, & + rcToReturn=rc)) return - case (ESMF_STATEITEM_FIELD%ot) - if (debug) then - print *, ' PET', localPet, & - ': serializing Field, pass =', pass, ', offset =', buffer_offset - end if - call ESMF_FieldSerialize(stateitem%datap%fp, & - obj_buffer, lbufsize, buffer_offset, & - attreconflag=attreconflag, inquireflag=inqflag, & - rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, & - rcToReturn=rc)) return + case (ESMF_STATEITEM_FIELD%ot) + fieldp => siwrap(i)%si%datap%fp%ftypep - case (ESMF_STATEITEM_ARRAY%ot) - if (debug) then - print *, ' PET', localPet, & - ': serialized Array, pass =', pass, ', offset =', buffer_offset - end if - call c_ESMC_ArraySerialize(stateitem%datap%ap, & - obj_buffer, lbufsize, buffer_offset, & - attreconflag, inqflag, & - localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, & - rcToReturn=rc)) return + call ESMF_BaseGetID(fieldp%base, id(i), rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, & + rcToReturn=rc)) return - case (ESMF_STATEITEM_ARRAYBUNDLE%ot) - if (debug) then - print *, ' PET', localPet, & - ': serializing ArrayBundle, pass =', pass, ', offset =', buffer_offset - end if - call c_ESMC_ArrayBundleSerialize(stateitem%datap%abp, & - obj_buffer, lbufsize, buffer_offset, & - attreconflag, inqflag, & - localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, & - rcToReturn=rc)) return + call ESMF_BaseGetVMID(fieldp%base, vmid(i), rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, & + rcToReturn=rc)) return - case (ESMF_STATEITEM_STATE%ot) - if (debug) then - print *, ' PET', localPet, & - ': serializing subState, pass =', pass, ', offset =', buffer_offset - end if - wrapper%statep => stateitem%datap%spp - ESMF_INIT_SET_CREATED(wrapper) - call ESMF_StateSerialize(wrapper, & - obj_buffer, lbufsize, buffer_offset, & - attreconflag=attreconflag, inquireflag=inqflag, & - rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, & - rcToReturn=rc)) return + case (ESMF_STATEITEM_FIELDBUNDLE%ot) + fbundlep => siwrap(i)%si%datap%fbp%this - case (ESMF_STATEITEM_ROUTEHANDLE%ot) - if (debug) then - print *, ' PET', localPet, & - ': ignoring RouteHandle, pass =', pass - end if - ! Do nothing for RouteHandles. There is no need to reconcile them. + call ESMF_BaseGetID(fbundlep%base, id(i), rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, & + rcToReturn=rc)) return + call ESMF_BaseGetVMID(fbundlep%base, vmid(i), rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, & + rcToReturn=rc)) return - case (ESMF_STATEITEM_UNKNOWN%ot) - if (debug) then - print *, ESMF_METHOD, ': serializing unknown: ', trim (stateitem%namep) - end if - write (errstring, '(a)') 'can''t serialize unknown type!!' - if (ESMF_LogFoundError(ESMF_RC_INTNRL_INCONS, msg=errstring, & - ESMF_CONTEXT, & - rcToReturn=rc)) return + case (ESMF_STATEITEM_ROUTEHANDLE%ot) + rhandlep => siwrap(i)%si%datap%rp - case default - localrc = ESMF_RC_INTNRL_INCONS - if (debug) then - print *, ' PET', localPet, & - ': serialization error in default case. Returning ESMF_RC_INTNRL_INCONS' - end if + call c_ESMC_GetID(rhandlep, id(i), localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, & + rcToReturn=rc)) return - end select + call c_ESMC_GetVMId(rhandlep, vmid(i), localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, & + rcToReturn=rc)) return + + case (ESMF_STATEITEM_STATE%ot) + statep => siwrap(i)%si%datap%spp + call ESMF_BaseGetID(statep%base, id(i), rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, & rcToReturn=rc)) return -#if defined (ALIGN_FIX) - buffer_offset = ((buffer_offset+7)/8)*8 -#endif + call ESMF_BaseGetVMID(statep%base, vmid(i), rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, & + rcToReturn=rc)) return - if (debug) then - print *, ' PET', localPet, & - ': item serialized, pass =', pass, ', new offset =', buffer_offset, & - merge (" (calc'ed)", " (actual) ", pass == 1) - end if + case default + if (ESMF_LogFoundError(ESMF_RC_INTNRL_INCONS, & + msg="Unknown State item type", & + ESMF_CONTEXT, & + rcToReturn=rc)) return - end do pass_loop + end select - pet_needs(item)%obj_buffer => obj_buffer - pet_needs(item)%buffer_size = buffer_offset - obj_buffer => null () + end do + + rc = ESMF_SUCCESS + + end subroutine ESMF_ReconcileGetStateIDInfo + +!------------------------------------------------------------------------------ +#undef ESMF_METHOD +#define ESMF_METHOD "ESMF_ReconcileInitialize" +!BOPI +! !IROUTINE: ESMF_ReconcileInitialize +! +! !INTERFACE: + subroutine ESMF_ReconcileInitialize(state, vm, siwrap, nitems_all, rc) +! +! !ARGUMENTS: + type (ESMF_State), intent(inout) :: state + type (ESMF_VM), intent(in) :: vm + type (ESMF_StateItemWrap), pointer :: siwrap(:) ! intent(out) + integer, pointer :: nitems_all(:) ! intent(out) + integer, intent(out) :: rc +! +! !DESCRIPTION: +! +! The arguments are: +! \begin{description} +! \item[state] +! {\tt ESMF\_State} to collect information from. +! \item[rc] +! Return code; equals {\tt ESMF\_SUCCESS} if there are no errors. +! \end{description} +!EOPI + + integer :: localrc + integer :: memstat + integer :: nitems_local(1) + integer :: localPet, petCount + + logical, parameter :: profile = .true. + + localrc = ESMF_RC_NOT_IMPL + + if (associated (siwrap) .or. associated (nitems_all)) then + if (ESMF_LogFoundError(ESMF_RC_ARG_BAD, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, & + rcToReturn=rc)) return + end if + + call ESMF_VMGet(vm, localPet=localPet, petCount=petCount, rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, & + rcToReturn=rc)) return + + ! Brute force removal of all existing proxies from the State + ! to handle the re-reconcile case. If State items were removed + ! between reconciles, there should be no proxies for them. + ! + ! TODO: Consider maintaining a flag in the state. Perform + ! a communication step to see if any removals have taken place. + ! Conditionally zap the proxies depending on whether it is actually + ! needed. + if (profile) then + call ESMF_TraceRegionEnter("ESMF_ReconcileZapProxies", rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, & + rcToReturn=rc)) return + endif + call ESMF_ReconcileZapProxies (state, localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, & + rcToReturn=rc)) return + if (profile) then + call ESMF_TraceRegionExit("ESMF_ReconcileZapProxies", rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, & + rcToReturn=rc)) return + endif - end do item_loop + ! Obtain local PET item list + siwrap => null () + call ESMF_ContainerGet (state%statep%stateContainer, & + itemList=siwrap, rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, & + rcToReturn=rc)) return - if (debug) & - print *, ESMF_METHOD, ': buffer_sizes =', pet_needs(:)%buffer_size + if (associated (siwrap)) then + nitems_local(1) = size (siwrap) + else + nitems_local(1) = 0 + end if -! For each PET, create a buffer containing its serialized needs. The buffer -! consists of a count of items, a table of the offsets (in bytes) of each -! serialized item, and the serialized items themselves. + ! All PETs send their item counts to all the other PETs for recv array sizing. + allocate (nitems_all(0:petCount-1), stat=memstat) + if (ESMF_LogFoundAllocError(memstat, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, & + rcToReturn=rc)) return - if (trace) then - call ESMF_ReconcileDebugPrint (ESMF_METHOD // & - ': *** Step 3 - Create per-PET serialized buffers') - end if - do, pet=0, petCount-1 - needs_count = count (needs_list(:,pet)) - if (debug .and. needs_count > 0) then - print *, ' PET', localPet, & - ': needs_count =', needs_count, ', for PET', pet - end if - if (needs_count == 0) then - id_info(pet)%item_buffer => null () - cycle - end if + if (profile) then + call ESMF_TraceRegionEnter("ESMF_VMAllGather", rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, & + rcToReturn=rc)) return + endif + call ESMF_VMAllGather (vm, & + sendData=nitems_local, recvData=nitems_all, & + count=1, rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, & + rcToReturn=rc)) return + if (profile) then + call ESMF_TraceRegionExit("ESMF_VMAllGather", rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, & + rcToReturn=rc)) return + endif - ! Calculate size needed for serialized item buffer, including - ! space for needs_count, and size/type table - buffer_offset = ESMF_SIZEOF_DEFINT * (2 + needs_count*2) - do, item=1, nitems - if (needs_list(item, pet)) & - buffer_offset = buffer_offset + pet_needs(item)%buffer_size - end do + end subroutine ESMF_ReconcileInitialize - if (debug) then - print *, ' PET', localPet, & - ': computed buffer_offset =', buffer_offset, ', for PET', pet - end if +!------------------------------------------------------------------------------ +#undef ESMF_METHOD +#define ESMF_METHOD "ESMF_ReconcileSerialize" +!BOPI +! !IROUTINE: ESMF_ReconcileSerialize +! +! !INTERFACE: + subroutine ESMF_ReconcileSerialize (state, vm, siwrap, & + needs_list, attreconflag, & + id_info, rc) +! +! !ARGUMENTS: + type (ESMF_State), intent(in) :: state + type (ESMF_VM), intent(in) :: vm + type (ESMF_StateItemWrap), intent(in) :: siwrap(:) + logical, intent(in) :: needs_list(:,0:) + type(ESMF_AttReconcileFlag),intent(in) :: attreconflag + type(ESMF_ReconcileIDInfo), intent(inout) :: id_info(0:) + integer, intent(out) :: rc +! +! !DESCRIPTION: +! +! The arguments are: +! \begin{description} +! \item[state] +! {\tt ESMF\_State} to collect information from. +! \item[siwrap] +! State items in the state. +! \item[needs\_list] +! List of State items that need to be sent to other PETs +! \item[attreconflag] +! Flag to indicate attribute reconciliation. +! \item[id\_info] +! IDInfo array containing buffers of serialized State objects (intent(out)) +! \item[rc] +! Return code; equals {\tt ESMF\_SUCCESS} if there are no errors. +! \end{description} +!EOPI - ! Fill serialized item buffer + integer :: localrc + integer :: memstat - allocate (id_info(pet)%item_buffer(0:buffer_offset-1), & - stat=memstat) - if (ESMF_LogFoundAllocError(memstat, ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, & - rcToReturn=rc)) return - obj_buffer => id_info(pet)%item_buffer + type PetNeeds_t + logical :: needed = .false. + integer :: obj_type + character(1), pointer :: obj_buffer(:) => null () + integer :: buffer_size = 0 ! Actual space used in obj_buffer. May be + ! smaller than size(obj_buffer) + end type - if (debug) then - write(logmsg, *) "ESMF_SIZEOF_DEFINT=", ESMF_SIZEOF_DEFINT - call ESMF_LogWrite(trim(logmsg)) - write(logmsg, *) "needs_count=", needs_count - call ESMF_LogWrite(trim(logmsg)) - end if + type(PetNeeds_t), allocatable :: pet_needs(:) - obj_buffer(0:ESMF_SIZEOF_DEFINT-1) = transfer ( & - source=needs_count, & - mold =obj_buffer(0:ESMF_SIZEOF_DEFINT-1)) + character(1), pointer :: obj_buffer(:) + integer, allocatable :: type_table(:) + type(ESMF_StateItem), pointer :: stateitem + type(ESMF_InquireFlag) :: inqflag + type(ESMF_State) :: wrapper - if (debug) then - needs_count_debug = transfer(source=obj_buffer(0:ESMF_SIZEOF_DEFINT-1), & - mold=needs_count_debug) - write(logmsg, *) "needs_count_debug=", needs_count_debug - call ESMF_LogWrite(trim(logmsg)) - end if + integer :: buffer_offset + integer :: needs_count + integer :: item, nitems + integer :: lbufsize + integer :: pass - ! space for needs_count, padding, and size/type table - buffer_offset = ESMF_SIZEOF_DEFINT * (2 + needs_count*2) + character(ESMF_MAXSTR) :: errstring + integer :: i + integer :: localPet, petCount, pet - i = 2 * ESMF_SIZEOF_DEFINT ! space for needs_count and a pad - do, item=1, nitems - if (.not. needs_list(item, pet)) cycle - lbufsize = pet_needs(item)%buffer_size - if (lbufsize == 0) cycle + logical, parameter :: debug=.false. + logical, parameter :: trace=.false. + character(len=ESMF_MAXSTR) :: logmsg + integer :: needs_count_debug - if (debug) then - print *, ' PET', localPet, & - ': packing at buffer_offset =', buffer_offset, ', for PET', pet, & - ', item =', item - end if - obj_buffer(i:i+ESMF_SIZEOF_DEFINT-1) = & ! Buffer offset - transfer ( & - source=buffer_offset, & - mold =obj_buffer(0:ESMF_SIZEOF_DEFINT-1)) - i = i + ESMF_SIZEOF_DEFINT + localrc = ESMF_RC_NOT_IMPL - obj_buffer(i:i+ESMF_SIZEOF_DEFINT-1) = & ! Item type - transfer ( & - source=type_table(item), & - mold =obj_buffer(0:ESMF_SIZEOF_DEFINT-1)) - i = i + ESMF_SIZEOF_DEFINT + call ESMF_VMGet(vm, localPet=localPet, petCount=petCount, rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, & + rcToReturn=rc)) return - obj_buffer(buffer_offset:buffer_offset+lbufsize-1) = & ! Serialized item - pet_needs(item)%obj_buffer(:lbufsize-1) - buffer_offset = buffer_offset + lbufsize - end do ! items +! Sanity check: siwrap and needs list must be the same size. - end do ! pets + if (ubound (siwrap, 1) /= ubound (needs_list, 1)) then + write (errstring, '(a,i0,a,i0)') & + 'siwrap ubound =', ubound (siwrap, 1), & + '/= needs_list ubound =', ubound (needs_list, 1) + call ESMF_LogWrite (msg=errstring, logmsgFlag=ESMF_LOGMSG_ERROR, ESMF_CONTEXT) + if (ESMF_LogFoundError(ESMF_RC_INTNRL_INCONS, & + msg="ubound (siwrap) /= ubound (needs_list)", & + ESMF_CONTEXT, & + rcToReturn=rc)) return + end if + nitems = size (siwrap) + ! Find the union of all the needs for this PET. if (trace) then call ESMF_ReconcileDebugPrint (ESMF_METHOD // & - ': *** Step 4 - Deallocate memory') + ': *** Step 1 - Find union of needs') end if + allocate (pet_needs(nitems), & + stat=memstat) + if (ESMF_LogFoundAllocError(memstat, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, & + rcToReturn=rc)) return - if (allocated (pet_needs)) then - do, i=1, nitems - if (associated (pet_needs(i)%obj_buffer)) then - deallocate (pet_needs(i)%obj_buffer, stat=memstat) - if (ESMF_LogFoundDeallocError(memstat, ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, & - rcToReturn=rc)) return - end if - end do + do, i=1, nitems + pet_needs(i)%needed = any (needs_list(i,:)) + end do + if (debug) then + print *, ' PET', localPet, & + ': needed_items array: ', pet_needs%needed + end if - deallocate (pet_needs, stat=memstat) - if (ESMF_LogFoundDeallocError(memstat, ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, & - rcToReturn=rc)) return + ! Serialize all needed objects + if (trace) then + call ESMF_ReconcileDebugPrint (ESMF_METHOD // & + ': *** Step 2 - Serialize all needed objects') end if + allocate (type_table(nitems), & + stat=memstat) + if (ESMF_LogFoundAllocError(memstat, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, & + rcToReturn=rc)) return + item_loop: & + do, item = 1, nitems - rc = ESMF_SUCCESS + ! Make two passes through each needed item. The first time to calculate + ! the size of the buffer, and the second time to perform the actual + ! serialization. - end subroutine ESMF_ReconcileSerialize + if (.not. pet_needs(item)%needed) cycle item_loop + + pass_loop: & + do, pass = 1, 2 + select case (pass) + ! Pass 1 finds the required buffer length to serialize the item. + case (1) + ! Allocate a very small buffer to avoid possible null pointer + ! references in the serialization routines. + inqflag = ESMF_INQUIREONLY + allocate (obj_buffer(0:ESMF_SIZEOF_DEFINT-1), stat=memstat) + if (ESMF_LogFoundAllocError(memstat, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, & + rcToReturn=rc)) return + buffer_offset = 0 + ! Pass 2 performs the actual serialization. + case (2) + inqflag = ESMF_NOINQUIRE + deallocate (obj_buffer, stat=memstat) + if (ESMF_LogFoundDeallocError(memstat, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, & + rcToReturn=rc)) return -!------------------------------------------------------------------------------ -#undef ESMF_METHOD -#define ESMF_METHOD "ESMF_ReconcileSerializeAll" -!BOPI -! !IROUTINE: ESMF_ReconcileSerializeAll -! -! !INTERFACE: - subroutine ESMF_ReconcileSerializeAll(state, itemList, itemCount, & - attreconflag, siwrap, buffer, rc) -! -! !ARGUMENTS: - type(ESMF_State), intent(in) :: state - integer, intent(in) :: itemList(:) - integer, intent(in) :: itemCount - type(ESMF_AttReconcileFlag),intent(in) :: attreconflag - type(ESMF_StateItemWrap), intent(in) :: siwrap(:) - character, pointer, intent(out) :: buffer(:) - integer, intent(out) :: rc -! -! !DESCRIPTION: -! -! The arguments are: -! \begin{description} -! \item[state] -! The {\tt ESMF\_State} to collect information from. -! \item[itemList] -! List of indices into siwrap(:) for items that need to be serialized. -! \item[itemCount] -! Number of items in itemList. The incoming allocation might be larger. -! \item[attreconflag] -! Flag to indicate attribute reconciliation. -! \item[siwrap] -! List of local state items. -! \item[buffer] -! Buffer -! \item[rc] -! Return code; equals {\tt ESMF\_SUCCESS} if there are no errors. -! \end{description} -!EOPI + if (debug) then + print *, ESMF_METHOD, ': allocating obj_buffer bounds = (0:', buffer_offset-1, ')' + end if - integer :: localrc, i - integer :: memstat - type(ESMF_StateItem), pointer :: stateItem - type(ESMF_State) :: wrapper - integer :: itemType - integer :: itemSize - integer :: sizeBuffer, posBuffer - character, pointer :: fakeBuffer(:) ! when inquiring sizes - integer :: sizeFakeBuffer - type(ESMF_InquireFlag) :: inqflag + allocate (obj_buffer(0:buffer_offset-1), stat=memstat) + if (ESMF_LogFoundAllocError(memstat, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, & + rcToReturn=rc)) return + buffer_offset = 0 - ! Init to not implemented - localrc = ESMF_RC_NOT_IMPL + end select -#ifdef RECONCILE_LOG_on - call ESMF_LogWrite("ESMF_ReconcileSerializeAll()", & - ESMF_LOGMSG_DEBUG, rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & - rcToReturn=rc)) return -#endif + lbufsize = size (obj_buffer) - !!!!! Calculate buffer size !!!!! + stateitem => siwrap(item)%si + type_table(item) = stateitem%otype%ot - ! Start with number of items - sizeBuffer=ESMF_SIZEOF_DEFINT + ! serialize item + select case (stateitem%otype%ot) - ! Allocate a fake buffer for passing in when asking for size - allocate(fakeBuffer(0:ESMF_SIZEOF_DEFINT-1)) + case (ESMF_STATEITEM_FIELDBUNDLE%ot) + if (debug) then + print *, ' PET', localPet, & + ': serializing FieldBundle, pass =', pass, ', offset =', buffer_offset + end if + call ESMF_FieldBundleSerialize(stateitem%datap%fbp, & + obj_buffer, lbufsize, buffer_offset, & + attreconflag=attreconflag, inquireflag=inqflag, & + rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, & + rcToReturn=rc)) return - ! Fake buffer size - sizeFakeBuffer=size(fakeBuffer) + case (ESMF_STATEITEM_FIELD%ot) + if (debug) then + print *, ' PET', localPet, & + ': serializing Field, pass =', pass, ', offset =', buffer_offset + end if + call ESMF_FieldSerialize(stateitem%datap%fp, & + obj_buffer, lbufsize, buffer_offset, & + attreconflag=attreconflag, inquireflag=inqflag, & + rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, & + rcToReturn=rc)) return - ! Set flag to only check size - inqflag = ESMF_INQUIREONLY + case (ESMF_STATEITEM_ARRAY%ot) + if (debug) then + print *, ' PET', localPet, & + ': serialized Array, pass =', pass, ', offset =', buffer_offset + end if + call c_ESMC_ArraySerialize(stateitem%datap%ap, & + obj_buffer, lbufsize, buffer_offset, & + attreconflag, inqflag, & + localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, & + rcToReturn=rc)) return - ! Loop over items in itemList and determine buffer size needed - do i=1, itemCount + case (ESMF_STATEITEM_ARRAYBUNDLE%ot) + if (debug) then + print *, ' PET', localPet, & + ': serializing ArrayBundle, pass =', pass, ', offset =', buffer_offset + end if + call c_ESMC_ArrayBundleSerialize(stateitem%datap%abp, & + obj_buffer, lbufsize, buffer_offset, & + attreconflag, inqflag, & + localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, & + rcToReturn=rc)) return - ! Get one State Item - stateItem => siwrap(itemList(i))%si + case (ESMF_STATEITEM_STATE%ot) + if (debug) then + print *, ' PET', localPet, & + ': serializing subState, pass =', pass, ', offset =', buffer_offset + end if + wrapper%statep => stateitem%datap%spp + ESMF_INIT_SET_CREATED(wrapper) + call ESMF_StateSerialize(wrapper, & + obj_buffer, lbufsize, buffer_offset, & + attreconflag=attreconflag, inquireflag=inqflag, & + rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, & + rcToReturn=rc)) return - ! Get item type - itemType = stateitem%otype%ot + case (ESMF_STATEITEM_ROUTEHANDLE%ot) + if (debug) then + print *, ' PET', localPet, & + ': ignoring RouteHandle, pass =', pass + end if + ! Do nothing for RouteHandles. There is no need to reconcile them. - ! Init itemSize to 0, so when we ask for the offset, - ! we are also getting the size - itemSize=0 - ! Get size of item to serialize - select case (itemType) - case (ESMF_STATEITEM_FIELDBUNDLE%ot) - call ESMF_FieldBundleSerialize(stateItem%datap%fbp, & - fakeBuffer, sizeFakeBuffer, itemSize, & - attreconflag=attreconflag, inquireflag=inqflag, & - rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & - rcToReturn=rc)) return -#ifdef RECONCILE_LOG_on - block - character(ESMF_MAXSTR) :: itemName - character(160) :: msgStr - call ESMF_FieldBundleGet(stateItem%datap%fbp, name=itemName, & - rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & - rcToReturn=rc)) return - write(msgStr,*) "Serialize FieldBundle '"//trim(itemName)//"' "//& - " size=", itemSize - call ESMF_LogWrite(msgStr, ESMF_LOGMSG_DEBUG, rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & - rcToReturn=rc)) return - end block -#endif - case (ESMF_STATEITEM_FIELD%ot) - call ESMF_FieldSerialize(stateItem%datap%fp, & - fakeBuffer, sizeFakeBuffer, itemSize, & - attreconflag=attreconflag, inquireflag=inqflag, & - rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & - rcToReturn=rc)) return -#ifdef RECONCILE_LOG_on - block - character(ESMF_MAXSTR) :: itemName - character(160) :: msgStr - call ESMF_FieldGet(stateItem%datap%fp, name=itemName, & - rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & - rcToReturn=rc)) return - write(msgStr,*) "Serialize Field '"//trim(itemName)//"' "//& - " size=", itemSize - call ESMF_LogWrite(msgStr, ESMF_LOGMSG_DEBUG, rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & - rcToReturn=rc)) return - end block -#endif - case (ESMF_STATEITEM_ARRAY%ot) - call c_ESMC_ArraySerialize(stateitem%datap%ap, & - fakeBuffer, sizeFakeBuffer, itemSize, & - attreconflag, inqflag, & - localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & - rcToReturn=rc)) return -#ifdef RECONCILE_LOG_on - block - character(ESMF_MAXSTR) :: itemName - character(160) :: msgStr - call ESMF_ArrayGet(stateItem%datap%ap, name=itemName, & - rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & - rcToReturn=rc)) return - write(msgStr,*) "Serialize Array '"//trim(itemName)//"' "//& - " size=", itemSize - call ESMF_LogWrite(msgStr, ESMF_LOGMSG_DEBUG, rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & - rcToReturn=rc)) return - end block -#endif - case (ESMF_STATEITEM_ARRAYBUNDLE%ot) - call c_ESMC_ArrayBundleSerialize(stateitem%datap%abp, & - fakeBuffer, sizeFakeBuffer, itemSize, & - attreconflag, inqflag, & - localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & - rcToReturn=rc)) return -#ifdef RECONCILE_LOG_on - block - character(ESMF_MAXSTR) :: itemName - character(160) :: msgStr - call ESMF_ArrayBundleGet(stateItem%datap%abp, name=itemName, & - rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & - rcToReturn=rc)) return - write(msgStr,*) "Serialize ArrayBundle '"//trim(itemName)//"' "//& - " size=", itemSize - call ESMF_LogWrite(msgStr, ESMF_LOGMSG_DEBUG, rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & + case (ESMF_STATEITEM_UNKNOWN%ot) + if (debug) then + print *, ESMF_METHOD, ': serializing unknown: ', trim (stateitem%namep) + end if + write (errstring, '(a)') 'can''t serialize unknown type!!' + if (ESMF_LogFoundError(ESMF_RC_INTNRL_INCONS, msg=errstring, & + ESMF_CONTEXT, & rcToReturn=rc)) return - end block -#endif - case (ESMF_STATEITEM_STATE%ot) - wrapper%statep => stateitem%datap%spp - ESMF_INIT_SET_CREATED(wrapper) - call ESMF_StateSerialize(wrapper, & - fakeBuffer, sizeFakeBuffer, itemSize, & - attreconflag=attreconflag, inquireflag=inqflag, & - rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & + + case default + localrc = ESMF_RC_INTNRL_INCONS + if (debug) then + print *, ' PET', localPet, & + ': serialization error in default case. Returning ESMF_RC_INTNRL_INCONS' + end if + + end select + + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, & rcToReturn=rc)) return -#ifdef RECONCILE_LOG_on - block - character(ESMF_MAXSTR) :: itemName - character(160) :: msgStr - call ESMF_StateGet(wrapper, name=itemName, & - rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & - rcToReturn=rc)) return - write(msgStr,*) "Serialize State '"//trim(itemName)//"' "//& - " size=", itemSize - call ESMF_LogWrite(msgStr, ESMF_LOGMSG_DEBUG, rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & - rcToReturn=rc)) return - end block + +#if defined (ALIGN_FIX) + buffer_offset = ((buffer_offset+7)/8)*8 #endif - case (ESMF_STATEITEM_ROUTEHANDLE%ot) - ! Do nothing for RouteHandles. There is no need to reconcile them. - case default - call ESMF_LogSetError(ESMF_RC_INTNRL_INCONS, & - msg="Unrecognized item type.", & - ESMF_CONTEXT, & - rcToReturn=rc) - return - end select - ! Add item type's size - sizeBuffer = sizeBuffer + ESMF_SIZEOF_DEFINT + if (debug) then + print *, ' PET', localPet, & + ': item serialized, pass =', pass, ', new offset =', buffer_offset, & + merge (" (calc'ed)", " (actual) ", pass == 1) + end if - ! Update buffer size by itemSize - sizeBuffer = sizeBuffer + itemSize - enddo + end do pass_loop - ! Get rid of fakeBuffer - deallocate(fakeBuffer) + pet_needs(item)%obj_buffer => obj_buffer + pet_needs(item)%buffer_size = buffer_offset + obj_buffer => null () - !!!!! Allocate buffer to serialize into !!!!! - allocate(buffer(0:sizeBuffer-1), stat=memstat) - if (ESMF_LogFoundAllocError(memstat, ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, & - rcToReturn=rc)) return + end do item_loop - !!!!! Serialize information into buffer !!!!! + if (debug) & + print *, ESMF_METHOD, ': buffer_sizes =', pet_needs(:)%buffer_size - ! Start position of buffer - posBuffer = 0 +! For each PET, create a buffer containing its serialized needs. The buffer +! consists of a count of items, a table of the offsets (in bytes) of each +! serialized item, and the serialized items themselves. - ! Put item count in buffer - buffer(posBuffer:posBuffer+ESMF_SIZEOF_DEFINT-1) = transfer ( & - source=itemCount, & - mold=buffer(0:ESMF_SIZEOF_DEFINT-1)) - posBuffer = posbuffer + ESMF_SIZEOF_DEFINT + if (trace) then + call ESMF_ReconcileDebugPrint (ESMF_METHOD // & + ': *** Step 3 - Create per-PET serialized buffers') + end if + do, pet=0, petCount-1 + needs_count = count (needs_list(:,pet)) + if (debug .and. needs_count > 0) then + print *, ' PET', localPet, & + ': needs_count =', needs_count, ', for PET', pet + end if + if (needs_count == 0) then + id_info(pet)%item_buffer => null () + cycle + end if - ! Set flag to actually serialize - inqflag = ESMF_NOINQUIRE + ! Calculate size needed for serialized item buffer, including + ! space for needs_count, and size/type table + buffer_offset = ESMF_SIZEOF_DEFINT * (2 + needs_count*2) + do, item=1, nitems + if (needs_list(item, pet)) & + buffer_offset = buffer_offset + pet_needs(item)%buffer_size + end do - ! Loop over items in itemList and add to buffer - do i=1, itemCount + if (debug) then + print *, ' PET', localPet, & + ': computed buffer_offset =', buffer_offset, ', for PET', pet + end if - ! Get one State Item - stateItem => siwrap(itemList(i))%si + ! Fill serialized item buffer - ! Get item type - itemType = stateitem%otype%ot + allocate (id_info(pet)%item_buffer(0:buffer_offset-1), & + stat=memstat) + if (ESMF_LogFoundAllocError(memstat, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, & + rcToReturn=rc)) return + obj_buffer => id_info(pet)%item_buffer - ! Add item type to buffer - buffer(posBuffer:posBuffer+ESMF_SIZEOF_DEFINT-1) = transfer (& - source=itemType, & - mold =buffer(0:ESMF_SIZEOF_DEFINT-1)) - posBuffer = posbuffer + ESMF_SIZEOF_DEFINT + if (debug) then + write(logmsg, *) "ESMF_SIZEOF_DEFINT=", ESMF_SIZEOF_DEFINT + call ESMF_LogWrite(trim(logmsg)) + write(logmsg, *) "needs_count=", needs_count + call ESMF_LogWrite(trim(logmsg)) + end if - ! Add serialized items - select case (itemType) - case (ESMF_STATEITEM_FIELDBUNDLE%ot) - call ESMF_FieldBundleSerialize(stateItem%datap%fbp, & - buffer, sizeBuffer, posBuffer, & - attreconflag=attreconflag, inquireflag=inqflag, & - rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & - rcToReturn=rc)) return - case (ESMF_STATEITEM_FIELD%ot) - call ESMF_FieldSerialize(stateItem%datap%fp, & - buffer, sizeBuffer, posBuffer, & - attreconflag=attreconflag, inquireflag=inqflag, & - rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & - rcToReturn=rc)) return - case (ESMF_STATEITEM_ARRAY%ot) - call c_ESMC_ArraySerialize(stateitem%datap%ap, & - buffer, sizeBuffer, posBuffer, & - attreconflag, inqflag, & - localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & - rcToReturn=rc)) return - case (ESMF_STATEITEM_ARRAYBUNDLE%ot) - call c_ESMC_ArrayBundleSerialize(stateitem%datap%abp, & - buffer, sizeBuffer, posBuffer, & - attreconflag, inqflag, & - localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & - rcToReturn=rc)) return - case (ESMF_STATEITEM_STATE%ot) - wrapper%statep => stateitem%datap%spp - ESMF_INIT_SET_CREATED(wrapper) - call ESMF_StateSerialize(wrapper, & - buffer, sizeBuffer, posBuffer, & - attreconflag=attreconflag, inquireflag=inqflag, & - rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & + obj_buffer(0:ESMF_SIZEOF_DEFINT-1) = transfer ( & + source=needs_count, & + mold =obj_buffer(0:ESMF_SIZEOF_DEFINT-1)) + + if (debug) then + needs_count_debug = transfer(source=obj_buffer(0:ESMF_SIZEOF_DEFINT-1), & + mold=needs_count_debug) + write(logmsg, *) "needs_count_debug=", needs_count_debug + call ESMF_LogWrite(trim(logmsg)) + end if + + ! space for needs_count, padding, and size/type table + buffer_offset = ESMF_SIZEOF_DEFINT * (2 + needs_count*2) + + i = 2 * ESMF_SIZEOF_DEFINT ! space for needs_count and a pad + do, item=1, nitems + if (.not. needs_list(item, pet)) cycle + lbufsize = pet_needs(item)%buffer_size + if (lbufsize == 0) cycle + + if (debug) then + print *, ' PET', localPet, & + ': packing at buffer_offset =', buffer_offset, ', for PET', pet, & + ', item =', item + end if + obj_buffer(i:i+ESMF_SIZEOF_DEFINT-1) = & ! Buffer offset + transfer ( & + source=buffer_offset, & + mold =obj_buffer(0:ESMF_SIZEOF_DEFINT-1)) + i = i + ESMF_SIZEOF_DEFINT + + obj_buffer(i:i+ESMF_SIZEOF_DEFINT-1) = & ! Item type + transfer ( & + source=type_table(item), & + mold =obj_buffer(0:ESMF_SIZEOF_DEFINT-1)) + i = i + ESMF_SIZEOF_DEFINT + + obj_buffer(buffer_offset:buffer_offset+lbufsize-1) = & ! Serialized item + pet_needs(item)%obj_buffer(:lbufsize-1) + buffer_offset = buffer_offset + lbufsize + end do ! items + + end do ! pets + + if (trace) then + call ESMF_ReconcileDebugPrint (ESMF_METHOD // & + ': *** Step 4 - Deallocate memory') + end if + + if (allocated (pet_needs)) then + do, i=1, nitems + if (associated (pet_needs(i)%obj_buffer)) then + deallocate (pet_needs(i)%obj_buffer, stat=memstat) + if (ESMF_LogFoundDeallocError(memstat, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, & rcToReturn=rc)) return - case (ESMF_STATEITEM_ROUTEHANDLE%ot) - ! Do nothing for RouteHandles. There is no need to reconcile them. - case default - call ESMF_LogSetError(ESMF_RC_INTNRL_INCONS, & - msg="Unrecognized item type.", & - ESMF_CONTEXT, & - rcToReturn=rc) - return - end select - enddo + end if + end do - ! Return success - rc = ESMF_SUCCESS + deallocate (pet_needs, stat=memstat) + if (ESMF_LogFoundDeallocError(memstat, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, & + rcToReturn=rc)) return + end if - end subroutine ESMF_ReconcileSerializeAll + rc = ESMF_SUCCESS + end subroutine ESMF_ReconcileSerialize !------------------------------------------------------------------------------ #undef ESMF_METHOD From 5f49277366f17d1b7f36947b2f182a04146aebe6 Mon Sep 17 00:00:00 2001 From: Gerhard Theurich Date: Wed, 13 Nov 2024 15:59:39 -0800 Subject: [PATCH 135/207] Major code declutter and clean-up. --- .../src/ESMF_StateReconcile.F90 | 457 ++++-------------- 1 file changed, 96 insertions(+), 361 deletions(-) diff --git a/src/Superstructure/StateReconcile/src/ESMF_StateReconcile.F90 b/src/Superstructure/StateReconcile/src/ESMF_StateReconcile.F90 index efbadc4174..d34e59bd44 100644 --- a/src/Superstructure/StateReconcile/src/ESMF_StateReconcile.F90 +++ b/src/Superstructure/StateReconcile/src/ESMF_StateReconcile.F90 @@ -129,9 +129,6 @@ module ESMF_StateReconcileMod ! !============================================================================== - logical, parameter :: trace=.false. - logical, parameter :: debug=.false. - contains !============================================================================== @@ -662,7 +659,9 @@ recursive subroutine StateReconcileIsNoopLoc(stateR, isNoopLoc, rc) ESMF_CONTEXT, rcToReturn=rc)) return endif -!call ESMF_LogWrite("processing "//trim(itemNameList(item)), ESMF_LOGMSG_DEBUG, rc=localrc) +#if 0 +call ESMF_LogWrite("processing "//trim(itemNameList(item)), ESMF_LOGMSG_DEBUG, rc=localrc) +#endif call ESMF_VMGetThis(vmItem, thisItem, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & @@ -745,9 +744,7 @@ subroutine ESMF_StateReconcile_driver(state, vm, rc) type(ESMF_VMId), pointer :: vmids_send(:) integer, allocatable, target :: vmintids_send(:) - logical, parameter :: debug = .false. logical, parameter :: meminfo = .false. - logical, parameter :: trace = .false. logical, parameter :: profile = .true. type(ESMF_VMId), allocatable, target :: vmIdMap(:) @@ -775,12 +772,11 @@ subroutine ESMF_StateReconcile_driver(state, vm, rc) ESMF_CONTEXT, & rcToReturn=rc)) return - if (debug) then - call ESMF_StateLog(state, rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, & - rcToReturn=rc)) return - end if +#if 0 + call ESMF_StateLog(state, rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & + rcToReturn=rc)) return +#endif ! ------------------------------------------------------------------------- ! (0) Interchange item counts between PETs. Set up counts/displacements @@ -792,16 +788,10 @@ subroutine ESMF_StateReconcile_driver(state, vm, rc) rcToReturn=rc)) return endif ! ------------------------------------------------------------------------- - if (trace) then - call ESMF_ReconcileDebugPrint (ESMF_METHOD // & - ': *** Step 0 - Initialize item counts and siwrappers') - end if siwrap => null () nitems_buf => null () call ESMF_ReconcileInitialize (state, vm, & siwrap=siwrap, nitems_all=nitems_buf, rc=localrc) - if (debug) & - localrc = ESMF_ReconcileAllRC (vm, localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, & rcToReturn=rc)) return @@ -827,10 +817,6 @@ subroutine ESMF_StateReconcile_driver(state, vm, rc) rcToReturn=rc)) return endif ! ------------------------------------------------------------------------- - if (trace) then - call ESMF_ReconcileDebugPrint (ESMF_METHOD // & - ': *** Step 1.0 - Build send arrays') - end if ids_send => null () vmids_send => null () if (profile) then @@ -843,8 +829,6 @@ subroutine ESMF_StateReconcile_driver(state, vm, rc) id= ids_send, & vmid=vmids_send, & rc=localrc) - if (debug) & - localrc = ESMF_ReconcileAllRC (vm, localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, & rcToReturn=rc)) return @@ -855,11 +839,6 @@ subroutine ESMF_StateReconcile_driver(state, vm, rc) rcToReturn=rc)) return endif - if (trace) then - call ESMF_ReconcileDebugPrint (ESMF_METHOD // & - ': *** Step 1.1 - Translate VM identifiers to integers') - end if - ! Translate VmId objects to an integer representation to minimize memory ! usage. This is also beneficial for performance. if (profile) then @@ -1023,10 +1002,6 @@ subroutine ESMF_StateReconcile_driver(state, vm, rc) rcToReturn=rc)) return endif ! ------------------------------------------------------------------------- - if (trace) then - call ESMF_ReconcileDebugPrint (ESMF_METHOD // & - ': *** Step 2.0 - Update Field metadata for unique geometries') - end if ! Update Field metadata for unique geometries. This will traverse the state ! hierarchy adding reconcile-specific attributes that will find unique @@ -1148,10 +1123,6 @@ subroutine ESMF_StateReconcile_driver(state, vm, rc) rcToReturn=rc)) return endif ! ------------------------------------------------------------------------- - if (trace) then - call ESMF_ReconcileDebugPrint (ESMF_METHOD // & - ': *** Step X.0 - Clean-up') - end if if (associated (ids_send)) then deallocate (ids_send, vmids_send, stat=memstat) @@ -1198,10 +1169,7 @@ subroutine ESMF_StateReconcile_driver(state, vm, rc) rcToReturn=rc)) return endif ! ------------------------------------------------------------------------- - if (trace) then - call ESMF_ReconcileDebugPrint (ESMF_METHOD // & - ': *** Step X+1.0 - Reconcile Zapped Proxies') - end if + call ESMF_ReconcileZappedProxies(state, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, & @@ -1243,10 +1211,6 @@ subroutine ESMF_StateReconcile_driver(state, vm, rc) if (meminfo) call ESMF_VMLogMemInfo ("(X+2) Use Field metadata for unique geometries") #endif - if (trace) then - call ESMF_ReconcileDebugPrint (ESMF_METHOD // ': Complete!') - call ESMF_VMBarrier (vm) - end if rc = ESMF_SUCCESS if (meminfo) call ESMF_VMLogMemInfo ("exiting ESMF_StateReconcile_driver") @@ -1901,26 +1865,23 @@ subroutine ESMF_ReconcileDeserializeAll(state, vm, attreconflag, buffer, rc) character(ESMF_MAXSTR) :: errstring character(ESMF_MAXSTR) :: name integer :: localPet - logical, parameter :: debug = .false. - logical, parameter :: trace = .false. integer :: item, numNewItems integer :: itemType - integer :: sizeBuffer, posBuffer + integer :: sizeBuffer, posBuffer #ifdef RECONCILE_LOG_on - call ESMF_LogWrite("ESMF_ReconcileDeserializeAll()", & - ESMF_LOGMSG_DEBUG, rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & - rcToReturn=rc)) return + call ESMF_LogWrite("ESMF_ReconcileDeserializeAll()", & + ESMF_LOGMSG_DEBUG, rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & + rcToReturn=rc)) return #endif ! VM information for debug output call ESMF_VMGet (vm, localPet=localPet, 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 + ! Set start position of buffer posBuffer = 0 @@ -1929,7 +1890,7 @@ subroutine ESMF_ReconcileDeserializeAll(state, vm, attreconflag, buffer, rc) source=buffer(posBuffer:posBuffer+ESMF_SIZEOF_DEFINT-1), & mold = numNewItems) posBuffer = posbuffer + ESMF_SIZEOF_DEFINT - + ! Loop getting new items do item=1, numNewItems @@ -1942,128 +1903,135 @@ subroutine ESMF_ReconcileDeserializeAll(state, vm, attreconflag, buffer, rc) ! Get items select case (itemType) case (ESMF_STATEITEM_FIELDBUNDLE%ot) - if (debug) then - print *, "deserializing FieldBundle, pos =",posBuffer - end if +#ifdef RECONCILE_LOG_on + block + character(160) :: msgStr + write(msgStr,*) "deserializing FieldBundle, pos =", posBuffer + call ESMF_LogWrite(msgStr, ESMF_LOGMSG_DEBUG, rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & + rcToReturn=rc)) return + end block +#endif fieldbundle = ESMF_FieldBundleDeserialize(buffer, posBuffer, & attreconflag=attreconflag, 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_StateAdd(state, fieldbundle, & addflag=.true., proxyflag=.true., & 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 case (ESMF_STATEITEM_FIELD%ot) - if (debug) then - print *, "deserializing Field, pos =", posBuffer - end if +#ifdef RECONCILE_LOG_on + block + character(160) :: msgStr + write(msgStr,*) "deserializing Field, pos =", posBuffer + call ESMF_LogWrite(msgStr, ESMF_LOGMSG_DEBUG, rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & + rcToReturn=rc)) return + end block +#endif field = ESMF_FieldDeserialize(buffer, posBuffer, & attreconflag=attreconflag, rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, & - rcToReturn=rc)) return - - ! Debug - call ESMF_FieldGet(field, name=name, rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, & - rcToReturn=rc)) return - - if (debug) then - print *, "created field, ready to add to local state" - end if + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & + rcToReturn=rc)) return call ESMF_StateAdd(state, field, & addflag=.true., proxyflag=.true., & 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 case (ESMF_STATEITEM_ARRAY%ot) - if (debug) then - print *, " PET", localPet, & - ": deserializing Array pos =",posBuffer - end if +#ifdef RECONCILE_LOG_on + block + character(160) :: msgStr + write(msgStr,*) "deserializing Array, pos =", posBuffer + call ESMF_LogWrite(msgStr, ESMF_LOGMSG_DEBUG, rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & + rcToReturn=rc)) return + end block +#endif call c_ESMC_ArrayDeserialize(array, buffer, posBuffer, & attreconflag, 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 ! Set init code call ESMF_ArraySetInitCreated(array, 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_StateAdd(state, array, & addflag=.true., proxyflag=.true., & 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 case (ESMF_STATEITEM_ARRAYBUNDLE%ot) - if (debug) then - print *, "deserializing ArrayBundle pos =",posBuffer - end if +#ifdef RECONCILE_LOG_on + block + character(160) :: msgStr + write(msgStr,*) "deserializing ArrayBundle, pos =", posBuffer + call ESMF_LogWrite(msgStr, ESMF_LOGMSG_DEBUG, rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & + rcToReturn=rc)) return + end block +#endif call c_ESMC_ArrayBundleDeserialize(arraybundle, buffer, posBuffer, & attreconflag, 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 ! Set init code call ESMF_ArrayBundleSetInitCreated(arraybundle, 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_StateAdd(state, arraybundle, & addflag=.true., proxyflag=.true., & 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 case (ESMF_STATEITEM_STATE%ot) - if (debug) then - print *, "deserializing nested State pos =",posBuffer - end if +#ifdef RECONCILE_LOG_on + block + character(160) :: msgStr + write(msgStr,*) "deserializing State, pos =", posBuffer + call ESMF_LogWrite(msgStr, ESMF_LOGMSG_DEBUG, rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & + rcToReturn=rc)) return + end block +#endif substate = ESMF_StateDeserialize(vm, buffer, posBuffer, & attreconflag=attreconflag, 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_StateAdd(state, substate, & addflag=.true., proxyflag=.true., & 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 case (ESMF_STATEITEM_UNKNOWN%ot) write (errstring, '(a,i0)') 'can''t deserialize unknown type: ', itemType - if (ESMF_LogFoundError(ESMF_RC_INTNRL_INCONS, msg=errstring, & - ESMF_CONTEXT, & - rcToReturn=rc)) return + call ESMF_LogSetError(ESMF_RC_INTNRL_INCONS, msg=errstring, & + ESMF_CONTEXT, rcToReturn=rc) + return case default write (errstring, '(a,i0)') 'can''t deserialize unsupported type: ', itemType - if (ESMF_LogFoundError(ESMF_RC_INTNRL_INCONS, msg=errstring, & - ESMF_CONTEXT, & - rcToReturn=rc)) return + call ESMF_LogSetError(ESMF_RC_INTNRL_INCONS, msg=errstring, & + ESMF_CONTEXT, rcToReturn=rc) + return + end select - - enddo + enddo ! Return success rc = ESMF_SUCCESS @@ -2157,10 +2125,6 @@ subroutine ESMF_ReconcileBruteForce(state, vm, attreconflag, siwrap, & rcToReturn=rc)) return endif ! ------------------------------------------------------------------------- - if (trace) then - call ESMF_ReconcileDebugPrint (ESMF_METHOD // & - ': *** Step 3 - Exchange Ids/VMIds') - end if allocate (id_info(0:petCount-1), stat=memstat) if (ESMF_LogFoundAllocError(memstat, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, & @@ -2171,8 +2135,6 @@ subroutine ESMF_ReconcileBruteForce(state, vm, attreconflag, siwrap, & vmid=vmintids_send, & id_info=id_info, & rc=localrc) - if (debug) & - localrc = ESMF_ReconcileAllRC (vm, localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, & rcToReturn=rc)) return @@ -2202,17 +2164,11 @@ subroutine ESMF_ReconcileBruteForce(state, vm, attreconflag, siwrap, & rcToReturn=rc)) return endif ! ------------------------------------------------------------------------- - if (trace) then - call ESMF_ReconcileDebugPrint (ESMF_METHOD // & - ': *** Step 4 - Compare and create needs arrays') - end if call ESMF_ReconcileCompareNeeds (vm, & id= ids_send, & vmid=vmintids_send, & id_info=id_info, & rc=localrc) - if (debug) & - localrc = ESMF_ReconcileAllRC (vm, localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, & rcToReturn=rc)) return @@ -2240,17 +2196,11 @@ subroutine ESMF_ReconcileBruteForce(state, vm, attreconflag, siwrap, & rcToReturn=rc)) return endif ! ------------------------------------------------------------------------- - if (trace) then - call ESMF_ReconcileDebugPrint (ESMF_METHOD // & - ': *** Step 5 - Exchange needs') - end if recvd_needs_matrix => null () call ESMF_ReconcileExchgNeeds (vm, & id_info=id_info, & recv_needs=recvd_needs_matrix, & rc=localrc) - if (debug) & - localrc = ESMF_ReconcileAllRC (vm, localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, & rcToReturn=rc)) return @@ -2274,17 +2224,11 @@ subroutine ESMF_ReconcileBruteForce(state, vm, attreconflag, siwrap, & rcToReturn=rc)) return endif ! ------------------------------------------------------------------------- - if (trace) then - call ESMF_ReconcileDebugPrint (ESMF_METHOD // & - ': *** Step 6 - Serialize needs', ask=.false.) - end if call ESMF_ReconcileSerialize (state, vm, siwrap, & needs_list=recvd_needs_matrix, & attreconflag=attreconflag, & id_info=id_info, & rc=localrc) - if (debug) & - localrc = ESMF_ReconcileAllRC (vm, localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, & rcToReturn=rc)) return @@ -2312,10 +2256,6 @@ subroutine ESMF_ReconcileBruteForce(state, vm, attreconflag, siwrap, & rcToReturn=rc)) return endif ! ------------------------------------------------------------------------- - if (trace) then - call ESMF_ReconcileDebugPrint (ESMF_METHOD // & - ': *** Step 7 - Exchange serialized objects') - end if allocate (items_recv(0:petCount-1), stat=memstat) if (ESMF_LogFoundAllocError(memstat, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, & @@ -2326,8 +2266,6 @@ subroutine ESMF_ReconcileBruteForce(state, vm, attreconflag, siwrap, & recv_items=items_recv, & ! %cptr aliased to portions of buffer_recv recv_buffer=buffer_recv, & rc=localrc) - if (debug) & - localrc = ESMF_ReconcileAllRC (vm, localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, & rcToReturn=rc)) return @@ -2352,21 +2290,9 @@ subroutine ESMF_ReconcileBruteForce(state, vm, attreconflag, siwrap, & rcToReturn=rc)) return endif ! ------------------------------------------------------------------------- - if (trace) then - call ESMF_ReconcileDebugPrint (ESMF_METHOD // & - ': *** Step 8 - Deserialize needs') - end if + do, i=0, petCount-1 - if (debug) then - write (*, '(a,i0,a,i0,a,l1)') & - ' PET ', localPet, ': Deserializing from PET ', i, & - ', associated (items_recv(i)%cptr) =', associated (items_recv(i)%cptr) - end if if (associated (items_recv(i)%cptr)) then - if (debug) then - print *, ' items_recv(', lbound (items_recv(i)%cptr), & - ':', ubound (items_recv(i)%cptr), ')' - end if call ESMF_ReconcileDeserialize (state, vm, & obj_buffer=items_recv(i)%cptr, & attreconflag=attreconflag, & @@ -2374,16 +2300,10 @@ subroutine ESMF_ReconcileBruteForce(state, vm, attreconflag, siwrap, & else localrc = ESMF_SUCCESS end if - if (debug) & - localrc = ESMF_ReconcileAllRC (vm, localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, & rcToReturn=rc)) return end do - if (trace) then - call ESMF_ReconcileDebugPrint (ESMF_METHOD // & - ': *** Step 8 - Complete') - end if ! ------------------------------------------------------------------------- if (profile) then @@ -2519,8 +2439,6 @@ subroutine ESMF_ReconcileCompareNeeds (vm, id, vmid, id_info, rc) needs_list => null () -! call ESMF_ReconcileDebugPrint (ESMF_METHOD // & -! ': computing id_info%needed') do, i=0, petCount-1 id_info(i)%needed = .false. if (i == localPet) cycle @@ -2859,7 +2777,6 @@ subroutine ESMF_ReconcileDeserialize (state, vm, obj_buffer, attreconflag, rc) integer :: localPet logical, parameter :: debug = .false. - logical, parameter :: trace = .false. ! Sanity checks call ESMF_VMGet (vm, localPet=localPet, rc=localrc) @@ -2867,11 +2784,6 @@ subroutine ESMF_ReconcileDeserialize (state, vm, obj_buffer, attreconflag, rc) ESMF_CONTEXT, & rcToReturn=rc)) return - if (trace) then - print *, ' pet', localPet, & - ': *** Step 0 - sanity checks' - end if - needs_count = transfer ( & source=obj_buffer(0:ESMF_SIZEOF_DEFINT-1), & mold =needs_count) @@ -2916,10 +2828,6 @@ subroutine ESMF_ReconcileDeserialize (state, vm, obj_buffer, attreconflag, rc) end do ! Deserialize items - if (trace) then - print *, ' pet', localPet, & - ': *** Step 1 - main deserialization loop' - end if buffer_offset = ESMF_SIZEOF_DEFINT * (2 + 2*needs_count) ! Skip past count, pad, and offset/type tables do, i=1, needs_count @@ -3069,11 +2977,6 @@ subroutine ESMF_ReconcileDeserialize (state, vm, obj_buffer, attreconflag, rc) end do ! needs_count - if (trace) then - print *, ' pet', localPet, & - ': *** Deserialization complete' - end if - rc = ESMF_SUCCESS end subroutine ESMF_ReconcileDeserialize @@ -3493,10 +3396,6 @@ subroutine ESMF_ReconcileExchgIDInfo (vm, & ESMF_CONTEXT, & rcToReturn=rc)) return - if (debug) then - call ESMF_ReconcileDebugPrint (ESMF_METHOD // & - ': Exchanging Ids (using ESMF_VMAllGatherV)') - end if call ESMF_VMAllGatherV (vm, & sendData=id , sendCount =size (id), & recvData=id_recv, recvCounts=counts_buf_recv, recvOffsets=displs_buf_recv, & @@ -3551,11 +3450,6 @@ subroutine ESMF_ReconcileExchgIDInfo (vm, & ! It will probably not be used, but AllToAll calls are notoriously problematic ! with some MPI implementations. #if 0 - if (trace) then - call ESMF_ReconcileDebugPrint (ESMF_METHOD // & - ': Exchanging VMIds (using ESMF_VMAllGatherVMId)') - end if - allocate (vmid_recv(0:sum (counts_buf_recv+1)-1), & stat=memstat) if (ESMF_LogFoundAllocError(memstat, ESMF_ERR_PASSTHRU, & @@ -3587,14 +3481,6 @@ subroutine ESMF_ReconcileExchgIDInfo (vm, & end do !else ! VMBcastVMId version - if (trace) then - call ESMF_ReconcileDebugPrint (ESMF_METHOD // & - ': Exchanging VMIds (using ESMF_VMBcastVMId)') - end if - if (debug) then - call ESMF_ReconcileDebugPrint (ESMF_METHOD // & - ': VMIdCopying...') - end if call ESMF_VMIdCopy ( & dest=id_info(localPet)%vmid, & source=vmid, & @@ -3604,11 +3490,6 @@ subroutine ESMF_ReconcileExchgIDInfo (vm, & rcToReturn=rc)) return do, send_pet=0, petCount-1 - if (debug) then - call ESMF_ReconcileDebugPrint (ESMF_METHOD // & - ': broadcasting VMId, using rootPet ' // iToS (send_pet), & - ask=.false.) - end if call ESMF_VMBcastVMId (vm, & bcstData=id_info(send_pet)%vmid, & count=size (id_info(send_pet)%vmid), & @@ -3993,11 +3874,6 @@ subroutine ESMF_ReconcileExchgNeeds (vm, id_info, recv_needs, rc) ! AlltoAllV - if (trace) then - call ESMF_ReconcileDebugPrint (ESMF_METHOD // & - ': calling VMAllToAll') - end if - if (profile) then call ESMF_TraceRegionEnter("ESMF_VMAllToAllV", rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & @@ -4407,7 +4283,6 @@ subroutine ESMF_ReconcileSerialize (state, vm, siwrap, & integer :: localPet, petCount, pet logical, parameter :: debug=.false. - logical, parameter :: trace=.false. character(len=ESMF_MAXSTR) :: logmsg integer :: needs_count_debug @@ -4433,10 +4308,6 @@ subroutine ESMF_ReconcileSerialize (state, vm, siwrap, & nitems = size (siwrap) ! Find the union of all the needs for this PET. - if (trace) then - call ESMF_ReconcileDebugPrint (ESMF_METHOD // & - ': *** Step 1 - Find union of needs') - end if allocate (pet_needs(nitems), & stat=memstat) if (ESMF_LogFoundAllocError(memstat, ESMF_ERR_PASSTHRU, & @@ -4452,10 +4323,6 @@ subroutine ESMF_ReconcileSerialize (state, vm, siwrap, & end if ! Serialize all needed objects - if (trace) then - call ESMF_ReconcileDebugPrint (ESMF_METHOD // & - ': *** Step 2 - Serialize all needed objects') - end if allocate (type_table(nitems), & stat=memstat) if (ESMF_LogFoundAllocError(memstat, ESMF_ERR_PASSTHRU, & @@ -4634,10 +4501,6 @@ subroutine ESMF_ReconcileSerialize (state, vm, siwrap, & ! consists of a count of items, a table of the offsets (in bytes) of each ! serialized item, and the serialized items themselves. - if (trace) then - call ESMF_ReconcileDebugPrint (ESMF_METHOD // & - ': *** Step 3 - Create per-PET serialized buffers') - end if do, pet=0, petCount-1 needs_count = count (needs_list(:,pet)) if (debug .and. needs_count > 0) then @@ -4722,11 +4585,6 @@ subroutine ESMF_ReconcileSerialize (state, vm, siwrap, & end do ! pets - if (trace) then - call ESMF_ReconcileDebugPrint (ESMF_METHOD // & - ': *** Step 4 - Deallocate memory') - end if - if (allocated (pet_needs)) then do, i=1, nitems if (associated (pet_needs(i)%obj_buffer)) then @@ -5233,127 +5091,4 @@ function ESMF_Reconcile_g95_getint (source) result (i) end function ESMF_Reconcile_g95_getint #endif -!------------------------------------------------------------------------------ -! Debugging and support procedures -!------------------------------------------------------------------------------ -#undef ESMF_METHOD -#define ESMF_METHOD "ESMF_ReconcileAllRC" - function ESMF_ReconcileAllRC (vm, rc) result (rc_return) - type(ESMF_VM), intent(in) :: vm - integer, intent(in) :: rc - integer :: rc_return - - integer :: rc_send(1) - integer, allocatable :: rc_all(:) - integer :: localPet, petCount - - call ESMF_VMGet(vm, localpet=localPet, petCount=petCount) - allocate (rc_all(petCount)) - - rc_send = rc - call ESMF_VMGather (vm, & - sendData=rc_send, recvData=rc_all, count=1, & - rootPet=0) - call ESMF_VMBroadcast (vm, & - bcstData=rc_all, count=petCount, & - rootPet=0) - - rc_return = rc - if (any (rc_all /= ESMF_SUCCESS)) then - rc_return = merge (ESMF_FAILURE, rc, rc == ESMF_SUCCESS) - end if - - - end function ESMF_ReconcileAllRC - -#undef ESMF_METHOD -#define ESMF_METHOD "ESMF_ReconcileDebugPrint" - subroutine ESMF_ReconcileDebugPrint (text, multitext, ask, rc) - use ESMF_IOUtilMod - character(*), intent(in), optional :: text - character(*), intent(in), optional :: multitext - logical, intent(in), optional :: ask - integer, intent(out), optional :: rc - - type(ESMF_VM) :: vm - integer :: localrc - integer :: localPet, petCount - character(16) :: answer - character(10) :: time - logical :: localask - - call ESMF_VMGetCurrent(vm=vm, rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, & - rcToReturn=rc)) return - - call ESMF_VMGet(vm, localPet=localPet, petCount=petCount, rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, & - rcToReturn=rc)) return - - localask = .false. - if (present (ask)) then - localask = ask - end if - - if (present (text)) then -#if 0 - call ESMF_UtilIOUnitFlush (ESMF_UtilIOStdout) - call ESMF_VMBarrier (vm) - if (localPet == 0) then - call date_and_time (time=time) - write (ESMF_UtilIOStdout,*) & - time(1:2), ':', time(3:4), ':', time(5:), ': ', text - call ESMF_UtilIOUnitflush (ESMF_UtilIOStdout) - end if - call ESMF_VMBarrier (vm) -#else - call ESMF_LogWrite(trim(text), ESMF_LOGMSG_DEBUG, rc=rc) -#endif - end if - - if (present (multitext)) then -#if 0 - write (ESMF_UtilIOStdout,*) multitext - call ESMF_UtilIOUnitFlush (ESMF_UtilIOStdout) - call ESMF_VMBarrier (vm) -#else - call ESMF_LogWrite(trim(multitext), ESMF_LOGMSG_DEBUG, rc=rc) -#endif - end if - - if (localask) then - if (localPet == 0) then - write (ESMF_UtilIOStdout,'(a)') 'Proceed?' - call ESMF_UtilIOUnitFlush (ESMF_UtilIOStdout) - read (ESMF_UtilIOStdin,'(a)') answer - end if - call ESMF_VMBarrier (vm) - end if - - end subroutine ESMF_ReconcileDebugPrint - - pure function iTos_len (i) - integer, intent(in) :: i - integer :: iTos_len - - character(16) :: string - - write (string,'(i16)') i - iTos_len = len_trim (adjustl (string)) - - end function iTos_len - - function iTos (i) - integer, intent(in) :: i - character(iTos_len (i)) :: iTos - - character(16) :: string - - write (string,'(i16)') i - iTos = adjustl (string) - - end function iTos - end module ESMF_StateReconcileMod From 3ccb8d786fed7dd426899b394b61bbfcff063300 Mon Sep 17 00:00:00 2001 From: Gerhard Theurich Date: Wed, 13 Nov 2024 16:08:43 -0800 Subject: [PATCH 136/207] Clean-up debug logging. --- .../StateReconcile/src/ESMF_StateReconcile.F90 | 11 +++++------ 1 file changed, 5 insertions(+), 6 deletions(-) diff --git a/src/Superstructure/StateReconcile/src/ESMF_StateReconcile.F90 b/src/Superstructure/StateReconcile/src/ESMF_StateReconcile.F90 index d34e59bd44..c1bd932e1d 100644 --- a/src/Superstructure/StateReconcile/src/ESMF_StateReconcile.F90 +++ b/src/Superstructure/StateReconcile/src/ESMF_StateReconcile.F90 @@ -13,7 +13,7 @@ ! #define UNIQUE_GEOM_INFO_TREAT_on ! -#define RECONCILE_LOG_on +#define RECONCILE_LOG_off #define RECONCILE_ZAP_LOG_off ! ! ESMF StateReconcile module @@ -327,7 +327,7 @@ subroutine ESMF_StateReconcile(state, keywordEnforcer, vm, checkflag, rc) call idesc%Update(state, "", rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, rcToReturn=rc)) return jsonStr = "state_json_after_reassemble="//ESMF_InfoDump(idesc%info) -#if 1 +#ifdef RECONCILE_LOG_on call ESMF_LogWrite(jsonStr, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, rcToReturn=rc)) return #endif @@ -977,7 +977,8 @@ subroutine ESMF_StateReconcile_driver(state, vm, rc) ! ------------------------------------------------------------------------- if (meminfo) call ESMF_VMLogMemInfo ("after (1) Construct send arrays") -#if 0 +#ifdef UNIQUE_GEOM_INFO_TREAT_on +#ifdef RECONCILE_LOG_on block type(ESMF_InfoDescribe) :: idesc ! Log a JSON State representation ----------------------------------------- @@ -992,8 +993,6 @@ subroutine ESMF_StateReconcile_driver(state, vm, rc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, rcToReturn=rc)) return end block #endif - -#ifdef UNIQUE_GEOM_INFO_TREAT_on ! ------------------------------------------------------------------------- if (profile) then call ESMF_TraceRegionEnter("(2) Set Field metadata for unique geometries", rc=localrc) @@ -1029,7 +1028,7 @@ subroutine ESMF_StateReconcile_driver(state, vm, rc) if (meminfo) call ESMF_VMLogMemInfo ("after (2) Update Field metadata") #endif -#if 1 +#ifdef RECONCILE_LOG_on block type(ESMF_InfoDescribe) :: idesc ! Log a JSON State representation ----------------------------------------- From fa36ba89dd68a5ddc2a90e41d7fa7f0b55cd7b2b Mon Sep 17 00:00:00 2001 From: Gerhard Theurich Date: Wed, 13 Nov 2024 16:36:55 -0800 Subject: [PATCH 137/207] API doc and more consistent formatting of error handling code. --- .../src/ESMF_StateReconcile.F90 | 533 +++++++----------- 1 file changed, 215 insertions(+), 318 deletions(-) diff --git a/src/Superstructure/StateReconcile/src/ESMF_StateReconcile.F90 b/src/Superstructure/StateReconcile/src/ESMF_StateReconcile.F90 index c1bd932e1d..2755fdbfa3 100644 --- a/src/Superstructure/StateReconcile/src/ESMF_StateReconcile.F90 +++ b/src/Superstructure/StateReconcile/src/ESMF_StateReconcile.F90 @@ -150,34 +150,32 @@ subroutine ESMF_StateReconcile(state, keywordEnforcer, vm, checkflag, rc) integer, intent(out), optional :: rc ! ! !DESCRIPTION: -! Must be called for any {\tt ESMF\_State} which contains ESMF objects -! that have not been created on all the {\tt PET}s of the currently -! running {\tt ESMF\_Component}. -! For example, if a coupler is operating on data -! which was created by another component that ran on only a subset -! of the couplers {\tt PET}s, the coupler must make this call first -! before operating on any data inside that {\tt ESMF\_State}. -! After calling {\tt ESMF\_StateReconcile} all {\tt PET}s will have -! a common view of all objects contained in this {\tt ESMF\_State}. ! -! This call is collective across the specified VM. +! Must be called for any {\tt ESMF\_State} which contains ESMF objects +! that have not been created on all the {\tt PET}s of the current VM. +! For example, if a coupler component is operating on data +! which was created by another component that ran on only a subset +! of the coupler {\tt PET}s, the coupler must make this call first +! before operating with any of the objects held by the {\tt ESMF\_State}. +! After calling {\tt ESMF\_StateReconcile()} all {\tt PET}s will have +! a common view of all objects contained in this {\tt ESMF\_State}. ! -! The arguments are: -! \begin{description} -! \item[state] -! {\tt ESMF\_State} to reconcile. -! \item[{[vm]}] -! {\tt ESMF\_VM} across which to reconcile. The default is the -! current VM. -! \item [{[checkflag]}] -! If set to {\tt .TRUE.} the reconciled State object will be checked -! for consistency across PETs before returning. Any detected issues will -! be indicated in {\tt rc}. Set {\tt checkflag} to {\tt .FALSE.} in order -! to achieve highest performance. The default is {\tt .FALSE.}. -! \item[{[rc]}] -! Return code; equals {\tt ESMF\_SUCCESS} if there are no errors. -! \end{description} +! This call is collective across the specified VM. ! +! The arguments are: +! \begin{description} +! \item[state] +! {\tt ESMF\_State} to reconcile. +! \item[{[vm]}] +! {\tt ESMF\_VM} across which to reconcile. The default is the current VM. +! \item [{[checkflag]}] +! If set to {\tt .TRUE.} the reconciled State object will be checked +! for consistency across PETs before returning. Any detected issues will +! be indicated in {\tt rc}. Set {\tt checkflag} to {\tt .FALSE.} in order +! to achieve highest performance. The default is {\tt .FALSE.}. +! \item[{[rc]}] +! Return code; equals {\tt ESMF\_SUCCESS} if there are no errors. +! \end{description} !EOP integer :: localrc @@ -204,22 +202,19 @@ subroutine ESMF_StateReconcile(state, keywordEnforcer, vm, checkflag, rc) localvm = vm else call ESMF_VMGetCurrent(vm=localvm, 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 end if #ifdef RECONCILE_LOG_on block character(ESMF_MAXSTR) :: stateName call ESMF_StateGet(state, name=stateName, rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, & + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & rcToReturn=rc)) return call ESMF_LogWrite("StateReconcile() for State: "//trim(stateName), & ESMF_LOGMSG_DEBUG, rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, & + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & rcToReturn=rc)) return end block #endif @@ -245,25 +240,24 @@ subroutine ESMF_StateReconcile(state, keywordEnforcer, vm, checkflag, rc) call ESMF_VMBarrier(localvm, rc=localrc) #endif - ! Determine whether there is anything to be Reconciled at all. - ! If not then return as quickly as possible + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + ! Determine whether there is anything to be Reconciled at all. ! + ! If not then return as quickly as possible. ! + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! if (profile) then call ESMF_TraceRegionEnter("ESMF_StateReconcileIsNoop", rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, & + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & rcToReturn=rc)) return endif call ESMF_StateReconcileIsNoop(state, vm=localvm, isNoop=isNoop, 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 if (profile) then call ESMF_TraceRegionExit("ESMF_StateReconcileIsNoop", rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, & + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & rcToReturn=rc)) return endif @@ -272,8 +266,7 @@ subroutine ESMF_StateReconcile(state, keywordEnforcer, vm, checkflag, rc) character(160):: msgStr write(msgStr,*) "StateReconcile() isNoop: ", isNoop call ESMF_LogWrite(msgStr, ESMF_LOGMSG_DEBUG, rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, & + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & rcToReturn=rc)) return end block #endif @@ -281,40 +274,37 @@ subroutine ESMF_StateReconcile(state, keywordEnforcer, vm, checkflag, rc) if (isNoop) then ! successful early return because of NOOP condition if (present(rc)) rc = ESMF_SUCCESS - return + return ! NOOP -> EARLY RETURN endif - ! Each PET broadcasts the object ID lists and compares them to what - ! they get back. Missing objects are sent so they can be recreated - ! on the PETs without those objects as "proxy" objects. Eventually - ! we might want to hash the ID lists so we can send a single number - ! (or short list of numbers) instead of having to build and send the - ! list each time. + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + ! Go on to reconcile the State ! + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! if (profile) then call ESMF_TraceRegionEnter("ESMF_StateReconcile_driver", rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, & + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & rcToReturn=rc)) return endif call ESMF_StateReconcile_driver(state, vm=localvm, 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 if (profile) then call ESMF_TraceRegionExit("ESMF_StateReconcile_driver", rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, & + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & rcToReturn=rc)) return endif + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + ! Conditinally check the reconciled State for consistency across PETs ! + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + if (localCheckFlag) then if (profile) then call ESMF_TraceRegionEnter("JSON cross PET check", rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, & + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & rcToReturn=rc)) return endif block @@ -391,8 +381,7 @@ subroutine ESMF_StateReconcile(state, keywordEnforcer, vm, checkflag, rc) end block if (profile) then call ESMF_TraceRegionExit("JSON cross PET check", rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, & + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & rcToReturn=rc)) return endif endif @@ -418,17 +407,20 @@ subroutine ESMF_StateReconcileIsNoop(state, vm, isNoop, rc) ! ! !DESCRIPTION: ! -! The arguments are: -! \begin{description} -! \item[state] -! {\tt ESMF\_State} to be reconciled. -! \item[vm] -! The current {\tt ESMF\_VM} (virtual machine). -! \item[isNoop] -! Return {\tt .true.} if no reconcile is needed, {\tt .false.} otherwise. -! \item[{[rc]}] -! Return code; equals {\tt ESMF\_SUCCESS} if there are no errors. -! \end{description} +! Determine whether there is a need for reconciliation of {\tt state} across +! the PETs of {\tt vm}. +! +! The arguments are: +! \begin{description} +! \item[state] +! {\tt ESMF\_State} to be reconciled. +! \item[vm] +! The current {\tt ESMF\_VM} (virtual machine). +! \item[isNoop] +! Return {\tt .true.} if no reconcile is needed, {\tt .false.} otherwise. +! \item[{[rc]}] +! Return code; equals {\tt ESMF\_SUCCESS} if there are no errors. +! \end{description} !EOPI integer :: localrc type(ESMF_VMId) :: vmId @@ -447,8 +439,7 @@ subroutine ESMF_StateReconcileIsNoop(state, vm, isNoop, rc) if (profile) then call ESMF_TraceRegionEnter("StateReconcileIsNoopLoc", rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, & + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & rcToReturn=rc)) return endif @@ -458,8 +449,7 @@ subroutine ESMF_StateReconcileIsNoop(state, vm, isNoop, rc) if (profile) then call ESMF_TraceRegionExit("StateReconcileIsNoopLoc", rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, & + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & rcToReturn=rc)) return endif @@ -468,8 +458,7 @@ subroutine ESMF_StateReconcileIsNoop(state, vm, isNoop, rc) if (profile) then call ESMF_TraceRegionEnter("ESMF_VMAllReduce", rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, & + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & rcToReturn=rc)) return endif @@ -481,8 +470,7 @@ subroutine ESMF_StateReconcileIsNoop(state, vm, isNoop, rc) if (profile) then call ESMF_TraceRegionExit("ESMF_VMAllReduce", rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, & + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & rcToReturn=rc)) return endif @@ -521,9 +509,8 @@ recursive subroutine StateReconcileIsNoopLoc(stateR, isNoopLoc, rc) ! query call ESMF_StateGet(stateR, itemCount=itemCount, 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 if (itemCount > 0) then allocate(itemNameList(itemCount)) @@ -539,40 +526,33 @@ recursive subroutine StateReconcileIsNoopLoc(stateR, isNoopLoc, rc) if ((itemtypeList(item) == ESMF_STATEITEM_STATE)) then call ESMF_StateGet(stateR, itemName=itemNameList(item), & nestedState=nestedState, 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_StateGet(nestedState, vm=vmItem, 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 ! recursion into nested state call StateReconcileIsNoopLoc(stateR=nestedState, & isNoopLoc=isNoopLoc, 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 else if (itemtypeList(item) == ESMF_STATEITEM_FIELD) then call ESMF_StateGet(stateR, itemName=itemNameList(item), & field=field, 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_FieldGet(field, vm=vmItem, 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 else if (itemtypeList(item) == ESMF_STATEITEM_FIELDBUNDLE) then call ESMF_StateGet(stateR, itemName=itemNameList(item), & fieldbundle=fieldbundle, 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_FieldBundleGet(fieldbundle, fieldCount=fieldCount, & isPacked=isFlag, 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 if (.not.isFlag) then ! not a packed fieldbundle -> check each field item allocate(fieldList(fieldCount)) @@ -598,36 +578,30 @@ recursive subroutine StateReconcileIsNoopLoc(stateR, isNoopLoc, rc) deallocate(fieldList) endif call ESMF_FieldBundleGet(fieldbundle, vm=vmItem, 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 else if (itemtypeList(item) == ESMF_STATEITEM_ARRAY) then call ESMF_StateGet(stateR, itemName=itemNameList(item), & array=array, 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_ArrayGet(array, vm=vmItem, 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 else if (itemtypeList(item) == ESMF_STATEITEM_ARRAYBUNDLE) then call ESMF_StateGet(stateR, itemName=itemNameList(item), & arraybundle=arraybundle, 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_ArrayBundleGet(arraybundle, arrayCount=arrayCount, & 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 allocate(arrayList(arrayCount)) call ESMF_ArrayBundleGet(arraybundle, arrayList=arrayList, & 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 do i=1, arrayCount call ESMF_ArrayGet(arrayList(i), vm=vmItem, rc=localrc) if (ESMF_LogFoundError(localrc, & @@ -644,19 +618,16 @@ recursive subroutine StateReconcileIsNoopLoc(stateR, isNoopLoc, rc) enddo deallocate(arrayList) call ESMF_ArrayBundleGet(arraybundle, vm=vmItem, 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 else if (itemtypeList(item) == ESMF_STATEITEM_ROUTEHANDLE) then call ESMF_StateGet(stateR, itemName=itemNameList(item), & routehandle=routehandle, 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_RouteHandleGet(routehandle, vm=vmItem, 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 endif #if 0 @@ -718,34 +689,36 @@ subroutine ESMF_StateReconcile_driver(state, vm, rc) ! ! !DESCRIPTION: ! -! The arguments are: -! \begin{description} -! \item[state] -! {\tt ESMF\_State} to collect information from. -! \item[vm] -! The current {\tt ESMF\_VM} (virtual machine). All PETs in this -! {\tt ESMF\_VM} will exchange information about objects which might -! only be known to one or more PETs, and ensure all PETs in this VM -! have a consistent view of the object list in this {\tt ESMF\_State}. -! \item[{[attreconflag]}] -! Flag to tell if Attribute reconciliation is to be done as well as data reconciliation -! \item[{[rc]}] -! Return code; equals {\tt ESMF\_SUCCESS} if there are no errors. -! \end{description} +! Drive the actual state reconcile precedure. +! +! The arguments are: +! \begin{description} +! \item[state] +! {\tt ESMF\_State} to collect information from. +! \item[vm] +! The current {\tt ESMF\_VM} (virtual machine). All PETs in this +! {\tt ESMF\_VM} will exchange information about objects which might +! only be known to one or more PETs, and ensure all PETs in this VM +! have a consistent view of the object list in this {\tt ESMF\_State}. +! \item[{[attreconflag]}] +! Flag to tell if Attribute reconciliation is to be done as well as data reconciliation +! \item[{[rc]}] +! Return code; equals {\tt ESMF\_SUCCESS} if there are no errors. +! \end{description} !EOPI integer :: localrc integer :: memstat integer :: localPet, petCount - integer, pointer :: nitems_buf(:) - type (ESMF_StateItemWrap), pointer :: siwrap(:) + logical, parameter :: meminfo = .false. + logical, parameter :: profile = .true. - integer, pointer :: ids_send(:) - type(ESMF_VMId), pointer :: vmids_send(:) - integer, allocatable, target :: vmintids_send(:) + integer, pointer :: nitems_buf(:) + type (ESMF_StateItemWrap), pointer :: siwrap(:) - logical, parameter :: meminfo = .false. - logical, parameter :: profile = .true. + integer, pointer :: ids_send(:) + type(ESMF_VMId), pointer :: vmids_send(:) + integer, allocatable, target :: vmintids_send(:) type(ESMF_VMId), allocatable, target :: vmIdMap(:) type(ESMF_VMId), pointer :: vmIdMap_ptr(:) @@ -757,7 +730,7 @@ subroutine ESMF_StateReconcile_driver(state, vm, rc) type(ESMF_AttReconcileFlag) :: attreconflag - type(ESMF_InfoCache) :: info_cache + type(ESMF_InfoCache) :: info_cache ! ------------------------------------------------------------------------- localrc = ESMF_RC_NOT_IMPL @@ -768,9 +741,8 @@ subroutine ESMF_StateReconcile_driver(state, vm, rc) if (meminfo) call ESMF_VMLogMemInfo("entering ESMF_StateReconcile_driver") call ESMF_VMGet(vm, localPet=localPet, petCount=petCount, 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 #if 0 call ESMF_StateLog(state, rc=localrc) @@ -783,8 +755,7 @@ subroutine ESMF_StateReconcile_driver(state, vm, rc) ! ------------------------------------------------------------------------- if (profile) then call ESMF_TraceRegionEnter("(0) Interchange item counts", rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, & + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & rcToReturn=rc)) return endif ! ------------------------------------------------------------------------- @@ -792,14 +763,12 @@ subroutine ESMF_StateReconcile_driver(state, vm, rc) nitems_buf => null () call ESMF_ReconcileInitialize (state, vm, & siwrap=siwrap, nitems_all=nitems_buf, 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 ! ------------------------------------------------------------------------- if (profile) then call ESMF_TraceRegionExit("(0) Interchange item counts", rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, & + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & rcToReturn=rc)) return endif ! ------------------------------------------------------------------------- @@ -812,8 +781,7 @@ subroutine ESMF_StateReconcile_driver(state, vm, rc) ! ------------------------------------------------------------------------- if (profile) then call ESMF_TraceRegionEnter("(1) Construct send arrays", rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, & + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & rcToReturn=rc)) return endif ! ------------------------------------------------------------------------- @@ -821,21 +789,18 @@ subroutine ESMF_StateReconcile_driver(state, vm, rc) vmids_send => null () if (profile) then call ESMF_TraceRegionEnter("ESMF_ReconcileGetStateIDInfo", rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, & + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & rcToReturn=rc)) return endif call ESMF_ReconcileGetStateIDInfo (state, siwrap, & id= ids_send, & vmid=vmids_send, & 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 if (profile) then call ESMF_TraceRegionExit("ESMF_ReconcileGetStateIDInfo", rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, & + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & rcToReturn=rc)) return endif @@ -843,8 +808,7 @@ subroutine ESMF_StateReconcile_driver(state, vm, rc) ! usage. This is also beneficial for performance. if (profile) then call ESMF_TraceRegionEnter("ESMF_VMTranslateVMId", rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, & + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & rcToReturn=rc)) return endif call ESMF_VMTranslateVMId(vm, vmIds=vmids_send, ids=vmintids_send, & @@ -855,16 +819,14 @@ subroutine ESMF_StateReconcile_driver(state, vm, rc) vmIdMap_ptr => vmIdMap if (profile) then call ESMF_TraceRegionExit("ESMF_VMTranslateVMId", rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, & + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & rcToReturn=rc)) return endif ! VM integer ids should always start with 1 if (profile) then call ESMF_TraceRegionEnter("Check vmIntIds", rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, & + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & rcToReturn=rc)) return endif if (any(vmintids_send(:) <= 0)) then @@ -875,16 +837,14 @@ subroutine ESMF_StateReconcile_driver(state, vm, rc) endif if (profile) then call ESMF_TraceRegionExit("Check vmIntIds", rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, & + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & rcToReturn=rc)) return endif ! Use the translated VM ids information to make decision about the case if (profile) then call ESMF_TraceRegionEnter("Decide between cases", rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, & + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & rcToReturn=rc)) return endif ! Decide between SingleComp and MultiComp case @@ -954,24 +914,21 @@ subroutine ESMF_StateReconcile_driver(state, vm, rc) write(msgStr,*) "ESMF_StateReconcile_driver() global-singleCompCaseFlag: ", & singleCompCaseFlag call ESMF_LogWrite(msgStr, ESMF_LOGMSG_DEBUG, rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, & + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & rcToReturn=rc)) return end block #endif if (profile) then call ESMF_TraceRegionExit("Decide between cases", rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, & + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & rcToReturn=rc)) return endif ! ------------------------------------------------------------------------- if (profile) then call ESMF_TraceRegionExit("(1) Construct send arrays", rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, & + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & rcToReturn=rc)) return endif ! ------------------------------------------------------------------------- @@ -996,8 +953,7 @@ subroutine ESMF_StateReconcile_driver(state, vm, rc) ! ------------------------------------------------------------------------- if (profile) then call ESMF_TraceRegionEnter("(2) Set Field metadata for unique geometries", rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, & + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & rcToReturn=rc)) return endif ! ------------------------------------------------------------------------- @@ -1020,8 +976,7 @@ subroutine ESMF_StateReconcile_driver(state, vm, rc) ! ------------------------------------------------------------------------- if (profile) then call ESMF_TraceRegionExit("(2) Set Field metadata for unique geometries", rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, & + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & rcToReturn=rc)) return endif ! ------------------------------------------------------------------------- @@ -1105,8 +1060,7 @@ subroutine ESMF_StateReconcile_driver(state, vm, rc) ! ------------------------------------------------------------------------ if (profile) then call ESMF_TraceRegionExit("(2<) ESMF_ReconcileMultiCompCase", rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, & + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & rcToReturn=rc)) return endif ! ------------------------------------------------------------------------ @@ -1117,8 +1071,7 @@ subroutine ESMF_StateReconcile_driver(state, vm, rc) ! ------------------------------------------------------------------------- if (profile) then call ESMF_TraceRegionEnter("(X) Clean-up", rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, & + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & rcToReturn=rc)) return endif ! ------------------------------------------------------------------------- @@ -1153,8 +1106,7 @@ subroutine ESMF_StateReconcile_driver(state, vm, rc) ! ------------------------------------------------------------------------- if (profile) then call ESMF_TraceRegionExit("(X) Clean-up", rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, & + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & rcToReturn=rc)) return endif ! ------------------------------------------------------------------------- @@ -1163,22 +1115,19 @@ subroutine ESMF_StateReconcile_driver(state, vm, rc) ! ------------------------------------------------------------------------- if (profile) then call ESMF_TraceRegionEnter("(X+1) Reconcile Zapped Proxies", rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, & + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & rcToReturn=rc)) return endif ! ------------------------------------------------------------------------- call ESMF_ReconcileZappedProxies(state, 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 ! ------------------------------------------------------------------------- if (profile) then call ESMF_TraceRegionExit("(X+1) Reconcile Zapped Proxies", rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, & + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & rcToReturn=rc)) return endif ! ------------------------------------------------------------------------- @@ -1187,8 +1136,7 @@ subroutine ESMF_StateReconcile_driver(state, vm, rc) #ifdef UNIQUE_GEOM_INFO_TREAT_on if (profile) then call ESMF_TraceRegionEnter("(X+2) Use Field metadata for unique geometries", rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, & + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & rcToReturn=rc)) return endif @@ -1202,8 +1150,7 @@ subroutine ESMF_StateReconcile_driver(state, vm, rc) if (profile) then call ESMF_TraceRegionExit("(X+2) Use Field metadata for unique geometries", rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, & + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & rcToReturn=rc)) return endif ! ------------------------------------------------------------------------- @@ -1834,6 +1781,7 @@ subroutine ESMF_ReconcileDeserializeAll(state, vm, attreconflag, buffer, rc) integer, intent(out) :: rc ! ! !DESCRIPTION: +! ! Builds proxy items for each of the items in the buffer. ! ! The arguments are: @@ -2097,13 +2045,11 @@ subroutine ESMF_ReconcileBruteForce(state, vm, attreconflag, siwrap, & block character(ESMF_MAXSTR) :: stateName call ESMF_StateGet(state, name=stateName, rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, & + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & rcToReturn=rc)) return call ESMF_LogWrite("ESMF_ReconcileBruteForce() for State: "//trim(stateName), & ESMF_LOGMSG_DEBUG, rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, & + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & rcToReturn=rc)) return end block #endif @@ -2119,8 +2065,7 @@ subroutine ESMF_ReconcileBruteForce(state, vm, attreconflag, siwrap, & ! ------------------------------------------------------------------------- if (profile) then call ESMF_TraceRegionEnter("(3) Send arrays exchange", rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, & + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & rcToReturn=rc)) return endif ! ------------------------------------------------------------------------- @@ -2140,8 +2085,7 @@ subroutine ESMF_ReconcileBruteForce(state, vm, attreconflag, siwrap, & ! ------------------------------------------------------------------------- if (profile) then call ESMF_TraceRegionExit("(3) Send arrays exchange", rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, & + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & rcToReturn=rc)) return endif ! ------------------------------------------------------------------------- @@ -2158,8 +2102,7 @@ subroutine ESMF_ReconcileBruteForce(state, vm, attreconflag, siwrap, & ! ------------------------------------------------------------------------- if (profile) then call ESMF_TraceRegionEnter("(4) Construct needs list", rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, & + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & rcToReturn=rc)) return endif ! ------------------------------------------------------------------------- @@ -2174,8 +2117,7 @@ subroutine ESMF_ReconcileBruteForce(state, vm, attreconflag, siwrap, & ! ------------------------------------------------------------------------- if (profile) then call ESMF_TraceRegionExit("(4) Construct needs list", rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, & + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & rcToReturn=rc)) return endif ! ------------------------------------------------------------------------- @@ -2190,8 +2132,7 @@ subroutine ESMF_ReconcileBruteForce(state, vm, attreconflag, siwrap, & ! ------------------------------------------------------------------------- if (profile) then call ESMF_TraceRegionEnter("(5) Communicate needs back", rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, & + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & rcToReturn=rc)) return endif ! ------------------------------------------------------------------------- @@ -2206,8 +2147,7 @@ subroutine ESMF_ReconcileBruteForce(state, vm, attreconflag, siwrap, & ! ------------------------------------------------------------------------- if (profile) then call ESMF_TraceRegionExit("(5) Communicate needs back", rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, & + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & rcToReturn=rc)) return endif ! ------------------------------------------------------------------------- @@ -2218,8 +2158,7 @@ subroutine ESMF_ReconcileBruteForce(state, vm, attreconflag, siwrap, & ! ------------------------------------------------------------------------- if (profile) then call ESMF_TraceRegionEnter("(6) Serialize needed objects", rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, & + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & rcToReturn=rc)) return endif ! ------------------------------------------------------------------------- @@ -2238,8 +2177,7 @@ subroutine ESMF_ReconcileBruteForce(state, vm, attreconflag, siwrap, & ! ------------------------------------------------------------------------- if (profile) then call ESMF_TraceRegionExit("(6) Serialize needed objects", rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, & + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & rcToReturn=rc)) return endif ! ------------------------------------------------------------------------- @@ -2250,8 +2188,7 @@ subroutine ESMF_ReconcileBruteForce(state, vm, attreconflag, siwrap, & ! ------------------------------------------------------------------------- if (profile) then call ESMF_TraceRegionEnter("(7) Send/receive serialized objects", rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, & + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & rcToReturn=rc)) return endif ! ------------------------------------------------------------------------- @@ -2271,8 +2208,7 @@ subroutine ESMF_ReconcileBruteForce(state, vm, attreconflag, siwrap, & ! ------------------------------------------------------------------------- if (profile) then call ESMF_TraceRegionExit("(7) Send/receive serialized objects", rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, & + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & rcToReturn=rc)) return endif ! ------------------------------------------------------------------------- @@ -2284,8 +2220,7 @@ subroutine ESMF_ReconcileBruteForce(state, vm, attreconflag, siwrap, & ! ------------------------------------------------------------------------- if (profile) then call ESMF_TraceRegionEnter("(8) Deserialize received objects and create proxies", rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, & + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & rcToReturn=rc)) return endif ! ------------------------------------------------------------------------- @@ -2307,8 +2242,7 @@ subroutine ESMF_ReconcileBruteForce(state, vm, attreconflag, siwrap, & ! ------------------------------------------------------------------------- if (profile) then call ESMF_TraceRegionExit("(8) Deserialize received objects and create proxies", rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, & + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & rcToReturn=rc)) return endif ! ------------------------------------------------------------------------- @@ -3038,8 +2972,7 @@ subroutine ESMF_ReconcileExchgAttributes (state, vm, rc) ! Serialize the Base attributes if (profile) then call ESMF_TraceRegionEnter("Serialize the Base attributes", rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, & + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & rcToReturn=rc)) return endif do, pass = 1, 2 @@ -3078,16 +3011,14 @@ subroutine ESMF_ReconcileExchgAttributes (state, vm, rc) end do ! pass if (profile) then call ESMF_TraceRegionExit("Serialize the Base attributes", rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, & + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & rcToReturn=rc)) return endif ! Exchange serialized buffer sizes if (profile) then call ESMF_TraceRegionEnter("Exchange serialized buffer sizes", rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, & + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & rcToReturn=rc)) return endif allocate (recv_sizes(0:petCount-1), stat=memstat) @@ -3098,8 +3029,7 @@ subroutine ESMF_ReconcileExchgAttributes (state, vm, rc) if (profile) then call ESMF_TraceRegionEnter("ESMF_VMAllGather", rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, & + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & rcToReturn=rc)) return endif call ESMF_VMAllGather (vm, & @@ -3110,15 +3040,13 @@ subroutine ESMF_ReconcileExchgAttributes (state, vm, rc) rcToReturn=rc)) return if (profile) then call ESMF_TraceRegionExit("ESMF_VMAllGather", rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, & + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & rcToReturn=rc)) return endif if (profile) then call ESMF_TraceRegionExit("Exchange serialized buffer sizes", rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, & + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & rcToReturn=rc)) return endif if (debug) then @@ -3129,8 +3057,7 @@ subroutine ESMF_ReconcileExchgAttributes (state, vm, rc) ! Exchange serialized buffers if (profile) then call ESMF_TraceRegionEnter("Exchange serialized buffers", rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, & + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & rcToReturn=rc)) return endif allocate ( & @@ -3152,8 +3079,7 @@ subroutine ESMF_ReconcileExchgAttributes (state, vm, rc) if (profile) then call ESMF_TraceRegionEnter("ESMF_VMAllGatherV", rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, & + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & rcToReturn=rc)) return endif call ESMF_VMAllGatherV (vm, & @@ -3165,23 +3091,20 @@ subroutine ESMF_ReconcileExchgAttributes (state, vm, rc) rcToReturn=rc)) return if (profile) then call ESMF_TraceRegionExit("ESMF_VMAllGatherV", rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, & + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & rcToReturn=rc)) return endif if (profile) then call ESMF_TraceRegionExit("Exchange serialized buffers", rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, & + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & rcToReturn=rc)) return endif ! Update local Base if (profile) then call ESMF_TraceRegionEnter("Update local Base", rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, & + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & rcToReturn=rc)) return endif do, i=0, petCount-1 @@ -3221,8 +3144,7 @@ subroutine ESMF_ReconcileExchgAttributes (state, vm, rc) end do if (profile) then call ESMF_TraceRegionExit("Update local Base", rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, & + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & rcToReturn=rc)) return endif @@ -3634,8 +3556,7 @@ subroutine ESMF_ReconcileExchgItems (vm, id_info, recv_items, recv_buffer, rc) if (profile) then call ESMF_TraceRegionEnter("ESMF_VMAllToAll", rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, & + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & rcToReturn=rc)) return endif call ESMF_VMAllToAll (vm, & @@ -3647,8 +3568,7 @@ subroutine ESMF_ReconcileExchgItems (vm, id_info, recv_items, recv_buffer, rc) rcToReturn=rc)) return if (profile) then call ESMF_TraceRegionExit("ESMF_VMAllToAll", rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, & + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & rcToReturn=rc)) return endif if (debug) then @@ -3685,8 +3605,7 @@ subroutine ESMF_ReconcileExchgItems (vm, id_info, recv_items, recv_buffer, rc) if (profile) then call ESMF_TraceRegionEnter("ESMF_VMAllToAllV", rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, & + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & rcToReturn=rc)) return endif call ESMF_VMAllToAllV (vm, & @@ -3698,8 +3617,7 @@ subroutine ESMF_ReconcileExchgItems (vm, id_info, recv_items, recv_buffer, rc) rcToReturn=rc)) return if (profile) then call ESMF_TraceRegionExit("ESMF_VMAllToAllV", rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, & + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & rcToReturn=rc)) return endif @@ -3875,8 +3793,7 @@ subroutine ESMF_ReconcileExchgNeeds (vm, id_info, recv_needs, rc) if (profile) then call ESMF_TraceRegionEnter("ESMF_VMAllToAllV", rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, & + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & rcToReturn=rc)) return endif @@ -3890,8 +3807,7 @@ subroutine ESMF_ReconcileExchgNeeds (vm, id_info, recv_needs, rc) if (profile) then call ESMF_TraceRegionExit("ESMF_VMAllToAllV", rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, & + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & rcToReturn=rc)) return endif @@ -4157,8 +4073,7 @@ subroutine ESMF_ReconcileInitialize(state, vm, siwrap, nitems_all, rc) ! needed. if (profile) then call ESMF_TraceRegionEnter("ESMF_ReconcileZapProxies", rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, & + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & rcToReturn=rc)) return endif call ESMF_ReconcileZapProxies (state, localrc) @@ -4167,8 +4082,7 @@ subroutine ESMF_ReconcileInitialize(state, vm, siwrap, nitems_all, rc) rcToReturn=rc)) return if (profile) then call ESMF_TraceRegionExit("ESMF_ReconcileZapProxies", rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, & + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & rcToReturn=rc)) return endif @@ -4194,8 +4108,7 @@ subroutine ESMF_ReconcileInitialize(state, vm, siwrap, nitems_all, rc) if (profile) then call ESMF_TraceRegionEnter("ESMF_VMAllGather", rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, & + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & rcToReturn=rc)) return endif call ESMF_VMAllGather (vm, & @@ -4206,8 +4119,7 @@ subroutine ESMF_ReconcileInitialize(state, vm, siwrap, nitems_all, rc) rcToReturn=rc)) return if (profile) then call ESMF_TraceRegionExit("ESMF_VMAllGather", rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, & + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & rcToReturn=rc)) return endif @@ -4655,9 +4567,8 @@ subroutine ESMF_ReconcileZapProxies(state, rc) itemList => null () call ESMF_ContainerGet(container=stypep%stateContainer, itemList=itemList, & 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 stypep%zapFlag => null() @@ -4680,9 +4591,8 @@ subroutine ESMF_ReconcileZapProxies(state, rc) if (itemList(i)%si%otype==ESMF_STATEITEM_FIELD) then fieldp => itemList(i)%si%datap%fp%ftypep call ESMF_StateItemGet(itemList(i)%si, name=thisname, 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 #ifdef RECONCILE_ZAP_LOG_on write(msgString,*) "ESMF_ReconcileZapProxies Field proxyFlag(old): "//& @@ -4705,9 +4615,8 @@ subroutine ESMF_ReconcileZapProxies(state, rc) else if (itemList(i)%si%otype==ESMF_STATEITEM_FIELDBUNDLE) then fbpthis => itemList(i)%si%datap%fbp%this call ESMF_StateItemGet(itemList(i)%si, name=thisname, 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 #ifdef RECONCILE_ZAP_LOG_on write(msgString,*) "ESMF_ReconcileZapProxies FieldBundle proxyFlag(old): "//& @@ -4733,15 +4642,13 @@ subroutine ESMF_ReconcileZapProxies(state, rc) if (itemList(i)%si%proxyFlag) then stypep%zapFlag(i) = .true. ! keep record about zapping call ESMF_StateItemGet(itemList(i)%si, name=thisname, 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 ! Remove proxy object from state using its name. This is safe b/c ! a state only allows items with unique names. call ESMF_StateRemove (state, itemNameList=(/thisname/), 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 #ifdef RECONCILE_ZAP_LOG_on write(msgString,*) "ESMF_ReconcileZapProxies zapping from State: "//& trim(thisname) @@ -4822,9 +4729,8 @@ subroutine ESMF_ReconcileZappedProxies(state, rc) itemList => null () call ESMF_ContainerGet(container=stypep%stateContainer, itemList=itemList, & 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 #ifdef RECONCILE_ZAP_LOG_on call ESMF_VMLogGarbageInfo(prefix="ZappedProxies bef: ", & @@ -4842,9 +4748,8 @@ subroutine ESMF_ReconcileZappedProxies(state, rc) (itemList(i)%si%otype==ESMF_STATEITEM_FIELD .or. & itemList(i)%si%otype==ESMF_STATEITEM_FIELDBUNDLE )) then call ESMF_StateItemGet(itemList(i)%si, name=thisname, 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 #ifdef RECONCILE_ZAP_LOG_on call ESMF_LogWrite("ESMF_ReconcileZappedProxies(): found a proxy field: "//& trim(thisname), ESMF_LOGMSG_DEBUG, rc=localrc) @@ -4871,10 +4776,8 @@ subroutine ESMF_ReconcileZappedProxies(state, rc) ! therefore the implemented method suffices. if (zapList(k)%si%otype==ESMF_STATEITEM_FIELD) then call ESMF_FieldGet(zapList(k)%si%datap%fp, name=name, 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 #ifdef RECONCILE_ZAP_LOG_on call ESMF_LogWrite("ESMF_ReconcileZappedProxies(): checking for name match Field: "//trim(name), & ESMF_LOGMSG_DEBUG, rc=localrc) @@ -4898,19 +4801,15 @@ subroutine ESMF_ReconcileZappedProxies(state, rc) ! Finally destroy the old Field internals ESMF_INIT_SET_CREATED(tempField) call ESMF_FieldDestroy(tempField, noGarbage=.true., 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 ! deallocate the associated StateItem deallocate(zapList(k)%si) end if else if (zapList(k)%si%otype==ESMF_STATEITEM_FIELDBUNDLE) then call ESMF_FieldBundleGet(zapList(k)%si%datap%fbp, name=name, 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 #ifdef RECONCILE_ZAP_LOG_on call ESMF_LogWrite("ESMF_ReconcileZappedProxies(): checking for name match FieldBundle: "//trim(name), & ESMF_LOGMSG_DEBUG, rc=localrc) @@ -4935,10 +4834,8 @@ subroutine ESMF_ReconcileZappedProxies(state, rc) ESMF_INIT_SET_CREATED(tempFB) call ESMF_FieldBundleDestroy(tempFB, noGarbage=.true., & 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 ! deallocate the associated StateItem deallocate(zapList(k)%si) end if From fe1fa55038dc2939d156ef03eeb1a6a36c5da20e Mon Sep 17 00:00:00 2001 From: Gerhard Theurich Date: Wed, 13 Nov 2024 17:40:40 -0800 Subject: [PATCH 138/207] Remove special handling for SingleCompCase, calling into ESMF_ReconcileMultiCompCase() for all cases from ESMF_StateReconcile_driver() level. --- .../src/ESMF_StateReconcile.F90 | 226 ++++++------------ 1 file changed, 69 insertions(+), 157 deletions(-) diff --git a/src/Superstructure/StateReconcile/src/ESMF_StateReconcile.F90 b/src/Superstructure/StateReconcile/src/ESMF_StateReconcile.F90 index 2755fdbfa3..e410c6ee45 100644 --- a/src/Superstructure/StateReconcile/src/ESMF_StateReconcile.F90 +++ b/src/Superstructure/StateReconcile/src/ESMF_StateReconcile.F90 @@ -227,7 +227,7 @@ subroutine ESMF_StateReconcile(state, keywordEnforcer, vm, checkflag, rc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, rcToReturn=rc)) return call idesc%Update(state, "", rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, rcToReturn=rc)) return - call ESMF_LogWrite("state_json_before_reconcile="//ESMF_InfoDump(idesc%info), rc=localrc) + call ESMF_LogWrite("state_json_before_reconcile="//ESMF_InfoDump(idesc%info), ESMF_LOGMSG_DEBUG, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, rcToReturn=rc)) return call idesc%Destroy(rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, rcToReturn=rc)) return @@ -318,7 +318,7 @@ subroutine ESMF_StateReconcile(state, keywordEnforcer, vm, checkflag, rc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, rcToReturn=rc)) return jsonStr = "state_json_after_reassemble="//ESMF_InfoDump(idesc%info) #ifdef RECONCILE_LOG_on - call ESMF_LogWrite(jsonStr, rc=localrc) + call ESMF_LogWrite(jsonStr, ESMF_LOGMSG_DEBUG, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, rcToReturn=rc)) return #endif call idesc%Destroy(rc=localrc) @@ -722,11 +722,6 @@ subroutine ESMF_StateReconcile_driver(state, vm, rc) type(ESMF_VMId), allocatable, target :: vmIdMap(:) type(ESMF_VMId), pointer :: vmIdMap_ptr(:) - type(ESMF_VMId), pointer :: vmIdSingleComp - logical :: singleCompCaseFlag - integer :: singleCompCaseFlagInt(1) - integer :: singleCompCaseInt(1) - integer :: singleCompIndex type(ESMF_AttReconcileFlag) :: attreconflag @@ -761,8 +756,8 @@ subroutine ESMF_StateReconcile_driver(state, vm, rc) ! ------------------------------------------------------------------------- siwrap => null () nitems_buf => null () - call ESMF_ReconcileInitialize (state, vm, & - siwrap=siwrap, nitems_all=nitems_buf, rc=localrc) + call ESMF_ReconcileInitialize (state, vm, siwrap=siwrap, & + nitems_all=nitems_buf, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & rcToReturn=rc)) return ! ------------------------------------------------------------------------- @@ -792,9 +787,9 @@ subroutine ESMF_StateReconcile_driver(state, vm, rc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & rcToReturn=rc)) return endif - call ESMF_ReconcileGetStateIDInfo (state, siwrap, & - id= ids_send, & - vmid=vmids_send, & + call ESMF_ReconcileGetStateIDInfo (state, siwrap, & + id= ids_send, & + vmid=vmids_send, & rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & rcToReturn=rc)) return @@ -813,8 +808,7 @@ subroutine ESMF_StateReconcile_driver(state, vm, rc) endif call ESMF_VMTranslateVMId(vm, vmIds=vmids_send, ids=vmintids_send, & vmIdMap=vmIdMap, rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, & + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & rcToReturn=rc)) return vmIdMap_ptr => vmIdMap if (profile) then @@ -841,37 +835,6 @@ subroutine ESMF_StateReconcile_driver(state, vm, rc) rcToReturn=rc)) return endif - ! Use the translated VM ids information to make decision about the case - if (profile) then - call ESMF_TraceRegionEnter("Decide between cases", rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & - rcToReturn=rc)) return - endif - ! Decide between SingleComp and MultiComp case - singleCompCaseFlag = .false. - nullify(vmIdSingleComp) - if (size(vmIdMap)==1) then - singleCompCaseFlag = all(vmintids_send(1:)==1) - if (singleCompCaseFlag) then - singleCompIndex = 1 - vmIdSingleComp => vmIdMap(singleCompIndex) - endif - else if (size(vmIdMap)==2) then - singleCompCaseFlag = all(vmintids_send(1:)==1) & - .or.all(vmintids_send(1:)==2) - if (singleCompCaseFlag) then - ! singleCompIndex could be 1 or 2, however, cannot simply look this up - ! in vmintids_send(1), because on PETs that do not have objects it only - ! stores vmintids_send(0), which holds the index into vmIdMap of the - ! executing VM. Since there are only two possible values, the correct - ! singleCompIndex must be "the other one". Therefore, look at - ! vmintids_send(0), which is valid on all PETs, add 1 mod 2. But since - ! indexing into vmIdMap starts at 1 the add 1 happens _after_ the mod 2. - singleCompIndex = mod(vmintids_send(0),2)+1 - vmIdSingleComp => vmIdMap(singleCompIndex) - endif - endif - #ifdef RECONCILE_LOG_on block character(160):: msgStr @@ -890,41 +853,9 @@ subroutine ESMF_StateReconcile_driver(state, vm, rc) call ESMF_LogWrite(msgStr, ESMF_LOGMSG_DEBUG, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & rcToReturn=rc)) return - write(msgStr,*) "ESMF_StateReconcile_driver() local-singleCompCaseFlag: ", & - singleCompCaseFlag - call ESMF_LogWrite(msgStr, ESMF_LOGMSG_DEBUG, rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & - rcToReturn=rc)) return - end block -#endif - - ! ensure global consistency of the final result - singleCompCaseFlagInt(1) = 0 - if (singleCompCaseFlag) singleCompCaseFlagInt(1) = 1 - ! logical AND reduction, only 1 if all incoming 1 - call ESMF_VMAllReduce(vm, singleCompCaseFlagInt, singleCompCaseInt, 1, & - ESMF_REDUCE_MIN, rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & - rcToReturn=rc)) return - singleCompCaseFlag = (singleCompCaseInt(1)==1) ! globally consistent result - -#ifdef RECONCILE_LOG_on - block - character(160):: msgStr - write(msgStr,*) "ESMF_StateReconcile_driver() global-singleCompCaseFlag: ", & - singleCompCaseFlag - call ESMF_LogWrite(msgStr, ESMF_LOGMSG_DEBUG, rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & - rcToReturn=rc)) return end block #endif - if (profile) then - call ESMF_TraceRegionExit("Decide between cases", rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & - rcToReturn=rc)) return - endif - ! ------------------------------------------------------------------------- if (profile) then call ESMF_TraceRegionExit("(1) Construct send arrays", rc=localrc) @@ -944,7 +875,7 @@ subroutine ESMF_StateReconcile_driver(state, vm, rc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, rcToReturn=rc)) return call idesc%Update(state, "", rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, rcToReturn=rc)) return - call ESMF_LogWrite("state_json_after_vmid="//ESMF_InfoDump(idesc%info), rc=localrc) + call ESMF_LogWrite("state_json_after_vmid="//ESMF_InfoDump(idesc%info), ESMF_LOGMSG_DEBUG, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, rcToReturn=rc)) return call idesc%Destroy(rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, rcToReturn=rc)) return @@ -992,79 +923,62 @@ subroutine ESMF_StateReconcile_driver(state, vm, rc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, rcToReturn=rc)) return call idesc%Update(state, "", rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, rcToReturn=rc)) return - call ESMF_LogWrite("state_json_after_set_field_meta="//ESMF_InfoDump(idesc%info), rc=localrc) + call ESMF_LogWrite("state_json_after_set_field_meta="//ESMF_InfoDump(idesc%info), ESMF_LOGMSG_DEBUG, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, rcToReturn=rc)) return call idesc%Destroy(rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, rcToReturn=rc)) return end block #endif -!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -!TODO: Remove this once done with testing! -!singleCompCaseFlag = .false. -!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - - if (singleCompCaseFlag) then - ! CASE: a single component interacting with a state - ! ------------------------------------------------------------------------ - if (profile) then - call ESMF_TraceRegionEnter("(2<) ESMF_ReconcileSingleCompCase", rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & - rcToReturn=rc)) return - endif - ! ------------------------------------------------------------------------ -#if 0 - call ESMF_ReconcileSingleCompCase(state, vm=vm, vmId=vmIdSingleComp, & - vmIntId=singleCompIndex, & - attreconflag=attreconflag, siwrap=siwrap, vmintids_send=vmintids_send, & - rc=localrc) +#if 1 + ! ------------------------------------------------------------------------ + ! This is the new (2024) Reconcile implementation with log(petCount) scaling + ! ------------------------------------------------------------------------ + if (profile) then + call ESMF_TraceRegionEnter("(2<) ESMF_ReconcileMultiCompCase", rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & rcToReturn=rc)) return + endif + ! ------------------------------------------------------------------------ + call ESMF_ReconcileMultiCompCase(state, vm=vm, vmIdMap=vmIdMap_ptr, & + attreconflag=attreconflag, siwrap=siwrap, vmintids_send=vmintids_send, & + rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & + rcToReturn=rc)) return + ! ------------------------------------------------------------------------ + if (profile) then + call ESMF_TraceRegionExit("(2<) ESMF_ReconcileMultiCompCase", rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & + rcToReturn=rc)) return + endif + ! ------------------------------------------------------------------------ #else - call ESMF_ReconcileMultiCompCase(state, vm=vm, vmIdMap=vmIdMap_ptr, & - attreconflag=attreconflag, siwrap=siwrap, vmintids_send=vmintids_send, & - rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, rcToReturn=rc)) return -#endif - ! ------------------------------------------------------------------------ - if (profile) then - call ESMF_TraceRegionExit("(2<) ESMF_ReconcileSingleCompCase", rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & - rcToReturn=rc)) return - endif - ! ------------------------------------------------------------------------ - else - ! CASE: multiple components interacting with a state - ! ------------------------------------------------------------------------ - if (profile) then - call ESMF_TraceRegionEnter("(2<) ESMF_ReconcileMultiCompCase", rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & - rcToReturn=rc)) return - endif - ! ------------------------------------------------------------------------ -#if 1 - call ESMF_ReconcileMultiCompCase(state, vm=vm, vmIdMap=vmIdMap_ptr, & - attreconflag=attreconflag, siwrap=siwrap, vmintids_send=vmintids_send, & - rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, rcToReturn=rc)) return -#else - call ESMF_ReconcileBruteForce(state, vm=vm, & - attreconflag=attreconflag, siwrap=siwrap, ids_send=ids_send, & - vmids_send=vmids_send, vmintids_send=vmintids_send, & - nitems_buf=nitems_buf, rc=localrc) + ! ------------------------------------------------------------------------ + ! This is the old Reconcile implementation. It uses a brute force appraoch + ! using Alltoall() communication that scales with petCount^2. + ! Only left here in case we run into situations that are not covered by the + ! new Reconcile implementation. + ! ------------------------------------------------------------------------ + if (profile) then + call ESMF_TraceRegionEnter("(2<) ESMF_ReconcileBruteForce", rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & + rcToReturn=rc)) return + endif + ! ------------------------------------------------------------------------ + call ESMF_ReconcileBruteForce(state, vm=vm, & + attreconflag=attreconflag, siwrap=siwrap, ids_send=ids_send, & + vmids_send=vmids_send, vmintids_send=vmintids_send, & + nitems_buf=nitems_buf, rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & + rcToReturn=rc)) return + ! ------------------------------------------------------------------------ + if (profile) then + call ESMF_TraceRegionExit("(2<) ESMF_ReconcileBruteForce", rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & rcToReturn=rc)) return -#endif - ! ------------------------------------------------------------------------ - if (profile) then - call ESMF_TraceRegionExit("(2<) ESMF_ReconcileMultiCompCase", rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & - rcToReturn=rc)) return - endif - ! ------------------------------------------------------------------------ endif + ! ------------------------------------------------------------------------ +#endif ! Clean up @@ -1078,30 +992,27 @@ subroutine ESMF_StateReconcile_driver(state, vm, rc) if (associated (ids_send)) then deallocate (ids_send, vmids_send, stat=memstat) - if (ESMF_LogFoundDeallocError(memstat, ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, & - rcToReturn=rc)) return + if (ESMF_LogFoundDeallocError(memstat, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & + rcToReturn=rc)) return end if call ESMF_VMIdDestroy(vmIdMap, 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 deallocate (vmIdMap, stat=memstat) - if (ESMF_LogFoundDeallocError(memstat, ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, & - rcToReturn=rc)) return + if (ESMF_LogFoundDeallocError(memstat, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & + rcToReturn=rc)) return if (associated (siwrap)) then deallocate (siwrap, stat=memstat) - if (ESMF_LogFoundDeallocError(memstat, ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, & - rcToReturn=rc)) return + if (ESMF_LogFoundDeallocError(memstat, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & + rcToReturn=rc)) return end if deallocate (nitems_buf, stat=memstat) - if (ESMF_LogFoundDeallocError(memstat, ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, & - rcToReturn=rc)) return + if (ESMF_LogFoundDeallocError(memstat, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & + rcToReturn=rc)) return ! ------------------------------------------------------------------------- if (profile) then @@ -1142,11 +1053,13 @@ subroutine ESMF_StateReconcile_driver(state, vm, rc) ! Traverse the State hierarchy and fix Field references to a shared geometry call ESMF_InfoCacheReassembleFields(state, state, 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 ! Traverse the state hierarchy and remove reconcile-specific attributes call ESMF_InfoCacheReassembleFieldsFinalize(state, 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 if (profile) then call ESMF_TraceRegionExit("(X+2) Use Field metadata for unique geometries", rc=localrc) @@ -1676,9 +1589,8 @@ subroutine ESMF_ReconcileSerializeAll(state, itemList, itemCount, & !!!!! Allocate buffer to serialize into !!!!! allocate(buffer(0:sizeBuffer-1), stat=memstat) - if (ESMF_LogFoundAllocError(memstat, ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, & - rcToReturn=rc)) return + if (ESMF_LogFoundAllocError(memstat, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & + rcToReturn=rc)) return !!!!! Serialize information into buffer !!!!! From 802b83db819057135a27208349e9c94aeac9f212 Mon Sep 17 00:00:00 2001 From: Gerhard Theurich Date: Wed, 13 Nov 2024 17:46:43 -0800 Subject: [PATCH 139/207] Add profiling around call into ESMF_ReconcileSingleCompCase(). --- .../StateReconcile/src/ESMF_StateReconcile.F90 | 12 ++++++++++++ 1 file changed, 12 insertions(+) diff --git a/src/Superstructure/StateReconcile/src/ESMF_StateReconcile.F90 b/src/Superstructure/StateReconcile/src/ESMF_StateReconcile.F90 index e410c6ee45..c460f924ab 100644 --- a/src/Superstructure/StateReconcile/src/ESMF_StateReconcile.F90 +++ b/src/Superstructure/StateReconcile/src/ESMF_StateReconcile.F90 @@ -1124,6 +1124,8 @@ subroutine ESMF_ReconcileMultiCompCase(state, vm, vmIdMap, attreconflag, & type(ESMF_VMId) :: vmId type(ESMF_VMId), pointer :: vmIdSingleComp + logical, parameter :: profile = .true. + rc = ESMF_SUCCESS #ifdef RECONCILE_LOG_on @@ -1175,11 +1177,21 @@ subroutine ESMF_ReconcileMultiCompCase(state, vm, vmIdMap, attreconflag, & ! objects with vmIdMap(i) are not defined on all PETs of the ! reconciling context -> need to reconcile vmIdSingleComp => vmIdMap(i) + if (profile) then + call ESMF_TraceRegionEnter("ESMF_ReconcileSingleCompCase", rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & + rcToReturn=rc)) return + endif call ESMF_ReconcileSingleCompCase(state, vm=vm, vmId=vmIdSingleComp, & vmIntId=i, attreconflag=attreconflag, siwrap=siwrap, & vmintids_send=vmintids_send, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & rcToReturn=rc)) return + if (profile) then + call ESMF_TraceRegionExit("ESMF_ReconcileSingleCompCase", rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & + rcToReturn=rc)) return + endif endif enddo From 7cb2e8c1778764062d54329da3c99befda7f560d Mon Sep 17 00:00:00 2001 From: Gerhard Theurich Date: Thu, 14 Nov 2024 09:01:17 -0800 Subject: [PATCH 140/207] Small API doc change, and disable forcing of checkflag. --- .../StateReconcile/src/ESMF_StateReconcile.F90 | 14 ++++++++------ 1 file changed, 8 insertions(+), 6 deletions(-) diff --git a/src/Superstructure/StateReconcile/src/ESMF_StateReconcile.F90 b/src/Superstructure/StateReconcile/src/ESMF_StateReconcile.F90 index c460f924ab..715965abbf 100644 --- a/src/Superstructure/StateReconcile/src/ESMF_StateReconcile.F90 +++ b/src/Superstructure/StateReconcile/src/ESMF_StateReconcile.F90 @@ -137,7 +137,7 @@ module ESMF_StateReconcileMod #undef ESMF_METHOD #define ESMF_METHOD "ESMF_StateReconcile" !BOP -! !IROUTINE: ESMF_StateReconcile -- Reconcile State data across all PETs in a VM +! !IROUTINE: ESMF_StateReconcile -- Reconcile State across PETs ! ! !INTERFACE: subroutine ESMF_StateReconcile(state, keywordEnforcer, vm, checkflag, rc) @@ -169,9 +169,9 @@ subroutine ESMF_StateReconcile(state, keywordEnforcer, vm, checkflag, rc) ! \item[{[vm]}] ! {\tt ESMF\_VM} across which to reconcile. The default is the current VM. ! \item [{[checkflag]}] -! If set to {\tt .TRUE.} the reconciled State object will be checked -! for consistency across PETs before returning. Any detected issues will -! be indicated in {\tt rc}. Set {\tt checkflag} to {\tt .FALSE.} in order +! If set to {\tt .TRUE.} the reconciled State object is checked for +! consistency across PETs before returning. Any detected issues are +! indicated in {\tt rc}. Set {\tt checkflag} to {\tt .FALSE.} in order ! to achieve highest performance. The default is {\tt .FALSE.}. ! \item[{[rc]}] ! Return code; equals {\tt ESMF\_SUCCESS} if there are no errors. @@ -195,8 +195,10 @@ subroutine ESMF_StateReconcile(state, keywordEnforcer, vm, checkflag, rc) localCheckFlag = .false. ! default if (present(checkFlag)) localCheckFlag = checkFlag -!TODO: turn this .true. when working on StateReoncile, so all tests validate! -localCheckFlag = .true. ! force checking +#if 0 + ! Activate this when working on StateReoncile, so all tests validate! + localCheckFlag = .true. ! force checking +#endif if (present (vm)) then localvm = vm From 1568681b7bdc1d6b3b2e23f514d85bd6824a50bb Mon Sep 17 00:00:00 2001 From: Gerhard Theurich Date: Thu, 14 Nov 2024 13:29:51 -0500 Subject: [PATCH 141/207] Leverage workaround supplied by https://github.com/mathomp4 for CMake/NAG/OpenMP bug https://gitlab.kitware.com/cmake/cmake/-/issues/21280. --- src/addon/ESMX/Driver/CMakeLists.txt | 9 +++++++++ 1 file changed, 9 insertions(+) diff --git a/src/addon/ESMX/Driver/CMakeLists.txt b/src/addon/ESMX/Driver/CMakeLists.txt index ab75e98d17..cc362a34b9 100644 --- a/src/addon/ESMX/Driver/CMakeLists.txt +++ b/src/addon/ESMX/Driver/CMakeLists.txt @@ -160,6 +160,15 @@ foreach(ESMX_LINK_LIBRARY IN ITEMS ${ESMX_LINK_LIBRARIES}) endif() endforeach() +# CMake has a bug with NAG and OpenMP: +# https://gitlab.kitware.com/cmake/cmake/-/issues/21280 +# so we work around it ... credit to https://github.com/mathomp4 +if (OpenMP_Fortran_FOUND AND CMAKE_Fortran_COMPILER_ID STREQUAL "NAG") + message(WARNING "NAG Fortran detected, resetting OpenMP flags to avoid CMake bug") + set_property(TARGET OpenMP::OpenMP_Fortran PROPERTY INTERFACE_LINK_LIBRARIES "") + set_property(TARGET OpenMP::OpenMP_Fortran PROPERTY INTERFACE_LINK_OPTIONS "-openmp") +endif() + # link options if(DEFINED ESMX_LINK_OPTIONS) target_link_options(esmx_driver PUBLIC ${ESMX_LINK_OPTIONS}) From 66a38773fdd1132b1f91e35990f60216ec09390e Mon Sep 17 00:00:00 2001 From: Gerhard Theurich Date: Thu, 14 Nov 2024 14:55:36 -0500 Subject: [PATCH 142/207] Slightly adjust performance threshold up by 500ms for BOPT=O mode in order to pass on NAG. --- src/Infrastructure/Array/tests/ESMF_ArrayRedistPerfUTest.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Infrastructure/Array/tests/ESMF_ArrayRedistPerfUTest.F90 b/src/Infrastructure/Array/tests/ESMF_ArrayRedistPerfUTest.F90 index 65f12b52f9..ed4bb08f4e 100644 --- a/src/Infrastructure/Array/tests/ESMF_ArrayRedistPerfUTest.F90 +++ b/src/Infrastructure/Array/tests/ESMF_ArrayRedistPerfUTest.F90 @@ -241,7 +241,7 @@ program ESMF_ArrayRedistPerfUTest #ifdef ESMF_BOPT_g dtTest = 20.d0 ! 20s is expected to pass in debug mode #else - dtTest = 2.d0 ! 2s is expected to pass in optimized mode + dtTest = 2.5d0 ! 2.5s is expected to pass in optimized mode #endif write(failMsg, *) "ArrayRedistStore() performance problem! ", dt, ">", dtTest #ifdef ESMF_TESTPERFORMANCE From 669e46a863f6c6667249e5e2f7e0d83325eb422a Mon Sep 17 00:00:00 2001 From: Gerhard Theurich Date: Thu, 14 Nov 2024 16:32:48 -0500 Subject: [PATCH 143/207] Collect 3rd party LIBS information in dedicated variables so they can be placed ahead of the standard C++ and Fortran link libraries during linking. --- build/common.mk | 56 ++++++++++++++++++++++++------------------------- 1 file changed, 28 insertions(+), 28 deletions(-) diff --git a/build/common.mk b/build/common.mk index d8d5c8c502..2366cb7d9a 100644 --- a/build/common.mk +++ b/build/common.mk @@ -1014,7 +1014,7 @@ endif ifeq ($(origin ESMF_F90LINKLIBS_ENV), environment) ESMF_F90LINKLIBS = $(ESMF_F90LINKLIBS_ENV) endif -ESMF_F90LINKLIBS += +ESMF_F90LINKLIBS += $(ESMF_F90LINKLIBSTHIRD) ESMF_F90ESMFLINKLIBS += -lesmf $(ESMF_F90LINKLIBS) ESMF_F90ESMFPRELOADLINKLIBS += -lesmf $(ESMF_TRACE_DYNAMICLINKLIBS) $(ESMF_F90LINKLIBS) @@ -1068,7 +1068,7 @@ endif ifeq ($(origin ESMF_CXXLINKLIBS_ENV), environment) ESMF_CXXLINKLIBS = $(ESMF_CXXLINKLIBS_ENV) endif -ESMF_CXXLINKLIBS += +ESMF_CXXLINKLIBS += $(ESMF_CXXLINKLIBSTHIRD) ESMF_CXXESMFLINKLIBS += -lesmf $(ESMF_CXXLINKLIBS) # - CLINKER @@ -1331,9 +1331,9 @@ ESMF_CXXCOMPILEPATHSTHIRD += -I$(ESMF_MOAB_INCLUDE) ESMF_F90COMPILEPATHSTHIRD += -I$(ESMF_MOAB_INCLUDE) endif ifdef ESMF_MOAB_LIBS -ESMF_CXXLINKLIBS += $(ESMF_MOAB_LIBS) +ESMF_CXXLINKLIBSTHIRD += $(ESMF_MOAB_LIBS) ESMF_CXXLINKRPATHSTHIRD += $(addprefix $(ESMF_CXXRPATHPREFIX),$(subst -L,,$(filter -L%,$(ESMF_MOAB_LIBS)))) -ESMF_F90LINKLIBS += $(ESMF_MOAB_LIBS) +ESMF_F90LINKLIBSTHIRD += $(ESMF_MOAB_LIBS) ESMF_F90LINKRPATHSTHIRD += $(addprefix $(ESMF_F90RPATHPREFIX),$(subst -L,,$(filter -L%,$(ESMF_MOAB_LIBS)))) endif ifdef ESMF_MOAB_LIBPATH @@ -1400,9 +1400,9 @@ ifdef ESMF_LAPACK_INTERNAL ESMF_CPPFLAGS += -DESMF_LAPACK_INTERNAL=1 endif ifdef ESMF_LAPACK_LIBS -ESMF_CXXLINKLIBS += $(ESMF_LAPACK_LIBS) +ESMF_CXXLINKLIBSTHIRD += $(ESMF_LAPACK_LIBS) ESMF_CXXLINKRPATHSTHIRD += $(addprefix $(ESMF_CXXRPATHPREFIX),$(subst -L,,$(filter -L%,$(ESMF_LAPACK_LIBS)))) -ESMF_F90LINKLIBS += $(ESMF_LAPACK_LIBS) +ESMF_F90LINKLIBSTHIRD += $(ESMF_LAPACK_LIBS) ESMF_F90LINKRPATHSTHIRD += $(addprefix $(ESMF_F90RPATHPREFIX),$(subst -L,,$(filter -L%,$(ESMF_LAPACK_LIBS)))) endif ifdef ESMF_LAPACK_LIBPATH @@ -1446,9 +1446,9 @@ ESMF_CXXCOMPILEPATHSTHIRD += -I$(ESMF_ACC_SOFTWARE_STACK_INCLUDE) ESMF_F90COMPILEPATHSTHIRD += -I$(ESMF_ACC_SOFTWARE_STACK_INCLUDE) endif ifdef ESMF_ACC_SOFTWARE_STACK_LIBS -ESMF_CXXLINKLIBS += $(ESMF_ACC_SOFTWARE_STACK_LIBS) +ESMF_CXXLINKLIBSTHIRD += $(ESMF_ACC_SOFTWARE_STACK_LIBS) ESMF_CXXLINKRPATHSTHIRD += $(addprefix $(ESMF_CXXRPATHPREFIX),$(subst -L,,$(filter -L%,$(ESMF_ACC_SOFTWARE_STACK_LIBS)))) -ESMF_F90LINKLIBS += $(ESMF_ACC_SOFTWARE_STACK_LIBS) +ESMF_F90LINKLIBSTHIRD += $(ESMF_ACC_SOFTWARE_STACK_LIBS) ESMF_F90LINKRPATHSTHIRD += $(addprefix $(ESMF_F90RPATHPREFIX),$(subst -L,,$(filter -L%,$(ESMF_ACC_SOFTWARE_STACK_LIBS)))) endif ifdef ESMF_ACC_SOFTWARE_STACK_LIBPATH @@ -1580,12 +1580,12 @@ ifdef ESMF_NETCDF ESMF_F90COMPILEPATHSTHIRD += -I$(ESMF_NETCDFF_INCLUDE) endif ifdef ESMF_NETCDF_LIBS - ESMF_CXXLINKLIBS += $(ESMF_NETCDF_LIBS) - ESMF_F90LINKLIBS += $(ESMF_NETCDF_LIBS) + ESMF_CXXLINKLIBSTHIRD += $(ESMF_NETCDF_LIBS) + ESMF_F90LINKLIBSTHIRD += $(ESMF_NETCDF_LIBS) endif ifdef ESMF_NETCDFF_LIBS - ESMF_CXXLINKLIBS += $(ESMF_NETCDFF_LIBS) - ESMF_F90LINKLIBS += $(ESMF_NETCDFF_LIBS) + ESMF_CXXLINKLIBSTHIRD += $(ESMF_NETCDFF_LIBS) + ESMF_F90LINKLIBSTHIRD += $(ESMF_NETCDFF_LIBS) endif ifdef ESMF_NETCDF_LIBPATH ESMF_CXXLINKPATHSTHIRD += $(addprefix -L,$(ESMF_NETCDF_LIBPATH)) @@ -1623,9 +1623,9 @@ ESMF_CXXCOMPILEPATHSTHIRD += -I$(ESMF_PNETCDF_INCLUDE) ESMF_F90COMPILEPATHSTHIRD += -I$(ESMF_PNETCDF_INCLUDE) endif ifdef ESMF_PNETCDF_LIBS -ESMF_CXXLINKLIBS += $(ESMF_PNETCDF_LIBS) +ESMF_CXXLINKLIBSTHIRD += $(ESMF_PNETCDF_LIBS) ESMF_CXXLINKRPATHSTHIRD += $(addprefix $(ESMF_CXXRPATHPREFIX),$(subst -L,,$(filter -L%,$(ESMF_PNETCDF_LIBS)))) -ESMF_F90LINKLIBS += $(ESMF_PNETCDF_LIBS) +ESMF_F90LINKLIBSTHIRD += $(ESMF_PNETCDF_LIBS) ESMF_F90LINKRPATHSTHIRD += $(addprefix $(ESMF_F90RPATHPREFIX),$(subst -L,,$(filter -L%,$(ESMF_PNETCDF_LIBS)))) endif ifdef ESMF_PNETCDF_LIBPATH @@ -1652,9 +1652,9 @@ ESMF_CXXCOMPILEPATHSTHIRD += -I$(ESMF_XERCES_INCLUDE) ESMF_F90COMPILEPATHSTHIRD += -I$(ESMF_XERCES_INCLUDE) endif ifdef ESMF_XERCES_LIBS -ESMF_CXXLINKLIBS += $(ESMF_XERCES_LIBS) +ESMF_CXXLINKLIBSTHIRD += $(ESMF_XERCES_LIBS) ESMF_CXXLINKRPATHSTHIRD += $(addprefix $(ESMF_CXXRPATHPREFIX),$(subst -L,,$(filter -L%,$(ESMF_XERCES_LIBS)))) -ESMF_F90LINKLIBS += $(ESMF_XERCES_LIBS) +ESMF_F90LINKLIBSTHIRD += $(ESMF_XERCES_LIBS) ESMF_F90LINKRPATHSTHIRD += $(addprefix $(ESMF_F90RPATHPREFIX),$(subst -L,,$(filter -L%,$(ESMF_XERCES_LIBS)))) endif ifdef ESMF_XERCES_LIBPATH @@ -1690,9 +1690,9 @@ ESMF_CXXCOMPILEPATHSTHIRD += -I$(ESMF_YAMLCPP_INCLUDE) ESMF_F90COMPILEPATHSTHIRD += -I$(ESMF_YAMLCPP_INCLUDE) endif ifdef ESMF_YAMLCPP_LIBS -ESMF_CXXLINKLIBS += $(ESMF_YAMLCPP_LIBS) +ESMF_CXXLINKLIBSTHIRD += $(ESMF_YAMLCPP_LIBS) ESMF_CXXLINKRPATHSTHIRD += $(addprefix $(ESMF_CXXRPATHPREFIX),$(subst -L,,$(filter -L%,$(ESMF_YAMLCPP_LIBS)))) -ESMF_F90LINKLIBS += $(ESMF_YAMLCPP_LIBS) +ESMF_F90LINKLIBSTHIRD += $(ESMF_YAMLCPP_LIBS) ESMF_F90LINKRPATHSTHIRD += $(addprefix $(ESMF_F90RPATHPREFIX),$(subst -L,,$(filter -L%,$(ESMF_YAMLCPP_LIBS)))) endif ifdef ESMF_YAMLCPP_LIBPATH @@ -1737,9 +1737,9 @@ ESMF_CXXCOMPILEPATHSTHIRD += -I$(ESMF_PIO_INCLUDE) ESMF_F90COMPILEPATHSTHIRD += -I$(ESMF_PIO_INCLUDE) endif ifdef ESMF_PIO_LIBS -ESMF_CXXLINKLIBS += $(ESMF_PIO_LIBS) +ESMF_CXXLINKLIBSTHIRD += $(ESMF_PIO_LIBS) ESMF_CXXLINKRPATHSTHIRD += $(addprefix $(ESMF_CXXRPATHPREFIX),$(subst -L,,$(filter -L%,$(ESMF_PIO_LIBS)))) -ESMF_F90LINKLIBS += $(ESMF_PIO_LIBS) +ESMF_F90LINKLIBSTHIRD += $(ESMF_PIO_LIBS) ESMF_F90LINKRPATHSTHIRD += $(addprefix $(ESMF_F90RPATHPREFIX),$(subst -L,,$(filter -L%,$(ESMF_PIO_LIBS)))) endif ifdef ESMF_PIO_LIBPATH @@ -1776,9 +1776,9 @@ ESMF_CXXCOMPILEPATHSTHIRD += -I$(ESMF_PROJ4_INCLUDE) ESMF_F90COMPILEPATHSTHIRD += -I$(ESMF_PROJ4_INCLUDE) endif ifdef ESMF_PROJ4_LIBS -ESMF_CXXLINKLIBS += $(ESMF_PROJ4_LIBS) +ESMF_CXXLINKLIBSTHIRD += $(ESMF_PROJ4_LIBS) ESMF_CXXLINKRPATHSTHIRD += $(addprefix $(ESMF_CXXRPATHPREFIX),$(subst -L,,$(filter -L%,$(ESMF_PROJ4_LIBS)))) -ESMF_F90LINKLIBS += $(ESMF_PROJ4_LIBS) +ESMF_F90LINKLIBSTHIRD += $(ESMF_PROJ4_LIBS) ESMF_F90LINKRPATHSTHIRD += $(addprefix $(ESMF_F90RPATHPREFIX),$(subst -L,,$(filter -L%,$(ESMF_PROJ4_LIBS)))) endif ifdef ESMF_PROJ4_LIBPATH @@ -1805,9 +1805,9 @@ ESMF_CXXCOMPILEPATHSTHIRD += -I$(ESMF_BABELTRACE_INCLUDE) ESMF_F90COMPILEPATHSTHIRD += -I$(ESMF_BABELTRACE_INCLUDE) endif ifdef ESMF_BABELTRACE_LIBS -ESMF_CXXLINKLIBS += $(ESMF_BABELTRACE_LIBS) +ESMF_CXXLINKLIBSTHIRD += $(ESMF_BABELTRACE_LIBS) ESMF_CXXLINKRPATHSTHIRD += $(addprefix $(ESMF_CXXRPATHPREFIX),$(subst -L,,$(filter -L%,$(ESMF_BABELTRACE_LIBS)))) -ESMF_F90LINKLIBS += $(ESMF_BABELTRACE_LIBS) +ESMF_F90LINKLIBSTHIRD += $(ESMF_BABELTRACE_LIBS) ESMF_F90LINKRPATHSTHIRD += $(addprefix $(ESMF_F90RPATHPREFIX),$(subst -L,,$(filter -L%,$(ESMF_BABELTRACE_LIBS)))) endif ifdef ESMF_BABELTRACE_LIBPATH @@ -1841,9 +1841,9 @@ ESMF_CXXCOMPILEPATHSTHIRD += -I$(ESMF_NUMA_INCLUDE) ESMF_F90COMPILEPATHSTHIRD += -I$(ESMF_NUMA_INCLUDE) endif ifdef ESMF_NUMA_LIBS -ESMF_CXXLINKLIBS += $(ESMF_NUMA_LIBS) +ESMF_CXXLINKLIBSTHIRD += $(ESMF_NUMA_LIBS) ESMF_CXXLINKRPATHSTHIRD += $(addprefix $(ESMF_CXXRPATHPREFIX),$(subst -L,,$(filter -L%,$(ESMF_NUMA_LIBS)))) -ESMF_F90LINKLIBS += $(ESMF_NUMA_LIBS) +ESMF_F90LINKLIBSTHIRD += $(ESMF_NUMA_LIBS) ESMF_F90LINKRPATHSTHIRD += $(addprefix $(ESMF_F90RPATHPREFIX),$(subst -L,,$(filter -L%,$(ESMF_NUMA_LIBS)))) endif ifdef ESMF_NUMA_LIBPATH @@ -1877,9 +1877,9 @@ ESMF_CXXCOMPILEPATHSTHIRD += -I$(ESMF_NVML_INCLUDE) ESMF_F90COMPILEPATHSTHIRD += -I$(ESMF_NVML_INCLUDE) endif ifdef ESMF_NVML_LIBS -ESMF_CXXLINKLIBS += $(ESMF_NVML_LIBS) +ESMF_CXXLINKLIBSTHIRD += $(ESMF_NVML_LIBS) ESMF_CXXLINKRPATHSTHIRD += $(addprefix $(ESMF_CXXRPATHPREFIX),$(subst -L,,$(filter -L%,$(ESMF_NVML_LIBS)))) -ESMF_F90LINKLIBS += $(ESMF_NVML_LIBS) +ESMF_F90LINKLIBSTHIRD += $(ESMF_NVML_LIBS) ESMF_F90LINKRPATHSTHIRD += $(addprefix $(ESMF_F90RPATHPREFIX),$(subst -L,,$(filter -L%,$(ESMF_NVML_LIBS)))) endif ifdef ESMF_NVML_LIBPATH From b6be293c581f13468e8075bdef8bb3d13e864f13 Mon Sep 17 00:00:00 2001 From: Gerhard Theurich Date: Fri, 15 Nov 2024 13:36:43 -0800 Subject: [PATCH 144/207] Disable profiling of StateReconcile() internals before merging into develop. --- .../StateReconcile/src/ESMF_StateReconcile.F90 | 18 +++++++++--------- 1 file changed, 9 insertions(+), 9 deletions(-) diff --git a/src/Superstructure/StateReconcile/src/ESMF_StateReconcile.F90 b/src/Superstructure/StateReconcile/src/ESMF_StateReconcile.F90 index 715965abbf..0db8c80fb0 100644 --- a/src/Superstructure/StateReconcile/src/ESMF_StateReconcile.F90 +++ b/src/Superstructure/StateReconcile/src/ESMF_StateReconcile.F90 @@ -182,7 +182,7 @@ subroutine ESMF_StateReconcile(state, keywordEnforcer, vm, checkflag, rc) type(ESMF_VM) :: localvm logical :: isNoop, isFlag, localCheckFlag - logical, parameter :: profile = .true. + logical, parameter :: profile = .false. ! check input variables ESMF_INIT_CHECK_DEEP(ESMF_StateGetInit,state,rc) @@ -429,7 +429,7 @@ subroutine ESMF_StateReconcileIsNoop(state, vm, isNoop, rc) logical :: isNoopLoc integer :: isNoopLocInt(1), isNoopInt(1) - logical, parameter :: profile = .true. + logical, parameter :: profile = .false. localrc = ESMF_RC_NOT_IMPL @@ -713,7 +713,7 @@ subroutine ESMF_StateReconcile_driver(state, vm, rc) integer :: localPet, petCount logical, parameter :: meminfo = .false. - logical, parameter :: profile = .true. + logical, parameter :: profile = .false. integer, pointer :: nitems_buf(:) type (ESMF_StateItemWrap), pointer :: siwrap(:) @@ -1126,7 +1126,7 @@ subroutine ESMF_ReconcileMultiCompCase(state, vm, vmIdMap, attreconflag, & type(ESMF_VMId) :: vmId type(ESMF_VMId), pointer :: vmIdSingleComp - logical, parameter :: profile = .true. + logical, parameter :: profile = .false. rc = ESMF_SUCCESS @@ -1963,7 +1963,7 @@ subroutine ESMF_ReconcileBruteForce(state, vm, attreconflag, siwrap, & character, pointer :: buffer_recv(:) logical, parameter :: meminfo = .false. - logical, parameter :: profile = .true. + logical, parameter :: profile = .false. rc = ESMF_SUCCESS @@ -2884,7 +2884,7 @@ subroutine ESMF_ReconcileExchgAttributes (state, vm, rc) type(ESMF_Info) :: base_info, base_temp_info logical, parameter :: debug = .false. - logical, parameter :: profile = .true. + logical, parameter :: profile = .false. rc = ESMF_RC_NOT_IMPL @@ -3402,7 +3402,7 @@ subroutine ESMF_ReconcileExchgItems (vm, id_info, recv_items, recv_buffer, rc) logical, parameter :: debug = .false. logical, parameter :: meminfo = .false. - logical, parameter :: profile = .true. + logical, parameter :: profile = .false. character(len=ESMF_MAXSTR) :: logmsg @@ -3642,7 +3642,7 @@ subroutine ESMF_ReconcileExchgNeeds (vm, id_info, recv_needs, rc) character(ESMF_MAXSTR) :: msgstring logical, parameter :: debug = .false. - logical, parameter :: profile = .true. + logical, parameter :: profile = .false. localrc = ESMF_RC_NOT_IMPL @@ -3974,7 +3974,7 @@ subroutine ESMF_ReconcileInitialize(state, vm, siwrap, nitems_all, rc) integer :: nitems_local(1) integer :: localPet, petCount - logical, parameter :: profile = .true. + logical, parameter :: profile = .false. localrc = ESMF_RC_NOT_IMPL From 257add1504447b9acf63020c7f34a20d21c1c20f Mon Sep 17 00:00:00 2001 From: Robert Oehmke Date: Tue, 19 Nov 2024 16:37:46 -0700 Subject: [PATCH 145/207] Add new ESMF_FieldEmptyReset() method and unit test. --- src/Infrastructure/Field/src/ESMF_Field.F90 | 214 +++++++++++++++++- .../Field/src/ESMF_FieldCreate.cppF90 | 98 ++------ .../Field/src/ESMF_FieldEmpty.cppF90 | 111 +++++++-- .../Field/tests/ESMF_FieldCreateGetUTest.F90 | 121 ++++++++++ 4 files changed, 444 insertions(+), 100 deletions(-) diff --git a/src/Infrastructure/Field/src/ESMF_Field.F90 b/src/Infrastructure/Field/src/ESMF_Field.F90 index 60ce5f98a2..e3500b217a 100644 --- a/src/Infrastructure/Field/src/ESMF_Field.F90 +++ b/src/Infrastructure/Field/src/ESMF_Field.F90 @@ -51,6 +51,10 @@ module ESMF_FieldMod use ESMF_StaggerLocMod use ESMF_DistGridMod use ESMF_GridMod + use ESMF_XGridMod + use ESMF_XGridCreateMod + use ESMF_MeshMod + use ESMF_LocStreamMod use ESMF_GeomMod use ESMF_ArrayMod use ESMF_ArrayCreateMod @@ -148,7 +152,8 @@ module ESMF_FieldMod public ESMF_FieldSerialize public ESMF_FieldDeserialize public ESMF_FieldInitialize ! Default initiailze field member variables - + public ESMF_FieldDestructArray + public ESMF_FieldDestructGeom !------------------------------------------------------------------------------ ! The following line turns the CVS identifier string into a printable variable. @@ -438,6 +443,213 @@ end subroutine ESMF_FieldValidate !------------------------------------------------------------------------------ +!------------------------------------------------------------------------------ +#undef ESMF_METHOD +#define ESMF_METHOD "ESMF_FieldDestruct" +!BOPI +! !IROUTINE: ESMF_FieldDestructArray - Release Field Array memory +! +! !INTERFACE: + subroutine ESMF_FieldDestructArray(ftype, noGarbage, rc) +! +! !ARGUMENTS: + type(ESMF_FieldType), pointer :: ftype + logical, intent(in), optional :: noGarbage + integer, intent(out), optional :: rc +! +! !DESCRIPTION: +! Releases Field Array memory. +! +! The arguments are: +! \begin{description} +! \item[ftype] +! Pointer to an {\tt ESMF\_Field} object. +! \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} +!EOPI +!------------------------------------------------------------------------------ + integer :: localrc ! local return code + type(ESMF_Status) :: basestatus + + ! Initialize + localrc = ESMF_RC_NOT_IMPL + if (present(rc)) rc = ESMF_RC_NOT_IMPL + + ! Only get rid of Array if complete + if(ftype%status .eq. ESMF_FIELDSTATUS_COMPLETE) then + if(ftype%is_proxy .or. ftype%array_internal) then + call ESMF_ArrayDestroy(ftype%array, noGarbage=noGarbage, rc=localrc) + if (ESMF_LogFoundError(localrc, & + ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, rcToReturn=rc)) return + endif + endif + + ! Return success + if (present(rc)) rc = ESMF_SUCCESS + + end subroutine ESMF_FieldDestructArray +!------------------------------------------------------------------------------ + + +!------------------------------------------------------------------------------ +#undef ESMF_METHOD +#define ESMF_METHOD "ESMF_FieldDestructGeom" +!BOPI +! !IROUTINE: ESMF_FieldDestructGeom - Clear out a Fields Geometry +! +! !INTERFACE: + subroutine ESMF_FieldDestructGeom(ftype, noGarbage, rc) +! +! !ARGUMENTS: + type(ESMF_FieldType), pointer :: ftype + logical, intent(in), optional :: noGarbage + integer, intent(out), optional :: rc +! +! !DESCRIPTION: +! Releases all geometry resources. +! +! The arguments are: +! \begin{description} +! \item[ftype] +! Pointer to an {\tt ESMF\_Field} object. +! \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} +!EOPI +!------------------------------------------------------------------------------ + integer :: localrc ! local return code + type(ESMF_GeomType_Flag):: geomtype + type(ESMF_Grid) :: grid + type(ESMF_Mesh) :: mesh + type(ESMF_LocStream) :: locstream + type(ESMF_Xgrid) :: xgrid + + ! Initialize + localrc = ESMF_RC_NOT_IMPL + if (present(rc)) rc = ESMF_RC_NOT_IMPL + + ! Field only has Geom if complete or gridset + if ((ftype%status .eq. ESMF_FIELDSTATUS_GRIDSET) .or. & + (ftype%status .eq. ESMF_FIELDSTATUS_COMPLETE)) then + + ! If proxy or internal get rid of stuff + if (ftype%is_proxy .or. ftype%geomb_internal) then + + if (ftype%is_proxy) then + ! proxies destroy their actual geometry object, but must leave + ! in garbage collection because multiple fields might be referencing + ! the same actual geometry object, and try to destroy + + call ESMF_GeomGet(ftype%geom, geomtype=geomtype, rc=localrc) + if (ESMF_LogFoundError(localrc, & + ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, rcToReturn=rc)) return + + ! call into the GEOMTYPE specific Destroy() method + if (geomtype .eq. ESMF_GEOMTYPE_GRID) then + call ESMF_GeomGet(ftype%geom, grid=grid, rc=localrc) + if (ESMF_LogFoundError(localrc, & + ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, rcToReturn=rc)) return + ! destroy the Grid proxy + call ESMF_GridDestroy(grid, noGarbage=.false., rc=localrc) + if (ESMF_LogFoundError(localrc, & + ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, rcToReturn=rc)) return + else if (geomtype .eq. ESMF_GEOMTYPE_MESH) then + call ESMF_GeomGet(ftype%geom, mesh=mesh, rc=localrc) + if (ESMF_LogFoundError(localrc, & + ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, rcToReturn=rc)) return + ! destroy the Mesh proxy + call ESMF_MeshDestroy(mesh, noGarbage=.false., rc=localrc) + if (ESMF_LogFoundError(localrc, & + ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, rcToReturn=rc)) return + else if (geomtype .eq. ESMF_GEOMTYPE_LOCSTREAM) then + call ESMF_GeomGet(ftype%geom, locstream=locstream, & + rc=localrc) + if (ESMF_LogFoundError(localrc, & + ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, rcToReturn=rc)) return + ! destroy the LocStream proxy + call ESMF_LocStreamDestroy(locstream, noGarbage=.false., & + rc=localrc) + if (ESMF_LogFoundError(localrc, & + ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, rcToReturn=rc)) return + else if (geomtype .eq. ESMF_GEOMTYPE_XGRID) then + call ESMF_GeomGet(ftype%geom, xgrid=xgrid, rc=localrc) + if (ESMF_LogFoundError(localrc, & + ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, rcToReturn=rc)) return + ! destroy the XGrid proxy + call ESMF_XGridDestroy(xgrid, noGarbage=.false., rc=localrc) + if (ESMF_LogFoundError(localrc, & + ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, rcToReturn=rc)) return + else + call ESMF_LogSetError(rcToCheck=ESMF_RC_INTNRL_BAD, & + msg="Unvalid GeomType detected. Garbage collection issue?", & + ESMF_CONTEXT, rcToReturn=rc) + return + endif + + endif + + ! proxy or not, the Geom needs to be destroyed + call ESMF_GeomDestroy(ftype%geom, rc=localrc) + if (ESMF_LogFoundError(localrc, & + ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, rcToReturn=rc)) return + endif + endif + + ! Return success + if (present(rc)) rc = ESMF_SUCCESS + + end subroutine ESMF_FieldDestructGeom +!------------------------------------------------------------------------------ + + !------------------------------------------------------------------------------ #undef ESMF_METHOD #define ESMF_METHOD "ESMF_FieldSerialize" diff --git a/src/Infrastructure/Field/src/ESMF_FieldCreate.cppF90 b/src/Infrastructure/Field/src/ESMF_FieldCreate.cppF90 index be1f75a76f..c43740efea 100644 --- a/src/Infrastructure/Field/src/ESMF_FieldCreate.cppF90 +++ b/src/Infrastructure/Field/src/ESMF_FieldCreate.cppF90 @@ -5336,11 +5336,6 @@ type(ESMF_KeywordEnforcer), optional:: keywordEnforcer ! must use keywords below !------------------------------------------------------------------------------ integer :: localrc ! local return code type(ESMF_Status) :: basestatus - type(ESMF_GeomType_Flag):: geomtype - type(ESMF_Grid) :: grid - type(ESMF_Mesh) :: mesh - type(ESMF_LocStream) :: locstream - type(ESMF_Xgrid) :: xgrid ! Initialize localrc = ESMF_RC_NOT_IMPL @@ -5352,87 +5347,22 @@ type(ESMF_KeywordEnforcer), optional:: keywordEnforcer ! must use keywords below ESMF_CONTEXT, rcToReturn=rc)) return if (basestatus .eq. ESMF_STATUS_READY) then - if(ftype%status .eq. ESMF_FIELDSTATUS_COMPLETE) then - if(ftype%is_proxy .or. ftype%array_internal) then - call ESMF_ArrayDestroy(ftype%array, noGarbage=noGarbage, rc=localrc) - if (ESMF_LogFoundError(localrc, & - ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, rcToReturn=rc)) return - endif - - if (ftype%is_proxy .or. ftype%geomb_internal) then - - if (ftype%is_proxy) then - ! proxies destroy their actual geometry object, but must leave - ! in garbage collection because multiple fields might be referencing - ! the same actual geometry object, and try to destroy - - call ESMF_GeomGet(ftype%geom, geomtype=geomtype, rc=localrc) - if (ESMF_LogFoundError(localrc, & - ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, rcToReturn=rc)) return - - ! call into the GEOMTYPE specific Destroy() method - if (geomtype .eq. ESMF_GEOMTYPE_GRID) then - call ESMF_GeomGet(ftype%geom, grid=grid, rc=localrc) - if (ESMF_LogFoundError(localrc, & - ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, rcToReturn=rc)) return - ! destroy the Grid proxy - call ESMF_GridDestroy(grid, noGarbage=.false., rc=localrc) - if (ESMF_LogFoundError(localrc, & - ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, rcToReturn=rc)) return - else if (geomtype .eq. ESMF_GEOMTYPE_MESH) then - call ESMF_GeomGet(ftype%geom, mesh=mesh, rc=localrc) - if (ESMF_LogFoundError(localrc, & - ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, rcToReturn=rc)) return - ! destroy the Mesh proxy - call ESMF_MeshDestroy(mesh, noGarbage=.false., rc=localrc) - if (ESMF_LogFoundError(localrc, & - ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, rcToReturn=rc)) return - else if (geomtype .eq. ESMF_GEOMTYPE_LOCSTREAM) then - call ESMF_GeomGet(ftype%geom, locstream=locstream, & - rc=localrc) - if (ESMF_LogFoundError(localrc, & - ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, rcToReturn=rc)) return - ! destroy the LocStream proxy - call ESMF_LocStreamDestroy(locstream, noGarbage=.false., & - rc=localrc) - if (ESMF_LogFoundError(localrc, & - ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, rcToReturn=rc)) return - else if (geomtype .eq. ESMF_GEOMTYPE_XGRID) then - call ESMF_GeomGet(ftype%geom, xgrid=xgrid, rc=localrc) - if (ESMF_LogFoundError(localrc, & - ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, rcToReturn=rc)) return - ! destroy the XGrid proxy - call ESMF_XGridDestroy(xgrid, noGarbage=.false., rc=localrc) - if (ESMF_LogFoundError(localrc, & - ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, rcToReturn=rc)) return - else - call ESMF_LogSetError(rcToCheck=ESMF_RC_INTNRL_BAD, & - msg="Unvalid GeomType detected. Garbage collection issue?", & - ESMF_CONTEXT, rcToReturn=rc) - return - endif - - endif + if(ftype%status .eq. ESMF_FIELDSTATUS_COMPLETE) then - ! proxy or not, the Geom needs to be destroyed - call ESMF_GeomDestroy(ftype%geom, rc=localrc) - if (ESMF_LogFoundError(localrc, & - ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, rcToReturn=rc)) return - endif - - ftype%status = ESMF_FIELDSTATUS_UNINIT ! mark invalid + ! Destroy Array + call ESMF_FieldDestructArray(ftype, noGarbage, rc=localrc) + if (ESMF_LogFoundError(localrc, & + ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, rcToReturn=rc)) return + + ! Destroy geometry + call ESMF_FieldDestructGeom(ftype, noGarbage, rc=localrc) + if (ESMF_LogFoundError(localrc, & + ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, rcToReturn=rc)) return + ! Mark invalid + ftype%status = ESMF_FIELDSTATUS_UNINIT endif endif diff --git a/src/Infrastructure/Field/src/ESMF_FieldEmpty.cppF90 b/src/Infrastructure/Field/src/ESMF_FieldEmpty.cppF90 index 66d8de0dfa..f4a3bffa5f 100644 --- a/src/Infrastructure/Field/src/ESMF_FieldEmpty.cppF90 +++ b/src/Infrastructure/Field/src/ESMF_FieldEmpty.cppF90 @@ -4314,8 +4314,7 @@ type(ESMF_KeywordEnforcer), optional:: keywordEnforcer ! must use keywords below end function ESMF_FieldEmptyCreate !------------------------------------------------------------------------------ - - + !------------------------------------------------------------------------------ ^undef ESMF_METHOD ^define ESMF_METHOD "ESMF_FieldEmptyReset" @@ -4355,7 +4354,8 @@ type(ESMF_KeywordEnforcer), optional:: keywordEnforcer ! must use keywords below ! \end{description} ! !EOP -!------------------------------------------------------------------------------ + !------------------------------------------------------------------------------ + type(ESMF_FieldType), pointer :: ftypep type(ESMF_FieldStatus_Flag) :: currStatus integer :: localrc type(ESMF_Pointer) :: vmThis @@ -4390,20 +4390,101 @@ type(ESMF_KeywordEnforcer), optional:: keywordEnforcer ! must use keywords below if(present(rc)) rc = ESMF_SUCCESS return endif + + ! Get pointer to internal Field + ftypep => field%ftypep ! Get field's current status - call ESMF_FieldGet(field, status=currStatus, rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, rcToReturn=rc)) return - + currStatus=ftypep%status - ! Change Field based on new status and current status - if (status == ESMF_FIELDSTATUS_EMPTY) then - - else if (status == ESMF_FIELDSTATUS_GRIDSET) then - - else if (status == ESMF_FIELDSTATUS_COMPLETE) then - + ! Change Field based on current status and new status + if (currStatus == ESMF_FIELDSTATUS_EMPTY) then + + if (status == ESMF_FIELDSTATUS_EMPTY) then + ! Don't do anything, since no change in status + else if (status == ESMF_FIELDSTATUS_GRIDSET) then + call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_WRONG, & + msg="a Field can't be reset to be more complete than its current status.", & + ESMF_CONTEXT, rcToReturn=rc) + return + else if (status == ESMF_FIELDSTATUS_COMPLETE) then + call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_WRONG, & + msg="a Field can't be reset to be more complete than its current status.", & + ESMF_CONTEXT, rcToReturn=rc) + return + else + call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_WRONG, & + msg="unknown status type", & + ESMF_CONTEXT, rcToReturn=rc) + return + endif + + else if (currStatus == ESMF_FIELDSTATUS_GRIDSET) then + + if (status == ESMF_FIELDSTATUS_EMPTY) then + + ! Destroy Geometry to go back to empty status + call ESMF_FieldDestructGeom(ftypep, noGarbage=.false., rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, rcToReturn=rc)) return + + ! Set flag back to it's inital setting + ftypep%geomb_internal = .false. + + else if (status == ESMF_FIELDSTATUS_GRIDSET) then + ! Don't do anything, since no change in status + else if (status == ESMF_FIELDSTATUS_COMPLETE) then + call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_WRONG, & + msg="a Field can't be reset to be more complete than its current status.", & + ESMF_CONTEXT, rcToReturn=rc) + return + else + call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_WRONG, & + msg="unknown status type", & + ESMF_CONTEXT, rcToReturn=rc) + return + endif + + + else if (currStatus == ESMF_FIELDSTATUS_COMPLETE) then + + if (status == ESMF_FIELDSTATUS_EMPTY) then + + ! Destroy Array + call ESMF_FieldDestructArray(ftypep, noGarbage=.false., rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, rcToReturn=rc)) return + + ! Set Array internal flag back to it's inital setting + ftypep%array_internal = .false. + + ! Destroy Geometry + call ESMF_FieldDestructGeom(ftypep, noGarbage=.false., rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, rcToReturn=rc)) return + + ! Set geom internal flag back to it's inital setting + ftypep%geomb_internal = .false. + + else if (status == ESMF_FIELDSTATUS_GRIDSET) then + + ! Destroy Array + call ESMF_FieldDestructArray(ftypep, noGarbage=.false., rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, rcToReturn=rc)) return + + ! Set Array internal flag back to it's inital setting + ftypep%array_internal = .false. + + else if (status == ESMF_FIELDSTATUS_COMPLETE) then + ! Don't do anything, since no change in status + else + call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_WRONG, & + msg="unknown status type", & + ESMF_CONTEXT, rcToReturn=rc) + return + endif + else call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_WRONG, & msg="unknown status type", & @@ -4412,7 +4493,7 @@ type(ESMF_KeywordEnforcer), optional:: keywordEnforcer ! must use keywords below endif ! Set new status - field%ftypep%status = status + ftypep%status = status ! Return success if(present(rc)) rc = ESMF_SUCCESS diff --git a/src/Infrastructure/Field/tests/ESMF_FieldCreateGetUTest.F90 b/src/Infrastructure/Field/tests/ESMF_FieldCreateGetUTest.F90 index 4dd6f8571c..68678ad686 100644 --- a/src/Infrastructure/Field/tests/ESMF_FieldCreateGetUTest.F90 +++ b/src/Infrastructure/Field/tests/ESMF_FieldCreateGetUTest.F90 @@ -2389,6 +2389,13 @@ program ESMF_FieldCreateGetUTest write(name, *) "Testing completing a Field from a Geom object and a typekind" call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE) + !------------------------------------------------------------------------ + !NEX_UTest_Multi_Proc_Only + ! Testing ESMF_FieldEmptyReset() + call test_FieldEmptyReset(rc) + write(failMsg, *) "" + write(name, *) "Test resetting a Field back to a less complete status" + call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE) call ESMF_TestEnd(ESMF_SRCLINE) @@ -9079,6 +9086,120 @@ subroutine test_geom_comp_tkr(rc) end subroutine test_geom_comp_tkr + + subroutine test_FieldEmptyReset(rc) + integer, intent(out) :: rc + integer :: localrc + type(ESMF_Field) :: field + type(ESMF_Grid) :: grid1, grid2, tmpGrid + real, dimension(:,:), allocatable :: farray + + type(ESMF_VM) :: vm + integer :: lpe + integer, dimension(2) :: ec, cc + integer, dimension(2) :: gelb, geub, gclb, gcub + type(ESMF_StaggerLoc) :: sloc + type (ESMF_TypeKind_Flag) :: typekind + character(len = 20) :: tmpName + + rc = ESMF_SUCCESS + localrc = ESMF_SUCCESS + + ! Create Grids + grid1 = ESMF_GridCreateNoPeriDim(minIndex=(/1,1/), maxIndex=(/16,20/), & + regDecomp=(/4,1/), name="testgrid1", rc=localrc) + if (ESMF_LogFoundError(localrc, & + ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, rcToReturn=rc)) return + + grid2 = ESMF_GridCreateNoPeriDim(minIndex=(/1,1/), maxIndex=(/32,40/), & + regDecomp=(/4,1/), name="testgrid2", rc=localrc) + if (ESMF_LogFoundError(localrc, & + ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, rcToReturn=rc)) return + + ! Create Empty Field + field = ESMF_FieldEmptyCreate(rc=localrc) + if (ESMF_LogFoundError(localrc, & + ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, rcToReturn=rc)) return + + ! Add a Grid + call ESMF_FieldEmptySet(field, grid1, rc=localrc) + if (ESMF_LogFoundError(localrc, & + ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, rcToReturn=rc)) return + + ! Complete + call ESMF_FieldEmptyComplete(field, ESMF_TYPEKIND_R8, rc=localrc) + if (ESMF_LogFoundError(localrc, & + ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, rcToReturn=rc)) return + + + ! Reset + call ESMF_FieldEmptyReset(field, status=ESMF_FIELDSTATUS_EMPTY, & + rc=localrc) + if (ESMF_LogFoundError(localrc, & + ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, rcToReturn=rc)) return + + ! Set a different Grid + call ESMF_FieldEmptySet(field, grid2, rc=localrc) + if (ESMF_LogFoundError(localrc, & + ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, rcToReturn=rc)) return + + ! Complete again with a different type + call ESMF_FieldEmptyComplete(field, ESMF_TYPEKIND_I4, rc=localrc) + if (ESMF_LogFoundError(localrc, & + ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, rcToReturn=rc)) return + + + ! Get info to check if Field was reset + call ESMF_FieldGet(field, typekind=typekind, grid=tmpGrid, rc=localrc) + if (ESMF_LogFoundError(localrc, & + ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, rcToReturn=rc)) return + + ! Check type + if (typekind /= ESMF_TYPEKIND_I4) then + rc= ESMF_FAILURE + return + endif + + ! Check Grid + call ESMF_GridGet(tmpGrid, name=tmpName, rc=localrc) + if (ESMF_LogFoundError(localrc, & + ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, rcToReturn=rc)) return + + if (trim(tmpName) /= "testgrid2") then + rc= ESMF_FAILURE + return + endif + + + ! Get rid of Field and Grid + call ESMF_FieldDestroy(field, rc=localrc) + if (ESMF_LogFoundError(localrc, & + ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, rcToReturn=rc)) return + + call ESMF_GridDestroy(grid1, rc=localrc) + if (ESMF_LogFoundError(localrc, & + ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, rcToReturn=rc)) return + + call ESMF_GridDestroy(grid2, rc=localrc) + if (ESMF_LogFoundError(localrc, & + ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, rcToReturn=rc)) return + + end subroutine test_FieldEmptyReset + + From 20b3f6de8ba216d032f3b8b16f9c8e35c7bf6e74 Mon Sep 17 00:00:00 2001 From: Robert Oehmke Date: Wed, 20 Nov 2024 09:42:14 -0700 Subject: [PATCH 146/207] Fix issue. --- src/Infrastructure/Field/src/ESMF_Field.F90 | 38 +++++++++++---------- 1 file changed, 20 insertions(+), 18 deletions(-) diff --git a/src/Infrastructure/Field/src/ESMF_Field.F90 b/src/Infrastructure/Field/src/ESMF_Field.F90 index 656d87a3b1..42bfa39f86 100644 --- a/src/Infrastructure/Field/src/ESMF_Field.F90 +++ b/src/Infrastructure/Field/src/ESMF_Field.F90 @@ -573,8 +573,8 @@ subroutine ESMF_FieldDestructGeom(ftype, noGarbage, rc) ! Field only has Geom if complete or gridset if ((ftype%status .eq. ESMF_FIELDSTATUS_GRIDSET) .or. & (ftype%status .eq. ESMF_FIELDSTATUS_COMPLETE)) then - - if (ftype%is_proxy .or. ftype%geomb_internal) then + + if (ftype%is_proxy .or. ftype%geomb_internal) then if (ftype%is_proxy) then #if 1 @@ -642,24 +642,26 @@ subroutine ESMF_FieldDestructGeom(ftype, noGarbage, rc) msg="Unvalid GeomType detected. Garbage collection issue?", & ESMF_CONTEXT, rcToReturn=rc) return - endif - ! the Geom needs to be destroyed - call ESMF_GeomDestroy(ftype%geom, rc=localrc) - if (ESMF_LogFoundError(localrc, & - ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, rcToReturn=rc)) return + endif + + ! the Geom needs to be destroyed + call ESMF_GeomDestroy(ftype%geom, rc=localrc) + if (ESMF_LogFoundError(localrc, & + ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, rcToReturn=rc)) return #endif - else - ! the Geom needs to be destroyed - call ESMF_GeomDestroy(ftype%geom, rc=localrc) - if (ESMF_LogFoundError(localrc, & - ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, rcToReturn=rc)) return - endif + else + ! the Geom needs to be destroyed + call ESMF_GeomDestroy(ftype%geom, rc=localrc) + if (ESMF_LogFoundError(localrc, & + ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, rcToReturn=rc)) return endif - - ! Return success - if (present(rc)) rc = ESMF_SUCCESS + endif + endif + + ! Return success + if (present(rc)) rc = ESMF_SUCCESS end subroutine ESMF_FieldDestructGeom !------------------------------------------------------------------------------ From e147c8e7ec99799bd7aaad2b4bf3ae8b3a89c53f Mon Sep 17 00:00:00 2001 From: Robert Oehmke Date: Wed, 20 Nov 2024 15:16:11 -0700 Subject: [PATCH 147/207] Small doc change. --- src/Infrastructure/Field/src/ESMF_FieldEmpty.cppF90 | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/src/Infrastructure/Field/src/ESMF_FieldEmpty.cppF90 b/src/Infrastructure/Field/src/ESMF_FieldEmpty.cppF90 index f4a3bffa5f..16e4de8c37 100644 --- a/src/Infrastructure/Field/src/ESMF_FieldEmpty.cppF90 +++ b/src/Infrastructure/Field/src/ESMF_FieldEmpty.cppF90 @@ -4336,9 +4336,13 @@ type(ESMF_KeywordEnforcer), optional:: keywordEnforcer ! must use keywords below ! !DESCRIPTION: ! Reset an {\tt ESMF\_Field} to a less complete status. After this ! operation, methods appropriate to the new status can be used on the Field. -! For example, if reset to status {\tt ESMF\_FIELDSTATUS\_EMPTY}, then {\tt ESMF\_FieldEmpySet()} +! For example, if reset to status {\tt ESMF\_FIELDSTATUS\_EMPTY}, then {\tt ESMF\_FieldEmptySet()} ! could be used to set a new Grid in the Field. ! +! Note that if used improperly, this method can cause inconsistencies. For example, creating a routeHandle +! on a Field and then using this method to change the geometry (e.g. Grid) under the Field could lead to the +! routeHandle no longer being valid for the Field. +! ! The arguments are: ! \begin{description} ! \item [field] From 2f73914d8eafd98795b751479dccd16c28099c80 Mon Sep 17 00:00:00 2001 From: Robert Oehmke Date: Wed, 20 Nov 2024 16:08:08 -0700 Subject: [PATCH 148/207] Remove unneeded perioid. --- src/Infrastructure/Field/src/ESMF_FieldEmpty.cppF90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Infrastructure/Field/src/ESMF_FieldEmpty.cppF90 b/src/Infrastructure/Field/src/ESMF_FieldEmpty.cppF90 index 16e4de8c37..cb103fcef5 100644 --- a/src/Infrastructure/Field/src/ESMF_FieldEmpty.cppF90 +++ b/src/Infrastructure/Field/src/ESMF_FieldEmpty.cppF90 @@ -4319,7 +4319,7 @@ type(ESMF_KeywordEnforcer), optional:: keywordEnforcer ! must use keywords below ^undef ESMF_METHOD ^define ESMF_METHOD "ESMF_FieldEmptyReset" !BOP -! !IROUTINE: ESMF_FieldEmptyReset - Reset a Field back to an earlier status. +! !IROUTINE: ESMF_FieldEmptyReset - Reset a Field back to an earlier status ! !INTERFACE: subroutine ESMF_FieldEmptyReset(field, status, keywordEnforcer, vm, rc) From d24f44eaa6f158de76257c8058636e55ae5483e1 Mon Sep 17 00:00:00 2001 From: Robert Oehmke Date: Thu, 21 Nov 2024 16:06:32 -0700 Subject: [PATCH 149/207] Change 2D_3D_sph 2nd order conservative to use XGrid information directly when calculating weights. --- .../Mesh/include/Legacy/ESMCI_SM.h | 16 + src/Infrastructure/Mesh/src/Legacy/ESMCI_SM.C | 338 ++++++++++++------ .../src/Regridding/ESMCI_Conserve2ndInterp.C | 44 ++- 3 files changed, 276 insertions(+), 122 deletions(-) diff --git a/src/Infrastructure/Mesh/include/Legacy/ESMCI_SM.h b/src/Infrastructure/Mesh/include/Legacy/ESMCI_SM.h index 1197ac7133..7d64cdc2b3 100644 --- a/src/Infrastructure/Mesh/include/Legacy/ESMCI_SM.h +++ b/src/Infrastructure/Mesh/include/Legacy/ESMCI_SM.h @@ -37,6 +37,22 @@ namespace ESMCI { std::vector *tmp_valid, std::vector *tmp_sintd_areas_out, std::vector *tmp_dst_areas_out, std::vector *sm_cells); + void create_dst_xgrid_SM_cells_2D_3D_sph(const MeshObj *src_elem, MEField<> *src_cfield, + std::vector dst_elems, MEField<> *dst_cfield, MEField<> * dst_mask_field, MEField<> * dst_frac2_field, + double *src_elem_area, + std::vector *valid, + std::vector *sintd_areas_out, std::vector *dst_areas_out, + std::vector *sm_cells); + + void create_src_xgrid_SM_cells_2D_3D_sph(const MeshObj *src_elem, MEField<> *src_cfield, + std::vector dst_elems, MEField<> *dst_cfield, MEField<> * dst_mask_field, MEField<> * dst_frac2_field, + double *src_elem_area, + std::vector *valid, + std::vector *sintd_areas_out, std::vector *dst_areas_out, + std::vector *sm_cells); + + + } // namespace #endif diff --git a/src/Infrastructure/Mesh/src/Legacy/ESMCI_SM.C b/src/Infrastructure/Mesh/src/Legacy/ESMCI_SM.C index 37cbd37e8e..56512c72aa 100644 --- a/src/Infrastructure/Mesh/src/Legacy/ESMCI_SM.C +++ b/src/Infrastructure/Mesh/src/Legacy/ESMCI_SM.C @@ -1071,6 +1071,9 @@ namespace ESMCI { // This method creates sm cells for a 2nd order interpolation going from a side mesh to an XGrid + // Since the destination is an XGrid by definition all the destination cells are the SM cells. + // Because of that, we just have to loop through the destination cells and fill in the SM + // info. // Here valid and wghts need to be resized to the same size as dst_elems before being passed into // this call. @@ -1079,27 +1082,22 @@ namespace ESMCI { double *src_elem_area, std::vector *valid, std::vector *sintd_areas_out, std::vector *dst_areas_out, - std::vector *tmp_valid, std::vector *tmp_sintd_areas_out, std::vector *tmp_dst_areas_out, std::vector *sm_cells) { - - //// STOPPED HERE //// - - // Maximum size for a supported polygon // Since the elements are of a small // limited size. Fixed sized buffers seem // the best way to handle them -#define MAX_NUM_POLY_NODES 40 -#define MAX_NUM_POLY_COORDS_3D (3*MAX_NUM_POLY_NODES) +#define MAX_NUM_SRC_POLY_NODES 40 +#define MAX_NUM_SRC_POLY_COORDS_3D (3*MAX_NUM_SRC_POLY_NODES) // Declaration for src polygon int num_src_nodes; - double src_coords[MAX_NUM_POLY_COORDS_3D]; - double tmp_coords[MAX_NUM_POLY_COORDS_3D]; + double src_coords[MAX_NUM_SRC_POLY_COORDS_3D]; + double tmp_coords[MAX_NUM_SRC_POLY_COORDS_3D]; // Get src coords - get_elem_coords_3D_ccw(src_elem, src_cfield, MAX_NUM_POLY_NODES, tmp_coords, &num_src_nodes, src_coords); + get_elem_coords_3D_ccw(src_elem, src_cfield, MAX_NUM_SRC_POLY_NODES, tmp_coords, &num_src_nodes, src_coords); // Get rid of degenerate edges remove_0len_edges3D(&num_src_nodes, src_coords); @@ -1128,137 +1126,253 @@ namespace ESMCI { return; } - // See if concave - bool is_concave=false; - if (num_src_nodes > 3) { - bool left_turn=false; - bool right_turn=false; + // Set src area + *src_elem_area=great_circle_area(num_src_nodes, src_coords); + + // Defs for dst polygon +#define MAX_NUM_DST_POLY_NODES 40 +#define MAX_NUM_DST_POLY_COORDS_3D (3*MAX_NUM_DST_POLY_NODES) + + // Declaration for dst polygon + int num_dst_nodes; + double dst_coords[MAX_NUM_DST_POLY_COORDS_3D]; + + // Loop over dst and put information into SM cells + for (int i=0; idata(*dst_elem); + if (*msk>0.5) { + // Init to 0's above + continue; + } + } + + // Invalidate creeped out dst element + if(dst_frac2_field){ + double *dst_frac2=dst_frac2_field->data(*dst_elem); + if (*dst_frac2 == 0.0){ + // Init to 0's above + continue; + } + } - // If not concave then just call into the lower level - if (!is_concave) { - create_SM_cells_2D_3D_sph_src_pnts(num_src_nodes, src_coords, - dst_elems, dst_cfield, dst_mask_field, dst_frac2_field, - src_elem_area, - valid, - sintd_areas_out, dst_areas_out, - sm_cells); + // Get dst coords + get_elem_coords_3D_ccw(dst_elem, dst_cfield, MAX_NUM_DST_POLY_NODES, tmp_coords, &num_dst_nodes, dst_coords); + + // Get rid of degenerate edges + remove_0len_edges3D(&num_dst_nodes, dst_coords); + + // if less than a triangle skip + if (num_dst_nodes<3) { + // Init to 0's above + continue; + } - } else { // else, break into two pieces... + // if a smashed quad skip + if (is_smashed_quad3D(num_dst_nodes, dst_coords)) { + // Init to 0's above + continue; + } + + // Put dst cell information directly into SM cells and list - // Space for temporary buffers - double td[3*4]; - int ti[4]; - int tri_ind[6]; + // Calculate dst area + double dst_area=great_circle_area(num_dst_nodes, dst_coords); + // Declare temporary supermesh cell info structure + SM_CELL tmp_smc; - // This must be a quad if not complain and exit - // IF NOT A QUAD, THEN THE ABOVE BUFFER SIZES MUST BE CHANGED!!! - // TO EMPHASIZE THAT IT MUST BE QUAD 4 IS PASSED IN FOR THE SIZE BELOW. - if (num_src_nodes != 4) Throw() << " This isn't a quad, but it should be!"; - int ret=triangulate_poly(4, src_coords, td, - ti, tri_ind); - // Error check - // Check return code - if (ret != ESMCI_TP_SUCCESS) { - if (ret == ESMCI_TP_DEGENERATE_POLY) Throw() << " - can't triangulate a polygon with less than 3 sides"; - else if (ret == ESMCI_TP_CLOCKWISE_POLY) Throw() << " - clockwise polygons not supported in triangulation routine"; - else Throw() << " - unknown error in triangulation"; - } + // Add destination cell index + tmp_smc.dst_index=i; + // Add area to supermesh cell info + tmp_smc.area=dst_area; + + // Add centroid to supermesh cell info + _calc_centroid_2D_3D_sph(num_dst_nodes, dst_coords, tmp_smc.cntr); - // Because this is a quad it will be in 2 pieces. - double tri[9]; + // Add to list + sm_cells->push_back(tmp_smc); - // Tri 1 - tri[0]=src_coords[3*tri_ind[0]]; - tri[1]=src_coords[3*tri_ind[0]+1]; - tri[2]=src_coords[3*tri_ind[0]+2]; + // Set information into other lists + (*valid)[i]=1; + (*sintd_areas_out)[i]=dst_area; // because dst is XGrid sintd area = dst area + (*dst_areas_out)[i]=dst_area; + +#undef MAX_NUM_DST_POLY_NODES +#undef MAX_NUM_DST_POLY_COORDS_3D + } + - tri[3]=src_coords[3*tri_ind[1]]; - tri[4]=src_coords[3*tri_ind[1]+1]; - tri[5]=src_coords[3*tri_ind[1]+2]; + +#undef MAX_NUM_SRC_POLY_NODES +#undef MAX_NUM_SRC_POLY_COORDS_3D + } - tri[6]=src_coords[3*tri_ind[2]]; - tri[7]=src_coords[3*tri_ind[2]+1]; - tri[8]=src_coords[3*tri_ind[2]+2]; - create_SM_cells_2D_3D_sph_src_pnts(3, tri, - dst_elems, dst_cfield, dst_mask_field, dst_frac2_field, - src_elem_area, - valid, - sintd_areas_out, dst_areas_out, - sm_cells); + // This method creates sm cells for a 2nd order interpolation going from an XGrid to a side mesh + // Since the source is an XGrid by definition the source cell is the SM cell. + // Because of that, we just have to set the + + // Here valid and wghts need to be resized to the same size as dst_elems before being passed into + // this call. + void create_src_xgrid_SM_cells_2D_3D_sph(const MeshObj *src_elem, MEField<> *src_cfield, + std::vector dst_elems, MEField<> *dst_cfield, MEField<> * dst_mask_field, MEField<> * dst_frac2_field, + double *src_elem_area, + std::vector *valid, + std::vector *sintd_areas_out, std::vector *dst_areas_out, + std::vector *sm_cells) { + +// Maximum size for a supported polygon +// Since the elements are of a small +// limited size. Fixed sized buffers seem +// the best way to handle them - // Tri 2 - tri[0]=src_coords[3*tri_ind[3]]; - tri[1]=src_coords[3*tri_ind[3]+1]; - tri[2]=src_coords[3*tri_ind[3]+2]; +#define MAX_NUM_SRC_POLY_NODES 40 +#define MAX_NUM_SRC_POLY_COORDS_3D (3*MAX_NUM_SRC_POLY_NODES) - tri[3]=src_coords[3*tri_ind[4]]; - tri[4]=src_coords[3*tri_ind[4]+1]; - tri[5]=src_coords[3*tri_ind[4]+2]; + // Declaration for src polygon + int num_src_nodes; + double src_coords[MAX_NUM_SRC_POLY_COORDS_3D]; + double tmp_coords[MAX_NUM_SRC_POLY_COORDS_3D]; - tri[6]=src_coords[3*tri_ind[5]]; - tri[7]=src_coords[3*tri_ind[5]+1]; - tri[8]=src_coords[3*tri_ind[5]+2]; + // Get src coords + get_elem_coords_3D_ccw(src_elem, src_cfield, MAX_NUM_SRC_POLY_NODES, tmp_coords, &num_src_nodes, src_coords); + // Get rid of degenerate edges + remove_0len_edges3D(&num_src_nodes, src_coords); - // Tmp variables to hold info from second triangle - double src_elem_area2; - - // If need to expand arrays, expand - if (dst_elems.size() > tmp_valid->size()) { - tmp_valid->resize(dst_elems.size(),0); - tmp_sintd_areas_out->resize(dst_elems.size(),0.0); - tmp_dst_areas_out->resize(dst_elems.size(),0.0); + // If less than a triangle invalidate everything and leave because it won't results in weights + // Decision about returning error for degeneracy is made above this subroutine + if (num_src_nodes<3) { + *src_elem_area=0.0; + for (int i=0; idata(*dst_elem); + if (*msk>0.5) { + // Init to 0's above + return; + } + } + + // Invalidate creeped out dst element + if(dst_frac2_field){ + double *dst_frac2=dst_frac2_field->data(*dst_elem); + if (*dst_frac2 == 0.0){ + // Init to 0's above + return; + } + } - //loop through merging valid, sintd area and dst area - for (int i=0; ipush_back(tmp_smc); + + // Set information into other lists + (*valid)[0]=1; + (*sintd_areas_out)[0]=src_area; // because src is XGrid sintd area = src area + (*dst_areas_out)[0]=dst_area; + + +#undef MAX_NUM_DST_POLY_NODES +#undef MAX_NUM_DST_POLY_COORDS_3D + +#undef MAX_NUM_SRC_POLY_NODES +#undef MAX_NUM_SRC_POLY_COORDS_3D } + //////////////// END CALC 2D 3D WEIGHTS ////////////////// diff --git a/src/Infrastructure/Mesh/src/Regridding/ESMCI_Conserve2ndInterp.C b/src/Infrastructure/Mesh/src/Regridding/ESMCI_Conserve2ndInterp.C index e79f0d5a12..ec11ea15d8 100644 --- a/src/Infrastructure/Mesh/src/Regridding/ESMCI_Conserve2ndInterp.C +++ b/src/Infrastructure/Mesh/src/Regridding/ESMCI_Conserve2ndInterp.C @@ -1245,17 +1245,41 @@ namespace ESMCI { std::vector *sm_cells, std::vector *nbrs ) { - - printf("xgrid_use=%d\n",xgrid_use); - // Create super mesh cells by intersecting src_elem and list of dst_elems - create_SM_cells_2D_3D_sph(src_elem, src_cfield, - dst_elems, dst_cfield, dst_mask_field, dst_frac2_field, - src_elem_area, - valid, sintd_areas_out, dst_areas_out, - tmp_valid, tmp_sintd_areas_out, tmp_dst_areas_out, - sm_cells); - + // Create super mesh cells depending on situation + switch(xgrid_use) { + case XGRID_USE_NONE: + // Create super mesh cells by intersecting src_elem and list of dst_elems + create_SM_cells_2D_3D_sph(src_elem, src_cfield, + dst_elems, dst_cfield, dst_mask_field, dst_frac2_field, + src_elem_area, + valid, sintd_areas_out, dst_areas_out, + tmp_valid, tmp_sintd_areas_out, tmp_dst_areas_out, + sm_cells); + break; + + case XGRID_USE_SRC: + // Create super mesh cells by getting src xgrid cell + create_src_xgrid_SM_cells_2D_3D_sph(src_elem, src_cfield, + dst_elems, dst_cfield, dst_mask_field, dst_frac2_field, + src_elem_area, + valid, sintd_areas_out, dst_areas_out, + sm_cells); + break; + + case XGRID_USE_DST: + // Create super mesh cells by getting dst xgrid cells + create_dst_xgrid_SM_cells_2D_3D_sph(src_elem, src_cfield, + dst_elems, dst_cfield, dst_mask_field, dst_frac2_field, + src_elem_area, + valid, sintd_areas_out, dst_areas_out, + sm_cells); + break; + + default: + Throw() << "Unrecognized xgrid use type."; + } + // If there are no sm cells then leave if (sm_cells->empty()) return; From bea752277e301161ae223aac00b02f365eea69cb Mon Sep 17 00:00:00 2001 From: Gerhard Theurich Date: Fri, 22 Nov 2024 10:11:53 -0800 Subject: [PATCH 150/207] Make `status` an optional argument in ESMF_FieldEmptyReset(). Reference list of valid options in API doc. --- .../Field/src/ESMF_FieldEmpty.cppF90 | 110 +++++++++--------- 1 file changed, 57 insertions(+), 53 deletions(-) diff --git a/src/Infrastructure/Field/src/ESMF_FieldEmpty.cppF90 b/src/Infrastructure/Field/src/ESMF_FieldEmpty.cppF90 index cb103fcef5..34fd7f5840 100644 --- a/src/Infrastructure/Field/src/ESMF_FieldEmpty.cppF90 +++ b/src/Infrastructure/Field/src/ESMF_FieldEmpty.cppF90 @@ -4314,23 +4314,23 @@ type(ESMF_KeywordEnforcer), optional:: keywordEnforcer ! must use keywords below end function ESMF_FieldEmptyCreate !------------------------------------------------------------------------------ - + !------------------------------------------------------------------------------ ^undef ESMF_METHOD ^define ESMF_METHOD "ESMF_FieldEmptyReset" !BOP -! !IROUTINE: ESMF_FieldEmptyReset - Reset a Field back to an earlier status +! !IROUTINE: ESMF_FieldEmptyReset - Reset a Field back to an earlier status ! !INTERFACE: - subroutine ESMF_FieldEmptyReset(field, status, keywordEnforcer, vm, rc) + subroutine ESMF_FieldEmptyReset(field, keywordEnforcer, status, vm, rc) ! ! !ARGUMENTS: - type(ESMF_Field), intent(inout) :: field - type(ESMF_FieldStatus_Flag), intent(in) :: status + type(ESMF_Field), intent(inout) :: field type(ESMF_KeywordEnforcer), optional:: keywordEnforcer ! must use keywords below - type(ESMF_VM), intent(in), optional :: vm - integer, intent(out), optional :: rc + type(ESMF_FieldStatus_Flag), intent(in), optional :: status + type(ESMF_VM), intent(in), optional :: vm + integer, intent(out), optional :: rc ! ! ! !DESCRIPTION: @@ -4341,14 +4341,16 @@ type(ESMF_KeywordEnforcer), optional:: keywordEnforcer ! must use keywords below ! ! Note that if used improperly, this method can cause inconsistencies. For example, creating a routeHandle ! on a Field and then using this method to change the geometry (e.g. Grid) under the Field could lead to the -! routeHandle no longer being valid for the Field. +! routeHandle no longer being valid for the Field. ! ! The arguments are: ! \begin{description} ! \item [field] -! The {\tt ESMF\_Field} object to reset. -! \item [status] -! The new status to set the Field to. +! The {\tt ESMF\_Field} object to reset. +! \item [{[status]}] +! The new status to set the Field to. +! See section \ref{const:fieldstatus} for a complete list of values. +! The default is {\tt ESMF\_FIELDSTATUS\_EMPTY}. ! \item[{[vm]}] ! If present, the Field object will only be accessed, and the Grid object ! set, on those PETs contained in the specified {\tt ESMF\_VM} object. @@ -4360,7 +4362,7 @@ type(ESMF_KeywordEnforcer), optional:: keywordEnforcer ! must use keywords below !EOP !------------------------------------------------------------------------------ type(ESMF_FieldType), pointer :: ftypep - type(ESMF_FieldStatus_Flag) :: currStatus + type(ESMF_FieldStatus_Flag) :: currStatus, setStatus integer :: localrc type(ESMF_Pointer) :: vmThis logical :: actualFlag @@ -4370,15 +4372,18 @@ type(ESMF_KeywordEnforcer), optional:: keywordEnforcer ! must use keywords below ESMF_INIT_CHECK_DEEP(ESMF_FieldGetInit,field,rc) + ! Handle option status argument + setStatus = ESMF_FIELDSTATUS_EMPTY ! default + if (present(status)) setStatus = status + ! Error check status - if(status == ESMF_FIELDSTATUS_UNINIT) then + if(setStatus == ESMF_FIELDSTATUS_UNINIT) then call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_WRONG, & msg="FieldEmptyReset - cannot reset a Field to an uninitialized status.", & ESMF_CONTEXT, rcToReturn=rc) return endif - ! Must make sure the local PET is associated with an actual member actualFlag = .true. if (present(vm)) then @@ -4396,63 +4401,62 @@ type(ESMF_KeywordEnforcer), optional:: keywordEnforcer ! must use keywords below endif ! Get pointer to internal Field - ftypep => field%ftypep - + ftypep => field%ftypep + ! Get field's current status currStatus=ftypep%status - + ! Change Field based on current status and new status if (currStatus == ESMF_FIELDSTATUS_EMPTY) then - - if (status == ESMF_FIELDSTATUS_EMPTY) then - ! Don't do anything, since no change in status - else if (status == ESMF_FIELDSTATUS_GRIDSET) then + + if (setStatus == ESMF_FIELDSTATUS_EMPTY) then + ! Don't do anything, since no change in status + else if (setStatus == ESMF_FIELDSTATUS_GRIDSET) then call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_WRONG, & msg="a Field can't be reset to be more complete than its current status.", & ESMF_CONTEXT, rcToReturn=rc) - return - else if (status == ESMF_FIELDSTATUS_COMPLETE) then + return + else if (setStatus == ESMF_FIELDSTATUS_COMPLETE) then call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_WRONG, & msg="a Field can't be reset to be more complete than its current status.", & ESMF_CONTEXT, rcToReturn=rc) - return + return else call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_WRONG, & msg="unknown status type", & ESMF_CONTEXT, rcToReturn=rc) - return + return endif - + else if (currStatus == ESMF_FIELDSTATUS_GRIDSET) then - - if (status == ESMF_FIELDSTATUS_EMPTY) then + + if (setStatus == ESMF_FIELDSTATUS_EMPTY) then ! Destroy Geometry to go back to empty status call ESMF_FieldDestructGeom(ftypep, noGarbage=.false., rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return - + ! Set flag back to it's inital setting - ftypep%geomb_internal = .false. + ftypep%geomb_internal = .false. - else if (status == ESMF_FIELDSTATUS_GRIDSET) then - ! Don't do anything, since no change in status - else if (status == ESMF_FIELDSTATUS_COMPLETE) then + else if (setStatus == ESMF_FIELDSTATUS_GRIDSET) then + ! Don't do anything, since no change in status + else if (setStatus == ESMF_FIELDSTATUS_COMPLETE) then call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_WRONG, & msg="a Field can't be reset to be more complete than its current status.", & ESMF_CONTEXT, rcToReturn=rc) - return + return else call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_WRONG, & msg="unknown status type", & ESMF_CONTEXT, rcToReturn=rc) - return - endif + return + endif - else if (currStatus == ESMF_FIELDSTATUS_COMPLETE) then - - if (status == ESMF_FIELDSTATUS_EMPTY) then + + if (setStatus == ESMF_FIELDSTATUS_EMPTY) then ! Destroy Array call ESMF_FieldDestructArray(ftypep, noGarbage=.false., rc=localrc) @@ -4460,17 +4464,17 @@ type(ESMF_KeywordEnforcer), optional:: keywordEnforcer ! must use keywords below ESMF_CONTEXT, rcToReturn=rc)) return ! Set Array internal flag back to it's inital setting - ftypep%array_internal = .false. - + ftypep%array_internal = .false. + ! Destroy Geometry call ESMF_FieldDestructGeom(ftypep, noGarbage=.false., rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return ! Set geom internal flag back to it's inital setting - ftypep%geomb_internal = .false. - - else if (status == ESMF_FIELDSTATUS_GRIDSET) then + ftypep%geomb_internal = .false. + + else if (setStatus == ESMF_FIELDSTATUS_GRIDSET) then ! Destroy Array call ESMF_FieldDestructArray(ftypep, noGarbage=.false., rc=localrc) @@ -4478,27 +4482,27 @@ type(ESMF_KeywordEnforcer), optional:: keywordEnforcer ! must use keywords below ESMF_CONTEXT, rcToReturn=rc)) return ! Set Array internal flag back to it's inital setting - ftypep%array_internal = .false. - - else if (status == ESMF_FIELDSTATUS_COMPLETE) then - ! Don't do anything, since no change in status + ftypep%array_internal = .false. + + else if (setStatus == ESMF_FIELDSTATUS_COMPLETE) then + ! Don't do anything, since no change in status else call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_WRONG, & msg="unknown status type", & ESMF_CONTEXT, rcToReturn=rc) - return + return endif - + else call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_WRONG, & msg="unknown status type", & ESMF_CONTEXT, rcToReturn=rc) - return + return endif ! Set new status - ftypep%status = status - + ftypep%status = setStatus + ! Return success if(present(rc)) rc = ESMF_SUCCESS From a3c065fa6296fe412c22cba65479b424a647c11e Mon Sep 17 00:00:00 2001 From: Gerhard Theurich Date: Fri, 22 Nov 2024 10:14:12 -0800 Subject: [PATCH 151/207] Correct typos that made a comment unintelligible. --- src/Infrastructure/Field/src/ESMF_Field.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Infrastructure/Field/src/ESMF_Field.F90 b/src/Infrastructure/Field/src/ESMF_Field.F90 index 42bfa39f86..26366992f2 100644 --- a/src/Infrastructure/Field/src/ESMF_Field.F90 +++ b/src/Infrastructure/Field/src/ESMF_Field.F90 @@ -579,7 +579,7 @@ subroutine ESMF_FieldDestructGeom(ftype, noGarbage, rc) if (ftype%is_proxy) then #if 1 !gjt: Destroying geom object for proxies might not be a good idea. If this -!gjt: every cases issues, then we might want to disable it here. +!gjt: ever causes issues, then we might want to disable it here. !gjt: Disable, because proxy geoms might be used outside the original the !gjt: proxy field... cannot destroy here, but instead must keep proxy the !gjt: geom alive!!! From f51a999e48a96b5a3b84241a490e8d6a7ef6d35e Mon Sep 17 00:00:00 2001 From: Ufuk Turuncoglu Date: Fri, 22 Nov 2024 12:32:51 -0600 Subject: [PATCH 152/207] add documentation --- src/addon/NUOPC/doc/NUOPC_Field_metadata.tex | 1 + src/addon/NUOPC/doc/NUOPC_State_metadata.tex | 1 + 2 files changed, 2 insertions(+) diff --git a/src/addon/NUOPC/doc/NUOPC_Field_metadata.tex b/src/addon/NUOPC/doc/NUOPC_Field_metadata.tex index e1d64baae3..aa50cbed3d 100644 --- a/src/addon/NUOPC/doc/NUOPC_Field_metadata.tex +++ b/src/addon/NUOPC/doc/NUOPC_Field_metadata.tex @@ -31,5 +31,6 @@ {\tt MaxIndex} & Integer value list. If present equals the {\tt maxIndex} (of tile 1) of the provider field.during a GeomObject transfer. & {\em no restriction}\\ \hline {\tt TypeKind} & Integer value. If present equals the integer representation of {\tt typekind} of the provider field.during a GeomObject transfer. & {\em implementation dependent range}\\ \hline {\tt GeomLoc} & Integer value. If present equals the integer representation of {\tt staggerloc} (for Grid) or {\tt meshloc} (for Mesh) of the provider field.during a GeomObject transfer. & {\em implementation dependent range}\\ \hline + {\tt ProviderCompName} & String value holding the name of provider component that is indicated in run sequence\\ \hline \hline \end{longtable} diff --git a/src/addon/NUOPC/doc/NUOPC_State_metadata.tex b/src/addon/NUOPC/doc/NUOPC_State_metadata.tex index 095773ee35..d191f5b8a7 100644 --- a/src/addon/NUOPC/doc/NUOPC_State_metadata.tex +++ b/src/addon/NUOPC/doc/NUOPC_State_metadata.tex @@ -9,5 +9,6 @@ \hline\hline {\tt Namespace} & String value holding the namespace of all the objects contained in the State.& {\em no restriction}\\ \hline {\tt FieldTransferPolicy} & String value indicating to Connector to transfer/mirror Fields. & transferNone,\newline transferAll\\ \hline + {\tt CompName} & String value holding the name of provider component that is indicated in run sequence\\ \hline \hline \end{longtable} From 69949045f7c1208f743dad1f50235f429d3aa2f6 Mon Sep 17 00:00:00 2001 From: Ufuk Turuncoglu Date: Fri, 22 Nov 2024 13:58:40 -0600 Subject: [PATCH 153/207] add doc for field mirroring --- src/addon/NUOPC/doc/NUOPC_FieldMirror.tex | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/addon/NUOPC/doc/NUOPC_FieldMirror.tex b/src/addon/NUOPC/doc/NUOPC_FieldMirror.tex index 681151cbe3..52b09caef0 100644 --- a/src/addon/NUOPC/doc/NUOPC_FieldMirror.tex +++ b/src/addon/NUOPC/doc/NUOPC_FieldMirror.tex @@ -7,8 +7,8 @@ The field mirror capability is also useful with NUOPC Mediators since these components often exactly reflect, in separate States, the sets of fields of each of the connected components. The field mirroring capability, therefore, can be used to ensure that a Mediator is always capable of accepting fields from connected components, and removes the need to specify field lists in multiple places, i.e., both within a set of Model components connected to a Mediator and within the Mediator itself. -To access the field mirror capability, a component sets the {\tt FieldTransferPolicy} attribute during {\tt label\_Advertise}. The attribute is set on the Import- and/or Export- States to trigger field mirroring for each state, respectively. The default value of "TransferNone" indicates that no fields should be mirrored. The other option, "TransferAll", indicates that fields should be mirrored in the State of a connected component. +To access the field mirror capability, a component sets the {\tt FieldTransferPolicy} attribute during {\tt label\_Advertise}. The attribute is set on the Import- and/or Export- States to trigger field mirroring for each state, respectively. The default value of "TransferNone" indicates that no fields should be mirrored. The other options, "TransferAll", indicates that fields should be mirrored in the State of a connected component and "TransferAllAsNests", also indicates that fields should be mirrored in the State of a connected component but in this case, fields are added to nested state for each provider component. -Each Connector consider the {\tt FieldTransferPolicy} Attribute on both its import and export States. If {\em both} States have a {\tt FieldTransferPolicy} of "TransferAll", then fields are transferred between the States in both directions (i.e., import to export and export to import). The transfer process works as follows: First, the {\tt TransferOfferGoemObject} attribute is reversed between the providing side and accepting side. Intuitively, if a field from the providing component is to be mirrored and it can provide its own geometric object, then the mirrored field on the accepting side should be set to accept a geometric object. Then, the field to be mirrored is advertised in the accepting State using a call to {\tt NUOPC\_Advertise()} such that the mirrored field shares the same Standard Name. +Each Connector consider the {\tt FieldTransferPolicy} Attribute on both its import and export States. If {\em both} States have a {\tt FieldTransferPolicy} of "TransferAll" or "TransferAllAsNests", then fields are transferred between the States in both directions (i.e., import to export and export to import). In case of "TransferAllAsNests", the received State by acceptor will have nested states for each provider. The transfer process works as follows: First, the {\tt TransferOfferGoemObject} attribute is reversed between the providing side and accepting side. Intuitively, if a field from the providing component is to be mirrored and it can provide its own geometric object, then the mirrored field on the accepting side should be set to accept a geometric object. Then, the field to be mirrored is advertised in the accepting State using a call to {\tt NUOPC\_Advertise()} such that the mirrored field shares the same Standard Name. The accepting State will have nested states if {\tt FieldTransferPolicy} is set to "TransferAllAsNests". Components have the opportunity, using specialiozation point {\tt label\_ModifyAdvertised}, to modify any of the mirrored Fields in their Import/ExportState. After this the initialization sequence continues as usual. Since fields to be mirrored have been advertised with matching Standard Names, the field pairing algorithm will now match them in the usual way thereby establishing a connection between the original and mirrored fields. From f12522db0738eea366dc9c5d98065825875a9995 Mon Sep 17 00:00:00 2001 From: Robert Oehmke Date: Mon, 2 Dec 2024 17:29:21 -0700 Subject: [PATCH 154/207] Fix issue with parallel 2nd order conservative on XGrid. --- .../Mesh/src/Regridding/ESMCI_Interp.C | 3 +- .../XGrid/tests/ESMF_XGridUTest.F90 | 775 ++++++++++++++++-- 2 files changed, 708 insertions(+), 70 deletions(-) diff --git a/src/Infrastructure/Mesh/src/Regridding/ESMCI_Interp.C b/src/Infrastructure/Mesh/src/Regridding/ESMCI_Interp.C index 1af27f9302..91766d8c2e 100644 --- a/src/Infrastructure/Mesh/src/Regridding/ESMCI_Interp.C +++ b/src/Infrastructure/Mesh/src/Regridding/ESMCI_Interp.C @@ -3042,8 +3042,9 @@ interp_method(imethod) } else { // If 2nd order see if it's an XGrid and then use that if (interp_method == Interp::INTERP_CONSERVE_2ND) { + // If an XGrid is involved, then do a search using that - if ((grend.GetSrcRend().side==3) || (grend.GetSrcRend().side==3)) { + if ((grend.GetSrcRend().side==3) || (grend.GetDstRend().side==3)) { XGridGatherOverlappingElems(grend.GetSrcRend(), grend.GetDstRend(), sres); } else { // ...otherwise just use the regular search OctSearchElems(grend.GetSrcRend(), ESMCI_UNMAPPEDACTION_IGNORE, grend.GetDstRend(), unmappedaction, 1e-8, sres); diff --git a/src/Infrastructure/XGrid/tests/ESMF_XGridUTest.F90 b/src/Infrastructure/XGrid/tests/ESMF_XGridUTest.F90 index df0fe5807e..699fbfca12 100644 --- a/src/Infrastructure/XGrid/tests/ESMF_XGridUTest.F90 +++ b/src/Infrastructure/XGrid/tests/ESMF_XGridUTest.F90 @@ -204,6 +204,15 @@ program ESMF_XGridUTest write(name, *) "Test 2nd order on an XGrid between Meshes" call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE) + ! !------------------------------------------------------------------------ + ! !NEX_UTest + ! ! Create an XGrid in 2D from Cartesian Meshes with user supplied area + ! call test_CartMeshToMesh_2nd(rc) + ! write(failMsg, *) "" + ! write(name, *) "Test 2nd order on an XGrid between Cartesian Meshes" + ! call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE) + + #if 0 !------------------------------------------------------------------------ !NEX_UTest @@ -2823,6 +2832,7 @@ subroutine test_MeshToMesh_2nd(rc) integer :: localrc type(ESMF_Mesh) :: srcMesh type(ESMF_Mesh) :: dstMesh + type(ESMF_Mesh) :: xgridMesh type(ESMF_XGrid) :: xgrid type(ESMF_Field) :: srcField type(ESMF_Field) :: dstField @@ -2860,7 +2870,7 @@ subroutine test_MeshToMesh_2nd(rc) ! result code integer :: finalrc - + ! Init to success rc=ESMF_SUCCESS itrp=.true. @@ -2884,6 +2894,8 @@ subroutine test_MeshToMesh_2nd(rc) return endif +! 11/25/2024 + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !!!!!!!!!!!!!!!! Setup Source !!!!!!!!!!!!! @@ -3079,12 +3091,11 @@ subroutine test_MeshToMesh_2nd(rc) deallocate(ownedElemCoords) -#if 0 +#if 1 call ESMF_MeshWrite(srcMesh,"srcMesh") call ESMF_MeshWrite(dstMesh,"dstMesh") #endif - #define USE_XGRID #ifdef USE_XGRID @@ -3099,6 +3110,15 @@ subroutine test_MeshToMesh_2nd(rc) if (ESMF_LogFoundError(localrc, & ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return + + + call ESMF_XGridGet(xgrid, mesh=xgridMesh, rc=localrc) + if (ESMF_LogFoundError(localrc, & + ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, rcToReturn=rc)) return + + call ESMF_MeshWrite(xgridMesh,"xgridMesh") + ! Field on XGrid xField = ESMF_FieldCreate(xgrid, arrayspec, & @@ -3107,7 +3127,6 @@ subroutine test_MeshToMesh_2nd(rc) ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return - ! Regrid store call ESMF_FieldRegridStore( & xgrid, & @@ -3121,9 +3140,10 @@ subroutine test_MeshToMesh_2nd(rc) ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return + call ESMF_FieldRegridStore( & - xgrid, & - xField, & + xgrid, & + xField, & dstField=dstField, & routeHandle=XToDrouteHandle, & regridmethod=ESMF_REGRIDMETHOD_CONSERVE_2ND, & @@ -3132,7 +3152,7 @@ subroutine test_MeshToMesh_2nd(rc) if (ESMF_LogFoundError(localrc, & ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return - + ! Do regrid call ESMF_FieldRegrid(srcField, xField, StoXrouteHandle, & rc=localrc) @@ -3356,7 +3376,7 @@ subroutine test_MeshToMesh_2nd(rc) ! Uncomment these calls to see some actual regrid results if (localPet == 0) then write(*,*) - write(*,*) "=== Second Order Conservative Mesh to Mesh via XGrid ===" + write(*,*) "=== Second Order Conservative between Spherical Meshes via XGrid ===" write(*,*) "Conservation:" write(*,*) "Rel Error = ", ABS(dstmassg(1)-srcmassg(1))/srcmassg(1) write(*,*) "SRC mass = ", srcmassg(1) @@ -3427,87 +3447,704 @@ subroutine test_MeshToMesh_2nd(rc) end subroutine test_MeshToMesh_2nd - function calc_lat(i,imax,dy) - integer :: i, imax - real(ESMF_KIND_R8) :: calc_lat - real(ESMF_KIND_R8) :: dy - - if (i .eq. 1) then - calc_lat = -90.0 - else if (i .eq. imax) then - calc_lat = 90.0 - else - calc_lat = REAL(i-1)*dy - 0.5*dy - 90.0 - endif - end function calc_lat - - - subroutine test_CSGridToGrid_2nd(rc) + ! Test 2nd order regridding on Cartesian meshes using an XGrid + subroutine test_CartMeshToMesh_2nd(rc) #undef ESMF_METHOD -#define ESMF_METHOD "test_CSGridToGrid_2nd" - integer, intent(out) :: rc - logical :: itrp - logical :: csrv - integer :: localrc - type(ESMF_Grid) :: srcGrid - type(ESMF_Grid) :: dstGrid +#define ESMF_METHOD "test_MeshToMesh_2nd" + integer, intent(out) :: rc + logical :: itrp + logical :: csrv + integer :: localrc + type(ESMF_Mesh) :: srcMesh + type(ESMF_Mesh) :: dstMesh type(ESMF_XGrid) :: xgrid type(ESMF_Field) :: srcField type(ESMF_Field) :: dstField type(ESMF_Field) :: xdstField - type(ESMF_Field) :: errorField type(ESMF_Field) :: xField - type(ESMF_Field) :: srcArea, dstArea - type(ESMF_Array) :: dstArray - type(ESMF_Array) :: xdstArray - type(ESMF_Array) :: errorArray - type(ESMF_Array) :: srcArray - type(ESMF_Array) :: srcAreaArray, dstAreaArray + type(ESMF_Field) :: srcAreaField, dstAreaField + type(ESMF_Field) :: srcFracField, dstFracField type(ESMF_RouteHandle) :: StoXrouteHandle type(ESMF_RouteHandle) :: XtoDrouteHandle type(ESMF_RouteHandle) :: routeHandle type(ESMF_ArraySpec) :: arrayspec - type(ESMF_VM) :: vm - real(ESMF_KIND_R8), pointer :: farrayPtrXC(:,:) - real(ESMF_KIND_R8), pointer :: farrayPtrYC(:,:) - real(ESMF_KIND_R8), pointer :: farrayPtr(:,:),xfarrayPtr(:,:),errorfarrayPtr(:,:),iwtsptr(:,:) - real(ESMF_KIND_R8), pointer :: srcAreaptr(:,:), dstAreaptr(:,:) - integer :: petMap2D(2,2,1) - integer :: clbnd(2),cubnd(2) - integer :: fclbnd(2),fcubnd(2) - integer :: i1,i2, index(2) - integer :: lDE, i - integer :: srclocalDECount, dstlocalDECount - - integer :: src_tile_size - integer :: Src_nx, Src_ny - integer :: Dst_nx, Dst_ny - real(ESMF_KIND_R8) :: Src_dx, Src_dy, yp1 - real(ESMF_KIND_R8) :: Dst_dx, Dst_dy - real(ESMF_KIND_R8) :: ctheta, stheta - real(ESMF_KIND_R8) :: theta, d2rad, x, y, z - real(ESMF_KIND_R8) :: DEG2RAD, a, lat, lon, phi - real(ESMF_KIND_R8) :: xtmp, ytmp, ztmp + type(ESMF_VM) :: vm + real(ESMF_KIND_R8), pointer :: srcFarrayPtr(:), dstFarrayPtr(:), xdstFarrayPtr(:) + real(ESMF_KIND_R8), pointer :: srcAreaPtr(:), dstAreaPtr(:) + real(ESMF_KIND_R8), pointer :: srcFracPtr(:), dstFracPtr(:) + integer :: clbnd(1),cubnd(1) + integer :: i1,i2,i3 + real(ESMF_KIND_R8) :: x,y,z + real(ESMF_KIND_R8) :: lat, lon, phi, theta + real(ESMF_KIND_R8),parameter :: & + DEG2RAD = 3.141592653589793_ESMF_KIND_R8/180.0_ESMF_KIND_R8 + integer :: localPet, petCount real(ESMF_KIND_R8) :: srcmass(1), dstmass(1), srcmassg(1), dstmassg(1) real(ESMF_KIND_R8) :: maxerror(1), minerror(1), error real(ESMF_KIND_R8) :: maxerrorg(1), minerrorg(1), errorg - integer :: localPet, petCount - - ! init success flag + + real(ESMF_KIND_R8) :: errorTot, errorTotG, dstVal + + integer :: num_errorTot + real(ESMF_KIND_R8) :: l_errorTot(1),g_errorTot(1) + integer :: l_num_errorTot(1), g_num_errorTot(1) + + integer :: numOwnedElems + real(ESMF_KIND_R8), pointer :: ownedElemCoords(:) + + ! result code + integer :: finalrc + + ! Init to success rc=ESMF_SUCCESS + itrp=.true. + csrv=.true. ! get pet info call ESMF_VMGetGlobal(vm, 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_VMGet(vm, petCount=petCount, localPet=localpet, rc=localrc) - if (ESMF_LogFoundError(localrc, & - ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, rcToReturn=rc)) return - ! XMRKX + if (ESMF_LogFoundError(localrc, & + ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, rcToReturn=rc)) return + + + ! If we don't have 1 or 2 PETS then exit unsuccessfully + if ((petCount .ne. 1) .and. (petCount .ne. 2)) then + rc=ESMF_FAILURE + return + endif + + + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !!!!!!!!!!!!!!!! Setup Source !!!!!!!!!!!!! + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + + ! Create Source Mesh + call CreateTestMesh2x2_1(srcMesh, rc=localrc) ! Non-easy element create + if (ESMF_LogFoundError(localrc, & + ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, rcToReturn=rc)) return + + + ! Array spec for fields + call ESMF_ArraySpecSet(arrayspec, 1, ESMF_TYPEKIND_R8, rc=localrc) + if (ESMF_LogFoundError(localrc, & + ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, rcToReturn=rc)) return + + ! Create source field + srcField = ESMF_FieldCreate(srcMesh, arrayspec, meshloc=ESMF_MESHLOC_ELEMENT, & + name="source", rc=localrc) + if (ESMF_LogFoundError(localrc, & + ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, rcToReturn=rc)) return + + ! Create source area field + srcAreaField = ESMF_FieldCreate(srcMesh, arrayspec, meshloc=ESMF_MESHLOC_ELEMENT, & + name="source_area", rc=localrc) + if (ESMF_LogFoundError(localrc, & + ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, rcToReturn=rc)) return + + ! Create source frac field + srcFracField = ESMF_FieldCreate(srcMesh, arrayspec, meshloc=ESMF_MESHLOC_ELEMENT, & + name="source_frac", rc=localrc) + if (ESMF_LogFoundError(localrc, & + ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, rcToReturn=rc)) return + + + ! Load test data into the source Field + ! Should only be 1 localDE + call ESMF_FieldGet(srcField, 0, srcFarrayPtr, rc=localrc) + if (ESMF_LogFoundError(localrc, & + ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, rcToReturn=rc)) return + + ! Set interpolated function + call ESMF_MeshGet(srcMesh, numOwnedElements=numOwnedElems, & + rc=localrc) + if (ESMF_LogFoundError(localrc, & + ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, rcToReturn=rc)) return + + ! Allocate space for coordinates + allocate(ownedElemCoords(2*numOwnedElems)) + + ! Set interpolated function + call ESMF_MeshGet(srcMesh, ownedElemCoords=ownedElemCoords, & + rc=localrc) + if (ESMF_LogFoundError(localrc, & + ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, rcToReturn=rc)) return + + + ! loop through and set field + do i1=1,numOwnedElems + + ! Get coords + lon=ownedElemCoords(2*i1-1) + lat=ownedElemCoords(2*i1) + + ! Set source function + theta = DEG2RAD*(lon) + phi = DEG2RAD*(90.-lat) + + x = cos(theta)*sin(phi) + y = sin(theta)*sin(phi) + z = cos(phi) + + srcFarrayPtr(i1) = x+y+z + !srcFarrayPtr(i1) = 1.0 + + enddo + + ! Deallocate space for coordinates + deallocate(ownedElemCoords) + + + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !!!!!!!!!!! Setup Destination !!!!!!!!!!!!! + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + + ! Create Destination Mesh + call CreateTestMesh2x2_2(dstMesh, rc=localrc) + if (ESMF_LogFoundError(localrc, & + ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, rcToReturn=rc)) return + + + ! Array spec + call ESMF_ArraySpecSet(arrayspec, 1, ESMF_TYPEKIND_R8, rc=localrc) + if (ESMF_LogFoundError(localrc, & + ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, rcToReturn=rc)) return + + ! Create dest. field + dstField = ESMF_FieldCreate(dstMesh, arrayspec, meshloc=ESMF_MESHLOC_ELEMENT, & + name="dest", rc=localrc) + if (ESMF_LogFoundError(localrc, & + ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, rcToReturn=rc)) return + + ! Create dest. area field + dstAreaField = ESMF_FieldCreate(dstMesh, arrayspec, meshloc=ESMF_MESHLOC_ELEMENT, & + name="dest_area", rc=localrc) + if (ESMF_LogFoundError(localrc, & + ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, rcToReturn=rc)) return + ! Create dest. frac field + dstFracField = ESMF_FieldCreate(dstMesh, arrayspec, meshloc=ESMF_MESHLOC_ELEMENT, & + name="dest_frac", rc=localrc) + if (ESMF_LogFoundError(localrc, & + ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, rcToReturn=rc)) return + + ! Create exact dest. field + xdstField = ESMF_FieldCreate(dstMesh, arrayspec, meshloc=ESMF_MESHLOC_ELEMENT, & + name="xdest", rc=localrc) + if (ESMF_LogFoundError(localrc, & + ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, rcToReturn=rc)) return + + + ! Init destination field to 0.0 + ! Should only be 1 localDE + call ESMF_FieldGet(dstField, 0, dstFarrayPtr, rc=localrc) + if (ESMF_LogFoundError(localrc, & + ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, rcToReturn=rc)) return + + + ! Init exact destination field + ! Should only be 1 localDE + call ESMF_FieldGet(xdstField, 0, xdstFarrayPtr, rc=localrc) + if (ESMF_LogFoundError(localrc, & + ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, rcToReturn=rc)) return + + + ! Set number of points in destination mesh + call ESMF_MeshGet(dstMesh, numOwnedElements=numOwnedElems, & + rc=localrc) + if (ESMF_LogFoundError(localrc, & + ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, rcToReturn=rc)) return + + ! Allocate space for coordinates + allocate(ownedElemCoords(2*numOwnedElems)) + + ! Set exact destination field + call ESMF_MeshGet(dstMesh, ownedElemCoords=ownedElemCoords, & + rc=localrc) + if (ESMF_LogFoundError(localrc, & + ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, rcToReturn=rc)) return + + ! loop through and set xfield + do i1=1,numOwnedElems + + ! Get coords + lon=ownedElemCoords(2*i1-1) + lat=ownedElemCoords(2*i1) + + ! Set exact dest function + theta = DEG2RAD*(lon) + phi = DEG2RAD*(90.-lat) + + x = cos(theta)*sin(phi) + y = sin(theta)*sin(phi) + z = cos(phi) + + xdstFarrayPtr(i1) = x+y+z + ! xdstFarrayPtr(i1) = 1.0 + + ! Init destination field to 0.0 + dstFarrayPtr(i1)=0.0 + + enddo + + ! Deallocate space for coordinates + deallocate(ownedElemCoords) + + +#if 0 + call ESMF_MeshWrite(srcMesh,"srcMesh") + call ESMF_MeshWrite(dstMesh,"dstMesh") +#endif + + +#define USE_XGRID +#ifdef USE_XGRID + +!write(*,*) "Using XGrid" + + + ! Create XGrid + xgrid = ESMF_XGridCreate(sideAMesh=(/srcMesh/), & + sideBMesh=(/dstMesh/), & + storeOverlay = .true., & + rc=localrc) + if (ESMF_LogFoundError(localrc, & + ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, rcToReturn=rc)) return + + ! Field on XGrid + xField = ESMF_FieldCreate(xgrid, arrayspec, & + name="xfield", rc=localrc) + if (ESMF_LogFoundError(localrc, & + ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, rcToReturn=rc)) return + + + ! Regrid store + call ESMF_FieldRegridStore( & + xgrid, & + srcField, & + dstField=xField, & + routeHandle=StoXrouteHandle, & + regridmethod=ESMF_REGRIDMETHOD_CONSERVE_2ND, & + srcFracField=srcFracField, & + rc=localrc) + if (ESMF_LogFoundError(localrc, & + ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, rcToReturn=rc)) return + + call ESMF_FieldRegridStore( & + xgrid, & + xField, & + dstField=dstField, & + routeHandle=XToDrouteHandle, & + regridmethod=ESMF_REGRIDMETHOD_CONSERVE_2ND, & + dstFracField=dstFracField, & + rc=localrc) + if (ESMF_LogFoundError(localrc, & + ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, rcToReturn=rc)) return + + ! Do regrid + call ESMF_FieldRegrid(srcField, xField, StoXrouteHandle, & + rc=localrc) + if (ESMF_LogFoundError(localrc, & + ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, rcToReturn=rc)) return + + call ESMF_FieldRegrid(xField, dstField, XToDrouteHandle, & + rc=localrc) + if (ESMF_LogFoundError(localrc, & + ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, rcToReturn=rc)) return + + ! Release routehandles + call ESMF_FieldRegridrelease(StoXrouteHandle, rc=localrc) + if (ESMF_LogFoundError(localrc, & + ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, rcToReturn=rc)) return + + call ESMF_FieldRegridRelease(XtoDrouteHandle, rc=localrc) + if (ESMF_LogFoundError(localrc, & + ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, rcToReturn=rc)) return + +#else + +!write(*,*) "NOT Using XGrid" + + !!! Regrid forward from the A grid to the B grid + ! Regrid store + call ESMF_FieldRegridStore( & + srcField, & + dstField=dstField, & + routeHandle=routeHandle, & + regridmethod=ESMF_REGRIDMETHOD_CONSERVE_2ND, & + dstFracField=dstFracField, & + srcFracField=srcFracField, & + unmappedaction=ESMF_UNMAPPEDACTION_IGNORE, & + rc=localrc) + if (ESMF_LogFoundError(localrc, & + ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, rcToReturn=rc)) return + + + ! Do regrid + call ESMF_FieldRegrid(srcField, dstField, routeHandle, & + rc=localrc) + if (ESMF_LogFoundError(localrc, & + ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, rcToReturn=rc)) return + + + call ESMF_FieldRegridRelease(routeHandle, rc=localrc) + if (ESMF_LogFoundError(localrc, & + ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, rcToReturn=rc)) return +#endif + + + + ! Get the integration weights + call ESMF_FieldRegridGetArea(srcAreaField, & + rc=localrc) + if (ESMF_LogFoundError(localrc, & + ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, rcToReturn=rc)) return + + ! Get the integration weights + call ESMF_FieldRegridGetArea(dstAreaField, & + rc=localrc) + if (ESMF_LogFoundError(localrc, & + ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, rcToReturn=rc)) return + + + ! Check if the values are close + minerror(1) = 100000. + maxerror(1) = 0. + error = 0. + errorTot=0.0 + num_errorTot=0 + dstmass = 0. + + ! get dst Field + call ESMF_FieldGet(dstField, 0, dstFarrayPtr, computationalLBound=clbnd, & + computationalUBound=cubnd, rc=localrc) + if (ESMF_LogFoundError(localrc, & + ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, rcToReturn=rc)) return + + ! get exact destination Field + call ESMF_FieldGet(xdstField, 0, xdstFarrayPtr, rc=localrc) + if (ESMF_LogFoundError(localrc, & + ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, rcToReturn=rc)) return + + + ! get dst area Field + call ESMF_FieldGet(dstAreaField, 0, dstAreaPtr, rc=localrc) + if (ESMF_LogFoundError(localrc, & + ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, rcToReturn=rc)) return + + ! get frac Field + call ESMF_FieldGet(dstFracField, 0, dstFracptr, rc=localrc) + if (ESMF_LogFoundError(localrc, & + ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, rcToReturn=rc)) return + + ! destination grid + !! check relative error + do i1=clbnd(1),cubnd(1) + + ! This is WRONG, shouldn't include Frac + ! dstmass = dstmass + dstFracptr(i1,i2)*dstAreaptr(i1)*fptr(i1) + + ! Instead do this + dstmass = dstmass + dstAreaptr(i1)*dstFarrayPtr(i1) + + ! If this destination cell isn't covered by a sig. amount of source, then don't compute error on it. + if (dstFracPtr(i1) .lt. 0.1) cycle + + ! write(*,*) i1,"::",dstFarrayPtr(i1),xdstFarrayPtr(i1) + + ! Since fraction isn't included in weights in this case, use it to modify dstField value, so + ! that it's correct for partial cells + if (dstFracPtr(i1) .ne. 0.0) then + dstVal=dstFarrayPtr(i1)/dstFracptr(i1) + else + dstVal=dstFarrayPtr(i1) + endif + + if (xdstFarrayPtr(i1) .ne. 0.0) then + error=ABS(dstVal - xdstFarrayPtr(i1))/ABS(xdstFarrayPtr(i1)) + else + error=ABS(dstVal - xdstFarrayPtr(i1)) + endif + + ! total error + errorTot=errorTot+error + num_errorTot=num_errorTot+1 + + ! min max error + if (error > maxerror(1)) then + maxerror(1) = error + endif + if (error < minerror(1)) then + minerror(1) = error + endif + + enddo + + srcmass(1) = 0. + + ! get src pointer + call ESMF_FieldGet(srcField, 0, srcFarrayPtr, computationalLBound=clbnd, & + computationalUBound=cubnd, rc=localrc) + if (ESMF_LogFoundError(localrc, & + ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, rcToReturn=rc)) return + + ! get src Field + call ESMF_FieldGet(srcAreaField, 0, srcAreaptr, rc=localrc) + if (ESMF_LogFoundError(localrc, & + ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, rcToReturn=rc)) return + + ! get frac Field + call ESMF_FieldGet(srcFracField, 0, srcFracptr, rc=localrc) + if (ESMF_LogFoundError(localrc, & + ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, rcToReturn=rc)) return + + do i1=clbnd(1),cubnd(1) + srcmass(1) = srcmass(1) + srcFracptr(i1)*srcAreaptr(i1)*srcFarrayPtr(i1) + enddo + + ! Init integrals + srcmassg(1) = 0. + dstmassg(1) = 0. + + call ESMF_VMAllReduce(vm, srcmass, srcmassg, 1, ESMF_REDUCE_SUM, rc=localrc) + if (ESMF_LogFoundError(localrc, & + ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, rcToReturn=rc)) return + + call ESMF_VMAllReduce(vm, dstmass, dstmassg, 1, ESMF_REDUCE_SUM, rc=localrc) + if (ESMF_LogFoundError(localrc, & + ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, rcToReturn=rc)) return + + call ESMF_VMAllReduce(vm, maxerror, maxerrorg, 1, ESMF_REDUCE_MAX, rc=localrc) + if (ESMF_LogFoundError(localrc, & + ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, rcToReturn=rc)) return + + call ESMF_VMAllReduce(vm, minerror, minerrorg, 1, ESMF_REDUCE_MIN, rc=localrc) + if (ESMF_LogFoundError(localrc, & + ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, rcToReturn=rc)) return + + l_errorTot(1)=errorTot + call ESMF_VMAllReduce(vm, l_errorTot, g_errorTot, 1, ESMF_REDUCE_SUM, rc=localrc) + if (ESMF_LogFoundError(localrc, & + ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, rcToReturn=rc)) return + + l_num_errorTot(1)=num_errorTot + call ESMF_VMAllReduce(vm, l_num_errorTot, g_num_errorTot, 1, ESMF_REDUCE_SUM, rc=localrc) + if (ESMF_LogFoundError(localrc, & + ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, rcToReturn=rc)) return + + ! return answer based on correct flags + csrv = .false. + if (ABS(dstmassg(1)-srcmassg(1))/srcmassg(1) < 1.0E-14) csrv = .true. + + itrp = .false. + if (maxerrorg(1) < 1.5E-2) itrp = .true. + + ! Uncomment these calls to see some actual regrid results + if (localPet == 0) then + write(*,*) + write(*,*) "=== Second Order Conservative between Cartesian Meshes via XGrid ===" + write(*,*) "Conservation:" + write(*,*) "Rel Error = ", ABS(dstmassg(1)-srcmassg(1))/srcmassg(1) + write(*,*) "SRC mass = ", srcmassg(1) + write(*,*) "DST mass = ", dstmassg(1) + write(*,*) " " + write(*,*) "Interpolation:" + write(*,*) "Max Error = ", maxerrorg(1) + write(*,*) "Min Error = ", minerrorg(1) + write(*,*) "Avg Error = ", g_errorTot(1)/g_num_errorTot(1) + write(*,*) " " + endif + + + ! Destroy the Fields + call ESMF_FieldDestroy(srcField, rc=localrc) + if (ESMF_LogFoundError(localrc, & + ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, rcToReturn=rc)) return + + call ESMF_FieldDestroy(dstField, rc=localrc) + if (ESMF_LogFoundError(localrc, & + ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, rcToReturn=rc)) return + + call ESMF_FieldDestroy(srcAreaField, rc=localrc) + if (ESMF_LogFoundError(localrc, & + ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, rcToReturn=rc)) return + + call ESMF_FieldDestroy(dstAreaField, rc=localrc) + if (ESMF_LogFoundError(localrc, & + ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, rcToReturn=rc)) return + + call ESMF_FieldDestroy(srcFracField, rc=localrc) + if (ESMF_LogFoundError(localrc, & + ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, rcToReturn=rc)) return + + call ESMF_FieldDestroy(dstFracField, rc=localrc) + if (ESMF_LogFoundError(localrc, & + ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, rcToReturn=rc)) return + + + call ESMF_FieldDestroy(xdstField, rc=localrc) + if (ESMF_LogFoundError(localrc, & + ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, rcToReturn=rc)) return + + ! Free the meshes + call ESMF_MeshDestroy(srcMesh, rc=localrc) + if (ESMF_LogFoundError(localrc, & + ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, rcToReturn=rc)) return + + call ESMF_MeshDestroy(dstMesh, rc=localrc) + if (ESMF_LogFoundError(localrc, & + ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, rcToReturn=rc)) return + + ! If either interpolation or conservation errors + ! are too large, then return failure + if (.not. itrp .or. .not. csrv) then + rc=ESMF_FAILURE + endif + + end subroutine test_CartMeshToMesh_2nd + + + + + + function calc_lat(i,imax,dy) + integer :: i, imax + real(ESMF_KIND_R8) :: calc_lat + real(ESMF_KIND_R8) :: dy + + if (i .eq. 1) then + calc_lat = -90.0 + else if (i .eq. imax) then + calc_lat = 90.0 + else + calc_lat = REAL(i-1)*dy - 0.5*dy - 90.0 + endif + end function calc_lat + + + subroutine test_CSGridToGrid_2nd(rc) +#undef ESMF_METHOD +#define ESMF_METHOD "test_CSGridToGrid_2nd" + integer, intent(out) :: rc + logical :: itrp + logical :: csrv + integer :: localrc + type(ESMF_Grid) :: srcGrid + type(ESMF_Grid) :: dstGrid + type(ESMF_XGrid) :: xgrid + type(ESMF_Field) :: srcField + type(ESMF_Field) :: dstField + type(ESMF_Field) :: xdstField + type(ESMF_Field) :: errorField + type(ESMF_Field) :: xField + type(ESMF_Field) :: srcArea, dstArea + type(ESMF_Array) :: dstArray + type(ESMF_Array) :: xdstArray + type(ESMF_Array) :: errorArray + type(ESMF_Array) :: srcArray + type(ESMF_Array) :: srcAreaArray, dstAreaArray + type(ESMF_RouteHandle) :: StoXrouteHandle + type(ESMF_RouteHandle) :: XtoDrouteHandle + type(ESMF_RouteHandle) :: routeHandle + type(ESMF_ArraySpec) :: arrayspec + type(ESMF_VM) :: vm + real(ESMF_KIND_R8), pointer :: farrayPtrXC(:,:) + real(ESMF_KIND_R8), pointer :: farrayPtrYC(:,:) + real(ESMF_KIND_R8), pointer :: farrayPtr(:,:),xfarrayPtr(:,:),errorfarrayPtr(:,:),iwtsptr(:,:) + real(ESMF_KIND_R8), pointer :: srcAreaptr(:,:), dstAreaptr(:,:) + integer :: petMap2D(2,2,1) + integer :: clbnd(2),cubnd(2) + integer :: fclbnd(2),fcubnd(2) + integer :: i1,i2, index(2) + integer :: lDE, i + integer :: srclocalDECount, dstlocalDECount + + integer :: src_tile_size + integer :: Src_nx, Src_ny + integer :: Dst_nx, Dst_ny + real(ESMF_KIND_R8) :: Src_dx, Src_dy, yp1 + real(ESMF_KIND_R8) :: Dst_dx, Dst_dy + real(ESMF_KIND_R8) :: ctheta, stheta + real(ESMF_KIND_R8) :: theta, d2rad, x, y, z + real(ESMF_KIND_R8) :: DEG2RAD, a, lat, lon, phi + real(ESMF_KIND_R8) :: xtmp, ytmp, ztmp + real(ESMF_KIND_R8) :: srcmass(1), dstmass(1), srcmassg(1), dstmassg(1) + real(ESMF_KIND_R8) :: maxerror(1), minerror(1), error + real(ESMF_KIND_R8) :: maxerrorg(1), minerrorg(1), errorg + integer :: localPet, petCount + + ! init success flag + rc=ESMF_SUCCESS + + ! get pet info + call ESMF_VMGetGlobal(vm, rc=localrc) + if (ESMF_LogFoundError(localrc, & + ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, rcToReturn=rc)) return + + call ESMF_VMGet(vm, petCount=petCount, localPet=localpet, rc=localrc) + if (ESMF_LogFoundError(localrc, & + ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, rcToReturn=rc)) return + + ! Establish the resolution of the grids src_tile_size=20 From 4fc1ba36d1c71517d1eee05523f04bc689556bb3 Mon Sep 17 00:00:00 2001 From: Robert Oehmke Date: Mon, 2 Dec 2024 17:47:52 -0700 Subject: [PATCH 155/207] Take out debug output. --- src/Infrastructure/Mesh/src/ESMCI_XGridUtil.C | 7 ------- src/Infrastructure/XGrid/tests/ESMF_XGridUTest.F90 | 14 +++++++------- 2 files changed, 7 insertions(+), 14 deletions(-) diff --git a/src/Infrastructure/Mesh/src/ESMCI_XGridUtil.C b/src/Infrastructure/Mesh/src/ESMCI_XGridUtil.C index 7de04666eb..93a4ce3ff5 100644 --- a/src/Infrastructure/Mesh/src/ESMCI_XGridUtil.C +++ b/src/Infrastructure/Mesh/src/ESMCI_XGridUtil.C @@ -2803,9 +2803,6 @@ void calc_wgts_from_xgrid_to_side_mesh(Mesh *src_xgrid_mesh, Mesh *dst_side_mesh void srcXGridGatherOverlappingElems(Mesh &srcXGridMesh, Mesh &dstMesh, SearchResult &result) { - printf("sXGE src side=%d src ind=%d\n",srcXGridMesh.side,srcXGridMesh.ind); - printf("sXGE dst side=%d dst ind=%d\n",dstMesh.side,dstMesh.ind); - // Get dst side mesh info int side=dstMesh.side; int ind=dstMesh.ind; @@ -2873,10 +2870,6 @@ void calc_wgts_from_xgrid_to_side_mesh(Mesh *src_xgrid_mesh, Mesh *dst_side_mesh void dstXGridGatherOverlappingElems(Mesh &srcMesh, Mesh &dstXGridMesh, SearchResult &result) { - printf("dXGE src side=%d src ind=%d\n",srcMesh.side,srcMesh.ind); - printf("dXGE dst side=%d dst ind=%d\n",dstXGridMesh.side,dstXGridMesh.ind); - - // Get dst side mesh info int side=srcMesh.side; int ind=srcMesh.ind; diff --git a/src/Infrastructure/XGrid/tests/ESMF_XGridUTest.F90 b/src/Infrastructure/XGrid/tests/ESMF_XGridUTest.F90 index 699fbfca12..67c5e72787 100644 --- a/src/Infrastructure/XGrid/tests/ESMF_XGridUTest.F90 +++ b/src/Infrastructure/XGrid/tests/ESMF_XGridUTest.F90 @@ -204,13 +204,13 @@ program ESMF_XGridUTest write(name, *) "Test 2nd order on an XGrid between Meshes" call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE) - ! !------------------------------------------------------------------------ - ! !NEX_UTest - ! ! Create an XGrid in 2D from Cartesian Meshes with user supplied area - ! call test_CartMeshToMesh_2nd(rc) - ! write(failMsg, *) "" - ! write(name, *) "Test 2nd order on an XGrid between Cartesian Meshes" - ! call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE) + !------------------------------------------------------------------------ + !NEX_UTest + ! Create an XGrid in 2D from Cartesian Meshes with user supplied area + call test_CartMeshToMesh_2nd(rc) + write(failMsg, *) "" + write(name, *) "Test 2nd order on an XGrid between Cartesian Meshes" + call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE) #if 0 From 589a9aec3e4dc7303262ca183d778ec8bc7499b6 Mon Sep 17 00:00:00 2001 From: Gerhard Theurich Date: Tue, 3 Dec 2024 16:19:11 -0800 Subject: [PATCH 156/207] Deal with top State Info attributes in StateReconcile(). Do this under ESMF_ReconcileMultiCompCase() and ESMF_ReconcileBruteForce(). However, there is an outstanding issue for an edge case under the `isNoop` condition. See comments in code for details. --- .../src/ESMF_StateReconcile.F90 | 167 ++++++++++++++---- 1 file changed, 134 insertions(+), 33 deletions(-) diff --git a/src/Superstructure/StateReconcile/src/ESMF_StateReconcile.F90 b/src/Superstructure/StateReconcile/src/ESMF_StateReconcile.F90 index 0db8c80fb0..667e4b7f9e 100644 --- a/src/Superstructure/StateReconcile/src/ESMF_StateReconcile.F90 +++ b/src/Superstructure/StateReconcile/src/ESMF_StateReconcile.F90 @@ -229,7 +229,8 @@ subroutine ESMF_StateReconcile(state, keywordEnforcer, vm, checkflag, rc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, rcToReturn=rc)) return call idesc%Update(state, "", rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, rcToReturn=rc)) return - call ESMF_LogWrite("state_json_before_reconcile="//ESMF_InfoDump(idesc%info), ESMF_LOGMSG_DEBUG, rc=localrc) + call ESMF_LogWrite("state_json_before_reconcile="// & + ESMF_InfoDump(idesc%info, indent=2), ESMF_LOGMSG_DEBUG, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, rcToReturn=rc)) return call idesc%Destroy(rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, rcToReturn=rc)) return @@ -274,34 +275,45 @@ subroutine ESMF_StateReconcile(state, keywordEnforcer, vm, checkflag, rc) #endif if (isNoop) then - ! successful early return because of NOOP condition - if (present(rc)) rc = ESMF_SUCCESS - return ! NOOP -> EARLY RETURN - endif - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - ! Go on to reconcile the State ! - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + ! Quick exit for Noop, but still must reconcile State level Info ! + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - if (profile) then - call ESMF_TraceRegionEnter("ESMF_StateReconcile_driver", rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & - rcToReturn=rc)) return - endif + !TODO: Only need to do the State level Info reconcile here for a very + !TODO: specific Noop case where no objects were added under a sub context, + !TODO: but top level State Attributes were set under the sub context. + !TODO: This is tricky to detect here, and to figure out which PET(s) + !TODO: to use for correct rootPets!! + !TODO: Luckily this is a very special edge case... and for now get away + !TODO: not handling it... but it could some day cause an issue!!! - call ESMF_StateReconcile_driver(state, vm=localvm, rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & - rcToReturn=rc)) return + else - if (profile) then - call ESMF_TraceRegionExit("ESMF_StateReconcile_driver", rc=localrc) + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + ! Go on to reconcile the State ! + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + + if (profile) then + call ESMF_TraceRegionEnter("ESMF_StateReconcile_driver", rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & + rcToReturn=rc)) return + endif + + call ESMF_StateReconcile_driver(state, vm=localvm, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & rcToReturn=rc)) return + + if (profile) then + call ESMF_TraceRegionExit("ESMF_StateReconcile_driver", rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & + rcToReturn=rc)) return + endif endif - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - ! Conditinally check the reconciled State for consistency across PETs ! - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + ! Conditionally check the reconciled State for consistency across PETs ! + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! if (localCheckFlag) then if (profile) then @@ -318,7 +330,9 @@ subroutine ESMF_StateReconcile(state, keywordEnforcer, vm, checkflag, rc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, rcToReturn=rc)) return call idesc%Update(state, "", rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, rcToReturn=rc)) return - jsonStr = "state_json_after_reassemble="//ESMF_InfoDump(idesc%info) + jsonStr = "state_json_after_reassemble="//& + ESMF_InfoDump(idesc%info, indent=2, rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, rcToReturn=rc)) return #ifdef RECONCILE_LOG_on call ESMF_LogWrite(jsonStr, ESMF_LOGMSG_DEBUG, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, rcToReturn=rc)) return @@ -702,8 +716,6 @@ subroutine ESMF_StateReconcile_driver(state, vm, rc) ! {\tt ESMF\_VM} will exchange information about objects which might ! only be known to one or more PETs, and ensure all PETs in this VM ! have a consistent view of the object list in this {\tt ESMF\_State}. -! \item[{[attreconflag]}] -! Flag to tell if Attribute reconciliation is to be done as well as data reconciliation ! \item[{[rc]}] ! Return code; equals {\tt ESMF\_SUCCESS} if there are no errors. ! \end{description} @@ -877,7 +889,8 @@ subroutine ESMF_StateReconcile_driver(state, vm, rc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, rcToReturn=rc)) return call idesc%Update(state, "", rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, rcToReturn=rc)) return - call ESMF_LogWrite("state_json_after_vmid="//ESMF_InfoDump(idesc%info), ESMF_LOGMSG_DEBUG, rc=localrc) + call ESMF_LogWrite("state_json_after_vmid="// & + ESMF_InfoDump(idesc%info, indent=2), ESMF_LOGMSG_DEBUG, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, rcToReturn=rc)) return call idesc%Destroy(rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, rcToReturn=rc)) return @@ -925,7 +938,8 @@ subroutine ESMF_StateReconcile_driver(state, vm, rc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, rcToReturn=rc)) return call idesc%Update(state, "", rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, rcToReturn=rc)) return - call ESMF_LogWrite("state_json_after_set_field_meta="//ESMF_InfoDump(idesc%info), ESMF_LOGMSG_DEBUG, rc=localrc) + call ESMF_LogWrite("state_json_after_set_field_meta="// & + ESMF_InfoDump(idesc%info, indent=2), ESMF_LOGMSG_DEBUG, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, rcToReturn=rc)) return call idesc%Destroy(rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, rcToReturn=rc)) return @@ -1385,6 +1399,8 @@ end subroutine ESMF_ReconcileSingleCompCase !BOPI ! !IROUTINE: ESMF_ReconcileSerializeAll ! +!TODO: This routine looks almost redundant to ESMF_StateSerialize()!!!!!!!!!! +! ! !INTERFACE: subroutine ESMF_ReconcileSerializeAll(state, itemList, itemCount, & attreconflag, siwrap, buffer, rc) @@ -1598,6 +1614,24 @@ subroutine ESMF_ReconcileSerializeAll(state, itemList, itemCount, & sizeBuffer = sizeBuffer + itemSize enddo + ! Size of the State's Base itself + call ESMF_BaseSerialize(state%statep%base, fakeBuffer, itemSize, & + attreconflag=attreconflag, inquireflag=inqflag, rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & + rcToReturn=rc)) return +#ifdef RECONCILE_LOG_on + block + character(160) :: msgStr + write(msgStr,*) "Serialize top State Base itself, size=", itemSize + call ESMF_LogWrite(msgStr, ESMF_LOGMSG_DEBUG, rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & + rcToReturn=rc)) return + end block +#endif + + ! Update buffer size by itemSize + sizeBuffer = sizeBuffer + itemSize + ! Get rid of fakeBuffer deallocate(fakeBuffer) @@ -1685,6 +1719,12 @@ subroutine ESMF_ReconcileSerializeAll(state, itemList, itemCount, & end select enddo + ! Serialize of the State's Base itself + call ESMF_BaseSerialize(state%statep%base, buffer, posBuffer, & + attreconflag=attreconflag, inquireflag=inqflag, rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & + rcToReturn=rc)) return + ! Return success rc = ESMF_SUCCESS @@ -1699,6 +1739,8 @@ end subroutine ESMF_ReconcileSerializeAll ! !INTERFACE: subroutine ESMF_ReconcileDeserializeAll(state, vm, attreconflag, buffer, rc) ! +!TODO: This routine looks almost redundant to ESMF_StateDeserialize()!!!!!!!!!! +! ! !ARGUMENTS: type (ESMF_State), intent(inout) :: state type (ESMF_VM), intent(in) :: vm @@ -1726,7 +1768,6 @@ subroutine ESMF_ReconcileDeserializeAll(state, vm, attreconflag, buffer, rc) !EOPI integer :: localrc - integer :: memstat type(ESMF_FieldBundle) :: fieldbundle type(ESMF_Field) :: field @@ -1737,7 +1778,6 @@ subroutine ESMF_ReconcileDeserializeAll(state, vm, attreconflag, buffer, rc) integer :: stateitem_type character(ESMF_MAXSTR) :: errstring character(ESMF_MAXSTR) :: name - integer :: localPet integer :: item, numNewItems integer :: itemType @@ -1750,11 +1790,6 @@ subroutine ESMF_ReconcileDeserializeAll(state, vm, attreconflag, buffer, rc) rcToReturn=rc)) return #endif - ! VM information for debug output - call ESMF_VMGet (vm, localPet=localPet, rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & - rcToReturn=rc)) return - ! Set start position of buffer posBuffer = 0 @@ -1906,6 +1941,48 @@ subroutine ESMF_ReconcileDeserializeAll(state, vm, attreconflag, buffer, rc) enddo + ! Deserialize the received State's Base itself and add to local top State + block + type(ESMF_Base) :: base_temp + type(ESMF_Info) :: base_info, base_temp_info + +#ifdef RECONCILE_LOG_on + block + character(160) :: msgStr + write(msgStr,*) "deserializing top State Base itself, pos =", posBuffer + call ESMF_LogWrite(msgStr, ESMF_LOGMSG_DEBUG, rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & + rcToReturn=rc)) return + end block +#endif + + base_temp = ESMF_BaseDeserializeWoGarbage(buffer, & + offset=posBuffer, attreconflag=attreconflag, rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & + rcToReturn=rc)) return + + call ESMF_BaseSetInitCreated(base_temp, rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & + rcToReturn=rc)) return + + call ESMF_InfoGetFromBase(base_temp, base_temp_info, rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & + rcToReturn=rc)) return + + call ESMF_InfoGetFromBase(state%statep%base, base_info, rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & + rcToReturn=rc)) return + + call ESMF_InfoUpdate(base_info, base_temp_info, recursive=.true., & + rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & + rcToReturn=rc)) return + + call ESMF_BaseDestroyWoGarbage(base_temp, rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & + rcToReturn=rc)) return + end block + ! Return success rc = ESMF_SUCCESS @@ -2174,6 +2251,30 @@ subroutine ESMF_ReconcileBruteForce(state, vm, attreconflag, siwrap, & ! ------------------------------------------------------------------------- if (meminfo) call ESMF_VMLogMemInfo ("after (8) Deserialize received objects and create proxies") + ! ------------------------------------------------------------------------- + ! (9) Attributes on the State itself + ! ------------------------------------------------------------------------- + if (profile) then + call ESMF_TraceRegionEnter("(9) Attributes on the State itself", rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & + rcToReturn=rc)) return + endif + ! ------------------------------------------------------------------------- + if (attreconflag == ESMF_ATTRECONCILE_ON) then + call ESMF_ReconcileExchgAttributes (state, vm, rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, & + rcToReturn=rc)) return + end if + ! ------------------------------------------------------------------------- + if (profile) then + call ESMF_TraceRegionExit("(9) Attributes on the State itself", rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & + rcToReturn=rc)) return + endif + ! ------------------------------------------------------------------------- + if (meminfo) call ESMF_VMLogMemInfo ("after (9) Attributes on the State itself") + ! Clean up if (associated (buffer_recv)) then From ce229b34fee1a2fa8decb7a050062819c0a371b8 Mon Sep 17 00:00:00 2001 From: Gerhard Theurich Date: Wed, 4 Dec 2024 13:44:40 -0800 Subject: [PATCH 157/207] Simplify, clean-up, robustify State class documentation/example. --- .../State/doc/State_refdoc.ctex | 2 +- src/Superstructure/State/doc/State_usage.tex | 20 +- src/Superstructure/State/doc/makefile | 2 +- .../State/examples/ESMF_StateEx.F90 | 212 ++++++------------ 4 files changed, 71 insertions(+), 165 deletions(-) diff --git a/src/Superstructure/State/doc/State_refdoc.ctex b/src/Superstructure/State/doc/State_refdoc.ctex index 3c83f42351..e14294dce7 100644 --- a/src/Superstructure/State/doc/State_refdoc.ctex +++ b/src/Superstructure/State/doc/State_refdoc.ctex @@ -21,7 +21,7 @@ \textheight 8.5in \addtolength{\oddsidemargin}{-.75in} \newcommand{\mytitle}{State Reference Manual} -\newcommand{\myauthors}{Walter Spector, Ben Koziol} +\newcommand{\myauthors}{Walter Spector, Ben Koziol, Gerhard Theurich} % these are temporary patches until something more % permanent is done to the protex script. \newlength{\oldparskip} diff --git a/src/Superstructure/State/doc/State_usage.tex b/src/Superstructure/State/doc/State_usage.tex index 167fdc4e51..5d73a51d15 100644 --- a/src/Superstructure/State/doc/State_usage.tex +++ b/src/Superstructure/State/doc/State_usage.tex @@ -8,8 +8,6 @@ % NASA Goddard Space Flight Center. % Licensed under the University of Illinois-NCSA License. -%\subsection{Use and Examples} - A Gridded Component generally has one associated import State and one export State. Generally the States associated with a Gridded Component will be created by @@ -41,7 +39,7 @@ is passed out through the argument list into a Coupler Component's run method. We recommend the convention that it enters the Coupler Component as the Coupler Component's -import State. Here is it transformed into a form +import State. Here the data is transformed into a form that another Gridded Component requires, and passed out of the Coupler Component as its export State. It can then be passed into the run method of a recipient Gridded Component @@ -78,19 +76,3 @@ qualities of the original object plus enough information for it to be a data source or destination for a regrid or data redistribution operation. - -\subsubsection{State create and destroy} - -States can be created and destroyed at any time during -application execution. The {\tt ESMF\_StateCreate()} routine -can take many different combinations of optional arguments. Refer -to the API description for all possible methods of creating a State. -An empty State can be created by providing only a name and type for -the intended State: - -{\tt state = ESMF\_StateCreate(name, stateintent=ESMF\_STATEINTENT\_IMPORT, rc=rc)} - -When finished with an {\tt ESMF\_State}, the {\tt ESMF\_StateDestroy} method -removes it. However, the objects inside the {\tt ESMF\_State} -created externally should be destroyed separately, -since objects can be added to more than one {\tt ESMF\_State}. diff --git a/src/Superstructure/State/doc/makefile b/src/Superstructure/State/doc/makefile index d0405746cc..58da8a06fa 100644 --- a/src/Superstructure/State/doc/makefile +++ b/src/Superstructure/State/doc/makefile @@ -31,7 +31,7 @@ TEXFILES_TO_MAKE += $(addsuffix _fapi.tex, $(basename $(notdir $(wildcard ../exa # These lists almost certainly will not be an exhastive list of # all of the dependent files, but even a partial listing will be helpfull. # -REFDOC_DEP_FILES = $(TEXFILES_TO_MAKE) +REFDOC_DEP_FILES = $(TEXFILES_TO_MAKE) State_desc.tex State_options.tex State_usage.tex State_rest.tex State_implnotes.tex State_obj.tex include $(ESMF_DIR)/makefile diff --git a/src/Superstructure/State/examples/ESMF_StateEx.F90 b/src/Superstructure/State/examples/ESMF_StateEx.F90 index 6ba1fc057d..5c4401a74c 100644 --- a/src/Superstructure/State/examples/ESMF_StateEx.F90 +++ b/src/Superstructure/State/examples/ESMF_StateEx.F90 @@ -22,19 +22,15 @@ program ESMF_StateEx use ESMF_TestMod implicit none -#define ESMF_ENABLESTATENEEDED - ! Local variables - integer :: rc - character(ESMF_MAXSTR) :: statename, bundlename, dataname - !type(ESMF_Field) :: field1 - type(ESMF_FieldBundle) :: bundle1, bundle2 - type(ESMF_State) :: state1, state2, state3 - integer :: finalrc - logical :: neededFlag - integer :: result = 0 ! all pass - character(ESMF_MAXSTR) :: testname - character(ESMF_MAXSTR) :: failMsg + integer :: rc + type(ESMF_State) :: state + type(ESMF_FieldBundle) :: bundle + type(ESMF_Field) :: field, field1, field2 + integer :: finalrc + integer :: result = 0 ! all pass + character(ESMF_MAXSTR) :: testname + character(ESMF_MAXSTR) :: failMsg finalrc = ESMF_SUCCESS @@ -47,191 +43,119 @@ program ESMF_StateEx !------------------------------------------------------------------------- !------------------------------------------------------------------------- - - call ESMF_Initialize(defaultlogfilename="StateEx.Log", & - logkindflag=ESMF_LOGKIND_MULTI, rc=rc) - -!------------------------------------------------------------------------- - print *, "State Example 1: Import State" - - ! This will probably be called from inside the Component Init code - statename = "Atmosphere" - state1 = ESMF_StateCreate(name=statename, & - stateintent=ESMF_STATEINTENT_IMPORT, rc=rc) - print *, "State Create returned, name = ", trim(statename) - - ! Data would be added here and the State reused inside the run - ! routine of a sequential application. - - print *, "State Example 1 finished" - if (rc.NE.ESMF_SUCCESS) finalrc = ESMF_FAILURE + logkindflag=ESMF_LOGKIND_MULTI, rc=rc) !------------------------------------------------------------------------- !BOE -!\subsubsection{Add items to a State} -! -! Creation of an empty {\tt ESMF\_State}, and adding an {\tt ESMF\_FieldBundle} -! to it. Note that the {\tt ESMF\_FieldBundle} does not get destroyed when -! the {\tt ESMF\_State} is destroyed; the {\tt ESMF\_State} only contains -! a reference to the objects it contains. It also does not make a copy; -! the original objects can be updated and code accessing them by using -! the {\tt ESMF\_State} will see the updated version. +!\subsubsection{Create a State and add items} +! +! Creation of an empty {\tt ESMF\_State}. Then adding an {\tt ESMF\_FieldBundle} +! to it. Note that the {\tt ESMF\_FieldBundle} is empty. +! The {\tt ESMF\_State} only contains a reference to the objects it contains. +! It does not make a copy; the original objects can be updated and code +! accessing them by using the {\tt ESMF\_State} will see the updated version. !EOE - - - ! Example 2: - ! - ! Create, Add Data, Query, then Destroy a State. - - print *, "State Example 2: Export State" - !BOC - statename = "Ocean" - state2 = ESMF_StateCreate(name=statename, & - stateintent=ESMF_STATEINTENT_EXPORT, rc=rc) + state = ESMF_StateCreate(name="Ocean", & + stateintent=ESMF_STATEINTENT_EXPORT, rc=rc) !EOC - - print *, "State Create returned, name = ", trim(statename) if (rc.NE.ESMF_SUCCESS) finalrc = ESMF_FAILURE !BOC - bundlename = "Temperature" - bundle1 = ESMF_FieldBundleCreate(name=bundlename, rc=rc) - print *, "FieldBundle Create returned", rc + bundle = ESMF_FieldBundleCreate(name="Surface Fields", rc=rc) !EOC if (rc.NE.ESMF_SUCCESS) finalrc = ESMF_FAILURE !BOC - call ESMF_StateAdd(state2, (/bundle1/), rc=rc) - print *, "StateAdd returned", rc + call ESMF_StateAdd(state, [bundle], rc=rc) !EOC if (rc.NE.ESMF_SUCCESS) finalrc = ESMF_FAILURE - ! Loop here, updating FieldBundle contents each time step - +!------------------------------------------------------------------------- +!BOE +!\subsubsection{Query a State for items and add more items} +! +! The objects contained in a State can be queried by name. +!EOE !BOC - call ESMF_StateDestroy(state2, rc=rc) + call ESMF_StateGet(state, itemName="Surface Fields", fieldbundle=bundle, & + rc=rc) !EOC - print *, "State Destroy returned", rc if (rc.NE.ESMF_SUCCESS) finalrc = ESMF_FAILURE +!BOE +! More objects can be created and added to the State. Here an empty Field is +! created and added to the State. +!EOE !BOC - call ESMF_FieldBundleDestroy(bundle1, rc=rc) + field = ESMF_FieldEmptyCreate(name="MyField", rc=rc) +!EOC + if (rc.NE.ESMF_SUCCESS) finalrc = ESMF_FAILURE +!BOC + call ESMF_StateAdd(state, [field], rc=rc) !EOC - print *, "FieldBundle Destroy returned", rc - print *, "State Example 2 finished" if (rc.NE.ESMF_SUCCESS) finalrc = ESMF_FAILURE - -!------------------------------------------------------------------------- !BOE -!\subsubsection{Add placeholders to a State} -! -! If a component could potentially produce a large number of optional -! items, one strategy is to add the names only of those objects to the -! {\tt ESMF\_State}. Other components can call framework routines to -! set the {\tt ESMF\_NEEDED} flag to indicate they require that data. -! The original component can query this flag and then produce only the -! data that is required by another component. +! Multiple objects of the same type can be added to the State at the same time. !EOE - - print *, "State Example 3: Export State with Placeholder" - - ! The producing Component creates the menu of data items available. !BOC - statename = "Ocean" - state3 = ESMF_StateCreate(name=statename, & - stateintent=ESMF_STATEINTENT_EXPORT, rc=rc) + field1 = ESMF_FieldEmptyCreate(name="field1", rc=rc) !EOC - print *, "State Create returned", rc, " name = ", trim(statename) if (rc.NE.ESMF_SUCCESS) finalrc = ESMF_FAILURE !BOC - dataname = "Downward wind:needed" - call ESMF_AttributeSet (state3, dataname, .false., rc=rc) + field2 = ESMF_FieldEmptyCreate(name="field2", rc=rc) !EOC - print *, "AttributeSet returned", rc, " name = ", trim(dataname) if (rc.NE.ESMF_SUCCESS) finalrc = ESMF_FAILURE !BOC - dataname = "Humidity:needed" - call ESMF_AttributeSet (state3, dataname, .false., rc=rc) + call ESMF_StateAdd(state, [field1, field2], rc=rc) !EOC - print *, "AttributeSet returned", rc, " name = ", trim(dataname) - - ! See next example for how this is used. - - print *, "State Example 3 finished" if (rc.NE.ESMF_SUCCESS) finalrc = ESMF_FAILURE !------------------------------------------------------------------------- -#if defined (ESMF_ENABLESTATENEEDED) !BOE -!\subsubsection{Mark an item {\tt NEEDED}} -! -! How to set the {\tt NEEDED} state of an item. +!\subsubsection{Removing items from a State} +! +! Objects contained in a State can be removed using the item name. !EOE - - print *, "State Example 4: Get/Set Needed flags in Export State" - - ! Given state3 from the previous example, the Coupler or Application - ! is given an opportunity to mark which data items are needed. - !BOC - dataname = "Downward wind:needed" - call ESMF_AttributeSet (state3, name=dataname, value=.true., rc=rc) + call ESMF_StateRemove(state, ["field1"], rc=rc) +!EOC + if (rc.NE.ESMF_SUCCESS) finalrc = ESMF_FAILURE +!BOE +! Notice that objects removed from a State are {\em not} destroyed by the +! {\tt ESMF\_StateRemove()} call. They must be destroyed explicitly when no +! longer needed. +!BOC + call ESMF_FieldDestroy(field1, rc=rc) !EOC - print *, "AttributeSet returned", rc if (rc.NE.ESMF_SUCCESS) finalrc = ESMF_FAILURE !------------------------------------------------------------------------- !BOE -!\subsubsection{Create a {\tt NEEDED} item} -! -! Query an item for the {\tt NEEDED} status, and creating an item on demand. -! Similar flags exist for "Ready", "Valid", and "Required for Restart", -! to mark each data item as ready, having been validated, or needed if the -! application is to be checkpointed and restarted. The flags are supported -! to help coordinate the data exchange between components. +!\subsubsection{Destroy a State} +! +! Once an {\tt ESMF\_State} is not longer needed, it should be destroyed. !EOE - - ! Query Needed flags, and add FieldBundle data - - print *, "State Example 5: Get/Set Needed flags in Export State, continued" - - ! Given state3 from the previous examples, the producing Component - ! can check the state to see what data items are required. - !BOC - dataname = "Downward wind:needed" - call ESMF_AttributeGet (state3, dataname, value=neededFlag, rc=rc) + call ESMF_StateDestroy(state, rc=rc) !EOC - if (rc.NE.ESMF_SUCCESS) finalrc = ESMF_FAILURE + if (rc.NE.ESMF_SUCCESS) finalrc = ESMF_FAILURE +!BOE +! Notice that objects contained in a State are {\em not} destroyed by the +! {\tt ESMF\_StateDestroy()} call. They must be destroyed explicitly when no +! longer needed. !BOC - if (rc == ESMF_SUCCESS .and. neededFlag) then - bundlename = dataname - bundle2 = ESMF_FieldBundleCreate(name=bundlename, rc=rc) + call ESMF_FieldBundleDestroy(bundle, rc=rc) !EOC - print *, "FieldBundle Create returned", rc, "name = ", trim(bundlename) - if (rc.NE.ESMF_SUCCESS) finalrc = ESMF_FAILURE + if (rc.NE.ESMF_SUCCESS) finalrc = ESMF_FAILURE !BOC - call ESMF_StateAdd(state3, (/bundle2/), rc=rc) + call ESMF_FieldDestroy(field, rc=rc) !EOC - print *, "StateAdd returned", rc - if (rc.NE.ESMF_SUCCESS) finalrc = ESMF_FAILURE + if (rc.NE.ESMF_SUCCESS) finalrc = ESMF_FAILURE !BOC - else - print *, "Data not marked as needed", trim(dataname) - endif + call ESMF_FieldDestroy(field2, rc=rc) !EOC - print *, "State Example 5 finished" -#endif - call ESMF_StateDestroy(state3, rc=rc) if (rc.NE.ESMF_SUCCESS) finalrc = ESMF_FAILURE - print *, "State Destroy returned", rc - -!------------------------------------------------------------------------- -! ! Similar flags exist for "Ready" and for "Valid" to mark each data -! ! item as ready or having been validated, to help synchronize data -! ! exchange between Components and Couplers. Also "Required for -! ! Restart". -!------------------------------------------------------------------------- +!=============================================================================== ! IMPORTANT: ESMF_STest() prints the PASS string and the # of processors in the log ! file that the scripts grep for. call ESMF_STest((finalrc.eq.ESMF_SUCCESS), testname, failMsg, result, ESMF_SRCLINE) From d24bbe16905b84a17529f55135ce9ad37a745f1d Mon Sep 17 00:00:00 2001 From: Robert Oehmke Date: Wed, 4 Dec 2024 15:00:51 -0700 Subject: [PATCH 158/207] Add optimization for Cartesian XGrids with 2nd order conservative. --- .../Mesh/include/Legacy/ESMCI_SM.h | 19 +- src/Infrastructure/Mesh/src/Legacy/ESMCI_SM.C | 307 +++++- .../src/Regridding/ESMCI_Conserve2ndInterp.C | 41 +- .../XGrid/tests/ESMF_XGridUTest.F90 | 932 +++++++++++++++++- 4 files changed, 1258 insertions(+), 41 deletions(-) diff --git a/src/Infrastructure/Mesh/include/Legacy/ESMCI_SM.h b/src/Infrastructure/Mesh/include/Legacy/ESMCI_SM.h index 7d64cdc2b3..74a3a6efc2 100644 --- a/src/Infrastructure/Mesh/include/Legacy/ESMCI_SM.h +++ b/src/Infrastructure/Mesh/include/Legacy/ESMCI_SM.h @@ -28,6 +28,21 @@ namespace ESMCI { std::vector *tmp_valid, std::vector *tmp_sintd_areas_out, std::vector *tmp_dst_areas_out, std::vector *sm_cells); + void create_dst_xgrid_SM_cells_2D_3D_sph(const MeshObj *src_elem, MEField<> *src_cfield, + std::vector dst_elems, MEField<> *dst_cfield, MEField<> * dst_mask_field, MEField<> * dst_frac2_field, + double *src_elem_area, + std::vector *valid, + std::vector *sintd_areas_out, std::vector *dst_areas_out, + std::vector *sm_cells); + + void create_src_xgrid_SM_cells_2D_3D_sph(const MeshObj *src_elem, MEField<> *src_cfield, + std::vector dst_elems, MEField<> *dst_cfield, MEField<> * dst_mask_field, MEField<> * dst_frac2_field, + double *src_elem_area, + std::vector *valid, + std::vector *sintd_areas_out, std::vector *dst_areas_out, + std::vector *sm_cells); + + void create_SM_cells_2D_2D_cart(const MeshObj *src_elem, MEField<> *src_cfield, std::vector dst_elems, MEField<> *dst_cfield, MEField<> * dst_mask_field, MEField<> * dst_frac2_field, @@ -37,14 +52,14 @@ namespace ESMCI { std::vector *tmp_valid, std::vector *tmp_sintd_areas_out, std::vector *tmp_dst_areas_out, std::vector *sm_cells); - void create_dst_xgrid_SM_cells_2D_3D_sph(const MeshObj *src_elem, MEField<> *src_cfield, + void create_dst_xgrid_SM_cells_2D_2D_cart(const MeshObj *src_elem, MEField<> *src_cfield, std::vector dst_elems, MEField<> *dst_cfield, MEField<> * dst_mask_field, MEField<> * dst_frac2_field, double *src_elem_area, std::vector *valid, std::vector *sintd_areas_out, std::vector *dst_areas_out, std::vector *sm_cells); - void create_src_xgrid_SM_cells_2D_3D_sph(const MeshObj *src_elem, MEField<> *src_cfield, + void create_src_xgrid_SM_cells_2D_2D_cart(const MeshObj *src_elem, MEField<> *src_cfield, std::vector dst_elems, MEField<> *dst_cfield, MEField<> * dst_mask_field, MEField<> * dst_frac2_field, double *src_elem_area, std::vector *valid, diff --git a/src/Infrastructure/Mesh/src/Legacy/ESMCI_SM.C b/src/Infrastructure/Mesh/src/Legacy/ESMCI_SM.C index 56512c72aa..28f9f676f4 100644 --- a/src/Infrastructure/Mesh/src/Legacy/ESMCI_SM.C +++ b/src/Infrastructure/Mesh/src/Legacy/ESMCI_SM.C @@ -549,6 +549,311 @@ namespace ESMCI { } + // This method creates sm cells for a 2nd order interpolation going from a side mesh to an XGrid + // Since the destination is an XGrid by definition all the destination cells are the SM cells. + // Because of that, we just have to loop through the destination cells and fill in the SM + // info. + + // Here valid and wghts need to be resized to the same size as dst_elems before being passed into + // this call. + void create_dst_xgrid_SM_cells_2D_2D_cart(const MeshObj *src_elem, MEField<> *src_cfield, + std::vector dst_elems, MEField<> *dst_cfield, MEField<> * dst_mask_field, MEField<> * dst_frac2_field, + double *src_elem_area, + std::vector *valid, + std::vector *sintd_areas_out, std::vector *dst_areas_out, + std::vector *sm_cells) { +// Maximum size for a supported polygon +// Since the elements are of a small +// limited size. Fixed sized buffers seem +// the best way to handle them + +#define MAX_NUM_SRC_POLY_NODES 40 +#define MAX_NUM_SRC_POLY_COORDS_2D (2*MAX_NUM_SRC_POLY_NODES) + + // Declaration for src polygon + int num_src_nodes; + double src_coords[MAX_NUM_SRC_POLY_COORDS_2D]; + double tmp_coords[MAX_NUM_SRC_POLY_COORDS_2D]; + + // Get src coords + get_elem_coords_2D_ccw(src_elem, src_cfield, MAX_NUM_SRC_POLY_NODES, tmp_coords, &num_src_nodes, src_coords); + + // Get rid of degenerate edges + remove_0len_edges2D(&num_src_nodes, src_coords); + + // If less than a triangle invalidate everything and leave because it won't results in weights + // Decision about returning error for degeneracy is made above this subroutine + if (num_src_nodes<3) { + *src_elem_area=0.0; + for (int i=0; idata(*dst_elem); + if (*msk>0.5) { + // Init to 0's above + continue; + } + } + + // Invalidate creeped out dst element + if(dst_frac2_field){ + double *dst_frac2=dst_frac2_field->data(*dst_elem); + if (*dst_frac2 == 0.0){ + // Init to 0's above + continue; + } + } + + // Get dst coords + get_elem_coords_2D_ccw(dst_elem, dst_cfield, MAX_NUM_DST_POLY_NODES, tmp_coords, &num_dst_nodes, dst_coords); + + // Get rid of degenerate edges + remove_0len_edges2D(&num_dst_nodes, dst_coords); + + // if less than a triangle skip + if (num_dst_nodes<3) { + // Init to 0's above + continue; + } + + // if a smashed quad skip + if (is_smashed_quad2D(num_dst_nodes, dst_coords)) { + // Init to 0's above + continue; + } + + // Put dst cell information directly into SM cells and list + + // Calculate dst area + double dst_area=area_of_flat_2D_polygon(num_dst_nodes, dst_coords); + + // Declare temporary supermesh cell info structure + SM_CELL tmp_smc; + + // Add destination cell index + tmp_smc.dst_index=i; + + // Add area to supermesh cell info + tmp_smc.area=dst_area; + + // Add centroid to supermesh cell info + _calc_centroid_2D_2D_cart(num_dst_nodes, dst_coords, tmp_smc.cntr); + + // Add to list + sm_cells->push_back(tmp_smc); + + // Set information into other lists + (*valid)[i]=1; + (*sintd_areas_out)[i]=dst_area; // because dst is XGrid sintd area = dst area + (*dst_areas_out)[i]=dst_area; + +#undef MAX_NUM_DST_POLY_NODES +#undef MAX_NUM_DST_POLY_COORDS_2D + } + + + +#undef MAX_NUM_SRC_POLY_NODES +#undef MAX_NUM_SRC_POLY_COORDS_2D + } + + + // This method creates sm cells for a 2nd order interpolation going from an XGrid to a side mesh + // Since the source is an XGrid by definition the source cell is the SM cell. + // Because of that, we just have to set the + + // Here valid and wghts need to be resized to the same size as dst_elems before being passed into + // this call. + void create_src_xgrid_SM_cells_2D_2D_cart(const MeshObj *src_elem, MEField<> *src_cfield, + std::vector dst_elems, MEField<> *dst_cfield, MEField<> * dst_mask_field, MEField<> * dst_frac2_field, + double *src_elem_area, + std::vector *valid, + std::vector *sintd_areas_out, std::vector *dst_areas_out, + std::vector *sm_cells) { + + +// Maximum size for a supported polygon +// Since the elements are of a small +// limited size. Fixed sized buffers seem +// the best way to handle them + +#define MAX_NUM_SRC_POLY_NODES 40 +#define MAX_NUM_SRC_POLY_COORDS_2D (2*MAX_NUM_SRC_POLY_NODES) + + // Declaration for src polygon + int num_src_nodes; + double src_coords[MAX_NUM_SRC_POLY_COORDS_2D]; + double tmp_coords[MAX_NUM_SRC_POLY_COORDS_2D]; + + // Get src coords + get_elem_coords_2D_ccw(src_elem, src_cfield, MAX_NUM_SRC_POLY_NODES, tmp_coords, &num_src_nodes, src_coords); + + // Get rid of degenerate edges + remove_0len_edges2D(&num_src_nodes, src_coords); + + // If less than a triangle invalidate everything and leave because it won't results in weights + // Decision about returning error for degeneracy is made above this subroutine + if (num_src_nodes<3) { + *src_elem_area=0.0; + for (int i=0; idata(*dst_elem); + if (*msk>0.5) { + // Init to 0's above + return; + } + } + + // Invalidate creeped out dst element + if(dst_frac2_field){ + double *dst_frac2=dst_frac2_field->data(*dst_elem); + if (*dst_frac2 == 0.0){ + // Init to 0's above + return; + } + } + + // Defs for dst polygon +#define MAX_NUM_DST_POLY_NODES 40 +#define MAX_NUM_DST_POLY_COORDS_2D (2*MAX_NUM_DST_POLY_NODES) + + // Declaration for dst polygon + int num_dst_nodes; + double dst_coords[MAX_NUM_DST_POLY_COORDS_2D]; + + // Get dst coords + get_elem_coords_2D_ccw(dst_elem, dst_cfield, MAX_NUM_DST_POLY_NODES, tmp_coords, &num_dst_nodes, dst_coords); + + // Get rid of degenerate edges + remove_0len_edges2D(&num_dst_nodes, dst_coords); + + // if less than a triangle skip + if (num_dst_nodes<3) { + // Init to 0's above + return; + } + + // if a smashed quad skip + if (is_smashed_quad2D(num_dst_nodes, dst_coords)) { + // Init to 0's above + return; + } + + // Calc dst area + double dst_area=area_of_flat_2D_polygon(num_dst_nodes, dst_coords); + + + // Dst looks ok, so put information into SM cell and lists + + // Declare temporary supermesh cell info structure + SM_CELL tmp_smc; + + // Add destination cell index + tmp_smc.dst_index=0; + + // Add area to supermesh cell info + tmp_smc.area=src_area; + + // Add centroid to supermesh cell info + _calc_centroid_2D_2D_cart(num_src_nodes, src_coords, tmp_smc.cntr); + + // Add to list + sm_cells->push_back(tmp_smc); + + // Set information into other lists + (*valid)[0]=1; + (*sintd_areas_out)[0]=src_area; // because src is XGrid sintd area = src area + (*dst_areas_out)[0]=dst_area; + + +#undef MAX_NUM_DST_POLY_NODES +#undef MAX_NUM_DST_POLY_COORDS_2D + +#undef MAX_NUM_SRC_POLY_NODES +#undef MAX_NUM_SRC_POLY_COORDS_2D + } + + + + //////////////// END CALC 2D 2D WEIGHTS ////////////////// @@ -1067,8 +1372,6 @@ namespace ESMCI { } - //////////////// END CALC 2D 3D WEIGHTS ////////////////// - // This method creates sm cells for a 2nd order interpolation going from a side mesh to an XGrid // Since the destination is an XGrid by definition all the destination cells are the SM cells. diff --git a/src/Infrastructure/Mesh/src/Regridding/ESMCI_Conserve2ndInterp.C b/src/Infrastructure/Mesh/src/Regridding/ESMCI_Conserve2ndInterp.C index ec11ea15d8..b24ce42113 100644 --- a/src/Infrastructure/Mesh/src/Regridding/ESMCI_Conserve2ndInterp.C +++ b/src/Infrastructure/Mesh/src/Regridding/ESMCI_Conserve2ndInterp.C @@ -507,14 +507,41 @@ namespace ESMCI { std::vector *nbrs ) { - // Create super mesh cells by intersecting src_elem and list of dst_elems - create_SM_cells_2D_2D_cart(src_elem, src_cfield, - dst_elems, dst_cfield, dst_mask_field, dst_frac2_field, - src_elem_area, - valid, sintd_areas_out, dst_areas_out, - tmp_valid, tmp_sintd_areas_out, tmp_dst_areas_out, - sm_cells); + // Create super mesh cells depending on situation + switch(xgrid_use) { + case XGRID_USE_NONE: + // Create super mesh cells by intersecting src_elem and list of dst_elems + create_SM_cells_2D_2D_cart(src_elem, src_cfield, + dst_elems, dst_cfield, dst_mask_field, dst_frac2_field, + src_elem_area, + valid, sintd_areas_out, dst_areas_out, + tmp_valid, tmp_sintd_areas_out, tmp_dst_areas_out, + sm_cells); + break; + case XGRID_USE_SRC: + // Create super mesh cells by getting src xgrid cell + create_src_xgrid_SM_cells_2D_2D_cart(src_elem, src_cfield, + dst_elems, dst_cfield, dst_mask_field, dst_frac2_field, + src_elem_area, + valid, sintd_areas_out, dst_areas_out, + sm_cells); + break; + + case XGRID_USE_DST: + // Create super mesh cells by getting dst xgrid cells + create_dst_xgrid_SM_cells_2D_2D_cart(src_elem, src_cfield, + dst_elems, dst_cfield, dst_mask_field, dst_frac2_field, + src_elem_area, + valid, sintd_areas_out, dst_areas_out, + sm_cells); + break; + + default: + Throw() << "Unrecognized xgrid use type."; + } + + // If there are no sm cells then leave if (sm_cells->empty()) return; diff --git a/src/Infrastructure/XGrid/tests/ESMF_XGridUTest.F90 b/src/Infrastructure/XGrid/tests/ESMF_XGridUTest.F90 index 67c5e72787..3dbdf5c912 100644 --- a/src/Infrastructure/XGrid/tests/ESMF_XGridUTest.F90 +++ b/src/Infrastructure/XGrid/tests/ESMF_XGridUTest.F90 @@ -3447,6 +3447,895 @@ subroutine test_MeshToMesh_2nd(rc) end subroutine test_MeshToMesh_2nd + + + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + ! + ! Creates the following mesh on + ! 1 or 4 PETs. Returns an error + ! if run on other than 1 or 4 PETs + ! + ! Mesh Ids + ! + ! 3.0 13 ------ 14 ------- 15 ------- 16 + ! | | | 10 / | + ! 2.5 | 7 | 8 | / | + ! | | | / 9 | + ! 2.0 9 ------- 10 ------- 11 ------- 12 + ! | | | | + ! 1.5 | 4 | 5 | 6 | + ! | | | | + ! 1.0 5 ------- 6 -------- 7 -------- 8 + ! | | | | + ! 0.5 | 1 | 2 | 3 | + ! | | | | + ! 0.0 1 ------- 2 -------- 3 -------- 4 + ! + ! 0.0 0.5 1.0 1.5 2.0 2.5 3.0 + ! + ! Node Ids at corners + ! Element Ids in centers + ! + !!!!! + ! + ! The owners for 1 PET are all Pet 0. + ! The owners for 4 PETs are as follows: + ! + ! Mesh Owners + ! + ! 3.0 2 ------- 2 -------- 3 -------- 3 + ! | | | 3 / | + ! | 2 | 2 | / | + ! | | | / 3 | + ! 2.0 2 ------- 2 -------- 3 -------- 3 + ! | | | | + ! | 2 | 2 | 3 | + ! | | | | + ! 1.0 0 ------- 0 -------- 1 -------- 1 + ! | | | | + ! | 0 | 1 | 1 | + ! | | | | + ! 0.0 0 ------- 0 -------- 1 -------- 1 + ! + ! 0.0 1.0 2.0 3.0 + ! + ! Node Owners at corners + ! Element Owners in centers + ! + +subroutine createTestMesh3x3Cart_1(mesh, rc) + type(ESMF_Mesh), intent(out) :: mesh + integer :: rc + + integer, pointer :: nodeIds(:),nodeOwners(:) + real(ESMF_KIND_R8), pointer :: nodeCoords(:) + real(ESMF_KIND_R8), pointer :: ownedNodeCoords(:) + integer :: numNodes, numOwnedNodes, numOwnedNodesTst + integer :: numElems,numOwnedElemsTst + integer :: numElemConns, numTriElems, numQuadElems + real(ESMF_KIND_R8), pointer :: elemCoords(:) + integer, pointer :: elemIds(:),elemTypes(:),elemConn(:) + integer, pointer :: elemMask(:) + integer :: petCount, localPet + type(ESMF_VM) :: vm + + + ! get global VM + call ESMF_VMGetGlobal(vm, rc=rc) + if (rc /= ESMF_SUCCESS) return + call ESMF_VMGet(vm, localPet=localPet, petCount=petCount, rc=rc) + if (rc /= ESMF_SUCCESS) return + + ! return with an error if not 1 or 4 PETs + if ((petCount /= 1) .and. (petCount /=4)) then + rc=ESMF_FAILURE + return + endif + + + ! Setup mesh info depending on the + ! number of PETs + if (petCount .eq. 1) then + + ! Fill in node data + numNodes=16 + + !! node ids + allocate(nodeIds(numNodes)) + nodeIds=(/1,2,3,4,5,6,7,8, & + 9,10,11,12,13,14,& + 15,16/) + + !! node Coords + allocate(nodeCoords(numNodes*2)) + nodeCoords=(/0.0,0.0, & ! 1 + 1.0,0.0, & ! 2 + 2.0,0.0, & ! 3 + 3.0,0.0, & ! 4 + 0.0,1.0, & ! 5 + 1.0,1.0, & ! 6 + 2.0,1.0, & ! 7 + 3.0,1.0, & ! 8 + 0.0,2.0, & ! 9 + 1.0,2.0, & ! 10 + 2.0,2.0, & ! 11 + 3.0,2.0, & ! 12 + 0.0,3.0, & ! 13 + 1.0,3.0, & ! 14 + 2.0,3.0, & ! 15 + 3.0,3.0 /) ! 16 + + + !! node owners + allocate(nodeOwners(numNodes)) + nodeOwners=0 ! everything on proc 0 + + + ! Fill in elem data + numTriElems=2 + numQuadElems=8 + numElems=numTriElems+numQuadElems + numElemConns=3*numTriElems+4*numQuadElems + + !! elem ids + allocate(elemIds(numElems)) + elemIds=(/1,2,3,4,5,6,7,8,9,10/) + + !! elem mask + allocate(elemMask(numElems)) + elemMask=(/0,0,1,0,0,0,0,0,0,0/) + + !! elem types + allocate(elemTypes(numElems)) + elemTypes=(/ESMF_MESHELEMTYPE_QUAD, & ! 1 + ESMF_MESHELEMTYPE_QUAD, & ! 2 + ESMF_MESHELEMTYPE_QUAD, & ! 3 + ESMF_MESHELEMTYPE_QUAD, & ! 4 + ESMF_MESHELEMTYPE_QUAD, & ! 5 + ESMF_MESHELEMTYPE_QUAD, & ! 6 + ESMF_MESHELEMTYPE_QUAD, & ! 7 + ESMF_MESHELEMTYPE_QUAD, & ! 8 + ESMF_MESHELEMTYPE_TRI, & ! 9 + ESMF_MESHELEMTYPE_TRI/) ! 10 + + !! elem coords + allocate(elemCoords(2*numElems)) + elemCoords=(/0.5,0.5, & ! 1 + 1.5,0.5, & ! 2 + 2.5,0.5, & ! 3 + 0.5,1.5, & ! 4 + 1.5,1.5, & ! 5 + 2.5,1.5, & ! 6 + 0.5,2.5, & ! 7 + 1.5,2.5, & ! 8 + 2.75,2.25,& ! 9 + 2.25,2.75/) ! 10 + + !! elem conn + allocate(elemConn(numElemConns)) + elemConn=(/1,2,6,5, & ! 1 + 2,3,7,6, & ! 2 + 3,4,8,7, & ! 3 + 5,6,10,9, & ! 4 + 6,7,11,10, & ! 5 + 7,8,12,11, & ! 6 + 9,10,14,13, & ! 7 + 10,11,15,14, & ! 8 + 11,12,16, & ! 9 + 11,16,15/) ! 10 + + else if (petCount .eq. 4) then + ! Setup mesh data depending on PET + if (localPet .eq. 0) then + + ! Fill in node data + numNodes=4 + + !! node ids + allocate(nodeIds(numNodes)) + nodeIds=(/1,2,5,6/) + + !! node Coords + allocate(nodeCoords(numNodes*2)) + nodeCoords=(/0.0,0.0, & ! 1 + 1.0,0.0, & ! 2 + 0.0,1.0, & ! 5 + 1.0,1.0 /) ! 6 + + !! node owners + allocate(nodeOwners(numNodes)) + nodeOwners=0 ! everything on proc 0 + + ! Fill in elem data + numTriElems=0 + numQuadElems=1 + numElems=numTriElems+numQuadElems + numElemConns=3*numTriElems+4*numQuadElems + + !! elem ids + allocate(elemIds(numElems)) + elemIds=(/1/) + + !! elem mask + allocate(elemMask(numElems)) + elemMask=(/0/) + + !! elem types + allocate(elemTypes(numElems)) + elemTypes=(/ESMF_MESHELEMTYPE_QUAD/) ! 1 + + !! elem coords + allocate(elemCoords(2*numElems)) + elemCoords=(/0.5,0.5/) ! 1 + + !! elem conn + allocate(elemConn(numElemConns)) + elemConn=(/1,2,4,3/) ! 1 + + else if (localPet .eq. 1) then + + ! Fill in node data + numNodes=6 + + !! node ids + allocate(nodeIds(numNodes)) + nodeIds=(/2,3,4,6,7,8/) + + !! node Coords + allocate(nodeCoords(numNodes*2)) + nodeCoords=(/1.0,0.0, & ! 2 + 2.0,0.0, & ! 3 + 3.0,0.0, & ! 4 + 1.0,1.0, & ! 6 + 2.0,1.0, & ! 7 + 3.0,1.0 /) ! 8 + + + + !! node owners + allocate(nodeOwners(numNodes)) + nodeOwners=(/0, & ! 2 + 1, & ! 3 + 1, & ! 4 + 0, & ! 6 + 1, & ! 7 + 1/) ! 8 + + ! Fill in elem data + numTriElems=0 + numQuadElems=2 + numElems=numTriElems+numQuadElems + numElemConns=3*numTriElems+4*numQuadElems + + !! elem ids + allocate(elemIds(numElems)) + elemIds=(/2,3/) + + !! elem mask + allocate(elemMask(numElems)) + elemMask=(/0,1/) + + !! elem types + allocate(elemTypes(numElems)) + elemTypes=(/ESMF_MESHELEMTYPE_QUAD, & ! 2 + ESMF_MESHELEMTYPE_QUAD/) ! 3 + + !! elem coords + allocate(elemCoords(2*numElems)) + elemCoords=(/1.5,0.5, & ! 2 + 2.5,0.5/) ! 3 + + + !! elem conn + allocate(elemConn(numElemConns)) + elemConn=(/1,2,5,4, & ! 2 + 2,3,6,5/) ! 3 + + else if (localPet .eq. 2) then + + ! Fill in node data + numNodes=9 + + !! node ids + allocate(nodeIds(numNodes)) + nodeIds=(/5,6,7, & + 9,10,11, & + 13,14,15/) + + + !! node Coords + allocate(nodeCoords(numNodes*2)) + nodeCoords=(/0.0,1.0, & ! 5 + 1.0,1.0, & ! 6 + 2.0,1.0, & ! 7 + 0.0,2.0, & ! 9 + 1.0,2.0, & ! 10 + 2.0,2.0, & ! 11 + 0.0,3.0, & ! 13 + 1.0,3.0, & ! 14 + 2.0,3.0/) ! 15 + + + !! node owners + allocate(nodeOwners(numNodes)) + nodeOwners=(/0, & ! 5 + 0, & ! 6 + 1, & ! 7 + 2, & ! 9 + 2, & ! 10 + 3, & ! 11 + 2, & ! 13 + 2, & ! 14 + 3/) ! 15 + + + ! Fill in elem data + numTriElems=0 + numQuadElems=4 + numElems=numTriElems+numQuadElems + numElemConns=3*numTriElems+4*numQuadElems + + !! elem ids + allocate(elemIds(numElems)) + elemIds=(/4,5,7,8/) + + !! elem mask + allocate(elemMask(numElems)) + elemMask=(/0,0,0,0/) + + !! elem types + allocate(elemTypes(numElems)) + elemTypes=(/ESMF_MESHELEMTYPE_QUAD, & ! 4 + ESMF_MESHELEMTYPE_QUAD, & ! 5 + ESMF_MESHELEMTYPE_QUAD, & ! 7 + ESMF_MESHELEMTYPE_QUAD/) ! 8 + + + !! elem coords + allocate(elemCoords(2*numElems)) + elemCoords=(/0.5,1.5, & ! 4 + 1.5,1.5, & ! 5 + 0.5,2.5, & ! 7 + 1.5,2.5/) ! 8 + + !! elem conn + allocate(elemConn(numElemConns)) + elemConn=(/1,2,5,4, & ! 4 + 2,3,6,5, & ! 5 + 4,5,8,7, & ! 7 + 5,6,9,8/) ! 8 + else if (localPet .eq. 3) then + + ! Fill in node data + numNodes=6 + + !! node ids + allocate(nodeIds(numNodes)) + nodeIds=(/7,8,11,12,15,16/) + + !! node Coords + allocate(nodeCoords(numNodes*2)) + nodeCoords=(/2.0,1.0, & ! 7 + 3.0,1.0, & ! 8 + 2.0,2.0, & ! 11 + 3.0,2.0, & ! 12 + 2.0,3.0, & ! 15 + 3.0,3.0 /) ! 16 + + + !! node owners + allocate(nodeOwners(numNodes)) + nodeOwners=(/1, & ! 7 + 1, & ! 8 + 3, & ! 11 + 3, & ! 12 + 3, & ! 15 + 3/) ! 16 + + ! Fill in elem data + numTriElems=2 + numQuadElems=1 + numElems=numTriElems+numQuadElems + numElemConns=3*numTriElems+4*numQuadElems + + !! elem ids + allocate(elemIds(numElems)) + elemIds=(/6,9,10/) + + !! elem mask + allocate(elemMask(numElems)) + elemMask=(/0,0,0/) + + !! elem types + allocate(elemTypes(numElems)) + elemTypes=(/ESMF_MESHELEMTYPE_QUAD, & ! 6 + ESMF_MESHELEMTYPE_TRI, & ! 9 + ESMF_MESHELEMTYPE_TRI/) ! 10 + + !! elem coords + allocate(elemCoords(2*numElems)) + elemCoords=(/2.5,1.5, & ! 6 + 2.75,2.25,& ! 9 + 2.25,2.75/) ! 10 + + !! elem conn + allocate(elemConn(numElemConns)) + elemConn=(/1,2,4,3, & ! 6 + 3,4,6, & ! 9 + 3,6,5/) ! 10 + endif + endif + + + ! Create Mesh structure in 1 step + mesh=ESMF_MeshCreate(parametricDim=2,spatialDim=2, & + coordSys=ESMF_COORDSYS_CART, & + nodeIds=nodeIds, nodeCoords=nodeCoords, & + nodeOwners=nodeOwners, elementIds=elemIds,& + elementTypes=elemTypes, elementConn=elemConn, & + elementCoords=elemCoords, elementMask=elemMask,& + rc=rc) + if (rc /= ESMF_SUCCESS) return + + ! deallocate node data + deallocate(nodeIds) + deallocate(nodeCoords) + deallocate(nodeOwners) + + ! deallocate elem data + deallocate(elemIds) + deallocate(elemTypes) + deallocate(elemCoords) + deallocate(elemConn) + +end subroutine createTestMesh3x3Cart_1 + + + + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + ! + ! Creates the following mesh on + ! 1 or 4 PETs. Returns an error + ! if run on other than 1 or 4 PETs + ! + ! Mesh Ids + ! + ! 3.0 13 ------ 14 ------- 15 ------- 16 + ! | | | 10 / | + ! 2.5 | 7 | 8 | / | + ! | | | / 9 | + ! 2.0 9 ------- 10 ------- 11 ------- 12 + ! | | | | + ! 1.5 | 4 | 5 | 6 | + ! | | | | + ! 1.0 5 ------- 6 -------- 7 -------- 8 + ! | | | | + ! 0.5 | 1 | 2 | 3 | + ! | | | | + ! 0.0 1 ------- 2 -------- 3 -------- 4 + ! + ! 0.0 0.5 1.0 1.5 2.0 2.5 3.0 + ! + ! Node Ids at corners + ! Element Ids in centers + ! + !!!!! + ! + ! The owners for 1 PET are all Pet 0. + ! The owners for 4 PETs are as follows: + ! + ! Mesh Owners + ! + ! 3.0 2 ------- 2 -------- 3 -------- 3 + ! | | | 3 / | + ! | 2 | 2 | / | + ! | | | / 3 | + ! 2.0 2 ------- 2 -------- 3 -------- 3 + ! | | | | + ! | 2 | 2 | 3 | + ! | | | | + ! 1.0 0 ------- 0 -------- 1 -------- 1 + ! | | | | + ! | 0 | 1 | 1 | + ! | | | | + ! 0.0 0 ------- 0 -------- 1 -------- 1 + ! + ! 0.0 1.0 2.0 3.0 + ! + ! Node Owners at corners + ! Element Owners in centers + ! + +subroutine createTestMesh3x3Cart_2(mesh, rc) + type(ESMF_Mesh), intent(out) :: mesh + integer :: rc + + integer, pointer :: nodeIds(:),nodeOwners(:) + real(ESMF_KIND_R8), pointer :: nodeCoords(:) + real(ESMF_KIND_R8), pointer :: ownedNodeCoords(:) + integer :: numNodes, numOwnedNodes, numOwnedNodesTst + integer :: numElems,numOwnedElemsTst + integer :: numElemConns, numTriElems, numQuadElems + real(ESMF_KIND_R8), pointer :: elemCoords(:) + integer, pointer :: elemIds(:),elemTypes(:),elemConn(:) + integer, pointer :: elemMask(:) + integer :: petCount, localPet + type(ESMF_VM) :: vm + + + ! get global VM + call ESMF_VMGetGlobal(vm, rc=rc) + if (rc /= ESMF_SUCCESS) return + call ESMF_VMGet(vm, localPet=localPet, petCount=petCount, rc=rc) + if (rc /= ESMF_SUCCESS) return + + ! return with an error if not 1 or 4 PETs + if ((petCount /= 1) .and. (petCount /=4)) then + rc=ESMF_FAILURE + return + endif + + + ! Setup mesh info depending on the + ! number of PETs + if (petCount .eq. 1) then + + ! Fill in node data + numNodes=16 + + !! node ids + allocate(nodeIds(numNodes)) + nodeIds=(/1,2,3,4,5,6,7,8, & + 9,10,11,12,13,14,& + 15,16/) + + !! node Coords + allocate(nodeCoords(numNodes*2)) + nodeCoords=(/0.0,0.0, & ! 1 + 1.0,0.0, & ! 2 + 2.0,0.0, & ! 3 + 3.0,0.0, & ! 4 + 0.0,1.0, & ! 5 + 1.25,1.25, & ! 6 + 1.75,1.25, & ! 7 + 3.0,1.0, & ! 8 + 0.0,2.0, & ! 9 + 1.25,1.75, & ! 10 + 1.75,1.75, & ! 11 + 3.0,2.0, & ! 12 + 0.0,3.0, & ! 13 + 1.0,3.0, & ! 14 + 2.0,3.0, & ! 15 + 3.0,3.0 /) ! 16 + + + !! node owners + allocate(nodeOwners(numNodes)) + nodeOwners=0 ! everything on proc 0 + + + ! Fill in elem data + numTriElems=2 + numQuadElems=8 + numElems=numTriElems+numQuadElems + numElemConns=3*numTriElems+4*numQuadElems + + !! elem ids + allocate(elemIds(numElems)) + elemIds=(/1,2,3,4,5,6,7,8,9,10/) + + !! elem mask + allocate(elemMask(numElems)) + elemMask=(/1,0,0,0,0,0,0,0,0,0/) + + !! elem types + allocate(elemTypes(numElems)) + elemTypes=(/ESMF_MESHELEMTYPE_QUAD, & ! 1 + ESMF_MESHELEMTYPE_QUAD, & ! 2 + ESMF_MESHELEMTYPE_QUAD, & ! 3 + ESMF_MESHELEMTYPE_QUAD, & ! 4 + ESMF_MESHELEMTYPE_QUAD, & ! 5 + ESMF_MESHELEMTYPE_QUAD, & ! 6 + ESMF_MESHELEMTYPE_QUAD, & ! 7 + ESMF_MESHELEMTYPE_QUAD, & ! 8 + ESMF_MESHELEMTYPE_TRI, & ! 9 + ESMF_MESHELEMTYPE_TRI/) ! 10 + + !! elem coords + allocate(elemCoords(2*numElems)) + elemCoords=(/0.5,0.5, & ! 1 + 1.5,0.5, & ! 2 + 2.5,0.5, & ! 3 + 0.5,1.5, & ! 4 + 1.5,1.5, & ! 5 + 2.5,1.5, & ! 6 + 0.5,2.5, & ! 7 + 1.5,2.5, & ! 8 + 2.75,2.25,& ! 9 + 2.25,2.75/) ! 10 + + !! elem conn + allocate(elemConn(numElemConns)) + elemConn=(/1,2,6,5, & ! 1 + 2,3,7,6, & ! 2 + 3,4,8,7, & ! 3 + 5,6,10,9, & ! 4 + 6,7,11,10, & ! 5 + 7,8,12,11, & ! 6 + 9,10,14,13, & ! 7 + 10,11,15,14, & ! 8 + 11,12,16, & ! 9 + 11,16,15/) ! 10 + + else if (petCount .eq. 4) then + ! Setup mesh data depending on PET + if (localPet .eq. 0) then + + ! Fill in node data + numNodes=4 + + !! node ids + allocate(nodeIds(numNodes)) + nodeIds=(/1,2,5,6/) + + !! node Coords + allocate(nodeCoords(numNodes*2)) + nodeCoords=(/0.0,0.0, & ! 1 + 1.0,0.0, & ! 2 + 0.0,1.0, & ! 5 + 1.25,1.25 /) ! 6 + + !! node owners + allocate(nodeOwners(numNodes)) + nodeOwners=0 ! everything on proc 0 + + ! Fill in elem data + numTriElems=0 + numQuadElems=1 + numElems=numTriElems+numQuadElems + numElemConns=3*numTriElems+4*numQuadElems + + !! elem ids + allocate(elemIds(numElems)) + elemIds=(/1/) + + !! elem mask + allocate(elemMask(numElems)) + elemMask=(/1/) + + !! elem types + allocate(elemTypes(numElems)) + elemTypes=(/ESMF_MESHELEMTYPE_QUAD/) ! 1 + + !! elem coords + allocate(elemCoords(2*numElems)) + elemCoords=(/0.5,0.5/) ! 1 + + !! elem conn + allocate(elemConn(numElemConns)) + elemConn=(/1,2,4,3/) ! 1 + + else if (localPet .eq. 1) then + + ! Fill in node data + numNodes=6 + + !! node ids + allocate(nodeIds(numNodes)) + nodeIds=(/2,3,4,6,7,8/) + + !! node Coords + allocate(nodeCoords(numNodes*2)) + nodeCoords=(/1.0,0.0, & ! 2 + 2.0,0.0, & ! 3 + 3.0,0.0, & ! 4 + 1.25,1.25, & ! 6 + 1.75,1.25, & ! 7 + 3.0,1.0 /) ! 8 + + + + !! node owners + allocate(nodeOwners(numNodes)) + nodeOwners=(/0, & ! 2 + 1, & ! 3 + 1, & ! 4 + 0, & ! 6 + 1, & ! 7 + 1/) ! 8 + + ! Fill in elem data + numTriElems=0 + numQuadElems=2 + numElems=numTriElems+numQuadElems + numElemConns=3*numTriElems+4*numQuadElems + + !! elem ids + allocate(elemIds(numElems)) + elemIds=(/2,3/) + + !! elem mask + allocate(elemMask(numElems)) + elemMask=(/0,0/) + + !! elem types + allocate(elemTypes(numElems)) + elemTypes=(/ESMF_MESHELEMTYPE_QUAD, & ! 2 + ESMF_MESHELEMTYPE_QUAD/) ! 3 + + !! elem coords + allocate(elemCoords(2*numElems)) + elemCoords=(/1.5,0.5, & ! 2 + 2.5,0.5/) ! 3 + + + !! elem conn + allocate(elemConn(numElemConns)) + elemConn=(/1,2,5,4, & ! 2 + 2,3,6,5/) ! 3 + + else if (localPet .eq. 2) then + + ! Fill in node data + numNodes=9 + + !! node ids + allocate(nodeIds(numNodes)) + nodeIds=(/5,6,7, & + 9,10,11, & + 13,14,15/) + + + !! node Coords + allocate(nodeCoords(numNodes*2)) + nodeCoords=(/0.0,1.0, & ! 5 + 1.25,1.25, & ! 6 + 1.75,1.25, & ! 7 + 0.0,2.0, & ! 9 + 1.25,1.75, & ! 10 + 1.75,1.75, & ! 11 + 0.0,3.0, & ! 13 + 1.0,3.0, & ! 14 + 2.0,3.0/) ! 15 + + + !! node owners + allocate(nodeOwners(numNodes)) + nodeOwners=(/0, & ! 5 + 0, & ! 6 + 1, & ! 7 + 2, & ! 9 + 2, & ! 10 + 3, & ! 11 + 2, & ! 13 + 2, & ! 14 + 3/) ! 15 + + + ! Fill in elem data + numTriElems=0 + numQuadElems=4 + numElems=numTriElems+numQuadElems + numElemConns=3*numTriElems+4*numQuadElems + + !! elem ids + allocate(elemIds(numElems)) + elemIds=(/4,5,7,8/) + + !! elem mask + allocate(elemMask(numElems)) + elemMask=(/0,0,0,0/) + + !! elem types + allocate(elemTypes(numElems)) + elemTypes=(/ESMF_MESHELEMTYPE_QUAD, & ! 4 + ESMF_MESHELEMTYPE_QUAD, & ! 5 + ESMF_MESHELEMTYPE_QUAD, & ! 7 + ESMF_MESHELEMTYPE_QUAD/) ! 8 + + + !! elem coords + allocate(elemCoords(2*numElems)) + elemCoords=(/0.5,1.5, & ! 4 + 1.5,1.5, & ! 5 + 0.5,2.5, & ! 7 + 1.5,2.5/) ! 8 + + !! elem conn + allocate(elemConn(numElemConns)) + elemConn=(/1,2,5,4, & ! 4 + 2,3,6,5, & ! 5 + 4,5,8,7, & ! 7 + 5,6,9,8/) ! 8 + else if (localPet .eq. 3) then + + ! Fill in node data + numNodes=6 + + !! node ids + allocate(nodeIds(numNodes)) + nodeIds=(/7,8,11,12,15,16/) + + !! node Coords + allocate(nodeCoords(numNodes*2)) + nodeCoords=(/1.75,1.25, & ! 7 + 3.0,1.0, & ! 8 + 1.75,1.75, & ! 11 + 3.0,2.0, & ! 12 + 2.0,3.0, & ! 15 + 3.0,3.0 /) ! 16 + + + !! node owners + allocate(nodeOwners(numNodes)) + nodeOwners=(/1, & ! 7 + 1, & ! 8 + 3, & ! 11 + 3, & ! 12 + 3, & ! 15 + 3/) ! 16 + + ! Fill in elem data + numTriElems=2 + numQuadElems=1 + numElems=numTriElems+numQuadElems + numElemConns=3*numTriElems+4*numQuadElems + + !! elem ids + allocate(elemIds(numElems)) + elemIds=(/6,9,10/) + + !! elem mask + allocate(elemMask(numElems)) + elemMask=(/0,0,0/) + + !! elem types + allocate(elemTypes(numElems)) + elemTypes=(/ESMF_MESHELEMTYPE_QUAD, & ! 6 + ESMF_MESHELEMTYPE_TRI, & ! 9 + ESMF_MESHELEMTYPE_TRI/) ! 10 + + !! elem coords + allocate(elemCoords(2*numElems)) + elemCoords=(/2.5,1.5, & ! 6 + 2.75,2.25,& ! 9 + 2.25,2.75/) ! 10 + + !! elem conn + allocate(elemConn(numElemConns)) + elemConn=(/1,2,4,3, & ! 6 + 3,4,6, & ! 9 + 3,6,5/) ! 10 + endif + endif + + + ! Create Mesh structure in 1 step + mesh=ESMF_MeshCreate(parametricDim=2,spatialDim=2, & + coordSys=ESMF_COORDSYS_CART, & + nodeIds=nodeIds, nodeCoords=nodeCoords, & + nodeOwners=nodeOwners, elementIds=elemIds,& + elementTypes=elemTypes, elementConn=elemConn, & + elementCoords=elemCoords, elementMask=elemMask,& + rc=rc) + if (rc /= ESMF_SUCCESS) return + + ! deallocate node data + deallocate(nodeIds) + deallocate(nodeCoords) + deallocate(nodeOwners) + + ! deallocate elem data + deallocate(elemIds) + deallocate(elemMask) + deallocate(elemTypes) + deallocate(elemCoords) + deallocate(elemConn) + +end subroutine createTestMesh3x3Cart_2 + + + ! Test 2nd order regridding on Cartesian meshes using an XGrid subroutine test_CartMeshToMesh_2nd(rc) #undef ESMF_METHOD @@ -3524,7 +4413,7 @@ subroutine test_CartMeshToMesh_2nd(rc) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! Create Source Mesh - call CreateTestMesh2x2_1(srcMesh, rc=localrc) ! Non-easy element create + call createTestMesh3x3Cart_1(srcMesh, rc=localrc) if (ESMF_LogFoundError(localrc, & ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return @@ -3587,19 +4476,11 @@ subroutine test_CartMeshToMesh_2nd(rc) do i1=1,numOwnedElems ! Get coords - lon=ownedElemCoords(2*i1-1) - lat=ownedElemCoords(2*i1) - - ! Set source function - theta = DEG2RAD*(lon) - phi = DEG2RAD*(90.-lat) + x=ownedElemCoords(2*i1-1) + y=ownedElemCoords(2*i1) - x = cos(theta)*sin(phi) - y = sin(theta)*sin(phi) - z = cos(phi) - - srcFarrayPtr(i1) = x+y+z - !srcFarrayPtr(i1) = 1.0 + ! Set analytic field + srcFarrayPtr(i1) = x+y+2.0 enddo @@ -3612,7 +4493,7 @@ subroutine test_CartMeshToMesh_2nd(rc) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! Create Destination Mesh - call CreateTestMesh2x2_2(dstMesh, rc=localrc) + call createTestMesh3x3Cart_2(dstMesh, rc=localrc) if (ESMF_LogFoundError(localrc, & ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return @@ -3690,23 +4571,14 @@ subroutine test_CartMeshToMesh_2nd(rc) do i1=1,numOwnedElems ! Get coords - lon=ownedElemCoords(2*i1-1) - lat=ownedElemCoords(2*i1) - - ! Set exact dest function - theta = DEG2RAD*(lon) - phi = DEG2RAD*(90.-lat) + x=ownedElemCoords(2*i1-1) + y=ownedElemCoords(2*i1) - x = cos(theta)*sin(phi) - y = sin(theta)*sin(phi) - z = cos(phi) + ! Set exact analytic Field + xdstFarrayPtr(i1) = x+y+2.0 - xdstFarrayPtr(i1) = x+y+z - ! xdstFarrayPtr(i1) = 1.0 - - ! Init destination field to 0.0 - dstFarrayPtr(i1)=0.0 - + ! Init destination Field + dstFarrayPtr(i1)=0.0 enddo ! Deallocate space for coordinates @@ -3985,7 +4857,7 @@ subroutine test_CartMeshToMesh_2nd(rc) if (ABS(dstmassg(1)-srcmassg(1))/srcmassg(1) < 1.0E-14) csrv = .true. itrp = .false. - if (maxerrorg(1) < 1.5E-2) itrp = .true. + if (maxerrorg(1) < 6.0E-2) itrp = .true. ! Uncomment these calls to see some actual regrid results if (localPet == 0) then From e796a9fdd7ef7821195d5e32d5700d2b81021cd7 Mon Sep 17 00:00:00 2001 From: Gerhard Theurich Date: Wed, 4 Dec 2024 14:21:14 -0800 Subject: [PATCH 159/207] Add bullet to the restrictions section about info keys in top level State not reconciled without actual object being present form that sub-context. --- src/Superstructure/State/doc/State_rest.tex | 48 +++++++++++++++------ 1 file changed, 35 insertions(+), 13 deletions(-) diff --git a/src/Superstructure/State/doc/State_rest.tex b/src/Superstructure/State/doc/State_rest.tex index 1df0a3807a..f66a3a926a 100644 --- a/src/Superstructure/State/doc/State_rest.tex +++ b/src/Superstructure/State/doc/State_rest.tex @@ -1,27 +1,49 @@ % $Id$ % % Earth System Modeling Framework -% Copyright (c) 2002-2024, 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, +% Copyright (c) 2002-2024, 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. -%\subsubsection{Restrictions and Future Work} - \begin{enumerate} -\item{\bf No synchronization of object IDs at object create time.} + +\item{\bf No synchronization of object IDs at object create time - Unison Rule:} Object IDs are used during the reconcile process to identify objects which are unknown to some subset of the PETs in the currently running VM. -Object IDs are assigned in sequential order at object create time. - -One important request by the user community during the ESMF object design was -that there be no communication overhead or synchronization when creating -distributed ESMF objects. As a consequence it is required to create these -objects in {\bf unison} across all PETs in order to keep the ESMF object +Object IDs are assigned in sequential order at object create time across the +context of the current VM without communication. This design was requested by +the user community during ESMF object design to reduce communication and +synchronization overhead when creating distributed ESMF objects. +As a consequence it is required to create distributed ESMF objects in +{\bf unison} across all PETs of the current VM in order to keep the ESMF object identification in sync. +Violation of the unison rule will lead to undefined behavior when reconciling +a State that contains objects with inconsistent object IDs. + +\item{\bf Info keys on top level State not reconciled without actual objects +present from the relevant sub-context.} One of the actions of the +{\tt ESMF\_StateReconcile()} method is to reconcile the Info keys of the +State object itself. The endresult is that the reconciled State has the +same Info {\em keys} on all of the PETs of the VM across which it was +reconciled -- albeit with potentially different values across PETs +(see the {\tt ESMF\_StateReconcile()} API doc for more details). An edge case +for which {\tt ESMF\_StateReconcile()} does {\bf not} provide Info key +reconcilation is when keys were added under a component executing on a subset +of PETs (compared to the reconciling VM), but no actual object +(Field, FieldBundle, Array, ArrayBundle, or nested State) was added under the +VM of that sub-context. + +The situation of unreconciled Info keys across PETs for an ESMF State is not an +error condition per-se, however, it can lead to unexpected behavior in +downstream code. Specifically if such code expects to find consistent Info keys +across all PETs. If this is the case, care should be taken to ensure actual +objects are added to the top level State on the sub-context PETs where new Info +keys are added. + \end{enumerate} From ab6160ab6a05283d7ad0f92dca50cb924b987ab2 Mon Sep 17 00:00:00 2001 From: Gerhard Theurich Date: Wed, 4 Dec 2024 14:49:06 -0800 Subject: [PATCH 160/207] Improve StateReconcile() API doc. Include discussion of Info key reconciliation. --- .../src/ESMF_StateReconcile.F90 | 22 ++++++++++++++----- 1 file changed, 17 insertions(+), 5 deletions(-) diff --git a/src/Superstructure/StateReconcile/src/ESMF_StateReconcile.F90 b/src/Superstructure/StateReconcile/src/ESMF_StateReconcile.F90 index 667e4b7f9e..7d3c3295fa 100644 --- a/src/Superstructure/StateReconcile/src/ESMF_StateReconcile.F90 +++ b/src/Superstructure/StateReconcile/src/ESMF_StateReconcile.F90 @@ -152,14 +152,26 @@ subroutine ESMF_StateReconcile(state, keywordEnforcer, vm, checkflag, rc) ! !DESCRIPTION: ! ! Must be called for any {\tt ESMF\_State} which contains ESMF objects -! that have not been created on all the {\tt PET}s of the current VM. -! For example, if a coupler component is operating on data -! which was created by another component that ran on only a subset -! of the coupler {\tt PET}s, the coupler must make this call first +! that have not been created on all the PETs of {\tt vm}. +! For example, if a coupler component is operating on objects +! which were created by another component that ran on only a subset +! of the coupler PETs, the coupler must make this call first ! before operating with any of the objects held by the {\tt ESMF\_State}. -! After calling {\tt ESMF\_StateReconcile()} all {\tt PET}s will have +! After calling {\tt ESMF\_StateReconcile()} all PETs will have ! a common view of all objects contained in this {\tt ESMF\_State}. ! +! The Info metadata keys of reconciled objects are also reconciled. This +! means that after reconciliation, every object in {\tt state} holds a +! consistent set of Info {\em keys} across all the PETs of {\tt vm}. +! Notice however, that no guarantee is made with respect to the Info +! {\em value} that is associated with reconciled Info keys. +! +! The Info metadata keys of the {\tt state} object itself are also reconciled +! for most common cases. The only exception is for the case where Info keys +! were added to {\tt state} under a component that is executing on a subset +! of PETs, and no actual object created under such component was added to +! {\tt state}. +! ! This call is collective across the specified VM. ! ! The arguments are: From 4a2a709b5c4f35a39503461064410ca3c006e42e Mon Sep 17 00:00:00 2001 From: Gerhard Theurich Date: Wed, 4 Dec 2024 15:09:11 -0800 Subject: [PATCH 161/207] Adjust section title. White space clean-up. --- .../examples/ESMF_StateReconcileEx.F90 | 28 +++++++++---------- 1 file changed, 14 insertions(+), 14 deletions(-) diff --git a/src/Superstructure/StateReconcile/examples/ESMF_StateReconcileEx.F90 b/src/Superstructure/StateReconcile/examples/ESMF_StateReconcileEx.F90 index 0e30c9fad1..c3e82061b0 100644 --- a/src/Superstructure/StateReconcile/examples/ESMF_StateReconcileEx.F90 +++ b/src/Superstructure/StateReconcile/examples/ESMF_StateReconcileEx.F90 @@ -18,8 +18,8 @@ module ESMF_StateReconcileEx_Mod contains !BOE -!\subsubsection{{\tt ESMF\_StateReconcile()} usage} -! +!\subsubsection{Reconcile a State} +! ! The set services routines are used to tell ESMF which routine ! hold the user code for the initialize, run, and finalize ! blocks of user level Components. @@ -40,9 +40,9 @@ subroutine comp1_init(gcomp, istate, ostate, clock, rc) print *, "i am comp1_init" field1 = ESMF_FieldEmptyCreate(name="Comp1 Field", rc=localrc) - + call ESMF_StateAdd(istate, (/field1/), rc=localrc) - + rc = localrc end subroutine comp1_init @@ -60,7 +60,7 @@ subroutine comp2_init(gcomp, istate, ostate, clock, rc) print *, "i am comp2_init" field2 = ESMF_FieldEmptyCreate(name="Comp2 Field", rc=localrc) - + call ESMF_StateAdd(istate, (/field2/), rc=localrc) rc = localrc @@ -74,7 +74,7 @@ subroutine comp_dummy(gcomp, rc) rc = ESMF_SUCCESS end subroutine comp_dummy !EOC - + end module ESMF_StateReconcileEx_Mod @@ -129,7 +129,7 @@ program ESMF_StateReconcileEx call ESMF_Initialize(vm=vm, defaultlogfilename="StateReconcileEx.Log", & logkindflag=ESMF_LOGKIND_MULTI, rc=rc) - + ! verify that this example can run on the given petCount call ESMF_VMGet(vm, petCount=petCount, rc=rc) if (rc .ne. ESMF_SUCCESS) goto 20 @@ -138,15 +138,15 @@ program ESMF_StateReconcileEx print *, "This test must run on at least 4 PETs." goto 20 endif - + !------------------------------------------------------------------------- !BOE -! +! ! A Component can be created which will run only on a subset of the ! current PET list. !EOE - + print *, "State Reconcile Example 1: Component Creation" !BOC @@ -168,7 +168,7 @@ program ESMF_StateReconcileEx !BOC statename = "Ocn2Atm" - state1 = ESMF_StateCreate(name=statename, rc=rc) + state1 = ESMF_StateCreate(name=statename, rc=rc) !EOC print *, "State Create returned, name = ", trim(statename) @@ -177,14 +177,14 @@ program ESMF_StateReconcileEx !------------------------------------------------------------------------- !BOE -! +! ! Here we register the subroutines which should be called for initialization. ! Then we call ESMF\_GridCompInitialize() on all PETs, but the code runs ! only on the PETs given in the petList when the Component was created. ! ! Because this example is so short, we call the entry point code ! directly instead of the normal procedure of nesting it in a separate -! SetServices() subroutine. +! SetServices() subroutine. ! !EOE @@ -247,7 +247,7 @@ program ESMF_StateReconcileEx !------------------------------------------------------------------------- !BOE -! +! ! Now we have {\tt state1} containing {\tt field1} on PETs 0 and 1, and ! {\tt state1} containing {\tt field2} on PETs 2 and 3. For the code ! to have a rational view of the data, we call {\tt ESMF\_StateReconcile} From 87c282db5d881d65aa71e35988a32d1f387ccf68 Mon Sep 17 00:00:00 2001 From: Gerhard Theurich Date: Wed, 4 Dec 2024 16:16:50 -0800 Subject: [PATCH 162/207] Much simplify the StateReconcile example and documentation to highlight the important concepts. --- .../examples/ESMF_StateReconcileEx.F90 | 287 +++++++----------- 1 file changed, 112 insertions(+), 175 deletions(-) diff --git a/src/Superstructure/StateReconcile/examples/ESMF_StateReconcileEx.F90 b/src/Superstructure/StateReconcile/examples/ESMF_StateReconcileEx.F90 index c3e82061b0..473b8fd3b9 100644 --- a/src/Superstructure/StateReconcile/examples/ESMF_StateReconcileEx.F90 +++ b/src/Superstructure/StateReconcile/examples/ESMF_StateReconcileEx.F90 @@ -13,81 +13,93 @@ module ESMF_StateReconcileEx_Mod -use ESMF + use ESMF -contains + contains !BOE !\subsubsection{Reconcile a State} ! -! The set services routines are used to tell ESMF which routine -! hold the user code for the initialize, run, and finalize -! blocks of user level Components. -! These are the separate subroutines called by the code below. +! An {\tt ESMF\_State} object must be reconciled if it contains objects that +! were created and added to the State on a subset of the PETs from which the +! objects are now accessed and operated on. A typical case of this is when +! a State object is passed to a component that runs on a subset of PETs, and +! that component creates objects that are added to the State. After the +! component passes control back to the larger calling context (a parent +! component or the main program), the State object is not consistent across +! PETs. The {\tt ESMF\_StateReconcile()} method is used to reconcilce the State +! across all PETs. +! +! In order to demonstrate State reconciliation we need to set up at least +! one component that can be run on a subset of PETs. To this end an external +! routine is created that adds a few emtpy Fields into its {\tt exportState}. +! !EOE - !BOC -! Initialize routine which creates "field1" on PETs 0 and 1 -subroutine comp1_init(gcomp, istate, ostate, clock, rc) + subroutine init(gcomp, importState, exportState, clock, rc) + ! Abide to ESMF-prescribed Fortran interface type(ESMF_GridComp) :: gcomp - type(ESMF_State) :: istate, ostate + type(ESMF_State) :: importState, exportState type(ESMF_Clock) :: clock integer, intent(out) :: rc - type(ESMF_Field) :: field1 - integer :: localrc - - print *, "i am comp1_init" + type(ESMF_Field) :: field1, field2, field3 - field1 = ESMF_FieldEmptyCreate(name="Comp1 Field", rc=localrc) + rc = ESMF_SUCCESS ! indicate success... unless error is found - call ESMF_StateAdd(istate, (/field1/), rc=localrc) + field1 = ESMF_FieldEmptyCreate(name="Field1", rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return - rc = localrc + field2 = ESMF_FieldEmptyCreate(name="Field2", rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return -end subroutine comp1_init + field3 = ESMF_FieldEmptyCreate(name="Field3", rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return -! Initialize routine which creates "field2" on PETs 2 and 3 -subroutine comp2_init(gcomp, istate, ostate, clock, rc) - type(ESMF_GridComp) :: gcomp - type(ESMF_State) :: istate, ostate - type(ESMF_Clock) :: clock - integer, intent(out) :: rc + call ESMF_StateAdd(exportState, [field1, field2, field3], rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return - type(ESMF_Field) :: field2 - integer :: localrc - - print *, "i am comp2_init" - - field2 = ESMF_FieldEmptyCreate(name="Comp2 Field", rc=localrc) - - call ESMF_StateAdd(istate, (/field2/), rc=localrc) - - rc = localrc - -end subroutine comp2_init + end subroutine init +!EOC -subroutine comp_dummy(gcomp, rc) +!BOE +! The standard way to register ESMF component routines is in the +! {\tt SetServices} routine. +!EOE +!BOC + subroutine SetServices(gcomp, rc) + ! Abide to ESMF-prescribed Fortran interface type(ESMF_GridComp) :: gcomp integer, intent(out) :: rc - rc = ESMF_SUCCESS -end subroutine comp_dummy -!EOC - -end module ESMF_StateReconcileEx_Mod - - + rc = ESMF_SUCCESS ! indicate success... unless error is found + ! register 'init' as component initialization method + call ESMF_GridCompSetEntryPoint(gcomp, ESMF_METHOD_INITIALIZE, & + userRoutine=init, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return + end subroutine SetServices +!EOC +end module ESMF_StateReconcileEx_Mod - program ESMF_StateReconcileEx +!BOE +! A component can now be created in the main program that uses these routines. +!EOE +!BOC + program ESMF_StateReconcileEx +!EOC !------------------------------------------------------------------------------ !ESMF_EXAMPLE String used by test script to count examples. !============================================================================== -!BOC +! ! !PROGRAM: ESMF_StateReconcileEx - State reconciliation ! ! !DESCRIPTION: @@ -103,13 +115,14 @@ program ESMF_StateReconcileEx implicit none ! Local variables - integer :: rc, petCount - type(ESMF_State) :: state1 - type(ESMF_GridComp) :: comp1, comp2 - type(ESMF_VM) :: vm - character(len=ESMF_MAXSTR) :: comp1name, comp2name, statename - + integer :: rc, petCount + type(ESMF_State) :: state +!BOC +! ... other local variables ... + type(ESMF_GridComp) :: comp !EOC + type(ESMF_VM) :: vm + integer :: finalrc, result character(ESMF_MAXSTR) :: testname character(ESMF_MAXSTR) :: failMsg @@ -120,180 +133,104 @@ program ESMF_StateReconcileEx write(failMsg, *) "Example failure" write(testname, *) "Example ESMF_StateReconcileEx" - ! ------------------------------------------------------------------------------ ! ------------------------------------------------------------------------------ finalrc = ESMF_SUCCESS - call ESMF_Initialize(vm=vm, defaultlogfilename="StateReconcileEx.Log", & - logkindflag=ESMF_LOGKIND_MULTI, rc=rc) + logkindflag=ESMF_LOGKIND_MULTI, rc=rc) + if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT) ! verify that this example can run on the given petCount call ESMF_VMGet(vm, petCount=petCount, rc=rc) - if (rc .ne. ESMF_SUCCESS) goto 20 + if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT) if (petCount<4) then print *, "This test must run on at least 4 PETs." + finalrc = ESMF_FAILURE goto 20 endif - -!------------------------------------------------------------------------- -!BOE -! -! A Component can be created which will run only on a subset of the -! current PET list. -!EOE - - print *, "State Reconcile Example 1: Component Creation" - -!BOC - ! Get the global VM for this job. - call ESMF_VMGetGlobal(vm=vm, rc=rc) - - comp1name = "Atmosphere" - comp1 = ESMF_GridCompCreate(name=comp1name, petList=(/ 0, 1 /), rc=rc) - print *, "GridComp Create returned, name = ", trim(comp1name) -!EOC - if (rc.NE.ESMF_SUCCESS) finalrc = ESMF_FAILURE !BOC - - comp2name = "Ocean" - comp2 = ESMF_GridCompCreate(name=comp2name, petList=(/ 2, 3 /), rc=rc) - print *, "GridComp Create returned, name = ", trim(comp2name) -!EOC - if (rc.NE.ESMF_SUCCESS) finalrc = ESMF_FAILURE -!BOC - - statename = "Ocn2Atm" - state1 = ESMF_StateCreate(name=statename, rc=rc) + comp = ESMF_GridCompCreate(name="MyComp", petList=[0,1], rc=rc) !EOC - print *, "State Create returned, name = ", trim(statename) - - print *, "State Example 1 finished" - if (rc.NE.ESMF_SUCCESS) finalrc = ESMF_FAILURE + if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT) -!------------------------------------------------------------------------- !BOE +! Here {\tt comp} is created to execute on two PETs: 0 and 1. ! -! Here we register the subroutines which should be called for initialization. -! Then we call ESMF\_GridCompInitialize() on all PETs, but the code runs -! only on the PETs given in the petList when the Component was created. -! -! Because this example is so short, we call the entry point code -! directly instead of the normal procedure of nesting it in a separate -! SetServices() subroutine. -! +! Next the Component {\tt SetServices} method is called to register the +! custom component method(s). !EOE - !BOC - ! This is where the VM for each component is initialized. - ! Normally you would call SetEntryPoint inside set services, - ! but to make this example very short, they are called inline below. - ! This is o.k. because the SetServices routine must execute from within - ! the parent component VM. - call ESMF_GridCompSetVM(comp1, comp_dummy, rc=rc) + call ESMF_GridCompSetServices(comp, userRoutine=SetServices, rc=rc) !EOC - if (rc.NE.ESMF_SUCCESS) finalrc = ESMF_FAILURE -!BOC + if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT) - call ESMF_GridCompSetVM(comp2, comp_dummy, rc=rc) -!EOC - if (rc.NE.ESMF_SUCCESS) finalrc = ESMF_FAILURE -!BOC +!BOE +! Now a State is created that can be passed in when the registered Component +! method is called. +!EOE - call ESMF_GridCompSetServices(comp1, userRoutine=comp_dummy, rc=rc) -!EOC - if (rc.NE.ESMF_SUCCESS) finalrc = ESMF_FAILURE !BOC - - call ESMF_GridCompSetServices(comp2, userRoutine=comp_dummy, rc=rc) + state = ESMF_StateCreate(rc=rc) !EOC - if (rc.NE.ESMF_SUCCESS) finalrc = ESMF_FAILURE -!BOC + if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT) - - print *, "ready to set entry point 1" - call ESMF_GridCompSetEntryPoint(comp1, ESMF_METHOD_INITIALIZE, & - comp1_init, rc=rc) -!EOC - if (rc.NE.ESMF_SUCCESS) finalrc = ESMF_FAILURE +!BOE +! The {\tt state} object is used as the Component's {\tt exportState}. +!EOE !BOC - - - print *, "ready to set entry point 2" - call ESMF_GridCompSetEntryPoint(comp2, ESMF_METHOD_INITIALIZE, & - comp2_init, rc=rc) + call ESMF_GridCompInitialize(comp, exportState=state, rc=rc) !EOC - if (rc.NE.ESMF_SUCCESS) finalrc = ESMF_FAILURE -!BOC + if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT) - - - print *, "ready to call init for comp 1" - call ESMF_GridCompInitialize(comp1, exportState=state1, rc=rc) -!EOC - if (rc.NE.ESMF_SUCCESS) finalrc = ESMF_FAILURE +!BOE +! Once control of execution has returned from the pevious +! {\tt ESMF\_GridCompInitialize()} call, the {\tt state} object is in an +! inconsistent state across the PETs of the current (main program) context. +! This is because Fields were added on PETs 0 and 1, but not on the remaining +! PETs (2 and 3). This situation can easliy be observed by writing the current +! {\tt state} to the ESMF log. +!EOE !BOC - - print *, "ready to call init for comp 2" - call ESMF_GridCompInitialize(comp2, exportState=state1, rc=rc) + call ESMF_StateLog(state, prefix="Before Reconcile:", rc=rc) !EOC + if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT) - print *, "State Example 2 finished" - if (rc.NE.ESMF_SUCCESS) finalrc = ESMF_FAILURE - -!------------------------------------------------------------------------- !BOE -! -! Now we have {\tt state1} containing {\tt field1} on PETs 0 and 1, and -! {\tt state1} containing {\tt field2} on PETs 2 and 3. For the code -! to have a rational view of the data, we call {\tt ESMF\_StateReconcile} -! which determines which objects are missing from any PET, and communicates -! information about the object. After the call to reconcile, all -! {\tt ESMF\_State} objects now have a consistent view of the data. +! To reconcile {\tt state} across all of the PETs, use the +! {\tt ESMF\_StateReconcile()} method. !EOE - !BOC - print *, "State before calling StateReconcile()" - call ESMF_StatePrint(state1, rc=rc) + call ESMF_StateReconcile(state, rc=rc) !EOC - if (rc.NE.ESMF_SUCCESS) finalrc = ESMF_FAILURE -!BOC - + if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT) - call ESMF_StateReconcile(state1, vm=vm, rc=rc) -!EOC - if (rc.NE.ESMF_SUCCESS) finalrc = ESMF_FAILURE +!BOE +! The output of {\tt state} to the ESMF log shows that the object is now +! consistent across all PETs. I.e. {\tt state} contains identical items on +! all of the PETs. +!EOE !BOC - - - print *, "State after calling StateReconcile()" - call ESMF_StatePrint(state1, rc=rc) + call ESMF_StateLog(state, prefix="After Reconcile:", rc=rc) !EOC - - print *, "State Example 3 finished" - if (rc.NE.ESMF_SUCCESS) finalrc = ESMF_FAILURE + if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT) !------------------------------------------------------------------------- - call ESMF_StateDestroy (state1, rc=rc) - if (rc /= ESMF_SUCCESS) finalrc = ESMF_FAILURE - - call ESMF_GridCompDestroy (comp2, rc=rc) - if (rc /= ESMF_SUCCESS) finalrc = ESMF_FAILURE + call ESMF_StateDestroy (state, rc=rc) + if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT) - call ESMF_GridCompDestroy (comp1, rc=rc) - if (rc /= ESMF_SUCCESS) finalrc = ESMF_FAILURE + call ESMF_GridCompDestroy (comp, rc=rc) + if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT) 20 continue ! IMPORTANT: ESMF_STest() prints the PASS string and the # of processors in the log ! file that the scripts grep for. call ESMF_STest((finalrc.eq.ESMF_SUCCESS), testname, failMsg, result, ESMF_SRCLINE) - call ESMF_Finalize(rc=rc) if (rc.NE.ESMF_SUCCESS) finalrc = ESMF_FAILURE From c2111e3be235d96beec611fe7f4a14587fc2ea89 Mon Sep 17 00:00:00 2001 From: Gerhard Theurich Date: Wed, 4 Dec 2024 17:33:46 -0800 Subject: [PATCH 163/207] Allow StateReconcile attribute test to validate with checkflag. --- .../StateReconcile/src/ESMF_StateReconcile.F90 | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/src/Superstructure/StateReconcile/src/ESMF_StateReconcile.F90 b/src/Superstructure/StateReconcile/src/ESMF_StateReconcile.F90 index 7d3c3295fa..a36daecba6 100644 --- a/src/Superstructure/StateReconcile/src/ESMF_StateReconcile.F90 +++ b/src/Superstructure/StateReconcile/src/ESMF_StateReconcile.F90 @@ -374,6 +374,9 @@ subroutine ESMF_StateReconcile(state, keywordEnforcer, vm, checkflag, rc) "All ", & "1 ", & "2 ", & + "3 ", & + "1 ", & + "2 ", & " ", & " ", & "M ", & @@ -384,6 +387,9 @@ subroutine ESMF_StateReconcile(state, keywordEnforcer, vm, checkflag, rc) ], & plusStringList = ["All ", & "None ", & + "0 ", & + "0 ", & + "0 ", & "2 ", & "1 ", & "DEF ", & From f44b67560d03d5c4d75f50996efdde6d40eb5d86 Mon Sep 17 00:00:00 2001 From: Gerhard Theurich Date: Wed, 4 Dec 2024 18:01:50 -0800 Subject: [PATCH 164/207] Correctly address the issue that now Reconcile() checkflag also checks for Noop condition! --- .../StateReconcile/src/ESMF_StateReconcile.F90 | 13 +++---------- .../tests/ESMF_StateReconcileUTest.F90 | 5 ++++- 2 files changed, 7 insertions(+), 11 deletions(-) diff --git a/src/Superstructure/StateReconcile/src/ESMF_StateReconcile.F90 b/src/Superstructure/StateReconcile/src/ESMF_StateReconcile.F90 index a36daecba6..9158c7719b 100644 --- a/src/Superstructure/StateReconcile/src/ESMF_StateReconcile.F90 +++ b/src/Superstructure/StateReconcile/src/ESMF_StateReconcile.F90 @@ -205,12 +205,11 @@ subroutine ESMF_StateReconcile(state, keywordEnforcer, vm, checkflag, rc) localrc = ESMF_RC_NOT_IMPL localCheckFlag = .false. ! default - if (present(checkFlag)) localCheckFlag = checkFlag - #if 0 - ! Activate this when working on StateReoncile, so all tests validate! - localCheckFlag = .true. ! force checking + ! Activate this when working on StateReoncile, so default is to check result + localCheckFlag = .true. ! force checking by default #endif + if (present(checkFlag)) localCheckFlag = checkFlag if (present (vm)) then localvm = vm @@ -374,9 +373,6 @@ subroutine ESMF_StateReconcile(state, keywordEnforcer, vm, checkflag, rc) "All ", & "1 ", & "2 ", & - "3 ", & - "1 ", & - "2 ", & " ", & " ", & "M ", & @@ -387,9 +383,6 @@ subroutine ESMF_StateReconcile(state, keywordEnforcer, vm, checkflag, rc) ], & plusStringList = ["All ", & "None ", & - "0 ", & - "0 ", & - "0 ", & "2 ", & "1 ", & "DEF ", & diff --git a/src/Superstructure/StateReconcile/tests/ESMF_StateReconcileUTest.F90 b/src/Superstructure/StateReconcile/tests/ESMF_StateReconcileUTest.F90 index 44fc076f81..d9e2db52cd 100644 --- a/src/Superstructure/StateReconcile/tests/ESMF_StateReconcileUTest.F90 +++ b/src/Superstructure/StateReconcile/tests/ESMF_StateReconcileUTest.F90 @@ -1508,7 +1508,10 @@ program ESMF_StateReconcileUTest !NEX_UTest_Multi_Proc_Only write(failMsg, *) "Did not return ESMF_SUCCESS" write(name, *) "Reconciling state with Base attribute test" - call ESMF_StateReconcile (state_attr, checkflag=.true., rc=rc) + ! use explicit checkflag=.false, because state Info values will not be + ! consistent across PETs... and in case we force default .true. for + ! development, make sure this is explicitly set to .false. here + call ESMF_StateReconcile (state_attr, checkflag=.false., rc=rc) call ESMF_Test((rc == ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE) !------------------------------------------------------------------------- From 195e508f70b1d104b86056d7b28ee7672b47cc09 Mon Sep 17 00:00:00 2001 From: Gerhard Theurich Date: Wed, 4 Dec 2024 21:16:38 -0800 Subject: [PATCH 165/207] Correctly set ESMF_StateReconcileEx as multi-proc example. --- .../StateReconcile/examples/ESMF_StateReconcileEx.F90 | 7 ++++--- src/Superstructure/StateReconcile/examples/makefile | 5 +---- 2 files changed, 5 insertions(+), 7 deletions(-) diff --git a/src/Superstructure/StateReconcile/examples/ESMF_StateReconcileEx.F90 b/src/Superstructure/StateReconcile/examples/ESMF_StateReconcileEx.F90 index 473b8fd3b9..3d87ba28bf 100644 --- a/src/Superstructure/StateReconcile/examples/ESMF_StateReconcileEx.F90 +++ b/src/Superstructure/StateReconcile/examples/ESMF_StateReconcileEx.F90 @@ -9,7 +9,10 @@ ! Licensed under the University of Illinois-NCSA License. ! !============================================================================== -! + +!============================================================================== +!ESMF_MULTI_PROC_EXAMPLE String used by test script to count examples. +!============================================================================== module ESMF_StateReconcileEx_Mod @@ -96,8 +99,6 @@ end module ESMF_StateReconcileEx_Mod program ESMF_StateReconcileEx !EOC -!------------------------------------------------------------------------------ -!ESMF_EXAMPLE String used by test script to count examples. !============================================================================== ! ! !PROGRAM: ESMF_StateReconcileEx - State reconciliation diff --git a/src/Superstructure/StateReconcile/examples/makefile b/src/Superstructure/StateReconcile/examples/makefile index b806f1aec1..b83da87cee 100644 --- a/src/Superstructure/StateReconcile/examples/makefile +++ b/src/Superstructure/StateReconcile/examples/makefile @@ -11,7 +11,7 @@ EXAMPLES_BUILD = $(ESMF_EXDIR)/ESMF_StateReconcileEx EXAMPLES_RUN = run_ESMF_StateReconcileEx -EXAMPLES_RUN_UNI = run_ESMF_StateReconcileEx_uni +EXAMPLES_RUN_UNI = include $(ESMF_DIR)/makefile @@ -27,6 +27,3 @@ DIRS = # run_ESMF_StateReconcileEx: $(MAKE) EXNAME=StateReconcile NP=4 exfrun - -run_ESMF_StateReconcileEx_uni: - $(MAKE) EXNAME=StateReconcile NP=1 exfrun From 8423bcccf53169ad2ac1753c038d7b7180d732c9 Mon Sep 17 00:00:00 2001 From: Robert Oehmke Date: Thu, 5 Dec 2024 11:34:36 -0700 Subject: [PATCH 166/207] Improve consistency of 2nd order conservative by sorting SM cells by dst id. --- .../Mesh/include/Legacy/ESMCI_SM.h | 3 +++ src/Infrastructure/Mesh/src/Legacy/ESMCI_SM.C | 20 +++++++++++++++++++ .../src/Regridding/ESMCI_Conserve2ndInterp.C | 6 ++++++ 3 files changed, 29 insertions(+) diff --git a/src/Infrastructure/Mesh/include/Legacy/ESMCI_SM.h b/src/Infrastructure/Mesh/include/Legacy/ESMCI_SM.h index 1197ac7133..453e340012 100644 --- a/src/Infrastructure/Mesh/include/Legacy/ESMCI_SM.h +++ b/src/Infrastructure/Mesh/include/Legacy/ESMCI_SM.h @@ -20,6 +20,9 @@ namespace ESMCI { int dst_index; } SM_CELL; + + void sort_SM_CELLS_by_dst_id(std::vector *sm_cells, std::vector &dst_elems); + void create_SM_cells_2D_3D_sph(const MeshObj *src_elem, MEField<> *src_cfield, std::vector dst_elems, MEField<> *dst_cfield, MEField<> * dst_mask_field, MEField<> * dst_frac2_field, double *src_elem_area, diff --git a/src/Infrastructure/Mesh/src/Legacy/ESMCI_SM.C b/src/Infrastructure/Mesh/src/Legacy/ESMCI_SM.C index 76970520f7..7a2a2dca86 100644 --- a/src/Infrastructure/Mesh/src/Legacy/ESMCI_SM.C +++ b/src/Infrastructure/Mesh/src/Legacy/ESMCI_SM.C @@ -47,6 +47,26 @@ static const char *const version = "$Id$"; namespace ESMCI { + // Comparison functor used to sort SM_CELLs by dst id + class SMDstIdsLess { + public: + SMDstIdsLess(std::vector &_dst_elems) : dst_elems(_dst_elems) {} + bool operator()(const SM_CELL &lhs, const SM_CELL &rhs) { + return (dst_elems[lhs.dst_index]->get_id() < dst_elems[rhs.dst_index]->get_id()); + } + private: + std::vector &dst_elems; + }; + + // Sort SM cells by dst id + void sort_SM_CELLS_by_dst_id(std::vector *sm_cells, std::vector &dst_elems) { + + // Sort using dst ids + std::sort(sm_cells->begin(), sm_cells->end(), SMDstIdsLess(dst_elems)); + } + + + //////////////// BEGIN CALC 2D 2D CELLS //////////////// void _calc_centroid_2D_2D_cart(int num_p, double *p, double *cntr) { diff --git a/src/Infrastructure/Mesh/src/Regridding/ESMCI_Conserve2ndInterp.C b/src/Infrastructure/Mesh/src/Regridding/ESMCI_Conserve2ndInterp.C index 79866c6623..b1489338af 100644 --- a/src/Infrastructure/Mesh/src/Regridding/ESMCI_Conserve2ndInterp.C +++ b/src/Infrastructure/Mesh/src/Regridding/ESMCI_Conserve2ndInterp.C @@ -518,6 +518,9 @@ namespace ESMCI { // If there are no sm cells then leave if (sm_cells->empty()) return; + // Sort SM cells by dst id to keep things consistent + sort_SM_CELLS_by_dst_id(sm_cells, dst_elems); + // Get list of source elements surrounding this one _get_neighbor_elems_2D_2D_cart(src_elem, src_cfield, src_mask_field, nbrs); @@ -1256,6 +1259,9 @@ namespace ESMCI { // If there are no sm cells then leave if (sm_cells->empty()) return; + // Sort SM cells by dst id to keep things consistent + sort_SM_CELLS_by_dst_id(sm_cells, dst_elems); + // Get list of source elements surrounding this one _get_neighbor_elems_2D_3D_sph(src_elem, src_cfield, src_mask_field, nbrs); From b39311b3081c47250326ebdadb4ddf59be152155 Mon Sep 17 00:00:00 2001 From: Daniel Rosen Date: Thu, 5 Dec 2024 14:50:30 -0700 Subject: [PATCH 167/207] Fix non-monotonic time on Mac OS GH Runner (#327) --- .github/workflows/development-tests.yml | 2 ++ 1 file changed, 2 insertions(+) diff --git a/.github/workflows/development-tests.yml b/.github/workflows/development-tests.yml index fb093f44f3..f2fb07b0ee 100644 --- a/.github/workflows/development-tests.yml +++ b/.github/workflows/development-tests.yml @@ -75,6 +75,8 @@ jobs: sudo apt-get -qq update sudo apt install -qq -y autoconf automake libtool elif [[ "${{matrix.config.osys}}" == "macos-"* ]]; then + sudo systemsetup -setusingnetworktime off + sudo rm -rf /etc/ntp.conf brew install autoconf automake libtool brew unlink libevent || true fi From 7d2bc831f25516ab7c7a73672296624894d23052 Mon Sep 17 00:00:00 2001 From: Robert Oehmke Date: Thu, 5 Dec 2024 15:19:28 -0700 Subject: [PATCH 168/207] Fix for unmapped cell issue. --- src/Infrastructure/Mesh/src/ESMCI_XGridUtil.C | 10 +- src/Infrastructure/Mesh/src/Legacy/ESMCI_SM.C | 4 + .../XGrid/tests/ESMF_XGridUTest.F90 | 549 +++++++++++++----- 3 files changed, 411 insertions(+), 152 deletions(-) diff --git a/src/Infrastructure/Mesh/src/ESMCI_XGridUtil.C b/src/Infrastructure/Mesh/src/ESMCI_XGridUtil.C index 93a4ce3ff5..1ffee63abf 100644 --- a/src/Infrastructure/Mesh/src/ESMCI_XGridUtil.C +++ b/src/Infrastructure/Mesh/src/ESMCI_XGridUtil.C @@ -2903,9 +2903,17 @@ void calc_wgts_from_xgrid_to_side_mesh(Mesh *src_xgrid_mesh, Mesh *dst_side_mesh for (; dxei != dxee; ++dxei) { MeshObj &dst_elem = *dxei; + if (dst_elem.get_id() == 107) { + printf("%d# dXGOE H1 dst_elem=%d\n",Par::Rank(),dst_elem.get_id()); + } + // Skip non-local elements - if (!GetAttr(dst_elem).is_locally_owned()) continue; + // if (!GetAttr(dst_elem).is_locally_owned()) continue; + if (dst_elem.get_id() == 107) { + printf("%d# dXGOE H2 dst_elem=%d\n",Par::Rank(),dst_elem.get_id()); + } + // Get XGrid element ind // (Round to nearest to take care of possible representation issues) double *elem_mesh_ind_dbl = mesh_ind_field->data(dst_elem); diff --git a/src/Infrastructure/Mesh/src/Legacy/ESMCI_SM.C b/src/Infrastructure/Mesh/src/Legacy/ESMCI_SM.C index 28f9f676f4..365cb3e7b4 100644 --- a/src/Infrastructure/Mesh/src/Legacy/ESMCI_SM.C +++ b/src/Infrastructure/Mesh/src/Legacy/ESMCI_SM.C @@ -1470,6 +1470,10 @@ namespace ESMCI { // Get dst coords get_elem_coords_3D_ccw(dst_elem, dst_cfield, MAX_NUM_DST_POLY_NODES, tmp_coords, &num_dst_nodes, dst_coords); + + if (dst_elem->get_id() == 107) { + printf("%d # dst id=%d\n",Par::Rank(),dst_elem->get_id()); + } // Get rid of degenerate edges remove_0len_edges3D(&num_dst_nodes, dst_coords); diff --git a/src/Infrastructure/XGrid/tests/ESMF_XGridUTest.F90 b/src/Infrastructure/XGrid/tests/ESMF_XGridUTest.F90 index 3dbdf5c912..750b376acd 100644 --- a/src/Infrastructure/XGrid/tests/ESMF_XGridUTest.F90 +++ b/src/Infrastructure/XGrid/tests/ESMF_XGridUTest.F90 @@ -56,6 +56,7 @@ program ESMF_XGridUTest !------------------------------------------------------------------------ +#if 0 !------------------------------------------------------------------------ !NEX_UTest ! Don't know if I should keep this turned on as an actual unit test, but it's useful for debugging @@ -65,7 +66,6 @@ program ESMF_XGridUTest call ESMF_Test((rc .eq. ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE) !------------------------------------------------------------------------ -#if 0 !------------------------------------------------------------------------ !NEX_UTest write(name, *) "Testing XGrid IsCreated for uncreated object" @@ -194,11 +194,11 @@ program ESMF_XGridUTest write(name, *) "Creating an XGrid with Mesh easy element create interface" call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE) -#endif + !------------------------------------------------------------------------ !NEX_UTest - ! Create an XGrid in 2D from Meshes with user supplied area + ! Create an XGrid in 2D from Meshes call test_MeshToMesh_2nd(rc) write(failMsg, *) "" write(name, *) "Test 2nd order on an XGrid between Meshes" @@ -206,17 +206,17 @@ program ESMF_XGridUTest !------------------------------------------------------------------------ !NEX_UTest - ! Create an XGrid in 2D from Cartesian Meshes with user supplied area + ! Create an XGrid in 2D from Cartesian Meshes call test_CartMeshToMesh_2nd(rc) write(failMsg, *) "" write(name, *) "Test 2nd order on an XGrid between Cartesian Meshes" call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE) - +#endif -#if 0 +#if 1 !------------------------------------------------------------------------ !NEX_UTest - ! Create an XGrid in 2D from Meshes with user supplied area + ! Create an XGrid in 2D from Meshes call test_CSGridToGrid_2nd(rc) write(failMsg, *) "" write(name, *) "Test 2nd order on an XGrid with a cubed sphere Grid" @@ -3091,7 +3091,7 @@ subroutine test_MeshToMesh_2nd(rc) deallocate(ownedElemCoords) -#if 1 +#if 0 call ESMF_MeshWrite(srcMesh,"srcMesh") call ESMF_MeshWrite(dstMesh,"dstMesh") #endif @@ -3111,14 +3111,14 @@ subroutine test_MeshToMesh_2nd(rc) ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return - +#if 0 call ESMF_XGridGet(xgrid, mesh=xgridMesh, rc=localrc) if (ESMF_LogFoundError(localrc, & ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return call ESMF_MeshWrite(xgridMesh,"xgridMesh") - +#endif ! Field on XGrid xField = ESMF_FieldCreate(xgrid, arrayspec, & @@ -3483,19 +3483,19 @@ end subroutine test_MeshToMesh_2nd ! ! Mesh Owners ! - ! 3.0 2 ------- 2 -------- 3 -------- 3 - ! | | | 3 / | - ! | 2 | 2 | / | - ! | | | / 3 | - ! 2.0 2 ------- 2 -------- 3 -------- 3 + ! 3.0 1 ------- 1 -------- 1 -------- 1 + ! | | | 1 / | + ! | 1 | 1 | / | + ! | | | / 1 | + ! 2.0 1 ------- 1 -------- 1 -------- 1 ! | | | | - ! | 2 | 2 | 3 | + ! | 1 | 1 | 1 | ! | | | | - ! 1.0 0 ------- 0 -------- 1 -------- 1 + ! 1.0 0 ------- 0 -------- 0 -------- 0 ! | | | | - ! | 0 | 1 | 1 | + ! | 0 | 0 | 0 | ! | | | | - ! 0.0 0 ------- 0 -------- 1 -------- 1 + ! 0.0 0 ------- 0 -------- 0 -------- 0 ! ! 0.0 1.0 2.0 3.0 ! @@ -3526,8 +3526,8 @@ subroutine createTestMesh3x3Cart_1(mesh, rc) call ESMF_VMGet(vm, localPet=localPet, petCount=petCount, rc=rc) if (rc /= ESMF_SUCCESS) return - ! return with an error if not 1 or 4 PETs - if ((petCount /= 1) .and. (petCount /=4)) then + ! return with an error if not 1 or 2 PETs + if ((petCount /= 1) .and. (petCount /=2)) then rc=ESMF_FAILURE return endif @@ -3581,9 +3581,6 @@ subroutine createTestMesh3x3Cart_1(mesh, rc) allocate(elemIds(numElems)) elemIds=(/1,2,3,4,5,6,7,8,9,10/) - !! elem mask - allocate(elemMask(numElems)) - elemMask=(/0,0,1,0,0,0,0,0,0,0/) !! elem types allocate(elemTypes(numElems)) @@ -3591,12 +3588,12 @@ subroutine createTestMesh3x3Cart_1(mesh, rc) ESMF_MESHELEMTYPE_QUAD, & ! 2 ESMF_MESHELEMTYPE_QUAD, & ! 3 ESMF_MESHELEMTYPE_QUAD, & ! 4 - ESMF_MESHELEMTYPE_QUAD, & ! 5 + ESMF_MESHELEMTYPE_QUAD, & ! 5 ESMF_MESHELEMTYPE_QUAD, & ! 6 ESMF_MESHELEMTYPE_QUAD, & ! 7 ESMF_MESHELEMTYPE_QUAD, & ! 8 ESMF_MESHELEMTYPE_TRI, & ! 9 - ESMF_MESHELEMTYPE_TRI/) ! 10 + ESMF_MESHELEMTYPE_TRI/) ! 10 !! elem coords allocate(elemCoords(2*numElems)) @@ -3624,23 +3621,27 @@ subroutine createTestMesh3x3Cart_1(mesh, rc) 11,12,16, & ! 9 11,16,15/) ! 10 - else if (petCount .eq. 4) then + else if (petCount .eq. 2) then ! Setup mesh data depending on PET if (localPet .eq. 0) then ! Fill in node data - numNodes=4 + numNodes=8 !! node ids allocate(nodeIds(numNodes)) - nodeIds=(/1,2,5,6/) + nodeIds=(/1,2,3,4,5,6,7,8/) !! node Coords allocate(nodeCoords(numNodes*2)) - nodeCoords=(/0.0,0.0, & ! 1 - 1.0,0.0, & ! 2 - 0.0,1.0, & ! 5 - 1.0,1.0 /) ! 6 + nodeCoords=(/0.0,0.0, & ! 1 + 1.0,0.0, & ! 2 + 2.0,0.0, & ! 3 + 3.0,0.0, & ! 4 + 0.0,1.0, & ! 5 + 1.0,1.0, & ! 6 + 2.0,1.0, & ! 7 + 3.0,1.0/) ! 8 !! node owners allocate(nodeOwners(numNodes)) @@ -3648,233 +3649,463 @@ subroutine createTestMesh3x3Cart_1(mesh, rc) ! Fill in elem data numTriElems=0 - numQuadElems=1 + numQuadElems=3 numElems=numTriElems+numQuadElems numElemConns=3*numTriElems+4*numQuadElems !! elem ids allocate(elemIds(numElems)) - elemIds=(/1/) + elemIds=(/1,2,3/) - !! elem mask - allocate(elemMask(numElems)) - elemMask=(/0/) !! elem types allocate(elemTypes(numElems)) - elemTypes=(/ESMF_MESHELEMTYPE_QUAD/) ! 1 + elemTypes=(/ESMF_MESHELEMTYPE_QUAD, & ! 1 + ESMF_MESHELEMTYPE_QUAD, & ! 2 + ESMF_MESHELEMTYPE_QUAD/) ! 3 !! elem coords allocate(elemCoords(2*numElems)) - elemCoords=(/0.5,0.5/) ! 1 + elemCoords=(/0.5,0.5, & ! 1 + 1.5,0.5, & ! 2 + 2.5,0.5/) ! 3 !! elem conn allocate(elemConn(numElemConns)) - elemConn=(/1,2,4,3/) ! 1 + elemConn=(/1,2,6,5, & ! 1 + 2,3,7,6, & ! 2 + 3,4,8,7/) ! 2 + else if (localPet .eq. 1) then ! Fill in node data - numNodes=6 + numNodes=12 !! node ids allocate(nodeIds(numNodes)) - nodeIds=(/2,3,4,6,7,8/) + nodeIds=(/5,6,7,8,9,10,11,12,13,14,15,16/) !! node Coords allocate(nodeCoords(numNodes*2)) - nodeCoords=(/1.0,0.0, & ! 2 - 2.0,0.0, & ! 3 - 3.0,0.0, & ! 4 - 1.0,1.0, & ! 6 - 2.0,1.0, & ! 7 - 3.0,1.0 /) ! 8 + nodeCoords=(/0.0,1.0, & ! 5 + 1.0,1.0, & ! 6 + 2.0,1.0, & ! 7 + 3.0 ,1.0, & ! 8 + 0.0,2.0, & ! 9 + 1.0,2.0, & ! 10 + 2.0,2.0, & ! 11 + 3.0,2.0, & ! 12 + 0.0,3.0, & ! 13 + 1.0,3.0, & ! 14 + 2.0,3.0, & ! 15 + 3.0,3.0 /) ! 16 + !! node owners allocate(nodeOwners(numNodes)) - nodeOwners=(/0, & ! 2 - 1, & ! 3 - 1, & ! 4 + nodeOwners=(/0, & ! 5 0, & ! 6 - 1, & ! 7 - 1/) ! 8 + 0, & ! 7 + 0, & ! 8 + 1, & ! 9 + 1, & ! 10 + 1, & ! 11 + 1, & ! 12 + 1, & ! 13 + 1, & ! 14 + 1, & ! 15 + 1/) ! 16 ! Fill in elem data - numTriElems=0 - numQuadElems=2 + numTriElems=2 + numQuadElems=5 numElems=numTriElems+numQuadElems numElemConns=3*numTriElems+4*numQuadElems !! elem ids allocate(elemIds(numElems)) - elemIds=(/2,3/) - - !! elem mask - allocate(elemMask(numElems)) - elemMask=(/0,1/) + elemIds=(/4,5,6,7,8,9,10/) !! elem types allocate(elemTypes(numElems)) - elemTypes=(/ESMF_MESHELEMTYPE_QUAD, & ! 2 - ESMF_MESHELEMTYPE_QUAD/) ! 3 + elemTypes=(/ESMF_MESHELEMTYPE_QUAD, & ! 4 + ESMF_MESHELEMTYPE_QUAD, & ! 5 + ESMF_MESHELEMTYPE_QUAD, & ! 6 + ESMF_MESHELEMTYPE_QUAD, & ! 7 + ESMF_MESHELEMTYPE_QUAD, & ! 8 + ESMF_MESHELEMTYPE_TRI, & ! 9 + ESMF_MESHELEMTYPE_TRI/) ! 10 !! elem coords allocate(elemCoords(2*numElems)) - elemCoords=(/1.5,0.5, & ! 2 - 2.5,0.5/) ! 3 + elemCoords=(/0.5,1.5, & ! 4 + 1.5,1.5, & ! 5 + 2.5,1.5, & ! 6 + 0.5,2.5, & ! 7 + 1.5,2.5, & ! 8 + 2.75,2.25,& ! 9 + 2.25,2.75/) ! 10 !! elem conn allocate(elemConn(numElemConns)) - elemConn=(/1,2,5,4, & ! 2 - 2,3,6,5/) ! 3 + elemConn=(/1,2,6,5, & ! 4 + 2,3,7,6, & ! 5 + 3,4,8,7, & ! 6 + 5,6,10,9, & ! 7 + 6,7,11,10, & ! 8 + 7,8,12, & ! 9 + 7,12,11/) ! 10 + endif + endif - else if (localPet .eq. 2) then + ! Create Mesh structure in 1 step + mesh=ESMF_MeshCreate(parametricDim=2,spatialDim=2, & + coordSys=ESMF_COORDSYS_CART, & + nodeIds=nodeIds, nodeCoords=nodeCoords, & + nodeOwners=nodeOwners, elementIds=elemIds, & + elementTypes=elemTypes, elementConn=elemConn, & + elementCoords=elemCoords, rc=rc) + if (rc /= ESMF_SUCCESS) return + + ! deallocate node data + deallocate(nodeIds) + deallocate(nodeCoords) + deallocate(nodeOwners) + + ! deallocate elem data + deallocate(elemIds) + deallocate(elemTypes) + deallocate(elemCoords) + deallocate(elemConn) + +end subroutine createTestMesh3x3Cart_1 + + + + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + ! + ! Creates the following mesh on + ! 1 or 4 PETs. Returns an error + ! if run on other than 1 or 4 PETs + ! + ! Mesh Ids + ! + ! 3.0 13 ------ 14 ------- 15 ------- 16 + ! | | | 10 / | + ! 2.5 | 7 | 8 | / | + ! | | | / 9 | + ! 2.0 9 ------- 10 ------- 11 ------- 12 + ! | | | | + ! 1.5 | 4 | 5 | 6 | + ! | | | | + ! 1.0 5 ------- 6 -------- 7 -------- 8 + ! | | | | + ! 0.5 | 1 | 2 | 3 | + ! | | | | + ! 0.0 1 ------- 2 -------- 3 -------- 4 + ! + ! 0.0 0.5 1.0 1.5 2.0 2.5 3.0 + ! + ! Node Ids at corners + ! Element Ids in centers + ! + !!!!! + ! + ! The owners for 1 PET are all Pet 0. + ! The owners for 4 PETs are as follows: + ! + ! Mesh Owners + ! + ! 3.0 1 ------- 1 -------- 1 -------- 1 + ! | | | 1 / | + ! | 1 | 1 | / | + ! | | | / 1 | + ! 2.0 1 ------- 1 -------- 1 -------- 1 + ! | | | | + ! | 1 | 1 | 1 | + ! | | | | + ! 1.0 0 ------- 0 -------- 0 -------- 0 + ! | | | | + ! | 0 | 0 | 0 | + ! | | | | + ! 0.0 0 ------- 0 -------- 0 -------- 0 + ! + ! 0.0 1.0 2.0 3.0 + ! + ! Node Owners at corners + ! Element Owners in centers + ! + +subroutine createTestMesh3x3Cart_2(mesh, rc) + type(ESMF_Mesh), intent(out) :: mesh + integer :: rc + + integer, pointer :: nodeIds(:),nodeOwners(:) + real(ESMF_KIND_R8), pointer :: nodeCoords(:) + real(ESMF_KIND_R8), pointer :: ownedNodeCoords(:) + integer :: numNodes, numOwnedNodes, numOwnedNodesTst + integer :: numElems,numOwnedElemsTst + integer :: numElemConns, numTriElems, numQuadElems + real(ESMF_KIND_R8), pointer :: elemCoords(:) + integer, pointer :: elemIds(:),elemTypes(:),elemConn(:) + integer, pointer :: elemMask(:) + integer :: petCount, localPet + type(ESMF_VM) :: vm + + + ! get global VM + call ESMF_VMGetGlobal(vm, rc=rc) + if (rc /= ESMF_SUCCESS) return + call ESMF_VMGet(vm, localPet=localPet, petCount=petCount, rc=rc) + if (rc /= ESMF_SUCCESS) return + + ! return with an error if not 1 or 2 PETs + if ((petCount /= 1) .and. (petCount /=2)) then + rc=ESMF_FAILURE + return + endif + + + ! Setup mesh info depending on the + ! number of PETs + if (petCount .eq. 1) then ! Fill in node data - numNodes=9 + numNodes=16 !! node ids allocate(nodeIds(numNodes)) - nodeIds=(/5,6,7, & - 9,10,11, & - 13,14,15/) - + nodeIds=(/1,2,3,4,5,6,7,8, & + 9,10,11,12,13,14,& + 15,16/) !! node Coords allocate(nodeCoords(numNodes*2)) - nodeCoords=(/0.0,1.0, & ! 5 - 1.0,1.0, & ! 6 - 2.0,1.0, & ! 7 - 0.0,2.0, & ! 9 - 1.0,2.0, & ! 10 - 2.0,2.0, & ! 11 - 0.0,3.0, & ! 13 + nodeCoords=(/0.0,0.0, & ! 1 + 1.0,0.0, & ! 2 + 2.0,0.0, & ! 3 + 3.0,0.0, & ! 4 + 0.0,1.0, & ! 5 + 1.25,1.25, & ! 6 + 1.75,1.25, & ! 7 + 3.0,1.0, & ! 8 + 0.0,2.0, & ! 9 + 1.25,1.75, & ! 10 + 1.75,1.75, & ! 11 + 3.0,2.0, & ! 12 + 0.0,3.0, & ! 13 1.0,3.0, & ! 14 - 2.0,3.0/) ! 15 - + 2.0,3.0, & ! 15 + 3.0,3.0 /) ! 16 + !! node owners allocate(nodeOwners(numNodes)) - nodeOwners=(/0, & ! 5 - 0, & ! 6 - 1, & ! 7 - 2, & ! 9 - 2, & ! 10 - 3, & ! 11 - 2, & ! 13 - 2, & ! 14 - 3/) ! 15 + nodeOwners=0 ! everything on proc 0 ! Fill in elem data - numTriElems=0 - numQuadElems=4 + numTriElems=2 + numQuadElems=8 numElems=numTriElems+numQuadElems numElemConns=3*numTriElems+4*numQuadElems !! elem ids allocate(elemIds(numElems)) - elemIds=(/4,5,7,8/) + elemIds=(/1,2,3,4,5,6,7,8,9,10/) - !! elem mask - allocate(elemMask(numElems)) - elemMask=(/0,0,0,0/) !! elem types allocate(elemTypes(numElems)) - elemTypes=(/ESMF_MESHELEMTYPE_QUAD, & ! 4 + elemTypes=(/ESMF_MESHELEMTYPE_QUAD, & ! 1 + ESMF_MESHELEMTYPE_QUAD, & ! 2 + ESMF_MESHELEMTYPE_QUAD, & ! 3 + ESMF_MESHELEMTYPE_QUAD, & ! 4 ESMF_MESHELEMTYPE_QUAD, & ! 5 + ESMF_MESHELEMTYPE_QUAD, & ! 6 ESMF_MESHELEMTYPE_QUAD, & ! 7 - ESMF_MESHELEMTYPE_QUAD/) ! 8 - + ESMF_MESHELEMTYPE_QUAD, & ! 8 + ESMF_MESHELEMTYPE_TRI, & ! 9 + ESMF_MESHELEMTYPE_TRI/) ! 10 !! elem coords allocate(elemCoords(2*numElems)) - elemCoords=(/0.5,1.5, & ! 4 - 1.5,1.5, & ! 5 + elemCoords=(/0.5,0.5, & ! 1 + 1.5,0.5, & ! 2 + 2.5,0.5, & ! 3 + 0.5,1.5, & ! 4 + 1.5,1.5, & ! 5 + 2.5,1.5, & ! 6 0.5,2.5, & ! 7 - 1.5,2.5/) ! 8 + 1.5,2.5, & ! 8 + 2.75,2.25,& ! 9 + 2.25,2.75/) ! 10 !! elem conn allocate(elemConn(numElemConns)) - elemConn=(/1,2,5,4, & ! 4 - 2,3,6,5, & ! 5 - 4,5,8,7, & ! 7 - 5,6,9,8/) ! 8 - else if (localPet .eq. 3) then + elemConn=(/1,2,6,5, & ! 1 + 2,3,7,6, & ! 2 + 3,4,8,7, & ! 3 + 5,6,10,9, & ! 4 + 6,7,11,10, & ! 5 + 7,8,12,11, & ! 6 + 9,10,14,13, & ! 7 + 10,11,15,14, & ! 8 + 11,12,16, & ! 9 + 11,16,15/) ! 10 + else if (petCount .eq. 2) then + ! Setup mesh data depending on PET + if (localPet .eq. 0) then + ! Fill in node data - numNodes=6 + numNodes=8 !! node ids allocate(nodeIds(numNodes)) - nodeIds=(/7,8,11,12,15,16/) + nodeIds=(/1,2,3,4,5,6,7,8/) !! node Coords allocate(nodeCoords(numNodes*2)) - nodeCoords=(/2.0,1.0, & ! 7 - 3.0,1.0, & ! 8 - 2.0,2.0, & ! 11 - 3.0,2.0, & ! 12 - 2.0,3.0, & ! 15 - 3.0,3.0 /) ! 16 - + nodeCoords=(/0.0,0.0, & ! 1 + 1.0,0.0, & ! 2 + 2.0,0.0, & ! 3 + 3.0,0.0, & ! 4 + 0.0,1.0, & ! 5 + 1.25,1.25, & ! 6 + 1.75,1.25, & ! 7 + 3.0,1.0/) ! 8 !! node owners allocate(nodeOwners(numNodes)) - nodeOwners=(/1, & ! 7 - 1, & ! 8 - 3, & ! 11 - 3, & ! 12 - 3, & ! 15 - 3/) ! 16 + nodeOwners=0 ! everything on proc 0 ! Fill in elem data - numTriElems=2 - numQuadElems=1 + numTriElems=0 + numQuadElems=3 numElems=numTriElems+numQuadElems numElemConns=3*numTriElems+4*numQuadElems - !! elem ids - allocate(elemIds(numElems)) - elemIds=(/6,9,10/) + !! elem ids + allocate(elemIds(numElems)) + elemIds=(/1,2,3/) - !! elem mask - allocate(elemMask(numElems)) - elemMask=(/0,0,0/) !! elem types allocate(elemTypes(numElems)) - elemTypes=(/ESMF_MESHELEMTYPE_QUAD, & ! 6 - ESMF_MESHELEMTYPE_TRI, & ! 9 - ESMF_MESHELEMTYPE_TRI/) ! 10 + elemTypes=(/ESMF_MESHELEMTYPE_QUAD, & ! 1 + ESMF_MESHELEMTYPE_QUAD, & ! 2 + ESMF_MESHELEMTYPE_QUAD/) ! 3 !! elem coords allocate(elemCoords(2*numElems)) - elemCoords=(/2.5,1.5, & ! 6 - 2.75,2.25,& ! 9 - 2.25,2.75/) ! 10 + elemCoords=(/0.5,0.5, & ! 1 + 1.5,0.5, & ! 2 + 2.5,0.5/) ! 3 !! elem conn allocate(elemConn(numElemConns)) - elemConn=(/1,2,4,3, & ! 6 - 3,4,6, & ! 9 - 3,6,5/) ! 10 - endif + elemConn=(/1,2,6,5, & ! 1 + 2,3,7,6, & ! 2 + 3,4,8,7/) ! 2 + + + else if (localPet .eq. 1) then + + ! Fill in node data + numNodes=12 + + !! node ids + allocate(nodeIds(numNodes)) + nodeIds=(/5,6,7,8,9,10,11,12,13,14,15,16/) + + !! node Coords + allocate(nodeCoords(numNodes*2)) + nodeCoords=(/0.0,1.0, & ! 5 + 1.25,1.25, & ! 6 + 1.75,1.25, & ! 7 + 3.0 ,1.0, & ! 8 + 0.0,2.0, & ! 9 + 1.25,1.75, & ! 10 + 1.75,1.75, & ! 11 + 3.0,2.0, & ! 12 + 0.0,3.0, & ! 13 + 1.0,3.0, & ! 14 + 2.0,3.0, & ! 15 + 3.0,3.0 /) ! 16 + + + + + !! node owners + allocate(nodeOwners(numNodes)) + nodeOwners=(/0, & ! 5 + 0, & ! 6 + 0, & ! 7 + 0, & ! 8 + 1, & ! 9 + 1, & ! 10 + 1, & ! 11 + 1, & ! 12 + 1, & ! 13 + 1, & ! 14 + 1, & ! 15 + 1/) ! 16 + + ! Fill in elem data + numTriElems=2 + numQuadElems=5 + numElems=numTriElems+numQuadElems + numElemConns=3*numTriElems+4*numQuadElems + + !! elem ids + allocate(elemIds(numElems)) + elemIds=(/4,5,6,7,8,9,10/) + + !! elem types + allocate(elemTypes(numElems)) + elemTypes=(/ESMF_MESHELEMTYPE_QUAD, & ! 4 + ESMF_MESHELEMTYPE_QUAD, & ! 5 + ESMF_MESHELEMTYPE_QUAD, & ! 6 + ESMF_MESHELEMTYPE_QUAD, & ! 7 + ESMF_MESHELEMTYPE_QUAD, & ! 8 + ESMF_MESHELEMTYPE_TRI, & ! 9 + ESMF_MESHELEMTYPE_TRI/) ! 10 + + !! elem coords + allocate(elemCoords(2*numElems)) + elemCoords=(/0.5,1.5, & ! 4 + 1.5,1.5, & ! 5 + 2.5,1.5, & ! 6 + 0.5,2.5, & ! 7 + 1.5,2.5, & ! 8 + 2.75,2.25,& ! 9 + 2.25,2.75/) ! 10 + + + !! elem conn + allocate(elemConn(numElemConns)) + elemConn=(/1,2,6,5, & ! 4 + 2,3,7,6, & ! 5 + 3,4,8,7, & ! 6 + 5,6,10,9, & ! 7 + 6,7,11,10, & ! 8 + 7,8,12, & ! 9 + 7,12,11/) ! 10 + endif endif - ! Create Mesh structure in 1 step mesh=ESMF_MeshCreate(parametricDim=2,spatialDim=2, & coordSys=ESMF_COORDSYS_CART, & nodeIds=nodeIds, nodeCoords=nodeCoords, & - nodeOwners=nodeOwners, elementIds=elemIds,& + nodeOwners=nodeOwners, elementIds=elemIds, & elementTypes=elemTypes, elementConn=elemConn, & - elementCoords=elemCoords, elementMask=elemMask,& - rc=rc) + elementCoords=elemCoords, rc=rc) if (rc /= ESMF_SUCCESS) return ! deallocate node data @@ -3888,7 +4119,7 @@ subroutine createTestMesh3x3Cart_1(mesh, rc) deallocate(elemCoords) deallocate(elemConn) -end subroutine createTestMesh3x3Cart_1 +end subroutine createTestMesh3x3Cart_2 @@ -3946,7 +4177,7 @@ end subroutine createTestMesh3x3Cart_1 ! Element Owners in centers ! -subroutine createTestMesh3x3Cart_2(mesh, rc) +subroutine createTestMesh3x3Cart_T(mesh, rc) type(ESMF_Mesh), intent(out) :: mesh integer :: rc @@ -4332,14 +4563,14 @@ subroutine createTestMesh3x3Cart_2(mesh, rc) deallocate(elemCoords) deallocate(elemConn) -end subroutine createTestMesh3x3Cart_2 +end subroutine createTestMesh3x3Cart_T ! Test 2nd order regridding on Cartesian meshes using an XGrid subroutine test_CartMeshToMesh_2nd(rc) #undef ESMF_METHOD -#define ESMF_METHOD "test_MeshToMesh_2nd" +#define ESMF_METHOD "test_CartMeshToMesh_2nd" integer, intent(out) :: rc logical :: itrp logical :: csrv @@ -4960,6 +5191,7 @@ subroutine test_CSGridToGrid_2nd(rc) integer :: localrc type(ESMF_Grid) :: srcGrid type(ESMF_Grid) :: dstGrid + type(ESMF_Mesh) :: xgridMesh type(ESMF_XGrid) :: xgrid type(ESMF_Field) :: srcField type(ESMF_Field) :: dstField @@ -5324,9 +5556,16 @@ subroutine test_CSGridToGrid_2nd(rc) enddo ! lDE -#if 0 +#if 1 call ESMF_GridWriteVTK(srcGrid,staggerloc=ESMF_STAGGERLOC_CORNER, & - filename="srcGridCnrb4", & + filename="srcGridCnr", & + rc=localrc) + if (ESMF_LogFoundError(localrc, & + ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, rcToReturn=rc)) return + + call ESMF_GridWriteVTK(dstGrid,staggerloc=ESMF_STAGGERLOC_CORNER, & + filename="dstGridCnr", & rc=localrc) if (ESMF_LogFoundError(localrc, & ESMF_ERR_PASSTHRU, & @@ -5354,6 +5593,14 @@ subroutine test_CSGridToGrid_2nd(rc) ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return +#if 1 + call ESMF_XGridGet(xgrid, mesh=xgridMesh, rc=localrc) + if (ESMF_LogFoundError(localrc, & + ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, rcToReturn=rc)) return + + call ESMF_MeshWrite(xgridMesh,"xgridMesh") +#endif ! Regrid store call ESMF_FieldRegridStore( & From 285ff051ba6a78142d784c77f47711b9a103a88c Mon Sep 17 00:00:00 2001 From: Gerhard Theurich Date: Fri, 6 Dec 2024 11:03:32 -0800 Subject: [PATCH 169/207] Implement ESMF_InfoLog() for more standard (and convenient) way to log the contents of an Info object. --- .../Base/interface/ESMF_Info.F90 | 68 ++++++++++++++++++- 1 file changed, 67 insertions(+), 1 deletion(-) diff --git a/src/Infrastructure/Base/interface/ESMF_Info.F90 b/src/Infrastructure/Base/interface/ESMF_Info.F90 index 339df16403..d1ab657d54 100644 --- a/src/Infrastructure/Base/interface/ESMF_Info.F90 +++ b/src/Infrastructure/Base/interface/ESMF_Info.F90 @@ -223,6 +223,7 @@ module ESMF_InfoMod public ESMF_InfoSetDirty public ESMF_InfoIsSet public ESMF_InfoIsPresent +public ESMF_InfoLog public ESMF_InfoPrint public ESMF_InfoDump public ESMF_InfoUpdate @@ -2495,6 +2496,71 @@ end function ESMF_InfoIsSet !------------------------------------------------------------------------------ +#undef ESMF_METHOD +#define ESMF_METHOD "ESMF_InfoLog()" +!BOP +! !IROUTINE: ESMF_InfoLog - Log contents of an Info object +! +! !INTERFACE: +subroutine ESMF_InfoLog(info, keywordEnforcer, prefix, logMsgFlag, rc) +! !ARGUMENTS: + type(ESMF_Info), intent(in) :: info +type(ESMF_KeywordEnforcer), optional:: keywordEnforcer ! must use keywords below + character(len=*), intent(in), optional :: prefix + type(ESMF_LogMsg_Flag), intent(in), optional :: logMsgFlag + integer, intent(out), optional :: rc +! +! !DESCRIPTION: +! Write information about {\tt info} object to the ESMF default Log. +! +! The arguments are: +! \begin{description} +! \item[info] +! {\tt ESMF\_Info} object logged. +! \item [{[prefix]}] +! String to prefix the log message. Default is no prefix. +! \item [{[logMsgFlag]}] +! Type of log message generated. See section \ref{const:logmsgflag} for +! a list of valid message types. Default is {\tt ESMF\_LOGMSG\_INFO}. +! \item[{[rc]}] +! Return code; equals {\tt ESMF\_SUCCESS} if there are no errors. +! \end{description} +! +!EOP +!------------------------------------------------------------------------------ + integer :: localrc + character(:), allocatable :: output, local_preString + + ! initialize return code; assume routine not implemented + localrc = ESMF_RC_NOT_IMPL + if (present(rc)) rc = ESMF_RC_NOT_IMPL + + !TODO: This should really be implemented on the C++ side where we could + !TODO: correctly deal with line breaks and prepend the prefix string on + !TODO: each line, much like for ESMF_HConfigLog(). + !TODO: For now implemented quickly on the Fortran side to make available. + + if (present(prefix)) then + local_preString = prefix + else + local_preString = "" + endif + + output = ESMF_InfoDump(info, indent=2, rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, rcToReturn=rc)) return + + call ESMF_LogWrite(local_preString//output, logMsgFlag, rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, rcToReturn=rc)) return + + ! return successfully + if (present(rc)) rc = ESMF_SUCCESS + +end subroutine ESMF_InfoLog + +!------------------------------------------------------------------------------ + #undef ESMF_METHOD #define ESMF_METHOD "ESMF_InfoPrint()" !BOP @@ -3929,4 +3995,4 @@ subroutine ESMF_InfoWriteJSON(info, filename, keywordEnforcer, rc) if (present(rc)) rc = ESMF_SUCCESS end subroutine ESMF_InfoWriteJSON -end module ESMF_InfoMod !===================================================== \ No newline at end of file +end module ESMF_InfoMod !===================================================== From e190c6ec24acdd0449af362a4973b5b4576ba666 Mon Sep 17 00:00:00 2001 From: Gerhard Theurich Date: Fri, 6 Dec 2024 11:04:39 -0800 Subject: [PATCH 170/207] Utilize InfoLog() inside StateLog()... at least during development. --- .../State/src/ESMF_StateAPI.cppF90 | 16 ++++++++++++++++ 1 file changed, 16 insertions(+) diff --git a/src/Superstructure/State/src/ESMF_StateAPI.cppF90 b/src/Superstructure/State/src/ESMF_StateAPI.cppF90 index 3e786803e4..3e347eaeb5 100644 --- a/src/Superstructure/State/src/ESMF_StateAPI.cppF90 +++ b/src/Superstructure/State/src/ESMF_StateAPI.cppF90 @@ -59,6 +59,7 @@ module ESMF_StateAPIMod use ESMF_IOUtilMod use ESMF_UtilMod use ESMF_UtilStringMod + use ESMF_InfoMod implicit none @@ -1852,6 +1853,21 @@ type(ESMF_KeywordEnforcer), optional:: keywordEnforcer ! must use keywords below ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return +#if 1 +!TODO: need a way to indicate from calling side that info should be logged + block + type(ESMF_Info) :: info + call ESMF_InfoGetFromBase(stateR%statep%base, info=info, rc=localrc) + if (ESMF_LogFoundError(localrc, & + ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, rcToReturn=rc)) return + call ESMF_InfoLog(info, prefix=prefix, rc=localrc) + if (ESMF_LogFoundError(localrc, & + ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, rcToReturn=rc)) return + end block +#endif + if (itemCount > 0) then allocate(itemNameList(itemCount)) allocate(itemTypeList(itemCount)) From 8ee83797411098639ce078c978c818c8e8b73b3c Mon Sep 17 00:00:00 2001 From: Gerhard Theurich Date: Fri, 6 Dec 2024 13:37:00 -0800 Subject: [PATCH 171/207] Revert back to version before CompName was added - which is not needed. Instead implement Import-/ExportState naming based on compLabel for more clarity. --- src/addon/NUOPC/src/NUOPC_Driver.F90 | 63 ++++++++-------------------- 1 file changed, 18 insertions(+), 45 deletions(-) diff --git a/src/addon/NUOPC/src/NUOPC_Driver.F90 b/src/addon/NUOPC/src/NUOPC_Driver.F90 index 4cd171e2ab..07f4476911 100644 --- a/src/addon/NUOPC/src/NUOPC_Driver.F90 +++ b/src/addon/NUOPC/src/NUOPC_Driver.F90 @@ -1170,7 +1170,7 @@ recursive subroutine InitializeIPDv02p1(driver, importState, exportState, & return ! bail out namespace=cmEntry%wrap%label else - ! in the old style (pre v7) there are no component labels availabl + ! in the old style (pre v7) there are no component labels available namespace="DEFAULT" ! cannot be empty for sake of AttributeSet() endif ! add State level attributes, set the namespace according to comp label @@ -1188,6 +1188,14 @@ recursive subroutine InitializeIPDv02p1(driver, importState, exportState, & if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, file=trim(name)//":"//FILENAME, rcToReturn=rc)) & return ! bail out + ! for available component label, also set State name for clarity + if (namespace /= "DEFAULT") then + call ESMF_StateSet(is%wrap%modelIS(i), & + name=trim(namespace)//"-ImportState", rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=trim(name)//":"//FILENAME, rcToReturn=rc)) & + return ! bail out + endif endif ! add State level attributes, set the namespace according to comp label stateIsCreated = ESMF_StateIsCreated(is%wrap%modelES(i), rc=rc) @@ -1204,6 +1212,14 @@ recursive subroutine InitializeIPDv02p1(driver, importState, exportState, & if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, file=trim(name)//":"//FILENAME, rcToReturn=rc)) & return ! bail out + ! for available component label, also set State name for clarity + if (namespace /= "DEFAULT") then + call ESMF_StateSet(is%wrap%modelES(i), & + name=trim(namespace)//"-ExportState", rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=trim(name)//":"//FILENAME, rcToReturn=rc)) & + return ! bail out + endif endif enddo @@ -1600,8 +1616,6 @@ recursive subroutine loopModelComps(phase, rc) logical :: areServicesSet character(ESMF_MAXSTR) :: iString, pLabel logical :: mustAttributeUpdate(1:is%wrap%modelCount) - logical :: isPresent - type(ESMF_Info) :: info rc = ESMF_SUCCESS mustAttributeUpdate = .false. ! loop through all the model components first time to execute @@ -1644,48 +1658,7 @@ recursive subroutine loopModelComps(phase, rc) return ! bail out endif enddo - ! loop through all the model components second time to add extra metadata - do i=1, is%wrap%modelCount - call ESMF_GridCompGet(is%wrap%modelComp(i), name=compName, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=trim(name)//":"//FILENAME, rcToReturn=rc)) & - return ! bail out - ! add metadata to import state - call ESMF_InfoGetFromHost(is%wrap%modelIS(i), info=info, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=trim(name)//":"//FILENAME, rcToReturn=rc)) & - return ! bail out - call ESMF_InfoGet(info, key="/NUOPC/Instance/CompName", & - isPresent=isPresent, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=trim(name)//":"//FILENAME, rcToReturn=rc)) & - return ! bail out - if (.not. isPresent) then - call ESMF_InfoSet(info, key="/NUOPC/Instance/CompName", & - value=trim(compName), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=trim(name)//":"//FILENAME, rcToReturn=rc)) & - return ! bail out - end if - ! add metadata to export state - call ESMF_InfoGetFromHost(is%wrap%modelES(i), info=info, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=trim(name)//":"//FILENAME, rcToReturn=rc)) & - return ! bail out - call ESMF_InfoGet(info, key="/NUOPC/Instance/CompName", & - isPresent=isPresent, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=trim(name)//":"//FILENAME, rcToReturn=rc)) & - return ! bail out - if (.not. isPresent) then - call ESMF_InfoSet(info, key="/NUOPC/Instance/CompName", & - value=trim(compName), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=trim(name)//":"//FILENAME, rcToReturn=rc)) & - return ! bail out - end if - end do - ! loop through all the model components third time to update Attributes + ! loop through all the model components second time to update Attributes do i=1, is%wrap%modelCount if (mustAttributeUpdate(i)) then ! need to update the Component attributes across all PETs From 4c8fd1edc68aeec02b59ce338716907ddf8b8675 Mon Sep 17 00:00:00 2001 From: Gerhard Theurich Date: Fri, 6 Dec 2024 13:39:09 -0800 Subject: [PATCH 172/207] Implement Field mirroring with NameSpace transfer. --- src/addon/NUOPC/src/NUOPC_Connector.F90 | 65 +++++++++---------------- 1 file changed, 23 insertions(+), 42 deletions(-) diff --git a/src/addon/NUOPC/src/NUOPC_Connector.F90 b/src/addon/NUOPC/src/NUOPC_Connector.F90 index a549c32507..075734a624 100644 --- a/src/addon/NUOPC/src/NUOPC_Connector.F90 +++ b/src/addon/NUOPC/src/NUOPC_Connector.F90 @@ -436,7 +436,7 @@ subroutine InitializeIPDv05p1(connector, importState, exportState, clock, rc) integer :: i, j character(ESMF_MAXSTR) :: importCplSet, exportCplSet character(len=240) :: msgString - character(ESMF_MAXSTR) :: importProvider, exportProvider + character(ESMF_MAXSTR) :: stateName, namespace rc = ESMF_SUCCESS @@ -609,25 +609,22 @@ subroutine InitializeIPDv05p1(connector, importState, exportState, clock, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, file=trim(name)//":"//FILENAME)) return ! bail out elseif (trim(exportXferPolicy)=="transferAllAsNests") then - ! check name of provider component - call NUOPC_GetAttribute(importState, name="CompName", & - value=importProvider, rc=rc) + ! access importState namespace so it can be transferred to exportState + call NUOPC_GetAttribute(importState, name="Namespace", & + value=namespace, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, file=trim(name)//":"//FILENAME)) return ! bail out - ! create nested state - exportNestedState = ESMF_StateCreate(name=trim(importProvider)//"-NestedState", rc=rc) + ! access name of exportState for nestedStateName construction for clarity + call ESMF_StateGet(exportState, name=stateName, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, file=trim(name)//":"//FILENAME)) return ! bail out - ! set FieldTransferPolicy metadata for nested state - call NUOPC_SetAttribute(exportNestedState, "FieldTransferPolicy", "transferAll", rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=trim(name)//":"//FILENAME)) return ! bail out - ! define namespace and nested state - call NUOPC_AddNamespace(exportState, namespace=trim(importProvider), & + ! set namespace on exportState, creating a nestedState + call NUOPC_AddNamespace(exportState, namespace=trim(namespace), & + nestedStateName=trim(stateName)//"-namespace:"//trim(namespace), & nestedState=exportNestedState, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, file=trim(name)//":"//FILENAME)) return ! bail out - ! top level mirroring into exportState + ! mirror importState items into exportNestedState call doMirror(importState, exportNestedState, acceptorVM=vm, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, file=trim(name)//":"//FILENAME)) return ! bail out @@ -707,25 +704,20 @@ subroutine InitializeIPDv05p1(connector, importState, exportState, clock, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, file=trim(name)//":"//FILENAME)) return ! bail out elseif (trim(importXferPolicy)=="transferAllAsNests") then - ! check name of provider component - call NUOPC_GetAttribute(exportState, name="CompName", & - value=exportProvider, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=trim(name)//":"//FILENAME)) return ! bail out - ! create nested state - importNestedState = ESMF_StateCreate(name=trim(exportProvider)//"-NestedState", rc=rc) + ! access exportState namespace so it can be transferred to importState + call NUOPC_GetAttribute(exportState, name="Namespace", & + value=namespace, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, file=trim(name)//":"//FILENAME)) return ! bail out - ! set FieldTransferPolicy metadata for nested state - call NUOPC_SetAttribute(importNestedState, "FieldTransferPolicy", "transferAll", rc=rc) + ! access name of importState for nestedStateName construction for clarity + call ESMF_StateGet(importState, name=stateName, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, file=trim(name)//":"//FILENAME)) return ! bail out - ! define namespace and nested state - call NUOPC_AddNamespace(importState, namespace=trim(exportProvider), & + ! set namespace on importState, creating a nestedState + call NUOPC_AddNamespace(importState, namespace=trim(namespace), & + nestedStateName=trim(stateName)//"-namespace:"//trim(namespace), & nestedState=importNestedState, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=trim(name)//":"//FILENAME)) return ! bail out - ! top level mirroring into exportState + ! mirror exportState items into importNestedState call doMirror(exportState, importNestedState, acceptorVM=vm, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, file=trim(name)//":"//FILENAME)) return ! bail out @@ -839,13 +831,12 @@ subroutine InitializeIPDv05p1(connector, importState, exportState, clock, rc) recursive subroutine doMirror(providerState, acceptorState, acceptorVM, rc) type(ESMF_State) :: providerState type(ESMF_State) :: acceptorState - type(ESMF_VM), intent(in) :: acceptorVM + type(ESMF_VM), intent(in) :: acceptorVM integer, intent(out) :: rc integer :: item, itemCount character(ESMF_MAXSTR) :: providerTransferOffer, acceptorTransferOffer character(ESMF_MAXSTR) :: acceptorStateName - character(ESMF_MAXSTR) :: providerCompName type(ESMF_State) :: providerNestedState type(ESMF_State) :: acceptorNestedState character(ESMF_MAXSTR) :: nestedStateName @@ -866,7 +857,7 @@ recursive subroutine doMirror(providerState, acceptorState, acceptorVM, rc) character(ESMF_MAXSTR) :: valueString type(ESMF_Pointer) :: vmThis logical :: actualFlag - + rc = ESMF_SUCCESS nullify(providerStandardNameList) @@ -874,18 +865,13 @@ recursive subroutine doMirror(providerState, acceptorState, acceptorVM, rc) nullify(providerFieldList) nullify(providerCplSetList) nullify(acceptorStandardNameList) - + actualFlag = .true. call ESMF_VMGetThis(acceptorVM, vmThis) if (vmThis == ESMF_NULL_POINTER) then actualFlag = .false. ! local PET is not for an actual member endif - call NUOPC_GetAttribute(providerState, name="CompName", & - value=providerCompName, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=trim(name)//":"//FILENAME)) return ! bail out - call ESMF_StateGet(acceptorState, name=acceptorStateName, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, file=trim(name)//":"//FILENAME)) return ! bail out @@ -1062,14 +1048,9 @@ recursive subroutine doMirror(providerState, acceptorState, acceptorVM, rc) line=__LINE__, file=trim(name)//":"//FILENAME)) return ! bail out endif - ! Add extra metadata to the field in acceptor side about provider - call NUOPC_SetAttribute(fieldAdv, name="ProviderCompName", & - value=trim(providerCompName), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=trim(name)//":"//FILENAME)) return ! bail out end do endif - + if (flipIntent) then ! Need to flip the accetorState intent back (same as providerIntent). call ESMF_StateSet(acceptorState, stateIntent=providerIntent, rc=rc) From e569cecae56d79838f968bc7da42e1ba68d280c5 Mon Sep 17 00:00:00 2001 From: Gerhard Theurich Date: Fri, 6 Dec 2024 14:23:03 -0800 Subject: [PATCH 173/207] Add the option to create nested State for NameSpace handling on a explicitly provided VM, and use this to target acceptor VM for field mirroring with NameSpace. --- src/addon/NUOPC/src/NUOPC_Base.F90 | 50 ++++++++++++++++--------- src/addon/NUOPC/src/NUOPC_Connector.F90 | 8 ++-- 2 files changed, 36 insertions(+), 22 deletions(-) diff --git a/src/addon/NUOPC/src/NUOPC_Base.F90 b/src/addon/NUOPC/src/NUOPC_Base.F90 index 2f3bf35a4a..891b39f808 100644 --- a/src/addon/NUOPC/src/NUOPC_Base.F90 +++ b/src/addon/NUOPC/src/NUOPC_Base.F90 @@ -154,12 +154,13 @@ module NUOPC_Base ! !IROUTINE: NUOPC_AddNamespace - Add a nested state with Namespace to a State ! !INTERFACE: subroutine NUOPC_AddNamespace(state, Namespace, nestedStateName, & - nestedState, rc) + nestedState, vm, rc) ! !ARGUMENTS: type(ESMF_State), intent(inout) :: state character(len=*), intent(in) :: Namespace character(len=*), intent(in), optional :: nestedStateName type(ESMF_State), intent(out), optional :: nestedState + type(ESMF_VM), intent(in), optional :: vm integer, intent(out), optional :: rc ! !DESCRIPTION: ! Add a Namespace to {\tt state}. Namespaces are implemented via nested @@ -178,6 +179,10 @@ subroutine NUOPC_AddNamespace(state, Namespace, nestedStateName, & ! Name of the nested state. Defaults to {\tt Namespace}. ! \item[{[nestedState]}] ! Optional return of the newly created nested state. +! \item[{[vm]}] +! If present, the nested State created to hold the namespace is created on +! the specified {\tt ESMF\_VM} object. The default is to create the nested +! State on the VM of the current component context. ! \item[{[rc]}] ! Return code; equals {\tt ESMF\_SUCCESS} if there are no errors. ! \end{description} @@ -189,9 +194,10 @@ subroutine NUOPC_AddNamespace(state, Namespace, nestedStateName, & type(ESMF_State) :: nestedS character(len=80) :: nestedSName type(ESMF_StateIntent_Flag) :: stateIntent - + logical :: stateIsCreated + if (present(rc)) rc = ESMF_SUCCESS - + call ESMF_StateGet(state, stateIntent=stateIntent, rc=localrc) if (ESMF_LogFoundError(rcToCheck=localrc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, file=FILENAME, rcToReturn=rc)) return ! bail out @@ -201,31 +207,39 @@ subroutine NUOPC_AddNamespace(state, Namespace, nestedStateName, & else nestedSName = trim(Namespace) endif - + nestedS = ESMF_StateCreate(name=nestedSName, stateIntent=stateIntent, & - rc=localrc) - if (ESMF_LogFoundError(rcToCheck=localrc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=FILENAME, rcToReturn=rc)) return ! bail out - - call NUOPC_InitAttributes(nestedS, rc=localrc) + vm=vm, rc=localrc) if (ESMF_LogFoundError(rcToCheck=localrc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, file=FILENAME, rcToReturn=rc)) return ! bail out - call NUOPC_SetAttribute(nestedS, name="Namespace", & - value=trim(Namespace), rc=localrc) - if (ESMF_LogFoundError(rcToCheck=localrc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=FILENAME, rcToReturn=rc)) return ! bail out - - call ESMF_StateAdd(state, (/nestedS/), rc=localrc) + stateIsCreated = ESMF_StateIsCreated(nestedS, rc=rc) if (ESMF_LogFoundError(rcToCheck=localrc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, file=FILENAME, rcToReturn=rc)) return ! bail out + if (stateIsCreated) then + + call NUOPC_InitAttributes(nestedS, rc=localrc) + if (ESMF_LogFoundError(rcToCheck=localrc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=FILENAME, rcToReturn=rc)) return ! bail out + + call NUOPC_SetAttribute(nestedS, name="Namespace", & + value=trim(Namespace), rc=localrc) + if (ESMF_LogFoundError(rcToCheck=localrc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=FILENAME, rcToReturn=rc)) return ! bail out + + call ESMF_StateAdd(state, (/nestedS/), rc=localrc) + if (ESMF_LogFoundError(rcToCheck=localrc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=FILENAME, rcToReturn=rc)) return ! bail out + + endif + if (present(nestedState)) & nestedState = nestedS - + end subroutine - !--------------------------------------------------------------------- - + !----------------------------------------------------------------------------- + !----------------------------------------------------------------------------- !BOP ! !IROUTINE: NUOPC_AddNestedState - Add a nested state to a state with NUOPC attributes diff --git a/src/addon/NUOPC/src/NUOPC_Connector.F90 b/src/addon/NUOPC/src/NUOPC_Connector.F90 index 075734a624..7540b577fd 100644 --- a/src/addon/NUOPC/src/NUOPC_Connector.F90 +++ b/src/addon/NUOPC/src/NUOPC_Connector.F90 @@ -618,10 +618,10 @@ subroutine InitializeIPDv05p1(connector, importState, exportState, clock, rc) call ESMF_StateGet(exportState, name=stateName, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, file=trim(name)//":"//FILENAME)) return ! bail out - ! set namespace on exportState, creating a nestedState + ! set namespace on exportState, creating a nestedState on acceptor VM call NUOPC_AddNamespace(exportState, namespace=trim(namespace), & nestedStateName=trim(stateName)//"-namespace:"//trim(namespace), & - nestedState=exportNestedState, rc=rc) + nestedState=exportNestedState, vm=vm, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, file=trim(name)//":"//FILENAME)) return ! bail out ! mirror importState items into exportNestedState @@ -713,10 +713,10 @@ subroutine InitializeIPDv05p1(connector, importState, exportState, clock, rc) call ESMF_StateGet(importState, name=stateName, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, file=trim(name)//":"//FILENAME)) return ! bail out - ! set namespace on importState, creating a nestedState + ! set namespace on importState, creating a nestedState on acceptor VM call NUOPC_AddNamespace(importState, namespace=trim(namespace), & nestedStateName=trim(stateName)//"-namespace:"//trim(namespace), & - nestedState=importNestedState, rc=rc) + nestedState=importNestedState, vm=vm, rc=rc) ! mirror exportState items into importNestedState call doMirror(exportState, importNestedState, acceptorVM=vm, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & From a5d550d2eceab34b4221c491273aae9b28ce0ec9 Mon Sep 17 00:00:00 2001 From: Gerhard Theurich Date: Fri, 6 Dec 2024 14:24:37 -0800 Subject: [PATCH 174/207] Turn off InfoLog() under StateLog(). --- src/Superstructure/State/src/ESMF_StateAPI.cppF90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Superstructure/State/src/ESMF_StateAPI.cppF90 b/src/Superstructure/State/src/ESMF_StateAPI.cppF90 index 3e347eaeb5..3ebac37213 100644 --- a/src/Superstructure/State/src/ESMF_StateAPI.cppF90 +++ b/src/Superstructure/State/src/ESMF_StateAPI.cppF90 @@ -1853,7 +1853,7 @@ type(ESMF_KeywordEnforcer), optional:: keywordEnforcer ! must use keywords below ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return -#if 1 +#if 0 !TODO: need a way to indicate from calling side that info should be logged block type(ESMF_Info) :: info From 823cf516c2b6914cf3fc062f6333df37d2d95e7c Mon Sep 17 00:00:00 2001 From: Gerhard Theurich Date: Mon, 9 Dec 2024 11:50:42 -0800 Subject: [PATCH 175/207] Switch to the new "transferAllWithNamespace" option for the FieldTransferPolicy attribute. Update documentation. --- src/addon/NUOPC/doc/NUOPC_FieldMirror.tex | 10 ++++++---- src/addon/NUOPC/doc/NUOPC_Field_metadata.tex | 3 +-- src/addon/NUOPC/doc/NUOPC_State_metadata.tex | 5 ++--- src/addon/NUOPC/src/NUOPC_Connector.F90 | 4 ++-- 4 files changed, 11 insertions(+), 11 deletions(-) diff --git a/src/addon/NUOPC/doc/NUOPC_FieldMirror.tex b/src/addon/NUOPC/doc/NUOPC_FieldMirror.tex index 52b09caef0..d39e4549f9 100644 --- a/src/addon/NUOPC/doc/NUOPC_FieldMirror.tex +++ b/src/addon/NUOPC/doc/NUOPC_FieldMirror.tex @@ -3,12 +3,14 @@ \label{FieldMirror} -In some cases it is helpful for a NUOPC component to automatically mirror or match the set of fields advertised by another component. One purpose of this is to automatically resolve the import data dependencies of a component, by setting up a component that exactly provides all of the needed fields. This is currently used in the NUOPC Component Explorer: when driving a child NUOPC Model with required import fields, the Component Explorer uses the field mirroring capability to advertise in the driver-self export State the exact set of fields advertised in the child NUOPC Model. This ensures that the entire Initialize Phase Sequence will complete (because all dependencies are satisfied) and all phases can be exercised by the Component Explorer. +In some cases it is useful for a NUOPC component to match the set of fields advertised by another component, e.g. in order to connect to every field. NUOPC provides the concept of {\em field mirroring} that allows automatic matching by "mirroring" the fields of another component in their import- or exportState into their own States. One purpose of this is to automatically resolve the import data dependencies of a component, by setting up a component that exactly provides all of the needed fields. The field mirror capability is also useful with NUOPC Mediators since these components often exactly reflect, in separate States, the sets of fields of each of the connected components. The field mirroring capability, therefore, can be used to ensure that a Mediator is always capable of accepting fields from connected components, and removes the need to specify field lists in multiple places, i.e., both within a set of Model components connected to a Mediator and within the Mediator itself. -To access the field mirror capability, a component sets the {\tt FieldTransferPolicy} attribute during {\tt label\_Advertise}. The attribute is set on the Import- and/or Export- States to trigger field mirroring for each state, respectively. The default value of "TransferNone" indicates that no fields should be mirrored. The other options, "TransferAll", indicates that fields should be mirrored in the State of a connected component and "TransferAllAsNests", also indicates that fields should be mirrored in the State of a connected component but in this case, fields are added to nested state for each provider component. +To access the field mirror capability, a component sets the {\tt FieldTransferPolicy} attribute during {\tt label\_Advertise}. The attribute is set on the Import- and/or Export- States to trigger field mirroring for each state, respectively. The default value of "TransferNone" indicates that no fields should be mirrored. The other available options are "TransferAll" and "transferAllWithNamespace". Both options mirror transfer all of the fields from all of the connected States into the State that carries the attribute. The "TransferAll" option results in flat structure with all of the mirrored fields added directly to the acceptor State. A flat structure like this is typically the preferred situation for an ExportState, where the same fields might be connected to multiple consumer components. The "transferAllWithNamespace" option also mirrors all of the field from the connected State, but creates separate Namespaces for each connection, placing the associated mirrored fields into the respective nested State. A nested structure like this useful for an ImportState where connections are being made with multiple producer components. In this case the consumer component can query the "Namespace" attribute of each nested State to infer the component label of the associated producer components. -Each Connector consider the {\tt FieldTransferPolicy} Attribute on both its import and export States. If {\em both} States have a {\tt FieldTransferPolicy} of "TransferAll" or "TransferAllAsNests", then fields are transferred between the States in both directions (i.e., import to export and export to import). In case of "TransferAllAsNests", the received State by acceptor will have nested states for each provider. The transfer process works as follows: First, the {\tt TransferOfferGoemObject} attribute is reversed between the providing side and accepting side. Intuitively, if a field from the providing component is to be mirrored and it can provide its own geometric object, then the mirrored field on the accepting side should be set to accept a geometric object. Then, the field to be mirrored is advertised in the accepting State using a call to {\tt NUOPC\_Advertise()} such that the mirrored field shares the same Standard Name. The accepting State will have nested states if {\tt FieldTransferPolicy} is set to "TransferAllAsNests". +Each Connector considers the {\tt FieldTransferPolicy} attribute on both its import and export States. Each State that has the {\tt FieldTransferPolicy} attribute set to "transferAll" or "transferAllWithNamespace", will have then fields of the respecive other State mirror transferred. If {\em both} States have the {\tt FieldTransferPolicy} attribute set to trigger the mirror transfer, then fields are mirrored in both directions (i.e. import to export and export to import). -Components have the opportunity, using specialiozation point {\tt label\_ModifyAdvertised}, to modify any of the mirrored Fields in their Import/ExportState. After this the initialization sequence continues as usual. Since fields to be mirrored have been advertised with matching Standard Names, the field pairing algorithm will now match them in the usual way thereby establishing a connection between the original and mirrored fields. +The transfer process works as follows: First, the {\tt TransferOfferGoemObject} attribute is reversed between the providing side and accepting side. This is because if a field from the providing component is to be mirrored and it {\em can} provide its own geometric object, then the mirrored field on the accepting side should be set to {\em accept} a geometric object. The mirrored field is advertised in the accepting State using a call to {\tt NUOPC\_Advertise()} such that the mirrored field shares the same StandardName. + +Components have the opportunity to modify or remove any of the mirrored Fields in their Import/ExportState by using the {\tt label\_ModifyAdvertised} specialization point. After this point the initialization sequence continues as usual. Since the mirrored fields have been advertised with matching StandardName attribute, the field pairing algorithm now matches them in the usual manner, thereby establishing a connection between the original and the mirrored fields. diff --git a/src/addon/NUOPC/doc/NUOPC_Field_metadata.tex b/src/addon/NUOPC/doc/NUOPC_Field_metadata.tex index aa50cbed3d..0e2d44f8d8 100644 --- a/src/addon/NUOPC/doc/NUOPC_Field_metadata.tex +++ b/src/addon/NUOPC/doc/NUOPC_Field_metadata.tex @@ -3,7 +3,7 @@ using the JSON Pointer "/NUOPC/Instance/" prefix followed by the "Attribute name" as per the table below. E.g. "StandardName" is accessed using {\tt key="/NUOPC/Instance/StandardName"}. -\begin{longtable}{|p{.22\textwidth}|p{.6\textwidth}|p{.2\textwidth}|} +\begin{longtable}{|p{.3\textwidth}|p{.4\textwidth}|p{.3\textwidth}|} \hline\hline {\bf Attribute name} & {\bf Definition} & {\bf Controlled vocabulary}\\ \hline\hline @@ -31,6 +31,5 @@ {\tt MaxIndex} & Integer value list. If present equals the {\tt maxIndex} (of tile 1) of the provider field.during a GeomObject transfer. & {\em no restriction}\\ \hline {\tt TypeKind} & Integer value. If present equals the integer representation of {\tt typekind} of the provider field.during a GeomObject transfer. & {\em implementation dependent range}\\ \hline {\tt GeomLoc} & Integer value. If present equals the integer representation of {\tt staggerloc} (for Grid) or {\tt meshloc} (for Mesh) of the provider field.during a GeomObject transfer. & {\em implementation dependent range}\\ \hline - {\tt ProviderCompName} & String value holding the name of provider component that is indicated in run sequence\\ \hline \hline \end{longtable} diff --git a/src/addon/NUOPC/doc/NUOPC_State_metadata.tex b/src/addon/NUOPC/doc/NUOPC_State_metadata.tex index d191f5b8a7..26f4654306 100644 --- a/src/addon/NUOPC/doc/NUOPC_State_metadata.tex +++ b/src/addon/NUOPC/doc/NUOPC_State_metadata.tex @@ -3,12 +3,11 @@ using the JSON Pointer "/NUOPC/Instance/" prefix followed by the "Attribute name" as per the table below. E.g. "Namespace" is accessed using {\tt key="/NUOPC/Instance/Namespace"}. -\begin{longtable}{|p{.22\textwidth}|p{.6\textwidth}|p{.2\textwidth}|} +\begin{longtable}{|p{.3\textwidth}|p{.4\textwidth}|p{.3\textwidth}|} \hline\hline {\bf Attribute name} & {\bf Definition} & {\bf Controlled vocabulary}\\ \hline\hline {\tt Namespace} & String value holding the namespace of all the objects contained in the State.& {\em no restriction}\\ \hline - {\tt FieldTransferPolicy} & String value indicating to Connector to transfer/mirror Fields. & transferNone,\newline transferAll\\ \hline - {\tt CompName} & String value holding the name of provider component that is indicated in run sequence\\ \hline + {\tt FieldTransferPolicy} & String value indicating to Connector to transfer/mirror Fields. & transferNone,\newline transferAll,\newline transferAllWithNamespace\\ \hline \hline \end{longtable} diff --git a/src/addon/NUOPC/src/NUOPC_Connector.F90 b/src/addon/NUOPC/src/NUOPC_Connector.F90 index 7540b577fd..840f5d71c0 100644 --- a/src/addon/NUOPC/src/NUOPC_Connector.F90 +++ b/src/addon/NUOPC/src/NUOPC_Connector.F90 @@ -608,7 +608,7 @@ subroutine InitializeIPDv05p1(connector, importState, exportState, clock, rc) call doMirror(importState, exportState, acceptorVM=vm, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, file=trim(name)//":"//FILENAME)) return ! bail out - elseif (trim(exportXferPolicy)=="transferAllAsNests") then + elseif (trim(exportXferPolicy)=="transferAllWithNamespace") then ! access importState namespace so it can be transferred to exportState call NUOPC_GetAttribute(importState, name="Namespace", & value=namespace, rc=rc) @@ -703,7 +703,7 @@ subroutine InitializeIPDv05p1(connector, importState, exportState, clock, rc) call doMirror(exportState, importState, acceptorVM=vm, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, file=trim(name)//":"//FILENAME)) return ! bail out - elseif (trim(importXferPolicy)=="transferAllAsNests") then + elseif (trim(importXferPolicy)=="transferAllWithNamespace") then ! access exportState namespace so it can be transferred to importState call NUOPC_GetAttribute(exportState, name="Namespace", & value=namespace, rc=rc) From e7c7b126bfaa674e71e9642bd95ad7b6e8e8c560 Mon Sep 17 00:00:00 2001 From: Gerhard Theurich Date: Mon, 9 Dec 2024 12:16:26 -0800 Subject: [PATCH 176/207] Correct casing of "transferAll" option. --- src/addon/NUOPC/doc/NUOPC_FieldMirror.tex | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/addon/NUOPC/doc/NUOPC_FieldMirror.tex b/src/addon/NUOPC/doc/NUOPC_FieldMirror.tex index d39e4549f9..db3c1b8815 100644 --- a/src/addon/NUOPC/doc/NUOPC_FieldMirror.tex +++ b/src/addon/NUOPC/doc/NUOPC_FieldMirror.tex @@ -7,7 +7,7 @@ The field mirror capability is also useful with NUOPC Mediators since these components often exactly reflect, in separate States, the sets of fields of each of the connected components. The field mirroring capability, therefore, can be used to ensure that a Mediator is always capable of accepting fields from connected components, and removes the need to specify field lists in multiple places, i.e., both within a set of Model components connected to a Mediator and within the Mediator itself. -To access the field mirror capability, a component sets the {\tt FieldTransferPolicy} attribute during {\tt label\_Advertise}. The attribute is set on the Import- and/or Export- States to trigger field mirroring for each state, respectively. The default value of "TransferNone" indicates that no fields should be mirrored. The other available options are "TransferAll" and "transferAllWithNamespace". Both options mirror transfer all of the fields from all of the connected States into the State that carries the attribute. The "TransferAll" option results in flat structure with all of the mirrored fields added directly to the acceptor State. A flat structure like this is typically the preferred situation for an ExportState, where the same fields might be connected to multiple consumer components. The "transferAllWithNamespace" option also mirrors all of the field from the connected State, but creates separate Namespaces for each connection, placing the associated mirrored fields into the respective nested State. A nested structure like this useful for an ImportState where connections are being made with multiple producer components. In this case the consumer component can query the "Namespace" attribute of each nested State to infer the component label of the associated producer components. +To access the field mirror capability, a component sets the {\tt FieldTransferPolicy} attribute during {\tt label\_Advertise}. The attribute is set on the Import- and/or Export- States to trigger field mirroring for each state, respectively. The default value of "TransferNone" indicates that no fields should be mirrored. The other available options are "transferAll" and "transferAllWithNamespace". Both options mirror transfer all of the fields from all of the connected States into the State that carries the attribute. The "transferAll" option results in flat structure with all of the mirrored fields added directly to the acceptor State. A flat structure like this is typically the preferred situation for an ExportState, where the same fields might be connected to multiple consumer components. The "transferAllWithNamespace" option also mirrors all of the field from the connected State, but creates separate Namespaces for each connection, placing the associated mirrored fields into the respective nested State. A nested structure like this useful for an ImportState where connections are being made with multiple producer components. In this case the consumer component can query the "Namespace" attribute of each nested State to infer the component label of the associated producer components. Each Connector considers the {\tt FieldTransferPolicy} attribute on both its import and export States. Each State that has the {\tt FieldTransferPolicy} attribute set to "transferAll" or "transferAllWithNamespace", will have then fields of the respecive other State mirror transferred. If {\em both} States have the {\tt FieldTransferPolicy} attribute set to trigger the mirror transfer, then fields are mirrored in both directions (i.e. import to export and export to import). From 323578c1ea1e78c9084d067b6e76531a067963aa Mon Sep 17 00:00:00 2001 From: Gerhard Theurich Date: Mon, 9 Dec 2024 12:28:14 -0800 Subject: [PATCH 177/207] Correctly case the "transferNone" option in documentation. --- src/addon/NUOPC/doc/NUOPC_FieldMirror.tex | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/addon/NUOPC/doc/NUOPC_FieldMirror.tex b/src/addon/NUOPC/doc/NUOPC_FieldMirror.tex index db3c1b8815..cf4919c07b 100644 --- a/src/addon/NUOPC/doc/NUOPC_FieldMirror.tex +++ b/src/addon/NUOPC/doc/NUOPC_FieldMirror.tex @@ -7,7 +7,7 @@ The field mirror capability is also useful with NUOPC Mediators since these components often exactly reflect, in separate States, the sets of fields of each of the connected components. The field mirroring capability, therefore, can be used to ensure that a Mediator is always capable of accepting fields from connected components, and removes the need to specify field lists in multiple places, i.e., both within a set of Model components connected to a Mediator and within the Mediator itself. -To access the field mirror capability, a component sets the {\tt FieldTransferPolicy} attribute during {\tt label\_Advertise}. The attribute is set on the Import- and/or Export- States to trigger field mirroring for each state, respectively. The default value of "TransferNone" indicates that no fields should be mirrored. The other available options are "transferAll" and "transferAllWithNamespace". Both options mirror transfer all of the fields from all of the connected States into the State that carries the attribute. The "transferAll" option results in flat structure with all of the mirrored fields added directly to the acceptor State. A flat structure like this is typically the preferred situation for an ExportState, where the same fields might be connected to multiple consumer components. The "transferAllWithNamespace" option also mirrors all of the field from the connected State, but creates separate Namespaces for each connection, placing the associated mirrored fields into the respective nested State. A nested structure like this useful for an ImportState where connections are being made with multiple producer components. In this case the consumer component can query the "Namespace" attribute of each nested State to infer the component label of the associated producer components. +To access the field mirror capability, a component sets the {\tt FieldTransferPolicy} attribute during {\tt label\_Advertise}. The attribute is set on the Import- and/or Export- States to trigger field mirroring for each state, respectively. The default value of "transferNone" indicates that no fields should be mirrored. The other available options are "transferAll" and "transferAllWithNamespace". Both options mirror transfer all of the fields from all of the connected States into the State that carries the attribute. The "transferAll" option results in flat structure with all of the mirrored fields added directly to the acceptor State. A flat structure like this is typically the preferred situation for an ExportState, where the same fields might be connected to multiple consumer components. The "transferAllWithNamespace" option also mirrors all of the field from the connected State, but creates separate Namespaces for each connection, placing the associated mirrored fields into the respective nested State. A nested structure like this useful for an ImportState where connections are being made with multiple producer components. In this case the consumer component can query the "Namespace" attribute of each nested State to infer the component label of the associated producer components. Each Connector considers the {\tt FieldTransferPolicy} attribute on both its import and export States. Each State that has the {\tt FieldTransferPolicy} attribute set to "transferAll" or "transferAllWithNamespace", will have then fields of the respecive other State mirror transferred. If {\em both} States have the {\tt FieldTransferPolicy} attribute set to trigger the mirror transfer, then fields are mirrored in both directions (i.e. import to export and export to import). From 6d5fdfe3bab588b11da023d8a0efc9cb62a2c777 Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Mon, 9 Dec 2024 14:32:40 -0700 Subject: [PATCH 178/207] Fix some ctypes argtypes declarations The ESMC_MeshCreateFromFile change was needed to fix https://github.com/esmf-org/esmf/issues/326#issue-2721014799 with python 3.12 on my Mac. The ESMC_RouteHandleCreateFromFile change was needed to fix https://github.com/esmf-org/esmf/issues/326#issuecomment-2521203074 with python 3.12 on my Mac. The two other changes weren't causing any visible problems, but were things I noticed that should be fixed. Resolves esmf-org/esmf#326 --- src/addon/esmpy/src/esmpy/interface/cbindings.py | 11 ++++++----- 1 file changed, 6 insertions(+), 5 deletions(-) diff --git a/src/addon/esmpy/src/esmpy/interface/cbindings.py b/src/addon/esmpy/src/esmpy/interface/cbindings.py index 9ad79d74ce..bd63e7bda7 100644 --- a/src/addon/esmpy/src/esmpy/interface/cbindings.py +++ b/src/addon/esmpy/src/esmpy/interface/cbindings.py @@ -215,8 +215,8 @@ def ESMP_Initialize(logkind = constants.LogKind.MULTI): raise ValueError('ESMC_Initialize() failed with rc = '+str(rc)+'. '+ constants._errmsg) -_ESMF.ESMC_Finalize.restype = ct.c_int -_ESMF.ESMC_Finalize.argtypes = [] +_ESMF.ESMC_FinalizeWithFlag.restype = ct.c_int +_ESMF.ESMC_FinalizeWithFlag.argtypes = [ct.c_uint] def ESMP_Finalize(endFlag = constants.EndAction.NORMAL): """ @@ -389,7 +389,7 @@ def ESMP_VMGetGlobal(): constants._errmsg) return vm.ptr -_ESMF.ESMC_VMLogMemInfo.argtypes = [ct.c_int] +_ESMF.ESMC_VMLogMemInfo.restype = ct.c_int _ESMF.ESMC_VMLogMemInfo.argtypes = [ct.c_char_p] def ESMP_VMLogMemInfo(str): @@ -1216,7 +1216,8 @@ def ESMP_MeshCreate(parametricDim, spatialDim, coordSys=None): OptionalNamedConstant, Py3Char, OptionalNamedConstant, - Py3Char] + Py3Char, + ct.POINTER(ct.c_int)] @pio @netcdf @@ -2425,7 +2426,7 @@ def ESMP_GridspecInq(filename): #### RouteHandle ##################################################### _ESMF.ESMC_RouteHandleCreateFromFile.restype = ESMP_RouteHandle -_ESMF.ESMC_RouteHandleCreateFromFile.argtypes = [Py3Char] +_ESMF.ESMC_RouteHandleCreateFromFile.argtypes = [Py3Char, ct.POINTER(ct.c_int)] def ESMP_RouteHandleCreateFromFile(filename): """ Preconditions: ESMP has been initialized.\n From 338cd064a2db2966f22d91188077a9e70906a6d2 Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Mon, 9 Dec 2024 20:10:44 -0700 Subject: [PATCH 179/207] Fix LocStream's __getitem__ for python >= 3.12 The logic in LocStream's `__getitem__` was built around the assumption that `slice` objects aren't hashable. However, starting with Python 3.12, `slice` objects *are* hashable. This commit changes the implementation of this logic while keeping the same result as before for both slices and strings. Note that, in theory, there are a number of other types that can be returned from `get_formatted_slice`, depending on the type of the `slc` argument to `__getitem__`: a list of multiple `slice(None)` objects, a `np.ndarray`, a tuple of slices, or a tuple of `np.ndarray`s. These cases all would have led to errors with the previous logic (entering the `except` block but then hitting an error in `slc_ls.stop`, since none of those types have a `stop` attribute), and now will lead to different errors (in trying to execute `__getitem__` on these objects). See https://github.com/orgs/esmf-org/discussions/313 for some context. Co-authored-by: Xylar Asay-Davis --- src/addon/esmpy/src/esmpy/api/locstream.py | 13 ++++++++++--- 1 file changed, 10 insertions(+), 3 deletions(-) diff --git a/src/addon/esmpy/src/esmpy/api/locstream.py b/src/addon/esmpy/src/esmpy/api/locstream.py index a311eb7a8d..566d532499 100644 --- a/src/addon/esmpy/src/esmpy/api/locstream.py +++ b/src/addon/esmpy/src/esmpy/api/locstream.py @@ -125,10 +125,17 @@ def __getitem__(self, slc): # re-initialize slc_ls slc_ls = get_formatted_slice(slc, self.rank) - # slice at will - try: + if not isinstance(slc_ls, slice): + # This handles the case where slc is a str, and so slc_ls remains equal to + # slc, and thus is also a str. In theory, we could enter this block with + # slc_ls being various other types emerging from get_formatted_slice; these + # cases are not currently handled (they will generally lead to exceptions in + # `__getitem__`). + ret = super(LocStream, self).__getitem__(slc_ls) - except TypeError: + else: + # slc_ls is a slice + ret = self.copy() # upper bounds and size From 12b248a8389179d21686145977b39b6527132dca Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Tue, 10 Dec 2024 19:47:02 -0700 Subject: [PATCH 180/207] Fix creation of mask in grid_create functions The previous logic (involving the use of `.any()`) was causing an error in recent versions of NumPy. On inspection, the use of `.any()` looked wrong, and not what was intended. In addition, the use of `.data` in other functions caused errors; I think these functions that used `.data` were never being called, so these errors weren't showing up. This commit fixes the logic to what I think was intended. This fix caused a failure in `test_field_regrid_zeroregion`. Bob Oehmke and I looked at the test together and felt that the test was incorrect and should actually be asserting that values are -100 where the mask is 0 (rather than having 0 values there), so I have made this change as well. This was passing previously because the mask was never 0 due to the above bug. Resolves https://github.com/esmf-org/esmf/issues/329 --- .../src/esmpy/test/test_api/test_regrid.py | 5 +++-- .../esmpy/src/esmpy/util/grid_utilities.py | 20 +++++++++---------- 2 files changed, 13 insertions(+), 12 deletions(-) diff --git a/src/addon/esmpy/src/esmpy/test/test_api/test_regrid.py b/src/addon/esmpy/src/esmpy/test/test_api/test_regrid.py index 3666f7841a..4ca3075655 100644 --- a/src/addon/esmpy/src/esmpy/test/test_api/test_regrid.py +++ b/src/addon/esmpy/src/esmpy/test/test_api/test_regrid.py @@ -836,11 +836,12 @@ def test_field_regrid_zeroregion(self): dst_mask_values=np.atleast_1d(np.array([0]))) dstfield = rh(srcfield, dstfield, zero_region=Region.SELECT) - # validate that the masked values were not zeroed out + # validate that the masked values were not zeroed out (zero_region=Region.SELECT + # should leave the masked values at their original values) for i in range(dstfield.data.shape[x]): for j in range(dstfield.data.shape[y]): if dstfield.grid.mask[StaggerLoc.CENTER][i, j] == 0: - assert(dstfield[i, j] == 0) + assert(dstfield.data[i, j] == -100) @pytest.mark.skipif(_ESMF_PIO==False, reason="PIO required in ESMF build") @pytest.mark.skipif(_ESMF_NETCDF==False, reason="NetCDF required in ESMF build") diff --git a/src/addon/esmpy/src/esmpy/util/grid_utilities.py b/src/addon/esmpy/src/esmpy/util/grid_utilities.py index 83597f85ca..38786f285f 100644 --- a/src/addon/esmpy/src/esmpy/util/grid_utilities.py +++ b/src/addon/esmpy/src/esmpy/util/grid_utilities.py @@ -95,8 +95,8 @@ def grid_create_from_coordinates(xcoords, ycoords, xcorners=False, ycorners=Fals if domask: mask = grid.add_item(esmpy.GridItem.MASK) mask[:] = 1 - mask[np.where((1.75 <= gridXCenter.any() < 2.25) & - (1.75 <= gridYCenter.any() < 2.25))] = 0 + mask[np.where((1.75 <= gridXCenter) & (gridXCenter < 2.25) & + (1.75 <= gridYCenter) & (gridYCenter < 2.25))] = 0 # add arbitrary areas values if doarea: @@ -180,8 +180,8 @@ def grid_create_from_coordinates_periodic(longitudes, latitudes, lon_corners=Fal if domask: mask = grid.add_item(esmpy.GridItem.MASK) mask[:] = 1 - mask[np.where((1.75 <= gridXCenter.any() < 2.25) & - (1.75 <= gridYCenter.any() < 2.25))] = 0 + mask[np.where((1.75 <= gridXCenter) & (gridXCenter < 2.25) & + (1.75 <= gridYCenter) & (gridYCenter < 2.25))] = 0 return grid @@ -286,9 +286,9 @@ def grid_create_from_coordinates_3d(xcoords, ycoords, zcoords, xcorners=False, y if domask: mask = grid.add_item(esmpy.GridItem.MASK) mask[:] = 1 - mask[np.where((1.75 < gridXCenter.data < 2.25) & - (1.75 < gridYCenter.data < 2.25) & - (1.75 < gridZCenter.data < 2.25))] = 0 + mask[np.where((1.75 <= gridXCenter) & (gridXCenter < 2.25) & + (1.75 <= gridYCenter) & (gridYCenter < 2.25) & + (1.75 <= gridZCenter) & (gridZCenter < 2.25))] = 0 # add arbitrary areas values if doarea: @@ -394,9 +394,9 @@ def grid_create_from_coordinates_periodic_3d(longitudes, latitudes, heights, if domask: mask = grid.add_item(esmpy.GridItem.MASK) mask[:] = 1 - mask[np.where((1.75 <= gridXCenter.data < 2.25) & - (1.75 <= gridYCenter.data < 2.25) & - (1.75 <= gridZCenter.data < 2.25))] = 0 + mask[np.where((1.75 <= gridXCenter) & (gridXCenter < 2.25) & + (1.75 <= gridYCenter) & (gridYCenter < 2.25) & + (1.75 <= gridZCenter) & (gridZCenter < 2.25))] = 0 return grid From c0aeabdd7885009dba4db5cebf6652e63d6c9265 Mon Sep 17 00:00:00 2001 From: Robert Oehmke Date: Wed, 11 Dec 2024 15:34:27 -0700 Subject: [PATCH 181/207] Only process active elements. Remove debug output. --- src/Infrastructure/Mesh/src/ESMCI_XGridUtil.C | 25 +++++++++---------- src/Infrastructure/Mesh/src/Legacy/ESMCI_SM.C | 4 --- .../XGrid/tests/ESMF_XGridUTest.F90 | 4 +-- 3 files changed, 14 insertions(+), 19 deletions(-) diff --git a/src/Infrastructure/Mesh/src/ESMCI_XGridUtil.C b/src/Infrastructure/Mesh/src/ESMCI_XGridUtil.C index 1ffee63abf..30773c8da9 100644 --- a/src/Infrastructure/Mesh/src/ESMCI_XGridUtil.C +++ b/src/Infrastructure/Mesh/src/ESMCI_XGridUtil.C @@ -2834,8 +2834,8 @@ void calc_wgts_from_xgrid_to_side_mesh(Mesh *src_xgrid_mesh, Mesh *dst_side_mesh for (; sxei != sxee; ++sxei) { MeshObj &src_elem = *sxei; - // Skip non-local elements - if (!GetAttr(src_elem).is_locally_owned()) continue; + // Skip non-active (e.g. ghostcell) elements + if (!GetAttr(src_elem).GetContext().is_set(Attr::ACTIVE_ID)) continue; // Get XGrid element ind // (Round to nearest to take care of possible representation issues) @@ -2854,7 +2854,10 @@ void calc_wgts_from_xgrid_to_side_mesh(Mesh *src_xgrid_mesh, Mesh *dst_side_mesh Mesh::MeshObjIDMap::iterator mi = dstMesh.map_find(MeshObj::ELEMENT, dst_orig_elem_id); if (mi != dstMesh.map_end(MeshObj::ELEMENT)) { MeshObj *dst_elem=&*mi; - + + // Skip non-active (e.g. ghostcell) elements + if (!GetAttr(*dst_elem).GetContext().is_set(Attr::ACTIVE_ID)) continue; + // Create Search result Search_result *sr=new Search_result(); sr->elem=&src_elem; // Add src elem @@ -2903,16 +2906,9 @@ void calc_wgts_from_xgrid_to_side_mesh(Mesh *src_xgrid_mesh, Mesh *dst_side_mesh for (; dxei != dxee; ++dxei) { MeshObj &dst_elem = *dxei; - if (dst_elem.get_id() == 107) { - printf("%d# dXGOE H1 dst_elem=%d\n",Par::Rank(),dst_elem.get_id()); - } - - // Skip non-local elements - // if (!GetAttr(dst_elem).is_locally_owned()) continue; - - if (dst_elem.get_id() == 107) { - printf("%d# dXGOE H2 dst_elem=%d\n",Par::Rank(),dst_elem.get_id()); - } + /* XMRKX */ + // Skip non-active (e.g. ghostcell) elements + if (!GetAttr(dst_elem).GetContext().is_set(Attr::ACTIVE_ID)) continue; // Get XGrid element ind // (Round to nearest to take care of possible representation issues) @@ -2932,6 +2928,9 @@ void calc_wgts_from_xgrid_to_side_mesh(Mesh *src_xgrid_mesh, Mesh *dst_side_mesh if (mi != srcMesh.map_end(MeshObj::ELEMENT)) { MeshObj *src_elem=&*mi; + // Skip non-active (e.g. ghostcell) elements + if (!GetAttr(*src_elem).GetContext().is_set(Attr::ACTIVE_ID)) continue; + // Find search result to add to std::map::iterator itsr=id_to_sr_map.find(src_elem->get_id()); diff --git a/src/Infrastructure/Mesh/src/Legacy/ESMCI_SM.C b/src/Infrastructure/Mesh/src/Legacy/ESMCI_SM.C index 21d9dbc661..cc1095034e 100644 --- a/src/Infrastructure/Mesh/src/Legacy/ESMCI_SM.C +++ b/src/Infrastructure/Mesh/src/Legacy/ESMCI_SM.C @@ -1490,10 +1490,6 @@ namespace ESMCI { // Get dst coords get_elem_coords_3D_ccw(dst_elem, dst_cfield, MAX_NUM_DST_POLY_NODES, tmp_coords, &num_dst_nodes, dst_coords); - - if (dst_elem->get_id() == 107) { - printf("%d # dst id=%d\n",Par::Rank(),dst_elem->get_id()); - } // Get rid of degenerate edges remove_0len_edges3D(&num_dst_nodes, dst_coords); diff --git a/src/Infrastructure/XGrid/tests/ESMF_XGridUTest.F90 b/src/Infrastructure/XGrid/tests/ESMF_XGridUTest.F90 index 750b376acd..24b494bd7d 100644 --- a/src/Infrastructure/XGrid/tests/ESMF_XGridUTest.F90 +++ b/src/Infrastructure/XGrid/tests/ESMF_XGridUTest.F90 @@ -5556,7 +5556,7 @@ subroutine test_CSGridToGrid_2nd(rc) enddo ! lDE -#if 1 +#if 0 call ESMF_GridWriteVTK(srcGrid,staggerloc=ESMF_STAGGERLOC_CORNER, & filename="srcGridCnr", & rc=localrc) @@ -5593,7 +5593,7 @@ subroutine test_CSGridToGrid_2nd(rc) ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return -#if 1 +#if 0 call ESMF_XGridGet(xgrid, mesh=xgridMesh, rc=localrc) if (ESMF_LogFoundError(localrc, & ESMF_ERR_PASSTHRU, & From db5ef5fe98090317881fe7d02ddec519fd8bfcc4 Mon Sep 17 00:00:00 2001 From: Gerhard Theurich Date: Wed, 11 Dec 2024 14:52:12 -0800 Subject: [PATCH 182/207] Add documentation for the missing 'CplSet' attribute, and small documentation improvements. --- src/addon/NUOPC/doc/NUOPC_State_metadata.tex | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/src/addon/NUOPC/doc/NUOPC_State_metadata.tex b/src/addon/NUOPC/doc/NUOPC_State_metadata.tex index 26f4654306..890b65bf60 100644 --- a/src/addon/NUOPC/doc/NUOPC_State_metadata.tex +++ b/src/addon/NUOPC/doc/NUOPC_State_metadata.tex @@ -7,7 +7,8 @@ \hline\hline {\bf Attribute name} & {\bf Definition} & {\bf Controlled vocabulary}\\ \hline\hline - {\tt Namespace} & String value holding the namespace of all the objects contained in the State.& {\em no restriction}\\ \hline - {\tt FieldTransferPolicy} & String value indicating to Connector to transfer/mirror Fields. & transferNone,\newline transferAll,\newline transferAllWithNamespace\\ \hline + {\tt Namespace} & String value holding the namespace that applies to all of the objects contained in the State.& {\em no restriction}\\ \hline + {\tt FieldTransferPolicy} & String value indicating to Connector whether to mirror transfer Fields into this State. & transferNone,\newline transferAll,\newline transferAllWithNamespace\\ \hline + {\tt CplSet} & String value holding the coupling set name that applies to all of the objects contained in the State.& {\em no restriction}\\ \hline \hline \end{longtable} From ffc2aacc5ff8317ba030b773a02871bf42cc50a6 Mon Sep 17 00:00:00 2001 From: Robert Oehmke Date: Wed, 11 Dec 2024 22:09:21 -0700 Subject: [PATCH 183/207] Change XGrid version of ESMF_FieldRegridStore() to use ESMF_RegridStore() directly. --- .../Field/src/ESMF_FieldRegrid.F90 | 298 ++++++++++-------- .../XGrid/tests/ESMF_XGridUTest.F90 | 6 +- 2 files changed, 166 insertions(+), 138 deletions(-) diff --git a/src/Infrastructure/Field/src/ESMF_FieldRegrid.F90 b/src/Infrastructure/Field/src/ESMF_FieldRegrid.F90 index 74744ae252..849ed67017 100644 --- a/src/Infrastructure/Field/src/ESMF_FieldRegrid.F90 +++ b/src/Infrastructure/Field/src/ESMF_FieldRegrid.F90 @@ -3478,7 +3478,7 @@ subroutine ESMF_FieldRegridStoreX(xgrid, srcField, dstField, keywordEnforcer, & type(ESMF_GeomType_Flag) :: geomtype, srcgeomtype, dstgeomtype type(ESMF_XGrid) :: srcXGrid, dstXGrid type(ESMF_Mesh) :: srcMesh, dstMesh - + type(ESMF_Array) :: srcArray, dstArray integer :: srcIdx, dstIdx, ngrid_a, ngrid_b integer :: sideAGC, sideAMC, sideBGC, sideBMC type(ESMF_XGridSide_Flag) :: srcSide, dstSide @@ -3494,11 +3494,10 @@ subroutine ESMF_FieldRegridStoreX(xgrid, srcField, dstField, keywordEnforcer, & type(ESMF_RegridMethod_Flag) :: lregridmethod type(ESMF_Mesh) :: xgridMesh, sideMesh logical :: sideMeshDestroy - type(ESMF_Field) :: tmpSrcField, tmpDstField - type(ESMF_Field) :: sideField - type(ESMF_Typekind_Flag) :: fieldTypeKind integer :: xgridSide, xgridInd, sideMeshSide, sideMeshInd + type(ESMF_PointList) :: dstPointList, srcPointList + type(ESMF_Array) :: statusArray ! Initialize return code; assume failure until success is certain localrc = ESMF_SUCCESS @@ -3993,182 +3992,213 @@ subroutine ESMF_FieldRegridStoreX(xgrid, srcField, dstField, keywordEnforcer, & rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return - else + + else if (lregridmethod .eq. ESMF_REGRIDMETHOD_CONSERVE_2ND) then + + ! Get Super Mesh + call ESMF_XGridGet(xgrid, mesh=xgridMesh, rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, rcToReturn=rc)) return + + ! Set XGrid side and ind information + xgridSide=3 + xgridInd=0 + call c_esmc_meshsetxgridinfo(xgridMesh, xgridSide, xgridInd, localrc) + if (ESMF_LogFoundError(localrc, & + ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, rcToReturn=rc)) return + + ! Init side info sideMeshDestroy=.false. sideMeshSide=0 sideMeshInd=0 - ! Set temporary field for source - if (srcSide == ESMF_XGRIDSIDE_BALANCED) then + ! Get srcMesh + if (srcSide == ESMF_XGRIDSIDE_BALANCED) then ! Src is XGrid - ! Get Field typekind - call ESMF_FieldGet(srcField, typekind=fieldTypeKind, & - rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, rcToReturn=rc)) return + ! SrcMesh is super mesh + srcMesh=xgridMesh - ! Get Super Mesh - call ESMF_XGridGet(xgrid, mesh=xgridMesh, rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, rcToReturn=rc)) return + else ! src is side mesh - ! Create temporary field - tmpSrcField=ESMF_FieldCreate(xgridMesh, & - typekind=fieldTypeKind, & - meshloc=ESMF_MESHLOC_ELEMENT, & - rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, rcToReturn=rc)) return - else - sideField=srcField + ! Set side info sideMeshSide=1 ! side A if (srcSide == ESMF_XGRIDSIDE_B) sideMeshSide=2 ! side B sideMeshInd=srcIdx - endif - - ! Set temporary field for dst - if (dstSide == ESMF_XGRIDSIDE_BALANCED) then - ! Get Field typekind - call ESMF_FieldGet(dstField, typekind=fieldTypeKind, & - rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, rcToReturn=rc)) return - - ! Get Super Mesh - call ESMF_XGridGet(xgrid, mesh=xgridMesh, rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, rcToReturn=rc)) return - - ! Create temporary field - tmpDstField=ESMF_FieldCreate(xgridMesh, & - typekind=fieldTypeKind, & - meshloc=ESMF_MESHLOC_ELEMENT, & + ! Get/create sideMesh + call ESMF_FieldGet(srcField, geomtype=geomtype, & rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return - else - sideField=dstField - sideMeshSide=1 ! side A - if (dstSide == ESMF_XGRIDSIDE_B) sideMeshSide=2 ! side B - sideMeshInd=dstIdx - endif - ! Set XGrid side and ind information - xgridSide=3 - xgridInd=0 - call c_esmc_meshsetxgridinfo(xgridMesh, xgridSide, xgridInd, localrc) - if (ESMF_LogFoundError(localrc, & - ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, rcToReturn=rc)) return + if (geomtype == ESMF_GEOMTYPE_GRID) then + call ESMF_FieldGet(srcField, grid=srcGrid, & + rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, rcToReturn=rc)) return + + ! Create Mesh from Grid + sideMesh=conserve_GridToMesh(srcGrid, & + !maskValues, turnedOnMeshElemMask, & + rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, rcToReturn=rc)) return - ! Get/create sideMesh - call ESMF_FieldGet(sideField, geomtype=geomtype, & - rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, rcToReturn=rc)) return + ! Record that we created the mesh + sideMeshDestroy=.true. - if (geomtype == ESMF_GEOMTYPE_GRID) then - call ESMF_FieldGet(sideField, grid=srcGrid, & - rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, rcToReturn=rc)) return + ! srcMesh is sideMesh + srcMesh=sideMesh + + else if (geomtype == ESMF_GEOMTYPE_MESH) then - ! Create Mesh from Grid - sideMesh=conserve_GridToMesh(srcGrid, & - !maskValues, turnedOnMeshElemMask, & - rc=localrc) + ! Get side Mesh + call ESMF_FieldGet(srcField, mesh=sideMesh, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, rcToReturn=rc)) return + ESMF_CONTEXT, rcToReturn=rc)) return + + ! srcMesh is sideMesh + srcMesh=sideMesh + + else + call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_BAD, & + msg="srcField is not built on Grid, or Mesh.", & + ESMF_CONTEXT, rcToReturn=rc) + return + endif + endif + + ! Get srcArray + call ESMF_FieldGet(srcField, array=srcArray, & + rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, rcToReturn=rc)) return - ! Record that we created the mesh - sideMeshDestroy=.true. - else if (geomtype == ESMF_GEOMTYPE_MESH) then - call ESMF_FieldGet(sideField, mesh=sideMesh, rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, rcToReturn=rc)) return - else - call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_BAD, & - msg=" side Field is not built on Grid, or Mesh.", & - ESMF_CONTEXT, rcToReturn=rc) - return - endif + + ! Get dstMesh + if (dstSide == ESMF_XGRIDSIDE_BALANCED) then ! Dst is XGrid + + ! DstMesh is super mesh + dstMesh=xgridMesh - ! Set side Mesh info - call c_esmc_meshsetxgridinfo(sideMesh, sideMeshSide, sideMeshInd, localrc) - if (ESMF_LogFoundError(localrc, & - ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, rcToReturn=rc)) return + else ! dst is side mesh - ! Set temporary field for side - if (srcSide /= ESMF_XGRIDSIDE_BALANCED) then + ! Set side info + sideMeshSide=1 ! side A + if (dstSide == ESMF_XGRIDSIDE_B) sideMeshSide=2 ! side B + sideMeshInd=dstIdx - ! Get Field typekind - call ESMF_FieldGet(srcField, typekind=fieldTypeKind, & - rc=localrc) + ! Get/create sideMesh + call ESMF_FieldGet(dstField, geomtype=geomtype, & + rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return - ! Create temporary field - tmpSrcField=ESMF_FieldCreate(sideMesh, & - typekind=fieldTypeKind, & - meshloc=ESMF_MESHLOC_ELEMENT, & + if (geomtype == ESMF_GEOMTYPE_GRID) then + call ESMF_FieldGet(dstField, grid=dstGrid, & rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, rcToReturn=rc)) return - else if (dstSide /= ESMF_XGRIDSIDE_BALANCED) then + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, rcToReturn=rc)) return + + ! Create Mesh from Grid + sideMesh=conserve_GridToMesh(dstGrid, & + !maskValues, turnedOnMeshElemMask, & + rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, rcToReturn=rc)) return - ! Get Field typekind - call ESMF_FieldGet(dstField, typekind=fieldTypeKind, & - rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, rcToReturn=rc)) return + ! Record that we created the mesh + sideMeshDestroy=.true. - ! Create temporary field - tmpDstField=ESMF_FieldCreate(sideMesh, & - typekind=fieldTypeKind, & - meshloc=ESMF_MESHLOC_ELEMENT, & - rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, rcToReturn=rc)) return - endif + ! dstMesh is sideMesh + dstMesh=sideMesh + + else if (geomtype == ESMF_GEOMTYPE_MESH) then + ! Get side Mesh + call ESMF_FieldGet(dstField, mesh=sideMesh, rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, rcToReturn=rc)) return + + ! dstMesh is sideMesh + dstMesh=sideMesh + + else + call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_BAD, & + msg="dstField is not built on Grid, or Mesh.", & + ESMF_CONTEXT, rcToReturn=rc) + return + endif + endif - ! Generate routehandle other that 1st order conserve - call ESMF_FieldRegridStoreNX(& - srcField=tmpSrcField, & - dstField=tmpDstField, & -! ?? srcMaskValues, dstMaskValues, & - regridmethod=lregridmethod, & - srcTermProcessing=srcTermProcessing, & - pipeLineDepth=pipeLineDepth, & - routehandle=routehandle, & - srcFracField=srcFracField, & - dstFracField=dstFracField, & - rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, rcToReturn=rc)) return + ! Get dstArray + call ESMF_FieldGet(dstField, array=dstArray, & + rc=localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, rcToReturn=rc)) return - ! Get rid of temporary source Fields if necessary - call ESMF_FieldDestroy(tmpSrcField, rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, rcToReturn=rc)) return + + ! Set side Mesh info + call c_esmc_meshsetxgridinfo(sideMesh, sideMeshSide, sideMeshInd, localrc) + if (ESMF_LogFoundError(localrc, & + ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, rcToReturn=rc)) return - call ESMF_FieldDestroy(tmpDstField, rc=localrc) + ! Generate routehandle for 2nd order conservative + call ESMF_RegridStore(srcMesh, srcArray, & + srcPointList, .false., & + dstMesh, dstArray, & + dstPointList, .false. , & + regridMethod=ESMF_REGRIDMETHOD_CONSERVE_2ND, & + lineType=ESMF_LINETYPE_GREAT_CIRCLE, & + normType=ESMF_NORMTYPE_DSTAREA, & + vectorRegrid=.false., & + polemethod=ESMF_POLEMETHOD_NONE, regridPoleNPnts=4, & + hasStatusArray=.false., statusArray=statusArray, & + extrapMethod=ESMF_EXTRAPMETHOD_NONE, & + extrapNumSrcPnts=8, extrapDistExponent=2.0_ESMF_KIND_R8, & + extrapNumLevels=2, extrapNumInputLevels=2, & + unmappedaction=ESMF_UNMAPPEDACTION_ERROR, & + ignoreDegenerate=.true., & + srcTermProcessing=srcTermProcessing, & + pipeLineDepth=pipeLineDepth, & + routehandle=routeHandle, & + checkFlag=.false., & + rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return + ! If present, copy src fraction information + if (present(srcFracField)) then + call copyFracsIntoOutputField(srcField, srcMesh, srcFracField, localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, rcToReturn=rc)) return + endif + + ! If present, copy dst fraction information + if (present(dstFracField)) then + call copyFracsIntoOutputField(dstField, dstMesh, dstFracField, localrc) + if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, rcToReturn=rc)) return + endif + ! Get rid of temporary sideMesh if necessary if (sideMeshDestroy) then call ESMF_MeshDestroy(sideMesh, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return endif - + + else + call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_BAD, & + msg=" unsupported regridMethod with XGrid version of ESMF_FieldRegridStore().", & + ESMF_CONTEXT, rcToReturn=rc) + return endif diff --git a/src/Infrastructure/XGrid/tests/ESMF_XGridUTest.F90 b/src/Infrastructure/XGrid/tests/ESMF_XGridUTest.F90 index 24b494bd7d..a5b2c442ea 100644 --- a/src/Infrastructure/XGrid/tests/ESMF_XGridUTest.F90 +++ b/src/Infrastructure/XGrid/tests/ESMF_XGridUTest.F90 @@ -56,7 +56,7 @@ program ESMF_XGridUTest !------------------------------------------------------------------------ -#if 0 +#if 1 !------------------------------------------------------------------------ !NEX_UTest ! Don't know if I should keep this turned on as an actual unit test, but it's useful for debugging @@ -211,9 +211,7 @@ program ESMF_XGridUTest write(failMsg, *) "" write(name, *) "Test 2nd order on an XGrid between Cartesian Meshes" call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE) -#endif - -#if 1 + !------------------------------------------------------------------------ !NEX_UTest ! Create an XGrid in 2D from Meshes From 4e8a8bb2b610f2ce81f44a0d33d98dd36e14d07c Mon Sep 17 00:00:00 2001 From: Robert Oehmke Date: Thu, 12 Dec 2024 11:53:12 -0700 Subject: [PATCH 184/207] Turn off side info after creating XGrid, so that it doesn't cause problems elsewhere. --- .../XGrid/src/ESMF_XGridCreate.F90 | 101 +++++++++++------- 1 file changed, 65 insertions(+), 36 deletions(-) diff --git a/src/Infrastructure/XGrid/src/ESMF_XGridCreate.F90 b/src/Infrastructure/XGrid/src/ESMF_XGridCreate.F90 index 6dd74344b1..823b53702d 100644 --- a/src/Infrastructure/XGrid/src/ESMF_XGridCreate.F90 +++ b/src/Infrastructure/XGrid/src/ESMF_XGridCreate.F90 @@ -1520,6 +1520,12 @@ function ESMF_XGridCreate(keywordEnforcer, & if(xgtype%storeOverlay) then xgtype%mesh = mesh + ! If keeping, turn off side information + call c_esmc_meshsetxgridinfo(mesh, -1, -1, localrc) + if (ESMF_LogFoundError(localrc, & + ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, rcToReturn=rc)) return + !! Debug output of xgrid mesh #ifdef BOB_XGRID_DEBUG call ESMF_MeshWrite(mesh, "xgrid_mid_mesh") @@ -1532,51 +1538,74 @@ function ESMF_XGridCreate(keywordEnforcer, & ESMF_CONTEXT, rcToReturn=rc)) return endif + ! Clean up Meshes for side A do i = 1, ngrid_a - if(present(sideAMaskValues)) then - call ESMF_MeshTurnOffCellMask(meshAt(i), rc=localrc); - if (ESMF_LogFoundError(localrc, & - ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, rcToReturn=rc)) return - endif - if(xggt_a(i) == ESMF_XGRIDGEOMTYPE_GRID) then - call ESMF_MeshDestroy(meshAt(i), rc=localrc) - if (ESMF_LogFoundError(localrc, & - ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, rcToReturn=rc)) return - endif + ! If it originally came from a Grid, then just destroy + if(xggt_a(i) == ESMF_XGRIDGEOMTYPE_GRID) then + call ESMF_MeshDestroy(meshAt(i), rc=localrc) + if (ESMF_LogFoundError(localrc, & + ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, rcToReturn=rc)) return + else ! ...otherwise turn things off + ! Turn off masking + if(present(sideAMaskValues)) then + call ESMF_MeshTurnOffCellMask(meshAt(i), rc=localrc); + if (ESMF_LogFoundError(localrc, & + ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, rcToReturn=rc)) return + endif + + ! Turn off side information + call c_esmc_meshsetxgridinfo(meshAt(i), -1, -1, localrc) + if (ESMF_LogFoundError(localrc, & + ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, rcToReturn=rc)) return + endif enddo + ! Clean up Meshes for side B do i = 1, ngrid_b - if(present(sideBMaskValues)) then - call ESMF_MeshTurnOffCellMask(meshBt(i), rc=localrc); - if (ESMF_LogFoundError(localrc, & - ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, rcToReturn=rc)) return - endif - if(xggt_b(i) == ESMF_XGRIDGEOMTYPE_GRID) then - call ESMF_MeshDestroy(meshBt(i), rc=localrc) - if (ESMF_LogFoundError(localrc, & - ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, rcToReturn=rc)) return - endif + ! If it originally came from a Grid, then just destroy + if(xggt_b(i) == ESMF_XGRIDGEOMTYPE_GRID) then + call ESMF_MeshDestroy(meshBt(i), rc=localrc) + if (ESMF_LogFoundError(localrc, & + ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, rcToReturn=rc)) return + + else ! ...otherwise turn things off + + ! Turn off masking + if(present(sideBMaskValues)) then + call ESMF_MeshTurnOffCellMask(meshBt(i), rc=localrc); + if (ESMF_LogFoundError(localrc, & + ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, rcToReturn=rc)) return + endif + + ! Turn off side information + call c_esmc_meshsetxgridinfo(meshBt(i), -1, -1, localrc) + if (ESMF_LogFoundError(localrc, & + ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, rcToReturn=rc)) return + + endif enddo - + deallocate(meshAt, meshBt) deallocate(xggt_a, xggt_b) - ! Finalize XGrid Creation - xgtype%online = 1 - xgtype%status = ESMF_STATUS_READY - ESMF_XGridCreate%xgtypep => xgtype - ESMF_INIT_SET_CREATED(ESMF_XGridCreate) - - !call ESMF_XGridValidate(ESMF_XGridCreate, rc=localrc) - !if (ESMF_LogFoundError(localrc, & - ! ESMF_ERR_PASSTHRU, & - ! ESMF_CONTEXT, rcToReturn=rc)) return + ! Finalize XGrid Creation + xgtype%online = 1 + xgtype%status = ESMF_STATUS_READY + ESMF_XGridCreate%xgtypep => xgtype + ESMF_INIT_SET_CREATED(ESMF_XGridCreate) - if(present(rc)) rc = ESMF_SUCCESS + !call ESMF_XGridValidate(ESMF_XGridCreate, rc=localrc) + !if (ESMF_LogFoundError(localrc, & + ! ESMF_ERR_PASSTHRU, & + ! ESMF_CONTEXT, rcToReturn=rc)) return + + if(present(rc)) rc = ESMF_SUCCESS end function ESMF_XGridCreate From 69450f492eb9ff4e45c1897765b38f2bdac9aeca Mon Sep 17 00:00:00 2001 From: Robert Oehmke Date: Thu, 12 Dec 2024 13:58:27 -0700 Subject: [PATCH 185/207] Turn off mesh side info after using it to do 2nd order XGrid calculation. --- .../Field/src/ESMF_FieldRegrid.F90 | 21 +++++++++++++++++-- src/Infrastructure/Mesh/include/ESMCI_Mesh.h | 4 ++-- .../XGrid/src/ESMF_XGridCreate.F90 | 4 +++- 3 files changed, 24 insertions(+), 5 deletions(-) diff --git a/src/Infrastructure/Field/src/ESMF_FieldRegrid.F90 b/src/Infrastructure/Field/src/ESMF_FieldRegrid.F90 index 849ed67017..b211605318 100644 --- a/src/Infrastructure/Field/src/ESMF_FieldRegrid.F90 +++ b/src/Infrastructure/Field/src/ESMF_FieldRegrid.F90 @@ -4148,6 +4148,7 @@ subroutine ESMF_FieldRegridStoreX(xgrid, srcField, dstField, keywordEnforcer, & ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return + ! Generate routehandle for 2nd order conservative call ESMF_RegridStore(srcMesh, srcArray, & srcPointList, .false., & @@ -4162,7 +4163,7 @@ subroutine ESMF_FieldRegridStoreX(xgrid, srcField, dstField, keywordEnforcer, & extrapMethod=ESMF_EXTRAPMETHOD_NONE, & extrapNumSrcPnts=8, extrapDistExponent=2.0_ESMF_KIND_R8, & extrapNumLevels=2, extrapNumInputLevels=2, & - unmappedaction=ESMF_UNMAPPEDACTION_ERROR, & + unmappedaction=ESMF_UNMAPPEDACTION_IGNORE, & ! Otherwise, dst = sideMesh will often lead to unmapped errors ignoreDegenerate=.true., & srcTermProcessing=srcTermProcessing, & pipeLineDepth=pipeLineDepth, & @@ -4172,6 +4173,10 @@ subroutine ESMF_FieldRegridStoreX(xgrid, srcField, dstField, keywordEnforcer, & if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return + ! The fraction information should be the same as stored in the XGrid. However, + ! use the version actually calculated during 2nd order calc, so that it matches more + ! precisely the values used during that calculation. + ! If present, copy src fraction information if (present(srcFracField)) then call copyFracsIntoOutputField(srcField, srcMesh, srcFracField, localrc) @@ -4187,6 +4192,18 @@ subroutine ESMF_FieldRegridStoreX(xgrid, srcField, dstField, keywordEnforcer, & endif + ! Reset Mesh side info so that it doesn't interfere elsewhere + call c_esmc_meshsetxgridinfo(xgridMesh, -1, -1, localrc) + if (ESMF_LogFoundError(localrc, & + ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, rcToReturn=rc)) return + + call c_esmc_meshsetxgridinfo(sideMesh, -1, -1, localrc) + if (ESMF_LogFoundError(localrc, & + ESMF_ERR_PASSTHRU, & + ESMF_CONTEXT, rcToReturn=rc)) return + + ! Get rid of temporary sideMesh if necessary if (sideMeshDestroy) then call ESMF_MeshDestroy(sideMesh, rc=localrc) @@ -4201,7 +4218,7 @@ subroutine ESMF_FieldRegridStoreX(xgrid, srcField, dstField, keywordEnforcer, & return endif - + ! Return success if(present(rc)) rc = ESMF_SUCCESS end subroutine ESMF_FieldRegridStoreX diff --git a/src/Infrastructure/Mesh/include/ESMCI_Mesh.h b/src/Infrastructure/Mesh/include/ESMCI_Mesh.h index fe24b9ca8a..8392693377 100644 --- a/src/Infrastructure/Mesh/include/ESMCI_Mesh.h +++ b/src/Infrastructure/Mesh/include/ESMCI_Mesh.h @@ -148,8 +148,8 @@ ESMCI::PointList *MeshToPointList(ESMC_MeshLoc_Flag meshLoc, ESMCI::InterArray Date: Thu, 12 Dec 2024 14:56:03 -0700 Subject: [PATCH 186/207] Make detection of XGrid regriding information in a Mesh more consistent. --- .../Mesh/include/ESMCI_XGridUtil.h | 9 +++- .../Regridding/ESMCI_Conserve2ndInterp.h | 4 +- src/Infrastructure/Mesh/src/ESMCI_XGridUtil.C | 24 +++++++++++ .../Mesh/src/Regridding/ESMCI_Interp.C | 43 +++++-------------- 4 files changed, 43 insertions(+), 37 deletions(-) diff --git a/src/Infrastructure/Mesh/include/ESMCI_XGridUtil.h b/src/Infrastructure/Mesh/include/ESMCI_XGridUtil.h index 9cc30d820f..f58f808921 100644 --- a/src/Infrastructure/Mesh/include/ESMCI_XGridUtil.h +++ b/src/Infrastructure/Mesh/include/ESMCI_XGridUtil.h @@ -21,6 +21,8 @@ namespace ESMCI { + + /** *\brief generate a mesh based on the nodes and cells vector. The cells are unique and refer to the nodes. * @param[in] sintd_nodes vector to allocated intersecting nodal points @@ -306,7 +308,12 @@ void test_clip3D(int pdim, int sdim, int num_s, double * s_coord, int num_c, dou void dump_sph_coords(int num, const double * coord); void dump_cart_coords(int num, const double * coord, bool only_sph=false); void dump_polygon(const polygon & poly, bool only_sph=false); - + + // Whether XGrid is being used for regridding + enum XGRID_USE {XGRID_USE_NONE, XGRID_USE_SRC, XGRID_USE_DST}; + + // Deterimine if the input meshes have XGrid regridding information and if so what type + XGRID_USE detect_xgrid_regrid_info_type(Mesh &srcmesh, Mesh &dstmesh); } // namespace diff --git a/src/Infrastructure/Mesh/include/Regridding/ESMCI_Conserve2ndInterp.h b/src/Infrastructure/Mesh/include/Regridding/ESMCI_Conserve2ndInterp.h index 5c2c8fed1e..f76238c045 100644 --- a/src/Infrastructure/Mesh/include/Regridding/ESMCI_Conserve2ndInterp.h +++ b/src/Infrastructure/Mesh/include/Regridding/ESMCI_Conserve2ndInterp.h @@ -21,6 +21,7 @@ #include #include #include +#include #include @@ -52,9 +53,6 @@ namespace ESMCI { } SM_CELL; #endif - enum XGRID_USE {XGRID_USE_NONE, XGRID_USE_SRC, XGRID_USE_DST}; - - void calc_2nd_order_weights_2D_3D_sph(const MeshObj *src_elem, MEField<> *src_cfield, MEField<> *src_mask_field, std::vector dst_elems, MEField<> *dst_cfield, MEField<> * dst_mask_field, MEField<> * dst_frac2_field, XGRID_USE xgrid_use, double *src_elem_area, diff --git a/src/Infrastructure/Mesh/src/ESMCI_XGridUtil.C b/src/Infrastructure/Mesh/src/ESMCI_XGridUtil.C index 30773c8da9..31e19965e6 100644 --- a/src/Infrastructure/Mesh/src/ESMCI_XGridUtil.C +++ b/src/Infrastructure/Mesh/src/ESMCI_XGridUtil.C @@ -2978,6 +2978,30 @@ void calc_wgts_from_xgrid_to_side_mesh(Mesh *src_xgrid_mesh, Mesh *dst_side_mesh else Throw() << "Unexpectedly neither src or dst Mesh is an XGrid."; } + + // Detect if we should use XGrid information for regridding and how + XGRID_USE detect_xgrid_regrid_info_type(Mesh &srcmesh, Mesh &dstmesh) { + + XGRID_USE xgrid_use=XGRID_USE_NONE; + if (srcmesh.side==3) { + // Extra check to ensure that it's actually a side mesh going to XGrid + if ((dstmesh.side == 1) || (dstmesh.side == 2)) { + xgrid_use=XGRID_USE_SRC; + } + } else if (dstmesh.side==3) { + // Extra check to ensure that it's actually a side mesh going to XGrid + if ((srcmesh.side == 1) || (srcmesh.side == 2)) { + xgrid_use=XGRID_USE_DST; + } + } + + return xgrid_use; + } + + + + + } //namespace diff --git a/src/Infrastructure/Mesh/src/Regridding/ESMCI_Interp.C b/src/Infrastructure/Mesh/src/Regridding/ESMCI_Interp.C index 91766d8c2e..164abdecfc 100644 --- a/src/Infrastructure/Mesh/src/Regridding/ESMCI_Interp.C +++ b/src/Infrastructure/Mesh/src/Regridding/ESMCI_Interp.C @@ -768,19 +768,7 @@ void calc_2nd_order_conserve_mat_serial_2D_3D_sph(Mesh &srcmesh, Mesh &dstmesh, Trace __trace("calc_conserve_mat_serial(Mesh &srcmesh, Mesh &dstmesh, SearchResult &sres, IWeights &iw)"); // See if we're using an XGrid - XGRID_USE xgrid_use=XGRID_USE_NONE; - if (srcmesh.side==3) { - // Extra check to ensure that it's actually a side mesh going to XGrid - if ((dstmesh.side == 1) || (dstmesh.side == 2)) { - xgrid_use=XGRID_USE_SRC; - } - } else if (dstmesh.side==3) { - // Extra check to ensure that it's actually a side mesh going to XGrid - if ((srcmesh.side == 1) || (srcmesh.side == 2)) { - xgrid_use=XGRID_USE_DST; - } - } - + XGRID_USE xgrid_use=detect_xgrid_regrid_info_type(srcmesh, dstmesh); // Get src coord field MEField<> *src_cfield = srcmesh.GetCoordField(); @@ -1102,18 +1090,7 @@ void calc_2nd_order_conserve_mat_serial_2D_2D_cart(Mesh &srcmesh, Mesh &dstmesh, Trace __trace("calc_conserve_mat_serial(Mesh &srcmesh, Mesh &dstmesh, SearchResult &sres, IWeights &iw)"); // See if we're using an XGrid - XGRID_USE xgrid_use=XGRID_USE_NONE; - if (srcmesh.side==3) { - // Extra check to ensure that it's actually a side mesh going to XGrid - if ((dstmesh.side == 1) || (dstmesh.side == 2)) { - xgrid_use=XGRID_USE_SRC; - } - } else if (dstmesh.side==3) { - // Extra check to ensure that it's actually a side mesh going to XGrid - if ((srcmesh.side == 1) || (srcmesh.side == 2)) { - xgrid_use=XGRID_USE_DST; - } - } + XGRID_USE xgrid_use=detect_xgrid_regrid_info_type(srcmesh, dstmesh); // Get src coord field MEField<> *src_cfield = srcmesh.GetCoordField(); @@ -3043,11 +3020,11 @@ interp_method(imethod) // If 2nd order see if it's an XGrid and then use that if (interp_method == Interp::INTERP_CONSERVE_2ND) { - // If an XGrid is involved, then do a search using that - if ((grend.GetSrcRend().side==3) || (grend.GetDstRend().side==3)) { - XGridGatherOverlappingElems(grend.GetSrcRend(), grend.GetDstRend(), sres); - } else { // ...otherwise just use the regular search + // If an XGrid isn't involved, then do a search using regular method + if (detect_xgrid_regrid_info_type(grend.GetSrcRend(), grend.GetDstRend()) == XGRID_USE_NONE) { OctSearchElems(grend.GetSrcRend(), ESMCI_UNMAPPEDACTION_IGNORE, grend.GetDstRend(), unmappedaction, 1e-8, sres); + } else { // ...otherwise use XGrid information + XGridGatherOverlappingElems(grend.GetSrcRend(), grend.GetDstRend(), sres); } } else { // ...otherwise just use the regular search OctSearchElems(grend.GetSrcRend(), ESMCI_UNMAPPEDACTION_IGNORE, grend.GetDstRend(), unmappedaction, 1e-8, sres); @@ -3089,11 +3066,11 @@ interp_method(imethod) // If 2nd order see if it's an XGrid and then use that if (interp_method == Interp::INTERP_CONSERVE_2ND) { - // If an XGrid is involved, then do a search using that - if ((src->side==3) || (dest->side==3)) { - XGridGatherOverlappingElems(*src, *dest, sres); - } else { // ...otherwise just use the regular search + // If an XGrid isn't involved, then do a search using regular method + if (detect_xgrid_regrid_info_type(*src, *dest) == XGRID_USE_NONE) { OctSearchElems(*src, ESMCI_UNMAPPEDACTION_IGNORE, *dest, unmappedaction, 1e-8, sres); + } else { // ...otherwise use XGrid info to do search + XGridGatherOverlappingElems(*src, *dest, sres); } } else { // ...otherwise just use the regular search OctSearchElems(*src, ESMCI_UNMAPPEDACTION_IGNORE, *dest, unmappedaction, 1e-8, sres); From 8b4004f7946a9466780a470ddefdaf1aff6f8ee1 Mon Sep 17 00:00:00 2001 From: Gerhard Theurich Date: Thu, 12 Dec 2024 18:00:23 -0800 Subject: [PATCH 187/207] Implement and document support for Epoch* metadata on Connector. --- .../doc/NUOPC_ConnectorComponent_metadata.tex | 7 +- src/addon/NUOPC/src/NUOPC_Comp.F90 | 11 ++- src/addon/NUOPC/src/NUOPC_Connector.F90 | 76 ++++++++++++------- 3 files changed, 61 insertions(+), 33 deletions(-) diff --git a/src/addon/NUOPC/doc/NUOPC_ConnectorComponent_metadata.tex b/src/addon/NUOPC/doc/NUOPC_ConnectorComponent_metadata.tex index 0257cb681c..83d3dae982 100644 --- a/src/addon/NUOPC/doc/NUOPC_ConnectorComponent_metadata.tex +++ b/src/addon/NUOPC/doc/NUOPC_ConnectorComponent_metadata.tex @@ -3,7 +3,7 @@ using the JSON Pointer "/NUOPC/Instance/" prefix followed by the "Attribute name" as per the table below. E.g. "Verbosity" is accessed using {\tt key="/NUOPC/Instance/Verbosity"}. -\begin{longtable}{|p{.22\textwidth}|p{.6\textwidth}|p{.2\textwidth}|} +\begin{longtable}{|p{.3\textwidth}|p{.4\textwidth}|p{.3\textwidth}|} \hline\hline {\bf Attribute name} & {\bf Definition} & {\bf Controlled vocabulary}\\ \hline\hline @@ -69,6 +69,9 @@ {\tt CplList} & List of StandardNames of the connected Fields. Each StandardName entry may be followed by a colon separated list of connection options. The details are discussed in section \ref{connection_options} & {\em Standard names} as per field dictionary, followed by {\em connection options} defined in section \ref{connection_options}.\\ \hline {\tt CplSetList} & List of coupling sets. Each coupling set is identified by a string value.& {\em no restriction}\\ \hline {\tt ConnectionOptions} & String value specifying the connection options to be applied to all the fields in the {\tt CplList} by default.& {\em Connection options} defined in section \ref{connection_options}.\\ \hline - {\tt EpochThrottle} & Integer specifying the maximum number of outstanding EPOCH messages between any two PETs. The ESMF level default is 10. & Any positive integer.\\ \hline + {\tt EpochEnable} & String value specifying whether EPOCH support is enabled inside the Connector. The default setting is "true". & false, true\\ \hline + {\tt EpochEnterKeepAlloc} & String value specifying whether to keep internal allocations when entering the EPOCH for reuse. The default setting is "true". & false, true\\ \hline + {\tt EpochExitKeepAlloc} & String value specifying whether to keep internal allocations when exiting the EPOCH for reuse. The default setting is "true". & false, true\\ \hline + {\tt EpochThrottle} & Integer specifying the maximum number of outstanding EPOCH messages between any two PETs. The default throttle level is 10. & Any positive integer.\\ \hline \hline \end{longtable} diff --git a/src/addon/NUOPC/src/NUOPC_Comp.F90 b/src/addon/NUOPC/src/NUOPC_Comp.F90 index 67d2d8a9d1..71d02cd762 100644 --- a/src/addon/NUOPC/src/NUOPC_Comp.F90 +++ b/src/addon/NUOPC/src/NUOPC_Comp.F90 @@ -2219,13 +2219,16 @@ subroutine NUOPC_CplCompAttributeInit(comp, rc) line=__LINE__, & file=FILENAME, & rcToReturn=rc)) return ! bail out - + ! The NUOPC/Connector Attributes - allocate(attrList(4)) + allocate(attrList(7)) attrList(1) = "CplList" attrList(2) = "CplSetList" attrList(3) = "ConnectionOptions" - attrList(4) = "EpochThrottle" + attrList(4) = "EpochEnable" + attrList(5) = "EpochEnterKeepAlloc" + attrList(6) = "EpochExitKeepAlloc" + attrList(7) = "EpochThrottle" call ESMF_AttributeAdd(comp, convention="NUOPC", purpose="Instance", & attrList=attrList, rc=localrc) if (ESMF_LogFoundError(rcToCheck=localrc, msg=ESMF_LOGERR_PASSTHRU, & @@ -2255,6 +2258,8 @@ subroutine NUOPC_CplCompAttributeInit(comp, rc) call NUOPC_CompAttributeSet(comp, & name="Diagnostic", value="0", & rc=localrc) + if (ESMF_LogFoundError(rcToCheck=localrc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=FILENAME, rcToReturn=rc)) return ! bail out end subroutine !----------------------------------------------------------------------------- diff --git a/src/addon/NUOPC/src/NUOPC_Connector.F90 b/src/addon/NUOPC/src/NUOPC_Connector.F90 index 840f5d71c0..8b25a7270d 100644 --- a/src/addon/NUOPC/src/NUOPC_Connector.F90 +++ b/src/addon/NUOPC/src/NUOPC_Connector.F90 @@ -85,6 +85,10 @@ module NUOPC_Connector type(ESMF_VM) :: srcVM type(ESMF_VM) :: dstVM type(ESMF_Clock) :: driverClock + logical :: epochEnable + logical :: epochEnterKeepAlloc + logical :: epochExitKeepAlloc + integer :: epochThrottle end type type type_InternalState @@ -5105,7 +5109,7 @@ subroutine InitializeIPDv05p6b(connector, importState, exportState, clock, rc) character(ESMF_MAXSTR), pointer :: cplList(:) integer :: j end type - + ! local variables character(*), parameter :: rName="InitializeIPDv05p6b" character(ESMF_MAXSTR), pointer :: cplList(:), chopStringList(:) @@ -5130,7 +5134,7 @@ subroutine InitializeIPDv05p6b(connector, importState, exportState, clock, rc) type(type_InternalState) :: is logical :: foundFlag integer :: localrc - logical :: existflag + logical :: existflag, isSet character(ESMF_MAXSTR) :: connectionString character(ESMF_MAXSTR) :: name, iString character(len=160) :: msgString @@ -5139,6 +5143,7 @@ subroutine InitializeIPDv05p6b(connector, importState, exportState, clock, rc) integer :: sIndex character(ESMF_MAXSTR) :: iShareStatus, eShareStatus logical :: sharedFlag + character(ESMF_MAXSTR) :: valueString integer :: verbosity, diagnostic, profiling type(ESMF_Time) :: currTime character(len=40) :: currTimeString @@ -5547,15 +5552,40 @@ subroutine InitializeIPDv05p6b(connector, importState, exportState, clock, rc) ESMF_LOGMSG_INFO, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, file=trim(name)//":"//FILENAME)) return ! bail out - endif + endif endif - + ! determine whether there is src/dst overlap on any PET call DetermineSrcDstOverlap(is%wrap%srcFieldList, is%wrap%dstFieldList, & is%wrap%srcDstOverlap, is%wrap%srcFlag, is%wrap%dstFlag, verbosity, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, file=trim(name)//":"//FILENAME)) return ! bail out + ! access and set Epoch flags + is%wrap%epochEnable = .true. ! default + call NUOPC_CompAttributeGet(connector, name="EpochEnable", & + value=valueString, isSet=isSet, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=trim(name)//":"//FILENAME)) return ! bail out + if (isSet) is%wrap%epochEnable = trim(valueString)=="true" + is%wrap%epochEnterKeepAlloc = .true. ! default + call NUOPC_CompAttributeGet(connector, name="EpochEnterKeepAlloc", & + value=valueString, isSet=isSet, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=trim(name)//":"//FILENAME)) return ! bail out + if (isSet) is%wrap%epochEnterKeepAlloc = trim(valueString)=="true" + is%wrap%epochExitKeepAlloc = .true. ! default + call NUOPC_CompAttributeGet(connector, name="EpochExitKeepAlloc", & + value=valueString, isSet=isSet, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=trim(name)//":"//FILENAME)) return ! bail out + if (isSet) is%wrap%epochExitKeepAlloc = trim(valueString)=="true" + is%wrap%epochThrottle = 10 ! default + call NUOPC_CompAttributeGet(connector, name="EpochThrottle", & + value=is%wrap%epochThrottle, isSet=isSet, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=trim(name)//":"//FILENAME)) return ! bail out + ! build Timestamp update packets !TODO: consider whether CplSet needs extra treatment here or not call BuildUpdatePackets(is%wrap%srcFieldList, is%wrap%dstFieldList, & @@ -6295,14 +6325,14 @@ subroutine Run(connector, importState, exportState, clock, rc) type(type_InternalState) :: is type(ESMF_VM) :: vm integer :: localrc - logical :: existflag, isSet + logical :: existflag logical :: routeHandleIsCreated character(ESMF_MAXSTR) :: compName, pLabel character(len=160) :: msgString integer :: phase integer :: verbosity, diagnostic, profiling character(ESMF_MAXSTR) :: name - integer :: i, epochThrottle + integer :: i type(ESMF_Time) :: currTime character(len=40) :: currTimeString @@ -6400,9 +6430,10 @@ subroutine Run(connector, importState, exportState, clock, rc) #endif if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, file=trim(name)//":"//FILENAME)) return ! bail out - + ! conditional profiling for src/dst PETs - if (btest(profiling,3) .and. .not.is%wrap%srcDstOverlap) then + if (btest(profiling,3) .and. & + (is%wrap%epochEnable.and. .not.is%wrap%srcDstOverlap)) then if (is%wrap%srcFlag) then call ESMF_TraceRegionEnter(rName//"-srcPETs", rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & @@ -6415,13 +6446,13 @@ subroutine Run(connector, importState, exportState, clock, rc) return ! bail out endif endif - + ! store the incoming clock as driverClock in internal state is%wrap%driverClock = clock !TODO: here may be the place to ensure incoming States are consistent !TODO: with the Fields held in the FieldBundle inside the internal State? - + ! SPECIALIZE by calling into attached method to execute routehandle if (btest(profiling,4)) then call ESMF_TraceRegionEnter("label_ExecuteRouteHandle") @@ -6443,23 +6474,11 @@ subroutine Run(connector, importState, exportState, clock, rc) endif ! if not specialized -> use default method to execute the exchange ! Conditionally enter VMEpoch - if (.not. is%wrap%srcDstOverlap) then - call NUOPC_CompAttributeGet(connector, name="EpochThrottle", & - value=epochThrottle, isSet=isSet, rc=rc) + if (is%wrap%epochEnable.and. .not.is%wrap%srcDstOverlap) then + call ESMF_VMEpochEnter(epoch=ESMF_VMEPOCH_BUFFER, & + throttle=is%wrap%epochThrottle, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, file=trim(name)//":"//FILENAME)) return ! bail out - if (isSet) then - ! using custom throttle - call ESMF_VMEpochEnter(epoch=ESMF_VMEPOCH_BUFFER, & - throttle=epochThrottle, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=trim(name)//":"//FILENAME)) return ! bail out - else - ! using default throttle - call ESMF_VMEpochEnter(epoch=ESMF_VMEPOCH_BUFFER, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=trim(name)//":"//FILENAME)) return ! bail out - endif endif ! call the SMM consistent with CplSets present or not if (is%wrap%cplSetCount > 1) then @@ -6479,7 +6498,7 @@ subroutine Run(connector, importState, exportState, clock, rc) line=__LINE__, file=trim(name)//":"//FILENAME)) return ! bail out endif enddo - else + else; routeHandleIsCreated = ESMF_RouteHandleIsCreated(is%wrap%rh, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, file=trim(name)//":"//FILENAME)) return ! bail out @@ -6497,7 +6516,7 @@ subroutine Run(connector, importState, exportState, clock, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, file=trim(name)//":"//FILENAME)) return ! bail out ! Conditionally exit VMEpoch - if (.not. is%wrap%srcDstOverlap) then + if (is%wrap%epochEnable.and. .not.is%wrap%srcDstOverlap) then call ESMF_VMEpochExit(rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, file=trim(name)//":"//FILENAME)) return ! bail out @@ -6563,7 +6582,8 @@ subroutine Run(connector, importState, exportState, clock, rc) line=__LINE__, file=trim(name)//":"//FILENAME)) return ! bail out ! conditional profiling for src/dst PETs - if (btest(profiling,3) .and. .not.is%wrap%srcDstOverlap) then + if (btest(profiling,3) .and. & + (is%wrap%epochEnable.and. .not.is%wrap%srcDstOverlap)) then if (is%wrap%srcFlag) then call ESMF_TraceRegionExit(rName//"-srcPETs", rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & From 661eb42b24700bfeece79af9203c37501dde980d Mon Sep 17 00:00:00 2001 From: Gerhard Theurich Date: Thu, 12 Dec 2024 19:01:57 -0800 Subject: [PATCH 188/207] Add documentation for `logSystem` Driver option key. --- src/addon/ESMX/README.md | 1 + 1 file changed, 1 insertion(+) diff --git a/src/addon/ESMX/README.md b/src/addon/ESMX/README.md index fe8de4cf1b..bc71702f4a 100644 --- a/src/addon/ESMX/README.md +++ b/src/addon/ESMX/README.md @@ -288,6 +288,7 @@ This section affects the driver level. | --------------- | -------------------------------------------------------------------- | --------------- | | `componentList` | list of component labels, each matching a top level key in this file | *Empty* | | `runSequence` | block literal string defining the run sequence | *NUOPC default* | +| `logSystem` | enable/disable ESMF_VMLogSystem() during Driver SetModelServices(): `true` or `false`| `false` | | `attributes` | map of key value pairs, each defining a driver attribute | *None* | #### Component Label Options From 8abac4f9d8be11eca688137afcca6f62c4d4c293 Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Fri, 13 Dec 2024 05:03:17 -0700 Subject: [PATCH 189/207] ESMPy: provide supported versions in pyproject.toml Provide earliest supported version for python - bump from 3.7 to 3.8 because that is the earliest we're testing with. (Not listing a latest supported version, as per advice in https://packaging.python.org/en/latest/guides/writing-pyproject-toml/#requires-python-upper-bounds and https://packaging.python.org/en/latest/guides/dropping-older-python-versions/#specify-the-version-ranges-for-supported-python-distributions). Provide earliest and latest supported versions for numpy. The earliest version is based on the earliest version we're testing with; the latest version is based on presumed backwards incompatibility with a major version bump. --- src/addon/esmpy/pyproject.toml | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) diff --git a/src/addon/esmpy/pyproject.toml b/src/addon/esmpy/pyproject.toml index 40bc3d1da9..2b3b25b3d7 100644 --- a/src/addon/esmpy/pyproject.toml +++ b/src/addon/esmpy/pyproject.toml @@ -7,10 +7,14 @@ name = "esmpy" description = "ESMF Python interface" # readme = "README.md" maintainers = [ { name = "ESMF Core Team", email = "esmf_support@ucar.edu" } ] -requires-python = ">=3.7" +# The following is the earliest python version that we test with: +requires-python = ">=3.8" license = { text = "University of Illinois-NCSA" } dependencies = [ - "numpy", + # The following is the earliest numpy version that we test with; the latest we test + # with is version 2.x, so we assume that version 3 might break backwards + # compatibility: + "numpy >= 1.19, < 3", 'importlib-metadata; python_version < "3.8"', # setuptools-git-versioning shouldn't be needed here, but is # included as a workaround for problems with the build-time From 8093deb0e6598d688453a760de0a50d5af700b01 Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Fri, 13 Dec 2024 05:12:12 -0700 Subject: [PATCH 190/207] ESMPy: Document minimum versions of python and numpy --- src/addon/esmpy/doc/install.rst | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/addon/esmpy/doc/install.rst b/src/addon/esmpy/doc/install.rst index 96df08d5eb..41a330fc2c 100644 --- a/src/addon/esmpy/doc/install.rst +++ b/src/addon/esmpy/doc/install.rst @@ -9,8 +9,8 @@ Requirements The following packages are *required* to work with ESMPy: * `ESMF installation `_ -* `python `_, minimum version 3.7 -* `numpy `_ +* `python `_, minimum version 3.8 +* `numpy `_, minimum version 1.19 The following packages are *optional*: From 6a781b2c449db920719a19a7cb1efe1a51dfb8c8 Mon Sep 17 00:00:00 2001 From: Gerhard Theurich Date: Fri, 13 Dec 2024 12:33:57 -0800 Subject: [PATCH 191/207] Only consider top level objects in the reconciled State during ESMF_StateReconcileIsNoop(). --- .../src/ESMF_StateReconcile.F90 | 61 +------------------ 1 file changed, 1 insertion(+), 60 deletions(-) diff --git a/src/Superstructure/StateReconcile/src/ESMF_StateReconcile.F90 b/src/Superstructure/StateReconcile/src/ESMF_StateReconcile.F90 index 9158c7719b..a69ae5adf1 100644 --- a/src/Superstructure/StateReconcile/src/ESMF_StateReconcile.F90 +++ b/src/Superstructure/StateReconcile/src/ESMF_StateReconcile.F90 @@ -519,10 +519,8 @@ recursive subroutine StateReconcileIsNoopLoc(stateR, isNoopLoc, rc) type(ESMF_StateItem_Flag), allocatable :: itemTypeList(:) type(ESMF_State) :: nestedState type(ESMF_Field) :: field - type(ESMF_Field), allocatable :: fieldList(:) type(ESMF_FieldBundle) :: fieldbundle type(ESMF_Array) :: array - type(ESMF_Array), allocatable :: arrayList(:) type(ESMF_ArrayBundle) :: arraybundle type(ESMF_RouteHandle) :: routehandle type(ESMF_VM) :: vmItem @@ -558,11 +556,6 @@ recursive subroutine StateReconcileIsNoopLoc(stateR, isNoopLoc, rc) call ESMF_StateGet(nestedState, vm=vmItem, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & rcToReturn=rc)) return - ! recursion into nested state - call StateReconcileIsNoopLoc(stateR=nestedState, & - isNoopLoc=isNoopLoc, rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & - rcToReturn=rc)) return else if (itemtypeList(item) == ESMF_STATEITEM_FIELD) then call ESMF_StateGet(stateR, itemName=itemNameList(item), & field=field, rc=localrc) @@ -576,34 +569,6 @@ recursive subroutine StateReconcileIsNoopLoc(stateR, isNoopLoc, rc) fieldbundle=fieldbundle, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & rcToReturn=rc)) return - call ESMF_FieldBundleGet(fieldbundle, fieldCount=fieldCount, & - isPacked=isFlag, rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & - rcToReturn=rc)) return - if (.not.isFlag) then - ! not a packed fieldbundle -> check each field item - allocate(fieldList(fieldCount)) - call ESMF_FieldBundleGet(fieldbundle, fieldList=fieldList, & - rc=localrc) - if (ESMF_LogFoundError(localrc, & - ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, rcToReturn=rc)) return - do i=1, fieldCount - call ESMF_FieldGet(fieldList(i), vm=vmItem, rc=localrc) - if (ESMF_LogFoundError(localrc, & - ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, rcToReturn=rc)) return - call ESMF_VMGetVMId(vmItem, vmId=vmIdItem, rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & - rcToReturn=rc)) return - isNoopLoc = ESMF_VMIdCompare(vmIdItem, vmId, keyOnly=.true., & - rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & - rcToReturn=rc)) return - if (.not.isNoopLoc) exit ! exit for .false. - enddo - deallocate(fieldList) - endif call ESMF_FieldBundleGet(fieldbundle, vm=vmItem, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & rcToReturn=rc)) return @@ -620,30 +585,6 @@ recursive subroutine StateReconcileIsNoopLoc(stateR, isNoopLoc, rc) arraybundle=arraybundle, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & rcToReturn=rc)) return - call ESMF_ArrayBundleGet(arraybundle, arrayCount=arrayCount, & - rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & - rcToReturn=rc)) return - allocate(arrayList(arrayCount)) - call ESMF_ArrayBundleGet(arraybundle, arrayList=arrayList, & - rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & - rcToReturn=rc)) return - do i=1, arrayCount - call ESMF_ArrayGet(arrayList(i), vm=vmItem, rc=localrc) - if (ESMF_LogFoundError(localrc, & - ESMF_ERR_PASSTHRU, & - ESMF_CONTEXT, rcToReturn=rc)) return - call ESMF_VMGetVMId(vmItem, vmId=vmIdItem, rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & - rcToReturn=rc)) return - isNoopLoc = ESMF_VMIdCompare(vmIdItem, vmId, keyOnly=.true., & - rc=localrc) - if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & - rcToReturn=rc)) return - if (.not.isNoopLoc) exit ! exit for .false. - enddo - deallocate(arrayList) call ESMF_ArrayBundleGet(arraybundle, vm=vmItem, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, & rcToReturn=rc)) return @@ -667,7 +608,7 @@ recursive subroutine StateReconcileIsNoopLoc(stateR, isNoopLoc, rc) if (thisItem == ESMF_NULL_POINTER) isNoopLoc = .false. ! found proxy - ! exit for .false. already from proxy, recursive state, or bundles + ! exit for .false. already from proxy if (.not.isNoopLoc) exit call ESMF_VMGetVMId(vmItem, vmId=vmIdItem, rc=localrc) From 36025dd8d39dbf0cf2161188e536c570169a20ea Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Fri, 13 Dec 2024 13:57:02 -0700 Subject: [PATCH 192/207] Convert some python files to python3 These aren't actually used in ESMPy so haven't been causing an issue, but can create errors in some circumstances. Resolves esmf-org/esmf#331 --- src/addon/esmpy/doc/api.rst | 2 +- src/addon/esmpy/examples/mpi_spawn_regrid.py | 5 +- .../fragments/dump_esmf_internal_info.py | 51 ++++++++++--------- src/addon/esmpy/src/esmpy/fragments/extras.py | 10 ++-- src/addon/esmpy/src/esmpy/fragments/remap.py | 6 +-- 5 files changed, 38 insertions(+), 36 deletions(-) diff --git a/src/addon/esmpy/doc/api.rst b/src/addon/esmpy/doc/api.rst index d10194e6e0..f28c2f8582 100644 --- a/src/addon/esmpy/doc/api.rst +++ b/src/addon/esmpy/doc/api.rst @@ -941,7 +941,7 @@ MPI.Spawn raise ValueError('Could not connect to parent - ' + usage) # worker code goes here, regridding etc.. - print "Hello World from PET #"+str(rank) + print("Hello World from PET #"+str(rank)) # Shutdown comm.Disconnect() diff --git a/src/addon/esmpy/examples/mpi_spawn_regrid.py b/src/addon/esmpy/examples/mpi_spawn_regrid.py index 10d5bedf11..8d4cd4b6ff 100644 --- a/src/addon/esmpy/examples/mpi_spawn_regrid.py +++ b/src/addon/esmpy/examples/mpi_spawn_regrid.py @@ -11,6 +11,7 @@ from esmpy.util.cache_data import DATA_DIR from esmpy.util.exceptions import DataMissing +from functools import reduce # The data files can be retrieved from the ESMF data repository by uncommenting the # following block of code: @@ -94,8 +95,8 @@ def compute_error(dstfield, xctfield): meanrelerr = relerr / num_nodes meanrelerr = relerr / num_nodes - print "ESMPy regridding as a spawned MPI process:" - print " interpolation mean relative error = {0}".format(meanrelerr) + print("ESMPy regridding as a spawned MPI process:") + print(" interpolation mean relative error = {0}".format(meanrelerr)) ########################################### MAIN ############################# diff --git a/src/addon/esmpy/src/esmpy/fragments/dump_esmf_internal_info.py b/src/addon/esmpy/src/esmpy/fragments/dump_esmf_internal_info.py index ed9b5f33b1..4175b0324e 100644 --- a/src/addon/esmpy/src/esmpy/fragments/dump_esmf_internal_info.py +++ b/src/addon/esmpy/src/esmpy/fragments/dump_esmf_internal_info.py @@ -1,3 +1,4 @@ +from functools import reduce # This file contains old routines to dump internal ESMF info from ESMPy Grid and Field objects # This code is likely obsolete, but was useful in the original development process .. # so it is being kept for a rainy day situation @@ -6,11 +7,11 @@ def dump_gridinfo(self, stagger): [x,y,z] = [0,1,2] - print "bounds - low, high" - print self.lower_bounds[stagger], \ - self.upper_bounds[stagger] - print "shape - [x, y, z] or [lat, lon]" - print self.coords[stagger][0].shape + print("bounds - low, high") + print(self.lower_bounds[stagger], \ + self.upper_bounds[stagger]) + print("shape - [x, y, z] or [lat, lon]") + print(self.coords[stagger][0].shape) if self.rank == 2: return [self.coords[stagger][x], self.coords[stagger][y]] @@ -20,11 +21,11 @@ def dump_gridinfo(self, stagger): def dump_gridinfo_lower(self, stagger): [x, y, z] = [0, 1, 2] - print "bounds - low, high" - print self.lower_bounds[stagger], \ - self.upper_bounds[stagger] - print "shape - [x, y, z] or [lat, lon]" - print self.coords[stagger][0].shape + print("bounds - low, high") + print(self.lower_bounds[stagger], \ + self.upper_bounds[stagger]) + print("shape - [x, y, z] or [lat, lon]") + print(self.coords[stagger][0].shape) # retrieve buffers to esmf coordinate memory gridptrX = self.get_grid_coords_from_esmc(x, stagger) @@ -67,10 +68,10 @@ def dump_gridinfo_ctypes(self, stagger, dim=2): np.dtype(constants._ESMF2PythonType[self.type]).itemsize*size) ycoords = np.frombuffer(ybuffer, constants._ESMF2PythonType[self.type]) - print "DIAGNOSTICS:" - print "self.type = ", self.type - print "constants._ESMF2PythonType", constants._ESMF2PythonType[self.type] - print "constants._ESMF2PythonType.itemsize", constants._ESMF2PythonType[self.type].itemsize + print("DIAGNOSTICS:") + print("self.type = ", self.type) + print("constants._ESMF2PythonType", constants._ESMF2PythonType[self.type]) + print("constants._ESMF2PythonType.itemsize", constants._ESMF2PythonType[self.type].itemsize) # find the size of the local coordinates at this stagger location @@ -80,12 +81,12 @@ def dump_gridinfo_ctypes(self, stagger, dim=2): # these appear to both return bounds information only lb, ub = ESMP_GridGetCoordBounds(self, staggerloc=stagger) - print "Bounds:" - print " ESMPy.Grid: ", size - print " ESMPy.ctypes1: ", lb, ub + print("Bounds:") + print(" ESMPy.Grid: ", size) + print(" ESMPy.ctypes1: ", lb, ub) - print "Coordinates:" + print("Coordinates:") I = ub[x]-lb[x] J = ub[y]-lb[y] if dim == 3: @@ -103,7 +104,7 @@ def dump_gridinfo_ctypes(self, stagger, dim=2): (ycoords[ind] > -1e-10 and 1e-10 > ycoords[ind] and ycoords[ind] != 0) or \ ycoords[ind] > 90: - print "[", i, ", ", j, "] = [", xcoords[ind], ", ", ycoords[ind], "]" + print("[", i, ", ", j, "] = [", xcoords[ind], ", ", ycoords[ind], "]") coordcount += 1 elif dim == 3: @@ -113,9 +114,9 @@ def dump_gridinfo_ctypes(self, stagger, dim=2): np.dtype(constants._ESMF2PythonType[self.type]).itemsize*size) zcoords = np.frombuffer(zbuffer, constants._ESMF2PythonType[self.type]) - for i in xrange(I): - for j in xrange(J): - for k in xrange(K): + for i in range(I): + for j in range(J): + for k in range(K): ind = i*I + j*J + k if (1e-10 > xcoords[ind] and xcoords[ind] != 0) or \ xcoords[ind] > 360 or \ @@ -123,10 +124,10 @@ def dump_gridinfo_ctypes(self, stagger, dim=2): (ycoords[ind] > -1e-10 and 1e-10 > ycoords[ind] and ycoords[ind] != 0) or \ ycoords[ind] > 90: - print "[", i, ", ", j, "] = [", xcoords[ind], ", ", ycoords[ind], "]" + print("[", i, ", ", j, "] = [", xcoords[ind], ", ", ycoords[ind], "]") coordcount += 1 - print "Coordcount = ", coordcount + print("Coordcount = ", coordcount) ''' # create a numpy array to point to the ESMF allocation # reshape the numpy array of coordinates using Fortran ordering in Grid @@ -148,4 +149,4 @@ def _dump_field_coords_(self): np.dtype(constants._ESMF2PythonType[self.type]).itemsize*size) esmf_coords = np.frombuffer(buffer, constants._ESMF2PythonType[self.type]) - print esmf_coords + print(esmf_coords) diff --git a/src/addon/esmpy/src/esmpy/fragments/extras.py b/src/addon/esmpy/src/esmpy/fragments/extras.py index 9d357fceb2..f247f586b0 100644 --- a/src/addon/esmpy/src/esmpy/fragments/extras.py +++ b/src/addon/esmpy/src/esmpy/fragments/extras.py @@ -112,11 +112,11 @@ def ESMP_ArraySpecSet(arrayspec, rank, typekind): if rc != _ESMP_SUCCESS: raise NameError('ESMC_ArraySpecSet() failed with rc = '+str(rc)) arrayspec.shallowMem = las.value - print 'sizeof(arrayspec) = '+str(sizeof(arrayspec)) - print 'arrayspec = '+str(arrayspec) - print 'sizeof(las) = '+str(sizeof(las)) - print 'las = '+str(las) - print "\n" + print('sizeof(arrayspec) = '+str(sizeof(arrayspec))) + print('arrayspec = '+str(arrayspec)) + print('sizeof(las) = '+str(sizeof(las))) + print('las = '+str(las)) + print("\n") return arrayspec diff --git a/src/addon/esmpy/src/esmpy/fragments/remap.py b/src/addon/esmpy/src/esmpy/fragments/remap.py index 8484f17b88..6dce0f167d 100755 --- a/src/addon/esmpy/src/esmpy/fragments/remap.py +++ b/src/addon/esmpy/src/esmpy/fragments/remap.py @@ -101,7 +101,7 @@ def remap(srcgrid, dstgrid, weights, method='bilinear'): if os.environ.get('ESMF_NUM_PROCS'): NUM_PROCS = os.environ.get('ESMF_NUM_PROCS') else: - print "ESMF_NUM_PROCS not defined in user environment, using default ESMF_NUM_PROCS=1" + print("ESMF_NUM_PROCS not defined in user environment, using default ESMF_NUM_PROCS=1") NUM_PROCS = "1" # read the esmf.mk and get the location of the executable and the OS for @@ -109,7 +109,7 @@ def remap(srcgrid, dstgrid, weights, method='bilinear'): if os.environ.get('ESMFMKFILE'): esmfmkfile = open(os.environ.get('ESMFMKFILE')) else: - print "ESMFMKFILE is not defined!" + print("ESMFMKFILE is not defined!") sys.exit for line in esmfmkfile: @@ -137,7 +137,7 @@ def remap(srcgrid, dstgrid, weights, method='bilinear'): options = '-m conserve' file = 'c' else: - print 'Method: '+method+' is not supported!' + print('Method: '+method+' is not supported!') sys.exit # TODO: what is this cruft? From 18c399839bde0f18cd9d2caf9dfdb9ef341f5369 Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Sun, 15 Dec 2024 13:52:31 -0700 Subject: [PATCH 193/207] Add some tests to better characterize ESMF_TimeGet --- .../TimeMgr/tests/ESMF_TimeUTest.F90 | 71 ++++++++++++++++++- 1 file changed, 69 insertions(+), 2 deletions(-) diff --git a/src/Infrastructure/TimeMgr/tests/ESMF_TimeUTest.F90 b/src/Infrastructure/TimeMgr/tests/ESMF_TimeUTest.F90 index 1ac112ae6e..90c8520781 100644 --- a/src/Infrastructure/TimeMgr/tests/ESMF_TimeUTest.F90 +++ b/src/Infrastructure/TimeMgr/tests/ESMF_TimeUTest.F90 @@ -45,6 +45,7 @@ program ESMF_TimeUTest ! individual test result code integer :: rc, H, M, S, MM, DD, YY + real(ESMF_KIND_R8) :: D_r8, H_r8, M_r8, S_r8 ! individual test name character(ESMF_MAXSTR) :: name @@ -74,8 +75,8 @@ program ESMF_TimeUTest logical :: bool integer :: dayOfYear, dayOfWeek, D, sD, sN, MS, NS, & US - real(ESMF_KIND_R8) :: NS_r8, S_r8, US_r8, MS_r8 - real(ESMF_KIND_R8) :: dayOfYear_r8, M_r8, D_r8, H_r8 + real(ESMF_KIND_R8) :: NS_r8, US_r8, MS_r8 + real(ESMF_KIND_R8) :: dayOfYear_r8 integer(ESMF_KIND_I8) :: year, SN_I8, SD_i8 ! instantitate some general times and timeintervals @@ -146,6 +147,72 @@ program ESMF_TimeUTest !print *, "startTime = ", timeString19 + ! ---------------------------------------------------------------------------- + !NEX_UTest + ! If you don't ask for all coarser time units, then the full remaining time gets + ! packed into the units you ask for + write(name, *) "Get Time Test - hours without all coarser time units" + write(failMsg, *) " Did not return correct un-normalized hours or ESMF_SUCCESS" + ! Do ask for years here, because otherwise we get the arbitrary baseline for years + ! folded into the result; but don't ask for any units between years and hours: + call ESMF_TimeGet(startTime, yy=YY, h=H, rc=rc) + ! Hours = (28 days)*(24 hours/day) + 12 + call ESMF_Test((YY==2004 .and. H==684 .and. rc==ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE) + + ! ---------------------------------------------------------------------------- + !NEX_UTest + ! When asking for real-valued time variables, they are still normalized by days, but + ! they are NOT normalized by time units finer than days. Furthermore, all times + ! include the full, fractional time (so hours, minutes and seconds all give the same + ! time value, just in different units). + write(name, *) "Get Time Test - real-valued time variables with int-valued date variables" + write(failMsg, *) " Did not return correct time values or ESMF_SUCCESS" + call ESMF_TimeGet(startTime, yy=YY, mm=MM, dd=DD, h_r8=H_r8, m_r8=M_r8, s_r8=S_r8, rc=rc) + ! Note that times are normalized by days; all times include the full time - with the + ! same value, just in different units + ! S = (12*60 + 17)*60 + 58 + ! M = ((12*60 + 17)*60 + 58) / 60 + ! H = (((12*60 + 17)*60 + 58) / 60) / 60 + call ESMF_Test((YY==2004 .and. MM==1 .and. DD==29 .and. & + abs(H_r8 - 12.299444444444445d0) < 1d-14 .and. & + abs(M_r8 - 737.9666666666667d0) < 1d-12 .and. & + abs(S_r8 - 44278.0d0) < 1d-11 .and. & + rc==ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE) + + ! ---------------------------------------------------------------------------- + !NEX_UTest + ! Time units include the full time even when asking for some time units in integer. + ! This contrasts with the behavior when asking for all things in integer, where the + ! finer time units are normalized by the coarser time units. + write(name, *) "Get Time Test - mix of coarser int-valued and finer real-valued time variables" + write(failMsg, *) " Did not return correct time values or ESMF_SUCCESS" + call ESMF_TimeGet(startTime, yy=YY, mm=MM, dd=DD, h=H, m_r8=M_r8, s_r8=S_r8, rc=rc) + ! Note that real-valued times include the full time - with the same value, just in + ! different units + ! S = (12*60 + 17)*60 + 58 + ! M = ((12*60 + 17)*60 + 58) / 60 + call ESMF_Test((YY==2004 .and. MM==1 .and. DD==29 .and. H==12 .and. & + abs(M_r8 - 737.9666666666667d0) < 1d-12 .and. & + abs(S_r8 - 44278.0d0) < 1d-11 .and. & + rc==ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE) + + ! ---------------------------------------------------------------------------- + !NEX_UTest + ! When asking for coarser time units in reals, days are still used to normalize + ! finer-valued time units, but time variables (e.g., hours) in real are NOT used to + ! normalize finer-valued time units in integer. This contrasts with the behavior + ! when asking for all things in integer, where the finer time units are normalized + ! by the coarser time units. + write(name, *) "Get Time Test - mix of coarser real-valued and finer int-valued time variables" + write(failMsg, *) " Did not return correct time values or ESMF_SUCCESS" + call ESMF_TimeGet(startTime, yy=YY, mm=MM, dd=DD, h_r8=H_r8, m=M, s=S, rc=rc) + ! M = (12 hours)*(60 minutes/hour) + 17 + ! S is normalized by M, so simply the remaining seconds, 58 + call ESMF_Test((YY==2004 .and. MM==1 .and. DD==29 .and. & + abs(H_r8 - 12.299444444444445d0) < 1d-14 .and. & + M==737 .and. S==58 .and. & + rc==ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE) + ! ---------------------------------------------------------------------------- !NEX_UTest From bb1cdae554fc9ba7ac229a636e87e47e177ff56f Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Mon, 16 Dec 2024 11:15:08 -0700 Subject: [PATCH 194/207] Document behavior of double precision outputs in ESMF_TimeGet --- src/Infrastructure/TimeMgr/interface/ESMF_Time.F90 | 10 ++++++++++ 1 file changed, 10 insertions(+) diff --git a/src/Infrastructure/TimeMgr/interface/ESMF_Time.F90 b/src/Infrastructure/TimeMgr/interface/ESMF_Time.F90 index 5b565fd8e8..70ed535755 100644 --- a/src/Infrastructure/TimeMgr/interface/ESMF_Time.F90 +++ b/src/Infrastructure/TimeMgr/interface/ESMF_Time.F90 @@ -662,6 +662,16 @@ subroutine ESMF_TimeGet(time, keywordEnforcer, & ! and {\tt ESMF\_TimeGet(yy = year, s=seconds)} would return ! {\tt year = 2004}, {\tt seconds = 2772000} (770 * 3600). ! +! However, double precision time units are not considered in this normalization: +! Double precision time units are still bound by units of a day or larger, but double +! precision time units of an hour or smaller neither bind nor are bound by other time +! units of an hour or smaller (either integer or double precision). For example, +! with the same time setting as above (2:00 am on February 2, 2004), +! {\tt ESMF\_TimeGet(dd=day, h_r8=hours_r8, s=seconds)} would return +! {\tt day = 2}, {\tt hours_r8 = 2.0}, {\tt seconds = 7200}, and +! {\tt ESMF\_TimeGet(dd=day, h=hours, s_r8=seconds_r8)} would return +! {\tt day = 2}, {\tt hours = 2}, {\tt seconds_r8 = 7200.0}. +! ! For {\tt timeString}, {\tt timeStringISOFrac}, {\tt dayOfWeek}, ! {\tt midMonth}, {\tt dayOfYear}, {\tt dayOfYear\_intvl}, and ! {\tt dayOfYear\_r8} described below, valid calendars are Gregorian, From 45f0f7cb3b34f86f2ac58a689dcb9a0a38f13baf Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Mon, 16 Dec 2024 11:21:19 -0700 Subject: [PATCH 195/207] Tweak some comments --- .../TimeMgr/tests/ESMF_TimeUTest.F90 | 24 +++++++++---------- 1 file changed, 12 insertions(+), 12 deletions(-) diff --git a/src/Infrastructure/TimeMgr/tests/ESMF_TimeUTest.F90 b/src/Infrastructure/TimeMgr/tests/ESMF_TimeUTest.F90 index 90c8520781..8bdec65d85 100644 --- a/src/Infrastructure/TimeMgr/tests/ESMF_TimeUTest.F90 +++ b/src/Infrastructure/TimeMgr/tests/ESMF_TimeUTest.F90 @@ -161,10 +161,10 @@ program ESMF_TimeUTest ! ---------------------------------------------------------------------------- !NEX_UTest - ! When asking for real-valued time variables, they are still normalized by days, but - ! they are NOT normalized by time units finer than days. Furthermore, all times - ! include the full, fractional time (so hours, minutes and seconds all give the same - ! time value, just in different units). + ! When asking for double precision time variables, they are still normalized by + ! days, but they are NOT normalized by time units finer than days. Furthermore, all + ! times include the full, fractional time (so hours, minutes and seconds all give + ! the same time value, just in different units). write(name, *) "Get Time Test - real-valued time variables with int-valued date variables" write(failMsg, *) " Did not return correct time values or ESMF_SUCCESS" call ESMF_TimeGet(startTime, yy=YY, mm=MM, dd=DD, h_r8=H_r8, m_r8=M_r8, s_r8=S_r8, rc=rc) @@ -181,9 +181,9 @@ program ESMF_TimeUTest ! ---------------------------------------------------------------------------- !NEX_UTest - ! Time units include the full time even when asking for some time units in integer. - ! This contrasts with the behavior when asking for all things in integer, where the - ! finer time units are normalized by the coarser time units. + ! Double precision time units include the full time even when asking for some time + ! units in integer. This contrasts with the behavior when asking for all things in + ! integer, where the finer time units are normalized by the coarser time units. write(name, *) "Get Time Test - mix of coarser int-valued and finer real-valued time variables" write(failMsg, *) " Did not return correct time values or ESMF_SUCCESS" call ESMF_TimeGet(startTime, yy=YY, mm=MM, dd=DD, h=H, m_r8=M_r8, s_r8=S_r8, rc=rc) @@ -198,11 +198,11 @@ program ESMF_TimeUTest ! ---------------------------------------------------------------------------- !NEX_UTest - ! When asking for coarser time units in reals, days are still used to normalize - ! finer-valued time units, but time variables (e.g., hours) in real are NOT used to - ! normalize finer-valued time units in integer. This contrasts with the behavior - ! when asking for all things in integer, where the finer time units are normalized - ! by the coarser time units. + ! When asking for coarser time units as double precision, days are still used to + ! normalize finer-valued time units, but time variables (e.g., hours) in double + ! precision are NOT used to normalize finer-valued time units in integer. This + ! contrasts with the behavior when asking for all things in integer, where the finer + ! time units are normalized by the coarser time units. write(name, *) "Get Time Test - mix of coarser real-valued and finer int-valued time variables" write(failMsg, *) " Did not return correct time values or ESMF_SUCCESS" call ESMF_TimeGet(startTime, yy=YY, mm=MM, dd=DD, h_r8=H_r8, m=M, s=S, rc=rc) From c380efa5bea0e563e3ad6179b722c96070d19d9a Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Mon, 16 Dec 2024 13:07:22 -0700 Subject: [PATCH 196/207] Document behavior of double precision outputs in ESMF_TimeIntervalGet --- .../TimeMgr/interface/ESMF_TimeInterval.F90 | 16 ++++++++++++++++ 1 file changed, 16 insertions(+) diff --git a/src/Infrastructure/TimeMgr/interface/ESMF_TimeInterval.F90 b/src/Infrastructure/TimeMgr/interface/ESMF_TimeInterval.F90 index 646aabc445..aac702f72a 100644 --- a/src/Infrastructure/TimeMgr/interface/ESMF_TimeInterval.F90 +++ b/src/Infrastructure/TimeMgr/interface/ESMF_TimeInterval.F90 @@ -1086,6 +1086,10 @@ subroutine ESMF_TimeIntervalGetDur(timeinterval, keywordEnforcer, & ! {\tt days = 1}, {\tt seconds = 0}, ! whereas {\tt ESMF\_TimeIntervalGet(s = seconds)} would return ! {\tt seconds = 86400}. +! However, double precision time units are not considered in this normalization: +! Double precision time units are still bound by units of a day or larger, but double +! precision time units of an hour or smaller neither bind nor are bound by other time +! units of an hour or smaller (either integer or double precision). ! ! For timeString, converts {\tt ESMF\_TimeInterval}'s value into ! partial ISO 8601 format PyYmMdDThHmMs[:n/d]S. See ~\cite{ISO} and @@ -1313,6 +1317,10 @@ subroutine ESMF_TimeIntervalGetDurStart(timeinterval, startTimeIn, & ! {\tt days = 1}, {\tt seconds = 0}, ! whereas {\tt ESMF\_TimeIntervalGet(s = seconds)} would return ! {\tt seconds = 86400}. +! However, double precision time units are not considered in this normalization: +! Double precision time units are still bound by units of a day or larger, but double +! precision time units of an hour or smaller neither bind nor are bound by other time +! units of an hour or smaller (either integer or double precision). ! ! For timeString, converts {\tt ESMF\_TimeInterval}'s value into ! partial ISO 8601 format PyYmMdDThHmMs[:n/d]S. See ~\cite{ISO} and @@ -1548,6 +1556,10 @@ subroutine ESMF_TimeIntervalGetDurCal(timeinterval, calendarIn, & ! {\tt days = 1}, {\tt seconds = 0}, ! whereas {\tt ESMF\_TimeIntervalGet(s = seconds)} would return ! {\tt seconds = 86400}. +! However, double precision time units are not considered in this normalization: +! Double precision time units are still bound by units of a day or larger, but double +! precision time units of an hour or smaller neither bind nor are bound by other time +! units of an hour or smaller (either integer or double precision). ! ! For timeString, converts {\tt ESMF\_TimeInterval}'s value into ! partial ISO 8601 format PyYmMdDThHmMs[:n/d]S. See ~\cite{ISO} and @@ -1785,6 +1797,10 @@ subroutine ESMF_TimeIntervalGetDurCalTyp(timeinterval, calkindflagIn, & ! {\tt days = 1}, {\tt seconds = 0}, ! whereas {\tt ESMF\_TimeIntervalGet(s = seconds)} would return ! {\tt seconds = 86400}. +! However, double precision time units are not considered in this normalization: +! Double precision time units are still bound by units of a day or larger, but double +! precision time units of an hour or smaller neither bind nor are bound by other time +! units of an hour or smaller (either integer or double precision). ! ! For timeString, converts {\tt ESMF\_TimeInterval}'s value into ! partial ISO 8601 format PyYmMdDThHmMs[:n/d]S. See ~\cite{ISO} and From f3937712dbfce9af38d4ecaaec0ec7dfdc12f099 Mon Sep 17 00:00:00 2001 From: Robert Oehmke Date: Mon, 16 Dec 2024 13:34:02 -0700 Subject: [PATCH 197/207] Add correct comments so that Geom operator testing is picked up by test coverage checker. --- src/Infrastructure/Geom/tests/ESMF_GeomUTest.F90 | 3 +++ 1 file changed, 3 insertions(+) diff --git a/src/Infrastructure/Geom/tests/ESMF_GeomUTest.F90 b/src/Infrastructure/Geom/tests/ESMF_GeomUTest.F90 index d8f70af5d6..8337d97790 100644 --- a/src/Infrastructure/Geom/tests/ESMF_GeomUTest.F90 +++ b/src/Infrastructure/Geom/tests/ESMF_GeomUTest.F90 @@ -75,6 +75,7 @@ program ESMF_GeomUTest !------------------------------------------------------------------------ !NEX_UTest + ! Testing ESMF_GeomOperator(==)() write(name, *) "Geom equality before assignment Test" write(failMsg, *) "Did not return ESMF_SUCCESS" shouldBeFalse = (geom1 == geom2) @@ -89,6 +90,7 @@ program ESMF_GeomUTest !------------------------------------------------------------------------ !NEX_UTest + ! Testing ESMF_GeomAssignment(=)() write(name, *) "Geom equality with alias test" write(failMsg, *) "Did not return ESMF_SUCCESS" @@ -113,6 +115,7 @@ program ESMF_GeomUTest !------------------------------------------------------------------------ !NEX_UTest + ! Testing ESMF_GeomOperator(/=)() write(name, *) "Geom inequality with two different geoms" write(failMsg, *) "Did not return ESMF_SUCCESS" From 637d39cad82a713d2afaac41193f756355d0e841 Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Mon, 16 Dec 2024 15:10:24 -0700 Subject: [PATCH 198/207] ESMF_Regrid: support -h in addition to --help --- src/apps/ESMF_Regrid/ESMF_Regrid.F90 | 11 ++++++----- .../ESMF_RegridWeightGen/ESMF_RegridWeightGen.F90 | 2 +- 2 files changed, 7 insertions(+), 6 deletions(-) diff --git a/src/apps/ESMF_Regrid/ESMF_Regrid.F90 b/src/apps/ESMF_Regrid/ESMF_Regrid.F90 index 2eea1fad7f..f0eb9598b9 100644 --- a/src/apps/ESMF_Regrid/ESMF_Regrid.F90 +++ b/src/apps/ESMF_Regrid/ESMF_Regrid.F90 @@ -112,9 +112,10 @@ program ESMF_RegridApp ! then broadcast the results to the rest of the Pets ! if (PetNo == 0) then - call ESMF_UtilGetArgIndex('--help', argindex=ind) + call ESMF_UtilGetArgIndex('-h', argindex=ind) + if (ind == -1) call ESMF_UtilGetArgIndex('--help', argindex=ind) if (ind /= -1) then - call PrintUsage() + call PrintUsage() terminateProg=.true. endif call ESMF_UtilGetArgIndex('--version', argindex=ind) @@ -526,7 +527,7 @@ subroutine PrintUsage() print *, " [--dst_regional]" print *, " [--check]" print *, " [--no_log]" - print *, " [--help]" + print *, " [--help|-h]" print *, " [--version]" print *, " [-V]" print *, "where" @@ -547,7 +548,7 @@ subroutine PrintUsage() print *, " where tilename is the tile name defined in the source grid file" print *, "--dstdatafile - If the destination grid is of type MOSAIC, the data is stored" print *, " in separated files, one per tile. dstdatafile is the prefix of" - print *, " the destination data file. The filename is srcdatafile.tilename.nc," + print *, " the destination data file. The filename is dstdatafile.tilename.nc," print *, " where tilename is the tile name defined in the destination grid file" print *, "--tilefile_path - The alternative file path for the tile files and mosaic data files" print *, " when either srcFile or dstFile is a GRIDSPEC MOSAIC grid. The path" @@ -578,7 +579,7 @@ subroutine PrintUsage() print *, " data(i,j,k,l)=2.0+(k-1)+2*(l-1)+cos(lat(i,j))**2*cos(2*lon(i,j)), assuming" print *, " it is a 2D grid " print *, "--no_log - Turn off the ESMF error log." - print *, "--help - Print this help message and exit." + print *, "--help or -h - Print this help message and exit." print *, "--version - Print ESMF version and license information and exit." print *, "-V - Print ESMF version number and exit." print *, "" diff --git a/src/apps/ESMF_RegridWeightGen/ESMF_RegridWeightGen.F90 b/src/apps/ESMF_RegridWeightGen/ESMF_RegridWeightGen.F90 index ef3ce33256..7bb5006cd1 100644 --- a/src/apps/ESMF_RegridWeightGen/ESMF_RegridWeightGen.F90 +++ b/src/apps/ESMF_RegridWeightGen/ESMF_RegridWeightGen.F90 @@ -1379,7 +1379,7 @@ subroutine PrintUsage() print *, " [--no_log]" print *, " [--check]" print *, " [--checkFlag]" - print *, " [--help]" + print *, " [--help|-h]" print *, " [--version]" print *, " [-V]" print *, "where" From 7deaaec0565d6cc6c58974ef78f5ba2039f06834 Mon Sep 17 00:00:00 2001 From: Gerhard Theurich Date: Mon, 16 Dec 2024 15:02:50 -0800 Subject: [PATCH 199/207] Add testing for ESMF_LogInfo() method. --- .../Base/tests/ESMF_InfoUTest.F90 | 23 +++++++++++++++++++ 1 file changed, 23 insertions(+) diff --git a/src/Infrastructure/Base/tests/ESMF_InfoUTest.F90 b/src/Infrastructure/Base/tests/ESMF_InfoUTest.F90 index 8659c62a0a..28fa923bc3 100644 --- a/src/Infrastructure/Base/tests/ESMF_InfoUTest.F90 +++ b/src/Infrastructure/Base/tests/ESMF_InfoUTest.F90 @@ -339,6 +339,29 @@ program ESMF_InfoUTest if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT) !---------------------------------------------------------------------------- + !---------------------------------------------------------------------------- + !NEX_UTest + write(name, *) "ESMF_InfoLog" + write(failMsg, *) "Did not return success." + + rc = ESMF_FAILURE + + info6 = ESMF_InfoCreate(rc=rc) + if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT) + + call ESMF_InfoSet(info6, "/i/am/nested", 111, rc=rc) + if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT) + + call ESMF_InfoSet(info6, "top-level", 222, rc=rc) + if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT) + + call ESMF_InfoLog(info6, prefix="info6: ", rc=rc) + call ESMF_Test((rc == ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE) + + call ESMF_InfoDestroy(info6, rc=rc) + if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT) + !---------------------------------------------------------------------------- + !---------------------------------------------------------------------------- !NEX_UTest write(name, *) "ESMF_InfoRemove Child From Parent" From 2bfd195f7b63841a928c09be425c2ec9a476d986 Mon Sep 17 00:00:00 2001 From: Gerhard Theurich Date: Mon, 16 Dec 2024 15:26:53 -0800 Subject: [PATCH 200/207] Add testing for ESMF_UtilStringDiffMatch() method. --- .../Util/tests/ESMF_UtilUTest.F90 | 52 +++++++++++++++++++ 1 file changed, 52 insertions(+) diff --git a/src/Infrastructure/Util/tests/ESMF_UtilUTest.F90 b/src/Infrastructure/Util/tests/ESMF_UtilUTest.F90 index 8e1fcba2e9..b5d6a90c63 100644 --- a/src/Infrastructure/Util/tests/ESMF_UtilUTest.F90 +++ b/src/Infrastructure/Util/tests/ESMF_UtilUTest.F90 @@ -75,6 +75,7 @@ program ESMF_UtilUTest integer :: nargs character(ESMF_MAXPATHLEN) :: program_path integer :: argindex + logical :: matchFlag real(ESMF_KIND_R8) :: random_values(50) = (/ & 0.997560, 0.566825, 0.965915, 0.747928, 0.367391, & @@ -1003,6 +1004,57 @@ program ESMF_UtilUTest call ESMF_Test(abs (valueDouble - 789.0d0) < 0.000001d0, name, failMsg, result, ESMF_SRCLINE) !------------------------------------------------------------------------ + !------------------------------------------------------------------------ + !EX_UTest + write(name, *) "ESMF_UtilStringDiffMatch() - identical strings - Test" + write(failMsg, *) "Did not return ESMF_SUCCESS" + matchFlag = ESMF_UtilStringDiffMatch( & + string1="A simple test string", string2="A simple test string", & + minusStringList=[""], plusStringList=[""], rc=rc) + call ESMF_Test((rc == ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE) + !------------------------------------------------------------------------ + + !------------------------------------------------------------------------ + !EX_UTest + write(name, *) "ESMF_UtilStringDiffMatch() - identical strings - match Test" + write(failMsg, *) "Did not return correct match flag" + call ESMF_Test(matchFlag, name, failMsg, result, ESMF_SRCLINE) + !------------------------------------------------------------------------ + + !------------------------------------------------------------------------ + !EX_UTest + write(name, *) "ESMF_UtilStringDiffMatch() - different strings - Test" + write(failMsg, *) "Did not return ESMF_SUCCESS" + matchFlag = ESMF_UtilStringDiffMatch( & + string1="A simple test string", string2="A xyzzyx test string", & + minusStringList=[""], plusStringList=[""], rc=rc) + call ESMF_Test((rc == ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE) + !------------------------------------------------------------------------ + + !------------------------------------------------------------------------ + !EX_UTest + write(name, *) "ESMF_UtilStringDiffMatch() - different strings - match Test" + write(failMsg, *) "Did not return correct match flag" + call ESMF_Test(.not.matchFlag, name, failMsg, result, ESMF_SRCLINE) + !------------------------------------------------------------------------ + + !------------------------------------------------------------------------ + !EX_UTest + write(name, *) "ESMF_UtilStringDiffMatch() - different strings minus/plus - Test" + write(failMsg, *) "Did not return ESMF_SUCCESS" + matchFlag = ESMF_UtilStringDiffMatch( & + string1="A simple test string", string2="A xyzzyx test string", & + minusStringList=["simple"], plusStringList=["xyzzyx"], rc=rc) + call ESMF_Test((rc == ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE) + !------------------------------------------------------------------------ + + !------------------------------------------------------------------------ + !EX_UTest + write(name, *) "ESMF_UtilStringDiffMatch() - different strings minus/plus - match Test" + write(failMsg, *) "Did not return correct match flag" + call ESMF_Test(matchFlag, name, failMsg, result, ESMF_SRCLINE) + !------------------------------------------------------------------------ + ! Internal string utilities (NOT part of the external ESMF API) !============================================================== From f0d37d82c4277d3b80761a161d615319ab8892ee Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Mon, 16 Dec 2024 17:07:12 -0700 Subject: [PATCH 201/207] Fix typos in documentation --- src/doc/ESMF_Regrid.tex | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/doc/ESMF_Regrid.tex b/src/doc/ESMF_Regrid.tex index e3629d85e2..d4f648d05b 100644 --- a/src/doc/ESMF_Regrid.tex +++ b/src/doc/ESMF_Regrid.tex @@ -21,7 +21,7 @@ \subsection{Description} a logically rectangular grid, the UGRID file format(~\ref{sec:fileformat:ugrid}) for unstructured grid and the GRIDSPEC Mosaic file format(~\ref{sec:fileformat:mosaic}) for cubed-sphere grid. For -the GRIDSPEC Mosaic file format, the data are stored in seperate data files, +the GRIDSPEC Mosaic file format, the data are stored in separate data files, one file per tile. The SCRIP format(~\ref{sec:fileformat:scrip}) and the ESMF unstructured grid format(~\ref{sec:fileformat:esmf}) are not supported because there is no way to define a variable field using these two formats. Currently, the tool only works with 2D grids, the support for the 3D grid will be made available in the future release. The variable array can be up to four dimensions. The @@ -113,7 +113,7 @@ \subsection{Description} The GRIDSPEC MOSAIC file(~\ref{sec:fileformat:mosaic}) can be identified by a dummy variable with {\tt standard\_name} attribute set to {\tt grid\_mosaic\_spec}. The data for a -GRIDSPEC Mosaic file are stored in seperate files, one tile per file. The +GRIDSPEC Mosaic file are stored in separate files, one tile per file. The name of the data file is not specified in the mosaic file. Therefore, additional optional argument {\tt --srcdatafile} or {\tt --dstdatafile} is required to provide the prefix of the datafile. The datafile is also a CF @@ -177,7 +177,7 @@ \subsection{Description} If the destination variable exists in the destination grid file, it has to have the same number of dimensions and the same type as the source variable. Except for the latitude and longitude dimensions, the size of the destination variable's extra dimensions (e.g., time and vertical layers) has to match with the -source variable. If the destination varialbe does not exist in the destination grid file, a +source variable. If the destination variable does not exist in the destination grid file, a new variable will be created with the same type and matching dimensions as the source variable. All the attributes of the source variable will be copied to the destination variable except those related to the grid definition (i.e. {\tt coordinates} attribute if the destination file is in From 8c9bd16e81c1bc6125091552b5d0ee220d894092 Mon Sep 17 00:00:00 2001 From: Gerhard Theurich Date: Mon, 16 Dec 2024 16:35:24 -0800 Subject: [PATCH 202/207] Change ESMF_UtilStringDiffMatch from BOP to BOPI. --- src/Infrastructure/Util/interface/ESMF_Util.F90 | 4 ++-- src/Infrastructure/Util/tests/ESMF_UtilUTest.F90 | 6 +++--- 2 files changed, 5 insertions(+), 5 deletions(-) diff --git a/src/Infrastructure/Util/interface/ESMF_Util.F90 b/src/Infrastructure/Util/interface/ESMF_Util.F90 index 4daeda1801..f27468ff33 100644 --- a/src/Infrastructure/Util/interface/ESMF_Util.F90 +++ b/src/Infrastructure/Util/interface/ESMF_Util.F90 @@ -997,7 +997,7 @@ end function ESMF_UtilString2Real !----------------------------------------------------------------------------- -!BOP +!BOPI ! !IROUTINE: ESMF_UtilStringDiffMatch - Match differences between two strings ! !INTERFACE: function ESMF_UtilStringDiffMatch(string1, string2, minusStringList, & @@ -1031,7 +1031,7 @@ function ESMF_UtilStringDiffMatch(string1, string2, minusStringList, & ! Return code; equals {\tt ESMF\_SUCCESS} if there are no errors. ! \end{description} ! -!EOP +!EOPI !----------------------------------------------------------------------------- ! local variables integer :: localrc diff --git a/src/Infrastructure/Util/tests/ESMF_UtilUTest.F90 b/src/Infrastructure/Util/tests/ESMF_UtilUTest.F90 index b5d6a90c63..718280c149 100644 --- a/src/Infrastructure/Util/tests/ESMF_UtilUTest.F90 +++ b/src/Infrastructure/Util/tests/ESMF_UtilUTest.F90 @@ -1004,6 +1004,9 @@ program ESMF_UtilUTest call ESMF_Test(abs (valueDouble - 789.0d0) < 0.000001d0, name, failMsg, result, ESMF_SRCLINE) !------------------------------------------------------------------------ +! Internal string utilities (NOT part of the external ESMF API) +!============================================================== + !------------------------------------------------------------------------ !EX_UTest write(name, *) "ESMF_UtilStringDiffMatch() - identical strings - Test" @@ -1055,9 +1058,6 @@ program ESMF_UtilUTest call ESMF_Test(matchFlag, name, failMsg, result, ESMF_SRCLINE) !------------------------------------------------------------------------ -! Internal string utilities (NOT part of the external ESMF API) -!============================================================== - !------------------------------------------------------------------------ !EX_UTest ! Test concatenating strings From 6724effb075d7e2aa8e9965ad963e2f8394070df Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Wed, 18 Dec 2024 15:48:09 -0700 Subject: [PATCH 203/207] Minor documentation fixes --- src/doc/ESMF_Regrid.tex | 6 +++--- src/doc/ESMF_RegridWeightGen.tex | 4 ++-- 2 files changed, 5 insertions(+), 5 deletions(-) diff --git a/src/doc/ESMF_Regrid.tex b/src/doc/ESMF_Regrid.tex index d4f648d05b..0b341d5cff 100644 --- a/src/doc/ESMF_Regrid.tex +++ b/src/doc/ESMF_Regrid.tex @@ -255,7 +255,7 @@ \subsection{Usage}\label{sec:fileregridusage} [--dst_regional] [--check] [--no_log] - [--help] + [--help|-h] [--version] [-V] where @@ -280,7 +280,7 @@ \subsection{Usage}\label{sec:fileregridusage} is srcdatafile.tilename.nc, where tilename is the tile name defined in the MOSAIC file. - --srcdatafile - If the destination grid is a GRIDSPEC MOSAIC grid, the data + --dstdatafile - If the destination grid is a GRIDSPEC MOSAIC grid, the data is stored in separate files, one per tile. dstdatafile is the prefix of the destination data file. The filename is dstdatafile.tilename.nc, where tilename is the tile @@ -380,7 +380,7 @@ \subsection{Usage}\label{sec:fileregridusage} --no_log - Turn off the ESMF error log. - --help - Print the usage message and exit. + --help or -h - Print the usage message and exit. --version - Print ESMF version and license information and exit. diff --git a/src/doc/ESMF_RegridWeightGen.tex b/src/doc/ESMF_RegridWeightGen.tex index dc0f908d20..ad10292721 100644 --- a/src/doc/ESMF_RegridWeightGen.tex +++ b/src/doc/ESMF_RegridWeightGen.tex @@ -326,7 +326,7 @@ \subsection{Usage}\label{sec:regridusage} [--check] [--checkFlag] [--no_log] - [--help] + [--help|-h] [--version] [-V] @@ -603,7 +603,7 @@ \subsection{Usage}\label{sec:regridusage} --no_log - Turn off the ESMF Log files. By default, ESMF creates multiple log files, one per PET. - --help - Print the usage message and exit. + --help or -h - Print the usage message and exit. --version - Print ESMF version and license information and exit. From 63eb6a2b1f2efa91c5f34848d607c573d0067356 Mon Sep 17 00:00:00 2001 From: Daniel Rosen Date: Fri, 20 Dec 2024 09:16:44 -0600 Subject: [PATCH 204/207] Clarify NUOPC_CompAttributeIngest documentation * add note that whitespace delimited lists are not supported --- src/addon/NUOPC/src/NUOPC_Comp.F90 | 19 ++++++++++++++++++- 1 file changed, 18 insertions(+), 1 deletion(-) diff --git a/src/addon/NUOPC/src/NUOPC_Comp.F90 b/src/addon/NUOPC/src/NUOPC_Comp.F90 index 71d02cd762..05f5637d0c 100644 --- a/src/addon/NUOPC/src/NUOPC_Comp.F90 +++ b/src/addon/NUOPC/src/NUOPC_Comp.F90 @@ -1610,7 +1610,10 @@ subroutine NUOPC_GridCompAttributeIng(comp, freeFormat, addFlag, rc) ! Important: Attributes ingested by this method are stored as type character ! strings, and must be accessed accordingly. Conversion from string into a ! different data type, e.g. {\tt integer} or {\tt real}, is the user's -! responsibility. +! responsibility. This method does not support value lists. Attribute values +! ingested by this method must not contain whitespace within the value. If +! whitespace is found within the value the attribute will not be added to +! the comp. ! ! If {\tt addFlag} is {\tt .false.} (default), an error will be returned if ! an attribute is to be ingested that was not previously added to the @@ -1644,6 +1647,20 @@ subroutine NUOPC_GridCompAttributeIng(comp, freeFormat, addFlag, rc) ! specifies a user-level Attribute, which is not part of the pre-defined ! Attributes of any of the standard NUOPC component kinds. ! +! Currently, whitespace is not supported in the attribute value and +! the following attributeName fails to be added. +! +! \begin{verbatim} +! attributeName = attributeValue1 attributeValue2 attributedValue3 +! \end{verbatim} +! +! If a list is needed then a comma can be used as a delimiter. The +! attribute value list must then be parsed in user code. +! +! \begin{verbatim} +! attributeName = attributeValue1,attributeValue2,attributedValue3 +! \end{verbatim} +! !EOP !----------------------------------------------------------------------------- character(ESMF_MAXSTR) :: name From 6f3d9530e97cdf614e8c3d13872fa170bf894d09 Mon Sep 17 00:00:00 2001 From: Gerhard Theurich Date: Wed, 8 Jan 2025 11:06:21 -0800 Subject: [PATCH 205/207] Fix Latex syntax by adding missing backslashes. --- src/Infrastructure/TimeMgr/interface/ESMF_Time.F90 | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/src/Infrastructure/TimeMgr/interface/ESMF_Time.F90 b/src/Infrastructure/TimeMgr/interface/ESMF_Time.F90 index 70ed535755..7f8f026d00 100644 --- a/src/Infrastructure/TimeMgr/interface/ESMF_Time.F90 +++ b/src/Infrastructure/TimeMgr/interface/ESMF_Time.F90 @@ -667,10 +667,10 @@ subroutine ESMF_TimeGet(time, keywordEnforcer, & ! precision time units of an hour or smaller neither bind nor are bound by other time ! units of an hour or smaller (either integer or double precision). For example, ! with the same time setting as above (2:00 am on February 2, 2004), -! {\tt ESMF\_TimeGet(dd=day, h_r8=hours_r8, s=seconds)} would return -! {\tt day = 2}, {\tt hours_r8 = 2.0}, {\tt seconds = 7200}, and -! {\tt ESMF\_TimeGet(dd=day, h=hours, s_r8=seconds_r8)} would return -! {\tt day = 2}, {\tt hours = 2}, {\tt seconds_r8 = 7200.0}. +! {\tt ESMF\_TimeGet(dd=day, h\_r8=hours\_r8, s=seconds)} would return +! {\tt day = 2}, {\tt hours\_r8 = 2.0}, {\tt seconds = 7200}, and +! {\tt ESMF\_TimeGet(dd=day, h=hours, s\_r8=seconds\_r8)} would return +! {\tt day = 2}, {\tt hours = 2}, {\tt seconds\_r8 = 7200.0}. ! ! For {\tt timeString}, {\tt timeStringISOFrac}, {\tt dayOfWeek}, ! {\tt midMonth}, {\tt dayOfYear}, {\tt dayOfYear\_intvl}, and From 80eb9bfd3a151a01cfa8efe7e17f3e93153cc55c Mon Sep 17 00:00:00 2001 From: Gerhard Theurich Date: Wed, 8 Jan 2025 11:08:03 -0800 Subject: [PATCH 206/207] Set versioning for 8.8.0 release. --- README.md | 2 +- src/Infrastructure/Util/include/ESMC_Macros.h | 6 +++--- src/Infrastructure/Util/src/ESMF_UtilTypes.F90 | 6 +++--- src/addon/NUOPC/doc/NUOPC_howtodoc.ctex | 2 +- src/addon/NUOPC/doc/NUOPC_refdoc.ctex | 2 +- src/addon/esmpy/README.md | 2 +- src/doc/ESMC_crefdoc.ctex | 2 +- src/doc/ESMF_refdoc.ctex | 2 +- src/doc/ESMF_usrdoc.ctex | 2 +- 9 files changed, 13 insertions(+), 13 deletions(-) diff --git a/README.md b/README.md index eb7f420bea..3996c880e1 100644 --- a/README.md +++ b/README.md @@ -6,7 +6,7 @@ [![DOI](https://zenodo.org/badge/DOI/10.5281/zenodo.11205526.svg)](https://doi.org/10.5281/zenodo.11205526) ->Copyright (c) 2002-2024 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. All rights reserved. +>Copyright (c) 2002-2025 University Corporation for Atmospheric Research, Massachusetts Institute of Technology, Geophysical Fluid Dynamics Laboratory, University of Michigan, National Centers for Environmental Prediction, Los Alamos National Laboratory, Argonne National Laboratory, NASA Goddard Space Flight Center. All rights reserved. Hello and welcome to ESMF. diff --git a/src/Infrastructure/Util/include/ESMC_Macros.h b/src/Infrastructure/Util/include/ESMC_Macros.h index 6c1eac73e2..258257d9ae 100644 --- a/src/Infrastructure/Util/include/ESMC_Macros.h +++ b/src/Infrastructure/Util/include/ESMC_Macros.h @@ -54,10 +54,10 @@ #define ESMF_VERSION_MINOR 8 #define ESMF_VERSION_REVISION 0 #define ESMF_VERSION_PATCHLEVEL 0 -#define ESMF_VERSION_PUBLIC 'F' -#define ESMF_VERSION_BETASNAPSHOT 'T' +#define ESMF_VERSION_PUBLIC 'T' +#define ESMF_VERSION_BETASNAPSHOT 'F' -#define ESMF_VERSION_STRING "8.8.0 beta snapshot" +#define ESMF_VERSION_STRING "8.8.0" #endif // ESMC_MACROS_H diff --git a/src/Infrastructure/Util/src/ESMF_UtilTypes.F90 b/src/Infrastructure/Util/src/ESMF_UtilTypes.F90 index 7e64f1cc3b..4a98a777df 100644 --- a/src/Infrastructure/Util/src/ESMF_UtilTypes.F90 +++ b/src/Infrastructure/Util/src/ESMF_UtilTypes.F90 @@ -85,10 +85,10 @@ module ESMF_UtilTypesMod integer, parameter :: ESMF_VERSION_MINOR = 8 integer, parameter :: ESMF_VERSION_REVISION = 0 integer, parameter :: ESMF_VERSION_PATCHLEVEL = 0 - logical, parameter :: ESMF_VERSION_PUBLIC = .false. - logical, parameter :: ESMF_VERSION_BETASNAPSHOT = .true. + logical, parameter :: ESMF_VERSION_PUBLIC = .true. + logical, parameter :: ESMF_VERSION_BETASNAPSHOT = .false. - character(*), parameter :: ESMF_VERSION_STRING = "8.8.0 beta snapshot" + character(*), parameter :: ESMF_VERSION_STRING = "8.8.0 #if defined (ESMF_NETCDF) logical, parameter :: ESMF_IO_NETCDF_PRESENT = .true. diff --git a/src/addon/NUOPC/doc/NUOPC_howtodoc.ctex b/src/addon/NUOPC/doc/NUOPC_howtodoc.ctex index 85d8425a43..d780352d81 100644 --- a/src/addon/NUOPC/doc/NUOPC_howtodoc.ctex +++ b/src/addon/NUOPC/doc/NUOPC_howtodoc.ctex @@ -17,7 +17,7 @@ \addtolength{\oddsidemargin}{-.75in} \newcommand{\mytitle}{\Large {\bf Building a NUOPC Model}} \newcommand{\myauthors}{\large {\it Content Standards Committee (CSC) Members}} -\newcommand{\myversion}{ESMF 8.8.0 beta snapshot} +\newcommand{\myversion}{ESMF 8.8.0} % set a standard paragraph style \setlength{\parskip}{0pt} \setlength{\parindent}{0pt} diff --git a/src/addon/NUOPC/doc/NUOPC_refdoc.ctex b/src/addon/NUOPC/doc/NUOPC_refdoc.ctex index 69e343ed4a..d7cafd3894 100644 --- a/src/addon/NUOPC/doc/NUOPC_refdoc.ctex +++ b/src/addon/NUOPC/doc/NUOPC_refdoc.ctex @@ -17,7 +17,7 @@ \addtolength{\oddsidemargin}{-.75in} \newcommand{\mytitle}{\Large {\bf NUOPC Layer Reference}} \newcommand{\myauthors}{\large {\it Content Standards Committee (CSC) Members}} -\newcommand{\myversion}{ESMF 8.8.0 beta snapshot} +\newcommand{\myversion}{ESMF 8.8.0} % set a standard paragraph style \setlength{\parskip}{0pt} \setlength{\parindent}{0pt} diff --git a/src/addon/esmpy/README.md b/src/addon/esmpy/README.md index c948644d36..e8b2436935 100644 --- a/src/addon/esmpy/README.md +++ b/src/addon/esmpy/README.md @@ -1,6 +1,6 @@ # Earth System Modeling Framework Python Interface (ESMPy) -> Copyright (c) 2002-2024, 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. +> Copyright (c) 2002-2025, University Corporation for Atmospheric Research, Massachusetts Institute of Technology, Geophysical Fluid Dynamics Laboratory, University of Michigan, National Centers for Environmental Prediction, Los Alamos National Laboratory, Argonne National Laboratory, NASA Goddard Space Flight Center. Licensed under the University of Illinois-NCSA License. * [ESMPy Documentation](https://earthsystemmodeling.org/esmpy_doc/nightly/develop/html/) * [Installation](https://earthsystemmodeling.org/esmpy_doc/nightly/develop/html/install.html) diff --git a/src/doc/ESMC_crefdoc.ctex b/src/doc/ESMC_crefdoc.ctex index f1416366f0..bb8c1d1eea 100644 --- a/src/doc/ESMC_crefdoc.ctex +++ b/src/doc/ESMC_crefdoc.ctex @@ -14,7 +14,7 @@ \newcommand{\sreq}[1]{\subsection{\hspace{.2in}#1}} \newcommand{\ssreq}[1]{\subsubsection{\hspace{.2in}#1}} \newcommand{\mytitle}{\longname \docmttype ~~} -\newcommand{\myversion}{Version 8.8.0 beta snapshot} +\newcommand{\myversion}{Version 8.8.0} \newenvironment {reqlist} diff --git a/src/doc/ESMF_refdoc.ctex b/src/doc/ESMF_refdoc.ctex index f50f960db5..56561bb842 100644 --- a/src/doc/ESMF_refdoc.ctex +++ b/src/doc/ESMF_refdoc.ctex @@ -15,7 +15,7 @@ \newcommand{\sreq}[1]{\subsection{\hspace{.2in}#1}} \newcommand{\ssreq}[1]{\subsubsection{\hspace{.2in}#1}} \newcommand{\mytitle}{\longname \docmttype ~~} -\newcommand{\myversion}{Version 8.8.0 beta snapshot} +\newcommand{\myversion}{Version 8.8.0} \input{common_commands} diff --git a/src/doc/ESMF_usrdoc.ctex b/src/doc/ESMF_usrdoc.ctex index 74541c66be..d4bc8bd2fc 100644 --- a/src/doc/ESMF_usrdoc.ctex +++ b/src/doc/ESMF_usrdoc.ctex @@ -14,7 +14,7 @@ \newcommand{\sreq}[1]{\subsection{\hspace{.2in}#1}} \newcommand{\ssreq}[1]{\subsubsection{\hspace{.2in}#1}} \newcommand{\mytitle}{\longname \docmttype ~~} -\newcommand{\myversion}{Version 8.8.0 beta snapshot} +\newcommand{\myversion}{Version 8.8.0} \newenvironment {reqlist} From c5a1114b171c552caac4213492079b83003a6882 Mon Sep 17 00:00:00 2001 From: Gerhard Theurich Date: Wed, 8 Jan 2025 11:25:52 -0800 Subject: [PATCH 207/207] Fix version string. --- src/Infrastructure/Util/src/ESMF_UtilTypes.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Infrastructure/Util/src/ESMF_UtilTypes.F90 b/src/Infrastructure/Util/src/ESMF_UtilTypes.F90 index 4a98a777df..cf3b3ef6a4 100644 --- a/src/Infrastructure/Util/src/ESMF_UtilTypes.F90 +++ b/src/Infrastructure/Util/src/ESMF_UtilTypes.F90 @@ -88,7 +88,7 @@ module ESMF_UtilTypesMod logical, parameter :: ESMF_VERSION_PUBLIC = .true. logical, parameter :: ESMF_VERSION_BETASNAPSHOT = .false. - character(*), parameter :: ESMF_VERSION_STRING = "8.8.0 + character(*), parameter :: ESMF_VERSION_STRING = "8.8.0" #if defined (ESMF_NETCDF) logical, parameter :: ESMF_IO_NETCDF_PRESENT = .true.