subroutine ESMF_ArraySMM(srcArray, dstArray, routehandle, keywordEnforcer, &
routesyncflag, finishedflag, cancelledflag, zeroregion, termorderflag, &
checkflag, dynamicMask, rc)
!
! !ARGUMENTS:
type(ESMF_Array), intent(in), optional :: srcArray
type(ESMF_Array), intent(inout), optional :: dstArray
type(ESMF_RouteHandle), intent(inout) :: routehandle
type(ESMF_KeywordEnforcer), optional:: keywordEnforcer ! must use keywords below
type(ESMF_RouteSync_Flag), intent(in), optional :: routesyncflag
logical, intent(out), optional :: finishedflag
logical, intent(out), optional :: cancelledflag
type(ESMF_Region_Flag), intent(in), optional :: zeroregion
type(ESMF_TermOrder_Flag), intent(in), optional :: termorderflag
logical, intent(in), optional :: checkflag
type(ESMF_DynamicMask), target, intent(in), optional :: dynamicMask
integer, intent(out), optional :: rc
!
! !STATUS:
! \begin{itemize}
! \item\apiStatusCompatibleVersion{5.2.0r}
! \item\apiStatusModifiedSinceVersion{5.2.0r}
! \begin{description}
! \item[6.1.0] Added argument {\tt termorderflag}.
! The new argument gives the user control over the order in which
! the src terms are summed up.
! \item[7.1.0r] Added argument {\tt dynamicMask}.
! The new argument supports the dynamic masking feature.
! \end{description}
! \end{itemize}
!
! !DESCRIPTION:
! \begin{sloppypar}
! Execute a precomputed Array sparse matrix multiplication from {\tt srcArray}
! to {\tt dstArray}.
! Both {\tt srcArray} and {\tt dstArray} must match the respective Arrays
! used during {\tt ESMF\_ArraySMMStore()} in {\em type}, {\em kind}, and
! memory layout of the {\em distributed} dimensions. However, the size,
! number, and index order of {\em undistributed} dimensions may be different. See section
! \ref{RH:Reusability} for a more detailed discussion of RouteHandle
! reusability.
! \end{sloppypar}
!
! The {\tt srcArray} and {\tt dstArray} arguments are optional in support of
! the situation where {\tt srcArray} and/or {\tt dstArray} are not defined on
! all PETs. The {\tt srcArray} and {\tt dstArray} must be specified on those
! PETs that hold source or destination DEs, respectively, but may be omitted
! on all other PETs. PETs that hold neither source nor destination DEs may
! omit both arguments.
!
! It is erroneous to specify the identical Array object for {\tt srcArray} and
! {\tt dstArray} arguments.
!
! See {\tt ESMF\_ArraySMMStore()} on how to precompute
! {\tt routehandle}. See section \ref{Array:SparseMatMul} for details on the
! operation {\tt ESMF\_ArraySMM()} performs.
!
! This call is {\em collective} across the current VM.
!
! \begin{description}
! \item [{[srcArray]}]
! {\tt ESMF\_Array} with source data.
! \item [{[dstArray]}]
! {\tt ESMF\_Array} with destination data.
! \item [routehandle]
! Handle to the precomputed Route.
! \item [{[routesyncflag]}]
! Indicate communication option. Default is {\tt ESMF\_ROUTESYNC\_BLOCKING},
! resulting in a blocking operation.
! See section \ref{const:routesync} for a complete list of valid settings.
! \item [{[finishedflag]}]
! \begin{sloppypar}
! Used in combination with {\tt routesyncflag = ESMF\_ROUTESYNC\_NBTESTFINISH}.
! Returned {\tt finishedflag} equal to {\tt .true.} indicates that all
! operations have finished. A value of {\tt .false.} indicates that there
! are still unfinished operations that require additional calls with
! {\tt routesyncflag = ESMF\_ROUTESYNC\_NBTESTFINISH}, or a final call with
! {\tt routesyncflag = ESMF\_ROUTESYNC\_NBWAITFINISH}. For all other {\tt routesyncflag}
! settings the returned value in {\tt finishedflag} is always {\tt .true.}.
! \end{sloppypar}
! \item [{[cancelledflag]}]
! A value of {\tt .true.} indicates that were cancelled communication
! operations. In this case the data in the {\tt dstArray} must be considered
! invalid. It may have been partially modified by the call. A value of
! {\tt .false.} indicates that none of the communication operations was
! cancelled. The data in {\tt dstArray} is valid if {\tt finishedflag}
! returns equal {\tt .true.}.
! \item [{[zeroregion]}]
! \begin{sloppypar}
! If set to {\tt ESMF\_REGION\_TOTAL} {\em (default)} the total regions of
! all DEs in {\tt dstArray} will be initialized to zero before updating the
! elements with the results of the sparse matrix multiplication. If set to
! {\tt ESMF\_REGION\_EMPTY} the elements in {\tt dstArray} will not be
! modified prior to the sparse matrix multiplication and results will be
! added to the incoming element values. Setting {\tt zeroregion} to
! {\tt ESMF\_REGION\_SELECT} will only zero out those elements in the
! destination Array that will be updated by the sparse matrix
! multiplication. See section \ref{const:region} for a complete list of
! valid settings.
! \end{sloppypar}
! \item [{[termorderflag]}]
! Specifies the order of the source side terms in all of the destination
! sums. The {\tt termorderflag} only affects the order of terms during
! the execution of the RouteHandle. See the \ref{RH:bfb} section for an
! in-depth discussion of {\em all} bit-for-bit reproducibility
! aspects related to route-based communication methods.
! See \ref{const:termorderflag} for a full list of options.
! The default setting depends on whether the {\tt dynamicMask} argument
! is present or not. With {\tt dynamicMask} argument present, the default
! of {\tt termorderflag} is {\tt ESMF\_TERMORDER\_SRCSEQ}. This ensures
! that {\tt all} source terms are present on the destination side, and
! the interpolation can be calculated as a single sum. When
! {\tt dynamicMask} is absent, the default of {\tt termorderflag} is
! {\tt ESMF\_TERMORDER\_FREE}, allowing maximum flexibility and partial
! sums for optimum performance.
! \item [{[checkflag]}]
! If set to {\tt .TRUE.} the input Array pair will be checked for
! consistency with the precomputed operation provided by {\tt routehandle}.
! If set to {\tt .FALSE.} {\em (default)} only a very basic input check
! will be performed, leaving many inconsistencies undetected. Set
! {\tt checkflag} to {\tt .FALSE.} to achieve highest performance.
! \item [{[dynamicMask]}]
! Object holding dynamic masking information.
! See section \ref{RH:DynMask} for a discussion of dynamic masking.
! \item [{[rc]}]
! Return code; equals {\tt ESMF\_SUCCESS} if there are no errors.
! \end{description}
!
!EOP
!------------------------------------------------------------------------------
integer :: localrc ! local return code
type(ESMF_Array) :: opt_srcArray ! helper variable
type(ESMF_Array) :: opt_dstArray ! helper variable
type(ESMF_RouteSync_Flag) :: opt_routesyncflag ! helper variable
type(ESMF_Logical) :: opt_finishedflag ! helper variable
type(ESMF_Logical) :: opt_cancelledflag ! helper variable
type(ESMF_Region_Flag) :: opt_zeroregion ! helper variable
type(ESMF_TermOrder_Flag) :: opt_termorderflag ! helper variable
type(ESMF_Logical) :: opt_checkflag ! helper variable
type(ESMF_DynamicMaskStateWrpR8R8R8) :: dynMaskStateR8R8R8
#ifndef ESMF_NO_DYNMASKOVERLOAD
type(ESMF_DynamicMaskStateWrpR8R8R8V):: dynMaskStateR8R8R8V
type(ESMF_DynamicMaskStateWrpR4R8R4) :: dynMaskStateR4R8R4
type(ESMF_DynamicMaskStateWrpR4R8R4V):: dynMaskStateR4R8R4V
type(ESMF_DynamicMaskStateWrpR4R4R4) :: dynMaskStateR4R4R4
type(ESMF_DynamicMaskStateWrpR4R4R4V):: dynMaskStateR4R4R4V
#endif
type(ESMF_Logical) :: handleAllElements
type(ESMF_Pointer) :: this
! initialize return code; assume routine not implemented
localrc = ESMF_RC_NOT_IMPL
if (present(rc)) rc = ESMF_RC_NOT_IMPL
! Check init status of arguments, deal with optional Array args
ESMF_INIT_CHECK_DEEP(ESMF_RouteHandleGetInit, routehandle, rc)
if (present(srcArray)) then
call ESMF_ArrayGetThis(srcArray, this, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
if (this /= ESMF_NULL_POINTER) then
ESMF_INIT_CHECK_DEEP(ESMF_ArrayGetInit, srcArray, rc)
endif
opt_srcArray = srcArray
else
call ESMF_ArraySetThisNull(opt_srcArray, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
endif
if (present(dstArray)) then
call ESMF_ArrayGetThis(dstArray, this, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
if (this /= ESMF_NULL_POINTER) then
ESMF_INIT_CHECK_DEEP(ESMF_ArrayGetInit, dstArray, rc)
endif
opt_dstArray = dstArray
else
call ESMF_ArraySetThisNull(opt_dstArray, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
endif
! prepare for passing of dynamic masking
if (present(dynamicMask)) then
! check for valid input
ESMF_INIT_CHECK_SHALLOW_SHORT(ESMF_DynamicMaskGetInit, dynamicMask, rc)
if (dynamicMask%typeKey=="R8R8R8") then
! insert dynMaskState into RouteHandle for Fortran layer
dynMaskStateR8R8R8%wrap => dynamicMask%dmsR8R8R8
call c_ESMC_RouteHandleSetASR8R8R8(routehandle, dynMaskStateR8R8R8, &
localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! set required dynamic masking info for C++ layer
if (dynamicMask%dmsR8R8R8%dynamicSrcMaskIsPresent) then
call c_ESMC_RouteHandleSetDynSrcMask(routehandle, &
dynamicMask%dmsR8R8R8%dynamicSrcMaskValue, localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
endif
if (dynamicMask%dmsR8R8R8%dynamicDstMaskIsPresent) then
call c_ESMC_RouteHandleSetDynDstMask(routehandle, &
dynamicMask%dmsR8R8R8%dynamicDstMaskValue, localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
endif
handleAllElements = dynamicMask%dmsR8R8R8%handleAllElements
call c_ESMC_RouteHandleSetHandleAll(routehandle, &
handleAllElements, localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
#ifndef ESMF_NO_DYNMASKOVERLOAD
else if (dynamicMask%typeKey=="R8R8R8V") then
! insert dynMaskState into RouteHandle for Fortran layer
dynMaskStateR8R8R8V%wrap => dynamicMask%dmsR8R8R8V
call c_ESMC_RouteHandleSetASR8R8R8V(routehandle, dynMaskStateR8R8R8V, &
localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! set required dynamic masking info for C++ layer
if (dynamicMask%dmsR8R8R8V%dynamicSrcMaskIsPresent) then
call c_ESMC_RouteHandleSetDynSrcMask(routehandle, &
dynamicMask%dmsR8R8R8V%dynamicSrcMaskValue, localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
endif
if (dynamicMask%dmsR8R8R8V%dynamicDstMaskIsPresent) then
call c_ESMC_RouteHandleSetDynDstMask(routehandle, &
dynamicMask%dmsR8R8R8V%dynamicDstMaskValue, localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
endif
handleAllElements = dynamicMask%dmsR8R8R8V%handleAllElements
call c_ESMC_RouteHandleSetHandleAll(routehandle, &
handleAllElements, localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
else if (dynamicMask%typeKey=="R4R8R4") then
! insert dynMaskState into RouteHandle for Fortran layer
dynMaskStateR4R8R4%wrap => dynamicMask%dmsR4R8R4
call c_ESMC_RouteHandleSetASR4R8R4(routehandle, dynMaskStateR4R8R4, &
localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! set required dynamic masking info for C++ layer
if (dynamicMask%dmsR4R8R4%dynamicSrcMaskIsPresent) then
call c_ESMC_RouteHandleSetDynSrcMask(routehandle, &
dynamicMask%dmsR4R8R4%dynamicSrcMaskValue, localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
endif
if (dynamicMask%dmsR4R8R4%dynamicDstMaskIsPresent) then
call c_ESMC_RouteHandleSetDynDstMask(routehandle, &
dynamicMask%dmsR4R8R4%dynamicDstMaskValue, localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
endif
handleAllElements = dynamicMask%dmsR4R8R4%handleAllElements
call c_ESMC_RouteHandleSetHandleAll(routehandle, &
handleAllElements, localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
else if (dynamicMask%typeKey=="R4R8R4V") then
! insert dynMaskState into RouteHandle for Fortran layer
dynMaskStateR4R8R4V%wrap => dynamicMask%dmsR4R8R4V
call c_ESMC_RouteHandleSetASR4R8R4V(routehandle, dynMaskStateR4R8R4V, &
localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! set required dynamic masking info for C++ layer
if (dynamicMask%dmsR4R8R4V%dynamicSrcMaskIsPresent) then
call c_ESMC_RouteHandleSetDynSrcMask(routehandle, &
dynamicMask%dmsR4R8R4V%dynamicSrcMaskValue, localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
endif
if (dynamicMask%dmsR4R8R4V%dynamicDstMaskIsPresent) then
call c_ESMC_RouteHandleSetDynDstMask(routehandle, &
dynamicMask%dmsR4R8R4V%dynamicDstMaskValue, localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
endif
handleAllElements = dynamicMask%dmsR4R8R4V%handleAllElements
call c_ESMC_RouteHandleSetHandleAll(routehandle, &
handleAllElements, localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
else if (dynamicMask%typeKey=="R4R4R4") then
! insert dynMaskState into RouteHandle for Fortran layer
dynMaskStateR4R4R4%wrap => dynamicMask%dmsR4R4R4
call c_ESMC_RouteHandleSetASR4R4R4(routehandle, dynMaskStateR4R4R4, &
localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! set required dynamic masking info for C++ layer
if (dynamicMask%dmsR4R4R4%dynamicSrcMaskIsPresent) then
call c_ESMC_RouteHandleSetDynSrcMask(routehandle, &
dynamicMask%dmsR4R4R4%dynamicSrcMaskValue, localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
endif
if (dynamicMask%dmsR4R4R4%dynamicDstMaskIsPresent) then
call c_ESMC_RouteHandleSetDynDstMask(routehandle, &
dynamicMask%dmsR4R4R4%dynamicDstMaskValue, localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
endif
handleAllElements = dynamicMask%dmsR4R4R4%handleAllElements
call c_ESMC_RouteHandleSetHandleAll(routehandle, &
handleAllElements, localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
else if (dynamicMask%typeKey=="R4R4R4V") then
! insert dynMaskState into RouteHandle for Fortran layer
dynMaskStateR4R4R4V%wrap => dynamicMask%dmsR4R4R4V
call c_ESMC_RouteHandleSetASR4R4R4V(routehandle, dynMaskStateR4R4R4V, &
localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! set required dynamic masking info for C++ layer
if (dynamicMask%dmsR4R4R4V%dynamicSrcMaskIsPresent) then
call c_ESMC_RouteHandleSetDynSrcMask(routehandle, &
dynamicMask%dmsR4R4R4V%dynamicSrcMaskValue, localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
endif
if (dynamicMask%dmsR4R4R4V%dynamicDstMaskIsPresent) then
call c_ESMC_RouteHandleSetDynDstMask(routehandle, &
dynamicMask%dmsR4R4R4V%dynamicDstMaskValue, localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
endif
handleAllElements = dynamicMask%dmsR4R4R4V%handleAllElements
call c_ESMC_RouteHandleSetHandleAll(routehandle, &
handleAllElements, localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
#endif
else
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_INCOMP, &
msg="Invalid 'typeKey' found in dynamicMask object.", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
endif
! Set default flags
opt_routesyncflag = ESMF_ROUTESYNC_BLOCKING
if (present(routesyncflag)) opt_routesyncflag = routesyncflag
opt_zeroregion = ESMF_REGION_TOTAL
if (present(zeroregion)) opt_zeroregion = zeroregion
opt_termorderflag = ESMF_TERMORDER_FREE
if (present(dynamicMask)) opt_termorderflag = ESMF_TERMORDER_SRCSEQ
if (present(termorderflag)) opt_termorderflag = termorderflag
opt_checkflag = ESMF_FALSE
if (present(checkflag)) opt_checkflag = checkflag
! ensure consistent termorder for dynamic masking
if (present(dynamicMask) .and. &
.not.(opt_termorderflag == ESMF_TERMORDER_SRCSEQ)) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_INCOMP, &
msg="Must use 'ESMF_TERMORDER_SRCSEQ' for dynamic masking", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
! Call into the C++ interface, which will sort out optional arguments
call c_ESMC_ArraySMM(opt_srcArray, opt_dstArray, routehandle, &
opt_routesyncflag, opt_finishedflag, opt_cancelledflag, opt_zeroregion, &
opt_termorderflag, opt_checkflag, localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! translate back finishedflag
if (present(finishedflag)) then
finishedflag = opt_finishedflag
endif
! translate back cancelledflag
if (present(cancelledflag)) then
cancelledflag = opt_cancelledflag
endif
! return successfully
if (present(rc)) rc = ESMF_SUCCESS
end subroutine ESMF_ArraySMM