ESMF_ArraySMMStoreInd4R4TP Subroutine

private subroutine ESMF_ArraySMMStoreInd4R4TP(srcArray, dstArray, routehandle, transposeRoutehandle, factorList, factorIndexList, keywordEnforcer, ignoreUnmatchedIndices, srcTermProcessing, pipelineDepth, rc)

Arguments

Type IntentOptional Attributes Name
type(ESMF_Array), intent(inout) :: srcArray
type(ESMF_Array), intent(inout) :: dstArray
type(ESMF_RouteHandle), intent(inout) :: routehandle
type(ESMF_RouteHandle), intent(inout) :: transposeRoutehandle
real(kind=ESMF_KIND_R4), intent(in), target :: factorList(:)
integer, intent(in) :: factorIndexList(:,:)
type(ESMF_KeywordEnforcer), optional :: keywordEnforcer
logical, intent(in), optional :: ignoreUnmatchedIndices
integer, intent(inout), optional :: srcTermProcessing
integer, intent(inout), optional :: pipelineDepth
integer, intent(out), optional :: rc

Calls

proc~~esmf_arraysmmstoreind4r4tp~~CallsGraph proc~esmf_arraysmmstoreind4r4tp ESMF_ArraySMMStoreInd4R4TP esmf_arraygetinit esmf_arraygetinit proc~esmf_arraysmmstoreind4r4tp->esmf_arraygetinit interface~c_esmc_arraysmmstoreind4 c_ESMC_ArraySMMStoreInd4 proc~esmf_arraysmmstoreind4r4tp->interface~c_esmc_arraysmmstoreind4 interface~esmf_interarraycreate ESMF_InterArrayCreate proc~esmf_arraysmmstoreind4r4tp->interface~esmf_interarraycreate proc~esmf_imerr ESMF_IMErr proc~esmf_arraysmmstoreind4r4tp->proc~esmf_imerr proc~esmf_interarraydestroy ESMF_InterArrayDestroy proc~esmf_arraysmmstoreind4r4tp->proc~esmf_interarraydestroy proc~esmf_logfounderror ESMF_LogFoundError proc~esmf_arraysmmstoreind4r4tp->proc~esmf_logfounderror proc~esmf_routehandlesetinitcreated ESMF_RouteHandleSetInitCreated proc~esmf_arraysmmstoreind4r4tp->proc~esmf_routehandlesetinitcreated proc~esmf_interarraycreateptr ESMF_InterArrayCreatePtr interface~esmf_interarraycreate->proc~esmf_interarraycreateptr proc~esmf_interarraycreatetrg ESMF_InterArrayCreateTrg interface~esmf_interarraycreate->proc~esmf_interarraycreatetrg proc~esmf_imerr->proc~esmf_logfounderror proc~esmf_initcheckdeep ESMF_InitCheckDeep proc~esmf_imerr->proc~esmf_initcheckdeep proc~esmf_logfounddeallocerror ESMF_LogFoundDeallocError proc~esmf_interarraydestroy->proc~esmf_logfounddeallocerror esmf_breakpoint esmf_breakpoint proc~esmf_logfounderror->esmf_breakpoint proc~esmf_logrc2msg ESMF_LogRc2Msg proc~esmf_logfounderror->proc~esmf_logrc2msg proc~esmf_logwrite ESMF_LogWrite proc~esmf_logfounderror->proc~esmf_logwrite

Called by

proc~~esmf_arraysmmstoreind4r4tp~~CalledByGraph proc~esmf_arraysmmstoreind4r4tp ESMF_ArraySMMStoreInd4R4TP interface~esmf_arraysmmstore ESMF_ArraySMMStore interface~esmf_arraysmmstore->proc~esmf_arraysmmstoreind4r4tp proc~esmf_arraysmmstorefromfile ESMF_ArraySMMStoreFromFile interface~esmf_arraysmmstore->proc~esmf_arraysmmstorefromfile proc~esmf_arraysmmstorefromfiletp ESMF_ArraySMMStoreFromFileTP interface~esmf_arraysmmstore->proc~esmf_arraysmmstorefromfiletp proc~esmf_arraysmmstorefromfile->interface~esmf_arraysmmstore proc~esmf_arraysmmstorefromfiletp->interface~esmf_arraysmmstore proc~esmf_fieldsmmstorei4 ESMF_FieldSMMStoreI4 proc~esmf_fieldsmmstorei4->interface~esmf_arraysmmstore proc~esmf_fieldsmmstorei4tr ESMF_FieldSMMStoreI4TR proc~esmf_fieldsmmstorei4tr->interface~esmf_arraysmmstore proc~esmf_fieldsmmstorei8 ESMF_FieldSMMStoreI8 proc~esmf_fieldsmmstorei8->interface~esmf_arraysmmstore proc~esmf_fieldsmmstorei8tr ESMF_FieldSMMStoreI8TR proc~esmf_fieldsmmstorei8tr->interface~esmf_arraysmmstore proc~esmf_fieldsmmstorenf ESMF_FieldSMMStoreNF proc~esmf_fieldsmmstorenf->interface~esmf_arraysmmstore proc~esmf_fieldsmmstorenftr ESMF_FieldSMMStoreNFTR proc~esmf_fieldsmmstorenftr->interface~esmf_arraysmmstore proc~esmf_fieldsmmstorer4 ESMF_FieldSMMStoreR4 proc~esmf_fieldsmmstorer4->interface~esmf_arraysmmstore proc~esmf_fieldsmmstorer4tr ESMF_FieldSMMStoreR4TR proc~esmf_fieldsmmstorer4tr->interface~esmf_arraysmmstore proc~esmf_fieldsmmstorer8 ESMF_FieldSMMStoreR8 proc~esmf_fieldsmmstorer8->interface~esmf_arraysmmstore proc~esmf_fieldsmmstorer8tr ESMF_FieldSMMStoreR8TR proc~esmf_fieldsmmstorer8tr->interface~esmf_arraysmmstore proc~test_smm test_smm proc~test_smm->interface~esmf_arraysmmstore proc~user_init~36 user_init proc~user_init~36->interface~esmf_arraysmmstore proc~user_init~53 user_init proc~user_init~53->interface~esmf_arraysmmstore program~esmf_arrayarbidxsmmutest ESMF_ArrayArbIdxSMMUTest program~esmf_arrayarbidxsmmutest->interface~esmf_arraysmmstore program~esmf_arraysparsematmulex ESMF_ArraySparseMatMulEx program~esmf_arraysparsematmulex->interface~esmf_arraysmmstore program~esmf_rhandlebitforbitex ESMF_RHandleBitForBitEx program~esmf_rhandlebitforbitex->interface~esmf_arraysmmstore interface~esmf_fieldsmmstore ESMF_FieldSMMStore interface~esmf_fieldsmmstore->proc~esmf_fieldsmmstorei4 interface~esmf_fieldsmmstore->proc~esmf_fieldsmmstorei4tr interface~esmf_fieldsmmstore->proc~esmf_fieldsmmstorei8 interface~esmf_fieldsmmstore->proc~esmf_fieldsmmstorei8tr interface~esmf_fieldsmmstore->proc~esmf_fieldsmmstorenf interface~esmf_fieldsmmstore->proc~esmf_fieldsmmstorenftr interface~esmf_fieldsmmstore->proc~esmf_fieldsmmstorer4 interface~esmf_fieldsmmstore->proc~esmf_fieldsmmstorer4tr interface~esmf_fieldsmmstore->proc~esmf_fieldsmmstorer8 interface~esmf_fieldsmmstore->proc~esmf_fieldsmmstorer8tr proc~run~2 run proc~run~2->proc~test_smm program~esmf_arraysmmutest ESMF_ArraySMMUTest program~esmf_arraysmmutest->proc~test_smm

Source Code

  subroutine ESMF_ArraySMMStoreInd4R4TP(srcArray, dstArray, routehandle, &
    transposeRoutehandle, factorList, factorIndexList, keywordEnforcer, &
    ignoreUnmatchedIndices, srcTermProcessing, pipelineDepth, rc)
!
! !ARGUMENTS:
    type(ESMF_Array),           intent(inout)           :: srcArray
    type(ESMF_Array),           intent(inout)           :: dstArray
    type(ESMF_RouteHandle),     intent(inout)           :: routehandle
    type(ESMF_RouteHandle),     intent(inout)           :: transposeRoutehandle
    real(ESMF_KIND_R4), target, intent(in)              :: factorList(:)
    integer,                    intent(in)              :: factorIndexList(:,:)
type(ESMF_KeywordEnforcer), optional:: keywordEnforcer ! must use keywords below
    logical,                    intent(in),    optional :: ignoreUnmatchedIndices
    integer,                    intent(inout), optional :: srcTermProcessing
    integer,                    intent(inout), optional :: pipelineDepth
    integer,                    intent(out),   optional :: rc
!
!EOPI
!------------------------------------------------------------------------------
    integer                       :: localrc            ! local return code
    real(ESMF_KIND_R4), pointer   :: opt_factorList(:)  ! helper variable
    integer                       :: len_factorList     ! helper variable
    type(ESMF_InterArray)         :: factorIndexListArg ! helper variable
    integer                       :: tupleSize, i       ! helper variable
    integer, allocatable          :: transposeFIL(:,:)  ! helper variable
    type(ESMF_Logical)            :: opt_ignoreUnmatched  ! helper variable

    ! initialize return code; assume routine not implemented
    localrc = ESMF_RC_NOT_IMPL
    if (present(rc)) rc = ESMF_RC_NOT_IMPL
    
    ! Check init status of arguments
    ESMF_INIT_CHECK_DEEP(ESMF_ArrayGetInit, srcArray, rc)
    ESMF_INIT_CHECK_DEEP(ESMF_ArrayGetInit, dstArray, rc)
    
    ! Wrap factor arguments
    len_factorList = size(factorList)
    opt_factorList => factorList
    factorIndexListArg = &
      ESMF_InterArrayCreate(farray2D=factorIndexList, rc=localrc)
    if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
      ESMF_CONTEXT, rcToReturn=rc)) return

    ! Set default flags
    opt_ignoreUnmatched = ESMF_FALSE
    if (present(ignoreUnmatchedIndices)) opt_ignoreUnmatched = ignoreUnmatchedIndices

    ! Call into the C++ interface, which will sort out optional arguments
    call c_ESMC_ArraySMMStoreInd4(srcArray, dstArray, routehandle, &
      ESMF_TYPEKIND_R4, opt_factorList, len_factorList, factorIndexListArg, &
      opt_ignoreUnmatched, srcTermProcessing, pipelineDepth, localrc)
    if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
      ESMF_CONTEXT, rcToReturn=rc)) return
    
    ! Garbage collection
    call ESMF_InterArrayDestroy(factorIndexListArg, rc=localrc)
    if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
      ESMF_CONTEXT, rcToReturn=rc)) return

    ! Mark routehandle object as being created
    call ESMF_RouteHandleSetInitCreated(routehandle, rc=localrc)
    if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
      ESMF_CONTEXT, rcToReturn=rc)) return
    
    ! Compute the transposeRoutehandle
    ! Construct the transpose of the factorIndexList
    tupleSize = size(factorIndexList,1)
    allocate(transposeFIL(tupleSize, len_factorList))
    if (tupleSize==2) then
      do i=1, len_factorList
        transposeFIL(1,i)=factorIndexList(2,i)
        transposeFIL(2,i)=factorIndexList(1,i)
      enddo
    else if (tupleSize==4) then
      do i=1, len_factorList
        transposeFIL(1,i)=factorIndexList(3,i)
        transposeFIL(2,i)=factorIndexList(4,i)
        transposeFIL(3,i)=factorIndexList(1,i)
        transposeFIL(4,i)=factorIndexList(2,i)
      enddo
    endif
    ! wrap transposeFIL
    factorIndexListArg = &
      ESMF_InterArrayCreate(farray2D=transposeFIL, rc=localrc)
    if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
      ESMF_CONTEXT, rcToReturn=rc)) return
    ! Call into the C++ interface, which will sort out optional arguments
    call c_ESMC_ArraySMMStoreInd4(dstArray, srcArray, transposeRoutehandle, &
      ESMF_TYPEKIND_R4, opt_factorList, len_factorList, factorIndexListArg, &
      opt_ignoreUnmatched, srcTermProcessing, pipelineDepth, localrc)
    if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
      ESMF_CONTEXT, rcToReturn=rc)) return
    ! Garbage collection
    call ESMF_InterArrayDestroy(factorIndexListArg, rc=localrc)
    if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
      ESMF_CONTEXT, rcToReturn=rc)) return
    deallocate(transposeFIL)
    ! Mark transposeRoutehandle object as being created
    call ESMF_RouteHandleSetInitCreated(transposeRoutehandle, 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_ArraySMMStoreInd4R4TP