From fe709e75b1e0677b08a7d9fe967e723a9d179ee9 Mon Sep 17 00:00:00 2001 From: Gerhard Theurich Date: Tue, 10 Sep 2024 14:00:54 -0700 Subject: [PATCH 1/2] Add connection option support for regridding method "conserve_2nd" and extrapolation method "nearest_d". --- src/addon/NUOPC/doc/NUOPC_ConnectionOptions.tex | 4 ++-- src/addon/NUOPC/src/NUOPC_Connector.F90 | 4 ++++ 2 files changed, 6 insertions(+), 2 deletions(-) diff --git a/src/addon/NUOPC/doc/NUOPC_ConnectionOptions.tex b/src/addon/NUOPC/doc/NUOPC_ConnectionOptions.tex index 62166c30f0..0085c4fff3 100644 --- a/src/addon/NUOPC/doc/NUOPC_ConnectionOptions.tex +++ b/src/addon/NUOPC/doc/NUOPC_ConnectionOptions.tex @@ -28,14 +28,14 @@ {\tt dstMaskValues} & List of integer values that defines the mask values. & multi & List of integers.\\ \hline {\tt dumpWeights} & Enable or disable dumping of the interpolation weights into a file. & single & {\tt true}, {\tt false}(default)\\ \hline {\tt extrapDistExponent} & The exponent to raise the distance to when calculating weights for the nearest\_idavg extrapolation method. & single & real(default 2.0)\\ \hline - {\tt extrapMethod} & Fill in points not mapped by the regrid method. & single & {\tt none}(default), {\tt nearest\_idavg}, {\tt nearest\_stod}, {\tt creep}, {\tt creep\_nrst\_d} \\ \hline + {\tt extrapMethod} & Fill in points not mapped by the regrid method. & single & {\tt none}(default), {\tt nearest\_idavg}, {\tt nearest\_stod}, {\tt nearest\_d}, {\tt creep}, {\tt creep\_nrst\_d} \\ \hline {\tt extrapNumLevels} & The number of levels to output for the extrapolation methods that fill levels. When a method is used that requires this, then an error will be returned, if it is not specified. & single & integer\\ \hline {\tt extrapNumSrcPnts} & The number of source points to use for the extrapolation methods that use more than one source point. & single & integer(default 8)\\ \hline {\tt ignoreDegenerate} & Ignore degenerate cells when checking the input Grids or Meshes for errors. & single & {\tt true}, {\tt false}(default)\\ \hline {\tt ignoreUnmatchedIndices} & Ignore unmatched sequence indices when redistributing between source and destination index space. & single & {\tt true}, {\tt false}(default)\\ \hline {\tt pipelineDepth} & Maximum number of outstanding non-blocking communication calls during the parallel interpolation. Only relevant for cases where the automatic tuning procedure fails to find a setting that works well on a given hardware. & single & integer\\ \hline {\tt poleMethod} & Extrapolation method around the pole(s). & single & {\tt none}(default), {\tt allavg}, {\tt npntavg}={\em "integer indicating number of points"}, {\tt teeth}\\ \hline - {\tt remapMethod} & Redistribution or interpolation to compute the regridding weights. & single & {\tt redist}, {\tt bilinear}(default), {\tt patch}, {\tt nearest\_stod}, {\tt nearest\_dtos}, {\tt conserve}\\ \hline + {\tt remapMethod} & Redistribution or interpolation to compute the regridding weights. & single & {\tt redist}, {\tt bilinear}(default), {\tt patch}, {\tt nearest\_stod}, {\tt nearest\_dtos}, {\tt conserve}, {\tt conserve\_2nd}\\ \hline {\tt srcMaskValues} & List of integer values that defines the mask values. & multi & List of integers.\\ \hline {\tt srcTermProcessing} & Number of terms in each partial sum of the interpolation to process on the source side. This setting impacts the bit-for-bit reproducibility of the parallel interpolation results between runs. The strictest bit-for-bit setting is achieved by setting the value to 1. & single & integer\\ \hline {\tt termOrder} & Order of the terms in each partial sum of the interpolation. This setting impacts the bit-for-bit reproducibility of the parallel interpolation results between runs. The strictest bit-for-bit setting is achieved by setting the value to {\tt srcseq}. & single & {\tt free}(default), {\tt srcseq}, {\tt srcpet}\\ \hline diff --git a/src/addon/NUOPC/src/NUOPC_Connector.F90 b/src/addon/NUOPC/src/NUOPC_Connector.F90 index b11e6e92d4..5dd942d43d 100644 --- a/src/addon/NUOPC/src/NUOPC_Connector.F90 +++ b/src/addon/NUOPC/src/NUOPC_Connector.F90 @@ -7422,6 +7422,8 @@ subroutine FieldBundleCplStore(srcFB, dstFB, cplList, rh, zeroRegions, & regridmethod = ESMF_REGRIDMETHOD_NEAREST_DTOS else if (trim(chopSubString(2))=="conserve") then regridmethod = ESMF_REGRIDMETHOD_CONSERVE + else if (trim(chopSubString(2))=="conserve_2nd") then + regridmethod = ESMF_REGRIDMETHOD_CONSERVE_2ND else write (msgString,*) "Specified option '", & trim(chopStringList(j)), & @@ -7509,6 +7511,8 @@ subroutine FieldBundleCplStore(srcFB, dstFB, cplList, rh, zeroRegions, & extrapMethod = ESMF_EXTRAPMETHOD_NEAREST_IDAVG else if (trim(chopSubString(2))=="nearest_stod") then extrapMethod = ESMF_EXTRAPMETHOD_NEAREST_STOD + else if (trim(chopSubString(2))=="nearest_d") then + extrapMethod = ESMF_EXTRAPMETHOD_NEAREST_D else if (trim(chopSubString(2))=="creep") then extrapMethod = ESMF_EXTRAPMETHOD_CREEP else if (trim(chopSubString(2))=="creep_nrst_d") then From a843fd8b84ac206a052729a1a06d171a9c4ae9b4 Mon Sep 17 00:00:00 2001 From: Gerhard Theurich Date: Tue, 10 Sep 2024 14:32:31 -0700 Subject: [PATCH 2/2] Remove unused code under the #ifdef USE_ESMF_RHL #else branches. --- src/addon/NUOPC/src/NUOPC_Connector.F90 | 368 ------------------------ 1 file changed, 368 deletions(-) diff --git a/src/addon/NUOPC/src/NUOPC_Connector.F90 b/src/addon/NUOPC/src/NUOPC_Connector.F90 index 5dd942d43d..1a0ef0a744 100644 --- a/src/addon/NUOPC/src/NUOPC_Connector.F90 +++ b/src/addon/NUOPC/src/NUOPC_Connector.F90 @@ -60,8 +60,6 @@ module NUOPC_Connector type(ESMF_FieldBundle) :: dstFields type(ESMF_Field), pointer :: srcFieldList(:) type(ESMF_Field), pointer :: dstFieldList(:) - integer :: srcFieldCount - integer :: dstFieldCount type(ESMF_RouteHandle) :: rh type(ESMF_State) :: state type(ESMF_Region_Flag), pointer :: zeroRegions(:) @@ -73,8 +71,6 @@ module NUOPC_Connector type(ESMF_FieldBundle) :: dstFields type(ESMF_Field), pointer :: srcFieldList(:) type(ESMF_Field), pointer :: dstFieldList(:) - integer :: srcFieldCount - integer :: dstFieldCount logical :: srcDstOverlap logical :: srcFlag logical :: dstFlag @@ -7094,46 +7090,7 @@ subroutine FieldBundleCplStore(srcFB, dstFB, cplList, rh, zeroRegions, & integer :: fieldDimCount, gridDimCount logical :: gridPair, verbosityFlag - type RHL - type(ESMF_Grid) :: srcGrid, dstGrid - ! field specific items, TODO: push into a FieldMatch() method - type(ESMF_ArraySpec) :: srcArraySpec, dstArraySpec - type(ESMF_StaggerLoc) :: srcStaggerLoc, dstStaggerLoc - integer, pointer :: srcGridToFieldMap(:) - integer, pointer :: dstGridToFieldMap(:) - integer, pointer :: srcUngriddedLBound(:) - integer, pointer :: srcUngriddedUBound(:) - integer, pointer :: dstUngriddedLBound(:) - integer, pointer :: dstUngriddedUBound(:) - ! remap specific items - logical :: redistflag - type(ESMF_RegridMethod_Flag) :: regridmethod - type(ESMF_ExtrapMethod_Flag) :: extrapMethod - integer :: extrapNumSrcPnts - real :: extrapDistExponent - integer :: extrapNumLevels - logical :: ignoreDegenerate - type(ESMF_RouteHandle) :: rh - integer(ESMF_KIND_I4), pointer :: factorIndexList(:,:) - real(ESMF_KIND_R8), pointer :: factorList(:) - integer(ESMF_KIND_I4), pointer :: srcMaskValues(:) - integer(ESMF_KIND_I4), pointer :: dstMaskValues(:) - type(ESMF_PoleMethod_Flag) :: polemethod - integer :: regridPoleNPnts - type(ESMF_UnmappedAction_Flag) :: unmappedaction - type(RHL), pointer :: prev - end type - -#define USE_ESMF_RHL -!TODO: Remove code that is under all the USE_ESMF_RHL-else branches after -!TODO: plenty of testing across systems, and no issues with the ESMF level -!TODO: implementation have been found or reported. I estimate this should happen -!TODO: right before the ESMF 8.6.0 release. -#ifdef USE_ESMF_RHL type(ESMF_RHL), pointer :: rhList, rhListE -#else - type(RHL), pointer :: rhList, rhListE -#endif logical :: rhListMatch verbosityFlag = btest(verbosity,12) @@ -7762,7 +7719,6 @@ subroutine FieldBundleCplStore(srcFB, dstFB, cplList, rh, zeroRegions, & endif enddo -#ifdef USE_ESMF_RHL call ESMF_FieldBundleRegridStorePair(srcFields(i), dstFields(i), & srcMaskValues, dstMaskValues, regridmethod, polemethod, & regridPoleNPnts, & @@ -7776,325 +7732,6 @@ subroutine FieldBundleCplStore(srcFB, dstFB, cplList, rh, zeroRegions, & if (ESMF_LogFoundError(rcToCheck=localrc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, file=trim(name)//":"//FILENAME, rcToReturn=rc)) return ! bail out -#else - - ! for now reuse of Regrid RouteHandle is only implemented for Grids - - call ESMF_FieldGet(srcFields(i), geomtype=srcGeomtype, rc=localrc) - if (ESMF_LogFoundError(rcToCheck=localrc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=trim(name)//":"//FILENAME, rcToReturn=rc)) return ! bail out - call ESMF_FieldGet(dstFields(i), geomtype=dstGeomtype, rc=localrc) - if (ESMF_LogFoundError(rcToCheck=localrc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=trim(name)//":"//FILENAME, rcToReturn=rc)) return ! bail out - - gridPair = (srcGeomtype==ESMF_GEOMTYPE_GRID) - gridPair = gridPair .and. (dstGeomtype==ESMF_GEOMTYPE_GRID) - - rhListMatch = .false. - - if (gridPair) then - ! access the src and dst grid objects - call ESMF_FieldGet(srcFields(i), arrayspec=srcArraySpec, grid=srcGrid, & - staggerLoc=srcStaggerLoc, dimCount=fieldDimCount, rc=localrc) - if (ESMF_LogFoundError(rcToCheck=localrc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=trim(name)//":"//FILENAME, rcToReturn=rc)) return ! bail out - call ESMF_GridGet(srcGrid, dimCount=gridDimCount, rc=localrc) - if (ESMF_LogFoundError(rcToCheck=localrc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=trim(name)//":"//FILENAME, rcToReturn=rc)) return ! bail out - allocate(srcGridToFieldMap(gridDimCount)) - allocate(srcUngriddedLBound(fieldDimCount-gridDimCount), & - srcUngriddedUBound(fieldDimCount-gridDimCount)) - call ESMF_FieldGet(srcFields(i), gridToFieldMap=srcGridToFieldMap, & - ungriddedLBound=srcUngriddedLBound, & - ungriddedUBound=srcUngriddedUBound,rc=localrc) - if (ESMF_LogFoundError(rcToCheck=localrc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=trim(name)//":"//FILENAME, rcToReturn=rc)) return ! bail out - - call ESMF_FieldGet(dstFields(i), arrayspec=dstArraySpec, grid=dstGrid, & - staggerLoc=dstStaggerLoc, rc=localrc) - if (ESMF_LogFoundError(rcToCheck=localrc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=trim(name)//":"//FILENAME, rcToReturn=rc)) return ! bail out - call ESMF_GridGet(dstGrid, dimCount=gridDimCount, rc=localrc) - if (ESMF_LogFoundError(rcToCheck=localrc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=trim(name)//":"//FILENAME, rcToReturn=rc)) return ! bail out - allocate(dstGridToFieldMap(gridDimCount)) - allocate(dstUngriddedLBound(fieldDimCount-gridDimCount), & - dstUngriddedUBound(fieldDimCount-gridDimCount)) - call ESMF_FieldGet(dstFields(i), gridToFieldMap=dstGridToFieldMap, & - ungriddedLBound=dstUngriddedLBound, & - ungriddedUBound=dstUngriddedUBound,rc=localrc) - if (ESMF_LogFoundError(rcToCheck=localrc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=trim(name)//":"//FILENAME, rcToReturn=rc)) return ! bail out - - ! search for a match - rhListE=>rhList - do while (associated(rhListE)) - ! test src grid match - rhListMatch = & - ESMF_GridMatch(rhListE%srcGrid, srcGrid, globalflag=.true., rc=localrc) & - >= ESMF_GRIDMATCH_EXACT - if (ESMF_LogFoundError(rcToCheck=localrc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=trim(name)//":"//FILENAME, rcToReturn=rc)) return ! bail out -#if 0 -write (msgString,*) trim(name)//": srcGrid Match for i=", i, " is: ", & - rhListMatch -call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_DEBUG) -#endif - if (.not.rhListMatch) goto 123 - ! test dst grid match - rhListMatch = & - ESMF_GridMatch(rhListE%dstGrid, dstGrid, globalflag=.true., rc=localrc) & - >= ESMF_GRIDMATCH_EXACT - if (ESMF_LogFoundError(rcToCheck=localrc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=trim(name)//":"//FILENAME, rcToReturn=rc)) return ! bail out -#if 0 -write (msgString,*) trim(name)//": dstGrid Match for i=", i, " is: ", & - rhListMatch -call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_DEBUG) -#endif - if (.not.rhListMatch) goto 123 - ! test src arrayspec match - rhListMatch = (rhListE%srcArraySpec==srcArraySpec) - if (.not.rhListMatch) goto 123 - ! test dst arrayspec match - rhListMatch = (rhListE%dstArraySpec==dstArraySpec) - if (.not.rhListMatch) goto 123 - ! test src staggerLoc match - rhListMatch = (rhListE%srcStaggerLoc==srcStaggerLoc) - if (.not.rhListMatch) goto 123 - ! test dst staggerLoc match - rhListMatch = (rhListE%dstStaggerLoc==dstStaggerLoc) - if (.not.rhListMatch) goto 123 - ! test srcGridToFieldMap - rhListMatch = & - (size(rhListE%srcGridToFieldMap)==size(srcGridToFieldMap)) - if (.not.rhListMatch) goto 123 - do j=1, size(srcGridToFieldMap) - rhListMatch = (rhListE%srcGridToFieldMap(j)==srcGridToFieldMap(j)) - if (.not.rhListMatch) goto 123 - enddo - ! test dstGridToFieldMap - rhListMatch = & - (size(rhListE%dstGridToFieldMap)==size(dstGridToFieldMap)) - if (.not.rhListMatch) goto 123 - do j=1, size(dstGridToFieldMap) - rhListMatch = (rhListE%dstGridToFieldMap(j)==dstGridToFieldMap(j)) - if (.not.rhListMatch) goto 123 - enddo - ! test srcUngriddedLBound - rhListMatch = & - (size(rhListE%srcUngriddedLBound)==size(srcUngriddedLBound)) - if (.not.rhListMatch) goto 123 - do j=1, size(srcUngriddedLBound) - rhListMatch = (rhListE%srcUngriddedLBound(j)==srcUngriddedLBound(j)) - if (.not.rhListMatch) goto 123 - enddo - ! test srcUngriddedUBound - rhListMatch = & - (size(rhListE%srcUngriddedUBound)==size(srcUngriddedUBound)) - if (.not.rhListMatch) goto 123 - do j=1, size(srcUngriddedUBound) - rhListMatch = (rhListE%srcUngriddedUBound(j)==srcUngriddedUBound(j)) - if (.not.rhListMatch) goto 123 - enddo - ! test dstUngriddedLBound - rhListMatch = & - (size(rhListE%dstUngriddedLBound)==size(dstUngriddedLBound)) - if (.not.rhListMatch) goto 123 - do j=1, size(dstUngriddedLBound) - rhListMatch = (rhListE%dstUngriddedLBound(j)==dstUngriddedLBound(j)) - if (.not.rhListMatch) goto 123 - enddo - ! test dstUngriddedUBound - rhListMatch = & - (size(rhListE%dstUngriddedUBound)==size(dstUngriddedUBound)) - if (.not.rhListMatch) goto 123 - do j=1, size(dstUngriddedUBound) - rhListMatch = (rhListE%dstUngriddedUBound(j)==dstUngriddedUBound(j)) - if (.not.rhListMatch) goto 123 - enddo - ! test redistflag - rhListMatch = (rhListE%redistflag .eqv. redistflag) - if (.not.rhListMatch) goto 123 - ! test regridmethod - rhListMatch = (rhListE%regridmethod==regridmethod) - if (.not.rhListMatch) goto 123 - ! test extrapMethod - rhListMatch = (rhListE%extrapMethod==extrapMethod) - if (.not.rhListMatch) goto 123 - ! test extrapNumSrcPnts - rhListMatch = (rhListE%extrapNumSrcPnts==extrapNumSrcPnts) - if (.not.rhListMatch) goto 123 - ! test extrapDistExponent - rhListMatch = (rhListE%extrapDistExponent==extrapDistExponent) - if (.not.rhListMatch) goto 123 - ! test extrapNumLevels - rhListMatch = (rhListE%extrapNumLevels==extrapNumLevels) - if (.not.rhListMatch) goto 123 - ! test ignoreDegenerate - rhListMatch = (rhListE%ignoreDegenerate.eqv.ignoreDegenerate) - if (.not.rhListMatch) goto 123 - ! test srcMaskValues - rhListMatch = & - (size(rhListE%srcMaskValues)==size(srcMaskValues)) - if (.not.rhListMatch) goto 123 - do j=1, size(srcMaskValues) - rhListMatch = (rhListE%srcMaskValues(j)==srcMaskValues(j)) - if (.not.rhListMatch) goto 123 - enddo - ! test dstMaskValues - rhListMatch = & - (size(rhListE%dstMaskValues)==size(dstMaskValues)) - if (.not.rhListMatch) goto 123 - do j=1, size(dstMaskValues) - rhListMatch = (rhListE%dstMaskValues(j)==dstMaskValues(j)) - if (.not.rhListMatch) goto 123 - enddo - ! test polemethod - rhListMatch = (rhListE%polemethod==polemethod) - if (.not.rhListMatch) goto 123 - ! test regridPoleNPnts - rhListMatch = (rhListE%regridPoleNPnts==regridPoleNPnts) - if (.not.rhListMatch) goto 123 - ! test unmappedaction - rhListMatch = (rhListE%unmappedaction==unmappedaction) - if (.not.rhListMatch) goto 123 - ! completed search - exit ! break out -123 continue - rhListE=>rhListE%prev ! previous element - enddo - - endif - - if (.not.rhListMatch) then -#if 0 -call ESMF_LogWrite(trim(name)//& - ": no rhListMatch -> pre-compute new remapping: "// & - trim(cplList(i)), ESMF_LOGMSG_DEBUG) -#endif - if (gridPair) then - ! add a new rhList element - allocate(rhListE) - rhListE%prev=>rhList ! link new element to previous list head - rhList=>rhListE ! list head now pointing to new element - endif - ! precompute remapping - if (redistflag) then - ! redist handled via ESMF_FieldBundleRedistStore() outside pair loop - ! finding it here indicates that something went wrong - call ESMF_LogSetError(ESMF_RC_ARG_BAD, & - msg="Bad internal error - should never get here!",& - line=__LINE__, file=trim(name)//":"//FILENAME, & - rcToReturn=rc) - return ! bail out - else - ! regrid store call - !TODO: leverage ESMF_FieldBundleRegridStore(), like for the Redist - !TODO: case, once ESMF_FieldBundleRegridStore() supports passing - !TODO: field pair specific arguments e.g. for polemethod, - !TODO: srcTermProcessing, etc. Until then must do each field - !TODO: individually here. Notice that most of the RH reuse - !TODO: optimization is already available on the ESMF side, too. - call ESMF_FieldRegridStore(srcField=srcFields(i), & - dstField=dstFields(i), & - srcMaskValues=srcMaskValues, dstMaskValues=dstMaskValues, & - regridmethod=regridmethod, & - polemethod=polemethod, regridPoleNPnts=regridPoleNPnts, & - extrapMethod=extrapMethod, extrapNumSrcPnts=extrapNumSrcPnts, & - extrapDistExponent=extrapDistExponent, & - extrapNumLevels=extrapNumLevels, & - unmappedaction=unmappedaction, ignoreDegenerate=ignoreDegenerate, & - srcTermProcessing=srcTermProcessing, pipelineDepth=pipelineDepth, & - routehandle=rhh, & - factorIndexList=factorIndexList, factorList=factorList, & - rc=localrc) - if (ESMF_LogFoundError(rcToCheck=localrc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=trim(name)//":"//FILENAME, rcToReturn=rc)) return ! bail out - endif - if (gridPair) then - ! store info in the new rhList element - rhListE%srcGrid=srcGrid - rhListE%dstGrid=dstGrid - rhListE%srcArraySpec=srcArraySpec - rhListE%dstArraySpec=dstArraySpec - rhListE%srcStaggerLoc=srcStaggerLoc - rhListE%dstStaggerLoc=dstStaggerLoc - rhListE%srcGridToFieldMap=>srcGridToFieldMap - rhListE%dstGridToFieldMap=>dstGridToFieldMap - rhListE%srcUngriddedLBound=>srcUngriddedLBound - rhListE%srcUngriddedUBound=>srcUngriddedUBound - rhListE%dstUngriddedLBound=>dstUngriddedLBound - rhListE%dstUngriddedUBound=>dstUngriddedUBound - rhListE%redistflag=redistflag - rhListE%regridmethod=regridmethod - rhListE%extrapMethod=extrapMethod - rhListE%extrapNumSrcPnts=extrapNumSrcPnts - rhListE%extrapDistExponent=extrapDistExponent - rhListE%extrapNumLevels=extrapNumLevels - rhListE%ignoreDegenerate=ignoreDegenerate - rhListE%rh=rhh - rhListE%factorIndexList=>factorIndexList - rhListE%factorList=>factorList - rhListE%srcMaskValues=>srcMaskValues - rhListE%dstMaskValues=>dstMaskValues - rhListE%polemethod=polemethod - rhListE%regridPoleNPnts=regridPoleNPnts - rhListE%unmappedaction=unmappedaction - endif - else -#if 0 -call ESMF_LogWrite(trim(name)//& - ": found rhListMatch -> reuse routehandle: "// & - trim(cplList(i)), ESMF_LOGMSG_DEBUG) -#endif - ! pull out the routehandle from the matching rhList element - rhh = rhListE%rh - factorIndexList => rhListE%factorIndexList - factorList => rhListE%factorList - ! deallocate temporary grid/field info - deallocate(srcGridToFieldMap, dstGridToFieldMap) - deallocate(srcUngriddedLBound, srcUngriddedUBound) - deallocate(dstUngriddedLBound, dstUngriddedUBound) - deallocate(srcMaskValues, dstMaskValues) - endif - - ! append rhh to rh and clear rhh - call ESMF_RouteHandleAppend(rh, appendRoutehandle=rhh, & - rraShift=rraShift, vectorLengthShift=vectorLengthShift, & - transferflag=.not.rhListMatch, rc=localrc) - if (ESMF_LogFoundError(rcToCheck=localrc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=trim(name)//":"//FILENAME, rcToReturn=rc)) return ! bail out - - ! adjust rraShift and vectorLengthShift - call ESMF_FieldGet(srcFields(i), localDeCount=localDeCount, rc=localrc) - if (ESMF_LogFoundError(rcToCheck=localrc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=trim(name)//":"//FILENAME, rcToReturn=rc)) return ! bail out - rraShift = rraShift + localDeCount - call ESMF_FieldGet(dstFields(i), localDeCount=localDeCount, rc=localrc) - if (ESMF_LogFoundError(rcToCheck=localrc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=trim(name)//":"//FILENAME, rcToReturn=rc)) return ! bail out - rraShift = rraShift + localDeCount - vectorLengthShift = vectorLengthShift + 1 - - ! weight dumping - if (dumpWeightsFlag .and. .not.redistflag) then - call NUOPC_Write(factorList=factorList, & - factorIndexList=factorIndexList, & - fileName="weightmatrix_"//trim(name)//"_"//trim(chopStringList(1))//".nc",& - rc=localrc) - if (ESMF_LogFoundError(rcToCheck=localrc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=trim(name)//":"//FILENAME, rcToReturn=rc)) return ! bail out - endif - - ! local garbage collection - if (.not.gridPair) then - ! grid pairs transfer ownership of lists into rhList struct - if (associated(factorIndexList)) deallocate(factorIndexList) - if (associated(factorList)) deallocate(factorList) - endif -#endif - if (associated(chopStringList)) deallocate(chopStringList) enddo ! loop over all field pairs @@ -8106,15 +7743,10 @@ subroutine FieldBundleCplStore(srcFB, dstFB, cplList, rh, zeroRegions, & call ESMF_RouteHandleDestroy(rhListE%rh, noGarbage=.true., rc=localrc) if (ESMF_LogFoundError(rcToCheck=localrc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, file=trim(name)//":"//FILENAME, rcToReturn=rc)) return ! bail out -#ifdef USE_ESMF_RHL if (rhListE%factorAllocFlag) then deallocate(rhListE%factorIndexList) deallocate(rhListE%factorList) endif -#else - if (associated(rhListE%factorIndexList)) deallocate(rhListE%factorIndexList) - if (associated(rhListE%factorList)) deallocate(rhListE%factorList) -#endif deallocate(rhListE%srcGridToFieldMap, rhListE%dstGridToFieldMap) deallocate(rhListE%srcUngriddedLBound, rhListE%srcUngriddedUBound) deallocate(rhListE%dstUngriddedLBound, rhListE%dstUngriddedUBound)