ESMF_SparseMatca Subroutine

private subroutine ESMF_SparseMatca(sparseMats, sparseMatd, ngrid, tag, rc)

Arguments

Type IntentOptional Attributes Name
type(ESMF_XGridSpec), intent(in) :: sparseMats(:)
type(ESMF_XGridSpec), pointer :: sparseMatd(:)
integer, intent(in) :: ngrid
character(len=*), intent(in) :: tag
integer, intent(out), optional :: rc

Calls

proc~~esmf_sparsematca~~CallsGraph proc~esmf_sparsematca ESMF_SparseMatca proc~esmf_logfoundallocerror ESMF_LogFoundAllocError proc~esmf_sparsematca->proc~esmf_logfoundallocerror proc~esmf_logseterror ESMF_LogSetError proc~esmf_sparsematca->proc~esmf_logseterror esmf_breakpoint esmf_breakpoint proc~esmf_logfoundallocerror->esmf_breakpoint proc~esmf_logrc2msg ESMF_LogRc2Msg proc~esmf_logfoundallocerror->proc~esmf_logrc2msg proc~esmf_logwrite ESMF_LogWrite proc~esmf_logfoundallocerror->proc~esmf_logwrite proc~esmf_logseterror->esmf_breakpoint proc~esmf_logseterror->proc~esmf_logrc2msg proc~esmf_logseterror->proc~esmf_logwrite c_esmc_loggeterrormsg c_esmc_loggeterrormsg proc~esmf_logrc2msg->c_esmc_loggeterrormsg c_esmc_vmwtime c_esmc_vmwtime proc~esmf_logwrite->c_esmc_vmwtime proc~esmf_logclose ESMF_LogClose proc~esmf_logwrite->proc~esmf_logclose proc~esmf_logflush ESMF_LogFlush proc~esmf_logwrite->proc~esmf_logflush proc~esmf_logopenfile ESMF_LogOpenFile proc~esmf_logwrite->proc~esmf_logopenfile proc~esmf_utiliounitflush ESMF_UtilIOUnitFlush proc~esmf_logwrite->proc~esmf_utiliounitflush proc~esmf_utilstring2array ESMF_UtilString2Array proc~esmf_logwrite->proc~esmf_utilstring2array proc~esmf_logclose->proc~esmf_logflush proc~esmf_logflush->proc~esmf_utiliounitflush proc~esmf_utilarray2string ESMF_UtilArray2String proc~esmf_logflush->proc~esmf_utilarray2string proc~esmf_logopenfile->proc~esmf_utiliounitflush proc~esmf_utiliounitget ESMF_UtilIOUnitGet proc~esmf_logopenfile->proc~esmf_utiliounitget

Called by

proc~~esmf_sparsematca~~CalledByGraph proc~esmf_sparsematca ESMF_SparseMatca proc~esmf_xgridconstruct ESMF_XGridConstruct proc~esmf_xgridconstruct->proc~esmf_sparsematca proc~esmf_xgridcreate ESMF_XGridCreate proc~esmf_xgridcreate->proc~esmf_xgridconstruct proc~esmf_xgridcreatefromsparsemat ESMF_XGridCreateFromSparseMat proc~esmf_xgridcreatefromsparsemat->proc~esmf_xgridconstruct

Source Code

subroutine ESMF_SparseMatca(sparseMats, sparseMatd, ngrid, tag, rc)

!
! !ARGUMENTS:
    type(ESMF_XGridSpec), intent(in)    :: sparseMats(:)
    type(ESMF_XGridSpec),     pointer   :: sparseMatd(:)
    integer, intent(in)                 :: ngrid
    character(len=*), intent(in)        :: tag
    integer, intent(out), optional      :: rc

!
! !DESCRIPTION:
!      Allocate internal SMM parameters and copy from src.
!
!     The arguments are:
!     \begin{description}
!     \item [sparseMats]
!           the source {\tt ESMF\_XGridSpec} object.
!     \item [sparseMatd]
!           the destination {\tt ESMF\_XGridSpec} object.
!     \item [ngrid]
!           number of grid, redundency check.
!     \item [tag]
!           A string to indicate which one of the 4 SMM parameters is used.
!     \item [{[rc]}]
!           Return code; equals {\tt ESMF\_SUCCESS} only if successful.
!     \end{description}
!
!EOPI
    integer                             :: i, localrc

    ! Initialize
    localrc = ESMF_RC_NOT_IMPL

    ! Initialize return code   
    if(present(rc)) rc = ESMF_RC_NOT_IMPL

    if(size(sparseMats,1) /= ngrid) then
        call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_WRONG, & 
           msg="- number of Grids different from size of sparseMat for "//tag, &
           ESMF_CONTEXT, rcToReturn=rc) 
        return
    endif

    do i = 1, ngrid
        if(.not. associated(sparseMats(i)%factorIndexList) .or. &
           .not. associated(sparseMats(i)%factorList)) then
            call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_WRONG, & 
               msg="- sparseMat not initiailzed properly for "//tag, &
               ESMF_CONTEXT, rcToReturn=rc) 
            return
        endif

        if(size(sparseMats(i)%factorIndexList, 2) /= size(sparseMats(i)%factorList, 1)) then
            call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_WRONG, & 
               msg="- sparseMat factorIndexList and factorList sizes not consistent "//tag, &
               ESMF_CONTEXT, rcToReturn=rc) 
            return
        endif
    enddo
        
    allocate(sparseMatd(ngrid), stat=localrc)
    if (ESMF_LogFoundAllocError(localrc, &
        msg="Allocating xgtype%"//tag, &
        ESMF_CONTEXT, rcToReturn=rc)) return
    do i = 1, ngrid
      sparseMatd(i) = sparseMats(i)
    enddo

    if(present(rc)) rc = ESMF_SUCCESS

end subroutine ESMF_SparseMatca