template <typename Entry> void free_Work ( spqr_work <Entry> *Work, Long ns, // number of stacks Long n, // number of columns of A Long maxfn, // largest number of columns in any front Long wtsize, // size of WTwork array for each Stack cholmod_common *cc ) { if (Work != NULL) { for (Long stack = 0 ; stack < ns ; stack++) { cholmod_l_free (n, sizeof (Long), Work [stack].Fmap, cc) ; cholmod_l_free (maxfn, sizeof (Long), Work [stack].Cmap, cc) ; cholmod_l_free (maxfn, sizeof (Long), Work [stack].Stair1, cc) ; cholmod_l_free (wtsize, sizeof (Entry), Work [stack].WTwork, cc) ; Work [stack].Fmap = NULL ; Work [stack].Cmap = NULL ; Work [stack].Stair1 = NULL ; Work [stack].WTwork = NULL ; } } }
static int put_values ( Long nz, mxArray *A, double *Ax, // complex case: size 2*nz and freed on return, // real case: size nz, not freed on return. Long is_complex, cholmod_common *cc ) { Long imag_all_zero = TRUE ; if (is_complex) { // A is complex, stored in interleaved form; split it for MATLAB Long k ; double z, *Ax2, *Az2 ; mxFree (mxGetPi (A)) ; Ax2 = (double *) cholmod_l_malloc (nz, sizeof (double), cc) ; Az2 = (double *) cholmod_l_malloc (nz, sizeof (double), cc) ; for (k = 0 ; k < nz ; k++) { Ax2 [k] = Ax [2*k] ; z = Ax [2*k+1] ; if (z != 0) { imag_all_zero = FALSE ; } Az2 [k] = z ; } mxSetPr (A, Ax2) ; if (imag_all_zero) { // free the imaginary part, converting A to real cholmod_l_free (nz, sizeof (double), Az2, cc) ; Az2 = NULL ; } mxSetPi (A, Az2) ; // NOTE: the input Ax is freed cholmod_l_free (nz, sizeof (Complex), Ax, cc) ; } else { // A is real; just set Ax and return (do not free Ax) mxSetPr (A, Ax) ; } return (TRUE) ; }
template <typename Entry> spqr_work <Entry> *get_Work ( Long ns, // number of stacks Long n, // number of columns of A Long maxfn, // largest number of columns in any front Long keepH, // if true, H is kept Long fchunk, Long *p_wtsize, // size of WTwork for each cholmod_common *cc ) { int ok = TRUE ; spqr_work <Entry> *Work ; Long wtsize ; *p_wtsize = 0 ; // wtsize = (fchunk + (keepH ? 0:1)) * maxfn ; wtsize = spqr_mult (fchunk + (keepH ? 0:1), maxfn, &ok) ; Work = (spqr_work <Entry> *) cholmod_l_malloc (ns, sizeof (spqr_work <Entry>), cc) ; if (!ok || cc->status < CHOLMOD_OK) { // out of memory or Long overflow cholmod_l_free (ns, sizeof (spqr_work <Entry>), Work, cc) ; ERROR (CHOLMOD_OUT_OF_MEMORY, "out of memory") ; return (NULL) ; } for (Long stack = 0 ; stack < ns ; stack++) { Work [stack].Fmap = (Long *) cholmod_l_malloc (n, sizeof (Long), cc) ; Work [stack].Cmap = (Long *) cholmod_l_malloc (maxfn, sizeof(Long), cc); if (keepH) { // Staircase is a permanent part of H Work [stack].Stair1 = NULL ; } else { // Staircase workspace reused for each front Work [stack].Stair1 = (Long *) cholmod_l_malloc (maxfn, sizeof (Long), cc) ; } Work [stack].WTwork = (Entry *) cholmod_l_malloc (wtsize, sizeof (Entry), cc) ; Work [stack].sumfrank = 0 ; Work [stack].maxfrank = 0 ; Work [stack].wscale = 0 ; Work [stack].wssq = 0 ; } *p_wtsize = wtsize ; return (Work) ; }
template <typename Entry> int spqr_1colamd // TRUE if OK, FALSE otherwise ( // inputs, not modified int ordering, // all available, except 0:fixed and 3:given // treated as 1:natural double tol, // only accept singletons above tol Long bncols, // number of columns of B cholmod_sparse *A, // m-by-n sparse matrix // outputs, neither allocated nor defined on input Long **p_Q1fill, // size n+bncols, fill-reducing // or natural ordering Long **p_R1p, // size n1rows+1, R1p [k] = # of nonzeros in kth // row of R1. NULL if n1cols == 0. Long **p_P1inv, // size m, singleton row inverse permutation. // If row i of A is the kth singleton row, then // P1inv [i] = k. NULL if n1cols is zero. cholmod_sparse **p_Y, // on output, only the first n-n1cols+1 entries of // Y->p are defined (if Y is not NULL), where // Y = [A B] or Y = [A2 B2]. If B is empty and // there are no column singletons, Y is NULL Long *p_n1cols, // number of column singletons found Long *p_n1rows, // number of corresponding rows found // workspace and parameters cholmod_common *cc ) { Long *Q1fill, *Degree, *Qrows, *W, *Winv, *ATp, *ATj, *R1p, *P1inv, *Yp, *Ap, *Ai, *Work ; Entry *Ax ; Long p, d, j, i, k, n1cols, n1rows, row, col, pend, n2rows, n2cols = EMPTY, nz2, kk, p2, col2, ynz, fill_reducing_ordering, m, n, xtype, worksize ; cholmod_sparse *AT, *Y ; // ------------------------------------------------------------------------- // get inputs // ------------------------------------------------------------------------- xtype = spqr_type <Entry> ( ) ; m = A->nrow ; n = A->ncol ; Ap = (Long *) A->p ; Ai = (Long *) A->i ; Ax = (Entry *) A->x ; // set outputs to NULL in case of early return *p_Q1fill = NULL ; *p_R1p = NULL ; *p_P1inv = NULL ; *p_Y = NULL ; *p_n1cols = EMPTY ; *p_n1rows = EMPTY ; // ------------------------------------------------------------------------- // allocate result Q1fill (Y, R1p, P1inv allocated later) // ------------------------------------------------------------------------- Q1fill = (Long *) cholmod_l_malloc (n+bncols, sizeof (Long), cc) ; // ------------------------------------------------------------------------- // allocate workspace // ------------------------------------------------------------------------- fill_reducing_ordering = ! ((ordering == SPQR_ORDERING_FIXED) || (ordering == SPQR_ORDERING_GIVEN) || (ordering == SPQR_ORDERING_NATURAL)) ; worksize = ((fill_reducing_ordering) ? 3:2) * n ; Work = (Long *) cholmod_l_malloc (worksize, sizeof (Long), cc) ; Degree = Work ; // size n Qrows = Work + n ; // size n Winv = Qrows ; // Winv and Qrows not needed at the same time W = Qrows + n ; // size n if fill-reducing ordering, else size 0 if (cc->status < CHOLMOD_OK) { // out of memory; free everything and return cholmod_l_free (worksize, sizeof (Long), Work, cc) ; cholmod_l_free (n+bncols, sizeof (Long), Q1fill, cc) ; return (FALSE) ; } // ------------------------------------------------------------------------- // initialze queue with empty columns, and columns with just one entry // ------------------------------------------------------------------------- n1cols = 0 ; n1rows = 0 ; for (j = 0 ; j < n ; j++) { p = Ap [j] ; d = Ap [j+1] - p ; if (d == 0) { // j is a dead column singleton PR (("initial dead %ld\n", j)) ; Q1fill [n1cols] = j ; Qrows [n1cols] = EMPTY ; n1cols++ ; Degree [j] = EMPTY ; } else if (d == 1 && spqr_abs (Ax [p], cc) > tol) { // j is a column singleton, live or dead PR (("initial live %ld %ld\n", j, Ai [p])) ; Q1fill [n1cols] = j ; Qrows [n1cols] = Ai [p] ; // this might be a duplicate n1cols++ ; Degree [j] = EMPTY ; } else { // j has degree > 1, it is not (yet) a singleton Degree [j] = d ; } } // Degree [j] = EMPTY if j is in the singleton queue, or the Degree [j] > 1 // is the degree of column j otherwise // ------------------------------------------------------------------------- // create AT = spones (A') // ------------------------------------------------------------------------- AT = cholmod_l_transpose (A, 0, cc) ; // [ if (cc->status < CHOLMOD_OK) { // out of memory; free everything and return cholmod_l_free (worksize, sizeof (Long), Work, cc) ; cholmod_l_free (n+bncols, sizeof (Long), Q1fill, cc) ; return (FALSE) ; } ATp = (Long *) AT->p ; ATj = (Long *) AT->i ; // ------------------------------------------------------------------------- // remove column singletons via breadth-first-search // ------------------------------------------------------------------------- for (k = 0 ; k < n1cols ; k++) { // --------------------------------------------------------------------- // get a new singleton from the queue // --------------------------------------------------------------------- col = Q1fill [k] ; row = Qrows [k] ; PR (("\n---- singleton col %ld row %ld\n", col, row)) ; ASSERT (Degree [col] == EMPTY) ; if (row == EMPTY || ATp [row] < 0) { // ----------------------------------------------------------------- // col is a dead column singleton; remove duplicate row index // ----------------------------------------------------------------- Qrows [k] = EMPTY ; row = EMPTY ; PR (("dead: %ld\n", col)) ; } else { // ----------------------------------------------------------------- // col is a live col singleton; remove its row from matrix // ----------------------------------------------------------------- n1rows++ ; p = ATp [row] ; ATp [row] = FLIP (p) ; // flag the singleton row pend = UNFLIP (ATp [row+1]) ; PR (("live: %ld row %ld\n", col, row)) ; for ( ; p < pend ; p++) { // look for new column singletons after row is removed j = ATj [p] ; d = Degree [j] ; if (d == EMPTY) { // j is already in the singleton queue continue ; } ASSERT (d >= 1) ; ASSERT2 (spqrDebug_listcount (j, Q1fill, n1cols, 0) == 0) ; d-- ; Degree [j] = d ; if (d == 0) { // a new dead col singleton PR (("newly dead %ld\n", j)) ; Q1fill [n1cols] = j ; Qrows [n1cols] = EMPTY ; n1cols++ ; Degree [j] = EMPTY ; } else if (d == 1) { // a new live col singleton; find its single live row for (p2 = Ap [j] ; p2 < Ap [j+1] ; p2++) { i = Ai [p2] ; if (ATp [i] >= 0 && spqr_abs (Ax [p2], cc) > tol) { // i might appear in Qrows [k+1:n1cols-1] PR (("newly live %ld\n", j)) ; ASSERT2 (spqrDebug_listcount (i,Qrows,k+1,1) == 0) ; Q1fill [n1cols] = j ; Qrows [n1cols] = i ; n1cols++ ; Degree [j] = EMPTY ; break ; } } } } } // Q1fill [0:k] and Qrows [0:k] have no duplicates ASSERT2 (spqrDebug_listcount (col, Q1fill, n1cols, 0) == 1) ; ASSERT2 (IMPLIES (row >= 0, spqrDebug_listcount (row, Qrows, k+1, 1) == 1)) ; } // ------------------------------------------------------------------------- // Degree flags the column singletons, ATp flags their rows // ------------------------------------------------------------------------- #ifndef NDEBUG k = 0 ; for (j = 0 ; j < n ; j++) { PR (("j %ld Degree[j] %ld\n", j, Degree [j])) ; if (Degree [j] > 0) k++ ; // j is not a column singleton } PR (("k %ld n %ld n1cols %ld\n", k, n, n1cols)) ; ASSERT (k == n - n1cols) ; for (k = 0 ; k < n1cols ; k++) { col = Q1fill [k] ; ASSERT (Degree [col] <= 0) ; } k = 0 ; for (i = 0 ; i < m ; i++) { if (ATp [i] >= 0) k++ ; // i is not a row of a col singleton } ASSERT (k == m - n1rows) ; for (k = 0 ; k < n1cols ; k++) { row = Qrows [k] ; ASSERT (IMPLIES (row != EMPTY, ATp [row] < 0)) ; } #endif // ------------------------------------------------------------------------- // find the row ordering // ------------------------------------------------------------------------- if (n1cols == 0) { // --------------------------------------------------------------------- // no singletons in the matrix; no R1 matrix, no P1inv permutation // --------------------------------------------------------------------- ASSERT (n1rows == 0) ; R1p = NULL ; P1inv = NULL ; } else { // --------------------------------------------------------------------- // construct the row singleton permutation // --------------------------------------------------------------------- // allocate result arrays R1p and P1inv R1p = (Long *) cholmod_l_malloc (n1rows+1, sizeof (Long), cc) ; P1inv = (Long *) cholmod_l_malloc (m, sizeof (Long), cc) ; if (cc->status < CHOLMOD_OK) { // out of memory; free everything and return cholmod_l_free_sparse (&AT, cc) ; cholmod_l_free (worksize, sizeof (Long), Work, cc) ; cholmod_l_free (n+bncols, sizeof (Long), Q1fill, cc) ; cholmod_l_free (n1rows+1, sizeof (Long), R1p, cc) ; cholmod_l_free (m, sizeof (Long), P1inv, cc) ; return (FALSE) ; } #ifndef NDEBUG for (i = 0 ; i < m ; i++) P1inv [i] = EMPTY ; #endif kk = 0 ; for (k = 0 ; k < n1cols ; k++) { i = Qrows [k] ; PR (("singleton col %ld row %ld\n", Q1fill [k], i)) ; if (i != EMPTY) { // row i is the kk-th singleton row ASSERT (ATp [i] < 0) ; ASSERT (P1inv [i] == EMPTY) ; P1inv [i] = kk ; // also find # of entries in row kk of R1 R1p [kk] = UNFLIP (ATp [i+1]) - UNFLIP (ATp [i]) ; kk++ ; } } ASSERT (kk == n1rows) ; for (i = 0 ; i < m ; i++) { if (ATp [i] >= 0) { // row i is not a singleton row ASSERT (P1inv [i] == EMPTY) ; P1inv [i] = kk ; kk++ ; } } ASSERT (kk == m) ; } // Qrows is no longer needed. // ------------------------------------------------------------------------- // complete the column ordering // ------------------------------------------------------------------------- if (!fill_reducing_ordering) { // --------------------------------------------------------------------- // natural ordering // --------------------------------------------------------------------- if (n1cols == 0) { // no singletons, so natural ordering is 0:n-1 for now for (k = 0 ; k < n ; k++) { Q1fill [k] = k ; } } else { // singleton columns appear first, then non column singletons k = n1cols ; for (j = 0 ; j < n ; j++) { if (Degree [j] > 0) { // column j is not a column singleton Q1fill [k++] = j ; } } ASSERT (k == n) ; } } else { // --------------------------------------------------------------------- // fill-reducing ordering of pruned submatrix // --------------------------------------------------------------------- if (n1cols == 0) { // ----------------------------------------------------------------- // no singletons found; do fill-reducing on entire matrix // ----------------------------------------------------------------- n2cols = n ; n2rows = m ; } else { // ----------------------------------------------------------------- // create the pruned matrix for fill-reducing by removing singletons // ----------------------------------------------------------------- // find the mapping of original columns to pruned columns n2cols = 0 ; for (j = 0 ; j < n ; j++) { if (Degree [j] > 0) { // column j is not a column singleton W [j] = n2cols++ ; PR (("W [%ld] = %ld\n", j, W [j])) ; } else { // column j is a column singleton W [j] = EMPTY ; PR (("W [%ld] = %ld (j is col singleton)\n", j, W [j])) ; } } ASSERT (n2cols == n - n1cols) ; // W is now a mapping of the original columns to the columns in the // pruned matrix. W [col] == EMPTY if col is a column singleton. // Otherwise col2 = W [j] is a column of the pruned matrix. // ----------------------------------------------------------------- // delete row and column singletons from A' // ----------------------------------------------------------------- // compact A' by removing row and column singletons nz2 = 0 ; n2rows = 0 ; for (i = 0 ; i < m ; i++) { p = ATp [i] ; if (p >= 0) { // row i is not a row of a column singleton ATp [n2rows++] = nz2 ; pend = UNFLIP (ATp [i+1]) ; for (p = ATp [i] ; p < pend ; p++) { j = ATj [p] ; ASSERT (W [j] >= 0 && W [j] < n-n1cols) ; ATj [nz2++] = W [j] ; } } } ATp [n2rows] = nz2 ; ASSERT (n2rows == m - n1rows) ; } // --------------------------------------------------------------------- // fill-reducing ordering of the transpose of the pruned A' matrix // --------------------------------------------------------------------- PR (("n1cols %ld n1rows %ld n2cols %ld n2rows %ld\n", n1cols, n1rows, n2cols, n2rows)) ; ASSERT ((Long) AT->nrow == n) ; ASSERT ((Long) AT->ncol == m) ; AT->nrow = n2cols ; AT->ncol = n2rows ; // save the current CHOLMOD settings Long save [6] ; save [0] = cc->supernodal ; save [1] = cc->nmethods ; save [2] = cc->postorder ; save [3] = cc->method [0].ordering ; save [4] = cc->method [1].ordering ; save [5] = cc->method [2].ordering ; // follow the ordering with a postordering of the column etree cc->postorder = TRUE ; // 8:best: best of COLAMD(A), AMD(A'A), and METIS (if available) if (ordering == SPQR_ORDERING_BEST) { ordering = SPQR_ORDERING_CHOLMOD ; cc->nmethods = 2 ; cc->method [0].ordering = CHOLMOD_COLAMD ; cc->method [1].ordering = CHOLMOD_AMD ; #ifndef NPARTITION cc->nmethods = 3 ; cc->method [2].ordering = CHOLMOD_METIS ; #endif } // 9:bestamd: best of COLAMD(A) and AMD(A'A) if (ordering == SPQR_ORDERING_BESTAMD) { // if METIS is not installed, this option is the same as 8:best ordering = SPQR_ORDERING_CHOLMOD ; cc->nmethods = 2 ; cc->method [0].ordering = CHOLMOD_COLAMD ; cc->method [1].ordering = CHOLMOD_AMD ; } #ifdef NPARTITION if (ordering == SPQR_ORDERING_METIS) { // METIS not installed; use default ordering ordering = SPQR_ORDERING_DEFAULT ; } #endif if (ordering == SPQR_ORDERING_DEFAULT) { // Version 1.2.0: just use COLAMD ordering = SPQR_ORDERING_COLAMD ; #if 0 // Version 1.1.2 and earlier: if (n2rows <= 2*n2cols) { // just use COLAMD; do not try AMD or METIS ordering = SPQR_ORDERING_COLAMD ; } else { #ifndef NPARTITION // use CHOLMOD's default ordering: try AMD and then METIS // if AMD gives high fill-in, and take the best ordering found ordering = SPQR_ORDERING_CHOLMOD ; cc->nmethods = 0 ; #else // METIS is not installed, so just use AMD ordering = SPQR_ORDERING_AMD ; #endif } #endif } if (ordering == SPQR_ORDERING_AMD) { // use CHOLMOD's interface to AMD to order A'*A cholmod_l_amd (AT, NULL, 0, (Long *) (Q1fill + n1cols), cc) ; } #ifndef NPARTITION else if (ordering == SPQR_ORDERING_METIS) { // use CHOLMOD's interface to METIS to order A'*A (if installed) cholmod_l_metis (AT, NULL, 0, TRUE, (Long *) (Q1fill + n1cols), cc) ; } #endif else if (ordering == SPQR_ORDERING_CHOLMOD) { // use CHOLMOD's internal ordering (defined by cc) to order AT PR (("Using CHOLMOD, nmethods %d\n", cc->nmethods)) ; cc->supernodal = CHOLMOD_SIMPLICIAL ; cc->postorder = TRUE ; cholmod_factor *Sc ; Sc = cholmod_l_analyze_p2 (FALSE, AT, NULL, NULL, 0, cc) ; if (Sc != NULL) { // copy perm from Sc->Perm [0:n2cols-1] to Q1fill (n1cols:n) Long *Sc_perm = (Long *) Sc->Perm ; for (k = 0 ; k < n2cols ; k++) { Q1fill [k + n1cols] = Sc_perm [k] ; } // CHOLMOD selected an ordering; determine the ordering used switch (Sc->ordering) { case CHOLMOD_AMD: ordering = SPQR_ORDERING_AMD ;break; case CHOLMOD_COLAMD: ordering = SPQR_ORDERING_COLAMD ;break; case CHOLMOD_METIS: ordering = SPQR_ORDERING_METIS ;break; } } cholmod_l_free_factor (&Sc, cc) ; PR (("CHOLMOD used method %d : ordering: %d\n", cc->selected, cc->method [cc->selected].ordering)) ; } else // SPQR_ORDERING_DEFAULT or SPQR_ORDERING_COLAMD { // use CHOLMOD's interface to COLAMD to order AT ordering = SPQR_ORDERING_COLAMD ; cholmod_l_colamd (AT, NULL, 0, TRUE, (Long *) (Q1fill + n1cols), cc) ; } cc->SPQR_istat [7] = ordering ; // restore the CHOLMOD settings cc->supernodal = save [0] ; cc->nmethods = save [1] ; cc->postorder = save [2] ; cc->method [0].ordering = save [3] ; cc->method [1].ordering = save [4] ; cc->method [2].ordering = save [5] ; AT->nrow = n ; AT->ncol = m ; } // ------------------------------------------------------------------------- // free AT // ------------------------------------------------------------------------- cholmod_l_free_sparse (&AT, cc) ; // ] // ------------------------------------------------------------------------- // check if the method succeeded // ------------------------------------------------------------------------- if (cc->status < CHOLMOD_OK) { // out of memory; free everything and return cholmod_l_free (worksize, sizeof (Long), Work, cc) ; cholmod_l_free (n+bncols, sizeof (Long), Q1fill, cc) ; cholmod_l_free (n1rows+1, sizeof (Long), R1p, cc) ; cholmod_l_free (m, sizeof (Long), P1inv, cc) ; return (FALSE) ; } // ------------------------------------------------------------------------- // map the fill-reducing ordering ordering back to A // ------------------------------------------------------------------------- if (n1cols > 0 && fill_reducing_ordering) { // Winv is workspace of size n2cols <= n #ifndef NDEBUG for (j = 0 ; j < n2cols ; j++) Winv [j] = EMPTY ; #endif for (j = 0 ; j < n ; j++) { // j is a column of A. col2 = W [j] is either EMPTY, or it is // the corresponding column of the pruned matrix col2 = W [j] ; if (col2 != EMPTY) { ASSERT (col2 >= 0 && col2 < n2cols) ; Winv [col2] = j ; } } for (k = n1cols ; k < n ; k++) { // col2 is a column of the pruned matrix col2 = Q1fill [k] ; // j is the corresonding column of the A matrix j = Winv [col2] ; ASSERT (j >= 0 && j < n) ; Q1fill [k] = j ; } } // ------------------------------------------------------------------------- // identity permutation of the columns of B // ------------------------------------------------------------------------- for (k = n ; k < n+bncols ; k++) { // tack on the identity permutation for columns of B Q1fill [k] = k ; } // ------------------------------------------------------------------------- // find column pointers for Y = [A2 B2]; columns of A2 // ------------------------------------------------------------------------- if (n1cols == 0 && bncols == 0) { // A will be factorized instead of Y Y = NULL ; } else { // Y has no entries yet; nnz(Y) will be determined later Y = cholmod_l_allocate_sparse (m-n1rows, n-n1cols+bncols, 0, FALSE, TRUE, 0, xtype, cc) ; if (cc->status < CHOLMOD_OK) { // out of memory; free everything and return cholmod_l_free (worksize, sizeof (Long), Work, cc) ; cholmod_l_free (n+bncols, sizeof (Long), Q1fill, cc) ; cholmod_l_free (n1rows+1, sizeof (Long), R1p, cc) ; cholmod_l_free (m, sizeof (Long), P1inv, cc) ; return (FALSE) ; } Yp = (Long *) Y->p ; ynz = 0 ; PR (("1c wrapup: n1cols %ld n %ld\n", n1cols, n)) ; for (k = n1cols ; k < n ; k++) { j = Q1fill [k] ; d = Degree [j] ; ASSERT (d >= 1 && d <= m) ; Yp [k-n1cols] = ynz ; ynz += d ; } Yp [n-n1cols] = ynz ; } // ------------------------------------------------------------------------- // free workspace and return results // ------------------------------------------------------------------------- cholmod_l_free (worksize, sizeof (Long), Work, cc) ; *p_Q1fill = Q1fill ; *p_R1p = R1p ; *p_P1inv = P1inv ; *p_Y = Y ; *p_n1cols = n1cols ; *p_n1rows = n1rows ; return (TRUE) ; }
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 ("!") ; */ }
void mexFunction ( int nargout, mxArray *pargout [ ], int nargin, const mxArray *pargin [ ] ) { Int *Bp, *Bi ; double *Ax, *Bx, dummy ; Int m, n, k, bncols, p, i, rank, A_complex, B_complex, is_complex, anz, bnz ; spqr_mx_options opts ; cholmod_sparse *A, Amatrix, *Xsparse ; cholmod_dense *Xdense ; cholmod_common Common, *cc ; char msg [LEN+1] ; #ifdef TIMING double t0 = (nargout > 1) ? spqr_time ( ) : 0 ; #endif // ------------------------------------------------------------------------- // start CHOLMOD and set parameters // ------------------------------------------------------------------------- cc = &Common ; cholmod_l_start (cc) ; spqr_mx_config (SPUMONI, cc) ; // ------------------------------------------------------------------------- // check inputs // ------------------------------------------------------------------------- if (nargout > 2) { mexErrMsgIdAndTxt ("MATLAB:maxlhs", "Too many output arguments") ; } if (nargin < 2) { mexErrMsgIdAndTxt ("MATLAB:minrhs", "Not enough input arguments") ; } if (nargin > 3) { mexErrMsgIdAndTxt ("MATLAB:maxrhs", "Too many input arguments") ; } // ------------------------------------------------------------------------- // get the input matrix A (must be sparse) // ------------------------------------------------------------------------- if (!mxIsSparse (pargin [0])) { mexErrMsgIdAndTxt ("QR:invalidInput", "A must be sparse") ; } A = spqr_mx_get_sparse (pargin [0], &Amatrix, &dummy) ; m = A->nrow ; n = A->ncol ; A_complex = mxIsComplex (pargin [0]) ; B_complex = mxIsComplex (pargin [1]) ; is_complex = (A_complex || B_complex) ; Ax = spqr_mx_merge_if_complex (pargin [0], is_complex, &anz, cc) ; if (is_complex) { // A has been converted from real or zomplex to complex A->x = Ax ; A->z = NULL ; A->xtype = CHOLMOD_COMPLEX ; } // ------------------------------------------------------------------------- // determine usage and parameters // ------------------------------------------------------------------------- spqr_mx_get_options ((nargin < 3) ? NULL : pargin [2], &opts, m, 3, cc) ; opts.Qformat = SPQR_Q_DISCARD ; opts.econ = 0 ; opts.permvector = TRUE ; opts.haveB = TRUE ; // ------------------------------------------------------------------------- // get the input matrix B (sparse or dense) // ------------------------------------------------------------------------- if (!mxIsNumeric (pargin [1])) { mexErrMsgIdAndTxt ("QR:invalidInput", "invalid non-numeric B") ; } if (mxGetM (pargin [1]) != m) { mexErrMsgIdAndTxt ("QR:invalidInput", "A and B must have the same number of rows") ; } cholmod_sparse Bsmatrix, *Bsparse ; cholmod_dense Bdmatrix, *Bdense ; // convert from real or zomplex to complex Bx = spqr_mx_merge_if_complex (pargin [1], is_complex, &bnz, cc) ; int B_is_sparse = mxIsSparse (pargin [1]) ; if (B_is_sparse) { Bsparse = spqr_mx_get_sparse (pargin [1], &Bsmatrix, &dummy) ; Bdense = NULL ; if (is_complex) { // Bsparse has been converted from real or zomplex to complex Bsparse->x = Bx ; Bsparse->z = NULL ; Bsparse->xtype = CHOLMOD_COMPLEX ; } } else { Bsparse = NULL ; Bdense = spqr_mx_get_dense (pargin [1], &Bdmatrix, &dummy) ; if (is_complex) { // Bdense has been converted from real or zomplex to complex Bdense->x = Bx ; Bdense->z = NULL ; Bdense->xtype = CHOLMOD_COMPLEX ; } } // ------------------------------------------------------------------------- // X = A\B // ------------------------------------------------------------------------- if (opts.min2norm && m < n) { #ifndef NEXPERT // This requires SuiteSparseQR_expert.cpp if (is_complex) { if (B_is_sparse) { // X and B are both sparse and complex Xsparse = SuiteSparseQR_min2norm <Complex> (opts.ordering, opts.tol, A, Bsparse, cc) ; pargout [0] = spqr_mx_put_sparse (&Xsparse, cc) ; } else { // X and B are both dense and complex Xdense = SuiteSparseQR_min2norm <Complex> (opts.ordering, opts.tol, A, Bdense, cc) ; pargout [0] = spqr_mx_put_dense (&Xdense, cc) ; } } else { if (B_is_sparse) { // X and B are both sparse and real Xsparse = SuiteSparseQR_min2norm <double> (opts.ordering, opts.tol, A, Bsparse, cc) ; pargout [0] = spqr_mx_put_sparse (&Xsparse, cc) ; } else { // X and B are both dense and real Xdense = SuiteSparseQR_min2norm <double> (opts.ordering, opts.tol, A, Bdense, cc) ; pargout [0] = spqr_mx_put_dense (&Xdense, cc) ; } } #else mexErrMsgIdAndTxt ("QR:notInstalled", "min2norm method not installed") ; #endif } else { if (is_complex) { if (B_is_sparse) { // X and B are both sparse and complex Xsparse = SuiteSparseQR <Complex> (opts.ordering, opts.tol, A, Bsparse, cc) ; pargout [0] = spqr_mx_put_sparse (&Xsparse, cc) ; } else { // X and B are both dense and complex Xdense = SuiteSparseQR <Complex> (opts.ordering, opts.tol, A, Bdense, cc) ; pargout [0] = spqr_mx_put_dense (&Xdense, cc) ; } } else { if (B_is_sparse) { // X and B are both sparse and real Xsparse = SuiteSparseQR <double> (opts.ordering, opts.tol, A, Bsparse, cc) ; pargout [0] = spqr_mx_put_sparse (&Xsparse, cc) ; } else { // X and B are both dense and real Xdense = SuiteSparseQR <double> (opts.ordering, opts.tol, A, Bdense, cc) ; pargout [0] = spqr_mx_put_dense (&Xdense, cc) ; } } } // ------------------------------------------------------------------------- // info output // ------------------------------------------------------------------------- if (nargout > 1) { #ifdef TIMING double flops = cc->other1 [0] ; double t = spqr_time ( ) - t0 ; #else double flops = -1 ; double t = -1 ; #endif pargout [1] = spqr_mx_info (cc, t, flops) ; } // ------------------------------------------------------------------------- // warn if rank deficient // ------------------------------------------------------------------------- rank = cc->SPQR_istat [4] ; if (rank < MIN (m,n)) { // snprintf would be safer, but Windows is oblivious to safety ... // (Visual Studio C++ 2008 does not recognize snprintf!) sprintf (msg, "rank deficient. rank = %ld tol = %g\n", rank, cc->SPQR_xstat [1]) ; mexWarnMsgIdAndTxt ("MATLAB:rankDeficientMatrix", msg) ; } if (is_complex) { // free the merged complex copies of A and B cholmod_l_free (anz, sizeof (Complex), Ax, cc) ; cholmod_l_free (bnz, sizeof (Complex), Bx, cc) ; } cholmod_l_finish (cc) ; if (opts.spumoni > 0) spqr_mx_spumoni (&opts, is_complex, cc) ; }
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 }
template <typename Entry> spqr_numeric <Entry> *spqr_factorize ( // input, optionally freed on output cholmod_sparse **Ahandle, // inputs, not modified Long freeA, // if TRUE, free A on output double tol, // for rank detection Long ntol, // apply tol only to first ntol columns spqr_symbolic *QRsym, // workspace and parameters cholmod_common *cc ) { Long *Wi, *Qfill, *PLinv, *Cm, *Sp, *Stack_size, *TaskFront, *TaskFrontp, *TaskStack, *Stack_maxstack ; Entry *Sx, **Rblock, **Cblock, **Stacks ; spqr_numeric <Entry> *QRnum ; Long nf, m, n, anz, fchunk, maxfn, rank, maxfrank, rjsize, rank1, maxstack,j, wtsize, stack, ns, ntasks, keepH, hisize ; char *Rdead ; cholmod_sparse *A ; spqr_work <Entry> *Work ; // ------------------------------------------------------------------------- // get inputs and contents of symbolic object // ------------------------------------------------------------------------- if (QRsym == NULL) { // out of memory in caller if (freeA) { // if freeA is true, A must always be freed, even on error cholmod_l_free_sparse (Ahandle, cc) ; } return (NULL) ; } A = *Ahandle ; nf = QRsym->nf ; // number of frontal matrices m = QRsym->m ; // A is m-by-n n = QRsym->n ; anz = QRsym->anz ; // nnz (A) keepH = QRsym->keepH ; rjsize = QRsym->rjsize ; Sp = QRsym->Sp ; // size m+1, row pointers for S Qfill = QRsym->Qfill ; // fill-reducing ordering PLinv = QRsym->PLinv ; // size m, leftmost column sort ns = QRsym->ns ; // number of stacks ntasks = QRsym->ntasks ; // number of tasks // FUTURE: compute a unique maxfn for each stack. Current maxfn is OK, but // it's a global max of the fn of all fronts, and need only be max fn of // the fronts in any given stack. maxfn = QRsym->maxfn ; // max # of columns in any front ASSERT (maxfn <= n) ; hisize = QRsym->hisize ; // # of integers in Hii, Householder vectors TaskFrontp = QRsym->TaskFrontp ; TaskFront = QRsym->TaskFront ; TaskStack = QRsym->TaskStack ; maxstack = QRsym->maxstack ; Stack_maxstack = QRsym->Stack_maxstack ; if (!(QRsym->do_rank_detection)) { // disable rank detection if not accounted for in analysis tol = -1 ; } // If there is one task, there is only one stack, and visa versa ASSERT ((ns == 1) == (ntasks == 1)) ; PR (("factorize with ns %ld ntasks %ld\n", ns, ntasks)) ; // ------------------------------------------------------------------------- // allocate workspace // ------------------------------------------------------------------------- cholmod_l_allocate_work (0, MAX (m,nf), 0, cc) ; // shared Long workspace Wi = (Long *) cc->Iwork ; // size m, aliased with the rest of Iwork Cm = Wi ; // size nf // Cblock is workspace shared by all threads Cblock = (Entry **) cholmod_l_malloc (nf+1, sizeof (Entry *), cc) ; Work = NULL ; // Work and its contents not yet allocated fchunk = MIN (m, FCHUNK) ; wtsize = 0 ; // ------------------------------------------------------------------------- // create S // ------------------------------------------------------------------------- // create numeric values of S = A(p,q) in row-form in Sx Sx = (Entry *) cholmod_l_malloc (anz, sizeof (Entry), cc) ; if (cc->status == CHOLMOD_OK) { // use Wi as workspace (Iwork (0:m-1)) [ spqr_stranspose2 (A, Qfill, Sp, PLinv, Sx, Wi) ; // Wi no longer needed ] } PR (("status after creating Sx: %d\n", cc->status)) ; // ------------------------------------------------------------------------- // input matrix A no longer needed; free it if the user doesn't need it // ------------------------------------------------------------------------- if (freeA) { // this is done even if out of memory, above cholmod_l_free_sparse (Ahandle, cc) ; ASSERT (*Ahandle == NULL) ; } if (cc->status < CHOLMOD_OK) { // out of memory FREE_WORK ; return (NULL) ; } // ------------------------------------------------------------------------- // allocate numeric object // ------------------------------------------------------------------------- QRnum = (spqr_numeric<Entry> *) cholmod_l_malloc (1, sizeof (spqr_numeric<Entry>), cc) ; if (cc->status < CHOLMOD_OK) { // out of memory FREE_WORK ; return (NULL) ; } Rblock = (Entry **) cholmod_l_malloc (nf, sizeof (Entry *), cc) ; Rdead = (char *) cholmod_l_calloc (n, sizeof (char), cc) ; // these may be revised (with ns=1) if we run out of memory Stacks = (Entry **) cholmod_l_calloc (ns, sizeof (Entry *), cc) ; Stack_size = (Long *) cholmod_l_calloc (ns, sizeof (Long), cc) ; QRnum->Rblock = Rblock ; QRnum->Rdead = Rdead ; QRnum->Stacks = Stacks ; QRnum->Stack_size = Stack_size ; if (keepH) { // allocate permanent space for Stair, Tau, Hii for each front QRnum->HStair= (Long *) cholmod_l_malloc (rjsize, sizeof (Long), cc) ; QRnum->HTau = (Entry *) cholmod_l_malloc (rjsize, sizeof (Entry), cc) ; QRnum->Hii = (Long *) cholmod_l_malloc (hisize, sizeof (Long), cc) ; QRnum->Hm = (Long *) cholmod_l_malloc (nf, sizeof (Long), cc) ; QRnum->Hr = (Long *) cholmod_l_malloc (nf, sizeof (Long), cc) ; QRnum->HPinv = (Long *) cholmod_l_malloc (m, sizeof (Long), cc) ; } else { // H is not kept; this part of the numeric object is not used QRnum->HStair = NULL ; QRnum->HTau = NULL ; QRnum->Hii = NULL ; QRnum->Hm = NULL ; QRnum->Hr = NULL ; QRnum->HPinv = NULL ; } QRnum->n = n ; QRnum->m = m ; QRnum->nf = nf ; QRnum->rjsize = rjsize ; QRnum->hisize = hisize ; QRnum->keepH = keepH ; QRnum->maxstack = maxstack ; QRnum->ns = ns ; QRnum->ntasks = ntasks ; QRnum->maxfm = EMPTY ; // max (Hm [0:nf-1]), computed only if H is kept if (cc->status < CHOLMOD_OK) { // out of memory spqr_freenum (&QRnum, cc) ; FREE_WORK ; return (NULL) ; } // ------------------------------------------------------------------------- // allocate workspace // ------------------------------------------------------------------------- Work = get_Work <Entry> (ns, n, maxfn, keepH, fchunk, &wtsize, cc) ; // ------------------------------------------------------------------------- // allocate and initialize each Stack // ------------------------------------------------------------------------- if (cc->status == CHOLMOD_OK) { for (stack = 0 ; stack < ns ; stack++) { Entry *Stack ; size_t stacksize = (ntasks == 1) ? maxstack : Stack_maxstack [stack] ; Stack_size [stack] = stacksize ; Stack = (Entry *) cholmod_l_malloc (stacksize, sizeof (Entry), cc) ; Stacks [stack] = Stack ; Work [stack].Stack_head = Stack ; Work [stack].Stack_top = Stack + stacksize ; } } // ------------------------------------------------------------------------- // punt to sequential case and fchunk = 1 if out of memory // ------------------------------------------------------------------------- if (cc->status < CHOLMOD_OK) { // PUNT: ran out of memory; try again with smaller workspace // out of memory; free any stacks that were successfully allocated if (Stacks != NULL) { for (stack = 0 ; stack < ns ; stack++) { size_t stacksize = (ntasks == 1) ? maxstack : Stack_maxstack [stack] ; cholmod_l_free (stacksize, sizeof (Entry), Stacks [stack], cc) ; } } cholmod_l_free (ns, sizeof (Entry *), Stacks, cc) ; cholmod_l_free (ns, sizeof (Long), Stack_size, cc) ; // free the contents of Work, and the Work array itself free_Work <Entry> (Work, ns, n, maxfn, wtsize, cc) ; cholmod_l_free (ns, sizeof (spqr_work <Entry>), Work, cc) ; // punt to a single stack, a single task, and fchunk of 1 ns = 1 ; ntasks = 1 ; fchunk = 1 ; cc->status = CHOLMOD_OK ; Work = get_Work <Entry> (ns, n, maxfn, keepH, fchunk, &wtsize, cc) ; Stacks = (Entry **) cholmod_l_calloc (ns, sizeof (Entry *), cc) ; Stack_size = (Long *) cholmod_l_calloc (ns, sizeof (Long), cc) ; QRnum->Stacks = Stacks ; QRnum->Stack_size = Stack_size ; if (cc->status == CHOLMOD_OK) { Entry *Stack ; Stack_size [0] = maxstack ; Stack = (Entry *) cholmod_l_malloc (maxstack, sizeof (Entry), cc) ; Stacks [0] = Stack ; Work [0].Stack_head = Stack ; Work [0].Stack_top = Stack + maxstack ; } } // actual # of stacks and tasks used QRnum->ns = ns ; QRnum->ntasks = ntasks ; // ------------------------------------------------------------------------- // check if everything was allocated OK // ------------------------------------------------------------------------- if (cc->status < CHOLMOD_OK) { spqr_freenum (&QRnum, cc) ; FREE_WORK ; return (NULL) ; } // At this point, the factorization is guaranteed to succeed, unless // sizeof (BLAS_INT) < sizeof (Long), in which case, you really should get // a 64-bit BLAS. // ------------------------------------------------------------------------- // create the Blob : everything the numeric factorization kernel needs // ------------------------------------------------------------------------- spqr_blob <Entry> Blob ; Blob.QRsym = QRsym ; Blob.QRnum = QRnum ; Blob.tol = tol ; Blob.Work = Work ; Blob.Cm = Cm ; Blob.Cblock = Cblock ; Blob.Sx = Sx ; Blob.ntol = ntol ; Blob.fchunk = fchunk ; Blob.cc = cc ; // ------------------------------------------------------------------------- // initialize the "pure" flop count (for performance testing only) // ------------------------------------------------------------------------- cc->other1 [0] = 0 ; // ------------------------------------------------------------------------- // numeric QR factorization // ------------------------------------------------------------------------- if (ntasks == 1) { // Just one task, with or without TBB installed: don't use TBB spqr_kernel (0, &Blob) ; // sequential case } else { #ifdef HAVE_TBB // parallel case: TBB is installed, and there is more than one task int nthreads = MAX (0, cc->SPQR_nthreads) ; spqr_parallel (ntasks, nthreads, &Blob) ; #else // TBB not installed, but the work is still split into multiple tasks. // do tasks 0 to ntasks-2 (skip the placeholder root task id = ntasks-1) for (Long id = 0 ; id < ntasks-1 ; id++) { spqr_kernel (id, &Blob) ; } #endif } // ------------------------------------------------------------------------- // check for BLAS Long overflow // ------------------------------------------------------------------------- if (CHECK_BLAS_INT && cc->status < CHOLMOD_OK) { // problem too large for the BLAS. This can only occur if, for example // you're on a 64-bit platform (with sizeof (Long) = 8) and using a // 32-bit BLAS (with sizeof (BLAS_INT) = 4). If sizeof (BLAS_INT) is // equal to sizeof (Long), then CHECK_BLAS_INT is FALSE at // compile-time, and this entire code is removed as dead code by the // compiler. spqr_freenum (&QRnum, cc) ; FREE_WORK ; return (NULL) ; } // ------------------------------------------------------------------------- // finalize the rank // ------------------------------------------------------------------------- rank = 0 ; maxfrank = 1 ; for (stack = 0 ; stack < ns ; stack++) { rank += Work [stack].sumfrank ; maxfrank = MAX (maxfrank, Work [stack].maxfrank) ; } QRnum->rank = rank ; // required by spqr_hpinv QRnum->maxfrank = maxfrank ; PR (("m %ld n %ld my QR rank %ld\n", m, n, rank)) ; // ------------------------------------------------------------------------- // finalize norm(w) for the dead column 2-norms // ------------------------------------------------------------------------- double wscale = 0 ; double wssq = 1 ; for (stack = 0 ; stack < ns ; stack++) { // norm_E_fro = norm (s.*sqrt(q)) ; see also LAPACK's dnrm2 double ws = Work [stack].wscale ; double wq = Work [stack].wssq ; if (wq != 0) { double wk = ws * sqrt (wq) ; if (wscale < wk) { double rr = wscale / wk ; wssq = 1 + wssq * rr * rr ; wscale = wk ; } else { double rr = wk / wscale ; wssq += rr * rr ; } } } QRnum->norm_E_fro = wscale * sqrt (wssq) ; cc->SPQR_xstat [2] = QRnum->norm_E_fro ; // ------------------------------------------------------------------------- // free all workspace, except Cblock and Work // ------------------------------------------------------------------------- FREE_WORK_PART1 ; // ------------------------------------------------------------------------- // shrink the Stacks to hold just R (and H, if H kept) // ------------------------------------------------------------------------- // If shrink is <= 0, then the Stacks are not modified. // If shrink is 1, each Stack is realloc'ed to the right size (default) // If shrink is > 1, then each Stack is forcibly moved and shrunk. // This option is mainly meant for testing, not production use. // It should be left at 1 for production use. Long any_moved = FALSE ; int shrink = cc->SPQR_shrink ; if (shrink > 0) { for (stack = 0 ; stack < ns ; stack++) { // stacksize is the current size of the this Stack size_t stacksize = Stack_size [stack] ; Entry *Stack = Stacks [stack] ; // Work [stack].Stack_head points to the first empty slot in stack, // so newstacksize is the size of the space in use by R and H. size_t newstacksize = Work [stack].Stack_head - Stack ; ASSERT (newstacksize <= stacksize) ; // Reduce the size of this stack. Cblock [0:nf-1] is no longer // needed for holding pointers to the C blocks of each frontal // matrix. Reuse it to hold the reallocated stacks. if (shrink > 1) { // force the block to move by malloc'ing a new one; // this option is mainly for testing only. Cblock [stack] = (Entry *) cholmod_l_malloc (newstacksize, sizeof (Entry), cc) ; if (Cblock [stack] == NULL) { // oops, the malloc failed; just use the old block cc->status = CHOLMOD_OK ; Cblock [stack] = Stack ; // update the memory usage statistics, however cc->memory_inuse += ((newstacksize-stacksize) * sizeof (Entry)) ; } else { // malloc is OK; copy the block over and free the old one memcpy (Cblock [stack], Stack, newstacksize*sizeof(Entry)) ; cholmod_l_free (stacksize, sizeof (Entry), Stack, cc) ; } // the Stack has been shrunk to the new size stacksize = newstacksize ; } else { // normal method; just realloc the block Cblock [stack] = // pointer to the new Stack (Entry *) cholmod_l_realloc ( newstacksize, // requested size of Stack, in # of Entries sizeof (Entry), // size of each Entry in the Stack Stack, // pointer to the old Stack &stacksize, // input: old stack size; output: new size cc) ; } Stack_size [stack] = stacksize ; any_moved = any_moved || (Cblock [stack] != Stack) ; // reducing the size of a block of memory always succeeds ASSERT (cc->status == CHOLMOD_OK) ; } } // ------------------------------------------------------------------------- // adjust the Rblock pointers if the Stacks have been moved // ------------------------------------------------------------------------- if (any_moved) { // at least one Stack has moved; check all fronts and adjust them for (Long task = 0 ; task < ntasks ; task++) { Long kfirst, klast ; if (ntasks == 1) { // sequential case kfirst = 0 ; klast = nf ; stack = 0 ; } else { kfirst = TaskFrontp [task] ; klast = TaskFrontp [task+1] ; stack = TaskStack [task] ; } ASSERT (stack >= 0 && stack < ns) ; Entry *Old_Stack = Stacks [stack] ; Entry *New_Stack = Cblock [stack] ; if (New_Stack != Old_Stack) { for (Long kf = kfirst ; kf < klast ; kf++) { Long f = (ntasks == 1) ? kf : TaskFront [kf] ; Rblock [f] = New_Stack + (Rblock [f] - Old_Stack) ; } } } // finalize the Stacks for (stack = 0 ; stack < ns ; stack++) { Stacks [stack] = Cblock [stack] ; } } // ------------------------------------------------------------------------- // free the rest of the workspace // ------------------------------------------------------------------------- FREE_WORK_PART2 ; // ------------------------------------------------------------------------- // extract the implicit row permutation for H // ------------------------------------------------------------------------- // this must be done sequentially, when all threads are finished if (keepH) { // use Wi as workspace (Iwork (0:m-1)) [ spqr_hpinv (QRsym, QRnum, Wi) ; // Wi no longer needed ] } // ------------------------------------------------------------------------- // find the rank and return the result // ------------------------------------------------------------------------- // find the rank of the first ntol columns of A if (ntol >= n) { rank1 = rank ; } else { rank1 = 0 ; for (j = 0 ; j < ntol ; j++) { if (!Rdead [j]) { rank1++ ; } } } QRnum->rank1 = rank1 ; return (QRnum) ; }
static void* free(size_t n, size_t size, void* p, cholmod_common* c) { return cholmod_l_free(n, size, p, c); }
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 ("!") ; */ }
void mexFunction ( int nargout, mxArray *pargout [ ], int nargin, const mxArray *pargin [ ] ) { Int *P, *Q, *Rp, *Pinv ; double *Ax, dummy, tol ; Int m, n, anz, is_complex, n1rows, n1cols, i, k ; cholmod_sparse *A, Amatrix, *Y ; cholmod_common Common, *cc ; // ------------------------------------------------------------------------- // start CHOLMOD and set parameters // ------------------------------------------------------------------------- cc = &Common ; cholmod_l_start (cc) ; spqr_mx_config (SPUMONI, cc) ; // ------------------------------------------------------------------------- // check inputs // ------------------------------------------------------------------------- if (nargout > 5) { mexErrMsgIdAndTxt ("MATLAB:maxlhs", "Too many output arguments") ; } if (nargin < 1) { mexErrMsgIdAndTxt ("MATLAB:minrhs", "Not enough input arguments") ; } if (nargin > 2) { mexErrMsgIdAndTxt ("MATLAB:maxrhs", "Too many input arguments") ; } // ------------------------------------------------------------------------- // get the input matrix A and convert to merged-complex if needed // ------------------------------------------------------------------------- if (!mxIsSparse (pargin [0])) { mexErrMsgIdAndTxt ("QR:invalidInput", "A must be sparse") ; } A = spqr_mx_get_sparse (pargin [0], &Amatrix, &dummy) ; m = A->nrow ; n = A->ncol ; is_complex = mxIsComplex (pargin [0]) ; Ax = spqr_mx_merge_if_complex (pargin [0], is_complex, &anz, cc) ; if (is_complex) { // A has been converted from real or zomplex to complex A->x = Ax ; A->z = NULL ; A->xtype = CHOLMOD_COMPLEX ; } // ------------------------------------------------------------------------- // get the tolerance // ------------------------------------------------------------------------- if (nargin < 2) { tol = is_complex ? spqr_tol <Complex> (A,cc) : spqr_tol <double> (A,cc); } else { tol = mxGetScalar (pargin [1]) ; } // ------------------------------------------------------------------------- // find the singletons // ------------------------------------------------------------------------- if (is_complex) { spqr_1colamd <Complex> (SPQR_ORDERING_NATURAL, tol, 0, A, &Q, &Rp, &Pinv, &Y, &n1cols, &n1rows, cc) ; } else { spqr_1colamd <double> (SPQR_ORDERING_NATURAL, tol, 0, A, &Q, &Rp, &Pinv, &Y, &n1cols, &n1rows, cc) ; } // ------------------------------------------------------------------------- // free unused outputs from spqr_1colamd, and the merged-complex copy of A // ------------------------------------------------------------------------- cholmod_l_free (n1rows+1, sizeof (Int), Rp, cc) ; cholmod_l_free_sparse (&Y, cc) ; if (is_complex) { // this was allocated by merge_if_complex cholmod_l_free (anz, sizeof (Complex), Ax, cc) ; } // ------------------------------------------------------------------------- // find P from Pinv // ------------------------------------------------------------------------- P = (Int *) cholmod_l_malloc (m, sizeof (Int), cc) ; for (i = 0 ; i < m ; i++) { k = Pinv ? Pinv [i] : i ; P [k] = i ; } cholmod_l_free (m, sizeof (Int), Pinv, cc) ; // ------------------------------------------------------------------------- // return results // ------------------------------------------------------------------------- pargout [0] = spqr_mx_put_permutation (P, m, TRUE, cc) ; cholmod_l_free (m, sizeof (Int), P, cc) ; if (nargout > 1) pargout [1] = spqr_mx_put_permutation (Q, n, TRUE, cc) ; cholmod_l_free (n, sizeof (Int), Q, cc) ; if (nargout > 2) pargout [2] = mxCreateDoubleScalar ((double) n1rows) ; if (nargout > 3) pargout [3] = mxCreateDoubleScalar ((double) n1cols) ; if (nargout > 4) pargout [4] = mxCreateDoubleScalar (tol) ; cholmod_l_finish (cc) ; }
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!") ; */ }
void mexFunction ( int nargout, mxArray *pargout [ ], int nargin, const mxArray *pargin [ ] ) { Int *Ap, *Ai, *E, *Bp, *Bi, *HPinv ; double *Ax, *Bx, dummy, tol ; Int m, n, anz, bnz, is_complex, econ, A_complex, B_complex ; spqr_mx_options opts ; cholmod_sparse *A, Amatrix, *R, *Q, *Csparse, Bsmatrix, *Bsparse, *H ; cholmod_dense *Cdense, Bdmatrix, *Bdense, *HTau ; cholmod_common Common, *cc ; #ifdef TIMING double t0 = (nargout > 3) ? spqr_time ( ) : 0 ; #endif // ------------------------------------------------------------------------- // start CHOLMOD and set parameters // ------------------------------------------------------------------------- cc = &Common ; cholmod_l_start (cc) ; spqr_mx_config (SPUMONI, cc) ; // ------------------------------------------------------------------------- // check inputs // ------------------------------------------------------------------------- // nargin can be 1, 2, or 3 // nargout can be 0, 1, 2, 3, or 4 if (nargout > 4) { mexErrMsgIdAndTxt ("MATLAB:maxlhs", "Too many output arguments") ; } if (nargin < 1) { mexErrMsgIdAndTxt ("MATLAB:minrhs", "Not enough input arguments") ; } if (nargin > 3) { mexErrMsgIdAndTxt ("MATLAB:maxrhs", "Too many input arguments") ; } // ------------------------------------------------------------------------- // get the input matrix A // ------------------------------------------------------------------------- if (!mxIsSparse (pargin [0])) { mexErrMsgIdAndTxt ("QR:invalidInput", "A must be sparse") ; } A = spqr_mx_get_sparse (pargin [0], &Amatrix, &dummy) ; Ap = (Int *) A->p ; Ai = (Int *) A->i ; m = A->nrow ; n = A->ncol ; A_complex = mxIsComplex (pargin [0]) ; // ------------------------------------------------------------------------- // determine usage and parameters // ------------------------------------------------------------------------- if (nargin == 1) { // --------------------------------------------------------------------- // [ ] = qr (A) // --------------------------------------------------------------------- spqr_mx_get_options (NULL, &opts, m, nargout, cc) ; // R = qr (A) // [Q,R] = qr (A) // [Q,R,E] = qr (A) } else if (nargin == 2) { // --------------------------------------------------------------------- // [ ] = qr (A,0), [ ] = qr (A,opts), or [ ] = qr (A,B) // --------------------------------------------------------------------- if (is_zero (pargin [1])) { // ----------------------------------------------------------------- // [ ... ] = qr (A,0) // ----------------------------------------------------------------- spqr_mx_get_options (NULL, &opts, m, nargout, cc) ; opts.econ = n ; opts.permvector = TRUE ; // R = qr (A,0) // [Q,R] = qr (A,0) // [Q,R,E] = qr (A,0) } else if (mxIsEmpty (pargin [1]) || mxIsStruct (pargin [1])) { // ----------------------------------------------------------------- // [ ] = qr (A,opts) // ----------------------------------------------------------------- spqr_mx_get_options (pargin [1], &opts, m, nargout, cc) ; // R = qr (A,opts) // [Q,R] = qr (A,opts) // [Q,R,E] = qr (A,opts) } else { // ----------------------------------------------------------------- // [ ] = qr (A,B) // ----------------------------------------------------------------- spqr_mx_get_options (NULL, &opts, m, nargout, cc) ; opts.haveB = TRUE ; opts.Qformat = SPQR_Q_DISCARD ; if (nargout <= 1) { mexErrMsgIdAndTxt ("MATLAB:minlhs", "Not enough output arguments") ; } // [C,R] = qr (A,B) // [C,R,E] = qr (A,B) } } else // if (nargin == 3) { // --------------------------------------------------------------------- // [ ] = qr (A,B,opts) // --------------------------------------------------------------------- if (is_zero (pargin [2])) { // ----------------------------------------------------------------- // [ ] = qr (A,B,0) // ----------------------------------------------------------------- spqr_mx_get_options (NULL, &opts, m, nargout, cc) ; opts.econ = n ; opts.permvector = TRUE ; opts.haveB = TRUE ; opts.Qformat = SPQR_Q_DISCARD ; if (nargout <= 1) { mexErrMsgIdAndTxt ("MATLAB:minlhs", "Not enough output arguments") ; } // [C,R] = qr (A,B,0) // [C,R,E] = qr (A,B,0) } else if (mxIsEmpty (pargin [2]) || mxIsStruct (pargin [2])) { // ----------------------------------------------------------------- // [ ] = qr (A,B,opts) // ----------------------------------------------------------------- spqr_mx_get_options (pargin [2], &opts, m, nargout, cc) ; opts.haveB = TRUE ; opts.Qformat = SPQR_Q_DISCARD ; if (nargout <= 1) { mexErrMsgIdAndTxt ("MATLAB:minlhs", "Not enough output arguments") ; } // [C,R] = qr (A,B,opts) // [C,R,E] = qr (A,B,opts) } else { mexErrMsgIdAndTxt ("QR:invalidInput", "Invalid opts argument") ; } } int order = opts.ordering ; tol = opts.tol ; econ = opts.econ ; // ------------------------------------------------------------------------- // get A and convert to merged-complex if needed // ------------------------------------------------------------------------- if (opts.haveB) { B_complex = mxIsComplex (pargin [1]) ; } else { B_complex = FALSE ; } is_complex = (A_complex || B_complex) ; Ax = spqr_mx_merge_if_complex (pargin [0], is_complex, &anz, cc) ; if (is_complex) { // A has been converted from real or zomplex to complex A->x = Ax ; A->z = NULL ; A->xtype = CHOLMOD_COMPLEX ; } // ------------------------------------------------------------------------- // analyze, factorize, and get the results // ------------------------------------------------------------------------- if (opts.haveB) { // --------------------------------------------------------------------- // get B, and convert to complex if necessary // --------------------------------------------------------------------- if (!mxIsNumeric (pargin [1])) { mexErrMsgIdAndTxt ("QR:invalidInput", "invalid non-numeric B") ; } if (mxGetM (pargin [1]) != m) { mexErrMsgIdAndTxt ("QR:invalidInput", "A and B must have the same number of rows") ; } // convert from real or zomplex to complex Bx = spqr_mx_merge_if_complex (pargin [1], is_complex, &bnz, cc) ; int B_is_sparse = mxIsSparse (pargin [1]) ; if (B_is_sparse) { Bsparse = spqr_mx_get_sparse (pargin [1], &Bsmatrix, &dummy) ; Bdense = NULL ; if (is_complex) { // Bsparse has been converted from real or zomplex to complex Bsparse->x = Bx ; Bsparse->z = NULL ; Bsparse->xtype = CHOLMOD_COMPLEX ; } } else { Bsparse = NULL ; Bdense = spqr_mx_get_dense (pargin [1], &Bdmatrix, &dummy) ; if (is_complex) { // Bdense has been converted from real or zomplex to complex Bdense->x = Bx ; Bdense->z = NULL ; Bdense->xtype = CHOLMOD_COMPLEX ; } } // --------------------------------------------------------------------- // [C,R,E] = qr (A,B,...) or [C,R] = qr (A,B,...) // --------------------------------------------------------------------- if (is_complex) { // ----------------------------------------------------------------- // [C,R,E] = qr (A,B): complex case // ----------------------------------------------------------------- if (B_is_sparse) { // B and C are both sparse and complex SuiteSparseQR <Complex> (order, tol, econ, A, Bsparse, &Csparse, &R, &E, cc) ; pargout [0] = spqr_mx_put_sparse (&Csparse, cc) ; } else { // B and C are both dense and complex SuiteSparseQR <Complex> (order, tol, econ, A, Bdense, &Cdense, &R, &E, cc) ; pargout [0] = spqr_mx_put_dense (&Cdense, cc) ; } } else { // ----------------------------------------------------------------- // [C,R,E] = qr (A,B): real case // ----------------------------------------------------------------- if (B_is_sparse) { // B and C are both sparse and real SuiteSparseQR <double> (order, tol, econ, A, Bsparse, &Csparse, &R, &E, cc) ; pargout [0] = spqr_mx_put_sparse (&Csparse, cc) ; } else { // B and C are both dense and real SuiteSparseQR <double> (order, tol, econ, A, Bdense, &Cdense, &R, &E, cc) ; pargout [0] = spqr_mx_put_dense (&Cdense, cc) ; } } pargout [1] = spqr_mx_put_sparse (&R, cc) ; } else if (nargout <= 1) { // --------------------------------------------------------------------- // R = qr (A) or R = qr (A,opts) // --------------------------------------------------------------------- if (is_complex) { SuiteSparseQR <Complex> (0, tol, econ, A, &R, NULL, cc) ; } else { SuiteSparseQR <double> (0, tol, econ, A, &R, NULL, cc) ; } pargout [0] = spqr_mx_put_sparse (&R, cc) ; } else { // --------------------------------------------------------------------- // [Q,R,E] = qr (A,...) or [Q,R] = qr (A,...) // --------------------------------------------------------------------- if (opts.Qformat == SPQR_Q_DISCARD) { // ----------------------------------------------------------------- // Q is discarded, and Q = [ ] is returned as a placeholder // ----------------------------------------------------------------- if (is_complex) { SuiteSparseQR <Complex> (order, tol, econ, A, &R, &E, cc); } else { SuiteSparseQR <double> (order, tol, econ, A, &R, &E, cc) ; } pargout [0] = mxCreateDoubleMatrix (0, 0, mxREAL) ; } else if (opts.Qformat == SPQR_Q_MATRIX) { // ----------------------------------------------------------------- // Q is a sparse matrix // ----------------------------------------------------------------- if (is_complex) { SuiteSparseQR <Complex> (order, tol, econ, A, &Q, &R, &E, cc) ; } else { SuiteSparseQR <double> (order, tol, econ, A, &Q, &R, &E, cc) ; } pargout [0] = spqr_mx_put_sparse (&Q, cc) ; } else { // ----------------------------------------------------------------- // H is kept, and Q is a struct containing H, Tau, and P // ----------------------------------------------------------------- mxArray *Tau, *P, *Hmatlab ; if (is_complex) { SuiteSparseQR <Complex> (order, tol, econ, A, &R, &E, &H, &HPinv, &HTau, cc) ; } else { SuiteSparseQR <double> (order, tol, econ, A, &R, &E, &H, &HPinv, &HTau, cc) ; } Tau = spqr_mx_put_dense (&HTau, cc) ; Hmatlab = spqr_mx_put_sparse (&H, cc) ; // Q.P contains the inverse row permutation P = mxCreateDoubleMatrix (1, m, mxREAL) ; double *Tx = mxGetPr (P) ; for (Int i = 0 ; i < m ; i++) { Tx [i] = HPinv [i] + 1 ; } // return Q const char *Qstruct [ ] = { "H", "Tau", "P" } ; pargout [0] = mxCreateStructMatrix (1, 1, 3, Qstruct) ; mxSetFieldByNumber (pargout [0], 0, 0, Hmatlab) ; mxSetFieldByNumber (pargout [0], 0, 1, Tau) ; mxSetFieldByNumber (pargout [0], 0, 2, P) ; } pargout [1] = spqr_mx_put_sparse (&R, cc) ; } // ------------------------------------------------------------------------- // return E // ------------------------------------------------------------------------- if (nargout > 2) { pargout [2] = spqr_mx_put_permutation (E, n, opts.permvector, cc) ; } // ------------------------------------------------------------------------- // free copy of merged-complex, if needed // ------------------------------------------------------------------------- if (is_complex) { // this was allocated by merge_if_complex cholmod_l_free (anz, sizeof (Complex), Ax, cc) ; if (opts.haveB) { cholmod_l_free (bnz, sizeof (Complex), Bx, cc) ; } } // ------------------------------------------------------------------------- // info output // ------------------------------------------------------------------------- if (nargout > 3) { #ifdef TIMING double flops = cc->other1 [0] ; double t = spqr_time ( ) - t0 ; #else double flops = -1 ; double t = -1 ; #endif pargout [3] = spqr_mx_info (cc, t, flops) ; } cholmod_l_finish (cc) ; if (opts.spumoni > 0) spqr_mx_spumoni (&opts, is_complex, cc) ; }
void mexFunction ( int nargout, mxArray *pargout [ ], int nargin, const mxArray *pargin [ ] ) { mxArray *Hmatlab, *Tau, *P ; Long *HPinv, *Yp, *Yi ; double *Hx, *Xx, *Tx, *Px, dummy ; Long m, n, k, nh, nb, p, i, method, mh, gotP, X_is_sparse, is_complex, hnz, tnz, xnz, inuse, count ; cholmod_sparse *Ysparse, *H, Hmatrix, *Xsparse, Xsmatrix ; cholmod_dense *Ydense, *Xdense, Xdmatrix, *HTau, HTau_matrix ; cholmod_common Common, *cc ; // ------------------------------------------------------------------------- // start CHOLMOD and set parameters // ------------------------------------------------------------------------- cc = &Common ; cholmod_l_start (cc) ; spqr_mx_config (SPUMONI, cc) ; // ------------------------------------------------------------------------- // check inputs // ------------------------------------------------------------------------- // nargin can be 2 or 3 // nargout can be 0 or 1 if (nargout > 1) { mexErrMsgIdAndTxt ("MATLAB:maxlhs", "Too many output arguments") ; } if (nargin < 2) { mexErrMsgIdAndTxt ("MATLAB:minrhs", "Not enough input arguments") ; } if (nargin > 3) { mexErrMsgIdAndTxt ("MATLAB:maxrhs", "Too many input arguments") ; } if (!mxIsStruct (pargin [0])) { mexErrMsgIdAndTxt ("QR:invalidInput", "invalid Q (must be a struct)") ; } // ------------------------------------------------------------------------- // get H, Tau, and P from the Q struct // ------------------------------------------------------------------------- i = mxGetFieldNumber (pargin [0], "H") ; if (i < 0) { mexErrMsgIdAndTxt ("QR:invalidInput", "invalid Q struct") ; } Hmatlab = mxGetFieldByNumber (pargin [0], 0, i) ; nh = mxGetN (Hmatlab) ; if (!mxIsSparse (Hmatlab)) { mexErrMsgIdAndTxt ("QR:invalidInput", "H must be sparse") ; } i = mxGetFieldNumber (pargin [0], "Tau") ; if (i < 0) { mexErrMsgIdAndTxt ("QR:invalidInput", "invalid Q struct") ; } Tau = mxGetFieldByNumber (pargin [0], 0, i) ; if (nh != mxGetNumberOfElements (Tau)) { mexErrMsgIdAndTxt ("QR:invalidInput", "H and Tau must have the same number of columns") ; } is_complex = mxIsComplex (Tau) || mxIsComplex (Hmatlab) || mxIsComplex (pargin [1]) ; // ------------------------------------------------------------------------- // get the Householder vectors // ------------------------------------------------------------------------- H = spqr_mx_get_sparse (Hmatlab, &Hmatrix, &dummy) ; mh = H->nrow ; Hx = spqr_mx_merge_if_complex (Hmatlab, is_complex, &hnz, cc) ; if (is_complex) { // H has been converted from real or zomplex to complex H->x = Hx ; H->z = NULL ; H->xtype = CHOLMOD_COMPLEX ; } // ------------------------------------------------------------------------- // get Tau // ------------------------------------------------------------------------- HTau = spqr_mx_get_dense (Tau, &HTau_matrix, &dummy) ; Tx = spqr_mx_merge_if_complex (Tau, is_complex, &tnz, cc) ; if (is_complex) { // HTau has been converted from real or zomplex to complex HTau->x = Tx ; HTau->z = NULL ; HTau->xtype = CHOLMOD_COMPLEX ; } // ------------------------------------------------------------------------- // get method // ------------------------------------------------------------------------- if (nargin < 3) { method = 0 ; } else { method = (Long) mxGetScalar (pargin [2]) ; if (method < 0 || method > 3) { mexErrMsgIdAndTxt ("QR:invalidInput", "invalid method") ; } } // ------------------------------------------------------------------------- // get X // ------------------------------------------------------------------------- m = mxGetM (pargin [1]) ; n = mxGetN (pargin [1]) ; X_is_sparse = mxIsSparse (pargin [1]) ; Xsparse = NULL ; if (X_is_sparse) { Xsparse = spqr_mx_get_sparse (pargin [1], &Xsmatrix, &dummy) ; } else { Xdense = spqr_mx_get_dense (pargin [1], &Xdmatrix, &dummy) ; } Xx = spqr_mx_merge_if_complex (pargin [1], is_complex, &xnz, cc) ; if (is_complex) { // X has been converted from real or zomplex to complex if (X_is_sparse) { Xsparse->x = Xx ; Xsparse->xtype = CHOLMOD_COMPLEX ; } else { Xdense->x = Xx ; Xdense->xtype = CHOLMOD_COMPLEX ; } } if (method == 0 || method == 1) { if (mh != m) { mexErrMsgIdAndTxt ("QR:invalidInput", "H and X must have same number of rows") ; } } else { if (mh != n) { mexErrMsgIdAndTxt ("QR:invalidInput", "# of cols of X must equal # of rows of H") ; } } // ------------------------------------------------------------------------- // get P // ------------------------------------------------------------------------- i = mxGetFieldNumber (pargin [0], "P") ; gotP = (i >= 0) ; HPinv = NULL ; if (gotP) { // get P from the H struct P = mxGetFieldByNumber (pargin [0], 0, i) ; if (mxGetNumberOfElements (P) != mh) { mexErrMsgIdAndTxt ("QR:invalidInput", "P must be a vector of length equal to # rows of H") ; } HPinv = (Long *) cholmod_l_malloc (mh, sizeof (Long), cc) ; Px = mxGetPr (P) ; for (i = 0 ; i < mh ; i++) { HPinv [i] = (Long) (Px [i] - 1) ; if (HPinv [i] < 0 || HPinv [i] >= mh) { mexErrMsgIdAndTxt ("QR:invalidInput", "invalid permutation") ; } } } // ------------------------------------------------------------------------- // Y = Q'*X, Q*X, X*Q or X*Q' // ------------------------------------------------------------------------- if (is_complex) { if (X_is_sparse) { Ysparse = SuiteSparseQR_qmult <Complex> (method, H, HTau, HPinv, Xsparse, cc) ; pargout [0] = spqr_mx_put_sparse (&Ysparse, cc) ; } else { Ydense = SuiteSparseQR_qmult <Complex> (method, H, HTau, HPinv, Xdense, cc) ; pargout [0] = spqr_mx_put_dense (&Ydense, cc) ; } } else { if (X_is_sparse) { Ysparse = SuiteSparseQR_qmult <double> (method, H, HTau, HPinv, Xsparse, cc) ; pargout [0] = spqr_mx_put_sparse (&Ysparse, cc) ; } else { Ydense = SuiteSparseQR_qmult <double> (method, H, HTau, HPinv, Xdense, cc) ; pargout [0] = spqr_mx_put_dense (&Ydense, cc) ; } } // ------------------------------------------------------------------------- // free workspace // ------------------------------------------------------------------------- cholmod_l_free (mh, sizeof (Long), HPinv, cc) ; if (is_complex) { // free the merged copies of the real parts of the H and Tau matrices cholmod_l_free (hnz, sizeof (Complex), Hx, cc) ; cholmod_l_free (tnz, sizeof (Complex), Tx, cc) ; cholmod_l_free (xnz, sizeof (Complex), Xx, cc) ; } cholmod_l_finish (cc) ; #if 0 // malloc count for testing only ... spqr_mx_get_usage (pargout [0], 1, &inuse, &count, cc) ; if (inuse != cc->memory_inuse || count != cc->malloc_count) { mexErrMsgIdAndTxt ("QR:internalError", "memory leak!") ; } #endif }
template <typename Entry> int spqr_1fixed ( // inputs, not modified double tol, // only accept singletons above tol Long bncols, // number of columns of B cholmod_sparse *A, // m-by-n sparse matrix // output arrays, neither allocated nor defined on input. Long **p_R1p, // size n1rows+1, R1p [k] = # of nonzeros in kth // row of R1. NULL if n1cols == 0. Long **p_P1inv, // size m, singleton row inverse permutation. // If row i of A is the kth singleton row, then // P1inv [i] = k. NULL if n1cols is zero. cholmod_sparse **p_Y, // on output, only the first n-n1cols+1 entries of // Y->p are defined (if Y is not NULL), where // Y = [A B] or Y = [A2 B2]. If B is empty and // there are no column singletons, Y is NULL Long *p_n1cols, // number of column singletons found Long *p_n1rows, // number of corresponding rows found // workspace and parameters cholmod_common *cc ) { cholmod_sparse *Y ; Long *P1inv, *R1p, *Yp, *Qrows, *Ap, *Ai ; char *Mark ; Entry *Ax ; Long i, j, k, p, d, row, n1rows, n1cols, ynz, iold, inew, kk, m, n, xtype ; // ------------------------------------------------------------------------- // get inputs // ------------------------------------------------------------------------- xtype = spqr_type <Entry> ( ) ; m = A->nrow ; n = A->ncol ; Ap = (Long *) A->p ; Ai = (Long *) A->i ; Ax = (Entry *) A->x ; // set outputs to NULL in case of early return *p_R1p = NULL ; *p_P1inv = NULL ; *p_Y = NULL ; *p_n1cols = EMPTY ; *p_n1rows = EMPTY ; // ------------------------------------------------------------------------- // allocate workspace // ------------------------------------------------------------------------- Mark = (char *) cholmod_l_calloc (m, sizeof (char), cc) ; Qrows = (Long *) cholmod_l_malloc (n, sizeof (Long), cc) ; if (cc->status < CHOLMOD_OK) { // out of memory cholmod_l_free (m, sizeof (char), Mark, cc) ; cholmod_l_free (n, sizeof (Long), Qrows, cc) ; return (FALSE) ; } // ------------------------------------------------------------------------- // find singletons; no column permutations allowed // ------------------------------------------------------------------------- n1cols = 0 ; // number of column singletons found n1rows = 0 ; // number of corresponding singleton rows for (j = 0 ; j < n ; j++) { // count the number of unmarked rows in column j Entry aij = 0 ; d = 0 ; row = EMPTY ; for (p = Ap [j] ; d < 2 && p < Ap [j+1] ; p++) { i = Ai [p] ; if (!Mark [i]) { // row i is not taken by a prior column singleton. If this // is the only unflagged row and the value is large enough, // it will become the row for this column singleton. aij = Ax [p] ; row = i ; d++ ; } } if (d == 0) { // j is a dead column singleton Qrows [n1cols++] = EMPTY ; } else if (d == 1 && spqr_abs (aij, cc) > tol) { // j is a live column singleton Qrows [n1cols++] = row ; // flag row i as taken Mark [row] = TRUE ; n1rows++ ; } else { // j is not a singleton; quit searching break ; } } // ------------------------------------------------------------------------- // construct P1inv permutation, row counts R1p, and col pointers Yp // ------------------------------------------------------------------------- if (n1cols == 0 && bncols == 0) { // --------------------------------------------------------------------- // no singletons, and B empty; Y=A will be done via pointer alias // --------------------------------------------------------------------- Y = NULL ; Yp = NULL ; P1inv = NULL ; R1p = NULL ; } else if (n1cols == 0) { // --------------------------------------------------------------------- // no singletons in the matrix; no R1 matrix, no P1inv permutation // --------------------------------------------------------------------- // Y has no entries yet; nnz(Y) will be determined later Y = cholmod_l_allocate_sparse (m, n+bncols, 0, FALSE, TRUE, 0, xtype, cc) ; if (cc->status < CHOLMOD_OK) { // out of memory cholmod_l_free (m, sizeof (char), Mark, cc) ; cholmod_l_free (n, sizeof (Long), Qrows, cc) ; return (FALSE) ; } Yp = (Long *) Y->p ; ASSERT (n1rows == 0) ; P1inv = NULL ; R1p = NULL ; // --------------------------------------------------------------------- // copy the column pointers of A for the first part of Y = [A B] // --------------------------------------------------------------------- ynz = Ap [n] ; for (k = 0 ; k <= n ; k++) { Yp [k] = Ap [k] ; } } else { // --------------------------------------------------------------------- // construct the row singleton permutation // --------------------------------------------------------------------- // Y has no entries yet; nnz(Y) will be determined later Y = cholmod_l_allocate_sparse (m-n1rows, n-n1cols+bncols, 0, TRUE, TRUE, 0, xtype, cc) ; P1inv = (Long *) cholmod_l_malloc (m, sizeof (Long), cc) ; R1p = (Long *) cholmod_l_calloc (n1rows+1, sizeof (Long), cc) ; if (cc->status < CHOLMOD_OK) { // out of memory cholmod_l_free_sparse (&Y, cc) ; cholmod_l_free (m, sizeof (Long), P1inv, cc) ; cholmod_l_free (n1rows+1, sizeof (Long), R1p, cc) ; cholmod_l_free (m, sizeof (char), Mark, cc) ; cholmod_l_free (n, sizeof (Long), Qrows, cc) ; return (FALSE) ; } Yp = (Long *) Y->p ; #ifndef NDEBUG for (i = 0 ; i < m ; i++) P1inv [i] = EMPTY ; #endif kk = 0 ; for (k = 0 ; k < n1cols ; k++) { i = Qrows [k] ; if (i != EMPTY) { // row i is the kk-th singleton row ASSERT (Mark [i]) ; ASSERT (P1inv [i] == EMPTY) ; P1inv [i] = kk ; kk++ ; } } for (i = 0 ; i < m ; i++) { if (!Mark [i]) { // row i is not a singleton row ASSERT (P1inv [i] == EMPTY) ; P1inv [i] = kk ; kk++ ; } } ASSERT (kk == m) ; // --------------------------------------------------------------------- // find row counts for R11 // --------------------------------------------------------------------- for (k = 0 ; k < n1cols ; k++) { for (p = Ap [k] ; p < Ap [k+1] ; p++) { iold = Ai [p] ; inew = P1inv [iold] ; ASSERT (inew < n1rows) ; R1p [inew]++ ; // a singleton row; in R1 } } // --------------------------------------------------------------------- // find row counts for R12 and column pointers for A2 part of Y // --------------------------------------------------------------------- ynz = 0 ; for ( ; k < n ; k++) { Yp [k-n1cols] = ynz ; for (p = Ap [k] ; p < Ap [k+1] ; p++) { iold = Ai [p] ; inew = P1inv [iold] ; if (inew < n1rows) { R1p [inew]++ ; // a singleton row; in R1 } else { ynz++ ; // not a singleton row; in A2 } } } Yp [n-n1cols] = ynz ; #ifndef NDEBUG PR (("n1cols: %ld\n", n1cols)) ; for (i = 0 ; i < n1rows ; i++) { PR (("R1p [%ld] is %ld\n", i, R1p [i])) ; ASSERT (R1p [i] > 0) ; } #endif } // ------------------------------------------------------------------------- // free workspace and return results // ------------------------------------------------------------------------- cholmod_l_free (n, sizeof (Long), Qrows, cc) ; cholmod_l_free (m, sizeof (char), Mark, cc) ; *p_R1p = R1p ; *p_P1inv = P1inv ; *p_Y = Y ; *p_n1cols = n1cols ; *p_n1rows = n1rows ; return (TRUE) ; }