Exemplo n.º 1
0
Arquivo: chol2.c Projeto: GHilmarG/Ua
void mexFunction
(
    int	nargout,
    mxArray *pargout [ ],
    int	nargin,
    const mxArray *pargin [ ]
)
{
    double dummy = 0, *px ;
    cholmod_sparse Amatrix, *A, *Lsparse, *R ;
    cholmod_factor *L ;
    cholmod_common Common, *cm ;
    Long n, minor ;

    /* ---------------------------------------------------------------------- */
    /* start CHOLMOD and set parameters */ 
    /* ---------------------------------------------------------------------- */

    cm = &Common ;
    cholmod_l_start (cm) ;
    sputil_config (SPUMONI, cm) ;

    /* convert to packed LL' when done */
    cm->final_asis = FALSE ;
    cm->final_super = FALSE ;
    cm->final_ll = TRUE ;
    cm->final_pack = TRUE ;
    cm->final_monotonic = TRUE ;

    /* no need to prune entries due to relaxed supernodal amalgamation, since
     * zeros are dropped with sputil_drop_zeros instead */
    cm->final_resymbol = FALSE ;

    cm->quick_return_if_not_posdef = (nargout < 2) ;

    /* ---------------------------------------------------------------------- */
    /* get inputs */
    /* ---------------------------------------------------------------------- */

    if (nargin != 1 || nargout > 3)
    {
	mexErrMsgTxt ("usage: [R,p,q] = chol2 (A)") ;
    }

    n = mxGetN (pargin [0]) ;

    if (!mxIsSparse (pargin [0]) || n != mxGetM (pargin [0]))
    {
    	mexErrMsgTxt ("A must be square and sparse") ;
    }

    /* get input sparse matrix A.  Use triu(A) only */
    A = sputil_get_sparse (pargin [0], &Amatrix, &dummy, 1) ;

    /* use natural ordering if no q output parameter */
    if (nargout < 3)
    {
	cm->nmethods = 1 ;
	cm->method [0].ordering = CHOLMOD_NATURAL ;
	cm->postorder = FALSE ;
    }

    /* ---------------------------------------------------------------------- */
    /* analyze and factorize */
    /* ---------------------------------------------------------------------- */

    L = cholmod_l_analyze (A, cm) ;
    cholmod_l_factorize (A, L, cm) ;

    if (nargout < 2 && cm->status != CHOLMOD_OK)
    {
	mexErrMsgTxt ("matrix is not positive definite") ;
    }

    /* ---------------------------------------------------------------------- */
    /* convert L to a sparse matrix */
    /* ---------------------------------------------------------------------- */

    /* the conversion sets L->minor back to n, so get a copy of it first */
    minor = L->minor ;
    Lsparse = cholmod_l_factor_to_sparse (L, cm) ;
    if (Lsparse->xtype == CHOLMOD_COMPLEX)
    {
	/* convert Lsparse from complex to zomplex */
	cholmod_l_sparse_xtype (CHOLMOD_ZOMPLEX, Lsparse, cm) ;
    }

    if (minor < n)
    {
	/* remove columns minor to n-1 from Lsparse */
	sputil_trim (Lsparse, minor, cm) ;
    }

    /* drop zeros from Lsparse */
    sputil_drop_zeros (Lsparse) ;

    /* Lsparse is lower triangular; conjugate transpose to get R */
    R = cholmod_l_transpose (Lsparse, 2, cm) ;
    cholmod_l_free_sparse (&Lsparse, cm) ;

    /* ---------------------------------------------------------------------- */
    /* return results to MATLAB */
    /* ---------------------------------------------------------------------- */

    /* return R */
    pargout [0] = sputil_put_sparse (&R, cm) ;

    /* return minor (translate to MATLAB convention) */
    if (nargout > 1)
    {
	pargout [1] = mxCreateDoubleMatrix (1, 1, mxREAL) ;
	px = mxGetPr (pargout [1]) ;
	px [0] = ((minor == n) ? 0 : (minor+1)) ;
    }

    /* return permutation */
    if (nargout > 2)
    {
	pargout [2] = sputil_put_int (L->Perm, n, 1) ;
    }

    /* ---------------------------------------------------------------------- */
    /* free workspace and the CHOLMOD L, except for what is copied to MATLAB */
    /* ---------------------------------------------------------------------- */

    cholmod_l_free_factor (&L, cm) ;
    cholmod_l_finish (cm) ;
    cholmod_l_print_common (" ", cm) ;
    /*
    if (cm->malloc_count != (3 + mxIsComplex (pargout[0]))) mexErrMsgTxt ("!") ;
    */
}
Exemplo n.º 2
0
void mexFunction
(
    int	nargout,
    mxArray *pargout [ ],
    int	nargin,
    const mxArray *pargin [ ]
)
{
    double dummy = 0, beta [2], *px ;
    cholmod_sparse Amatrix, *A, *Lsparse ;
    cholmod_factor *L ;
    cholmod_common Common, *cm ;
    Long n, minor ;

    /* ---------------------------------------------------------------------- */
    /* start CHOLMOD and set parameters */ 
    /* ---------------------------------------------------------------------- */

    cm = &Common ;
    cholmod_l_start (cm) ;
    sputil_config (SPUMONI, cm) ;

    /* convert to packed LDL' when done */
    cm->final_asis = FALSE ;
    cm->final_super = FALSE ;
    cm->final_ll = FALSE ;
    cm->final_pack = TRUE ;
    cm->final_monotonic = TRUE ;

    /* since numerically zero entries are NOT dropped from the symbolic
     * pattern, we DO need to drop entries that result from supernodal
     * amalgamation. */
    cm->final_resymbol = TRUE ;

    cm->quick_return_if_not_posdef = (nargout < 2) ;

    /* This will disable the supernodal LL', which will be slow. */
    /* cm->supernodal = CHOLMOD_SIMPLICIAL ; */

    /* ---------------------------------------------------------------------- */
    /* get inputs */
    /* ---------------------------------------------------------------------- */

    if (nargin < 1 || nargin > 2 || nargout > 3)
    {
	mexErrMsgTxt ("usage: [L,p,q] = ldlchol (A,beta)") ;
    }

    n = mxGetM (pargin [0]) ;

    if (!mxIsSparse (pargin [0]))
    {
    	mexErrMsgTxt ("A must be sparse") ;
    }
    if (nargin == 1 && n != mxGetN (pargin [0]))
    {
    	mexErrMsgTxt ("A must be square") ;
    }

    /* get sparse matrix A, use tril(A)  */
    A = sputil_get_sparse (pargin [0], &Amatrix, &dummy, -1) ; 

    if (nargin == 1)
    {
	A->stype = -1 ;	    /* use lower part of A */
	beta [0] = 0 ;
	beta [1] = 0 ;
    }
    else
    {
	A->stype = 0 ;	    /* use all of A, factorizing A*A' */
	beta [0] = mxGetScalar (pargin [1]) ;
	beta [1] = 0 ;
    }

    /* use natural ordering if no q output parameter */
    if (nargout < 3)
    {
	cm->nmethods = 1 ;
	cm->method [0].ordering = CHOLMOD_NATURAL ;
	cm->postorder = FALSE ;
    }

    /* ---------------------------------------------------------------------- */
    /* analyze and factorize */
    /* ---------------------------------------------------------------------- */

    L = cholmod_l_analyze (A, cm) ;
    cholmod_l_factorize_p (A, beta, NULL, 0, L, cm) ;

    if (nargout < 2 && cm->status != CHOLMOD_OK)
    {
	mexErrMsgTxt ("matrix is not positive definite") ;
    }

    /* ---------------------------------------------------------------------- */
    /* convert L to a sparse matrix */
    /* ---------------------------------------------------------------------- */

    /* the conversion sets L->minor back to n, so get a copy of it first */
    minor = L->minor ;
    Lsparse = cholmod_l_factor_to_sparse (L, cm) ;
    if (Lsparse->xtype == CHOLMOD_COMPLEX)
    {
	/* convert Lsparse from complex to zomplex */
	cholmod_l_sparse_xtype (CHOLMOD_ZOMPLEX, Lsparse, cm) ;
    }

    /* ---------------------------------------------------------------------- */
    /* return results to MATLAB */
    /* ---------------------------------------------------------------------- */

    /* return L as a sparse matrix (it may contain numerically zero entries) */
    pargout [0] = sputil_put_sparse (&Lsparse, cm) ;

    /* return minor (translate to MATLAB convention) */
    if (nargout > 1)
    {
	pargout [1] = mxCreateDoubleMatrix (1, 1, mxREAL) ;
	px = mxGetPr (pargout [1]) ;
	px [0] = ((minor == n) ? 0 : (minor+1)) ;
    }

    /* return permutation */
    if (nargout > 2)
    {
	pargout [2] = sputil_put_int (L->Perm, n, 1) ;
    }

    /* ---------------------------------------------------------------------- */
    /* free workspace and the CHOLMOD L, except for what is copied to MATLAB */
    /* ---------------------------------------------------------------------- */

    cholmod_l_free_factor (&L, cm) ;
    cholmod_l_finish (cm) ;
    cholmod_l_print_common (" ", cm) ;
    /*
    if (cm->malloc_count != 3 + mxIsComplex (pargout[0])) mexErrMsgTxt ("!") ;
    */
}
Exemplo n.º 3
0
void mexFunction
(
    int nargout,
    mxArray *pargout [ ],
    int nargin,
    const mxArray *pargin [ ]
)
{
    double dummy = 0 ;
    double *Lx, *px ;
    Int *Parent, *Post, *ColCount, *First, *Level, *Rp, *Ri, *Lp, *Li, *W ;
    cholmod_sparse *A, Amatrix, *F, *Aup, *Alo, *R, *A1, *A2, *L, *S ;
    cholmod_common Common, *cm ;
    Int n, i, coletree, j, lnz, p, k, height, c ;
    char buf [LEN] ;

    /* ---------------------------------------------------------------------- */
    /* start CHOLMOD and set defaults */
    /* ---------------------------------------------------------------------- */

    cm = &Common ;
    cholmod_l_start (cm) ;
    sputil_config (SPUMONI, cm) ;

    /* ---------------------------------------------------------------------- */
    /* get inputs */
    /* ---------------------------------------------------------------------- */

    if (nargout > 5 || nargin < 1 || nargin > 3)
    {
	mexErrMsgTxt (
	    "Usage: [count h parent post R] = symbfact2 (A, mode, Lmode)") ;
    }

    /* ---------------------------------------------------------------------- */
    /* get input matrix A */
    /* ---------------------------------------------------------------------- */

    A = sputil_get_sparse_pattern (pargin [0], &Amatrix, &dummy, cm) ;
    S = (A == &Amatrix) ? NULL : A ;

    /* ---------------------------------------------------------------------- */
    /* get A->stype, default is to use triu(A) */
    /* ---------------------------------------------------------------------- */

    A->stype = 1 ;
    n = A->nrow ;
    coletree = FALSE ;
    if (nargin > 1)
    {
	buf [0] = '\0' ;
	if (mxIsChar (pargin [1]))
	{
	    mxGetString (pargin [1], buf, LEN) ;
	}
	c = buf [0] ;
	if (tolower (c) == 'r')
	{
	    /* unsymmetric case (A*A') if string starts with 'r' */
	    A->stype = 0 ;
	}
	else if (tolower (c) == 'c')
	{
	    /* unsymmetric case (A'*A) if string starts with 'c' */
	    n = A->ncol ;
	    coletree = TRUE ;
	    A->stype = 0 ;
	}
	else if (tolower (c) == 's')
	{
	    /* symmetric upper case (A) if string starts with 's' */
	    A->stype = 1 ;
	}
	else if (tolower (c) == 'l')
	{
	    /* symmetric lower case (A) if string starts with 'l' */
	    A->stype = -1 ;
	}
	else
	{
	    mexErrMsgTxt ("symbfact2: unrecognized mode") ;
	}
    }

    if (A->stype && A->nrow != A->ncol)
    {
	mexErrMsgTxt ("symbfact2: A must be square") ;
    }

    /* ---------------------------------------------------------------------- */
    /* compute the etree, its postorder, and the row/column counts */
    /* ---------------------------------------------------------------------- */

    Parent = cholmod_l_malloc (n, sizeof (Int), cm) ;
    Post = cholmod_l_malloc (n, sizeof (Int), cm) ;
    ColCount = cholmod_l_malloc (n, sizeof (Int), cm) ;
    First = cholmod_l_malloc (n, sizeof (Int), cm) ;
    Level = cholmod_l_malloc (n, sizeof (Int), cm) ;

    /* F = A' */
    F = cholmod_l_transpose (A, 0, cm) ;

    if (A->stype == 1 || coletree)
    {
	/* symmetric upper case: find etree of A, using triu(A) */
	/* column case: find column etree of A, which is etree of A'*A */
	Aup = A ;
	Alo = F ;
    }
    else
    {
	/* symmetric lower case: find etree of A, using tril(A) */
	/* row case: find row etree of A, which is etree of A*A' */
	Aup = F ;
	Alo = A ;
    }

    cholmod_l_etree (Aup, Parent, cm) ;

    if (cm->status < CHOLMOD_OK)
    {
	/* out of memory or matrix invalid */
	mexErrMsgTxt ("symbfact2 failed: matrix corrupted!") ;
    }

    if (cholmod_l_postorder (Parent, n, NULL, Post, cm) != n)
    {
	/* out of memory or Parent invalid */
	mexErrMsgTxt ("symbfact2 postorder failed!") ;
    }

    /* symmetric upper case: analyze tril(F), which is triu(A) */
    /* column case: analyze F*F', which is A'*A */
    /* symmetric lower case: analyze tril(A) */
    /* row case: analyze A*A' */
    cholmod_l_rowcolcounts (Alo, NULL, 0, Parent, Post, NULL, ColCount,
		First, Level, cm) ;

    if (cm->status < CHOLMOD_OK)
    {
	/* out of memory or matrix invalid */
	mexErrMsgTxt ("symbfact2 failed: matrix corrupted!") ;
    }

    /* ---------------------------------------------------------------------- */
    /* return results to MATLAB: count, h, parent, and post */
    /* ---------------------------------------------------------------------- */

    pargout [0] = sputil_put_int (ColCount, n, 0) ;
    if (nargout > 1)
    {
	/* compute the elimination tree height */
	height = 0 ;
	for (i = 0 ; i < n ; i++)
	{
	    height = MAX (height, Level [i]) ;
	}
	height++ ;
	pargout [1] = mxCreateDoubleMatrix (1, 1, mxREAL) ;
	px = mxGetPr (pargout [1]) ;
	px [0] = height ;
    }
    if (nargout > 2)
    {
	pargout [2] = sputil_put_int (Parent, n, 1) ;
    }
    if (nargout > 3)
    {
	pargout [3] = sputil_put_int (Post, n, 1) ;
    }

    /* ---------------------------------------------------------------------- */
    /* construct L, if requested */
    /* ---------------------------------------------------------------------- */

    if (nargout > 4)
    {

	if (A->stype == 1)
	{
	    /* symmetric upper case: use triu(A) only, A2 not needed */
	    A1 = A ;
	    A2 = NULL ;
	}
	else if (A->stype == -1)
	{
	    /* symmetric lower case: use tril(A) only, A2 not needed */
	    A1 = F ;
	    A2 = NULL ;
	}
	else if (coletree)
	{
	    /* column case: analyze F*F' */
	    A1 = F ;
	    A2 = A ;
	}
	else
	{
	    /* row case: analyze A*A' */
	    A1 = A ;
	    A2 = F ;
	}

	/* count the total number of entries in L */
	lnz = 0 ;
	for (j = 0 ; j < n ; j++)
	{
	    lnz += ColCount [j] ;
	}

	/* allocate the output matrix L (pattern-only) */
	L = cholmod_l_allocate_sparse (n, n, lnz, TRUE, TRUE, 0,
	    CHOLMOD_PATTERN, cm) ;
	Lp = L->p ;
	Li = L->i ;

	/* initialize column pointers */
	lnz = 0 ;
	for (j = 0 ; j < n ; j++)
	{
	    Lp [j] = lnz ;
	    lnz += ColCount [j] ;
	}
	Lp [j] = lnz ;

	/* create a copy of the column pointers */
	W = First ;
	for (j = 0 ; j < n ; j++)
	{
	    W [j] = Lp [j] ;
	}

	/* get workspace for computing one row of L */
	R = cholmod_l_allocate_sparse (n, 1, n, FALSE, TRUE, 0, CHOLMOD_PATTERN,
		cm) ;
	Rp = R->p ;
	Ri = R->i ;

	/* compute L one row at a time */
	for (k = 0 ; k < n ; k++)
	{
	    /* get the kth row of L and store in the columns of L */
	    cholmod_l_row_subtree (A1, A2, k, Parent, R, cm) ;
	    for (p = 0 ; p < Rp [1] ; p++)
	    {
		Li [W [Ri [p]]++] = k ;
	    }
	    /* add the diagonal entry */
	    Li [W [k]++] = k ;
	}

	/* free workspace */
	cholmod_l_free_sparse (&R, cm) ;

	/* transpose L to get R, or leave as is */
	if (nargin < 3)
	{
	    /* R = L' */
	    R = cholmod_l_transpose (L, 0, cm) ;
	    cholmod_l_free_sparse (&L, cm) ;
	    L = R ;
	}

	/* fill numerical values of L with one's (only MATLAB needs this...) */
	L->x = cholmod_l_malloc (lnz, sizeof (double), cm) ;
	Lx = L->x ;
	for (p = 0 ; p < lnz ; p++)
	{
	    Lx [p] = 1 ;
	}
	L->xtype = CHOLMOD_REAL ;

	/* return L (or R) to MATLAB */
	pargout [4] = sputil_put_sparse (&L, cm) ;
    }

    /* ---------------------------------------------------------------------- */
    /* free workspace */
    /* ---------------------------------------------------------------------- */

    cholmod_l_free (n, sizeof (Int), Parent, cm) ;
    cholmod_l_free (n, sizeof (Int), Post, cm) ;
    cholmod_l_free (n, sizeof (Int), ColCount, cm) ;
    cholmod_l_free (n, sizeof (Int), First, cm) ;
    cholmod_l_free (n, sizeof (Int), Level, cm) ;
    cholmod_l_free_sparse (&F, cm) ;
    cholmod_l_free_sparse (&S, cm) ;
    cholmod_l_finish (cm) ;
    cholmod_l_print_common (" ", cm) ;
    /*
    if (cm->malloc_count != ((nargout == 5) ? 3:0)) mexErrMsgTxt ("!") ;
    */
}
Exemplo n.º 4
0
void mexFunction
(
    int nargout,
    mxArray *pargout [ ],
    int nargin,
    const mxArray *pargin [ ]
)
{
    double dummy = 0 ;
    cholmod_factor *L ;
    cholmod_sparse *A, Amatrix, *C, *S ;
    cholmod_common Common, *cm ;
    Long n, transpose, c ;
    char buf [LEN] ;

    /* ---------------------------------------------------------------------- */
    /* start CHOLMOD and set defaults */
    /* ---------------------------------------------------------------------- */

    cm = &Common ;
    cholmod_l_start (cm) ;
    sputil_config (SPUMONI, cm) ;

    /* only do the simplicial analysis (L->Perm and L->ColCount) */
    cm->supernodal = CHOLMOD_SIMPLICIAL ;

    /* ---------------------------------------------------------------------- */
    /* get inputs */
    /* ---------------------------------------------------------------------- */

    if (nargout > 2 || nargin < 1 || nargin > 3)
    {
	mexErrMsgTxt ("Usage: [p count] = analyze (A, mode)") ;
    }
    if (nargin == 3)
    {
	cm->nmethods = mxGetScalar (pargin [2]) ;
	if (cm->nmethods == -1)
	{
	    /* use AMD only */
	    cm->nmethods = 1 ;
	    cm->method [0].ordering = CHOLMOD_AMD ;
	    cm->postorder = TRUE ;
	}
	else if (cm->nmethods == -2)
	{
	    /* use METIS only */
	    cm->nmethods = 1 ;
	    cm->method [0].ordering = CHOLMOD_METIS ;
	    cm->postorder = TRUE ;
	}
	else if (cm->nmethods == -3)
	{
	    /* use NESDIS only */
	    cm->nmethods = 1 ;
	    cm->method [0].ordering = CHOLMOD_NESDIS ;
	    cm->postorder = TRUE ;
	}
    }

    /* ---------------------------------------------------------------------- */
    /* get input matrix A */
    /* ---------------------------------------------------------------------- */

    A = sputil_get_sparse_pattern (pargin [0], &Amatrix, &dummy, cm) ;
    S = (A == &Amatrix) ? NULL : A ;

    /* ---------------------------------------------------------------------- */
    /* get A->stype, default is to use tril(A) */
    /* ---------------------------------------------------------------------- */

    A->stype = -1 ;
    transpose = FALSE ;

    if (nargin > 1)
    {
	buf [0] = '\0' ;
	if (mxIsChar (pargin [1]))
	{
	    mxGetString (pargin [1], buf, LEN) ;
	}
	c = buf [0] ;
	if (tolower (c) == 'r')
	{
	    /* unsymmetric case (A*A') if string starts with 'r' */
	    transpose = FALSE ;
	    A->stype = 0 ;
	}
	else if (tolower (c) == 'c')
	{
	    /* unsymmetric case (A'*A) if string starts with 'c' */
	    transpose = TRUE ;
	    A->stype = 0 ;
	}
	else if (tolower (c) == 's')
	{
	    /* symmetric case (A) if string starts with 's' */
	    transpose = FALSE ;
	    A->stype = -1 ;
	}
	else
	{
	    mexErrMsgTxt ("analyze: unrecognized mode") ;
	}
    }

    if (A->stype && A->nrow != A->ncol)
    {
	mexErrMsgTxt ("analyze: A must be square") ;
    }

    C = NULL ;
    if (transpose)
    {
	/* C = A', and then order C*C' */
	C = cholmod_l_transpose (A, 0, cm) ;
	if (C == NULL)
	{
	    mexErrMsgTxt ("analyze failed") ;
	}
	A = C ;
    }

    n = A->nrow ;

    /* ---------------------------------------------------------------------- */
    /* analyze and order the matrix */
    /* ---------------------------------------------------------------------- */

    L = cholmod_l_analyze (A, cm) ;

    /* ---------------------------------------------------------------------- */
    /* return Perm */
    /* ---------------------------------------------------------------------- */

    pargout [0] = sputil_put_int (L->Perm, n, 1) ;
    if (nargout > 1)
    {
	pargout [1] = sputil_put_int (L->ColCount, n, 0) ;
    }

    /* ---------------------------------------------------------------------- */
    /* free workspace */
    /* ---------------------------------------------------------------------- */

    cholmod_l_free_factor (&L, cm) ;
    cholmod_l_free_sparse (&C, cm) ;
    cholmod_l_free_sparse (&S, cm) ;
    cholmod_l_finish (cm) ;
    cholmod_l_print_common (" ", cm) ;
    /* if (cm->malloc_count != 0) mexErrMsgTxt ("!") ; */
}
Exemplo n.º 5
0
void mexFunction
(
    int	nargout,
    mxArray *pargout [ ],
    int	nargin,
    const mxArray *pargin [ ]
)
{
    double dummy = 0 ;
    cholmod_sparse Amatrix, *A ;
    cholmod_common Common, *cm ;
    Long result, quick, option, xmatched, pmatched, nzoffdiag, nzdiag ;

    /* ---------------------------------------------------------------------- */
    /* start CHOLMOD and set parameters */ 
    /* ---------------------------------------------------------------------- */

    cm = &Common ;
    cholmod_l_start (cm) ;
    sputil_config (SPUMONI, cm) ;

    /* ---------------------------------------------------------------------- */
    /* get inputs */
    /* ---------------------------------------------------------------------- */

    if (nargin > 2 || nargin < 1 || nargout > 5)
    {
	mexErrMsgTxt ("usage: [s xmatch pmatch nzoff nzd] = spsym (A,quick)") ;
    }
    if (!mxIsSparse (pargin [0]))
    {
    	mexErrMsgTxt ("A must be sparse and double") ;
    }

    /* get sparse matrix A */
    A = sputil_get_sparse (pargin [0], &Amatrix, &dummy, 0) ;

    /* get the "quick" parameter */
    quick = (nargin > 1) ? (mxGetScalar (pargin [1]) != 0) : FALSE ;

    if (nargout > 1)
    {
	option = 2 ;
    }
    else if (quick)
    {
	option = 0 ;
    }
    else
    {
	option = 1 ;
    }

    /* ---------------------------------------------------------------------- */
    /* determine symmetry */
    /* ---------------------------------------------------------------------- */

    xmatched = 0 ;
    pmatched = 0 ;
    nzoffdiag = 0 ;
    nzdiag = 0 ;

    result = cholmod_l_symmetry (A, option, &xmatched, &pmatched, &nzoffdiag,
	&nzdiag, cm) ;

    /* ---------------------------------------------------------------------- */
    /* return results to MATLAB */
    /* ---------------------------------------------------------------------- */

    pargout [0] = sputil_put_int (&result, 1, 0) ;

    if (nargout > 1) pargout [1] = sputil_put_int (&xmatched, 1, 0) ;
    if (nargout > 2) pargout [2] = sputil_put_int (&pmatched, 1, 0) ;
    if (nargout > 3) pargout [3] = sputil_put_int (&nzoffdiag, 1, 0) ;
    if (nargout > 4) pargout [4] = sputil_put_int (&nzdiag, 1, 0) ;

    /* ---------------------------------------------------------------------- */
    /* free workspace */
    /* ---------------------------------------------------------------------- */

    cholmod_l_finish (cm) ;
    cholmod_l_print_common (" ", cm) ;
}
Exemplo n.º 6
0
void mexFunction
(
    int	nargout,
    mxArray *pargout [ ],
    int	nargin,
    const mxArray *pargin [ ]
)
{
    void *G ;
    cholmod_dense *X = NULL ;
    cholmod_sparse *A = NULL, *Z = NULL ;
    cholmod_common Common, *cm ;
    Long *Ap = NULL, *Ai ;
    double *Ax, *Az = NULL ;
    char filename [MAXLEN] ;
    Long nz, k, is_complex = FALSE, nrow = 0, ncol = 0, allzero ;
    int mtype ;

    /* ---------------------------------------------------------------------- */
    /* start CHOLMOD and set parameters */
    /* ---------------------------------------------------------------------- */

    cm = &Common ;
    cholmod_l_start (cm) ;
    sputil_config (SPUMONI, cm) ;

    /* ---------------------------------------------------------------------- */
    /* get inputs */
    /* ---------------------------------------------------------------------- */

    if (nargin < 1 || nargin > 2 || nargout > 2)
    {
        mexErrMsgTxt ("usage: [A Z] = mread (filename, prefer_binary)") ;
    }
    if (!mxIsChar (pargin [0]))
    {
        mexErrMsgTxt ("mread requires a filename") ;
    }
    mxGetString (pargin [0], filename, MAXLEN) ;
    sputil_file = fopen (filename, "r") ;
    if (sputil_file == NULL)
    {
        mexErrMsgTxt ("cannot open file") ;
    }
    if (nargin > 1)
    {
        cm->prefer_binary = (mxGetScalar (pargin [1]) != 0) ;
    }

    /* ---------------------------------------------------------------------- */
    /* read the matrix, as either a dense or sparse matrix */
    /* ---------------------------------------------------------------------- */

    G = cholmod_l_read_matrix (sputil_file, 1, &mtype, cm) ;
    fclose (sputil_file) ;
    sputil_file = NULL ;
    if (G == NULL)
    {
        mexErrMsgTxt ("could not read file") ;
    }

    /* get the specific matrix (A or X), and change to ZOMPLEX if needed */
    if (mtype == CHOLMOD_SPARSE)
    {
        A = (cholmod_sparse *) G ;
        nrow = A->nrow ;
        ncol = A->ncol ;
        is_complex = (A->xtype == CHOLMOD_COMPLEX) ;
        Ap = A->p ;
        Ai = A->i ;
        if (is_complex)
        {
            /* if complex, ensure A is ZOMPLEX */
            cholmod_l_sparse_xtype (CHOLMOD_ZOMPLEX, A, cm) ;
        }
        Ax = A->x ;
        Az = A->z ;
    }
    else if (mtype == CHOLMOD_DENSE)
    {
        X = (cholmod_dense *) G ;
        nrow = X->nrow ;
        ncol = X->ncol ;
        is_complex = (X->xtype == CHOLMOD_COMPLEX) ;
        if (is_complex)
        {
            /* if complex, ensure X is ZOMPLEX */
            cholmod_l_dense_xtype (CHOLMOD_ZOMPLEX, X, cm) ;
        }
        Ax = X->x ;
        Az = X->z ;
    }
    else
    {
        mexErrMsgTxt ("invalid file") ;
    }

    /* ---------------------------------------------------------------------- */
    /* if requested, extract the zero entries and place them in Z */
    /* ---------------------------------------------------------------------- */

    if (nargout > 1)
    {
        if (mtype == CHOLMOD_SPARSE)
        {
            /* A is a sparse real/zomplex double matrix */
            Z = sputil_extract_zeros (A, cm) ;
        }
        else
        {
            /* input is full; just return an empty Z matrix */
            Z = cholmod_l_spzeros (nrow, ncol, 0, CHOLMOD_REAL, cm) ;
        }
    }

    /* ---------------------------------------------------------------------- */
    /* prune the zero entries from A and set nzmax(A) to nnz(A) */
    /* ---------------------------------------------------------------------- */

    if (mtype == CHOLMOD_SPARSE)
    {
        sputil_drop_zeros (A) ;
        cholmod_l_reallocate_sparse (cholmod_l_nnz (A, cm), A, cm) ;
    }

    /* ---------------------------------------------------------------------- */
    /* change a complex matrix to real if its imaginary part is all zero */
    /* ---------------------------------------------------------------------- */

    if (is_complex)
    {
        if (mtype == CHOLMOD_SPARSE)
        {
            nz = Ap [ncol] ;
        }
        else
        {
            nz = nrow * ncol ;
        }
        allzero = TRUE ;
        for (k = 0 ; k < nz ; k++)
        {
            if (Az [k] != 0)
            {
                allzero = FALSE ;
                break ;
            }
        }
        if (allzero)
        {
            /* discard the all-zero imaginary part */
            if (mtype == CHOLMOD_SPARSE)
            {
                cholmod_l_sparse_xtype (CHOLMOD_REAL, A, cm) ;
            }
            else
            {
                cholmod_l_dense_xtype (CHOLMOD_REAL, X, cm) ;
            }
        }
    }

    /* ---------------------------------------------------------------------- */
    /* return results to MATLAB */
    /* ---------------------------------------------------------------------- */

    if (mtype == CHOLMOD_SPARSE)
    {
        pargout [0] = sputil_put_sparse (&A, cm) ;
    }
    else
    {
        pargout [0] = sputil_put_dense (&X, cm) ;
    }
    if (nargout > 1)
    {
        pargout [1] = sputil_put_sparse (&Z, cm) ;
    }

    /* ---------------------------------------------------------------------- */
    /* free workspace */
    /* ---------------------------------------------------------------------- */

    cholmod_l_finish (cm) ;
    cholmod_l_print_common (" ", cm) ;
}
Exemplo n.º 7
0
void mexFunction
(
    int nargout,
    mxArray *pargout [ ],
    int nargin,
    const mxArray *pargin [ ]
)
{
    int ki;
    double dummy = 0 ;
    double *Lx, *Lx2 ;
    Int *Li, *Lp, *Li2, *Lp2, *Lnz2, *ColCount ;
    cholmod_sparse Cmatrix, *R, *Lsparse ;
    cholmod_factor *L ;
    cholmod_common Common, *cm ;
    Int j, k, s, update, n, lnz ;
    char buf [LEN] ;

    /* ---------------------------------------------------------------------- */
    /* start CHOLMOD and set parameters */ 
    /* ---------------------------------------------------------------------- */

    cm = &Common ;
    cholmod_l_start (cm) ;
    sputil_config (SPUMONI, cm) ;

    /* ---------------------------------------------------------------------- */
    /* check inputs */
    /* ---------------------------------------------------------------------- */

    if (nargout > 1 || nargin < 3 || nargin > 4)
    {
	mexErrMsgTxt ("Usage: L = ldlrowupdate (k, L, R, '+')") ; 
    }

    n = mxGetN (pargin [1]) ;
    k = mxGetN (pargin [2]) ;

    if (!mxIsSparse (pargin [1]) || !mxIsSparse (pargin [2])
	    || n != mxGetM (pargin [1]) || n != mxGetM (pargin [2])
	    || mxIsComplex (pargin [1]) || mxIsComplex (pargin [2]))
    {
      k = mxGetM (pargin [2]);
      j = mxGetM (pargin [1]);
      printf("n=%d  L=%d  R=%d \n", n, j, k);
	mexErrMsgTxt ("ldlrowupdate: R and/or L not sparse, complex, or wrong"
		" dimensions") ;
    }

    /* ---------------------------------------------------------------------- */
    /* determine if we're doing an update or downdate */
    /* ---------------------------------------------------------------------- */

    update = TRUE ;
    if (nargin > 3 && mxIsChar (pargin [3]))
    {
	mxGetString (pargin [3], buf, LEN) ;
	if (buf [0] == '-')
	{
	    update = FALSE ;
	}
	else if (buf [0] != '+')
	{
	    mexErrMsgTxt ("ldlrowupdate: update string must be '+' or '-'") ;
	}
    }

    /* ---------------------------------------------------------------------- */
    /* get ki: column integer of update */
    /* ---------------------------------------------------------------------- */
    ki = (int) *mxGetPr(pargin[0]);
    ki = ki-1;

    /* ---------------------------------------------------------------------- */
    /* get R: sparse matrix of incoming/outgoing columns */
    /* ---------------------------------------------------------------------- */

    R = sputil_get_sparse (pargin [2], &Cmatrix, &dummy, 0) ;

    /* ---------------------------------------------------------------------- */
    /* construct a copy of the input sparse matrix L */
    /* ---------------------------------------------------------------------- */

    /* get the MATLAB L */
    Lp = (Int *) mxGetJc (pargin [1]) ;
    Li = (Int *) mxGetIr (pargin [1]) ;
    Lx = mxGetPr (pargin [1]) ;

    /* allocate the CHOLMOD symbolic L */
    L = cholmod_l_allocate_factor (n, cm) ;
    L->ordering = CHOLMOD_NATURAL ;
    ColCount = L->ColCount ;
    for (j = 0 ; j < n ; j++)
    {
	ColCount [j] = Lp [j+1] - Lp [j] ;
    }

    /* allocate space for a CHOLMOD LDL' packed factor */
    cholmod_l_change_factor (CHOLMOD_REAL, FALSE, FALSE, TRUE, TRUE, L, cm) ;

    /* copy MATLAB L into CHOLMOD L */
    Lp2 = L->p ;
    Li2 = L->i ;
    Lx2 = L->x ;
    Lnz2 = L->nz ;
    lnz = L->nzmax ;
    for (j = 0 ; j <= n ; j++)
    {
	Lp2 [j] = Lp [j] ;
    }
    for (j = 0 ; j < n ; j++)
    {
	Lnz2 [j] = Lp [j+1] - Lp [j] ;
    }
    for (s = 0 ; s < lnz ; s++)
    {
	Li2 [s] = Li [s] ;
    }
    for (s = 0 ; s < lnz ; s++)
    {
	Lx2 [s] = Lx [s] ;
    }

    /* ---------------------------------------------------------------------- */
    /* update/downdate the LDL' factorization */
    /* ---------------------------------------------------------------------- */
    /* add row */
    if (update){
      if (!cholmod_l_rowadd (ki, R, L, cm))
	{
	  mexErrMsgTxt ("rowadd failed\n") ;
	}
    }
    /* delete row */
    else {
      if (!cholmod_l_rowdel (ki, NULL, L, cm))
	{
	  mexErrMsgTxt ("rowdel failed\n") ;
	}
    }
      

    /* ---------------------------------------------------------------------- */
    /* copy the results back to MATLAB */
    /* ---------------------------------------------------------------------- */

    /* change L back to packed LDL' (it may have become unpacked if the
     * sparsity pattern changed).  This change takes O(n) time if the pattern
     * of L wasn't updated. */
    Lsparse = cholmod_l_factor_to_sparse (L, cm) ;

    /* return L as a sparse matrix */
    pargout [0] = sputil_put_sparse (&Lsparse, cm) ;

    /* ---------------------------------------------------------------------- */
    /* free workspace and the CHOLMOD L, except for what is copied to MATLAB */
    /* ---------------------------------------------------------------------- */

    cholmod_l_free_factor (&L, cm) ;
    cholmod_l_finish (cm) ;
    cholmod_l_print_common (" ", cm) ;
    /*
    if (cm->malloc_count != 3 + mxIsComplex (pargout[0])) mexErrMsgTxt ("!") ;
    */
}
Exemplo n.º 8
0
void mexFunction
(
    int	nargout,
    mxArray *pargout [ ],
    int	nargin,
    const mxArray *pargin [ ]
    )
{
  double dummy = 0, beta [2], *px, *C, *Ct, *C2, *fil, *Zt, *zt, done=1.0, *zz, dzero=0.0;
  cholmod_sparse Amatrix, *A, *Lsparse ;
  cholmod_factor *L ;
  cholmod_common Common, *cm ;
  Int minor, *It2, *Jt2 ;
  mwIndex l, k2, h, k, i, j, ik, *I, *J, *Jt, *It, *I2, *J2, lfi, *w, *w2, *r;
  mwSize nnz, nnzlow, m, n;
  int nz = 0;
  mwSignedIndex one=1, lfi_si;
  mxArray *Am, *Bm;
  char *uplo="L", *trans="N";
  

  /* ---------------------------------------------------------------------- */
  /* Only one input. We have to find first the Cholesky factorization.      */ 
  /* start CHOLMOD and set parameters */ 
  /* ---------------------------------------------------------------------- */

  if (nargin == 1) {
    cm = &Common ;
    cholmod_l_start (cm) ;
    sputil_config (SPUMONI, cm) ;
    
    /* convert to packed LDL' when done */
    cm->final_asis = FALSE ;
    cm->final_super = FALSE ;
    cm->final_ll = FALSE ;
    cm->final_pack = TRUE ;
    cm->final_monotonic = TRUE ;

    /* since numerically zero entries are NOT dropped from the symbolic
     * pattern, we DO need to drop entries that result from supernodal
     * amalgamation. */
    cm->final_resymbol = TRUE ;

    cm->quick_return_if_not_posdef = (nargout < 2) ;
  }

  /* This will disable the supernodal LL', which will be slow. */
  /* cm->supernodal = CHOLMOD_SIMPLICIAL ; */
  
  /* ---------------------------------------------------------------------- */
  /* get inputs */
  /* ---------------------------------------------------------------------- */
  
  if (nargin > 3)
    {
      mexErrMsgTxt ("usage: Z = sinv(A), or Z = sinv(LD, 1)") ;
    }
  
  n = mxGetM (pargin [0]) ;
  m = mxGetM (pargin [0]) ;
  
  if (!mxIsSparse (pargin [0]))
    {
      mexErrMsgTxt ("A must be sparse") ;
    }
  if (n != mxGetN (pargin [0]))
    {
      mexErrMsgTxt ("A must be square") ;
    }

  /* Only one input. We have to find first the Cholesky factorization.      */
  if (nargin == 1) {
    /* get sparse matrix A, use tril(A)  */
    A = sputil_get_sparse (pargin [0], &Amatrix, &dummy, -1) ; 
    
    A->stype = -1 ;	    /* use lower part of A */
    beta [0] = 0 ;
    beta [1] = 0 ;
    
    /* ---------------------------------------------------------------------- */
    /* analyze and factorize */
    /* ---------------------------------------------------------------------- */
    
    L = cholmod_l_analyze (A, cm) ;
    cholmod_l_factorize_p (A, beta, NULL, 0, L, cm) ;
    
    if (cm->status != CHOLMOD_OK)
      {
	mexErrMsgTxt ("matrix is not positive definite") ;
      }
    
    /* ---------------------------------------------------------------------- */
    /* convert L to a sparse matrix */
    /* ---------------------------------------------------------------------- */

    Lsparse = cholmod_l_factor_to_sparse (L, cm) ;
    if (Lsparse->xtype == CHOLMOD_COMPLEX)
      {
	mexErrMsgTxt ("matrix is complex") ;
      }
    
    /* ---------------------------------------------------------------------- */
    /* Set the sparse Cholesky factorization in Matlab format */
    /* ---------------------------------------------------------------------- */
    /*Am = sputil_put_sparse (&Lsparse, cm) ;
      I = mxGetIr(Am);
      J = mxGetJc(Am);
      C = mxGetPr(Am);
      nnz = mxGetNzmax(Am); */

    It2 = Lsparse->i;
    Jt2 = Lsparse->p;
    Ct = Lsparse->x;
    nnz = (mwSize) Lsparse->nzmax;

    Am = mxCreateSparse(m, m, nnz, mxREAL) ;
    I = mxGetIr(Am);
    J = mxGetJc(Am);
    C = mxGetPr(Am);
    for (j = 0 ;  j < n+1 ; j++)  J[j] = (mwIndex) Jt2[j];
    for ( i = 0 ; i < nnz ; i++) {
	I[i] = (mwIndex) It2[i];
	C[i] = Ct[i];
    }
    
    cholmod_l_free_sparse (&Lsparse, cm) ;

    /*FILE *out1 = fopen( "output1.txt", "w" );
    if( out1 != NULL )
      fprintf( out1, "Hello %d\n", nnz );
      fclose (out1);*/
    
  } else {
    /* The cholesky factorization is given as an input.      */
    /* We have to copy it into workspace                     */
    It = mxGetIr(pargin [0]);
    Jt = mxGetJc(pargin [0]);
    Ct = mxGetPr(pargin [0]);
    nnz = mxGetNzmax(pargin [0]);
    
    Am = mxCreateSparse(m, m, nnz, mxREAL) ;
    I = mxGetIr(Am);
    J = mxGetJc(Am);
    C = mxGetPr(Am);
    for (j = 0 ;  j < n+1 ; j++)  J[j] = Jt[j];
    for ( i = 0 ; i < nnz ; i++) {
	I[i] = It[i];
	C[i] = Ct[i];
    }    
  }

  /* Evaluate the sparse inverse */
  C[nnz-1] = 1.0/C[J[m-1]];               /* set the last element of sparse inverse */
  fil = mxCalloc((mwSize)1,sizeof(double));
  zt = mxCalloc((mwSize)1,sizeof(double));
  Zt = mxCalloc((mwSize)1,sizeof(double));
  zz = mxCalloc((mwSize)1,sizeof(double));
  for (j=m-2;j!=-1;j--){
    lfi = J[j+1]-(J[j]+1);
    
    /* if (lfi > 0) */
    if ( J[j+1] > (J[j]+1) )
      {
	/*	printf("lfi = %u \n ", lfi);
	printf("lfi*double = %u \n", (mwSize)lfi*sizeof(double));
	printf("lfi*lfi*double = %u \n", (mwSize)lfi*(mwSize)lfi*sizeof(double));
	printf("\n \n");
	*/
	
	fil = mxRealloc(fil,(mwSize)lfi*sizeof(double));
	for (i=0;i<lfi;i++) fil[i] = C[J[j]+i+1];                   /* take the j'th lower triangular column of the Cholesky */
	
	zt = mxRealloc(zt,(mwSize)lfi*sizeof(double));              /* memory for the sparse inverse elements to be evaluated */
	Zt = mxRealloc(Zt,(mwSize)lfi*(mwSize)lfi*sizeof(double));  /* memory for the needed sparse inverse elements */
	
	/* Set the lower triangular for Zt */
	k2 = 0;
	for (k=J[j]+1;k<J[j+1];k++){
	  ik = I[k];
	  h = k2;
	  for (l=J[ik];l<=J[ik+1];l++){
	    if (I[l] == I[ J[j]+h+1 ]){
	      Zt[h+lfi*k2] = C[l];
	      h++;
	    }
	  }
	  k2++;
	}
	
	
	/* evaluate zt = fil*Zt */
	lfi_si = (mwSignedIndex) lfi;
	dsymv(uplo, &lfi_si, &done, Zt, &lfi_si, fil, &one, &dzero, zt, &one);
	
	/* Set the evaluated sparse inverse elements, zt, into C */
	k=lfi-1;
	for (i = J[j+1]-1; i!=J[j] ; i--){
	  C[i] = -zt[k];
	  k--;
	}
	/* evaluate the j'th diagonal of sparse inverse */
	dgemv(trans, &one, &lfi_si, &done, fil, &one, zt, &one, &dzero, zz, &one); 
	C[J[j]] = 1.0/C[J[j]] + zz[0];
      }
    else
      {
	/* evaluate the j'th diagonal of sparse inverse */
	C[J[j]] = 1.0/C[J[j]];	
      }
  }
    
  /* Free the temporary variables */
  mxFree(fil);
  mxFree(zt);
  mxFree(Zt);
  mxFree(zz);

  /* ---------------------------------------------------------------------- */
  /* Permute the elements according to r(q) = 1:n                           */
  /* Done only if the Cholesky was evaluated here                           */
  /* ---------------------------------------------------------------------- */
  if (nargin == 1) {
   
    Bm = mxCreateSparse(m, m, nnz, mxREAL) ;     
    It = mxGetIr(Bm);
    Jt = mxGetJc(Bm);
    Ct = mxGetPr(Bm);                            /* Ct = C(r,r) */ 
    
    r = (mwIndex *) L->Perm;                         /* fill reducing ordering */
    w = mxCalloc(m,sizeof(mwIndex));                 /* column counts of Am */
    
    /* count entries in each column of Bm */
    for (j=0; j<m; j++){
      k = r ? r[j] : j ;       /* column j of Bm is column k of Am */
      for (l=J[j] ; l<J[j+1] ; l++){
	i = I[l];
	ik = r ? r[i] : i ;    /* row i of Bm is row ik of Am */
	w[ max(ik,k) ]++;
      }
    }
    cumsum2(Jt, w, m);
    for (j=0; j<m; j++){
      k = r ? r[j] : j ;             /* column j of Bm is column k of Am */
      for (l=J[j] ; l<J[j+1] ; l++){
	i= I[l];
	ik = r ? r[i] : i ;          /* row i of Bm is row ik of Am */
	It [k2 = w[max(ik,k)]++ ] = min(ik,k);
	Ct[k2] = C[l];
      }
    }
    mxFree(w);
    
    /* ---------------------------------------------------------------------- */
    /* Transpose the permuted (upper triangular) matrix Bm into Am */
    /* (this way we get sorted columns)                            */
    /* ---------------------------------------------------------------------- */
    w = mxCalloc(m,sizeof(mwIndex));                 
    for (i=0 ; i<Jt[m] ; i++) w[It[i]]++;        /* row counts of Bm */
    cumsum2(J, w, m);                            /* row pointers */
    for (j=0 ; j<m ; j++){
      for (i=Jt[j] ; i<Jt[j+1] ; i++){
	I[ l=w[ It[i] ]++ ] = j;
	C[l] = Ct[i];
      }
    }
    mxFree(w);
    mxDestroyArray(Bm);
  }
  
  /* ---------------------------------------------------------------------- */
  /* Fill the upper triangle of the sparse inverse */
  /* ---------------------------------------------------------------------- */
  
  w = mxCalloc(m,sizeof(mwIndex));        /* workspace */
  w2 = mxCalloc(m,sizeof(mwIndex));       /* workspace */
  for (k=0;k<J[m];k++) w[I[k]]++;     /* row counts of the lower triangular */
  for (k=0;k<m;k++) w2[k] = w[k] + J[k+1] - J[k] - 1;   /* column counts of the sparse inverse */
  
  nnz = (mwSize)2*nnz - m;                       /* The number of nonzeros in Z */
  pargout[0] = mxCreateSparse(m,m,nnz,mxREAL);   /* The sparse matrix */
  It = mxGetIr(pargout[0]);
  Jt = mxGetJc(pargout[0]);
  Ct = mxGetPr(pargout[0]);
  
  cumsum2(Jt, w2, m);               /* column starting points */
  for (j = 0 ; j < m ; j++){           /* fill the upper triangular */
    for (k = J[j] ; k < J[j+1] ; k++){
      It[l = w2[ I[k]]++] = j ;	 /* place C(i,j) as entry Ct(j,i) */
      if (Ct) Ct[l] = C[k] ;
    }
  }
  for (j = 0 ; j < m ; j++){           /* fill the lower triangular */
    for (k = J[j]+1 ; k < J[j+1] ; k++){
      It[l = w2[j]++] = I[k] ;         /* place C(j,i) as entry Ct(j,i) */
      if (Ct) Ct[l] = C[k] ;
    }
  }
  
  mxFree(w2);
  mxFree(w);
  
  /* ---------------------------------------------------------------------- */
  /* return to MATLAB */
  /* ---------------------------------------------------------------------- */
  
  /* ---------------------------------------------------------------------- */
  /* free workspace and the CHOLMOD L, except for what is copied to MATLAB */
  /* ---------------------------------------------------------------------- */
  if (nargin == 1) {
    cholmod_l_free_factor (&L, cm) ;
    cholmod_l_finish (cm) ;
    cholmod_l_print_common (" ", cm) ;
  }
  mxDestroyArray(Am);
  
}
Exemplo n.º 9
0
Arquivo: metis.c Projeto: GHilmarG/Ua
void mexFunction
(
    int nargout,
    mxArray *pargout [ ],
    int nargin,
    const mxArray *pargin [ ]
)
{
#ifndef NPARTITION
    double dummy = 0 ;
    Long *Perm ;
    cholmod_sparse *A, Amatrix, *C, *S ;
    cholmod_common Common, *cm ;
    Long n, transpose, c, postorder ;
    char buf [LEN] ;

    /* ---------------------------------------------------------------------- */
    /* start CHOLMOD and set defaults */
    /* ---------------------------------------------------------------------- */

    cm = &Common ;
    cholmod_l_start (cm) ;
    sputil_config (SPUMONI, cm) ;

    /* ---------------------------------------------------------------------- */
    /* get inputs */
    /* ---------------------------------------------------------------------- */

    if (nargout > 1 || nargin < 1 || nargin > 3)
    {
	mexErrMsgTxt ("Usage: p = metis (A, mode)") ;
    }

    /* ---------------------------------------------------------------------- */
    /* get input matrix A */
    /* ---------------------------------------------------------------------- */

    A = sputil_get_sparse_pattern (pargin [0], &Amatrix, &dummy, cm) ;
    S = (A == &Amatrix) ? NULL : A ;

    /* ---------------------------------------------------------------------- */
    /* get A->stype, default is to use tril(A) */
    /* ---------------------------------------------------------------------- */

    A->stype = -1 ;
    transpose = FALSE ;

    if (nargin > 1)
    {
	buf [0] = '\0' ;
	if (mxIsChar (pargin [1]))
	{
	    mxGetString (pargin [1], buf, LEN) ;
	}
	c = buf [0] ;
	if (tolower (c) == 'r')
	{
	    /* unsymmetric case (A*A') if string starts with 'r' */
	    transpose = FALSE ;
	    A->stype = 0 ;
	}
	else if (tolower (c) == 'c')
	{
	    /* unsymmetric case (A'*A) if string starts with 'c' */
	    transpose = TRUE ;
	    A->stype = 0 ;
	}
	else if (tolower (c) == 's')
	{
	    /* symmetric case (A) if string starts with 's' */
	    transpose = FALSE ;
	    A->stype = -1 ;
	}
	else
	{
	    mexErrMsgTxt ("metis: p=metis(A,mode) ; unrecognized mode") ;
	}
    }

    if (A->stype && A->nrow != A->ncol)
    {
	mexErrMsgTxt ("metis: A must be square") ;
    }

    C = NULL ;
    if (transpose)
    {
	/* C = A', and then order C*C' with METIS */
	C = cholmod_l_transpose (A, 0, cm) ;
	if (C == NULL)
	{
	    mexErrMsgTxt ("metis failed") ;
	}
	A = C ;
    }

    n = A->nrow ;

    /* ---------------------------------------------------------------------- */
    /* get workspace */
    /* ---------------------------------------------------------------------- */

    Perm = cholmod_l_malloc (n, sizeof (Long), cm) ;

    /* ---------------------------------------------------------------------- */
    /* order the matrix with CHOLMOD's interface to METIS_NodeND */ 
    /* ---------------------------------------------------------------------- */

    postorder = (nargin < 3) ;
    if (!cholmod_l_metis (A, NULL, 0, postorder, Perm, cm))
    {
	mexErrMsgTxt ("metis failed") ;
	return ;
    }

    /* ---------------------------------------------------------------------- */
    /* return Perm */
    /* ---------------------------------------------------------------------- */

    pargout [0] = sputil_put_int (Perm, n, 1) ;

    /* ---------------------------------------------------------------------- */
    /* free workspace */
    /* ---------------------------------------------------------------------- */

    cholmod_l_free (n, sizeof (Long), Perm, cm) ;
    cholmod_l_free_sparse (&C, cm) ;
    cholmod_l_free_sparse (&S, cm) ;
    cholmod_l_finish (cm) ;
    cholmod_l_print_common (" ", cm) ;
    /*
    if (cm->malloc_count != 0) mexErrMsgTxt ("!") ;
    */
#else
    mexErrMsgTxt ("METIS and the CHOLMOD Partition Module not installed\n") ;
#endif
}
Exemplo n.º 10
0
void mexFunction
(
    int nargout,
    mxArray *pargout [ ],
    int nargin,
    const mxArray *pargin [ ]
)
{
    double dummy = 0 ;
    double *Lx, *Lx2, *Lz, *Lz2 ;
    Long *Li, *Lp, *Lnz2, *Li2, *Lp2, *ColCount ;
    cholmod_sparse *A, Amatrix, *Lsparse, *S ;
    cholmod_factor *L ;
    cholmod_common Common, *cm ;
    Long j, s, n, lnz, is_complex ;

    /* ---------------------------------------------------------------------- */
    /* start CHOLMOD and set parameters */ 
    /* ---------------------------------------------------------------------- */

    cm = &Common ;
    cholmod_l_start (cm) ;
    sputil_config (SPUMONI, cm) ;

    /* ---------------------------------------------------------------------- */
    /* check inputs */
    /* ---------------------------------------------------------------------- */

    if (nargout > 1 || nargin != 2)
    {
	mexErrMsgTxt ("usage: L = resymbol (L, A)\n") ;
    }

    n = mxGetN (pargin [0]) ;
    if (!mxIsSparse (pargin [0]) || n != mxGetM (pargin [0]))
    {
	mexErrMsgTxt ("resymbol: L must be sparse and square") ;
    }
    if (n != mxGetM (pargin [1]) || n != mxGetN (pargin [1]))
    {
	mexErrMsgTxt ("resymbol: A and L must have same dimensions") ;
    }

    /* ---------------------------------------------------------------------- */
    /* get the sparse matrix A */
    /* ---------------------------------------------------------------------- */

    A = sputil_get_sparse_pattern (pargin [1], &Amatrix, &dummy, cm) ;
    S = (A == &Amatrix) ? NULL : A ;

    A->stype = -1 ;

    /* A = sputil_get_sparse (pargin [1], &Amatrix, &dummy, -1) ; */

    /* ---------------------------------------------------------------------- */
    /* construct a copy of the input sparse matrix L */
    /* ---------------------------------------------------------------------- */

    /* get the MATLAB L */
    Lp = (Long *) mxGetJc (pargin [0]) ;
    Li = (Long *) mxGetIr (pargin [0]) ;
    Lx = mxGetPr (pargin [0]) ;
    Lz = mxGetPi (pargin [0]) ;
    is_complex = mxIsComplex (pargin [0]) ;

    /* allocate the CHOLMOD symbolic L */
    L = cholmod_l_allocate_factor (n, cm) ;
    L->ordering = CHOLMOD_NATURAL ;
    ColCount = L->ColCount ;
    for (j = 0 ; j < n ; j++)
    {
	ColCount [j] = Lp [j+1] - Lp [j] ;
    }

    /* allocate space for a CHOLMOD LDL' packed factor */
    /* (LL' and LDL' are treated identically) */
    cholmod_l_change_factor (is_complex ? CHOLMOD_ZOMPLEX : CHOLMOD_REAL,
	    FALSE, FALSE, TRUE, TRUE, L, cm) ;

    /* copy MATLAB L into CHOLMOD L */
    Lp2 = L->p ;
    Li2 = L->i ;
    Lx2 = L->x ;
    Lz2 = L->z ;
    Lnz2 = L->nz ;
    lnz = L->nzmax ;
    for (j = 0 ; j <= n ; j++)
    {
	Lp2 [j] = Lp [j] ;
    }
    for (j = 0 ; j < n ; j++)
    {
	Lnz2 [j] = Lp [j+1] - Lp [j] ;
    }
    for (s = 0 ; s < lnz ; s++)
    {
	Li2 [s] = Li [s] ;
    }
    for (s = 0 ; s < lnz ; s++)
    {
	Lx2 [s] = Lx [s] ;
    }
    if (is_complex)
    {
	for (s = 0 ; s < lnz ; s++)
	{
	    Lz2 [s] = Lz [s] ;
	}
    }

    /* ---------------------------------------------------------------------- */
    /* resymbolic factorization */
    /* ---------------------------------------------------------------------- */

    cholmod_l_resymbol (A, NULL, 0, TRUE, L, cm) ;

    /* ---------------------------------------------------------------------- */
    /* copy the results back to MATLAB */
    /* ---------------------------------------------------------------------- */

    Lsparse = cholmod_l_factor_to_sparse (L, cm) ;

    /* return L as a sparse matrix */
    pargout [0] = sputil_put_sparse (&Lsparse, cm) ;

    /* ---------------------------------------------------------------------- */
    /* free workspace and the CHOLMOD L, except for what is copied to MATLAB */
    /* ---------------------------------------------------------------------- */

    cholmod_l_free_factor (&L, cm) ;
    cholmod_l_free_sparse (&S, cm) ;
    cholmod_l_finish (cm) ;
    cholmod_l_print_common (" ", cm) ;
    /*
    if (cm->malloc_count != 3 + mxIsComplex (pargout[0])) mexErrMsgTxt ("!") ;
    */
}
Exemplo n.º 11
0
void mexFunction
(
    int nargout,
    mxArray *pargout [ ],
    int nargin,
    const mxArray *pargin [ ]
)
{
    double dummy = 0, *Px, *Xsetx ;
    Long *Lp, *Lnz, *Xp, *Xi, xnz, *Perm, *Lprev, *Lnext, *Xsetp ;
    cholmod_sparse *Bset, Bmatrix, *Xset ;
    cholmod_dense *Bdense, *X, *Y, *E ;
    cholmod_factor *L ;
    cholmod_common Common, *cm ;
    Long k, j, n, head, tail, xsetlen ;
    int sys, kind ;

    /* ---------------------------------------------------------------------- */
    /* start CHOLMOD and set parameters */
    /* ---------------------------------------------------------------------- */

    cm = &Common ;
    cholmod_l_start (cm) ;
    sputil_config (SPUMONI, cm) ;

    /* ---------------------------------------------------------------------- */
    /* check inputs */
    /* ---------------------------------------------------------------------- */

    if (nargin != 5 || nargout > 2)
    {
        mexErrMsgTxt ("usage: [x xset] = lsubsolve (L,kind,P,b,system)") ;
    }

    n = mxGetN (pargin [0]) ;
    if (!mxIsSparse (pargin [0]) || n != mxGetM (pargin [0]))
    {
        mexErrMsgTxt ("lsubsolve: L must be sparse and square") ;
    }
    if (mxGetNumberOfElements (pargin [1]) != 1)
    {
        mexErrMsgTxt ("lsubsolve: kind must be a scalar") ;
    }

    if (mxIsSparse (pargin [2]) ||
            !(mxIsEmpty (pargin [2]) || mxGetNumberOfElements (pargin [2]) == n))
    {
        mexErrMsgTxt ("lsubsolve: P must be size n, or empty") ;
    }

    if (mxGetM (pargin [3]) != n || mxGetN (pargin [3]) != 1)
    {
        mexErrMsgTxt ("lsubsolve: b wrong dimension") ;
    }
    if (!mxIsSparse (pargin [3]))
    {
        mexErrMsgTxt ("lxbpattern: b must be sparse") ;
    }
    if (mxGetNumberOfElements (pargin [4]) != 1)
    {
        mexErrMsgTxt ("lsubsolve: system must be a scalar") ;
    }

    /* ---------------------------------------------------------------------- */
    /* get the inputs */
    /* ---------------------------------------------------------------------- */

    kind = (int) sputil_get_integer (pargin [1], FALSE, 0) ;
    sys  = (int) sputil_get_integer (pargin [4], FALSE, 0) ;

    /* ---------------------------------------------------------------------- */
    /* get the sparse b */
    /* ---------------------------------------------------------------------- */

    /* get sparse matrix B (unsymmetric) */
    Bset = sputil_get_sparse (pargin [3], &Bmatrix, &dummy, 0) ;
    Bdense = cholmod_l_sparse_to_dense (Bset, cm) ;
    Bset->x = NULL ;
    Bset->z = NULL ;
    Bset->xtype = CHOLMOD_PATTERN ;

    /* ---------------------------------------------------------------------- */
    /* construct a shallow copy of the input sparse matrix L */
    /* ---------------------------------------------------------------------- */

    /* the construction of the CHOLMOD takes O(n) time and memory */

    /* allocate the CHOLMOD symbolic L */
    L = cholmod_l_allocate_factor (n, cm) ;
    L->ordering = CHOLMOD_NATURAL ;

    /* get the MATLAB L */
    L->p = mxGetJc (pargin [0]) ;
    L->i = mxGetIr (pargin [0]) ;
    L->x = mxGetPr (pargin [0]) ;
    L->z = mxGetPi (pargin [0]) ;

    /* allocate and initialize the rest of L */
    L->nz = cholmod_l_malloc (n, sizeof (Long), cm) ;
    Lp = L->p ;
    Lnz = L->nz ;
    for (j = 0 ; j < n ; j++)
    {
        Lnz [j] = Lp [j+1] - Lp [j] ;
    }

    /* these pointers are not accessed in cholmod_solve2 */
    L->prev = cholmod_l_malloc (n+2, sizeof (Long), cm) ;
    L->next = cholmod_l_malloc (n+2, sizeof (Long), cm) ;
    Lprev = L->prev ;
    Lnext = L->next ;

    head = n+1 ;
    tail = n ;
    Lnext [head] = 0 ;
    Lprev [head] = -1 ;
    Lnext [tail] = -1 ;
    Lprev [tail] = n-1 ;
    for (j = 0 ; j < n ; j++)
    {
        Lnext [j] = j+1 ;
        Lprev [j] = j-1 ;
    }
    Lprev [0] = head ;

    L->xtype = (mxIsComplex (pargin [0])) ? CHOLMOD_ZOMPLEX : CHOLMOD_REAL ;
    L->nzmax = Lp [n] ;

    /* get the permutation */
    if (mxIsEmpty (pargin [2]))
    {
        L->Perm = NULL ;
        Perm = NULL ;
    }
    else
    {
        L->ordering = CHOLMOD_GIVEN ;
        L->Perm = cholmod_l_malloc (n, sizeof (Long), cm) ;
        Perm = L->Perm ;
        Px = mxGetPr (pargin [2]) ;
        for (k = 0 ; k < n ; k++)
        {
            Perm [k] = ((Long) Px [k]) - 1 ;
        }
    }

    /* set the kind, LL' or LDL' */
    L->is_ll = (kind == 0) ;
    /*
    cholmod_l_print_factor (L, "L", cm) ;
    */

    /* ---------------------------------------------------------------------- */
    /* solve the system */
    /* ---------------------------------------------------------------------- */

    X = cholmod_l_zeros (n, 1, L->xtype, cm) ;
    Xset = NULL ;
    Y = NULL ;
    E = NULL ;

    cholmod_l_solve2 (sys, L, Bdense, Bset, &X, &Xset, &Y, &E, cm) ;

    cholmod_l_free_dense (&Y, cm) ;
    cholmod_l_free_dense (&E, cm) ;

    /* ---------------------------------------------------------------------- */
    /* return result */
    /* ---------------------------------------------------------------------- */

    pargout [0] = sputil_put_dense (&X, cm) ;

    /* fill numerical values of Xset with one's */
    Xsetp = Xset->p ;
    xsetlen = Xsetp [1] ;
    Xset->x = cholmod_l_malloc (xsetlen, sizeof (double), cm) ;
    Xsetx = Xset->x ;
    for (k = 0 ; k < xsetlen ; k++)
    {
        Xsetx [k] = 1 ;
    }
    Xset->xtype = CHOLMOD_REAL ;

    pargout [1] = sputil_put_sparse (&Xset, cm) ;

    /* ---------------------------------------------------------------------- */
    /* free workspace and the CHOLMOD L, except for what is copied to MATLAB */
    /* ---------------------------------------------------------------------- */

    L->p = NULL ;
    L->i = NULL ;
    L->x = NULL ;
    L->z = NULL ;
    cholmod_l_free_factor (&L, cm) ;
    cholmod_l_finish (cm) ;
    cholmod_l_print_common (" ", cm) ;
}
Exemplo n.º 12
0
void mexFunction
(
    int nargout,
    mxArray *pargout [ ],
    int nargin,
    const mxArray *pargin [ ]
)
{
    double dummy = 0, one [2] = {1,0}, zero [2] = {0,0} ;
    cholmod_sparse *S, Smatrix ;
    cholmod_dense *F, Fmatrix, *C ;
    cholmod_common Common, *cm ;
    Long srow, scol, frow, fcol, crow, transpose ; 

    /* ---------------------------------------------------------------------- */
    /* start CHOLMOD and set parameters */ 
    /* ---------------------------------------------------------------------- */

    cm = &Common ;
    cholmod_l_start (cm) ;
    sputil_config (SPUMONI, cm) ;

    /* ---------------------------------------------------------------------- */
    /* check inputs */
    /* ---------------------------------------------------------------------- */

    if (nargout > 1 || nargin < 2 || nargin > 3)
    {
	mexErrMsgTxt ("Usage: C = sdmult (S,F,transpose)") ; 
    }

    srow = mxGetM (pargin [0]) ;
    scol = mxGetN (pargin [0]) ;
    frow = mxGetM (pargin [1]) ;
    fcol = mxGetN (pargin [1]) ;

    transpose = !((nargin == 2) || (mxGetScalar (pargin [2]) == 0)) ;

    if (frow != (transpose ? srow : scol))
    {
	mexErrMsgTxt ("invalid inner dimensions") ;
    }

    if (!mxIsSparse (pargin [0]) || mxIsSparse (pargin [1]))
    {
	mexErrMsgTxt ("sdmult (S,F): S must be sparse, F must be full") ;
    }

    /* ---------------------------------------------------------------------- */
    /* get S and F */
    /* ---------------------------------------------------------------------- */

    S = sputil_get_sparse (pargin [0], &Smatrix, &dummy, 0) ;
    F = sputil_get_dense  (pargin [1], &Fmatrix, &dummy) ;

    /* ---------------------------------------------------------------------- */
    /* C = S*F or S'*F */
    /* ---------------------------------------------------------------------- */

    crow = transpose ? scol : srow ;
    C = cholmod_l_allocate_dense (crow, fcol, crow, F->xtype, cm) ;
    cholmod_l_sdmult (S, transpose, one, zero, F, C, cm) ;
    pargout [0] = sputil_put_dense (&C, cm) ;

    /* ---------------------------------------------------------------------- */
    /* free workspace and the CHOLMOD L, except for what is copied to MATLAB */
    /* ---------------------------------------------------------------------- */

    cholmod_l_finish (cm) ;
    cholmod_l_print_common (" ", cm) ;
    /*
    if (cm->malloc_count != (mxIsComplex (pargout [0]) + 1)) mexErrMsgTxt ("!");
    */
}
Exemplo n.º 13
0
void mexFunction
(
    int nargout,
    mxArray *pargout [ ],
    int nargin,
    const mxArray *pargin [ ]
)
{
    double dummy = 0 ;
    double *Lx, *Lx2 ;
    Long *Li, *Lp, *Li2, *Lp2, *Lnz2, *ColCount ;
    cholmod_sparse Cmatrix, *C, *Lsparse ;
    cholmod_factor *L ;
    cholmod_common Common, *cm ;
    Long j, k, s, rowadd, n, lnz, ok ;

    /* ---------------------------------------------------------------------- */
    /* start CHOLMOD and set parameters */ 
    /* ---------------------------------------------------------------------- */

    cm = &Common ;
    cholmod_l_start (cm) ;
    sputil_config (SPUMONI, cm) ;

    /* ---------------------------------------------------------------------- */
    /* check inputs */
    /* ---------------------------------------------------------------------- */

    if (nargout > 1 || nargin < 2 || nargin > 3)
    {
	mexErrMsgTxt ("Usage: LD = ldlrowmod (LD,k,C) or ldlrowmod (LD,k)") ; 
    }

    n = mxGetN (pargin [0]) ;
    k = (Long) mxGetScalar (pargin [1]) ;
    k = k - 1 ;         /* change from 1-based to 0-based */

    if (!mxIsSparse (pargin [0])
	    || n != mxGetM (pargin [0])
	    || mxIsComplex (pargin [0]))
    {
	mexErrMsgTxt ("ldlrowmod: L must be real, square, and sparse") ;
    }

    /* ---------------------------------------------------------------------- */
    /* determine if we're doing an rowadd or rowdel */
    /* ---------------------------------------------------------------------- */

    rowadd = (nargin > 2) ;

    if (rowadd)
    {
        if (!mxIsSparse (pargin [2])
                || n != mxGetM (pargin [2])
                || 1 != mxGetN (pargin [2])
                || mxIsComplex (pargin [2]))
        {
            mexErrMsgTxt ("ldlrowmod: C must be a real sparse vector, "
                "with the same number of rows as LD") ;
        }
    }

    /* ---------------------------------------------------------------------- */
    /* get C: sparse vector of incoming/outgoing column */
    /* ---------------------------------------------------------------------- */

    C = (rowadd) ? sputil_get_sparse (pargin [2], &Cmatrix, &dummy, 0) : NULL ;

    /* ---------------------------------------------------------------------- */
    /* construct a copy of the input sparse matrix L */
    /* ---------------------------------------------------------------------- */

    /* get the MATLAB L */
    Lp = (Long *) mxGetJc (pargin [0]) ;
    Li = (Long *) mxGetIr (pargin [0]) ;
    Lx = mxGetPr (pargin [0]) ;

    /* allocate the CHOLMOD symbolic L */
    L = cholmod_l_allocate_factor (n, cm) ;
    L->ordering = CHOLMOD_NATURAL ;
    ColCount = L->ColCount ;
    for (j = 0 ; j < n ; j++)
    {
	ColCount [j] = Lp [j+1] - Lp [j] ;
    }

    /* allocate space for a CHOLMOD LDL' packed factor */
    cholmod_l_change_factor (CHOLMOD_REAL, FALSE, FALSE, TRUE, TRUE, L, cm) ;

    /* copy MATLAB L into CHOLMOD L */
    Lp2 = L->p ;
    Li2 = L->i ;
    Lx2 = L->x ;
    Lnz2 = L->nz ;
    lnz = L->nzmax ;
    for (j = 0 ; j <= n ; j++)
    {
	Lp2 [j] = Lp [j] ;
    }
    for (j = 0 ; j < n ; j++)
    {
	Lnz2 [j] = Lp [j+1] - Lp [j] ;
    }
    for (s = 0 ; s < lnz ; s++)
    {
	Li2 [s] = Li [s] ;
    }
    for (s = 0 ; s < lnz ; s++)
    {
	Lx2 [s] = Lx [s] ;
    }

    /* ---------------------------------------------------------------------- */
    /* rowadd/rowdel the LDL' factorization */
    /* ---------------------------------------------------------------------- */

    if (rowadd)
    {
        ok = cholmod_l_rowadd (k, C, L, cm) ;
    }
    else
    {
        ok = cholmod_l_rowdel (k, NULL, L, cm) ;
    }
    if (!ok) mexErrMsgTxt ("ldlrowmod failed\n") ;

    /* ---------------------------------------------------------------------- */
    /* copy the results back to MATLAB */
    /* ---------------------------------------------------------------------- */

    /* change L back to packed LDL' (it may have become unpacked if the
     * sparsity pattern changed).  This change takes O(n) time if the pattern
     * of L wasn't updated. */
    Lsparse = cholmod_l_factor_to_sparse (L, cm) ;

    /* return L as a sparse matrix */
    pargout [0] = sputil_put_sparse (&Lsparse, cm) ;

    /* ---------------------------------------------------------------------- */
    /* free workspace and the CHOLMOD L, except for what is copied to MATLAB */
    /* ---------------------------------------------------------------------- */

    cholmod_l_free_factor (&L, cm) ;
    cholmod_l_finish (cm) ;
    cholmod_l_print_common (" ", cm) ;
    /*
    if (cm->malloc_count != 3 + mxIsComplex (pargout[0])) mexErrMsgTxt ("!") ;
    */
}
Exemplo n.º 14
0
void mexFunction
(
    int nargout,
    mxArray *pargout [ ],
    int nargin,
    const mxArray *pargin [ ]
)
{
    double dummy = 0 ;
    cholmod_sparse Amatrix, Zmatrix, *A, *Z ;
    cholmod_dense Xmatrix, *X ;
    cholmod_common Common, *cm ;
    Int arg_z, arg_comments, sym ;
    char filename [MAXLEN], comments [MAXLEN] ;

    /* ---------------------------------------------------------------------- */
    /* start CHOLMOD and set parameters */ 
    /* ---------------------------------------------------------------------- */

    cm = &Common ;
    cholmod_l_start (cm) ;
    sputil_config (SPUMONI, cm) ;

    /* ---------------------------------------------------------------------- */
    /* check inputs */
    /* ---------------------------------------------------------------------- */

    if (nargin < 2 || nargin > 4 || nargout > 1)
    {
	mexErrMsgTxt ("Usage: mwrite (filename, A, Z, comments_filename)") ;
    }

    /* ---------------------------------------------------------------------- */
    /* get the output filename */
    /* ---------------------------------------------------------------------- */

    if (!mxIsChar (pargin [0]))
    {
	mexErrMsgTxt ("first parameter must be a filename") ;
    }
    mxGetString (pargin [0], filename, MAXLEN) ;

    /* ---------------------------------------------------------------------- */
    /* get the A matrix (sparse or dense) */
    /* ---------------------------------------------------------------------- */

    if (mxIsSparse (pargin [1]))
    {
	A = sputil_get_sparse (pargin [1], &Amatrix, &dummy, 0) ;
	X = NULL ;
    }
    else
    {
	X = sputil_get_dense (pargin [1], &Xmatrix, &dummy) ;
	A = NULL ;
    }

    /* ---------------------------------------------------------------------- */
    /* determine if the Z matrix and comments_file are present */
    /* ---------------------------------------------------------------------- */

    if (nargin == 3)
    {
	if (mxIsChar (pargin [2]))
	{
	    /* mwrite (file, A, comments) */
	    arg_z = -1 ;
	    arg_comments = 2 ;
	}
	else
	{
	    /* mwrite (file, A, Z).  Ignore Z if A is full */
	    arg_z = (A == NULL) ? -1 : 2 ;
	    arg_comments = -1 ;
	}
    }
    else if (nargin == 4)
    {
	/* mwrite (file, A, Z, comments).  Ignore Z is A is full */
	arg_z = (A == NULL) ? -1 : 2 ;
	arg_comments = 3 ;
    }
    else
    {
	arg_z = -1 ;
	arg_comments = -1 ;
    }

    /* ---------------------------------------------------------------------- */
    /* get the Z matrix */
    /* ---------------------------------------------------------------------- */

    if (arg_z == -1 ||
	mxGetM (pargin [arg_z]) == 0 || mxGetN (pargin [arg_z]) == 0)
    {
	/* A is dense, Z is not present, or Z is empty.  Ignore Z. */
	Z = NULL ;
    }
    else
    {
	/* A is sparse and Z is present and not empty */
	if (!mxIsSparse (pargin [arg_z]))
	{
	    mexErrMsgTxt ("Z must be sparse") ;
	}
	Z = sputil_get_sparse (pargin [arg_z], &Zmatrix, &dummy, 0) ;
    }

    /* ---------------------------------------------------------------------- */
    /* get the comments filename */
    /* ---------------------------------------------------------------------- */

    comments [0] = '\0' ;
    if (arg_comments != -1)
    {
	if (!mxIsChar (pargin [arg_comments]))
	{
	    mexErrMsgTxt ("comments filename must be a string") ;
	}
	mxGetString (pargin [arg_comments], comments, MAXLEN) ;
    }

    /* ---------------------------------------------------------------------- */
    /* write the matrix to the file */
    /* ---------------------------------------------------------------------- */

    sputil_file = fopen (filename, "w") ;
    if (sputil_file == NULL)
    {
	mexErrMsgTxt ("error opening file") ;
    }
    if (A != NULL)
    {
	sym = cholmod_l_write_sparse (sputil_file, A, Z, comments, cm) ;
    }
    else
    {
	sym = cholmod_l_write_dense (sputil_file, X, comments, cm) ;
    }
    fclose (sputil_file) ;
    sputil_file = NULL ;
    if (sym < 0)
    {
	mexErrMsgTxt ("mwrite failed") ;
    }

    /* ---------------------------------------------------------------------- */
    /* free workspace and return symmetry */
    /* ---------------------------------------------------------------------- */

    pargout [0] = sputil_put_int (&sym, 1, 0) ;
    cholmod_l_finish (cm) ;
    cholmod_l_print_common (" ", cm) ;
}
Exemplo n.º 15
0
void mexFunction
(
    int nargout,
    mxArray *pargout [ ],
    int nargin,
    const mxArray *pargin [ ]
)
{
    double dummy = 0 ;
    Long *Parent ;
    cholmod_sparse *A, Amatrix, *S ;
    cholmod_common Common, *cm ;
    Long n, coletree, c ;
    char buf [LEN] ;

    /* ---------------------------------------------------------------------- */
    /* start CHOLMOD and set defaults */
    /* ---------------------------------------------------------------------- */

    cm = &Common ;
    cholmod_l_start (cm) ;
    sputil_config (SPUMONI, cm) ;

    /* ---------------------------------------------------------------------- */
    /* get inputs */
    /* ---------------------------------------------------------------------- */

    if (nargout > 2 || nargin < 1 || nargin > 2)
    {
	mexErrMsgTxt ("Usage: [parent post] = etree2 (A, mode)") ;
    }

    /* ---------------------------------------------------------------------- */
    /* get input matrix A */
    /* ---------------------------------------------------------------------- */

    A = sputil_get_sparse_pattern (pargin [0], &Amatrix, &dummy, cm) ;
    S = (A == &Amatrix) ? NULL : A ;

    /* ---------------------------------------------------------------------- */
    /* get A->stype, default is to use triu(A) */
    /* ---------------------------------------------------------------------- */

    A->stype = 1 ;
    n = A->nrow ;
    coletree = FALSE ;
    if (nargin > 1)
    {
	buf [0] = '\0' ;
	if (mxIsChar (pargin [1]))
	{
	    mxGetString (pargin [1], buf, LEN) ;
	}
	c = buf [0] ;
	if (tolower (c) == 'r')
	{
	    /* unsymmetric case (A*A') if string starts with 'r' */
	    A->stype = 0 ;
	}
	else if (tolower (c) == 'c')
	{
	    /* unsymmetric case (A'*A) if string starts with 'c' */
	    n = A->ncol ;
	    coletree = TRUE ;
	    A->stype = 0 ;
	}
	else if (tolower (c) == 's')
	{
	    /* symmetric upper case (A) if string starts with 's' */
	    A->stype = 1 ;
	}
	else if (tolower (c) == 'l')
	{
	    /* symmetric lower case (A) if string starts with 'l' */
	    A->stype = -1 ;
	}
	else
	{
	    mexErrMsgTxt ("etree2: unrecognized mode") ;
	}
    }

    if (A->stype && A->nrow != A->ncol)
    {
	mexErrMsgTxt ("etree2: A must be square") ;
    }

    /* ---------------------------------------------------------------------- */
    /* compute the etree */
    /* ---------------------------------------------------------------------- */

    Parent = cholmod_l_malloc (n, sizeof (Long), cm) ;
    if (A->stype == 1 || coletree)
    {
	/* symmetric case: find etree of A, using triu(A) */
	/* column case: find column etree of A, which is etree of A'*A */
	cholmod_l_etree (A, Parent, cm) ;
    }
    else
    {
	/* symmetric case: find etree of A, using tril(A) */
	/* row case: find row etree of A, which is etree of A*A' */
	/* R = A' */
	cholmod_sparse *R ;
	R = cholmod_l_transpose (A, 0, cm) ;
	cholmod_l_etree (R, Parent, cm) ;
	cholmod_l_free_sparse (&R, cm) ;
    }

    if (cm->status < CHOLMOD_OK)
    {
	/* out of memory or matrix invalid */
	mexErrMsgTxt ("etree2 failed: matrix corrupted!") ;
    }

    /* ---------------------------------------------------------------------- */
    /* return Parent to MATLAB */
    /* ---------------------------------------------------------------------- */

    pargout [0] = sputil_put_int (Parent, n, 1) ;

    /* ---------------------------------------------------------------------- */
    /* postorder the tree and return results to MATLAB */
    /* ---------------------------------------------------------------------- */

    if (nargout > 1)
    {
	Long *Post ;
	Post = cholmod_l_malloc (n, sizeof (Long), cm) ;
	if (cholmod_l_postorder (Parent, n, NULL, Post, cm) != n)
	{
	    /* out of memory or Parent invalid */
	    mexErrMsgTxt ("etree2 postorder failed!") ;
	}
	pargout [1] = sputil_put_int (Post, n, 1) ;
	cholmod_l_free (n, sizeof (Long), Post, cm) ;
    }

    /* ---------------------------------------------------------------------- */
    /* free workspace */
    /* ---------------------------------------------------------------------- */

    cholmod_l_free (n, sizeof (Long), Parent, cm) ;
    cholmod_l_free_sparse (&S, cm) ;
    cholmod_l_finish (cm) ;
    cholmod_l_print_common (" ", cm) ;
    /* if (cm->malloc_count != 0) mexErrMsgTxt ("!") ; */
}
Exemplo n.º 16
0
void mexFunction
(
    int	nargout,
    mxArray *pargout [ ],
    int	nargin,
    const mxArray *pargin [ ]
)
{
    double dummy = 0, rcond, *p ;
    cholmod_sparse Amatrix, Bspmatrix, *A, *Bs, *Xs ;
    cholmod_dense Bmatrix, *X, *B ;
    cholmod_factor *L ;
    cholmod_common Common, *cm ;
    Int n, B_is_sparse, ordering, k, *Perm ;

    /* ---------------------------------------------------------------------- */
    /* start CHOLMOD and set parameters */ 
    /* ---------------------------------------------------------------------- */

    cm = &Common ;
    cholmod_l_start (cm) ;
    sputil_config (SPUMONI, cm) ;

    /* There is no supernodal LDL'.  If cm->final_ll = FALSE (the default), then
     * this mexFunction will use a simplicial LDL' when flops/lnz < 40, and a
     * supernodal LL' otherwise.  This may give suprising results to the MATLAB
     * user, so always perform an LL' factorization by setting cm->final_ll
     * to TRUE. */

    cm->final_ll = TRUE ;
    cm->quick_return_if_not_posdef = TRUE ;

    /* ---------------------------------------------------------------------- */
    /* get inputs */
    /* ---------------------------------------------------------------------- */

    if (nargout > 2 || nargin < 2 || nargin > 3)
    {
	mexErrMsgTxt ("usage: [x,rcond] = cholmod2 (A,b,ordering)") ;
    }
    n = mxGetM (pargin [0]) ;
    if (!mxIsSparse (pargin [0]) || (n != mxGetN (pargin [0])))
    {
    	mexErrMsgTxt ("A must be square and sparse") ;
    }
    if (n != mxGetM (pargin [1]))
    {
    	mexErrMsgTxt ("# of rows of A and B must match") ;
    }

    /* get sparse matrix A.  Use triu(A) only. */
    A = sputil_get_sparse (pargin [0], &Amatrix, &dummy, 1) ;

    /* get sparse or dense matrix B */
    B = NULL ;
    Bs = NULL ;
    B_is_sparse = mxIsSparse (pargin [1]) ;
    if (B_is_sparse)
    {
	/* get sparse matrix B (unsymmetric) */
	Bs = sputil_get_sparse (pargin [1], &Bspmatrix, &dummy, 0) ;
    }
    else
    {
	/* get dense matrix B */
	B = sputil_get_dense (pargin [1], &Bmatrix, &dummy) ;
    }

    /* get the ordering option */
    if (nargin < 3)
    {
	/* use default ordering */
	ordering = -1 ;
    }
    else
    {
	/* use a non-default option */
	ordering = mxGetScalar (pargin [2]) ;
    }

    p = NULL ;
    Perm = NULL ;

    if (ordering == 0)
    {
	/* natural ordering */
	cm->nmethods = 1 ;
	cm->method [0].ordering = CHOLMOD_NATURAL ;
	cm->postorder = FALSE ;
    }
    else if (ordering == -1)
    {
	/* default strategy ... nothing to change */
    }
    else if (ordering == -2)
    {
	/* default strategy, but with NESDIS in place of METIS */
	cm->default_nesdis = TRUE ;
    }
    else if (ordering == -3)
    {
	/* use AMD only */
	cm->nmethods = 1 ;
	cm->method [0].ordering = CHOLMOD_AMD ;
	cm->postorder = TRUE ;
    }
    else if (ordering == -4)
    {
	/* use METIS only */
	cm->nmethods = 1 ;
	cm->method [0].ordering = CHOLMOD_METIS ;
	cm->postorder = TRUE ;
    }
    else if (ordering == -5)
    {
	/* use NESDIS only */
	cm->nmethods = 1 ;
	cm->method [0].ordering = CHOLMOD_NESDIS ;
	cm->postorder = TRUE ;
    }
    else if (ordering == -6)
    {
	/* natural ordering, but with etree postordering */
	cm->nmethods = 1 ;
	cm->method [0].ordering = CHOLMOD_NATURAL ;
	cm->postorder = TRUE ;
    }
    else if (ordering == -7)
    {
	/* always try both AMD and METIS, and pick the best */
	cm->nmethods = 2 ;
	cm->method [0].ordering = CHOLMOD_AMD ;
	cm->method [1].ordering = CHOLMOD_METIS ;
	cm->postorder = TRUE ;
    }
    else if (ordering >= 1)
    {
	/* assume the 3rd argument is a user-provided permutation of 1:n */
	if (mxGetNumberOfElements (pargin [2]) != n)
	{
	    mexErrMsgTxt ("invalid input permutation") ;
	}
	/* copy from double to integer, and convert to 0-based */
	p = mxGetPr (pargin [2]) ;
	Perm = cholmod_l_malloc (n, sizeof (Int), cm) ;
	for (k = 0 ; k < n ; k++)
	{
	    Perm [k] = p [k] - 1 ;
	}
	/* check the permutation */
	if (!cholmod_l_check_perm (Perm, n, n, cm))
	{
	    mexErrMsgTxt ("invalid input permutation") ;
	}
	/* use only the given permutation */
	cm->nmethods = 1 ;
	cm->method [0].ordering = CHOLMOD_GIVEN ;
	cm->postorder = FALSE ;
    }
    else
    {
	mexErrMsgTxt ("invalid ordering option") ;
    }

    /* ---------------------------------------------------------------------- */
    /* analyze and factorize */
    /* ---------------------------------------------------------------------- */

    L = cholmod_l_analyze_p (A, Perm, NULL, 0, cm) ;
    cholmod_l_free (n, sizeof (Int), Perm, cm) ;
    cholmod_l_factorize (A, L, cm) ;

    rcond = cholmod_l_rcond (L, cm) ;

    if (rcond == 0)
    {
	mexWarnMsgTxt ("Matrix is indefinite or singular to working precision");
    }
    else if (rcond < DBL_EPSILON)
    {
	mexWarnMsgTxt ("Matrix is close to singular or badly scaled.") ;
	mexPrintf ("         Results may be inaccurate. RCOND = %g.\n", rcond) ;
    }

    /* ---------------------------------------------------------------------- */
    /* solve and return solution to MATLAB */
    /* ---------------------------------------------------------------------- */

    if (B_is_sparse)
    {
	/* solve AX=B with sparse X and B; return sparse X to MATLAB */
	Xs = cholmod_l_spsolve (CHOLMOD_A, L, Bs, cm) ;
	pargout [0] = sputil_put_sparse (&Xs, cm) ;
    }
    else
    {
	/* solve AX=B with dense X and B; return dense X to MATLAB */
	X = cholmod_l_solve (CHOLMOD_A, L, B, cm) ;
	pargout [0] = sputil_put_dense (&X, cm) ;
    }

    /* return statistics, if requested */
    if (nargout > 1)
    {
	pargout [1] = mxCreateDoubleMatrix (1, 5, mxREAL) ;
	p = mxGetPr (pargout [1]) ;
	p [0] = rcond ;
	p [1] = L->ordering ;
	p [2] = cm->lnz ;
	p [3] = cm->fl ;
	p [4] = cm->memory_usage / 1048576. ;
    }

    cholmod_l_free_factor (&L, cm) ;
    cholmod_l_finish (cm) ;
    cholmod_l_print_common (" ", cm) ;
    /*
    if (cm->malloc_count !=
	(mxIsComplex (pargout [0]) + (mxIsSparse (pargout[0]) ? 3:1)))
	mexErrMsgTxt ("memory leak!") ;
    */
}