int CHOLMOD(row_lsubtree) ( /* ---- input ---- */ cholmod_sparse *A, /* matrix to analyze */ Int *Fi, size_t fnz, /* nonzero pattern of kth row of A', not required * for the symmetric case. Need not be sorted. */ size_t krow, /* row k of L */ cholmod_factor *L, /* the factor L from which parent(i) is derived */ /* ---- output --- */ cholmod_sparse *R, /* pattern of L(k,:), 1-by-n with R->nzmax >= n */ /* --------------- */ cholmod_common *Common ) { Int *Rp, *Stack, *Flag, *Ap, *Ai, *Anz, *Lp, *Li, *Lnz ; Int p, pend, parent, t, stype, nrow, k, pf, packed, sorted, top, len, i, mark ; /* ---------------------------------------------------------------------- */ /* check inputs */ /* ---------------------------------------------------------------------- */ RETURN_IF_NULL_COMMON (FALSE) ; RETURN_IF_NULL (A, FALSE) ; RETURN_IF_NULL (R, FALSE) ; RETURN_IF_NULL (L, FALSE) ; RETURN_IF_XTYPE_INVALID (A, CHOLMOD_PATTERN, CHOLMOD_ZOMPLEX, FALSE) ; RETURN_IF_XTYPE_INVALID (R, CHOLMOD_PATTERN, CHOLMOD_ZOMPLEX, FALSE) ; RETURN_IF_XTYPE_INVALID (L, CHOLMOD_REAL, CHOLMOD_ZOMPLEX, FALSE) ; stype = A->stype ; if (stype == 0) { RETURN_IF_NULL (Fi, FALSE) ; } if (krow >= A->nrow) { ERROR (CHOLMOD_INVALID, "lsubtree: k invalid") ; return (FALSE) ; } if (R->ncol != 1 || A->nrow != R->nrow || A->nrow > R->nzmax) { ERROR (CHOLMOD_INVALID, "lsubtree: R invalid") ; return (FALSE) ; } if (L->is_super) { ERROR (CHOLMOD_INVALID, "lsubtree: L invalid (cannot be supernodal)") ; return (FALSE) ; } Common->status = CHOLMOD_OK ; /* ---------------------------------------------------------------------- */ /* allocate workspace */ /* ---------------------------------------------------------------------- */ nrow = A->nrow ; CHOLMOD(allocate_work) (nrow, 0, 0, Common) ; if (Common->status < CHOLMOD_OK) { return (FALSE) ; } ASSERT (CHOLMOD(dump_work) (TRUE, TRUE, 0, Common)) ; /* ---------------------------------------------------------------------- */ /* get inputs */ /* ---------------------------------------------------------------------- */ if (stype < 0) { /* symmetric lower triangular form not supported */ ERROR (CHOLMOD_INVALID, "symmetric lower not supported") ; return (FALSE) ; } Ap = A->p ; Ai = A->i ; Anz = A->nz ; packed = A->packed ; sorted = A->sorted ; k = krow ; Stack = R->i ; Lp = L->p ; Li = L->i ; Lnz = L->nz ; /* ---------------------------------------------------------------------- */ /* get workspace */ /* ---------------------------------------------------------------------- */ Flag = Common->Flag ; /* size nrow, Flag [i] < mark must hold */ mark = CHOLMOD(clear_flag) (Common) ; /* ---------------------------------------------------------------------- */ /* compute the pattern of L(k,:) */ /* ---------------------------------------------------------------------- */ top = nrow ; /* Stack is empty */ Flag [k] = mark ; /* do not include diagonal entry in Stack */ #define SCATTER /* do not scatter numerical values */ #define PARENT(i) (Lnz [i] > 1) ? (Li [Lp [i] + 1]) : EMPTY if (stype != 0) { /* scatter kth col of triu (A), get pattern L(k,:) */ p = Ap [k] ; pend = (packed) ? (Ap [k+1]) : (p + Anz [k]) ; SUBTREE ; } else { /* scatter kth col of triu (beta*I+AA'), get pattern L(k,:) */ for (pf = 0 ; pf < (Int) fnz ; pf++) { /* get nonzero entry F (t,k) */ t = Fi [pf] ; p = Ap [t] ; pend = (packed) ? (Ap [t+1]) : (p + Anz [t]) ; SUBTREE ; } } #undef SCATTER #undef PARENT /* shift the stack upwards, to the first part of R */ len = nrow - top ; for (i = 0 ; i < len ; i++) { Stack [i] = Stack [top + i] ; } Rp = R->p ; Rp [0] = 0 ; Rp [1] = len ; R->sorted = FALSE ; CHOLMOD(clear_flag) (Common) ; ASSERT (CHOLMOD(dump_work) (TRUE, TRUE, 0, Common)) ; return (TRUE) ; }
int CHOLMOD(colamd) ( /* ---- input ---- */ cholmod_sparse *A, /* matrix to order */ Int *fset, /* subset of 0:(A->ncol)-1 */ size_t fsize, /* size of fset */ int postorder, /* if TRUE, follow with a coletree postorder */ /* ---- output --- */ Int *Perm, /* size A->nrow, output permutation */ /* --------------- */ cholmod_common *Common ) { double knobs [COLAMD_KNOBS] ; cholmod_sparse *C ; Int *NewPerm, *Parent, *Post, *Work2n ; Int k, nrow, ncol ; size_t s, alen ; int ok = TRUE ; /* ---------------------------------------------------------------------- */ /* check inputs */ /* ---------------------------------------------------------------------- */ RETURN_IF_NULL_COMMON (FALSE) ; RETURN_IF_NULL (A, FALSE) ; RETURN_IF_NULL (Perm, FALSE) ; RETURN_IF_XTYPE_INVALID (A, CHOLMOD_PATTERN, CHOLMOD_ZOMPLEX, FALSE) ; if (A->stype != 0) { ERROR (CHOLMOD_INVALID, "matrix must be unsymmetric") ; return (FALSE) ; } Common->status = CHOLMOD_OK ; /* ---------------------------------------------------------------------- */ /* get inputs */ /* ---------------------------------------------------------------------- */ nrow = A->nrow ; ncol = A->ncol ; /* ---------------------------------------------------------------------- */ /* allocate workspace */ /* ---------------------------------------------------------------------- */ /* Note: this is less than the space used in cholmod_analyze, so if * cholmod_colamd is being called by that routine, no space will be * allocated. */ /* s = 4*nrow + ncol */ s = CHOLMOD(mult_size_t) (nrow, 4, &ok) ; s = CHOLMOD(add_size_t) (s, ncol, &ok) ; #ifdef LONG alen = colamd_l_recommended (A->nzmax, ncol, nrow) ; colamd_l_set_defaults (knobs) ; #else alen = colamd_recommended (A->nzmax, ncol, nrow) ; colamd_set_defaults (knobs) ; #endif if (!ok || alen == 0) { ERROR (CHOLMOD_TOO_LARGE, "matrix invalid or too large") ; return (FALSE) ; } CHOLMOD(allocate_work) (0, s, 0, Common) ; if (Common->status < CHOLMOD_OK) { return (FALSE) ; } /* ---------------------------------------------------------------------- */ /* allocate COLAMD workspace */ /* ---------------------------------------------------------------------- */ /* colamd_printf is only available in colamd v2.4 or later */ colamd_printf = Common->print_function ; C = CHOLMOD(allocate_sparse) (ncol, nrow, alen, TRUE, TRUE, 0, CHOLMOD_PATTERN, Common) ; /* ---------------------------------------------------------------------- */ /* copy (and transpose) the input matrix A into the colamd workspace */ /* ---------------------------------------------------------------------- */ /* C = A (:,f)', which also packs A if needed. */ /* workspace: Iwork (nrow if no fset; MAX (nrow,ncol) if fset) */ ok = CHOLMOD(transpose_unsym) (A, 0, NULL, fset, fsize, C, Common) ; /* ---------------------------------------------------------------------- */ /* order the matrix (destroys the contents of C->i and C->p) */ /* ---------------------------------------------------------------------- */ /* get parameters */ if (Common->current < 0 || Common->current >= CHOLMOD_MAXMETHODS) { /* this is the CHOLMOD default, not the COLAMD default */ knobs [COLAMD_DENSE_ROW] = -1 ; } else { /* get the knobs from the Common parameters */ knobs [COLAMD_DENSE_COL] = Common->method[Common->current].prune_dense ; knobs [COLAMD_DENSE_ROW] = Common->method[Common->current].prune_dense2; knobs [COLAMD_AGGRESSIVE] = Common->method[Common->current].aggressive ; } if (ok) { Int *Cp ; Int stats [COLAMD_STATS] ; Cp = C->p ; #ifdef LONG colamd_l (ncol, nrow, alen, C->i, Cp, knobs, stats) ; #else colamd (ncol, nrow, alen, C->i, Cp, knobs, stats) ; #endif ok = stats [COLAMD_STATUS] ; ok = (ok == COLAMD_OK || ok == COLAMD_OK_BUT_JUMBLED) ; /* permutation returned in C->p, if the ordering succeeded */ for (k = 0 ; k < nrow ; k++) { Perm [k] = Cp [k] ; } } CHOLMOD(free_sparse) (&C, Common) ; /* ---------------------------------------------------------------------- */ /* column etree postordering */ /* ---------------------------------------------------------------------- */ if (postorder) { /* use the last 2*n space in Iwork for Parent and Post */ Work2n = Common->Iwork ; Work2n += 2*((size_t) nrow) + ncol ; Parent = Work2n ; /* size nrow (i/i/l) */ Post = Work2n + nrow ; /* size nrow (i/i/l) */ /* workspace: Iwork (2*nrow+ncol), Flag (nrow), Head (nrow+1) */ ok = ok && CHOLMOD(analyze_ordering) (A, CHOLMOD_COLAMD, Perm, fset, fsize, Parent, Post, NULL, NULL, NULL, Common) ; /* combine the colamd permutation with its postordering */ if (ok) { NewPerm = Common->Iwork ; /* size nrow (i/i/l) */ for (k = 0 ; k < nrow ; k++) { NewPerm [k] = Perm [Post [k]] ; } for (k = 0 ; k < nrow ; k++) { Perm [k] = NewPerm [k] ; } } } return (ok) ; }
cholmod_factor *CHOLMOD(analyze_p2) ( /* ---- input ---- */ int for_cholesky, /* if TRUE, then analyze for Cholesky; else for QR */ cholmod_sparse *A, /* matrix to order and analyze */ Int *UserPerm, /* user-provided permutation, size A->nrow */ Int *fset, /* subset of 0:(A->ncol)-1 */ size_t fsize, /* size of fset */ /* --------------- */ cholmod_common *Common ) { double lnz_best ; Int *First, *Level, *Work4n, *Cmember, *CParent, *ColCount, *Lperm, *Parent, *Post, *Perm, *Lparent, *Lcolcount ; cholmod_factor *L ; Int k, n, ordering, method, nmethods, status, default_strategy, ncol, uncol, skip_analysis, skip_best ; Int amd_backup ; size_t s ; int ok = TRUE ; /* ---------------------------------------------------------------------- */ /* check inputs */ /* ---------------------------------------------------------------------- */ RETURN_IF_NULL_COMMON (NULL) ; RETURN_IF_NULL (A, NULL) ; RETURN_IF_XTYPE_INVALID (A, CHOLMOD_PATTERN, CHOLMOD_ZOMPLEX, NULL) ; Common->status = CHOLMOD_OK ; status = CHOLMOD_OK ; Common->selected = EMPTY ; Common->called_nd = FALSE ; /* ---------------------------------------------------------------------- */ /* get inputs */ /* ---------------------------------------------------------------------- */ n = A->nrow ; ncol = A->ncol ; uncol = (A->stype == 0) ? (A->ncol) : 0 ; /* ---------------------------------------------------------------------- */ /* set the default strategy */ /* ---------------------------------------------------------------------- */ lnz_best = (double) EMPTY ; skip_best = FALSE ; nmethods = MIN (Common->nmethods, CHOLMOD_MAXMETHODS) ; nmethods = MAX (0, nmethods) ; PRINT1 (("nmethods "ID"\n", nmethods)) ; default_strategy = (nmethods == 0) ; if (default_strategy) { /* default strategy: try UserPerm, if given. Try AMD for A, or AMD * to order A*A'. Try METIS for the symmetric case only if AMD reports * a high degree of fill-in and flop count. METIS is not tried if the * Partition Module isn't installed. If Common->default_nesdis is * TRUE, then NESDIS is used as the 3rd ordering instead. */ Common->method [0].ordering = CHOLMOD_GIVEN ;/* skip if UserPerm NULL */ Common->method [1].ordering = CHOLMOD_AMD ; Common->method [2].ordering = (Common->default_nesdis ? CHOLMOD_NESDIS : CHOLMOD_METIS) ; amd_backup = FALSE ; #ifndef NPARTITION nmethods = 3 ; #else nmethods = 2 ; #endif } else { /* If only METIS and NESDIS are selected, or if 2 or more methods are * being tried, then enable AMD backup */ amd_backup = (nmethods > 1) || (nmethods == 1 && (Common->method [0].ordering == CHOLMOD_METIS || Common->method [0].ordering == CHOLMOD_NESDIS)) ; } #ifdef NSUPERNODAL /* CHOLMOD Supernodal module not installed, just do simplicial analysis */ Common->supernodal = CHOLMOD_SIMPLICIAL ; #endif /* ---------------------------------------------------------------------- */ /* allocate workspace */ /* ---------------------------------------------------------------------- */ /* Note: enough space needs to be allocated here so that routines called by * cholmod_analyze do not reallocate the space. */ /* s = 6*n + uncol */ s = CHOLMOD(mult_size_t) (n, 6, &ok) ; s = CHOLMOD(add_size_t) (s, uncol, &ok) ; if (!ok) { ERROR (CHOLMOD_TOO_LARGE, "problem too large") ; return (NULL) ; } CHOLMOD(allocate_work) (n, s, 0, Common) ; if (Common->status < CHOLMOD_OK) { return (NULL) ; /* out of memory */ } ASSERT (CHOLMOD(dump_work) (TRUE, TRUE, 0, Common)) ; /* ensure that subsequent routines, called by cholmod_analyze, do not * reallocate any workspace. This is set back to FALSE in the * FREE_WORKSPACE_AND_RETURN macro, which is the only way this function * returns to its caller. */ Common->no_workspace_reallocate = TRUE ; /* Use the last 4*n Int's in Iwork for Parent, First, Level, and Post, since * other CHOLMOD routines will use the first 2n+uncol space. The ordering * routines (cholmod_amd, cholmod_colamd, cholmod_ccolamd, cholmod_metis) * are an exception. They can use all 6n + ncol space, since the contents * of Parent, First, Level, and Post are not needed across calls to those * routines. */ Work4n = Common->Iwork ; Work4n += 2*((size_t) n) + uncol ; Parent = Work4n ; First = Work4n + n ; Level = Work4n + 2*((size_t) n) ; Post = Work4n + 3*((size_t) n) ; /* note that this assignment means that cholmod_nested_dissection, * cholmod_ccolamd, and cholmod_camd can use only the first 4n+uncol * space in Common->Iwork */ Cmember = Post ; CParent = Level ; /* ---------------------------------------------------------------------- */ /* allocate more workspace, and an empty simplicial symbolic factor */ /* ---------------------------------------------------------------------- */ L = CHOLMOD(allocate_factor) (n, Common) ; Lparent = CHOLMOD(malloc) (n, sizeof (Int), Common) ; Perm = CHOLMOD(malloc) (n, sizeof (Int), Common) ; ColCount = CHOLMOD(malloc) (n, sizeof (Int), Common) ; if (Common->status < CHOLMOD_OK) { /* out of memory */ FREE_WORKSPACE_AND_RETURN ; } Lperm = L->Perm ; Lcolcount = L->ColCount ; Common->anz = EMPTY ; /* ---------------------------------------------------------------------- */ /* try all the requested ordering options and backup to AMD if needed */ /* ---------------------------------------------------------------------- */ /* turn off error handling [ */ Common->try_catch = TRUE ; for (method = 0 ; method <= nmethods ; method++) { /* ------------------------------------------------------------------ */ /* determine the method to try */ /* ------------------------------------------------------------------ */ Common->fl = EMPTY ; Common->lnz = EMPTY ; skip_analysis = FALSE ; if (method == nmethods) { /* All methods failed: backup to AMD */ if (Common->selected == EMPTY && amd_backup) { PRINT1 (("All methods requested failed: backup to AMD\n")) ; ordering = CHOLMOD_AMD ; } else { break ; } } else { ordering = Common->method [method].ordering ; } Common->current = method ; PRINT1 (("method "ID": Try method: "ID"\n", method, ordering)) ; /* ------------------------------------------------------------------ */ /* find the fill-reducing permutation */ /* ------------------------------------------------------------------ */ if (ordering == CHOLMOD_NATURAL) { /* -------------------------------------------------------------- */ /* natural ordering */ /* -------------------------------------------------------------- */ for (k = 0 ; k < n ; k++) { Perm [k] = k ; } } else if (ordering == CHOLMOD_GIVEN) { /* -------------------------------------------------------------- */ /* use given ordering of A, if provided */ /* -------------------------------------------------------------- */ if (UserPerm == NULL) { /* this is not an error condition */ PRINT1 (("skip, no user perm given\n")) ; continue ; } for (k = 0 ; k < n ; k++) { /* UserPerm is checked in cholmod_ptranspose */ Perm [k] = UserPerm [k] ; } } else if (ordering == CHOLMOD_AMD) { /* -------------------------------------------------------------- */ /* AMD ordering of A, A*A', or A(:,f)*A(:,f)' */ /* -------------------------------------------------------------- */ amd_backup = FALSE ; /* no need to try AMD twice ... */ CHOLMOD(amd) (A, fset, fsize, Perm, Common) ; skip_analysis = TRUE ; } else if (ordering == CHOLMOD_COLAMD) { /* -------------------------------------------------------------- */ /* AMD for symmetric case, COLAMD for A*A' or A(:,f)*A(:,f)' */ /* -------------------------------------------------------------- */ if (A->stype) { CHOLMOD(amd) (A, fset, fsize, Perm, Common) ; skip_analysis = TRUE ; } else { /* Alternative: CHOLMOD(ccolamd) (A, fset, fsize, NULL, Perm, Common) ; */ /* do not postorder, it is done later, below */ /* workspace: Iwork (4*nrow+uncol), Flag (nrow), Head (nrow+1)*/ CHOLMOD(colamd) (A, fset, fsize, FALSE, Perm, Common) ; } } else if (ordering == CHOLMOD_METIS) { /* -------------------------------------------------------------- */ /* use METIS_NodeND directly (via a CHOLMOD wrapper) */ /* -------------------------------------------------------------- */ #ifndef NPARTITION /* postorder parameter is false, because it will be later, below */ /* workspace: Iwork (4*nrow+uncol), Flag (nrow), Head (nrow+1) */ Common->called_nd = TRUE ; CHOLMOD(metis) (A, fset, fsize, FALSE, Perm, Common) ; #else Common->status = CHOLMOD_NOT_INSTALLED ; #endif } else if (ordering == CHOLMOD_NESDIS) { /* -------------------------------------------------------------- */ /* use CHOLMOD's nested dissection */ /* -------------------------------------------------------------- */ /* this method is based on METIS' node bissection routine * (METIS_NodeComputeSeparator). In contrast to METIS_NodeND, * it calls CAMD or CCOLAMD on the whole graph, instead of MMD * on just the leaves. */ #ifndef NPARTITION /* workspace: Flag (nrow), Head (nrow+1), Iwork (2*nrow) */ Common->called_nd = TRUE ; CHOLMOD(nested_dissection) (A, fset, fsize, Perm, CParent, Cmember, Common) ; #else Common->status = CHOLMOD_NOT_INSTALLED ; #endif } else { /* -------------------------------------------------------------- */ /* invalid ordering method */ /* -------------------------------------------------------------- */ Common->status = CHOLMOD_INVALID ; PRINT1 (("No such ordering: "ID"\n", ordering)) ; } ASSERT (CHOLMOD(dump_work) (TRUE, TRUE, 0, Common)) ; if (Common->status < CHOLMOD_OK) { /* out of memory, or method failed */ status = MIN (status, Common->status) ; Common->status = CHOLMOD_OK ; continue ; } /* ------------------------------------------------------------------ */ /* analyze the ordering */ /* ------------------------------------------------------------------ */ if (!skip_analysis) { if (!CHOLMOD(analyze_ordering) (A, ordering, Perm, fset, fsize, Parent, Post, ColCount, First, Level, Common)) { /* ordering method failed; clear status and try next method */ status = MIN (status, Common->status) ; Common->status = CHOLMOD_OK ; continue ; } } ASSERT (Common->fl >= 0 && Common->lnz >= 0) ; Common->method [method].fl = Common->fl ; Common->method [method].lnz = Common->lnz ; PRINT1 (("lnz %g fl %g\n", Common->lnz, Common->fl)) ; /* ------------------------------------------------------------------ */ /* pick the best method */ /* ------------------------------------------------------------------ */ /* fl.pt. compare, but lnz can never be NaN */ if (Common->selected == EMPTY || Common->lnz < lnz_best) { Common->selected = method ; PRINT1 (("this is best so far, method "ID"\n", method)) ; L->ordering = ordering ; lnz_best = Common->lnz ; for (k = 0 ; k < n ; k++) { Lperm [k] = Perm [k] ; } /* save the results of cholmod_analyze_ordering, if it was called */ skip_best = skip_analysis ; if (!skip_analysis) { /* save the column count; becomes permanent part of L */ for (k = 0 ; k < n ; k++) { Lcolcount [k] = ColCount [k] ; } /* Parent is needed for weighted postordering and for supernodal * analysis. Does not become a permanent part of L */ for (k = 0 ; k < n ; k++) { Lparent [k] = Parent [k] ; } } } /* ------------------------------------------------------------------ */ /* determine if METIS is to be skipped */ /* ------------------------------------------------------------------ */ if (default_strategy && ordering == CHOLMOD_AMD) { if ((Common->fl < 500 * Common->lnz) || (Common->lnz < 5 * Common->anz)) { /* AMD found an ordering with less than 500 flops per nonzero in * L, or one with a fill-in ratio (nnz(L)/nnz(A)) of less than * 5. This is pretty good, and it's unlikely that METIS will do * better (this heuristic is based on tests on all symmetric * positive definite matrices in the UF sparse matrix * collection, and it works well across a wide range of * problems). METIS can take much more time than AMD. */ break ; } } } /* turn error printing back on ] */ Common->try_catch = FALSE ; /* ---------------------------------------------------------------------- */ /* return if no ordering method succeeded */ /* ---------------------------------------------------------------------- */ if (Common->selected == EMPTY) { /* All methods failed. * If two or more methods failed, they may have failed for different * reasons. Both would clear Common->status and skip to the next * method. Common->status needs to be restored here to the worst error * obtained in any of the methods. CHOLMOD_INVALID is worse * than CHOLMOD_OUT_OF_MEMORY, since the former implies something may * be wrong with the user's input. CHOLMOD_OUT_OF_MEMORY is simply an * indication of lack of resources. */ ASSERT (status < CHOLMOD_OK) ; ERROR (status, "all methods failed") ; FREE_WORKSPACE_AND_RETURN ; } /* ---------------------------------------------------------------------- */ /* do the analysis for AMD, if skipped */ /* ---------------------------------------------------------------------- */ Common->fl = Common->method [Common->selected].fl ; Common->lnz = Common->method [Common->selected].lnz ; ASSERT (Common->lnz >= 0) ; if (skip_best) { if (!CHOLMOD(analyze_ordering) (A, L->ordering, Lperm, fset, fsize, Lparent, Post, Lcolcount, First, Level, Common)) { /* out of memory, or method failed */ FREE_WORKSPACE_AND_RETURN ; } } /* ---------------------------------------------------------------------- */ /* postorder the etree, weighted by the column counts */ /* ---------------------------------------------------------------------- */ if (Common->postorder) { /* combine the fill-reducing ordering with the weighted postorder */ /* workspace: Iwork (2*nrow) */ if (CHOLMOD(postorder) (Lparent, n, Lcolcount, Post, Common) == n) { /* use First and Level as workspace [ */ Int *Wi = First, *InvPost = Level ; Int newchild, oldchild, newparent, oldparent ; for (k = 0 ; k < n ; k++) { Wi [k] = Lperm [Post [k]] ; } for (k = 0 ; k < n ; k++) { Lperm [k] = Wi [k] ; } for (k = 0 ; k < n ; k++) { Wi [k] = Lcolcount [Post [k]] ; } for (k = 0 ; k < n ; k++) { Lcolcount [k] = Wi [k] ; } for (k = 0 ; k < n ; k++) { InvPost [Post [k]] = k ; } /* updated Lparent needed only for supernodal case */ for (newchild = 0 ; newchild < n ; newchild++) { oldchild = Post [newchild] ; oldparent = Lparent [oldchild] ; newparent = (oldparent == EMPTY) ? EMPTY : InvPost [oldparent] ; Wi [newchild] = newparent ; } for (k = 0 ; k < n ; k++) { Lparent [k] = Wi [k] ; } /* done using Iwork as workspace ] */ /* L is now postordered, no longer in natural ordering */ if (L->ordering == CHOLMOD_NATURAL) { L->ordering = CHOLMOD_POSTORDERED ; } } } /* ---------------------------------------------------------------------- */ /* supernodal analysis, if requested or if selected automatically */ /* ---------------------------------------------------------------------- */ #ifndef NSUPERNODAL if (Common->supernodal > CHOLMOD_AUTO || (Common->supernodal == CHOLMOD_AUTO && Common->lnz > 0 && (Common->fl / Common->lnz) >= Common->supernodal_switch)) { cholmod_sparse *S, *F, *A2, *A1 ; permute_matrices (A, L->ordering, Lperm, fset, fsize, TRUE, &A1, &A2, &S, &F, Common) ; /* workspace: Flag (nrow), Head (nrow), Iwork (5*nrow) */ CHOLMOD(super_symbolic2) (for_cholesky, S, F, Lparent, L, Common) ; PRINT1 (("status %d\n", Common->status)) ; CHOLMOD(free_sparse) (&A1, Common) ; CHOLMOD(free_sparse) (&A2, Common) ; } #endif /* ---------------------------------------------------------------------- */ /* free temporary matrices and workspace, and return result L */ /* ---------------------------------------------------------------------- */ FREE_WORKSPACE_AND_RETURN ; }
int CHOLMOD(metis) ( /* ---- input ---- */ cholmod_sparse *A, /* matrix to order */ Int *fset, /* subset of 0:(A->ncol)-1 */ size_t fsize, /* size of fset */ int postorder, /* if TRUE, follow with etree or coletree postorder */ /* ---- output --- */ Int *Perm, /* size A->nrow, output permutation */ /* --------------- */ cholmod_common *Common ) { double d ; Int *Iperm, *Iwork, *Bp, *Bi ; idxtype *Mp, *Mi, *Mperm, *Miperm ; cholmod_sparse *B ; Int i, j, n, nz, p, identity, uncol ; int Opt [8], nn, zero = 0 ; size_t n1, s ; int ok = TRUE ; /* ---------------------------------------------------------------------- */ /* get inputs */ /* ---------------------------------------------------------------------- */ RETURN_IF_NULL_COMMON (FALSE) ; RETURN_IF_NULL (A, FALSE) ; RETURN_IF_NULL (Perm, FALSE) ; RETURN_IF_XTYPE_INVALID (A, CHOLMOD_PATTERN, CHOLMOD_ZOMPLEX, FALSE) ; Common->status = CHOLMOD_OK ; /* ---------------------------------------------------------------------- */ /* quick return */ /* ---------------------------------------------------------------------- */ n = A->nrow ; if (n == 0) { return (TRUE) ; } n1 = ((size_t) n) + 1 ; /* ---------------------------------------------------------------------- */ /* allocate workspace */ /* ---------------------------------------------------------------------- */ /* s = 4*n + uncol */ uncol = (A->stype == 0) ? A->ncol : 0 ; s = CHOLMOD(mult_size_t) (n, 4, &ok) ; s = CHOLMOD(add_size_t) (s, uncol, &ok) ; if (!ok) { ERROR (CHOLMOD_TOO_LARGE, "problem too large") ; return (FALSE) ; } CHOLMOD(allocate_work) (n, s, 0, Common) ; if (Common->status < CHOLMOD_OK) { return (FALSE) ; } ASSERT (CHOLMOD(dump_work) (TRUE, TRUE, 0, Common)) ; /* ---------------------------------------------------------------------- */ /* convert the matrix to adjacency list form */ /* ---------------------------------------------------------------------- */ /* The input graph for METIS must be symmetric, with both upper and lower * parts present, and with no diagonal entries. The columns need not be * sorted. * B = A+A', A*A', or A(:,f)*A(:,f)', upper and lower parts present */ if (A->stype) { /* Add the upper/lower part to a symmetric lower/upper matrix by * converting to unsymmetric mode */ /* workspace: Iwork (nrow) */ B = CHOLMOD(copy) (A, 0, -1, Common) ; } else { /* B = A*A' or A(:,f)*A(:,f)', no diagonal */ /* workspace: Flag (nrow), Iwork (max (nrow,ncol)) */ B = CHOLMOD(aat) (A, fset, fsize, -1, Common) ; } ASSERT (CHOLMOD(dump_sparse) (B, "B for NodeND", Common) >= 0) ; if (Common->status < CHOLMOD_OK) { return (FALSE) ; } ASSERT (B->nrow == A->nrow) ; /* ---------------------------------------------------------------------- */ /* get inputs */ /* ---------------------------------------------------------------------- */ Iwork = Common->Iwork ; Iperm = Iwork ; /* size n (i/i/l) */ Bp = B->p ; Bi = B->i ; nz = Bp [n] ; /* ---------------------------------------------------------------------- */ /* METIS does not have a UF_long integer version */ /* ---------------------------------------------------------------------- */ #ifdef LONG if (sizeof (Int) > sizeof (idxtype) && MAX (n,nz) > INT_MAX / sizeof (int)) { /* CHOLMOD's matrix is too large for METIS */ CHOLMOD(free_sparse) (&B, Common) ; return (FALSE) ; } #endif /* B does not include the diagonal, and both upper and lower parts. * Common->anz includes the diagonal, and just the lower part of B */ Common->anz = nz / 2 + n ; /* ---------------------------------------------------------------------- */ /* set control parameters for METIS_NodeND */ /* ---------------------------------------------------------------------- */ Opt [0] = 0 ; /* use defaults */ Opt [1] = 3 ; /* matching type */ Opt [2] = 1 ; /* init. partitioning algo*/ Opt [3] = 2 ; /* refinement algorithm */ Opt [4] = 0 ; /* no debug */ Opt [5] = 1 ; /* initial compression */ Opt [6] = 0 ; /* no dense node removal */ Opt [7] = 1 ; /* number of separators @ each step */ /* ---------------------------------------------------------------------- */ /* allocate the METIS input arrays, if needed */ /* ---------------------------------------------------------------------- */ if (sizeof (Int) == sizeof (idxtype)) { /* This is the typical case. */ Miperm = (idxtype *) Iperm ; Mperm = (idxtype *) Perm ; Mp = (idxtype *) Bp ; Mi = (idxtype *) Bi ; } else { /* allocate graph for METIS only if Int and idxtype differ */ Miperm = CHOLMOD(malloc) (n, sizeof (idxtype), Common) ; Mperm = CHOLMOD(malloc) (n, sizeof (idxtype), Common) ; Mp = CHOLMOD(malloc) (n1, sizeof (idxtype), Common) ; Mi = CHOLMOD(malloc) (nz, sizeof (idxtype), Common) ; if (Common->status < CHOLMOD_OK) { /* out of memory */ CHOLMOD(free_sparse) (&B, Common) ; CHOLMOD(free) (n, sizeof (idxtype), Miperm, Common) ; CHOLMOD(free) (n, sizeof (idxtype), Mperm, Common) ; CHOLMOD(free) (n1, sizeof (idxtype), Mp, Common) ; CHOLMOD(free) (nz, sizeof (idxtype), Mi, Common) ; return (FALSE) ; } for (j = 0 ; j <= n ; j++) { Mp [j] = Bp [j] ; } for (p = 0 ; p < nz ; p++) { Mi [p] = Bi [p] ; } } /* ---------------------------------------------------------------------- */ /* METIS workarounds */ /* ---------------------------------------------------------------------- */ identity = FALSE ; if (nz == 0) { /* The matrix has no off-diagonal entries. METIS_NodeND fails in this * case, so avoid using it. The best permutation is identity anyway, * so this is an easy fix. */ identity = TRUE ; PRINT1 (("METIS:: no nz\n")) ; } else if (Common->metis_nswitch > 0) { /* METIS_NodeND in METIS 4.0.1 gives a seg fault with one matrix of * order n = 3005 and nz = 6,036,025, including the diagonal entries. * The workaround is to return the identity permutation instead of using * METIS for matrices of dimension 3000 or more and with density of 66% * or more - admittedly an uncertain fix, but such matrices are so dense * that any reasonable ordering will do, even identity (n^2 is only 50% * higher than nz in this case). CHOLMOD's nested dissection method * (cholmod_nested_dissection) has no problems with the same matrix, * even though it too uses METIS_NodeComputeSeparator. The matrix is * derived from LPnetlib/lpi_cplex1 in the UF sparse matrix collection. * If C is the lpi_cplex matrix (of order 3005-by-5224), A = (C*C')^2 * results in the seg fault. The seg fault also occurs in the stand- * alone onmetis program that comes with METIS. If a future version of * METIS fixes this problem, then set Common->metis_nswitch to zero. */ d = ((double) nz) / (((double) n) * ((double) n)) ; if (n > (Int) (Common->metis_nswitch) && d > Common->metis_dswitch) { identity = TRUE ; PRINT1 (("METIS:: nswitch/dswitch activated\n")) ; } } if (!identity && !metis_memory_ok (n, nz, Common)) { /* METIS might ask for too much memory and thus terminate the program */ identity = TRUE ; } /* ---------------------------------------------------------------------- */ /* find the permutation */ /* ---------------------------------------------------------------------- */ if (identity) { /* no need to do the postorder */ postorder = FALSE ; for (i = 0 ; i < n ; i++) { Mperm [i] = i ; } } else { #ifdef DUMP_GRAPH /* DUMP_GRAPH */ printf ("Calling METIS_NodeND n "ID" nz "ID"" "density %g\n", n, nz, ((double) nz) / (((double) n) * ((double) n))); dumpgraph (Mp, Mi, n, Common) ; #endif nn = n ; METIS_NodeND (&nn, Mp, Mi, &zero, Opt, Mperm, Miperm) ; n = nn ; PRINT0 (("METIS_NodeND done\n")) ; } /* ---------------------------------------------------------------------- */ /* free the METIS input arrays */ /* ---------------------------------------------------------------------- */ if (sizeof (Int) != sizeof (idxtype)) { for (i = 0 ; i < n ; i++) { Perm [i] = (Int) (Mperm [i]) ; } CHOLMOD(free) (n, sizeof (idxtype), Miperm, Common) ; CHOLMOD(free) (n, sizeof (idxtype), Mperm, Common) ; CHOLMOD(free) (n+1, sizeof (idxtype), Mp, Common) ; CHOLMOD(free) (nz, sizeof (idxtype), Mi, Common) ; } CHOLMOD(free_sparse) (&B, Common) ; /* ---------------------------------------------------------------------- */ /* etree or column-etree postordering, using the Cholesky Module */ /* ---------------------------------------------------------------------- */ if (postorder) { Int *Parent, *Post, *NewPerm ; Int k ; Parent = Iwork + 2*((size_t) n) + uncol ; /* size n = nrow */ Post = Parent + n ; /* size n */ /* workspace: Iwork (2*nrow+uncol), Flag (nrow), Head (nrow+1) */ CHOLMOD(analyze_ordering) (A, CHOLMOD_METIS, Perm, fset, fsize, Parent, Post, NULL, NULL, NULL, Common) ; if (Common->status == CHOLMOD_OK) { /* combine the METIS permutation with its postordering */ NewPerm = Parent ; /* use Parent as workspace */ for (k = 0 ; k < n ; k++) { NewPerm [k] = Perm [Post [k]] ; } for (k = 0 ; k < n ; k++) { Perm [k] = NewPerm [k] ; } } } ASSERT (CHOLMOD(dump_work) (TRUE, TRUE, 0, Common)) ; PRINT1 (("cholmod_metis done\n")) ; return (Common->status == CHOLMOD_OK) ; }
int CHOLMOD(camd) ( /* ---- input ---- */ cholmod_sparse *A, /* matrix to order */ Int *fset, /* subset of 0:(A->ncol)-1 */ size_t fsize, /* size of fset */ Int *Cmember, /* size nrow. see cholmod_ccolamd.c for description.*/ /* ---- output ---- */ Int *Perm, /* size A->nrow, output permutation */ /* --------------- */ cholmod_common *Common ) { double Info [CAMD_INFO], Control2 [CAMD_CONTROL], *Control ; Int *Cp, *Len, *Nv, *Head, *Elen, *Degree, *Wi, *Next, *BucketSet, *Work3n, *p ; cholmod_sparse *C ; Int j, n, cnz ; size_t s ; int ok = TRUE ; /* ---------------------------------------------------------------------- */ /* get inputs */ /* ---------------------------------------------------------------------- */ RETURN_IF_NULL_COMMON (FALSE) ; RETURN_IF_NULL (A, FALSE) ; n = A->nrow ; /* s = 4*n */ s = CHOLMOD(mult_size_t) (n, 4, &ok) ; if (!ok) { ERROR (CHOLMOD_TOO_LARGE, "problem too large") ; return (FALSE) ; } RETURN_IF_NULL (Perm, FALSE) ; RETURN_IF_XTYPE_INVALID (A, CHOLMOD_PATTERN, CHOLMOD_ZOMPLEX, FALSE) ; Common->status = CHOLMOD_OK ; if (n == 0) { /* nothing to do */ Common->fl = 0 ; Common->lnz = 0 ; Common->anz = 0 ; return (TRUE) ; } /* ---------------------------------------------------------------------- */ /* get workspace */ /* ---------------------------------------------------------------------- */ /* cholmod_analyze has allocated Cmember at Common->Iwork + 5*n+uncol, and * CParent at Common->Iwork + 4*n+uncol, where uncol is 0 if A is symmetric * or A->ncol otherwise. Thus, only the first 4n integers in Common->Iwork * can be used here. */ CHOLMOD(allocate_work) (n, s, 0, Common) ; if (Common->status < CHOLMOD_OK) { return (FALSE) ; } p = Common->Iwork ; Degree = p ; p += n ; /* size n */ Elen = p ; p += n ; /* size n */ Len = p ; p += n ; /* size n */ Nv = p ; p += n ; /* size n */ Work3n = CHOLMOD(malloc) (n+1, 3*sizeof (Int), Common) ; if (Common->status < CHOLMOD_OK) { return (FALSE) ; } p = Work3n ; Next = p ; p += n ; /* size n */ Wi = p ; p += (n+1) ; /* size n+1 */ BucketSet = p ; /* size n */ Head = Common->Head ; /* size n+1 */ /* ---------------------------------------------------------------------- */ /* construct the input matrix for CAMD */ /* ---------------------------------------------------------------------- */ if (A->stype == 0) { /* C = A*A' or A(:,f)*A(:,f)', add extra space of nnz(C)/2+n to C */ C = CHOLMOD(aat) (A, fset, fsize, -2, Common) ; } else { /* C = A+A', but use only the upper triangular part of A if A->stype = 1 * and only the lower part of A if A->stype = -1. Add extra space of * nnz(C)/2+n to C. */ C = CHOLMOD(copy) (A, 0, -2, Common) ; } if (Common->status < CHOLMOD_OK) { /* out of memory, fset invalid, or other error */ CHOLMOD(free) (n+1, 3*sizeof (Int), Work3n, Common) ; return (FALSE) ; } Cp = C->p ; for (j = 0 ; j < n ; j++) { Len [j] = Cp [j+1] - Cp [j] ; } /* C does not include the diagonal, and both upper and lower parts. * Common->anz includes the diagonal, and just the lower part of C */ cnz = Cp [n] ; Common->anz = cnz / 2 + n ; /* ---------------------------------------------------------------------- */ /* order C using CAMD */ /* ---------------------------------------------------------------------- */ /* get parameters */ if (Common->current < 0 || Common->current >= CHOLMOD_MAXMETHODS) { /* use CAMD defaults */ Control = NULL ; } else { Control = Control2 ; Control [CAMD_DENSE] = Common->method [Common->current].prune_dense ; Control [CAMD_AGGRESSIVE] = Common->method [Common->current].aggressive; } /* CAMD_2 does not use camd_malloc and camd_free, but set these pointers * just be safe. */ amesos_camd_malloc = Common->malloc_memory ; amesos_camd_free = Common->free_memory ; amesos_camd_calloc = Common->calloc_memory ; amesos_camd_realloc = Common->realloc_memory ; /* CAMD_2 doesn't print anything either, but future versions might, * so set the camd_printf pointer too. */ amesos_camd_printf = Common->print_function ; #ifdef LONG /* DEBUG (camd_l_debug_init ("cholmod_l_camd")) ; */ amesos_camd_l2 (n, C->p, C->i, Len, C->nzmax, cnz, Nv, Next, Perm, Head, Elen, Degree, Wi, Control, Info, Cmember, BucketSet) ; #else /* DEBUG (camd_debug_init ("cholmod_camd")) ; */ amesos_camd_2 (n, C->p, C->i, Len, C->nzmax, cnz, Nv, Next, Perm, Head, Elen, Degree, Wi, Control, Info, Cmember, BucketSet) ; #endif /* LL' flop count. Need to subtract n for LL' flop count. Note that this * is a slight upper bound which is often exact (see CAMD/Source/camd_2.c * for details). cholmod_analyze computes an exact flop count and * fill-in. */ Common->fl = Info [CAMD_NDIV] + 2 * Info [CAMD_NMULTSUBS_LDL] + n ; /* Info [CAMD_LNZ] excludes the diagonal */ Common->lnz = n + Info [CAMD_LNZ] ; /* ---------------------------------------------------------------------- */ /* free the CAMD workspace and clear the persistent workspace in Common */ /* ---------------------------------------------------------------------- */ ASSERT (IMPLIES (Common->status == CHOLMOD_OK, CHOLMOD(dump_perm) (Perm, n, n, "CAMD2 perm", Common))) ; CHOLMOD(free_sparse) (&C, Common) ; for (j = 0 ; j <= n ; j++) { Head [j] = EMPTY ; } CHOLMOD(free) (n+1, 3*sizeof (Int), Work3n, Common) ; return (TRUE) ; }
cholmod_sparse *CHOLMOD(ssmult) ( /* ---- input ---- */ cholmod_sparse *A, /* left matrix to multiply */ cholmod_sparse *B, /* right matrix to multiply */ int stype, /* requested stype of C */ int values, /* TRUE: do numerical values, FALSE: pattern only */ int sorted, /* if TRUE then return C with sorted columns */ /* --------------- */ cholmod_common *Common ) { double bjt ; double *Ax, *Bx, *Cx, *W ; Int *Ap, *Anz, *Ai, *Bp, *Bnz, *Bi, *Cp, *Ci, *Flag ; cholmod_sparse *C, *A2, *B2, *A3, *B3, *C2 ; Int apacked, bpacked, j, i, pa, paend, pb, pbend, ncol, mark, cnz, t, p, nrow, anz, bnz, do_swap_and_transpose, n1, n2 ; /* ---------------------------------------------------------------------- */ /* check inputs */ /* ---------------------------------------------------------------------- */ RETURN_IF_NULL_COMMON (NULL) ; RETURN_IF_NULL (A, NULL) ; RETURN_IF_NULL (B, NULL) ; values = values && (A->xtype != CHOLMOD_PATTERN) && (B->xtype != CHOLMOD_PATTERN) ; RETURN_IF_XTYPE_INVALID (A, CHOLMOD_PATTERN, values ? CHOLMOD_REAL : CHOLMOD_ZOMPLEX, NULL) ; RETURN_IF_XTYPE_INVALID (B, CHOLMOD_PATTERN, values ? CHOLMOD_REAL : CHOLMOD_ZOMPLEX, NULL) ; if (A->ncol != B->nrow) { /* inner dimensions must agree */ ERROR (CHOLMOD_INVALID, "A and B inner dimensions must match") ; return (NULL) ; } /* A and B must have the same numerical type if values is TRUE (both must * be CHOLMOD_REAL, this is implicitly checked above) */ Common->status = CHOLMOD_OK ; /* ---------------------------------------------------------------------- */ /* allocate workspace */ /* ---------------------------------------------------------------------- */ if (A->nrow <= 1) { /* C will be implicitly sorted, so no need to sort it here */ sorted = FALSE ; } if (sorted) { n1 = MAX (A->nrow, B->ncol) ; } else { n1 = A->nrow ; } n2 = MAX4 (A->ncol, A->nrow, B->nrow, B->ncol) ; CHOLMOD(allocate_work) (n1, n2, values ? n1 : 0, Common) ; if (Common->status < CHOLMOD_OK) { /* out of memory */ return (NULL) ; } ASSERT (CHOLMOD(dump_work) (TRUE, TRUE, values ? n1 : 0, Common)) ; /* ---------------------------------------------------------------------- */ /* get inputs */ /* ---------------------------------------------------------------------- */ /* convert A to unsymmetric, if necessary */ A2 = NULL ; B2 = NULL ; if (A->stype) { /* workspace: Iwork (max (A->nrow,A->ncol)) */ A2 = CHOLMOD(copy) (A, 0, values, Common) ; if (Common->status < CHOLMOD_OK) { /* out of memory */ ASSERT (CHOLMOD(dump_work) (TRUE, TRUE, values ? n1:0, Common)) ; return (NULL) ; } A = A2 ; } /* convert B to unsymmetric, if necessary */ if (B->stype) { /* workspace: Iwork (max (B->nrow,B->ncol)) */ B2 = CHOLMOD(copy) (B, 0, values, Common) ; if (Common->status < CHOLMOD_OK) { /* out of memory */ CHOLMOD(free_sparse) (&A2, Common) ; ASSERT (CHOLMOD(dump_work) (TRUE, TRUE, values ? n1:0, Common)) ; return (NULL) ; } B = B2 ; } ASSERT (CHOLMOD(dump_sparse) (A, "A", Common) >= 0) ; ASSERT (CHOLMOD(dump_sparse) (B, "B", Common) >= 0) ; /* get the A matrix */ Ap = A->p ; Anz = A->nz ; Ai = A->i ; Ax = A->x ; apacked = A->packed ; /* get the B matrix */ Bp = B->p ; Bnz = B->nz ; Bi = B->i ; Bx = B->x ; bpacked = B->packed ; /* get the size of C */ nrow = A->nrow ; ncol = B->ncol ; /* get workspace */ W = Common->Xwork ; /* size nrow, unused if values is FALSE */ Flag = Common->Flag ; /* size nrow, Flag [0..nrow-1] < mark on input*/ /* ---------------------------------------------------------------------- */ /* count the number of entries in the result C */ /* ---------------------------------------------------------------------- */ cnz = 0 ; for (j = 0 ; j < ncol ; j++) { /* clear the Flag array */ /* mark = CHOLMOD(clear_flag) (Common) ; */ CHOLMOD_CLEAR_FLAG (Common) ; mark = Common->mark ; /* for each nonzero B(t,j) in column j, do: */ pb = Bp [j] ; pbend = (bpacked) ? (Bp [j+1]) : (pb + Bnz [j]) ; for ( ; pb < pbend ; pb++) { /* B(t,j) is nonzero */ t = Bi [pb] ; /* add the nonzero pattern of A(:,t) to the pattern of C(:,j) */ pa = Ap [t] ; paend = (apacked) ? (Ap [t+1]) : (pa + Anz [t]) ; for ( ; pa < paend ; pa++) { i = Ai [pa] ; if (Flag [i] != mark) { Flag [i] = mark ; cnz++ ; } } } if (cnz < 0) { break ; /* integer overflow case */ } } /* mark = CHOLMOD(clear_flag) (Common) ; */ CHOLMOD_CLEAR_FLAG (Common) ; mark = Common->mark ; /* ---------------------------------------------------------------------- */ /* check for integer overflow */ /* ---------------------------------------------------------------------- */ if (cnz < 0) { ERROR (CHOLMOD_TOO_LARGE, "problem too large") ; CHOLMOD(free_sparse) (&A2, Common) ; CHOLMOD(free_sparse) (&B2, Common) ; ASSERT (CHOLMOD(dump_work) (TRUE, TRUE, values ? n1:0, Common)) ; return (NULL) ; } /* ---------------------------------------------------------------------- */ /* Determine how to return C sorted (if requested) */ /* ---------------------------------------------------------------------- */ do_swap_and_transpose = FALSE ; if (sorted) { /* Determine the best way to return C with sorted columns. Computing * C = (B'*A')' takes cnz + anz + bnz time (ignoring O(n) terms). * Sorting C when done, C = (A*B)'', takes 2*cnz time. Pick the one * with the least amount of work. */ anz = CHOLMOD(nnz) (A, Common) ; bnz = CHOLMOD(nnz) (B, Common) ; do_swap_and_transpose = (anz + bnz < cnz) ; if (do_swap_and_transpose) { /* -------------------------------------------------------------- */ /* C = (B'*A')' */ /* -------------------------------------------------------------- */ /* workspace: Iwork (A->nrow) */ A3 = CHOLMOD(ptranspose) (A, values, NULL, NULL, 0, Common) ; CHOLMOD(free_sparse) (&A2, Common) ; A2 = A3 ; if (Common->status < CHOLMOD_OK) { /* out of memory */ CHOLMOD(free_sparse) (&A2, Common) ; CHOLMOD(free_sparse) (&B2, Common) ; ASSERT (CHOLMOD(dump_work) (TRUE, TRUE, values ? n1:0, Common)); return (NULL) ; } /* workspace: Iwork (B->nrow) */ B3 = CHOLMOD(ptranspose) (B, values, NULL, NULL, 0, Common) ; CHOLMOD(free_sparse) (&B2, Common) ; B2 = B3 ; if (Common->status < CHOLMOD_OK) { /* out of memory */ CHOLMOD(free_sparse) (&A2, Common) ; CHOLMOD(free_sparse) (&B2, Common) ; ASSERT (CHOLMOD(dump_work) (TRUE, TRUE, values ? n1:0, Common)); return (NULL) ; } A = B2 ; B = A2 ; /* get the new A matrix */ Ap = A->p ; Anz = A->nz ; Ai = A->i ; Ax = A->x ; apacked = A->packed ; /* get the new B matrix */ Bp = B->p ; Bnz = B->nz ; Bi = B->i ; Bx = B->x ; bpacked = B->packed ; /* get the size of C' */ nrow = A->nrow ; ncol = B->ncol ; } } /* ---------------------------------------------------------------------- */ /* allocate C */ /* ---------------------------------------------------------------------- */ C = CHOLMOD(allocate_sparse) (nrow, ncol, cnz, FALSE, TRUE, 0, values ? A->xtype : CHOLMOD_PATTERN, Common) ; if (Common->status < CHOLMOD_OK) { /* out of memory */ CHOLMOD(free_sparse) (&A2, Common) ; CHOLMOD(free_sparse) (&B2, Common) ; ASSERT (CHOLMOD(dump_work) (TRUE, TRUE, values ? n1:0, Common)) ; return (NULL) ; } Cp = C->p ; Ci = C->i ; Cx = C->x ; /* ---------------------------------------------------------------------- */ /* C = A*B */ /* ---------------------------------------------------------------------- */ cnz = 0 ; if (values) { /* pattern and values */ for (j = 0 ; j < ncol ; j++) { /* clear the Flag array */ /* mark = CHOLMOD(clear_flag (Common)) ; */ CHOLMOD_CLEAR_FLAG (Common) ; mark = Common->mark ; /* start column j of C */ Cp [j] = cnz ; /* for each nonzero B(t,j) in column j, do: */ pb = Bp [j] ; pbend = (bpacked) ? (Bp [j+1]) : (pb + Bnz [j]) ; for ( ; pb < pbend ; pb++) { /* B(t,j) is nonzero */ t = Bi [pb] ; bjt = Bx [pb] ; /* add the nonzero pattern of A(:,t) to the pattern of C(:,j) * and scatter the values into W */ pa = Ap [t] ; paend = (apacked) ? (Ap [t+1]) : (pa + Anz [t]) ; for ( ; pa < paend ; pa++) { i = Ai [pa] ; if (Flag [i] != mark) { Flag [i] = mark ; Ci [cnz++] = i ; } W [i] += Ax [pa] * bjt ; } } /* gather the values into C(:,j) */ for (p = Cp [j] ; p < cnz ; p++) { i = Ci [p] ; Cx [p] = W [i] ; W [i] = 0 ; } } } else { /* pattern only */ for (j = 0 ; j < ncol ; j++) { /* clear the Flag array */ /* mark = CHOLMOD(clear_flag) (Common) ; */ CHOLMOD_CLEAR_FLAG (Common) ; mark = Common->mark ; /* start column j of C */ Cp [j] = cnz ; /* for each nonzero B(t,j) in column j, do: */ pb = Bp [j] ; pbend = (bpacked) ? (Bp [j+1]) : (pb + Bnz [j]) ; for ( ; pb < pbend ; pb++) { /* B(t,j) is nonzero */ t = Bi [pb] ; /* add the nonzero pattern of A(:,t) to the pattern of C(:,j) */ pa = Ap [t] ; paend = (apacked) ? (Ap [t+1]) : (pa + Anz [t]) ; for ( ; pa < paend ; pa++) { i = Ai [pa] ; if (Flag [i] != mark) { Flag [i] = mark ; Ci [cnz++] = i ; } } } } } Cp [ncol] = cnz ; ASSERT (MAX (1,cnz) == C->nzmax) ; /* ---------------------------------------------------------------------- */ /* clear workspace and free temporary matrices */ /* ---------------------------------------------------------------------- */ CHOLMOD(free_sparse) (&A2, Common) ; CHOLMOD(free_sparse) (&B2, Common) ; /* CHOLMOD(clear_flag) (Common) ; */ CHOLMOD_CLEAR_FLAG (Common) ; ASSERT (CHOLMOD(dump_work) (TRUE, TRUE, values ? n1:0, Common)) ; /* ---------------------------------------------------------------------- */ /* convert C to a symmetric upper/lower matrix if requested */ /* ---------------------------------------------------------------------- */ /* convert C in place, which cannot fail since no memory is allocated */ if (stype > 0) { /* C = triu (C), in place */ (void) CHOLMOD(band_inplace) (0, ncol, values, C, Common) ; C->stype = 1 ; } else if (stype < 0) { /* C = tril (C), in place */ (void) CHOLMOD(band_inplace) (-nrow, 0, values, C, Common) ; C->stype = -1 ; } ASSERT (Common->status >= CHOLMOD_OK) ; /* ---------------------------------------------------------------------- */ /* sort C, if requested */ /* ---------------------------------------------------------------------- */ if (sorted) { if (do_swap_and_transpose) { /* workspace: Iwork (C->ncol), which is A->nrow since C=(B'*A') */ C2 = CHOLMOD(ptranspose) (C, values, NULL, NULL, 0, Common) ; CHOLMOD(free_sparse) (&C, Common) ; if (Common->status < CHOLMOD_OK) { /* out of memory */ ASSERT (CHOLMOD(dump_work) (TRUE, TRUE, values ? n1:0, Common)); return (NULL) ; } C = C2 ; } else { /* workspace: Iwork (max (C->nrow,C->ncol)) */ if (!CHOLMOD(sort) (C, Common)) { /* out of memory */ CHOLMOD(free_sparse) (&C, Common) ; ASSERT (CHOLMOD(dump_work) (TRUE, TRUE, values ? n1:0, Common)); return (NULL) ; } } } /* ---------------------------------------------------------------------- */ /* return result */ /* ---------------------------------------------------------------------- */ DEBUG (CHOLMOD(dump_sparse) (C, "ssmult", Common) >= 0) ; ASSERT (CHOLMOD(dump_work) (TRUE, TRUE, values ? n1:0, Common)) ; return (C) ; }
int CHOLMOD(csymamd) ( /* ---- input ---- */ cholmod_sparse *A, /* matrix to order */ /* ---- output --- */ Int *Cmember, /* size nrow. see cholmod_ccolamd.c for description */ Int *Perm, /* size A->nrow, output permutation */ /* --------------- */ cholmod_common *Common ) { double knobs [CCOLAMD_KNOBS] ; Int *perm, *Head ; Int ok, i, nrow, stats [CCOLAMD_STATS] ; /* ---------------------------------------------------------------------- */ /* check inputs */ /* ---------------------------------------------------------------------- */ RETURN_IF_NULL_COMMON (FALSE) ; RETURN_IF_NULL (A, FALSE) ; RETURN_IF_NULL (Perm, FALSE) ; RETURN_IF_XTYPE_INVALID (A, CHOLMOD_PATTERN, CHOLMOD_ZOMPLEX, FALSE) ; Common->status = CHOLMOD_OK ; if (A->nrow != A->ncol || !(A->packed)) { ERROR (CHOLMOD_INVALID, "matrix must be square and packed") ; return (FALSE) ; } /* ---------------------------------------------------------------------- */ /* get inputs */ /* ---------------------------------------------------------------------- */ nrow = A->nrow ; /* ---------------------------------------------------------------------- */ /* allocate workspace */ /* ---------------------------------------------------------------------- */ CHOLMOD(allocate_work) (nrow, 0, 0, Common) ; if (Common->status < CHOLMOD_OK) { return (FALSE) ; } /* ---------------------------------------------------------------------- */ /* order the matrix (does not affect A->p or A->i) */ /* ---------------------------------------------------------------------- */ perm = Common->Head ; /* size nrow+1 (i/l/l) */ /* get parameters */ #ifdef LONG ccolamd_l_set_defaults (knobs) ; #else ccolamd_set_defaults (knobs) ; #endif if (Common->current >= 0 && Common->current < CHOLMOD_MAXMETHODS) { /* get the knobs from the Common parameters */ knobs [CCOLAMD_DENSE_ROW] =Common->method[Common->current].prune_dense ; knobs [CCOLAMD_AGGRESSIVE]=Common->method[Common->current].aggressive ; } { #ifdef LONG csymamd_l (nrow, A->i, A->p, perm, knobs, stats, Common->calloc_memory, Common->free_memory, Cmember, A->stype) ; #else csymamd (nrow, A->i, A->p, perm, knobs, stats, Common->calloc_memory, Common->free_memory, Cmember, A->stype) ; #endif ok = stats [CCOLAMD_STATUS] ; } if (ok == CCOLAMD_ERROR_out_of_memory) { ERROR (CHOLMOD_OUT_OF_MEMORY, "out of memory") ; } ok = (ok == CCOLAMD_OK || ok == CCOLAMD_OK_BUT_JUMBLED) ; /* ---------------------------------------------------------------------- */ /* free the workspace and return result */ /* ---------------------------------------------------------------------- */ /* permutation returned in perm [0..n-1] */ for (i = 0 ; i < nrow ; i++) { Perm [i] = perm [i] ; } /* clear Head workspace (used for perm, in csymamd): */ Head = Common->Head ; for (i = 0 ; i <= nrow ; i++) { Head [i] = EMPTY ; } return (ok) ; }
int CHOLMOD(amd) ( /* ---- input ---- */ cholmod_sparse *A, /* matrix to order */ Int *fset, /* subset of 0:(A->ncol)-1 */ size_t fsize, /* size of fset */ /* ---- output --- */ Int *Perm, /* size A->nrow, output permutation */ /* --------------- */ cholmod_common *Common ) { double Info [AMD_INFO], Control2 [AMD_CONTROL], *Control ; Int *Cp, *Len, *Nv, *Head, *Elen, *Degree, *Wi, *Iwork, *Next ; cholmod_sparse *C ; Int j, n, cnz ; size_t s ; int ok = TRUE ; /* ---------------------------------------------------------------------- */ /* get inputs */ /* ---------------------------------------------------------------------- */ RETURN_IF_NULL_COMMON (FALSE) ; RETURN_IF_NULL (A, FALSE) ; n = A->nrow ; RETURN_IF_NULL (Perm, FALSE) ; RETURN_IF_XTYPE_INVALID (A, CHOLMOD_PATTERN, CHOLMOD_ZOMPLEX, FALSE) ; Common->status = CHOLMOD_OK ; if (n == 0) { /* nothing to do */ Common->fl = 0 ; Common->lnz = 0 ; Common->anz = 0 ; return (TRUE) ; } /* ---------------------------------------------------------------------- */ /* get workspace */ /* ---------------------------------------------------------------------- */ /* Note: this is less than the space used in cholmod_analyze, so if * cholmod_amd is being called by that routine, no space will be * allocated. */ /* s = MAX (6*n, A->ncol) */ s = CHOLMOD(mult_size_t) (n, 6, &ok) ; if (!ok) { ERROR (CHOLMOD_TOO_LARGE, "problem too large") ; return (FALSE) ; } s = MAX (s, A->ncol) ; CHOLMOD(allocate_work) (n, s, 0, Common) ; if (Common->status < CHOLMOD_OK) { return (FALSE) ; } Iwork = Common->Iwork ; Degree = Iwork ; /* size n */ Wi = Iwork + n ; /* size n */ Len = Iwork + 2*((size_t) n) ; /* size n */ Nv = Iwork + 3*((size_t) n) ; /* size n */ Next = Iwork + 4*((size_t) n) ; /* size n */ Elen = Iwork + 5*((size_t) n) ; /* size n */ Head = Common->Head ; /* size n+1, but only n is used */ /* ---------------------------------------------------------------------- */ /* construct the input matrix for AMD */ /* ---------------------------------------------------------------------- */ if (A->stype == 0) { /* C = A*A' or A(:,f)*A(:,f)', add extra space of nnz(C)/2+n to C */ C = CHOLMOD(aat) (A, fset, fsize, -2, Common) ; } else { /* C = A+A', but use only the upper triangular part of A if A->stype = 1 * and only the lower part of A if A->stype = -1. Add extra space of * nnz(C)/2+n to C. */ C = CHOLMOD(copy) (A, 0, -2, Common) ; } if (Common->status < CHOLMOD_OK) { /* out of memory, fset invalid, or other error */ return (FALSE) ; } Cp = C->p ; for (j = 0 ; j < n ; j++) { Len [j] = Cp [j+1] - Cp [j] ; } /* C does not include the diagonal, and both upper and lower parts. * Common->anz includes the diagonal, and just the lower part of C */ cnz = Cp [n] ; Common->anz = cnz / 2 + n ; /* ---------------------------------------------------------------------- */ /* order C using AMD */ /* ---------------------------------------------------------------------- */ /* get parameters */ if (Common->current < 0 || Common->current >= CHOLMOD_MAXMETHODS) { /* use AMD defaults */ Control = NULL ; } else { Control = Control2 ; Control [AMD_DENSE] = Common->method [Common->current].prune_dense ; Control [AMD_AGGRESSIVE] = Common->method [Common->current].aggressive ; } #ifdef LONG amd_l2 (n, C->p, C->i, Len, C->nzmax, cnz, Nv, Next, Perm, Head, Elen, Degree, Wi, Control, Info) ; #else amd_2 (n, C->p, C->i, Len, C->nzmax, cnz, Nv, Next, Perm, Head, Elen, Degree, Wi, Control, Info) ; #endif /* LL' flop count. Need to subtract n for LL' flop count. Note that this * is a slight upper bound which is often exact (see AMD/Source/amd_2.c for * details). cholmod_analyze computes an exact flop count and fill-in. */ Common->fl = Info [AMD_NDIV] + 2 * Info [AMD_NMULTSUBS_LDL] + n ; /* Info [AMD_LNZ] excludes the diagonal */ Common->lnz = n + Info [AMD_LNZ] ; /* ---------------------------------------------------------------------- */ /* free the AMD workspace and clear the persistent workspace in Common */ /* ---------------------------------------------------------------------- */ ASSERT (IMPLIES (Common->status == CHOLMOD_OK, CHOLMOD(dump_perm) (Perm, n, n, "AMD2 perm", Common))) ; CHOLMOD(free_sparse) (&C, Common) ; for (j = 0 ; j <= n ; j++) { Head [j] = EMPTY ; } return (TRUE) ; }
int CHOLMOD(updown_mask) ( /* ---- input ---- */ int update, /* TRUE for update, FALSE for downdate */ cholmod_sparse *C, /* the incoming sparse update */ Int *colmark, /* Int array of size n. See cholmod_updown.c */ Int *mask, /* size n */ /* ---- in/out --- */ cholmod_factor *L, /* factor to modify */ cholmod_dense *X, /* solution to Lx=b (size n-by-1) */ cholmod_dense *DeltaB, /* change in b, zero on output */ /* --------------- */ cholmod_common *Common ) { double xj, fl ; double *Lx, *W, *Xx, *Nx ; Int *Li, *Lp, *Lnz, *Cp, *Ci, *Cnz, *Head, *Flag, *Stack, *Lnext, *Iwork, *Set_ps1 [32], *Set_ps2 [32], *ps1, *ps2 ; size_t maxrank ; Path_type OrderedPath [32], Path [32] ; Int n, wdim, k1, k2, npaths, i, j, row, packed, ccol, p, cncol, do_solve, mark, jj, j2, kk, nextj, p1, p2, c, use_colmark, newlnz, k, newpath, path_order, w_order, scattered, path, newparent, pp1, pp2, smax, maxrow, row1, nsets, s, p3, newlnz1, Set [32], top, len, lnz, m, botrow ; size_t w ; int ok = TRUE ; DEBUG (Int oldparent) ; /* ---------------------------------------------------------------------- */ /* check inputs */ /* ---------------------------------------------------------------------- */ RETURN_IF_NULL_COMMON (FALSE) ; RETURN_IF_NULL (C, FALSE) ; RETURN_IF_NULL (L, FALSE) ; RETURN_IF_XTYPE_INVALID (L, CHOLMOD_PATTERN, CHOLMOD_REAL, FALSE) ; RETURN_IF_XTYPE_INVALID (C, CHOLMOD_REAL, CHOLMOD_REAL, FALSE) ; n = L->n ; cncol = C->ncol ; if (!(C->sorted)) { ERROR (CHOLMOD_INVALID, "C must have sorted columns") ; return (FALSE) ; } if (n != (Int) (C->nrow)) { ERROR (CHOLMOD_INVALID, "C and L dimensions do not match") ; return (FALSE) ; } do_solve = (X != NULL) && (DeltaB != NULL) ; if (do_solve) { RETURN_IF_XTYPE_INVALID (X, CHOLMOD_REAL, CHOLMOD_REAL, FALSE) ; RETURN_IF_XTYPE_INVALID (DeltaB, CHOLMOD_REAL, CHOLMOD_REAL, FALSE) ; Xx = X->x ; Nx = DeltaB->x ; if (X->nrow != L->n || X->ncol != 1 || DeltaB->nrow != L->n || DeltaB->ncol != 1 || Xx == NULL || Nx == NULL) { ERROR (CHOLMOD_INVALID, "X and/or DeltaB invalid") ; return (FALSE) ; } } else { Xx = NULL ; Nx = NULL ; } Common->status = CHOLMOD_OK ; Common->modfl = 0 ; fl = 0 ; use_colmark = (colmark != NULL) ; /* ---------------------------------------------------------------------- */ /* allocate workspace */ /* ---------------------------------------------------------------------- */ /* Note: cholmod_rowadd and cholmod_rowdel use the second n doubles in * Common->Xwork for Cx, and then perform a rank-1 update here, which uses * the first n doubles in Common->Xwork. Both the rowadd and rowdel * routines allocate enough workspace so that Common->Xwork isn't destroyed * below. Also, both cholmod_rowadd and cholmod_rowdel use the second n * ints in Common->Iwork for Ci. */ /* make sure maxrank is in the proper range */ maxrank = CHOLMOD(maxrank) (n, Common) ; k = MIN (cncol, (Int) maxrank) ; /* maximum k is wdim */ wdim = Power2 [k] ; /* number of columns needed in W */ ASSERT (wdim <= (Int) maxrank) ; PRINT1 (("updown wdim final "ID" k "ID"\n", wdim, k)) ; /* w = wdim * n */ w = CHOLMOD(mult_size_t) (n, wdim, &ok) ; if (!ok) { ERROR (CHOLMOD_TOO_LARGE, "problem too large") ; return (FALSE) ; } CHOLMOD(allocate_work) (n, n, w, Common) ; if (Common->status < CHOLMOD_OK || maxrank == 0) { /* out of memory, L is returned unchanged */ return (FALSE) ; } /* ---------------------------------------------------------------------- */ /* convert to simplicial numeric LDL' factor, if not already */ /* ---------------------------------------------------------------------- */ if (L->xtype == CHOLMOD_PATTERN || L->is_super || L->is_ll) { /* can only update/downdate a simplicial LDL' factorization */ CHOLMOD(change_factor) (CHOLMOD_REAL, FALSE, FALSE, FALSE, FALSE, L, Common) ; if (Common->status < CHOLMOD_OK) { /* out of memory, L is returned unchanged */ return (FALSE) ; } } /* ---------------------------------------------------------------------- */ /* get inputs */ /* ---------------------------------------------------------------------- */ /* mark = CHOLMOD(clear_flag) (Common) ; */ CHOLMOD_CLEAR_FLAG (Common) ; mark = Common->mark ; PRINT1 (("updown, rank %g update %d\n", (double) C->ncol, update)) ; DEBUG (CHOLMOD(dump_factor) (L, "input L for updown", Common)) ; ASSERT (CHOLMOD(dump_sparse) (C, "input C for updown", Common) >= 0) ; Ci = C->i ; Cp = C->p ; Cnz = C->nz ; packed = C->packed ; ASSERT (IMPLIES (!packed, Cnz != NULL)) ; /* ---------------------------------------------------------------------- */ /* quick return */ /* ---------------------------------------------------------------------- */ if (cncol <= 0 || n == 0) { /* nothing to do */ return (TRUE) ; } /* ---------------------------------------------------------------------- */ /* get L */ /* ---------------------------------------------------------------------- */ Li = L->i ; Lx = L->x ; Lp = L->p ; Lnz = L->nz ; Lnext = L->next ; ASSERT (Lnz != NULL) ; /* ---------------------------------------------------------------------- */ /* get workspace */ /* ---------------------------------------------------------------------- */ Flag = Common->Flag ; /* size n, Flag [i] <= mark must hold */ Head = Common->Head ; /* size n, Head [i] == EMPTY must hold */ W = Common->Xwork ; /* size n-by-wdim, zero on input and output*/ /* note that Iwork [n .. 2*n-1] (i/i/l) may be in use in rowadd/rowdel: */ Iwork = Common->Iwork ; Stack = Iwork ; /* size n, uninitialized (i/i/l) */ /* ---------------------------------------------------------------------- */ /* entire rank-cncol update, done as a sequence of rank-k updates */ /* ---------------------------------------------------------------------- */ ps1 = NULL ; ps2 = NULL ; for (k1 = 0 ; k1 < cncol ; k1 += k) { /* ------------------------------------------------------------------ */ /* get the next k columns of C for the update/downdate */ /* ------------------------------------------------------------------ */ /* the last update/downdate might be less than rank-k */ if (k > cncol - k1) { k = cncol - k1 ; wdim = Power2 [k] ; } k2 = k1 + k - 1 ; /* workspaces are in the following state, on input and output */ ASSERT (CHOLMOD(dump_work) (TRUE, TRUE, wdim, Common)) ; /* ------------------------------------------------------------------ */ /* create a zero-length path for each column of W */ /* ------------------------------------------------------------------ */ nextj = n ; path = 0 ; for (ccol = k1 ; ccol <= k2 ; ccol++) { PRINT1 (("Column ["ID"]: "ID"\n", path, ccol)) ; ASSERT (ccol >= 0 && ccol <= cncol) ; pp1 = Cp [ccol] ; pp2 = (packed) ? (Cp [ccol+1]) : (pp1 + Cnz [ccol]) ; /* get the row index j of the first entry in C (:,ccol) */ if (pp2 > pp1) { /* Column ccol of C has at least one entry. */ j = Ci [pp1] ; } else { /* Column ccol of C is empty. Pretend it has one entry in * the last column with numerical value of zero. */ j = n-1 ; } ASSERT (j >= 0 && j < n) ; /* find first column to work on */ nextj = MIN (nextj, j) ; Path [path].ccol = ccol ; /* which column of C this path is for */ Path [path].start = EMPTY ; /* paths for C have zero length */ Path [path].end = EMPTY ; Path [path].parent = EMPTY ; /* no parent yet */ Path [path].rank = 1 ; /* one column of W */ Path [path].c = EMPTY ; /* no child of this path (case A) */ Path [path].next = Head [j] ; /* this path is pending at col j */ Path [path].pending = j ; /* this path is pending at col j */ Head [j] = path ; /* this path is pending at col j */ PRINT1(("Path "ID" starts: start "ID" end "ID" parent "ID" c "ID"" "j "ID" ccol "ID"\n", path, Path [path].start, Path [path].end, Path [path].parent, Path [path].c, j, ccol)) ; /* initialize botrow for this path */ Path [path].botrow = (use_colmark) ? colmark [ccol] : n ; path++ ; } /* we start with paths 0 to k-1. Next one (now unused) is npaths */ npaths = k ; j = nextj ; ASSERT (j < n) ; scattered = FALSE ; /* ------------------------------------------------------------------ */ /* symbolic update of columns of L */ /* ------------------------------------------------------------------ */ while (j < n) { ASSERT (j >= 0 && j < n && Lnz [j] > 0) ; /* the old column, Li [p1..p2-1]. D (j,j) is stored in Lx [p1] */ p1 = Lp [j] ; newlnz = Lnz [j] ; p2 = p1 + newlnz ; #ifndef NDEBUG PRINT1 (("\n=========Column j="ID" p1 "ID" p2 "ID" lnz "ID" \n", j, p1, p2, newlnz)) ; dump_col ("Old", j, p1, p2, Li, Lx, n, Common) ; oldparent = (Lnz [j] > 1) ? (Li [p1 + 1]) : EMPTY ; ASSERT (CHOLMOD(dump_work) (TRUE, FALSE, 0, Common)) ; ASSERT (!scattered) ; PRINT1 (("Col "ID": Checking paths, npaths: "ID"\n", j, npaths)) ; for (kk = 0 ; kk < npaths ; kk++) { Int kk2, found, j3 = Path [kk].pending ; PRINT2 (("Path "ID" pending at "ID".\n", kk, j3)) ; if (j3 != EMPTY) { /* Path kk must be somewhere in link list for column j3 */ ASSERT (Head [j3] != EMPTY) ; PRINT3 ((" List at "ID": ", j3)) ; found = FALSE ; for (kk2 = Head [j3] ; kk2 != EMPTY ; kk2 = Path [kk2].next) { PRINT3 ((""ID" ", kk2)) ; ASSERT (Path [kk2].pending == j3) ; found = found || (kk2 == kk) ; } PRINT3 (("\n")) ; ASSERT (found) ; } } PRINT1 (("\nCol "ID": Paths at this column, head "ID"\n", j, Head [j])); ASSERT (Head [j] != EMPTY) ; for (kk = Head [j] ; kk != EMPTY ; kk = Path [kk].next) { PRINT1 (("path "ID": (c="ID" j="ID") npaths "ID"\n", kk, Path[kk].c, j, npaths)) ; ASSERT (kk >= 0 && kk < npaths) ; ASSERT (Path [kk].pending == j) ; } #endif /* -------------------------------------------------------------- */ /* determine the path we're on */ /* -------------------------------------------------------------- */ /* get the first old path at column j */ path = Head [j] ; /* -------------------------------------------------------------- */ /* update/downdate of forward solve, Lx=b */ /* -------------------------------------------------------------- */ if (do_solve) { xj = Xx [j] ; if (IS_NONZERO (xj)) { xj = Xx [j] ; /* This is first time column j has been seen for entire */ /* rank-k update/downdate. */ /* DeltaB += Lold (j:botrow-1,j) * X (j) */ Nx [j] += xj ; /* diagonal of L */ /* find the botrow for this column */ botrow = (use_colmark) ? Path [path].botrow : n ; for (p = p1 + 1 ; p < p2 ; p++) { i = Li [p] ; if (i >= botrow) { break ; } Nx [i] += Lx [p] * xj ; } /* clear X[j] to flag col j of Lold as having been seen. If * X (j) was initially zero, then the above code is never * executed for column j. This is safe, since if xj=0 the * code above does not do anything anyway. */ Xx [j] = 0.0 ; } } /* -------------------------------------------------------------- */ /* start a new path at this column if two or more paths merge */ /* -------------------------------------------------------------- */ newpath = /* start a new path if paths have merged */ (Path [path].next != EMPTY) /* or if j is the first node on a path (case A). */ || (Path [path].c == EMPTY) ; if (newpath) { /* get the botrow of the first path at column j */ botrow = (use_colmark) ? Path [path].botrow : n ; path = npaths++ ; ASSERT (npaths <= 3*k) ; Path [path].ccol = EMPTY ; /* no single col of C for this path*/ Path [path].start = j ; /* path starts at this column j */ Path [path].end = EMPTY ; /* don't know yet where it ends */ Path [path].parent = EMPTY ;/* don't know parent path yet */ Path [path].rank = 0 ; /* rank is sum of child path ranks */ PRINT1 (("Path "ID" starts: start "ID" end "ID" parent "ID"\n", path, Path [path].start, Path [path].end, Path [path].parent)) ; /* set the botrow of the new path */ Path [path].botrow = (use_colmark) ? botrow : n ; } /* -------------------------------------------------------------- */ /* for each path kk pending at column j */ /* -------------------------------------------------------------- */ /* make a list of the sets that need to be merged into column j */ nsets = 0 ; for (kk = Head [j] ; kk != EMPTY ; kk = Path [kk].next) { /* ---------------------------------------------------------- */ /* path kk is at (c,j) */ /* ---------------------------------------------------------- */ c = Path [kk].c ; ASSERT (c < j) ; PRINT1 (("TUPLE on path "ID" (c="ID" j="ID")\n", kk, c, j)) ; ASSERT (Path [kk].pending == j) ; if (newpath) { /* finalize path kk and find rank of this path */ Path [kk].end = c ; /* end of old path is previous node c */ Path [kk].parent = path ; /* parent is this path */ Path [path].rank += Path [kk].rank ; /* sum up ranks */ Path [kk].pending = EMPTY ; PRINT1 (("Path "ID" done:start "ID" end "ID" parent "ID"\n", kk, Path [kk].start, Path [kk].end, Path [kk].parent)) ; } if (c == EMPTY) { /* ------------------------------------------------------ */ /* CASE A: first node in path */ /* ------------------------------------------------------ */ /* update: add pattern of incoming column */ /* Column ccol of C is in Ci [pp1 ... pp2-1] */ ccol = Path [kk].ccol ; pp1 = Cp [ccol] ; pp2 = (packed) ? (Cp [ccol+1]) : (pp1 + Cnz [ccol]) ; PRINT1 (("Case A, ccol = "ID" len "ID"\n", ccol, pp2-pp1)) ; ASSERT (IMPLIES (pp2 > pp1, Ci [pp1] == j)) ; if (!scattered) { /* scatter the original pattern of column j of L */ for (p = p1 ; p < p2 ; p++) { Flag [Li [p]] = mark ; } scattered = TRUE ; } /* scatter column ccol of C (skip first entry, j) */ newlnz1 = newlnz ; for (p = pp1 + 1 ; p < pp2 ; p++) { row = Ci [p] ; if (Flag [row] < mark) { /* this is a new entry in Lj' */ Flag [row] = mark ; newlnz++ ; } } if (newlnz1 != newlnz) { /* column ccol of C adds something to column j of L */ Set [nsets++] = FLIP (ccol) ; } } else if (Head [c] == 1) { /* ------------------------------------------------------ */ /* CASE B: c is old, but changed, child of j */ /* CASE C: new child of j */ /* ------------------------------------------------------ */ /* Head [c] is 1 if col c of L has new entries, * EMPTY otherwise */ Flag [c] = 0 ; Head [c] = EMPTY ; /* update: add Lc' */ /* column c of L is in Li [pp1 .. pp2-1] */ pp1 = Lp [c] ; pp2 = pp1 + Lnz [c] ; PRINT1 (("Case B/C: c = "ID"\n", c)) ; DEBUG (dump_col ("Child", c, pp1, pp2, Li, Lx, n, Common)) ; ASSERT (j == Li [pp1 + 1]) ; /* j is new parent of c */ if (!scattered) { /* scatter the original pattern of column j of L */ for (p = p1 ; p < p2 ; p++) { Flag [Li [p]] = mark ; } scattered = TRUE ; } /* scatter column c of L (skip first two entries, c and j)*/ newlnz1 = newlnz ; for (p = pp1 + 2 ; p < pp2 ; p++) { row = Li [p] ; if (Flag [row] < mark) { /* this is a new entry in Lj' */ Flag [row] = mark ; newlnz++ ; } } PRINT2 (("\n")) ; if (newlnz1 != newlnz) { /* column c of L adds something to column j of L */ Set [nsets++] = c ; } } } /* -------------------------------------------------------------- */ /* update the pattern of column j of L */ /* -------------------------------------------------------------- */ /* Column j of L will be in Li/Lx [p1 .. p3-1] */ p3 = p1 + newlnz ; ASSERT (IMPLIES (nsets == 0, newlnz == Lnz [j])) ; PRINT1 (("p1 "ID" p2 "ID" p3 "ID" nsets "ID"\n", p1, p2, p3,nsets)); /* -------------------------------------------------------------- */ /* ensure we have enough space for the longer column */ /* -------------------------------------------------------------- */ if (nsets > 0 && p3 > Lp [Lnext [j]]) { PRINT1 (("Col realloc: j "ID" newlnz "ID"\n", j, newlnz)) ; if (!CHOLMOD(reallocate_column) (j, newlnz, L, Common)) { /* out of memory, L is now simplicial symbolic */ CHOLMOD(clear_flag) (Common) ; for (j = 0 ; j <= n ; j++) { Head [j] = EMPTY ; } ASSERT (CHOLMOD(dump_work) (TRUE, TRUE, wdim, Common)) ; return (FALSE) ; } /* L->i and L->x may have moved. Column j has moved too */ Li = L->i ; Lx = L->x ; p1 = Lp [j] ; p2 = p1 + Lnz [j] ; p3 = p1 + newlnz ; } /* -------------------------------------------------------------- */ /* create set pointers */ /* -------------------------------------------------------------- */ for (s = 0 ; s < nsets ; s++) { /* Pattern of Set s is *(Set_ps1 [s] ... Set_ps2 [s]-1) */ c = Set [s] ; if (c < EMPTY) { /* column ccol of C, skip first entry (j) */ ccol = FLIP (c) ; pp1 = Cp [ccol] ; pp2 = (packed) ? (Cp [ccol+1]) : (pp1 + Cnz [ccol]) ; ASSERT (pp2 - pp1 > 1) ; Set_ps1 [s] = &(Ci [pp1 + 1]) ; Set_ps2 [s] = &(Ci [pp2]) ; PRINT1 (("set "ID" is ccol "ID"\n", s, ccol)) ; } else { /* column c of L, skip first two entries (c and j) */ pp1 = Lp [c] ; pp2 = pp1 + Lnz [c] ; ASSERT (Lnz [c] > 2) ; Set_ps1 [s] = &(Li [pp1 + 2]) ; Set_ps2 [s] = &(Li [pp2]) ; PRINT1 (("set "ID" is L "ID"\n", s, c)) ; } DEBUG (dump_set (s, Set_ps1, Set_ps2, j, n, Common)) ; } /* -------------------------------------------------------------- */ /* multiset merge */ /* -------------------------------------------------------------- */ /* Merge the sets into a single sorted set, Lj'. Before the merge * starts, column j is located in Li/Lx [p1 ... p2-1] and the * space Li/Lx [p2 ... p3-1] is empty. p1 is Lp [j], p2 is * Lp [j] + Lnz [j] (the old length of the column), and p3 is * Lp [j] + newlnz (the new and longer length of the column). * * The sets 0 to nsets-1 are defined by the Set_ps1 and Set_ps2 * pointers. Set s is located in *(Set_ps1 [s] ... Set_ps2 [s]-1). * It may be a column of C, or a column of L. All row indices i in * the sets are in the range i > j and i < n. All sets are sorted. * * The merge into column j of L is done in place. * * During the merge, p2 and p3 are updated. Li/Lx [p1..p2-1] * reflects the indices of the old column j of L that are yet to * be merged into the new column. Entries in their proper place in * the new column j of L are located in Li/Lx [p3 ... p1+newlnz-1]. * The merge finishes when p2 == p3. * * During the merge, set s consumed as it is merged into column j of * L. Its unconsumed contents are *(Set_ps1 [s] ... Set_ps2 [s]-1). * When a set is completely consumed, it is removed from the set of * sets, and nsets is decremented. * * The multiset merge and 2-set merge finishes when p2 == p3. */ PRINT1 (("Multiset merge p3 "ID" p2 "ID" nsets "ID"\n", p3, p2, nsets)) ; while (p3 > p2 && nsets > 1) { #ifndef NDEBUG PRINT2 (("\nMultiset merge. nsets = "ID"\n", nsets)) ; PRINT2 (("Source col p1 = "ID", p2 = "ID", p3= "ID"\n", p1, p2, p3)) ; for (p = p1 + 1 ; p < p2 ; p++) { PRINT2 ((" p: "ID" source row "ID" %g\n", p, Li[p], Lx[p])) ; ASSERT (Li [p] > j && Li [p] < n) ; } PRINT2 (("---\n")) ; for (p = p3 ; p < p1 + newlnz ; p++) { PRINT2 ((" p: "ID" target row "ID" %g\n", p, Li[p], Lx[p])) ; ASSERT (Li [p] > j && Li [p] < n) ; } for (s = 0 ; s < nsets ; s++) { dump_set (s, Set_ps1, Set_ps2, j, n, Common) ; } #endif /* get the entry at the tail end of source column Lj */ row1 = Li [p2 - 1] ; ASSERT (row1 >= j && p2 >= p1) ; /* find the largest row in all the sets */ maxrow = row1 ; smax = EMPTY ; for (s = nsets-1 ; s >= 0 ; s--) { ASSERT (Set_ps1 [s] < Set_ps2 [s]) ; row = *(Set_ps2 [s] - 1) ; if (row == maxrow) { /* skip past this entry in set s (it is a duplicate) */ Set_ps2 [s]-- ; if (Set_ps1 [s] == Set_ps2 [s]) { /* nothing more in this set */ nsets-- ; Set_ps1 [s] = Set_ps1 [nsets] ; Set_ps2 [s] = Set_ps2 [nsets] ; if (smax == nsets) { /* Set smax redefined; it is now this set */ smax = s ; } } } else if (row > maxrow) { maxrow = row ; smax = s ; } } ASSERT (maxrow > j) ; /* move the row onto the stack of the target column */ if (maxrow == row1) { /* next entry is in Lj, move to the bottom of Lj' */ ASSERT (smax == EMPTY) ; p2-- ; p3-- ; Li [p3] = maxrow ; Lx [p3] = Lx [p2] ; } else { /* new entry in Lj' */ ASSERT (smax >= 0 && smax < nsets) ; Set_ps2 [smax]-- ; p3-- ; Li [p3] = maxrow ; Lx [p3] = 0.0 ; if (Set_ps1 [smax] == Set_ps2 [smax]) { /* nothing more in this set */ nsets-- ; Set_ps1 [smax] = Set_ps1 [nsets] ; Set_ps2 [smax] = Set_ps2 [nsets] ; PRINT1 (("Set "ID" now empty\n", smax)) ; } } } /* -------------------------------------------------------------- */ /* 2-set merge: */ /* -------------------------------------------------------------- */ /* This the same as the multi-set merge, except there is only one * set s = 0 left. The source column j and the set 0 are being * merged into the target column j. */ if (nsets > 0) { ps1 = Set_ps1 [0] ; ps2 = Set_ps2 [0] ; } while (p3 > p2) { #ifndef NDEBUG PRINT2 (("\n2-set merge.\n")) ; ASSERT (nsets == 1) ; PRINT2 (("Source col p1 = "ID", p2 = "ID", p3= "ID"\n", p1, p2, p3)) ; for (p = p1 + 1 ; p < p2 ; p++) { PRINT2 ((" p: "ID" source row "ID" %g\n", p, Li[p], Lx[p])) ; ASSERT (Li [p] > j && Li [p] < n) ; } PRINT2 (("---\n")) ; for (p = p3 ; p < p1 + newlnz ; p++) { PRINT2 ((" p: "ID" target row "ID" %g\n", p, Li[p], Lx[p])) ; ASSERT (Li [p] > j && Li [p] < n) ; } dump_set (0, Set_ps1, Set_ps2, j, n, Common) ; #endif if (p2 == p1 + 1) { /* the top of Lj is empty; copy the set and quit */ while (p3 > p2) { /* new entry in Lj' */ row = *(--ps2) ; p3-- ; Li [p3] = row ; Lx [p3] = 0.0 ; } } else { /* get the entry at the tail end of Lj */ row1 = Li [p2 - 1] ; ASSERT (row1 > j && row1 < n) ; /* get the entry at the tail end of the incoming set */ ASSERT (ps1 < ps2) ; row = *(ps2-1) ; ASSERT (row > j && row1 < n) ; /* move the larger of the two entries to the target set */ if (row1 >= row) { /* next entry is in Lj, move to the bottom */ if (row1 == row) { /* skip past this entry in the set */ ps2-- ; } p2-- ; p3-- ; Li [p3] = row1 ; Lx [p3] = Lx [p2] ; } else { /* new entry in Lj' */ ps2-- ; p3-- ; Li [p3] = row ; Lx [p3] = 0.0 ; } } } /* -------------------------------------------------------------- */ /* The new column j of L is now in Li/Lx [p1 ... p2-1] */ /* -------------------------------------------------------------- */ p2 = p1 + newlnz ; DEBUG (dump_col ("After merge: ", j, p1, p2, Li, Lx, n, Common)) ; fl += Path [path].rank * (6 + 4 * (double) newlnz) ; /* -------------------------------------------------------------- */ /* clear Flag; original pattern of column j L no longer marked */ /* -------------------------------------------------------------- */ mark = CHOLMOD(clear_flag) (Common) ; scattered = FALSE ; /* -------------------------------------------------------------- */ /* find the new parent */ /* -------------------------------------------------------------- */ newparent = (newlnz > 1) ? (Li [p1 + 1]) : EMPTY ; PRINT1 (("\nNew parent, Lnz: "ID": "ID" "ID"\n", j, newparent,newlnz)); ASSERT (oldparent == EMPTY || newparent <= oldparent) ; /* -------------------------------------------------------------- */ /* go to the next node in the path */ /* -------------------------------------------------------------- */ /* path moves to (j,nextj) unless j is a root */ nextj = (newparent == EMPTY) ? n : newparent ; /* place path at head of list for nextj, or terminate the path */ PRINT1 (("\n j = "ID" nextj = "ID"\n\n", j, nextj)) ; Path [path].c = j ; if (nextj < n) { /* put path on link list of pending paths at column nextj */ Path [path].next = Head [nextj] ; Path [path].pending = nextj ; Head [nextj] = path ; PRINT1 (("Path "ID" continues to ("ID","ID"). Rank "ID"\n", path, Path [path].c, nextj, Path [path].rank)) ; } else { /* path has ended here, at a root */ Path [path].next = EMPTY ; Path [path].pending = EMPTY ; Path [path].end = j ; PRINT1 (("Path "ID" ends at root ("ID"). Rank "ID"\n", path, Path [path].end, Path [path].rank)) ; } /* The link list Head [j] can now be emptied. Set Head [j] to 1 * if column j has changed (it is no longer used as a link list). */ PRINT1 (("column "ID", oldlnz = "ID"\n", j, Lnz [j])) ; Head [j] = (Lnz [j] != newlnz) ? 1 : EMPTY ; Lnz [j] = newlnz ; PRINT1 (("column "ID", newlnz = "ID"\n", j, newlnz)) ; DEBUG (dump_col ("New", j, p1, p2, Li, Lx, n, Common)) ; /* move to the next column */ if (k == Path [path].rank) { /* only one path left */ j = nextj ; } else { /* The current path is moving from column j to column nextj * (nextj is n if the path has ended). However, there may be * other paths pending in columns j+1 to nextj-1. There are * two methods for looking for the next column with a pending * update. The first one looks at all columns j+1 to nextj-1 * for a non-empty link list. This can be costly if j and * nextj differ by a large amount (it can be O(n), but this * entire routine may take Omega(1) time). The second method * looks at all paths and finds the smallest column at which any * path is pending. It takes O(# of paths), which is bounded * by 23: one for each column of C (up to 8), and then 15 for a * balanced binary tree with 8 leaves. However, if j and * nextj differ by a tiny amount (nextj is often j+1 near * the end of the matrix), looking at columns j+1 to nextj * would be faster. Both methods give the same answer. */ if (nextj - j < npaths) { /* there are fewer columns to search than paths */ PRINT1 (("check j="ID" to nextj="ID"\n", j, nextj)) ; for (j2 = j + 1 ; j2 < nextj ; j2++) { PRINT1 (("check j="ID" "ID"\n", j2, Head [j2])) ; if (Head [j2] != EMPTY) { PRINT1 (("found, j="ID"\n", j2)) ; ASSERT (Path [Head [j2]].pending == j2) ; break ; } } } else { /* there are fewer paths than columns to search */ j2 = nextj ; for (kk = 0 ; kk < npaths ; kk++) { jj = Path [kk].pending ; PRINT2 (("Path "ID" pending at "ID"\n", kk, jj)) ; if (jj != EMPTY) j2 = MIN (j2, jj) ; } } j = j2 ; } } /* ensure workspaces are back to the values required on input */ ASSERT (CHOLMOD(dump_work) (TRUE, TRUE, TRUE, Common)) ; /* ------------------------------------------------------------------ */ /* depth-first-search of tree to order the paths */ /* ------------------------------------------------------------------ */ /* create lists of child paths */ PRINT1 (("\n\nDFS search:\n\n")) ; for (path = 0 ; path < npaths ; path++) { Path [path].c = EMPTY ; /* first child of path */ Path [path].next = EMPTY ; /* next sibling of path */ Path [path].order = EMPTY ; /* path is not ordered yet */ Path [path].wfirst = EMPTY ; /* 1st column of W not found yet */ #ifndef NDEBUG j = Path [path].start ; PRINT1 (("Path "ID" : start "ID" end "ID" parent "ID" ccol "ID"\n", path, j, Path [path].end, Path [path].parent, Path [path].ccol)) ; for ( ; ; ) { PRINT1 ((" column "ID"\n", j)) ; ASSERT (j == EMPTY || (j >= 0 && j < n)) ; if (j == Path [path].end) { break ; } ASSERT (j >= 0 && j < n) ; j = (Lnz [j] > 1) ? (Li [Lp [j] + 1]) : EMPTY ; } #endif } for (path = 0 ; path < npaths ; path++) { p = Path [path].parent ; /* add path to child list of parent */ if (p != EMPTY) { ASSERT (p < npaths) ; Path [path].next = Path [p].c ; Path [p].c = path ; } } path_order = k ; w_order = 0 ; for (path = npaths-1 ; path >= 0 ; path--) { if (Path [path].order == EMPTY) { /* this path is the root of a subtree of Tbar */ PRINT1 (("Root path "ID"\n", path)) ; ASSERT (path >= k) ; dfs (Path, k, path, &path_order, &w_order, 0, npaths) ; } } ASSERT (path_order == npaths) ; ASSERT (w_order == k) ; /* reorder the paths */ for (path = 0 ; path < npaths ; path++) { /* old order is path, new order is Path [path].order */ OrderedPath [Path [path].order] = Path [path] ; } #ifndef NDEBUG for (path = 0 ; path < npaths ; path++) { PRINT1 (("Ordered Path "ID": start "ID" end "ID" wfirst "ID" rank " ""ID" ccol "ID"\n", path, OrderedPath [path].start, OrderedPath [path].end, OrderedPath [path].wfirst, OrderedPath [path].rank, OrderedPath [path].ccol)) ; if (path < k) { ASSERT (OrderedPath [path].ccol >= 0) ; } else { ASSERT (OrderedPath [path].ccol == EMPTY) ; } } #endif /* ------------------------------------------------------------------ */ /* numeric update/downdate for all paths */ /* ------------------------------------------------------------------ */ ASSERT (CHOLMOD(dump_work) (TRUE, TRUE, wdim, Common)) ; switch (wdim) { case 1: updown_1_r (update, C, k, L, W, OrderedPath, npaths, mask, Common) ; break ; case 2: updown_2_r (update, C, k, L, W, OrderedPath, npaths, mask, Common) ; break ; case 4: updown_4_r (update, C, k, L, W, OrderedPath, npaths, mask, Common) ; break ; case 8: updown_8_r (update, C, k, L, W, OrderedPath, npaths, mask, Common) ; break ; } ASSERT (CHOLMOD(dump_work) (TRUE, TRUE, wdim, Common)) ; } /* ---------------------------------------------------------------------- */ /* update/downdate the forward solve */ /* ---------------------------------------------------------------------- */ if (do_solve) { /* We now have DeltaB += Lold (:,j) * X (j) for all columns j in union * of all paths seen during the entire rank-cncol update/downdate. For * each j in path, do DeltaB -= Lnew (:,j)*DeltaB(j) * in topological order. */ #ifndef NDEBUG PRINT1 (("\ndo_solve, DeltaB + Lold(:,Path)*X(Path):\n")) ; for (i = 0 ; i < n ; i++) { PRINT1 (("do_solve: "ID" %30.20e\n", i, Nx [i])) ; } #endif /* Note that the downdate, if it deleted entries, would need to compute * the Stack prior to doing any downdates. */ /* find the union of all the paths in the new L */ top = n ; /* "top" is stack pointer, not a row or column index */ for (ccol = 0 ; ccol < cncol ; ccol++) { /* -------------------------------------------------------------- */ /* j = first row index of C (:,ccol) */ /* -------------------------------------------------------------- */ pp1 = Cp [ccol] ; pp2 = (packed) ? (Cp [ccol+1]) : (pp1 + Cnz [ccol]) ; if (pp2 > pp1) { /* Column ccol of C has at least one entry. */ j = Ci [pp1] ; } else { /* Column ccol of C is empty */ j = n-1 ; } PRINT1 (("\ndo_solve: ccol= "ID"\n", ccol)) ; ASSERT (j >= 0 && j < n) ; len = 0 ; /* -------------------------------------------------------------- */ /* find the new rowmark */ /* -------------------------------------------------------------- */ /* Each column of C can redefine the region of L that takes part in * the update/downdate of the triangular solve Lx=b. If * i = colmark [ccol] for column C(:,ccol), then i = rowmark [j] is * redefined for all columns along the path modified by C(:,ccol). * If more than one column modifies any given column j of L, then * the rowmark of j is determined by the colmark of the least- * numbered column that affects column j. That is, if both * C(:,ccol1) and C(:,ccol2) affect column j of L, then * rowmark [j] = colmark [MIN (ccol1, ccol2)]. * * rowmark [j] is not modified if rowmark or colmark are NULL, * or if colmark [ccol] is EMPTY. */ botrow = (use_colmark) ? (colmark [ccol]) : EMPTY ; /* -------------------------------------------------------------- */ /* traverse from j towards root, stopping if node already visited */ /* -------------------------------------------------------------- */ while (j != EMPTY && Flag [j] < mark) { PRINT1 (("do_solve: subpath j= "ID"\n", j)) ; ASSERT (j >= 0 && j < n) ; Stack [len++] = j ; /* place j on the stack */ Flag [j] = mark ; /* flag j as visited */ /* if using colmark, mark column j with botrow */ ASSERT (Li [Lp [j]] == j) ; /* diagonal is always present */ if (use_colmark) { Li [Lp [j]] = botrow ; /* use the space for botrow */ } /* go up the tree, to the parent of j */ j = (Lnz [j] > 1) ? (Li [Lp [j] + 1]) : EMPTY ; } /* -------------------------------------------------------------- */ /* move the path down to the bottom of the stack */ /* -------------------------------------------------------------- */ ASSERT (len <= top) ; while (len > 0) { Stack [--top] = Stack [--len] ; } } #ifndef NDEBUG /* Union of paths now in Stack [top..n-1] in topological order */ PRINT1 (("\nTopological order:\n")) ; for (i = top ; i < n ; i++) { PRINT1 (("column "ID" in full path\n", Stack [i])) ; } #endif /* Do the forward solve for the full path part of L */ for (m = top ; m < n ; m++) { j = Stack [m] ; ASSERT (j >= 0 && j < n) ; PRINT1 (("do_solve: path j= "ID"\n", j)) ; p1 = Lp [j] ; lnz = Lnz [j] ; p2 = p1 + lnz ; xj = Nx [j] ; /* copy new solution onto old one, for all cols in full path */ Xx [j] = xj ; Nx [j] = 0. ; /* DeltaB -= Lnew (j+1:botrow-1,j) * deltab(j) */ if (use_colmark) { botrow = Li [p1] ; /* get botrow */ Li [p1] = j ; /* restore diagonal entry */ for (p = p1 + 1 ; p < p2 ; p++) { i = Li [p] ; if (i >= botrow) break ; Nx [i] -= Lx [p] * xj ; } } else { for (p = p1 + 1 ; p < p2 ; p++) { Nx [Li [p]] -= Lx [p] * xj ; } } } /* clear the Flag */ mark = CHOLMOD(clear_flag) (Common) ; } /* ---------------------------------------------------------------------- */ /* successful update/downdate */ /* ---------------------------------------------------------------------- */ Common->modfl = fl ; DEBUG (for (j = 0 ; j < n ; j++) ASSERT (IMPLIES (do_solve, Nx[j] == 0.))) ; ASSERT (CHOLMOD(dump_work) (TRUE, TRUE, TRUE, Common)) ; DEBUG (CHOLMOD(dump_factor) (L, "output L for updown", Common)) ; return (TRUE) ; }
UF_long CHOLMOD(postorder) /* return # of nodes postordered */ ( /* ---- input ---- */ Int *Parent, /* size n. Parent [j] = p if p is the parent of j */ size_t n, Int *Weight, /* size n, optional. Weight [j] is weight of node j */ /* ---- output --- */ Int *Post, /* size n. Post [k] = j is kth in postordered tree */ /* --------------- */ cholmod_common *Common ) { Int *Head, *Next, *Pstack, *Iwork ; Int j, p, k, w, nextj ; size_t s ; int ok = TRUE ; /* ---------------------------------------------------------------------- */ /* check inputs */ /* ---------------------------------------------------------------------- */ RETURN_IF_NULL_COMMON (EMPTY) ; RETURN_IF_NULL (Parent, EMPTY) ; RETURN_IF_NULL (Post, EMPTY) ; Common->status = CHOLMOD_OK ; /* ---------------------------------------------------------------------- */ /* allocate workspace */ /* ---------------------------------------------------------------------- */ /* s = 2*n */ s = CHOLMOD(mult_size_t) (n, 2, &ok) ; if (!ok) { ERROR (CHOLMOD_TOO_LARGE, "problem too large") ; return (EMPTY) ; } CHOLMOD(allocate_work) (n, s, 0, Common) ; if (Common->status < CHOLMOD_OK) { return (EMPTY) ; } ASSERT (CHOLMOD(dump_work) (TRUE, TRUE, 0, Common)) ; /* ---------------------------------------------------------------------- */ /* get inputs */ /* ---------------------------------------------------------------------- */ Head = Common->Head ; /* size n+1, initially all EMPTY */ Iwork = Common->Iwork ; Next = Iwork ; /* size n (i/i/l) */ Pstack = Iwork + n ; /* size n (i/i/l) */ /* ---------------------------------------------------------------------- */ /* construct a link list of children for each node */ /* ---------------------------------------------------------------------- */ if (Weight == NULL) { /* in reverse order so children are in ascending order in each list */ for (j = n-1 ; j >= 0 ; j--) { p = Parent [j] ; if (p >= 0 && p < ((Int) n)) { /* add j to the list of children for node p */ Next [j] = Head [p] ; Head [p] = j ; } } /* Head [p] = j if j is the youngest (least-numbered) child of p */ /* Next [j1] = j2 if j2 is the next-oldest sibling of j1 */ } else { /* First, construct a set of link lists according to Weight. * * Whead [w] = j if node j is the first node in bucket w. * Next [j1] = j2 if node j2 follows j1 in a link list. */ Int *Whead = Pstack ; /* use Pstack as workspace for Whead [ */ for (w = 0 ; w < ((Int) n) ; w++) { Whead [w] = EMPTY ; } /* do in forward order, so nodes that ties are ordered by node index */ for (j = 0 ; j < ((Int) n) ; j++) { p = Parent [j] ; if (p >= 0 && p < ((Int) n)) { w = Weight [j] ; w = MAX (0, w) ; w = MIN (w, ((Int) n) - 1) ; /* place node j at the head of link list for weight w */ Next [j] = Whead [w] ; Whead [w] = j ; } } /* traverse weight buckets, placing each node in its parent's list */ for (w = n-1 ; w >= 0 ; w--) { for (j = Whead [w] ; j != EMPTY ; j = nextj) { nextj = Next [j] ; /* put node j in the link list of its parent */ p = Parent [j] ; ASSERT (p >= 0 && p < ((Int) n)) ; Next [j] = Head [p] ; Head [p] = j ; } } /* Whead no longer needed ] */ /* Head [p] = j if j is the lightest child of p */ /* Next [j1] = j2 if j2 is the next-heaviest sibling of j1 */ } /* ---------------------------------------------------------------------- */ /* start a DFS at each root node of the etree */ /* ---------------------------------------------------------------------- */ k = 0 ; for (j = 0 ; j < ((Int) n) ; j++) { if (Parent [j] == EMPTY) { /* j is the root of a tree; start a DFS here */ k = trilinos_dfs (j, k, Post, Head, Next, Pstack) ; } } /* this would normally be EMPTY already, unless Parent is invalid */ for (j = 0 ; j < ((Int) n) ; j++) { Head [j] = EMPTY ; } PRINT1 (("postordered "ID" nodes\n", k)) ; ASSERT (CHOLMOD(dump_work) (TRUE, TRUE, 0, Common)) ; return (k) ; }
void gsl_integration_qaws_table_free (gsl_integration_qaws_table * t) { RETURN_IF_NULL (t); free (t); }
static void init_p(int argc, const char **argv) { RETURN_IF_NULL(if_pan); EXEC(if_pan->init, &pan_cbacks); }
int CHOLMOD(symmetry) ( /* ---- input ---- */ cholmod_sparse *A, int option, /* option 0, 1, or 2 (see above) */ /* ---- output --- */ /* outputs ignored if any are NULL */ Int *p_xmatched, /* # of matched numerical entries */ Int *p_pmatched, /* # of matched entries in pattern */ Int *p_nzoffdiag, /* # of off diagonal entries */ Int *p_nzdiag, /* # of diagonal entries */ /* --------------- */ cholmod_common *Common ) { double aij_real = 0, aij_imag = 0, aji_real = 0, aji_imag = 0 ; double *Ax, *Az ; Int *Ap, *Ai, *Anz, *munch ; Int packed, nrow, ncol, xtype, is_symmetric, is_skew, is_hermitian, posdiag, j, p, pend, i, piend, result, xmatched, pmatched, nzdiag, i2, found ; /* ---------------------------------------------------------------------- */ /* check inputs */ /* ---------------------------------------------------------------------- */ RETURN_IF_NULL_COMMON (EMPTY) ; RETURN_IF_NULL (A, EMPTY) ; RETURN_IF_XTYPE_INVALID (A, CHOLMOD_PATTERN, CHOLMOD_ZOMPLEX, EMPTY) ; Common->status = CHOLMOD_OK ; ASSERT (CHOLMOD(dump_sparse) (A, "cholmod_symmetry", Common) >= 0) ; if (p_xmatched == NULL || p_pmatched == NULL || p_nzoffdiag == NULL || p_nzdiag == NULL) { /* option 2 is not performed if any output parameter is NULL */ option = MAX (option, 1) ; } /* ---------------------------------------------------------------------- */ /* get inputs */ /* ---------------------------------------------------------------------- */ Ap = A->p ; Ai = A->i ; Ax = A->x ; Az = A->z ; Anz = A->nz ; packed = A->packed ; ncol = A->ncol ; nrow = A->nrow ; xtype = A->xtype ; /* ---------------------------------------------------------------------- */ /* check if rectangular, unsorted, or stype is not zero */ /* ---------------------------------------------------------------------- */ if (nrow != ncol) { /* matrix is rectangular */ return (CHOLMOD_MM_RECTANGULAR) ; } if (!(A->sorted) || A->stype != 0) { /* this function cannot determine the type or symmetry */ return (EMPTY) ; } /* ---------------------------------------------------------------------- */ /* allocate workspace */ /* ---------------------------------------------------------------------- */ /* this function requires uninitialized Int workspace of size ncol */ CHOLMOD(allocate_work) (0, ncol, 0, Common) ; if (Common->status < CHOLMOD_OK) { /* out of memory */ return (EMPTY) ; } munch = Common->Iwork ; /* the munch array is size ncol */ /* ---------------------------------------------------------------------- */ /* determine symmetry of a square matrix */ /* ---------------------------------------------------------------------- */ /* a complex or zomplex matrix is Hermitian until proven otherwise */ is_hermitian = (xtype >= CHOLMOD_COMPLEX) ; /* any matrix is symmetric until proven otherwise */ is_symmetric = TRUE ; /* a non-pattern matrix is skew-symmetric until proven otherwise */ is_skew = (xtype != CHOLMOD_PATTERN) ; /* a matrix has positive diagonal entries until proven otherwise */ posdiag = TRUE ; /* munch pointers start at the top of each column */ for (j = 0 ; j < ncol ; j++) { munch [j] = Ap [j] ; } xmatched = 0 ; pmatched = 0 ; nzdiag = 0 ; for (j = 0 ; j < ncol ; j++) /* examine each column of A */ { /* ------------------------------------------------------------------ */ /* look at the entire munch column j */ /* ------------------------------------------------------------------ */ /* start at the munch point of column j, and go to end of the column */ p = munch [j] ; pend = (packed) ? (Ap [j+1]) : (Ap [j] + Anz [j]) ; for ( ; p < pend ; p++) { /* get the row index of A(i,j) */ i = Ai [p] ; if (i < j) { /* ---------------------------------------------------------- */ /* A(i,j) in triu(A), but matching A(j,i) not in tril(A) */ /* ---------------------------------------------------------- */ /* entry A(i,j) is unmatched; it appears in the upper triangular * part, but not the lower triangular part. The matrix is * unsymmetric. */ is_hermitian = FALSE ; is_symmetric = FALSE ; is_skew = FALSE ; } else if (i == j) { /* ---------------------------------------------------------- */ /* the diagonal A(j,j) is present; check its value */ /* ---------------------------------------------------------- */ get_value (Ax, Az, p, xtype, &aij_real, &aij_imag) ; if (aij_real != 0. || aij_imag != 0.) { /* diagonal is nonzero; matrix is not skew-symmetric */ nzdiag++ ; is_skew = FALSE ; } if (aij_real <= 0. || aij_imag != 0.) { /* diagonal negative or imaginary; not chol candidate */ posdiag = FALSE ; } if (aij_imag != 0.) { /* imaginary part is present; not Hermitian */ is_hermitian = FALSE ; } } else /* i > j */ { /* ---------------------------------------------------------- */ /* consider column i, up to and including row j */ /* ---------------------------------------------------------- */ /* munch the entry at top of column i up to and incl row j */ piend = (packed) ? (Ap [i+1]) : (Ap [i] + Anz [i]) ; found = FALSE ; for ( ; munch [i] < piend ; munch [i]++) { i2 = Ai [munch [i]] ; if (i2 < j) { /* -------------------------------------------------- */ /* A(i2,i) in triu(A) but A(i,i2) not in tril(A) */ /* -------------------------------------------------- */ /* The matrix is unsymmetric. */ is_hermitian = FALSE ; is_symmetric = FALSE ; is_skew = FALSE ; } else if (i2 == j) { /* -------------------------------------------------- */ /* both A(i,j) and A(j,i) exist in the matrix */ /* -------------------------------------------------- */ /* this is one more matching entry in the pattern */ pmatched += 2 ; found = TRUE ; /* get the value of A(i,j) */ get_value (Ax, Az, p, xtype, &aij_real, &aij_imag) ; /* get the value of A(j,i) */ get_value (Ax, Az, munch [i], xtype, &aji_real, &aji_imag) ; /* compare A(i,j) with A(j,i) */ if (aij_real != aji_real || aij_imag != aji_imag) { /* the matrix cannot be symmetric */ is_symmetric = FALSE ; } if (aij_real != -aji_real || aij_imag != aji_imag) { /* the matrix cannot be skew-symmetric */ is_skew = FALSE ; } if (aij_real != aji_real || aij_imag != -aji_imag) { /* the matrix cannot be Hermitian */ is_hermitian = FALSE ; } else { /* A(i,j) and A(j,i) are numerically matched */ xmatched += 2 ; } } else /* i2 > j */ { /* -------------------------------------------------- */ /* entry A(i2,i) is not munched; consider it later */ /* -------------------------------------------------- */ break ; } } if (!found) { /* A(i,j) in tril(A) but A(j,i) not in triu(A). * The matrix is unsymmetric. */ is_hermitian = FALSE ; is_symmetric = FALSE ; is_skew = FALSE ; } } if (option < 2 && !(is_symmetric || is_skew || is_hermitian)) { /* matrix is unsymmetric; terminate the test */ return (CHOLMOD_MM_UNSYMMETRIC) ; } } /* ------------------------------------------------------------------ */ /* quick return if not Cholesky candidate */ /* ------------------------------------------------------------------ */ if (option < 1 && (!posdiag || nzdiag <= j)) { /* Diagonal entry not present, or present but negative or with * nonzero imaginary part. Quick return for option 0. */ return (CHOLMOD_MM_UNSYMMETRIC) ; } } /* ---------------------------------------------------------------------- */ /* return the results */ /* ---------------------------------------------------------------------- */ if (nzdiag < ncol) { /* not all diagonal entries are present */ posdiag = FALSE ; } if (option >= 2) { *p_xmatched = xmatched ; *p_pmatched = pmatched ; *p_nzoffdiag = CHOLMOD(nnz) (A, Common) - nzdiag ; *p_nzdiag = nzdiag ; } result = CHOLMOD_MM_UNSYMMETRIC ; if (is_hermitian) { /* complex Hermitian matrix, with either pos. or non-pos. diagonal */ result = posdiag ? CHOLMOD_MM_HERMITIAN_POSDIAG : CHOLMOD_MM_HERMITIAN ; } else if (is_symmetric) { /* real or complex symmetric matrix, with pos. or non-pos. diagonal */ result = posdiag ? CHOLMOD_MM_SYMMETRIC_POSDIAG : CHOLMOD_MM_SYMMETRIC ; } else if (is_skew) { /* real or complex skew-symmetric matrix */ result = CHOLMOD_MM_SKEW_SYMMETRIC ; } return (result) ; }
int CHOLMOD(rowfac_mask) ( /* ---- input ---- */ cholmod_sparse *A, /* matrix to factorize */ cholmod_sparse *F, /* used for A*A' case only. F=A' or A(:,f)' */ double beta [2], /* factorize beta*I+A or beta*I+AA' */ size_t kstart, /* first row to factorize */ size_t kend, /* last row to factorize is kend-1 */ Int *mask, /* size A->nrow. if mask[i] >= 0 row i is set to zero */ Int *RLinkUp, /* size A->nrow. link list of rows to compute */ /* ---- in/out --- */ cholmod_factor *L, /* --------------- */ cholmod_common *Common ) { Int n ; size_t s ; int ok = TRUE ; /* ---------------------------------------------------------------------- */ /* check inputs */ /* ---------------------------------------------------------------------- */ RETURN_IF_NULL_COMMON (FALSE) ; RETURN_IF_NULL (A, FALSE) ; RETURN_IF_NULL (L, FALSE) ; RETURN_IF_XTYPE_INVALID (A, CHOLMOD_REAL, CHOLMOD_ZOMPLEX, FALSE) ; RETURN_IF_XTYPE_INVALID (L, CHOLMOD_PATTERN, CHOLMOD_ZOMPLEX, FALSE) ; if (L->xtype != CHOLMOD_PATTERN && A->xtype != L->xtype) { ERROR (CHOLMOD_INVALID, "xtype of A and L do not match") ; return (FALSE) ; } if (L->is_super) { ERROR (CHOLMOD_INVALID, "can only do simplicial factorization"); return (FALSE) ; } if (A->stype == 0) { RETURN_IF_NULL (F, FALSE) ; if (A->xtype != F->xtype) { ERROR (CHOLMOD_INVALID, "xtype of A and F do not match") ; return (FALSE) ; } } if (A->stype < 0) { /* symmetric lower triangular form not supported */ ERROR (CHOLMOD_INVALID, "symmetric lower not supported") ; return (FALSE) ; } if (kend > L->n) { ERROR (CHOLMOD_INVALID, "kend invalid") ; return (FALSE) ; } if (A->nrow != L->n) { ERROR (CHOLMOD_INVALID, "dimensions of A and L do not match") ; return (FALSE) ; } Common->status = CHOLMOD_OK ; Common->rowfacfl = 0 ; /* ---------------------------------------------------------------------- */ /* allocate workspace */ /* ---------------------------------------------------------------------- */ /* Xwork is of size n for the real case, 2*n for complex/zomplex */ n = L->n ; /* s = ((A->xtype != CHOLMOD_REAL) ? 2:1)*n */ s = CHOLMOD(mult_size_t) (n, ((A->xtype != CHOLMOD_REAL) ? 2:1), &ok) ; if (!ok) { ERROR (CHOLMOD_TOO_LARGE, "problem too large") ; return (FALSE) ; } CHOLMOD(allocate_work) (n, n, s, Common) ; if (Common->status < CHOLMOD_OK) { return (FALSE) ; } ASSERT (CHOLMOD(dump_work) (TRUE, TRUE, A->nrow, Common)) ; /* ---------------------------------------------------------------------- */ /* factorize the matrix, using template routine */ /* ---------------------------------------------------------------------- */ if (RLinkUp == NULL) { switch (A->xtype) { case CHOLMOD_REAL: ok = r_cholmod_rowfac (A, F, beta, kstart, kend, L, Common) ; break ; case CHOLMOD_COMPLEX: ok = c_cholmod_rowfac (A, F, beta, kstart, kend, L, Common) ; break ; case CHOLMOD_ZOMPLEX: ok = z_cholmod_rowfac (A, F, beta, kstart, kend, L, Common) ; break ; } } else { switch (A->xtype) { case CHOLMOD_REAL: ok = r_cholmod_rowfac_mask (A, F, beta, kstart, kend, mask, RLinkUp, L, Common) ; break ; case CHOLMOD_COMPLEX: ok = c_cholmod_rowfac_mask (A, F, beta, kstart, kend, mask, RLinkUp, L, Common) ; break ; case CHOLMOD_ZOMPLEX: ok = z_cholmod_rowfac_mask (A, F, beta, kstart, kend, mask, RLinkUp, L, Common) ; break ; } } return (ok) ; }
cholmod_triplet *CHOLMOD(sparse_to_triplet) ( /* ---- input ---- */ cholmod_sparse *A, /* matrix to copy */ /* --------------- */ cholmod_common *Common ) { double *Ax, *Az, *Tx, *Tz ; Int *Ap, *Ai, *Ti, *Tj, *Anz ; cholmod_triplet *T ; Int i, xtype, p, pend, k, j, nrow, ncol, nz, stype, packed, up, lo, both ; /* ---------------------------------------------------------------------- */ /* check inputs */ /* ---------------------------------------------------------------------- */ RETURN_IF_NULL_COMMON (NULL) ; RETURN_IF_NULL (A, NULL) ; RETURN_IF_XTYPE_INVALID (A, CHOLMOD_PATTERN, CHOLMOD_ZOMPLEX, NULL) ; stype = SIGN (A->stype) ; nrow = A->nrow ; ncol = A->ncol ; if (stype && nrow != ncol) { /* inputs invalid */ ERROR (CHOLMOD_INVALID, "matrix invalid") ; return (NULL) ; } Ax = A->x ; Az = A->z ; xtype = A->xtype ; Common->status = CHOLMOD_OK ; ASSERT (CHOLMOD(dump_sparse) (A, "A", Common) >= 0) ; /* ---------------------------------------------------------------------- */ /* allocate triplet matrix */ /* ---------------------------------------------------------------------- */ nz = CHOLMOD(nnz) (A, Common) ; T = CHOLMOD(allocate_triplet) (nrow, ncol, nz, A->stype, A->xtype, Common) ; if (Common->status < CHOLMOD_OK) { return (NULL) ; /* out of memory */ } /* ---------------------------------------------------------------------- */ /* convert to a sparse matrix */ /* ---------------------------------------------------------------------- */ Ap = A->p ; Ai = A->i ; Anz = A->nz ; packed = A->packed ; Ti = T->i ; Tj = T->j ; Tx = T->x ; Tz = T->z ; T->stype = A->stype ; both = (A->stype == 0) ; up = (A->stype > 0) ; lo = (A->stype < 0) ; k = 0 ; for (j = 0 ; j < ncol ; j++) { p = Ap [j] ; pend = (packed) ? (Ap [j+1]) : (p + Anz [j]) ; for ( ; p < pend ; p++) { i = Ai [p] ; if (both || (up && i <= j) || (lo && i >= j)) { Ti [k] = Ai [p] ; Tj [k] = j ; if (xtype == CHOLMOD_REAL) { Tx [k] = Ax [p] ; } else if (xtype == CHOLMOD_COMPLEX) { Tx [2*k ] = Ax [2*p ] ; Tx [2*k+1] = Ax [2*p+1] ; } else if (xtype == CHOLMOD_ZOMPLEX) { Tx [k] = Ax [p] ; Tz [k] = Az [p] ; } k++ ; ASSERT (k <= nz) ; } } } T->nnz = k ; /* ---------------------------------------------------------------------- */ /* return result */ /* ---------------------------------------------------------------------- */ ASSERT (CHOLMOD(dump_triplet) (T, "T", Common)) ; return (T) ; }
int CHOLMOD(rowcolcounts) ( /* ---- input ---- */ cholmod_sparse *A, /* matrix to analyze */ Int *fset, /* subset of 0:(A->ncol)-1 */ size_t fsize, /* size of fset */ Int *Parent, /* size nrow. Parent [i] = p if p is the parent of i */ Int *Post, /* size nrow. Post [k] = i if i is the kth node in * the postordered etree. */ /* ---- output --- */ Int *RowCount, /* size nrow. RowCount [i] = # entries in the ith row of * L, including the diagonal. */ Int *ColCount, /* size nrow. ColCount [i] = # entries in the ith * column of L, including the diagonal. */ Int *First, /* size nrow. First [i] = k is the least postordering * of any descendant of i. */ Int *Level, /* size nrow. Level [i] is the length of the path from * i to the root, with Level [root] = 0. */ /* --------------- */ cholmod_common *Common ) { double fl, ff ; Int *Ap, *Ai, *Anz, *PrevNbr, *SetParent, *Head, *PrevLeaf, *Anext, *Ipost, *Iwork ; Int i, j, r, k, len, s, p, pend, inew, stype, nf, anz, inode, parent, nrow, ncol, packed, use_fset, jj ; size_t w ; int ok = TRUE ; /* ---------------------------------------------------------------------- */ /* check inputs */ /* ---------------------------------------------------------------------- */ RETURN_IF_NULL_COMMON (FALSE) ; RETURN_IF_NULL (A, FALSE) ; RETURN_IF_NULL (Parent, FALSE) ; RETURN_IF_NULL (Post, FALSE) ; RETURN_IF_NULL (ColCount, FALSE) ; RETURN_IF_NULL (First, FALSE) ; RETURN_IF_NULL (Level, FALSE) ; RETURN_IF_XTYPE_INVALID (A, CHOLMOD_PATTERN, CHOLMOD_ZOMPLEX, FALSE) ; stype = A->stype ; if (stype > 0) { /* symmetric with upper triangular part not supported */ ERROR (CHOLMOD_INVALID, "symmetric upper not supported") ; return (FALSE) ; } Common->status = CHOLMOD_OK ; /* ---------------------------------------------------------------------- */ /* allocate workspace */ /* ---------------------------------------------------------------------- */ nrow = A->nrow ; /* the number of rows of A */ ncol = A->ncol ; /* the number of columns of A */ /* w = 2*nrow + (stype ? 0 : ncol) */ w = CHOLMOD(mult_size_t) (nrow, 2, &ok) ; w = CHOLMOD(add_size_t) (w, (stype ? 0 : ncol), &ok) ; if (!ok) { ERROR (CHOLMOD_TOO_LARGE, "problem too large") ; return (FALSE) ; } CHOLMOD(allocate_work) (nrow, w, 0, Common) ; if (Common->status < CHOLMOD_OK) { return (FALSE) ; } ASSERT (CHOLMOD(dump_perm) (Post, nrow, nrow, "Post", Common)) ; ASSERT (CHOLMOD(dump_parent) (Parent, nrow, "Parent", Common)) ; /* ---------------------------------------------------------------------- */ /* get inputs */ /* ---------------------------------------------------------------------- */ Ap = A->p ; /* size ncol+1, column pointers for A */ Ai = A->i ; /* the row indices of A, of size nz=Ap[ncol+1] */ Anz = A->nz ; packed = A->packed ; ASSERT (IMPLIES (!packed, Anz != NULL)) ; /* ---------------------------------------------------------------------- */ /* get workspace */ /* ---------------------------------------------------------------------- */ Iwork = Common->Iwork ; SetParent = Iwork ; /* size nrow (i/i/l) */ PrevNbr = Iwork + nrow ; /* size nrow (i/i/l) */ Anext = Iwork + 2*((size_t) nrow) ; /* size ncol (i/i/l) (unsym only) */ PrevLeaf = Common->Flag ; /* size nrow */ Head = Common->Head ; /* size nrow+1 (unsym only)*/ /* ---------------------------------------------------------------------- */ /* find the first descendant and level of each node in the tree */ /* ---------------------------------------------------------------------- */ /* First [i] = k if the postordering of first descendent of node i is k */ /* Level [i] = length of path from node i to the root (Level [root] = 0) */ for (i = 0 ; i < nrow ; i++) { First [i] = EMPTY ; } /* postorder traversal of the etree */ for (k = 0 ; k < nrow ; k++) { /* node i of the etree is the kth node in the postordered etree */ i = Post [k] ; /* i is a leaf if First [i] is still EMPTY */ /* ColCount [i] starts at 1 if i is a leaf, zero otherwise */ ColCount [i] = (First [i] == EMPTY) ? 1 : 0 ; /* traverse the path from node i to the root, stopping if we find a * node r whose First [r] is already defined. */ len = 0 ; for (r = i ; (r != EMPTY) && (First [r] == EMPTY) ; r = Parent [r]) { First [r] = k ; len++ ; } if (r == EMPTY) { /* we hit a root node, the level of which is zero */ len-- ; } else { /* we stopped at node r, where Level [r] is already defined */ len += Level [r] ; } /* re-traverse the path from node i to r; set the level of each node */ for (s = i ; s != r ; s = Parent [s]) { Level [s] = len-- ; } } /* ---------------------------------------------------------------------- */ /* AA' case: sort columns of A according to first postordered row index */ /* ---------------------------------------------------------------------- */ fl = 0.0 ; if (stype == 0) { /* [ use PrevNbr [0..nrow-1] as workspace for Ipost */ Ipost = PrevNbr ; /* Ipost [i] = k if i is the kth node in the postordered etree. */ for (k = 0 ; k < nrow ; k++) { Ipost [Post [k]] = k ; } use_fset = (fset != NULL) ; if (use_fset) { nf = fsize ; /* clear Anext to check fset */ for (j = 0 ; j < ncol ; j++) { Anext [j] = -2 ; } /* find the first postordered row in each column of A (post,f) * and place the column in the corresponding link list */ for (jj = 0 ; jj < nf ; jj++) { j = fset [jj] ; if (j < 0 || j > ncol || Anext [j] != -2) { /* out-of-range or duplicate entry in fset */ ERROR (CHOLMOD_INVALID, "fset invalid") ; return (FALSE) ; } /* flag column j as having been seen */ Anext [j] = EMPTY ; } /* fset is now valid */ ASSERT (CHOLMOD(dump_perm) (fset, nf, ncol, "fset", Common)) ; } else { nf = ncol ; } for (jj = 0 ; jj < nf ; jj++) { j = (use_fset) ? (fset [jj]) : jj ; /* column j is in the fset; find the smallest row (if any) */ p = Ap [j] ; pend = (packed) ? (Ap [j+1]) : (p + Anz [j]) ; ff = (double) MAX (0, pend - p) ; fl += ff*ff + ff ; if (pend > p) { k = Ipost [Ai [p]] ; for ( ; p < pend ; p++) { inew = Ipost [Ai [p]] ; k = MIN (k, inew) ; } /* place column j in link list k */ ASSERT (k >= 0 && k < nrow) ; Anext [j] = Head [k] ; Head [k] = j ; } } /* Ipost no longer needed for inverse postordering ] * Head [k] contains a link list of all columns whose first * postordered row index is equal to k, for k = 0 to nrow-1. */ } /* ---------------------------------------------------------------------- */ /* compute the row counts and node weights */ /* ---------------------------------------------------------------------- */ if (RowCount != NULL) { for (i = 0 ; i < nrow ; i++) { RowCount [i] = 1 ; } } for (i = 0 ; i < nrow ; i++) { PrevLeaf [i] = EMPTY ; PrevNbr [i] = EMPTY ; SetParent [i] = i ; /* every node is in its own set, by itself */ } if (stype != 0) { /* ------------------------------------------------------------------ */ /* symmetric case: LL' = A */ /* ------------------------------------------------------------------ */ /* also determine the number of entries in triu(A) */ anz = nrow ; for (k = 0 ; k < nrow ; k++) { /* j is the kth node in the postordered etree */ j = initialize_node (k, Post, Parent, ColCount, PrevNbr) ; /* for all nonzeros A(i,j) below the diagonal, in column j of A */ p = Ap [j] ; pend = (packed) ? (Ap [j+1]) : (p + Anz [j]) ; for ( ; p < pend ; p++) { i = Ai [p] ; if (i > j) { /* j is a descendant of i in etree(A) */ anz++ ; process_edge (j, i, k, First, PrevNbr, ColCount, PrevLeaf, RowCount, SetParent, Level) ; } } /* update SetParent: UNION (j, Parent [j]) */ finalize_node (j, Parent, SetParent) ; } Common->anz = anz ; } else { /* ------------------------------------------------------------------ */ /* unsymmetric case: LL' = AA' */ /* ------------------------------------------------------------------ */ for (k = 0 ; k < nrow ; k++) { /* inode is the kth node in the postordered etree */ inode = initialize_node (k, Post, Parent, ColCount, PrevNbr) ; /* for all cols j whose first postordered row is k: */ for (j = Head [k] ; j != EMPTY ; j = Anext [j]) { /* k is the first postordered row in column j of A */ /* for all rows i in column j: */ p = Ap [j] ; pend = (packed) ? (Ap [j+1]) : (p + Anz [j]) ; for ( ; p < pend ; p++) { i = Ai [p] ; /* has i already been considered at this step k */ if (PrevNbr [i] < k) { /* inode is a descendant of i in etree(AA') */ /* process edge (inode,i) and set PrevNbr[i] to k */ process_edge (inode, i, k, First, PrevNbr, ColCount, PrevLeaf, RowCount, SetParent, Level) ; } } } /* clear link list k */ Head [k] = EMPTY ; /* update SetParent: UNION (inode, Parent [inode]) */ finalize_node (inode, Parent, SetParent) ; } } /* ---------------------------------------------------------------------- */ /* finish computing the column counts */ /* ---------------------------------------------------------------------- */ for (j = 0 ; j < nrow ; j++) { parent = Parent [j] ; if (parent != EMPTY) { /* add the ColCount of j to its parent */ ColCount [parent] += ColCount [j] ; } } /* ---------------------------------------------------------------------- */ /* clear workspace */ /* ---------------------------------------------------------------------- */ Common->mark = EMPTY ; /* CHOLMOD(clear_flag) (Common) ; */ CHOLMOD_CLEAR_FLAG (Common) ; ASSERT (CHOLMOD(dump_work) (TRUE, TRUE, 0, Common)) ; /* ---------------------------------------------------------------------- */ /* flop count and nnz(L) for subsequent LL' numerical factorization */ /* ---------------------------------------------------------------------- */ /* use double to avoid integer overflow. lnz cannot be NaN. */ Common->aatfl = fl ; Common->lnz = 0. ; fl = 0 ; for (j = 0 ; j < nrow ; j++) { ff = (double) (ColCount [j]) ; Common->lnz += ff ; fl += ff*ff ; } Common->fl = fl ; PRINT1 (("rowcol fl %g lnz %g\n", Common->fl, Common->lnz)) ; return (TRUE) ; }
cholmod_triplet *CHOLMOD(copy_triplet) ( /* ---- input ---- */ cholmod_triplet *T, /* matrix to copy */ /* --------------- */ cholmod_common *Common ) { double *Tx, *Tz, *Cx, *Cz ; Int *Ci, *Cj, *Ti, *Tj ; cholmod_triplet *C ; Int xtype, k, nz ; /* ---------------------------------------------------------------------- */ /* check inputs */ /* ---------------------------------------------------------------------- */ RETURN_IF_NULL_COMMON (NULL) ; RETURN_IF_NULL (T, NULL) ; RETURN_IF_XTYPE_INVALID (T, CHOLMOD_PATTERN, CHOLMOD_ZOMPLEX, NULL) ; nz = T->nnz ; Ti = T->i ; Tj = T->j ; Tx = T->x ; Tz = T->z ; xtype = T->xtype ; RETURN_IF_NULL (Ti, NULL) ; RETURN_IF_NULL (Tj, NULL) ; Common->status = CHOLMOD_OK ; DEBUG (CHOLMOD(dump_triplet) (T, "T input", Common)) ; /* ---------------------------------------------------------------------- */ /* allocate copy */ /* ---------------------------------------------------------------------- */ C = CHOLMOD(allocate_triplet) (T->nrow, T->ncol, T->nzmax, T->stype, xtype, Common) ; if (Common->status < CHOLMOD_OK) { return (NULL) ; /* out of memory */ } /* ---------------------------------------------------------------------- */ /* copy the triplet matrix */ /* ---------------------------------------------------------------------- */ Ci = C->i ; Cj = C->j ; Cx = C->x ; Cz = C->z ; C->nnz = nz ; for (k = 0 ; k < nz ; k++) { Ci [k] = Ti [k] ; } for (k = 0 ; k < nz ; k++) { Cj [k] = Tj [k] ; } if (xtype == CHOLMOD_REAL) { for (k = 0 ; k < nz ; k++) { Cx [k] = Tx [k] ; } } else if (xtype == CHOLMOD_COMPLEX) { for (k = 0 ; k < nz ; k++) { Cx [2*k ] = Tx [2*k ] ; Cx [2*k+1] = Tx [2*k+1] ; } } else if (xtype == CHOLMOD_ZOMPLEX) { for (k = 0 ; k < nz ; k++) { Cx [k] = Tx [k] ; Cz [k] = Tz [k] ; } } /* ---------------------------------------------------------------------- */ /* return the result */ /* ---------------------------------------------------------------------- */ ASSERT (CHOLMOD(dump_triplet) (C, "C triplet copy", Common)) ; return (C) ; }
cholmod_sparse *CHOLMOD(horzcat) ( /* ---- input ---- */ cholmod_sparse *A, /* left matrix to concatenate */ cholmod_sparse *B, /* right matrix to concatenate */ int values, /* if TRUE compute the numerical values of C */ /* --------------- */ cholmod_common *Common ) { double *Ax, *Bx, *Cx ; Int *Ap, *Ai, *Anz, *Bp, *Bi, *Bnz, *Cp, *Ci ; cholmod_sparse *C, *A2, *B2 ; Int apacked, bpacked, ancol, bncol, ncol, nrow, anz, bnz, nz, j, p, pend, pdest ; /* ---------------------------------------------------------------------- */ /* check inputs */ /* ---------------------------------------------------------------------- */ RETURN_IF_NULL_COMMON (NULL) ; RETURN_IF_NULL (A, NULL) ; RETURN_IF_NULL (B, NULL) ; values = values && (A->xtype != CHOLMOD_PATTERN) && (B->xtype != CHOLMOD_PATTERN) ; RETURN_IF_XTYPE_INVALID (A, CHOLMOD_PATTERN, values ? CHOLMOD_REAL : CHOLMOD_ZOMPLEX, NULL) ; RETURN_IF_XTYPE_INVALID (B, CHOLMOD_PATTERN, values ? CHOLMOD_REAL : CHOLMOD_ZOMPLEX, NULL) ; if (A->nrow != B->nrow) { /* A and B must have the same number of rows */ ERROR (CHOLMOD_INVALID, "A and B must have same # rows") ; return (NULL) ; } /* A and B must have the same numerical type if values is TRUE (both must * be CHOLMOD_REAL, this is implicitly checked above) */ Common->status = CHOLMOD_OK ; /* ---------------------------------------------------------------------- */ /* allocate workspace */ /* ---------------------------------------------------------------------- */ ancol = A->ncol ; bncol = B->ncol ; nrow = A->nrow ; CHOLMOD(allocate_work) (0, MAX3 (nrow, ancol, bncol), 0, Common) ; if (Common->status < CHOLMOD_OK) { /* out of memory */ return (NULL) ; } /* ---------------------------------------------------------------------- */ /* get inputs */ /* ---------------------------------------------------------------------- */ /* convert A to unsymmetric, if necessary */ A2 = NULL ; if (A->stype != 0) { /* workspace: Iwork (max (A->nrow,A->ncol)) */ A2 = CHOLMOD(copy) (A, 0, values, Common) ; if (Common->status < CHOLMOD_OK) { /* out of memory */ return (NULL) ; } A = A2 ; } /* convert B to unsymmetric, if necessary */ B2 = NULL ; if (B->stype != 0) { /* workspace: Iwork (max (B->nrow,B->ncol)) */ B2 = CHOLMOD(copy) (B, 0, values, Common) ; if (Common->status < CHOLMOD_OK) { /* out of memory */ CHOLMOD(free_sparse) (&A2, Common) ; return (NULL) ; } B = B2 ; } Ap = A->p ; Anz = A->nz ; Ai = A->i ; Ax = A->x ; apacked = A->packed ; Bp = B->p ; Bnz = B->nz ; Bi = B->i ; Bx = B->x ; bpacked = B->packed ; /* ---------------------------------------------------------------------- */ /* allocate C */ /* ---------------------------------------------------------------------- */ anz = CHOLMOD(nnz) (A, Common) ; bnz = CHOLMOD(nnz) (B, Common) ; ncol = ancol + bncol ; nz = anz + bnz ; C = CHOLMOD(allocate_sparse) (nrow, ncol, nz, A->sorted && B->sorted, TRUE, 0, values ? A->xtype : CHOLMOD_PATTERN, Common) ; if (Common->status < CHOLMOD_OK) { /* out of memory */ CHOLMOD(free_sparse) (&A2, Common) ; CHOLMOD(free_sparse) (&B2, Common) ; return (NULL) ; } Cp = C->p ; Ci = C->i ; Cx = C->x ; /* ---------------------------------------------------------------------- */ /* C = [A , B] */ /* ---------------------------------------------------------------------- */ pdest = 0 ; /* copy A as the first A->ncol columns of C */ for (j = 0 ; j < ancol ; j++) { /* A(:,j) is the jth column of C */ p = Ap [j] ; pend = (apacked) ? (Ap [j+1]) : (p + Anz [j]) ; Cp [j] = pdest ; for ( ; p < pend ; p++) { Ci [pdest] = Ai [p] ; if (values) Cx [pdest] = Ax [p] ; pdest++ ; } } /* copy B as the next B->ncol columns of C */ for (j = 0 ; j < bncol ; j++) { /* B(:,j) is the (ancol+j)th column of C */ p = Bp [j] ; pend = (bpacked) ? (Bp [j+1]) : (p + Bnz [j]) ; Cp [ancol + j] = pdest ; for ( ; p < pend ; p++) { Ci [pdest] = Bi [p] ; if (values) Cx [pdest] = Bx [p] ; pdest++ ; } } Cp [ncol] = pdest ; ASSERT (pdest == anz + bnz) ; /* ---------------------------------------------------------------------- */ /* free the unsymmetric copies of A and B, and return C */ /* ---------------------------------------------------------------------- */ CHOLMOD(free_sparse) (&A2, Common) ; CHOLMOD(free_sparse) (&B2, Common) ; return (C) ; }
int CHOLMOD(rowdel_mark) ( /* ---- input ---- */ size_t kdel, /* row/column index to delete */ cholmod_sparse *R, /* NULL, or the nonzero pattern of kth row of L */ double yk [2], /* kth entry in the solution to A*y=b */ Int *colmark, /* Int array of size 1. See cholmod_updown.c */ /* ---- in/out --- */ cholmod_factor *L, /* factor to modify */ cholmod_dense *X, /* solution to Lx=b (size n-by-1) */ cholmod_dense *DeltaB, /* change in b, zero on output */ /* --------------- */ cholmod_common *Common ) { double dk, sqrt_dk, xk, dj, fl ; double *Lx, *Cx, *W, *Xx, *Nx ; Int *Li, *Lp, *Lnz, *Ci, *Rj, *Rp, *Iwork ; cholmod_sparse *C, Cmatrix ; Int j, p, pend, kk, lnz, n, Cp [2], do_solve, do_update, left, k, right, middle, i, klast, given_row, rnz, ok ; /* ---------------------------------------------------------------------- */ /* check inputs */ /* ---------------------------------------------------------------------- */ RETURN_IF_NULL_COMMON (FALSE) ; RETURN_IF_NULL (L, FALSE) ; RETURN_IF_XTYPE_INVALID (L, CHOLMOD_PATTERN, CHOLMOD_REAL, FALSE) ; n = L->n ; k = kdel ; if (k >= n || k < 0) { ERROR (CHOLMOD_INVALID, "k invalid") ; return (FALSE) ; } if (R == NULL) { Rj = NULL ; rnz = EMPTY ; } else { RETURN_IF_XTYPE_INVALID (R, CHOLMOD_PATTERN, CHOLMOD_ZOMPLEX, FALSE) ; if (R->ncol != 1 || R->nrow != L->n) { ERROR (CHOLMOD_INVALID, "R invalid") ; return (FALSE) ; } Rj = R->i ; Rp = R->p ; rnz = Rp [1] ; } do_solve = (X != NULL) && (DeltaB != NULL) ; if (do_solve) { RETURN_IF_XTYPE_INVALID (X, CHOLMOD_REAL, CHOLMOD_REAL, FALSE) ; RETURN_IF_XTYPE_INVALID (DeltaB, CHOLMOD_REAL, CHOLMOD_REAL, FALSE) ; Xx = X->x ; Nx = DeltaB->x ; if (X->nrow != L->n || X->ncol != 1 || DeltaB->nrow != L->n || DeltaB->ncol != 1 || Xx == NULL || Nx == NULL) { ERROR (CHOLMOD_INVALID, "X and/or DeltaB invalid") ; return (FALSE) ; } } else { Xx = NULL ; Nx = NULL ; } Common->status = CHOLMOD_OK ; /* ---------------------------------------------------------------------- */ /* allocate workspace */ /* ---------------------------------------------------------------------- */ CHOLMOD(allocate_work) (n, 2*n, 2*n, Common) ; if (Common->status < CHOLMOD_OK) { return (FALSE) ; } ASSERT (CHOLMOD(dump_work) (TRUE, TRUE, 2*n, Common)) ; /* ---------------------------------------------------------------------- */ /* convert to simplicial numeric LDL' factor, if not already */ /* ---------------------------------------------------------------------- */ if (L->xtype == CHOLMOD_PATTERN || L->is_super || L->is_ll) { /* can only update/downdate a simplicial LDL' factorization */ CHOLMOD(change_factor) (CHOLMOD_REAL, FALSE, FALSE, FALSE, FALSE, L, Common) ; if (Common->status < CHOLMOD_OK) { /* out of memory, L is returned unchanged */ return (FALSE) ; } } /* ---------------------------------------------------------------------- */ /* get inputs */ /* ---------------------------------------------------------------------- */ /* inputs, not modified on output: */ Lp = L->p ; /* size n+1 */ /* outputs, contents defined on input for incremental case only: */ Lnz = L->nz ; /* size n */ Li = L->i ; /* size L->nzmax. Can change in size. */ Lx = L->x ; /* size L->nzmax. Can change in size. */ ASSERT (L->nz != NULL) ; /* ---------------------------------------------------------------------- */ /* get workspace */ /* ---------------------------------------------------------------------- */ W = Common->Xwork ; /* size n, used only in cholmod_updown */ Cx = W + n ; /* use 2nd column of Xwork for C (size n) */ Iwork = Common->Iwork ; Ci = Iwork + n ; /* size n (i/i/l) */ /* NOTE: cholmod_updown uses Iwork [0..n-1] (i/i/l) as Stack */ /* ---------------------------------------------------------------------- */ /* prune row k from all columns of L */ /* ---------------------------------------------------------------------- */ given_row = (rnz >= 0) ; klast = given_row ? rnz : k ; PRINT2 (("given_row "ID"\n", given_row)) ; for (kk = 0 ; kk < klast ; kk++) { /* either search j = 0:k-1 or j = Rj [0:rnz-1] */ j = given_row ? (Rj [kk]) : (kk) ; if (j < 0 || j >= k) { ERROR (CHOLMOD_INVALID, "R invalid") ; return (FALSE) ; } PRINT2 (("Prune col j = "ID":\n", j)) ; lnz = Lnz [j] ; dj = Lx [Lp [j]] ; ASSERT (Lnz [j] > 0 && Li [Lp [j]] == j) ; if (lnz > 1) { left = Lp [j] ; pend = left + lnz ; right = pend - 1 ; i = Li [right] ; if (i < k) { /* row k is not in column j */ continue ; } else if (i == k) { /* k is the last row index in this column (quick delete) */ if (do_solve) { Xx [j] -= yk [0] * dj * Lx [right] ; } Lx [right] = 0 ; } else { /* binary search for row k in column j */ PRINT2 (("\nBinary search: lnz "ID" k = "ID"\n", lnz, k)) ; while (left < right) { middle = (left + right) / 2 ; PRINT2 (("left "ID" right "ID" middle "ID": ["ID" "ID"" ""ID"]\n", left, right, middle, Li [left], Li [middle], Li [right])) ; if (k > Li [middle]) { left = middle + 1 ; } else { right = middle ; } } ASSERT (left >= Lp [j] && left < pend) ; #ifndef NDEBUG /* brute force, linear-time search */ { Int p3 = Lp [j] ; i = EMPTY ; PRINT2 (("Brute force:\n")) ; for ( ; p3 < pend ; p3++) { i = Li [p3] ; PRINT2 (("p "ID" ["ID"]\n", p3, i)) ; if (i >= k) { break ; } } if (i == k) { ASSERT (k == Li [p3]) ; ASSERT (p3 == left) ; } } #endif if (k == Li [left]) { if (do_solve) { Xx [j] -= yk [0] * dj * Lx [left] ; } /* found row k in column j. Prune it from the column.*/ Lx [left] = 0 ; } } } } #ifndef NDEBUG /* ensure that row k has been deleted from the matrix L */ for (j = 0 ; j < k ; j++) { Int lasti ; lasti = EMPTY ; p = Lp [j] ; pend = p + Lnz [j] ; /* look for row k in column j */ PRINT1 (("Pruned column "ID"\n", j)) ; for ( ; p < pend ; p++) { i = Li [p] ; PRINT2 ((" "ID"", i)) ; PRINT2 ((" %g\n", Lx [p])) ; ASSERT (IMPLIES (i == k, Lx [p] == 0)) ; ASSERT (i > lasti) ; lasti = i ; } PRINT1 (("\n")) ; } #endif /* ---------------------------------------------------------------------- */ /* set diagonal and clear column k of L */ /* ---------------------------------------------------------------------- */ lnz = Lnz [k] - 1 ; ASSERT (Lnz [k] > 0) ; /* ---------------------------------------------------------------------- */ /* update/downdate */ /* ---------------------------------------------------------------------- */ /* update or downdate L (k+1:n, k+1:n) with the vector * C = L (:,k) * sqrt (abs (D [k])) * Do a numeric update if D[k] > 0, numeric downdate otherwise. */ PRINT1 (("rowdel downdate lnz = "ID"\n", lnz)) ; /* store the new unit diagonal */ p = Lp [k] ; pend = p + lnz + 1 ; dk = Lx [p] ; Lx [p++] = 1 ; PRINT2 (("D [k = "ID"] = %g\n", k, dk)) ; ok = TRUE ; fl = 0 ; if (lnz > 0) { /* compute DeltaB for updown (in DeltaB) */ if (do_solve) { xk = Xx [k] - yk [0] * dk ; for ( ; p < pend ; p++) { Nx [Li [p]] += Lx [p] * xk ; } } do_update = IS_GT_ZERO (dk) ; if (!do_update) { dk = -dk ; } sqrt_dk = sqrt (dk) ; p = Lp [k] + 1 ; for (kk = 0 ; kk < lnz ; kk++, p++) { Ci [kk] = Li [p] ; Cx [kk] = Lx [p] * sqrt_dk ; Lx [p] = 0 ; /* clear column k */ } fl = lnz + 1 ; /* create a n-by-1 sparse matrix to hold the single column */ C = &Cmatrix ; C->nrow = n ; C->ncol = 1 ; C->nzmax = lnz ; C->sorted = TRUE ; C->packed = TRUE ; C->p = Cp ; C->i = Ci ; C->x = Cx ; C->nz = NULL ; C->itype = L->itype ; C->xtype = L->xtype ; C->dtype = L->dtype ; C->z = NULL ; C->stype = 0 ; Cp [0] = 0 ; Cp [1] = lnz ; /* numeric update if dk > 0, and with Lx=b change */ /* workspace: Flag (nrow), Head (nrow+1), W (nrow), Iwork (2*nrow) */ ok = CHOLMOD(updown_mark) (do_update ? (1) : (0), C, colmark, L, X, DeltaB, Common) ; /* clear workspace */ for (kk = 0 ; kk < lnz ; kk++) { Cx [kk] = 0 ; } } Common->modfl += fl ; if (do_solve) { /* kth equation becomes identity, so X(k) is now Y(k) */ Xx [k] = yk [0] ; } DEBUG (CHOLMOD(dump_factor) (L, "LDL factorization, L:", Common)) ; ASSERT (CHOLMOD(dump_work) (TRUE, TRUE, 2*n, Common)) ; return (ok) ; }
static cholmod_sparse *band /* returns C, or NULL if failure */ ( /* ---- input or in/out if inplace is TRUE --- */ cholmod_sparse *A, /* ---- input ---- */ long k1, /* ignore entries below the k1-st diagonal */ long k2, /* ignore entries above the k2-nd diagonal */ int mode, /* >0: numerical, 0: pattern, <0: pattern (no diagonal) */ int inplace, /* if TRUE, then convert A in place */ /* --------------- */ cholmod_common *Common ) { double *Ax, *Cx ; Int packed, nz, j, p, pend, i, ncol, nrow, jlo, jhi, ilo, ihi, sorted, values, diag ; Int *Ap, *Anz, *Ai, *Cp, *Ci ; cholmod_sparse *C ; /* ---------------------------------------------------------------------- */ /* check inputs */ /* ---------------------------------------------------------------------- */ RETURN_IF_NULL_COMMON (NULL) ; RETURN_IF_NULL (A, NULL) ; values = (mode > 0) && (A->xtype != CHOLMOD_PATTERN) ; RETURN_IF_XTYPE_INVALID (A, CHOLMOD_PATTERN, values ? CHOLMOD_REAL : CHOLMOD_ZOMPLEX, NULL) ; packed = A->packed ; diag = (mode >= 0) ; if (inplace && !packed) { /* cannot operate on an unpacked matrix in place */ ERROR (CHOLMOD_INVALID, "cannot operate on unpacked matrix in-place") ; return (NULL) ; } Common->status = CHOLMOD_OK ; /* ---------------------------------------------------------------------- */ /* get inputs */ /* ---------------------------------------------------------------------- */ PRINT1 (("k1 %ld k2 %ld\n", k1, k2)) ; Ap = A->p ; Anz = A->nz ; Ai = A->i ; Ax = A->x ; sorted = A->sorted ; if (A->stype > 0) { /* ignore any entries in strictly lower triangular part of A */ k1 = MAX (k1, 0) ; } if (A->stype < 0) { /* ignore any entries in strictly upper triangular part of A */ k2 = MIN (k2, 0) ; } ncol = A->ncol ; nrow = A->nrow ; /* ensure k1 and k2 are in the range -nrow to +ncol to * avoid possible integer overflow if k1 and k2 are huge */ k1 = MAX (-nrow, k1) ; k1 = MIN (k1, ncol) ; k2 = MAX (-nrow, k2) ; k2 = MIN (k2, ncol) ; /* consider columns jlo to jhi. columns outside this range are empty */ jlo = MAX (k1, 0) ; jhi = MIN (k2+nrow, ncol) ; if (k1 > k2) { /* nothing to do */ jlo = ncol ; jhi = ncol ; } /* ---------------------------------------------------------------------- */ /* allocate C, or operate on A in place */ /* ---------------------------------------------------------------------- */ if (inplace) { /* convert A in place */ C = A ; } else { /* count the number of entries in the result C */ nz = 0 ; if (sorted) { for (j = jlo ; j < jhi ; j++) { ilo = j-k2 ; ihi = j-k1 ; p = Ap [j] ; pend = (packed) ? (Ap [j+1]) : (p + Anz [j]) ; for ( ; p < pend ; p++) { i = Ai [p] ; if (i > ihi) { break ; } if (i >= ilo && (diag || i != j)) { nz++ ; } } } } else { for (j = jlo ; j < jhi ; j++) { ilo = j-k2 ; ihi = j-k1 ; p = Ap [j] ; pend = (packed) ? (Ap [j+1]) : (p + Anz [j]) ; for ( ; p < pend ; p++) { i = Ai [p] ; if (i >= ilo && i <= ihi && (diag || i != j)) { nz++ ; } } } } /* allocate C; A will not be modified. C is sorted if A is sorted */ C = CHOLMOD(allocate_sparse) (A->nrow, ncol, nz, sorted, TRUE, A->stype, values ? A->xtype : CHOLMOD_PATTERN, Common) ; if (Common->status < CHOLMOD_OK) { return (NULL) ; /* out of memory */ } } Cp = C->p ; Ci = C->i ; Cx = C->x ; /* ---------------------------------------------------------------------- */ /* construct C */ /* ---------------------------------------------------------------------- */ /* columns 0 to jlo-1 are empty */ for (j = 0 ; j < jlo ; j++) { Cp [j] = 0 ; } nz = 0 ; if (sorted) { if (values) { /* pattern and values */ ASSERT (diag) ; for (j = jlo ; j < jhi ; j++) { ilo = j-k2 ; ihi = j-k1 ; p = Ap [j] ; pend = (packed) ? (Ap [j+1]) : (p + Anz [j]) ; Cp [j] = nz ; for ( ; p < pend ; p++) { i = Ai [p] ; if (i > ihi) { break ; } if (i >= ilo) { Ci [nz] = i ; Cx [nz] = Ax [p] ; nz++ ; } } } } else { /* pattern only, perhaps with no diagonal */ for (j = jlo ; j < jhi ; j++) { ilo = j-k2 ; ihi = j-k1 ; p = Ap [j] ; pend = (packed) ? (Ap [j+1]) : (p + Anz [j]) ; Cp [j] = nz ; for ( ; p < pend ; p++) { i = Ai [p] ; if (i > ihi) { break ; } if (i >= ilo && (diag || i != j)) { Ci [nz++] = i ; } } } } } else { if (values) { /* pattern and values */ ASSERT (diag) ; for (j = jlo ; j < jhi ; j++) { ilo = j-k2 ; ihi = j-k1 ; p = Ap [j] ; pend = (packed) ? (Ap [j+1]) : (p + Anz [j]) ; Cp [j] = nz ; for ( ; p < pend ; p++) { i = Ai [p] ; if (i >= ilo && i <= ihi) { Ci [nz] = i ; Cx [nz] = Ax [p] ; nz++ ; } } } } else { /* pattern only, perhaps with no diagonal */ for (j = jlo ; j < jhi ; j++) { ilo = j-k2 ; ihi = j-k1 ; p = Ap [j] ; pend = (packed) ? (Ap [j+1]) : (p + Anz [j]) ; Cp [j] = nz ; for ( ; p < pend ; p++) { i = Ai [p] ; if (i >= ilo && i <= ihi && (diag || i != j)) { Ci [nz++] = i ; } } } } } /* columns jhi to ncol-1 are empty */ for (j = jhi ; j <= ncol ; j++) { Cp [j] = nz ; } /* ---------------------------------------------------------------------- */ /* reduce A in size if done in place */ /* ---------------------------------------------------------------------- */ if (inplace) { /* free the unused parts of A, and reduce A->i and A->x in size */ ASSERT (MAX (1,nz) <= A->nzmax) ; CHOLMOD(reallocate_sparse) (nz, A, Common) ; ASSERT (Common->status >= CHOLMOD_OK) ; } /* ---------------------------------------------------------------------- */ /* return the result C */ /* ---------------------------------------------------------------------- */ DEBUG (i = CHOLMOD(dump_sparse) (C, "band", Common)) ; ASSERT (IMPLIES (mode < 0, i == 0)) ; return (C) ; }
UF_long CHOLMOD(metis_bisector) /* returns separator size */ ( /* ---- input ---- */ cholmod_sparse *A, /* matrix to bisect */ Int *Anw, /* size A->nrow, node weights */ Int *Aew, /* size nz, edge weights */ /* ---- output --- */ Int *Partition, /* size A->nrow */ /* --------------- */ cholmod_common *Common ) { Int *Ap, *Ai ; idxtype *Mp, *Mi, *Mnw, *Mew, *Mpart ; Int n, nleft, nright, j, p, csep, total_weight, lightest, nz ; int Opt [8], nn, csp ; size_t n1 ; DEBUG (Int nsep) ; /* ---------------------------------------------------------------------- */ /* check inputs */ /* ---------------------------------------------------------------------- */ RETURN_IF_NULL_COMMON (EMPTY) ; RETURN_IF_NULL (A, EMPTY) ; RETURN_IF_NULL (Anw, EMPTY) ; RETURN_IF_NULL (Aew, EMPTY) ; RETURN_IF_NULL (Partition, EMPTY) ; RETURN_IF_XTYPE_INVALID (A, CHOLMOD_PATTERN, CHOLMOD_ZOMPLEX, EMPTY) ; if (A->stype || A->nrow != A->ncol) { /* A must be square, with both upper and lower parts present */ ERROR (CHOLMOD_INVALID, "matrix must be square, symmetric," " and with both upper/lower parts present") ; return (EMPTY) ; } Common->status = CHOLMOD_OK ; /* ---------------------------------------------------------------------- */ /* quick return */ /* ---------------------------------------------------------------------- */ n = A->nrow ; if (n == 0) { return (0) ; } n1 = ((size_t) n) + 1 ; /* ---------------------------------------------------------------------- */ /* get inputs */ /* ---------------------------------------------------------------------- */ Ap = A->p ; Ai = A->i ; nz = Ap [n] ; /* ---------------------------------------------------------------------- */ /* METIS does not have a 64-bit integer version */ /* ---------------------------------------------------------------------- */ #ifdef LONG if (sizeof (Int) > sizeof (idxtype) && MAX (n,nz) > INT_MAX / sizeof (int)) { /* CHOLMOD's matrix is too large for METIS */ return (EMPTY) ; } #endif /* ---------------------------------------------------------------------- */ /* set default options */ /* ---------------------------------------------------------------------- */ Opt [0] = 0 ; /* use defaults */ Opt [1] = 3 ; /* matching type */ Opt [2] = 1 ; /* init. partitioning algo*/ Opt [3] = 2 ; /* refinement algorithm */ Opt [4] = 0 ; /* no debug */ Opt [5] = 0 ; /* unused */ Opt [6] = 0 ; /* unused */ Opt [7] = -1 ; /* random seed */ DEBUG (for (j = 0 ; j < n ; j++) ASSERT (Anw [j] > 0)) ; /* ---------------------------------------------------------------------- */ /* copy Int to METIS idxtype, if necessary */ /* ---------------------------------------------------------------------- */ DEBUG (for (j = 0 ; j < nz ; j++) ASSERT (Aew [j] > 0)) ; if (sizeof (Int) == sizeof (idxtype)) { /* this is the typical case */ Mi = (idxtype *) Ai ; Mew = (idxtype *) Aew ; Mp = (idxtype *) Ap ; Mnw = (idxtype *) Anw ; Mpart = (idxtype *) Partition ; } else { /* idxtype and Int differ; copy the graph into the METIS idxtype */ Mi = CHOLMOD(malloc) (nz, sizeof (idxtype), Common) ; Mew = CHOLMOD(malloc) (nz, sizeof (idxtype), Common) ; Mp = CHOLMOD(malloc) (n1, sizeof (idxtype), Common) ; Mnw = CHOLMOD(malloc) (n, sizeof (idxtype), Common) ; Mpart = CHOLMOD(malloc) (n, sizeof (idxtype), Common) ; if (Common->status < CHOLMOD_OK) { CHOLMOD(free) (nz, sizeof (idxtype), Mi, Common) ; CHOLMOD(free) (nz, sizeof (idxtype), Mew, Common) ; CHOLMOD(free) (n1, sizeof (idxtype), Mp, Common) ; CHOLMOD(free) (n, sizeof (idxtype), Mnw, Common) ; CHOLMOD(free) (n, sizeof (idxtype), Mpart, Common) ; return (EMPTY) ; } for (p = 0 ; p < nz ; p++) { Mi [p] = Ai [p] ; } for (p = 0 ; p < nz ; p++) { Mew [p] = Aew [p] ; } for (j = 0 ; j <= n ; j++) { Mp [j] = Ap [j] ; } for (j = 0 ; j < n ; j++) { Mnw [j] = Anw [j] ; } } /* ---------------------------------------------------------------------- */ /* METIS workaround: try to ensure METIS doesn't run out of memory */ /* ---------------------------------------------------------------------- */ if (!metis_memory_ok (n, nz, Common)) { /* METIS might ask for too much memory and thus terminate the program */ if (sizeof (Int) != sizeof (idxtype)) { CHOLMOD(free) (nz, sizeof (idxtype), Mi, Common) ; CHOLMOD(free) (nz, sizeof (idxtype), Mew, Common) ; CHOLMOD(free) (n1, sizeof (idxtype), Mp, Common) ; CHOLMOD(free) (n, sizeof (idxtype), Mnw, Common) ; CHOLMOD(free) (n, sizeof (idxtype), Mpart, Common) ; } return (EMPTY) ; } /* ---------------------------------------------------------------------- */ /* partition the graph */ /* ---------------------------------------------------------------------- */ #ifndef NDEBUG PRINT1 (("Metis graph, n = "ID"\n", n)) ; for (j = 0 ; j < n ; j++) { Int ppp ; PRINT2 (("M(:,"ID") node weight "ID"\n", j, (Int) Mnw [j])) ; ASSERT (Mnw [j] > 0) ; for (ppp = Mp [j] ; ppp < Mp [j+1] ; ppp++) { PRINT3 ((" "ID" : "ID"\n", (Int) Mi [ppp], (Int) Mew [ppp])) ; ASSERT (Mi [ppp] != j) ; ASSERT (Mew [ppp] > 0) ; } } #endif nn = n ; METIS_NodeComputeSeparator (&nn, Mp, Mi, Mnw, Mew, Opt, &csp, Mpart) ; n = nn ; csep = csp ; PRINT1 (("METIS csep "ID"\n", csep)) ; /* ---------------------------------------------------------------------- */ /* copy the results back from idxtype, if required */ /* ---------------------------------------------------------------------- */ if (sizeof (Int) != sizeof (idxtype)) { for (j = 0 ; j < n ; j++) { Partition [j] = Mpart [j] ; } CHOLMOD(free) (nz, sizeof (idxtype), Mi, Common) ; CHOLMOD(free) (nz, sizeof (idxtype), Mew, Common) ; CHOLMOD(free) (n1, sizeof (idxtype), Mp, Common) ; CHOLMOD(free) (n, sizeof (idxtype), Mnw, Common) ; CHOLMOD(free) (n, sizeof (idxtype), Mpart, Common) ; } /* ---------------------------------------------------------------------- */ /* ensure a reasonable separator */ /* ---------------------------------------------------------------------- */ /* METIS can return a valid separator with no nodes in (for example) the * left part. In this case, there really is no separator. CHOLMOD * prefers, in this case, for all nodes to be in the separator (and both * left and right parts to be empty). Also, if the graph is unconnected, * METIS can return a valid empty separator. CHOLMOD prefers at least one * node in the separator. Note that cholmod_nested_dissection only calls * this routine on connected components, but cholmod_bisect can call this * routine for any graph. */ if (csep == 0) { /* The separator is empty, select lightest node as separator. If * ties, select the highest numbered node. */ lightest = 0 ; for (j = 0 ; j < n ; j++) { if (Anw [j] <= Anw [lightest]) { lightest = j ; } } PRINT1 (("Force "ID" as sep\n", lightest)) ; Partition [lightest] = 2 ; csep = Anw [lightest] ; } /* determine the node weights in the left and right part of the graph */ nleft = 0 ; nright = 0 ; DEBUG (nsep = 0) ; for (j = 0 ; j < n ; j++) { PRINT1 (("Partition ["ID"] = "ID"\n", j, Partition [j])) ; if (Partition [j] == 0) { nleft += Anw [j] ; } else if (Partition [j] == 1) { nright += Anw [j] ; } #ifndef NDEBUG else { ASSERT (Partition [j] == 2) ; nsep += Anw [j] ; } #endif } ASSERT (csep == nsep) ; total_weight = nleft + nright + csep ; if (csep < total_weight) { /* The separator is less than the whole graph. Make sure the left and * right parts are either both empty or both non-empty. */ PRINT1 (("nleft "ID" nright "ID" csep "ID" tot "ID"\n", nleft, nright, csep, total_weight)) ; ASSERT (nleft + nright + csep == total_weight) ; ASSERT (nleft > 0 || nright > 0) ; if ((nleft == 0 && nright > 0) || (nleft > 0 && nright == 0)) { /* left or right is empty; put all nodes in the separator */ PRINT1 (("Force all in sep\n")) ; csep = total_weight ; for (j = 0 ; j < n ; j++) { Partition [j] = 2 ; } } } ASSERT (CHOLMOD(dump_partition) (n, Ap, Ai, Anw, Partition, csep, Common)) ; /* ---------------------------------------------------------------------- */ /* return the sum of the weights of nodes in the separator */ /* ---------------------------------------------------------------------- */ return (csep) ; }
void RenderingObject::UnregisterMaterialChanged(const Delegate<void(RenderableChangedFlags)>& val) { RETURN_IF_NULL(mMaterial); mMaterial->OnMaterialChanged -= val; }
int CHOLMOD(change_factor) ( /* ---- input ---- */ int to_xtype, /* convert to CHOLMOD_PATTERN, _REAL, _COMPLEX, or * _ZOMPLEX */ int to_ll, /* TRUE: convert to LL', FALSE: LDL' */ int to_super, /* TRUE: convert to supernodal, FALSE: simplicial */ int to_packed, /* TRUE: pack simplicial columns, FALSE: do not pack */ int to_monotonic, /* TRUE: put simplicial columns in order, FALSE: not */ /* ---- in/out --- */ cholmod_factor *L, /* factor to modify */ /* --------------- */ cholmod_common *Common ) { /* ---------------------------------------------------------------------- */ /* get inputs */ /* ---------------------------------------------------------------------- */ RETURN_IF_NULL_COMMON (FALSE) ; RETURN_IF_NULL (L, FALSE) ; RETURN_IF_XTYPE_INVALID (L, CHOLMOD_PATTERN, CHOLMOD_ZOMPLEX, FALSE) ; if (to_xtype < CHOLMOD_PATTERN || to_xtype > CHOLMOD_ZOMPLEX) { ERROR (CHOLMOD_INVALID, "xtype invalid") ; return (FALSE) ; } Common->status = CHOLMOD_OK ; PRINT1 (("-----convert from (%d,%d,%d,%d,%d) to (%d,%d,%d,%d,%d)\n", L->xtype, L->is_ll, L->is_super, L_is_packed (L, Common), L->is_monotonic, to_xtype, to_ll, to_super, to_packed, to_monotonic)) ; /* ensure all parameters are TRUE/FALSE */ to_ll = BOOLEAN (to_ll) ; to_super = BOOLEAN (to_super) ; ASSERT (BOOLEAN (L->is_ll) == L->is_ll) ; ASSERT (BOOLEAN (L->is_super) == L->is_super) ; if (to_super && to_xtype == CHOLMOD_ZOMPLEX) { ERROR (CHOLMOD_INVALID, "supernodal zomplex L not supported") ; return (FALSE) ; } /* ---------------------------------------------------------------------- */ /* convert */ /* ---------------------------------------------------------------------- */ if (to_xtype == CHOLMOD_PATTERN) { /* ------------------------------------------------------------------ */ /* convert to symbolic */ /* ------------------------------------------------------------------ */ if (!to_super) { /* -------------------------------------------------------------- */ /* convert any factor into a simplicial symbolic factor */ /* -------------------------------------------------------------- */ any_to_simplicial_symbolic (L, to_ll, Common) ; /* cannot fail */ } else { /* -------------------------------------------------------------- */ /* convert to a supernodal symbolic factor */ /* -------------------------------------------------------------- */ if (L->xtype != CHOLMOD_PATTERN && L->is_super) { /* convert from supernodal numeric to supernodal symbolic. * this preserves symbolic pattern of L, discards numeric * values */ ll_super_to_super_symbolic (L, Common) ; /* cannot fail */ } else if (L->xtype == CHOLMOD_PATTERN && !(L->is_super)) { /* convert from simplicial symbolic to supernodal symbolic. * contents of supernodal pattern are uninitialized. Not meant * for the end user. */ simplicial_symbolic_to_super_symbolic (L, Common) ; } else { /* cannot convert from simplicial numeric to supernodal * symbolic */ ERROR (CHOLMOD_INVALID, "cannot convert L to supernodal symbolic") ; } } } else { /* ------------------------------------------------------------------ */ /* convert to numeric */ /* ------------------------------------------------------------------ */ if (to_super) { /* -------------------------------------------------------------- */ /* convert to supernodal numeric factor */ /* -------------------------------------------------------------- */ if (L->xtype == CHOLMOD_PATTERN) { if (L->is_super) { /* Convert supernodal symbolic to supernodal numeric. * Contents of supernodal numeric values are uninitialized. * This is used by cholmod_super_numeric. Not meant for * the end user. */ super_symbolic_to_ll_super (to_xtype, L, Common) ; } else { /* Convert simplicial symbolic to supernodal numeric. * Contents not defined. This is used by * Core/cholmod_copy_factor only. Not meant for the end * user. */ if (!simplicial_symbolic_to_super_symbolic (L, Common)) { /* failure, convert back to simplicial symbolic */ any_to_simplicial_symbolic (L, to_ll, Common) ; } else { /* conversion to super symbolic OK, allocate numeric * part */ super_symbolic_to_ll_super (to_xtype, L, Common) ; } } } else { /* nothing to do if L is already in supernodal numeric form */ if (!(L->is_super)) { ERROR (CHOLMOD_INVALID, "cannot convert simplicial L to supernodal") ; } /* FUTURE WORK: convert to/from supernodal LL' and LDL' */ } } else { /* -------------------------------------------------------------- */ /* convert any factor to simplicial numeric */ /* -------------------------------------------------------------- */ if (L->xtype == CHOLMOD_PATTERN && !(L->is_super)) { /* ---------------------------------------------------------- */ /* convert simplicial symbolic to simplicial numeric (L=I,D=I)*/ /* ---------------------------------------------------------- */ simplicial_symbolic_to_simplicial_numeric (L, to_ll, to_packed, to_xtype, Common) ; } else if (L->xtype != CHOLMOD_PATTERN && L->is_super) { /* ---------------------------------------------------------- */ /* convert a supernodal LL' to simplicial numeric */ /* ---------------------------------------------------------- */ ll_super_to_simplicial_numeric (L, to_packed, to_ll, Common) ; } else if (L->xtype == CHOLMOD_PATTERN && L->is_super) { /* ---------------------------------------------------------- */ /* convert a supernodal symbolic to simplicial numeric (L=D=I)*/ /* ---------------------------------------------------------- */ any_to_simplicial_symbolic (L, to_ll, Common) ; /* if the following fails, it leaves the factor in simplicial * symbolic form */ simplicial_symbolic_to_simplicial_numeric (L, to_ll, to_packed, to_xtype, Common) ; } else { /* ---------------------------------------------------------- */ /* change a simplicial numeric factor */ /* ---------------------------------------------------------- */ /* change LL' to LDL', LDL' to LL', or leave as-is. pack the * columns of L, or leave as-is. Ensure the columns are * monotonic, or leave as-is. */ change_simplicial_numeric (L, to_ll, to_packed, to_monotonic, Common) ; } } } /* ---------------------------------------------------------------------- */ /* return result */ /* ---------------------------------------------------------------------- */ return (Common->status >= CHOLMOD_OK) ; }
void RenderingObject::RegisterMaterialChanged(const Delegate<void(RenderableChangedFlags)>& val) { RETURN_IF_NULL(mMesh); mMesh->OnMeshChanged += val; }
int DestroyView(HVIEW view) { RETURN_IF_NULL(view); return 1; }
cholmod_sparse *CHOLMOD(aat) ( /* ---- input ---- */ cholmod_sparse *A, /* input matrix; C=A*A' is constructed */ Int *fset, /* subset of 0:(A->ncol)-1 */ size_t fsize, /* size of fset */ int mode, /* >0: numerical, 0: pattern, <0: pattern (no diag) * -2: pattern only, no diagonal, add 50% + n extra * space to C */ /* --------------- */ cholmod_common *Common ) { double fjt ; double *Ax, *Fx, *Cx, *W ; Int *Ap, *Anz, *Ai, *Fp, *Fi, *Cp, *Ci, *Flag ; cholmod_sparse *C, *F ; Int packed, j, i, pa, paend, pf, pfend, n, mark, cnz, t, p, values, diag, extra ; /* ---------------------------------------------------------------------- */ /* check inputs */ /* ---------------------------------------------------------------------- */ RETURN_IF_NULL_COMMON (NULL) ; RETURN_IF_NULL (A, NULL) ; values = (mode > 0) && (A->xtype != CHOLMOD_PATTERN) ; RETURN_IF_XTYPE_INVALID (A, CHOLMOD_PATTERN, values ? CHOLMOD_REAL : CHOLMOD_ZOMPLEX, NULL) ; if (A->stype) { ERROR (CHOLMOD_INVALID, "matrix cannot be symmetric") ; return (NULL) ; } Common->status = CHOLMOD_OK ; /* ---------------------------------------------------------------------- */ /* allocate workspace */ /* ---------------------------------------------------------------------- */ diag = (mode >= 0) ; n = A->nrow ; CHOLMOD(allocate_work) (n, MAX (A->ncol, A->nrow), values ? n : 0, Common) ; if (Common->status < CHOLMOD_OK) { return (NULL) ; /* out of memory */ } ASSERT (CHOLMOD(dump_work) (TRUE, TRUE, values ? n : 0, Common)) ; /* ---------------------------------------------------------------------- */ /* get inputs */ /* ---------------------------------------------------------------------- */ ASSERT (CHOLMOD(dump_sparse) (A, "A", Common) >= 0) ; /* get the A matrix */ Ap = A->p ; Anz = A->nz ; Ai = A->i ; Ax = A->x ; packed = A->packed ; /* get workspace */ W = Common->Xwork ; /* size n, unused if values is FALSE */ Flag = Common->Flag ; /* size n, Flag [0..n-1] < mark on input*/ /* ---------------------------------------------------------------------- */ /* F = A' or A(:,f)' */ /* ---------------------------------------------------------------------- */ /* workspace: Iwork (nrow if no fset; MAX (nrow,ncol) if fset)*/ F = CHOLMOD(ptranspose) (A, values, NULL, fset, fsize, Common) ; if (Common->status < CHOLMOD_OK) { return (NULL) ; /* out of memory */ } Fp = F->p ; Fi = F->i ; Fx = F->x ; /* ---------------------------------------------------------------------- */ /* count the number of entries in the result C */ /* ---------------------------------------------------------------------- */ cnz = 0 ; for (j = 0 ; j < n ; j++) { /* clear the Flag array */ mark = CHOLMOD(clear_flag) (Common) ; /* exclude the diagonal, if requested */ if (!diag) { Flag [j] = mark ; } /* for each nonzero F(t,j) in column j, do: */ pfend = Fp [j+1] ; for (pf = Fp [j] ; pf < pfend ; pf++) { /* F(t,j) is nonzero */ t = Fi [pf] ; /* add the nonzero pattern of A(:,t) to the pattern of C(:,j) */ pa = Ap [t] ; paend = (packed) ? (Ap [t+1]) : (pa + Anz [t]) ; for ( ; pa < paend ; pa++) { i = Ai [pa] ; if (Flag [i] != mark) { Flag [i] = mark ; cnz++ ; } } } if (cnz < 0) { break ; /* integer overflow case */ } } extra = (mode == -2) ? (cnz/2 + n) : 0 ; mark = CHOLMOD(clear_flag) (Common) ; /* ---------------------------------------------------------------------- */ /* check for integer overflow */ /* ---------------------------------------------------------------------- */ if (cnz < 0 || (cnz + extra) < 0) { ERROR (CHOLMOD_TOO_LARGE, "problem too large") ; CHOLMOD(clear_flag) (Common) ; CHOLMOD(free_sparse) (&F, Common) ; return (NULL) ; /* problem too large */ } /* ---------------------------------------------------------------------- */ /* allocate C */ /* ---------------------------------------------------------------------- */ C = CHOLMOD(allocate_sparse) (n, n, cnz + extra, FALSE, TRUE, 0, values ? A->xtype : CHOLMOD_PATTERN, Common) ; if (Common->status < CHOLMOD_OK) { CHOLMOD(free_sparse) (&F, Common) ; return (NULL) ; /* out of memory */ } Cp = C->p ; Ci = C->i ; Cx = C->x ; /* ---------------------------------------------------------------------- */ /* C = A*A' */ /* ---------------------------------------------------------------------- */ cnz = 0 ; if (values) { /* pattern and values */ for (j = 0 ; j < n ; j++) { /* clear the Flag array */ mark = CHOLMOD(clear_flag) (Common) ; /* start column j of C */ Cp [j] = cnz ; /* for each nonzero F(t,j) in column j, do: */ pfend = Fp [j+1] ; for (pf = Fp [j] ; pf < pfend ; pf++) { /* F(t,j) is nonzero */ t = Fi [pf] ; fjt = Fx [pf] ; /* add the nonzero pattern of A(:,t) to the pattern of C(:,j) * and scatter the values into W */ pa = Ap [t] ; paend = (packed) ? (Ap [t+1]) : (pa + Anz [t]) ; for ( ; pa < paend ; pa++) { i = Ai [pa] ; if (Flag [i] != mark) { Flag [i] = mark ; Ci [cnz++] = i ; } W [i] += Ax [pa] * fjt ; } } /* gather the values into C(:,j) */ for (p = Cp [j] ; p < cnz ; p++) { i = Ci [p] ; Cx [p] = W [i] ; W [i] = 0 ; } } } else { /* pattern only */ for (j = 0 ; j < n ; j++) { /* clear the Flag array */ mark = CHOLMOD(clear_flag) (Common) ; /* exclude the diagonal, if requested */ if (!diag) { Flag [j] = mark ; } /* start column j of C */ Cp [j] = cnz ; /* for each nonzero F(t,j) in column j, do: */ pfend = Fp [j+1] ; for (pf = Fp [j] ; pf < pfend ; pf++) { /* F(t,j) is nonzero */ t = Fi [pf] ; /* add the nonzero pattern of A(:,t) to the pattern of C(:,j) */ pa = Ap [t] ; paend = (packed) ? (Ap [t+1]) : (pa + Anz [t]) ; for ( ; pa < paend ; pa++) { i = Ai [pa] ; if (Flag [i] != mark) { Flag [i] = mark ; Ci [cnz++] = i ; } } } } } Cp [n] = cnz ; ASSERT (IMPLIES (mode != -2, MAX (1,cnz) == C->nzmax)) ; /* ---------------------------------------------------------------------- */ /* clear workspace and free temporary matrices and return result */ /* ---------------------------------------------------------------------- */ CHOLMOD(free_sparse) (&F, Common) ; CHOLMOD(clear_flag) (Common) ; ASSERT (CHOLMOD(dump_work) (TRUE, TRUE, values ? n : 0, Common)) ; DEBUG (i = CHOLMOD(dump_sparse) (C, "aat", Common)) ; ASSERT (IMPLIES (mode < 0, i == 0)) ; return (C) ; }
int CHOLMOD(analyze_ordering) ( /* ---- input ---- */ cholmod_sparse *A, /* matrix to analyze */ int ordering, /* ordering method used */ Int *Perm, /* size n, fill-reducing permutation to analyze */ Int *fset, /* subset of 0:(A->ncol)-1 */ size_t fsize, /* size of fset */ /* ---- output --- */ Int *Parent, /* size n, elimination tree */ Int *Post, /* size n, postordering of elimination tree */ Int *ColCount, /* size n, nnz in each column of L */ /* ---- workspace */ Int *First, /* size n workspace for cholmod_postorder */ Int *Level, /* size n workspace for cholmod_postorder */ /* --------------- */ cholmod_common *Common ) { cholmod_sparse *A1, *A2, *S, *F ; Int n, ok, do_rowcolcounts ; /* check inputs */ RETURN_IF_NULL_COMMON (FALSE) ; RETURN_IF_NULL (A, FALSE) ; n = A->nrow ; do_rowcolcounts = (ColCount != NULL) ; /* permute A according to Perm and fset */ ok = permute_matrices (A, ordering, Perm, fset, fsize, do_rowcolcounts, &A1, &A2, &S, &F, Common) ; /* find etree of S (symmetric upper/lower case) or F (unsym case) */ /* workspace: symmmetric: Iwork (nrow), unsym: Iwork (nrow+ncol) */ ok = ok && CHOLMOD(etree) (A->stype ? S:F, Parent, Common) ; /* postorder the etree (required by cholmod_rowcolcounts) */ /* workspace: Iwork (2*nrow) */ ok = ok && (CHOLMOD(postorder) (Parent, n, NULL, Post, Common) == n) ; /* cholmod_postorder doesn't set Common->status if it returns < n */ Common->status = (!ok && Common->status == CHOLMOD_OK) ? CHOLMOD_INVALID : Common->status ; /* analyze LL'=S or SS' or S(:,f)*S(:,f)' */ /* workspace: * if symmetric: Flag (nrow), Iwork (2*nrow) * if unsymmetric: Flag (nrow), Iwork (2*nrow+ncol), Head (nrow+1) */ if (do_rowcolcounts) { ok = ok && CHOLMOD(rowcolcounts) (A->stype ? F:S, fset, fsize, Parent, Post, NULL, ColCount, First, Level, Common) ; } /* free temporary matrices and return result */ CHOLMOD(free_sparse) (&A1, Common) ; CHOLMOD(free_sparse) (&A2, Common) ; return (ok) ; }
cholmod_sparse *CHOLMOD(triplet_to_sparse) ( /* ---- input ---- */ cholmod_triplet *T, /* matrix to copy */ size_t nzmax, /* allocate at least this much space in output matrix */ /* --------------- */ cholmod_common *Common ) { cholmod_sparse *R, *A = NULL ; Int *Wj, *Rp, *Ri, *Rnz, *Ti, *Tj ; Int i, j, p, k, stype, nrow, ncol, nz, ok ; size_t anz = 0 ; /* ---------------------------------------------------------------------- */ /* check inputs */ /* ---------------------------------------------------------------------- */ RETURN_IF_NULL_COMMON (NULL) ; RETURN_IF_NULL (T, NULL) ; Ti = T->i ; Tj = T->j ; RETURN_IF_NULL (Ti, NULL) ; RETURN_IF_NULL (Tj, NULL) ; RETURN_IF_XTYPE_INVALID (T, CHOLMOD_PATTERN, CHOLMOD_ZOMPLEX, NULL) ; stype = SIGN (T->stype) ; if (stype && T->nrow != T->ncol) { /* inputs invalid */ ERROR (CHOLMOD_INVALID, "matrix invalid") ; return (NULL) ; } Common->status = CHOLMOD_OK ; DEBUG (CHOLMOD(dump_triplet) (T, "T", Common)) ; /* ---------------------------------------------------------------------- */ /* get inputs */ /* ---------------------------------------------------------------------- */ nrow = T->nrow ; ncol = T->ncol ; nz = T->nnz ; /* ---------------------------------------------------------------------- */ /* allocate workspace */ /* ---------------------------------------------------------------------- */ CHOLMOD(allocate_work) (0, MAX (nrow, ncol), 0, Common) ; if (Common->status < CHOLMOD_OK) { return (NULL) ; /* out of memory */ } /* ---------------------------------------------------------------------- */ /* allocate temporary matrix R */ /* ---------------------------------------------------------------------- */ R = CHOLMOD(allocate_sparse) (ncol, nrow, nz, FALSE, FALSE, -stype, T->xtype, Common) ; if (Common->status < CHOLMOD_OK) { return (NULL) ; /* out of memory */ } Rp = R->p ; Ri = R->i ; Rnz = R->nz ; /* ---------------------------------------------------------------------- */ /* count the entries in each row of A (also counting duplicates) */ /* ---------------------------------------------------------------------- */ for (i = 0 ; i < nrow ; i++) { Rnz [i] = 0 ; } if (stype > 0) { for (k = 0 ; k < nz ; k++) { i = Ti [k] ; j = Tj [k] ; if (i < 0 || i >= nrow || j < 0 || j >= ncol) { ERROR (CHOLMOD_INVALID, "index out of range") ; break ; } /* A will be symmetric with just the upper triangular part stored. * Create a matrix R that is lower triangular. Entries in the * upper part of R are transposed to the lower part. */ Rnz [MIN (i,j)]++ ; } } else if (stype < 0) { for (k = 0 ; k < nz ; k++) { i = Ti [k] ; j = Tj [k] ; if (i < 0 || i >= nrow || j < 0 || j >= ncol) { ERROR (CHOLMOD_INVALID, "index out of range") ; break ; } /* A will be symmetric with just the lower triangular part stored. * Create a matrix R that is upper triangular. Entries in the * lower part of R are transposed to the upper part. */ Rnz [MAX (i,j)]++ ; } } else { for (k = 0 ; k < nz ; k++) { i = Ti [k] ; j = Tj [k] ; if (i < 0 || i >= nrow || j < 0 || j >= ncol) { ERROR (CHOLMOD_INVALID, "index out of range") ; break ; } /* constructing an unsymmetric matrix */ Rnz [i]++ ; } } if (Common->status < CHOLMOD_OK) { /* triplet matrix is invalid */ CHOLMOD(free_sparse) (&R, Common) ; return (NULL) ; } /* ---------------------------------------------------------------------- */ /* construct the row pointers */ /* ---------------------------------------------------------------------- */ p = 0 ; for (i = 0 ; i < nrow ; i++) { Rp [i] = p ; p += Rnz [i] ; } Rp [nrow] = p ; /* use Wj (i/l/l) as temporary row pointers */ Wj = Common->Iwork ; /* size MAX (nrow,ncol) FUTURE WORK: (i/l/l) */ for (i = 0 ; i < nrow ; i++) { Wj [i] = Rp [i] ; } /* ---------------------------------------------------------------------- */ /* construct triplet matrix, using template routine */ /* ---------------------------------------------------------------------- */ switch (T->xtype) { case CHOLMOD_PATTERN: anz = p_cholmod_triplet_to_sparse (T, R, Common) ; break ; case CHOLMOD_REAL: anz = r_cholmod_triplet_to_sparse (T, R, Common) ; break ; case CHOLMOD_COMPLEX: anz = c_cholmod_triplet_to_sparse (T, R, Common) ; break ; case CHOLMOD_ZOMPLEX: anz = z_cholmod_triplet_to_sparse (T, R, Common) ; break ; } /* ---------------------------------------------------------------------- */ /* A = R' (array transpose, not complex conjugate transpose) */ /* ---------------------------------------------------------------------- */ /* workspace: Iwork (R->nrow), which is A->ncol */ ASSERT (CHOLMOD(dump_sparse) (R, "R", Common) >= 0) ; A = CHOLMOD(allocate_sparse) (nrow, ncol, MAX (anz, nzmax), TRUE, TRUE, stype, T->xtype, Common) ; if (stype) { ok = CHOLMOD(transpose_sym) (R, 1, NULL, A, Common) ; } else { ok = CHOLMOD(transpose_unsym) (R, 1, NULL, NULL, 0, A, Common) ; } CHOLMOD(free_sparse) (&R, Common) ; if (Common->status < CHOLMOD_OK) { CHOLMOD(free_sparse) (&A, Common) ; } /* ---------------------------------------------------------------------- */ /* return result */ /* ---------------------------------------------------------------------- */ ASSERT (CHOLMOD(dump_sparse) (A, "A = triplet(T) result", Common) >= 0) ; return (A) ; }
void OGLTR_DrawGlyphList(JNIEnv *env, OGLContext *oglc, OGLSDOps *dstOps, jint totalGlyphs, jboolean usePositions, jboolean subPixPos, jboolean rgbOrder, jint lcdContrast, jfloat glyphListOrigX, jfloat glyphListOrigY, unsigned char *images, unsigned char *positions) { int glyphCounter; J2dTraceLn(J2D_TRACE_INFO, "OGLTR_DrawGlyphList"); RETURN_IF_NULL(oglc); RETURN_IF_NULL(dstOps); RETURN_IF_NULL(images); if (usePositions) { RETURN_IF_NULL(positions); } glyphMode = MODE_NOT_INITED; isCachedDestValid = JNI_FALSE; for (glyphCounter = 0; glyphCounter < totalGlyphs; glyphCounter++) { jint x, y; jfloat glyphx, glyphy; jboolean grayscale, ok; GlyphInfo *ginfo = (GlyphInfo *)jlong_to_ptr(NEXT_LONG(images)); if (ginfo == NULL) { // this shouldn't happen, but if it does we'll just break out... J2dRlsTraceLn(J2D_TRACE_ERROR, "OGLTR_DrawGlyphList: glyph info is null"); break; } grayscale = (ginfo->rowBytes == ginfo->width); if (usePositions) { jfloat posx = NEXT_FLOAT(positions); jfloat posy = NEXT_FLOAT(positions); glyphx = glyphListOrigX + posx + ginfo->topLeftX; glyphy = glyphListOrigY + posy + ginfo->topLeftY; FLOOR_ASSIGN(x, glyphx); FLOOR_ASSIGN(y, glyphy); } else { glyphx = glyphListOrigX + ginfo->topLeftX; glyphy = glyphListOrigY + ginfo->topLeftY; FLOOR_ASSIGN(x, glyphx); FLOOR_ASSIGN(y, glyphy); glyphListOrigX += ginfo->advanceX; glyphListOrigY += ginfo->advanceY; } if (ginfo->image == NULL) { continue; } if (grayscale) { // grayscale or monochrome glyph data if (cacheStatus != CACHE_LCD && ginfo->width <= OGLTR_CACHE_CELL_WIDTH && ginfo->height <= OGLTR_CACHE_CELL_HEIGHT) { ok = OGLTR_DrawGrayscaleGlyphViaCache(oglc, ginfo, x, y); } else { ok = OGLTR_DrawGrayscaleGlyphNoCache(oglc, ginfo, x, y); } } else { // LCD-optimized glyph data jint rowBytesOffset = 0; if (subPixPos) { jint frac = (jint)((glyphx - x) * 3); if (frac != 0) { rowBytesOffset = 3 - frac; x += 1; } } if (rowBytesOffset == 0 && cacheStatus != CACHE_GRAY && ginfo->width <= OGLTR_CACHE_CELL_WIDTH && ginfo->height <= OGLTR_CACHE_CELL_HEIGHT) { ok = OGLTR_DrawLCDGlyphViaCache(oglc, dstOps, ginfo, x, y, glyphCounter, totalGlyphs, rgbOrder, lcdContrast); } else { ok = OGLTR_DrawLCDGlyphNoCache(oglc, dstOps, ginfo, x, y, rowBytesOffset, rgbOrder, lcdContrast); } } if (!ok) { break; } } OGLTR_DisableGlyphModeState(); }
int CHOLMOD(row_subtree) ( /* ---- input ---- */ cholmod_sparse *A, /* matrix to analyze */ cholmod_sparse *F, /* used for A*A' case only. F=A' or A(:,f)' */ size_t krow, /* row k of L */ Int *Parent, /* elimination tree */ /* ---- output --- */ cholmod_sparse *R, /* pattern of L(k,:), 1-by-n with R->nzmax >= n */ /* --------------- */ cholmod_common *Common ) { Int *Rp, *Stack, *Flag, *Ap, *Ai, *Anz, *Fp, *Fi, *Fnz ; Int p, pend, parent, t, stype, nrow, k, pf, pfend, Fpacked, packed, sorted, top, len, i, mark ; /* ---------------------------------------------------------------------- */ /* check inputs */ /* ---------------------------------------------------------------------- */ RETURN_IF_NULL_COMMON (FALSE) ; RETURN_IF_NULL (A, FALSE) ; RETURN_IF_NULL (R, FALSE) ; RETURN_IF_NULL (Parent, FALSE) ; RETURN_IF_XTYPE_INVALID (A, CHOLMOD_PATTERN, CHOLMOD_ZOMPLEX, FALSE) ; RETURN_IF_XTYPE_INVALID (R, CHOLMOD_PATTERN, CHOLMOD_ZOMPLEX, FALSE) ; stype = A->stype ; if (stype == 0) { RETURN_IF_NULL (F, FALSE) ; RETURN_IF_XTYPE_INVALID (F, CHOLMOD_PATTERN, CHOLMOD_ZOMPLEX, FALSE) ; } if (krow >= A->nrow) { ERROR (CHOLMOD_INVALID, "subtree: k invalid") ; return (FALSE) ; } if (R->ncol != 1 || A->nrow != R->nrow || A->nrow > R->nzmax) { ERROR (CHOLMOD_INVALID, "subtree: R invalid") ; return (FALSE) ; } Common->status = CHOLMOD_OK ; /* ---------------------------------------------------------------------- */ /* allocate workspace */ /* ---------------------------------------------------------------------- */ nrow = A->nrow ; CHOLMOD(allocate_work) (nrow, 0, 0, Common) ; if (Common->status < CHOLMOD_OK) { return (FALSE) ; } ASSERT (CHOLMOD(dump_work) (TRUE, TRUE, 0, Common)) ; /* ---------------------------------------------------------------------- */ /* get inputs */ /* ---------------------------------------------------------------------- */ if (stype > 0) { /* symmetric upper case: F is not needed. It may be NULL */ Fp = NULL ; Fi = NULL ; Fnz = NULL ; Fpacked = TRUE ; } else if (stype == 0) { /* unsymmetric case: F is required. */ Fp = F->p ; Fi = F->i ; Fnz = F->nz ; Fpacked = F->packed ; } else { /* symmetric lower triangular form not supported */ ERROR (CHOLMOD_INVALID, "symmetric lower not supported") ; return (FALSE) ; } Ap = A->p ; Ai = A->i ; Anz = A->nz ; packed = A->packed ; sorted = A->sorted ; k = krow ; Stack = R->i ; /* ---------------------------------------------------------------------- */ /* get workspace */ /* ---------------------------------------------------------------------- */ Flag = Common->Flag ; /* size nrow, Flag [i] < mark must hold */ /* mark = CHOLMOD(clear_flag) (Common) ; */ CHOLMOD_CLEAR_FLAG (Common) ; mark = Common->mark ; /* ---------------------------------------------------------------------- */ /* compute the pattern of L(k,:) */ /* ---------------------------------------------------------------------- */ top = nrow ; /* Stack is empty */ Flag [k] = mark ; /* do not include diagonal entry in Stack */ #define SCATTER /* do not scatter numerical values */ #define PARENT(i) Parent [i] /* use Parent for etree */ if (stype != 0) { /* scatter kth col of triu (A), get pattern L(k,:) */ p = Ap [k] ; pend = (packed) ? (Ap [k+1]) : (p + Anz [k]) ; SUBTREE ; } else { /* scatter kth col of triu (beta*I+AA'), get pattern L(k,:) */ pf = Fp [k] ; pfend = (Fpacked) ? (Fp [k+1]) : (pf + Fnz [k]) ; for ( ; pf < pfend ; pf++) { /* get nonzero entry F (t,k) */ t = Fi [pf] ; p = Ap [t] ; pend = (packed) ? (Ap [t+1]) : (p + Anz [t]) ; SUBTREE ; } } #undef SCATTER #undef PARENT /* shift the stack upwards, to the first part of R */ len = nrow - top ; for (i = 0 ; i < len ; i++) { Stack [i] = Stack [top + i] ; } Rp = R->p ; Rp [0] = 0 ; Rp [1] = len ; R->sorted = FALSE ; CHOLMOD(clear_flag) (Common) ; ASSERT (CHOLMOD(dump_work) (TRUE, TRUE, 0, Common)) ; return (TRUE) ; }