static KLU_symbolic *order_and_analyze /* returns NULL if error, or a valid KLU_symbolic object if successful */ ( /* inputs, not modified */ Int n, /* A is n-by-n */ Int Ap [ ], /* size n+1, column pointers */ Int Ai [ ], /* size nz, row indices */ /* --------------------- */ KLU_common *Common ) { double work ; KLU_symbolic *Symbolic ; double *Lnz ; Int *Qbtf, *Cp, *Ci, *Pinv, *Pblk, *Pbtf, *P, *Q, *R ; Int nblocks, nz, block, maxblock, k1, k2, nk, do_btf, ordering, k, Cilen, *Work ; /* ---------------------------------------------------------------------- */ /* allocate the Symbolic object, and check input matrix */ /* ---------------------------------------------------------------------- */ Symbolic = KLU_alloc_symbolic (n, Ap, Ai, Common) ; if (Symbolic == NULL) { return (NULL) ; } P = Symbolic->P ; Q = Symbolic->Q ; R = Symbolic->R ; Lnz = Symbolic->Lnz ; nz = Symbolic->nz ; ordering = Common->ordering ; if (ordering == 1) { /* COLAMD */ Cilen = COLAMD_recommended (nz, n, n) ; } else if (ordering == 0 || (ordering == 3 && Common->user_order != NULL)) { /* AMD or user ordering function */ Cilen = nz+1 ; } else { /* invalid ordering */ Common->status = KLU_INVALID ; KLU_free_symbolic (&Symbolic, Common) ; return (NULL) ; } /* AMD memory management routines */ amd_malloc = Common->malloc_memory ; amd_free = Common->free_memory ; amd_calloc = Common->calloc_memory ; amd_realloc = Common->realloc_memory ; /* ---------------------------------------------------------------------- */ /* allocate workspace for BTF permutation */ /* ---------------------------------------------------------------------- */ Pbtf = KLU_malloc (n, sizeof (Int), Common) ; Qbtf = KLU_malloc (n, sizeof (Int), Common) ; if (Common->status < KLU_OK) { KLU_free (Pbtf, n, sizeof (Int), Common) ; KLU_free (Qbtf, n, sizeof (Int), Common) ; KLU_free_symbolic (&Symbolic, Common) ; return (NULL) ; } /* ---------------------------------------------------------------------- */ /* get the common parameters for BTF and ordering method */ /* ---------------------------------------------------------------------- */ do_btf = Common->btf ; do_btf = (do_btf) ? TRUE : FALSE ; Symbolic->ordering = ordering ; Symbolic->do_btf = do_btf ; Symbolic->structural_rank = EMPTY ; /* ---------------------------------------------------------------------- */ /* find the block triangular form (if requested) */ /* ---------------------------------------------------------------------- */ Common->work = 0 ; if (do_btf) { Work = KLU_malloc (5*n, sizeof (Int), Common) ; if (Common->status < KLU_OK) { /* out of memory */ KLU_free (Pbtf, n, sizeof (Int), Common) ; KLU_free (Qbtf, n, sizeof (Int), Common) ; KLU_free_symbolic (&Symbolic, Common) ; return (NULL) ; } nblocks = BTF_order (n, Ap, Ai, Common->maxwork, &work, Pbtf, Qbtf, R, &(Symbolic->structural_rank), Work) ; Common->structural_rank = Symbolic->structural_rank ; Common->work += work ; KLU_free (Work, 5*n, sizeof (Int), Common) ; /* unflip Qbtf if the matrix does not have full structural rank */ if (Symbolic->structural_rank < n) { for (k = 0 ; k < n ; k++) { Qbtf [k] = BTF_UNFLIP (Qbtf [k]) ; } } /* find the size of the largest block */ maxblock = 1 ; for (block = 0 ; block < nblocks ; block++) { k1 = R [block] ; k2 = R [block+1] ; nk = k2 - k1 ; PRINTF (("block %d size %d\n", block, nk)) ; maxblock = MAX (maxblock, nk) ; } } else { /* BTF not requested */ nblocks = 1 ; maxblock = n ; R [0] = 0 ; R [1] = n ; for (k = 0 ; k < n ; k++) { Pbtf [k] = k ; Qbtf [k] = k ; } } Symbolic->nblocks = nblocks ; PRINTF (("maxblock size %d\n", maxblock)) ; Symbolic->maxblock = maxblock ; /* ---------------------------------------------------------------------- */ /* allocate more workspace, for analyze_worker */ /* ---------------------------------------------------------------------- */ Pblk = KLU_malloc (maxblock, sizeof (Int), Common) ; Cp = KLU_malloc (maxblock + 1, sizeof (Int), Common) ; Ci = KLU_malloc (MAX (Cilen, nz+1), sizeof (Int), Common) ; Pinv = KLU_malloc (n, sizeof (Int), Common) ; /* ---------------------------------------------------------------------- */ /* order each block of the BTF ordering, and a fill-reducing ordering */ /* ---------------------------------------------------------------------- */ if (Common->status == KLU_OK) { PRINTF (("calling analyze_worker\n")) ; Common->status = analyze_worker (n, Ap, Ai, nblocks, Pbtf, Qbtf, R, ordering, P, Q, Lnz, Pblk, Cp, Ci, Cilen, Pinv, Symbolic, Common) ; PRINTF (("analyze_worker done\n")) ; } /* ---------------------------------------------------------------------- */ /* free all workspace */ /* ---------------------------------------------------------------------- */ KLU_free (Pblk, maxblock, sizeof (Int), Common) ; KLU_free (Cp, maxblock+1, sizeof (Int), Common) ; KLU_free (Ci, MAX (Cilen, nz+1), sizeof (Int), Common) ; KLU_free (Pinv, n, sizeof (Int), Common) ; KLU_free (Pbtf, n, sizeof (Int), Common) ; KLU_free (Qbtf, n, sizeof (Int), Common) ; /* ---------------------------------------------------------------------- */ /* return the symbolic object */ /* ---------------------------------------------------------------------- */ if (Common->status < KLU_OK) { KLU_free_symbolic (&Symbolic, Common) ; } return (Symbolic) ; }
KLU_symbolic<Entry, Int> *KLU_analyze_given /* returns NULL if error, or a valid KLU_symbolic object if successful */ ( /* inputs, not modified */ Int n, /* A is n-by-n */ Int Ap [ ], /* size n+1, column pointers */ Int Ai [ ], /* size nz, row indices */ Int Puser [ ], /* size n, user's row permutation (may be NULL) */ Int Quser [ ], /* size n, user's column permutation (may be NULL) */ /* -------------------- */ KLU_common<Entry, Int> *Common ) { KLU_symbolic<Entry, Int> *Symbolic ; double *Lnz ; Int nblocks, nz, block, maxblock, *P, *Q, *R, nzoff, p, pend, do_btf, k ; /* ---------------------------------------------------------------------- */ /* determine if input matrix is valid, and get # of nonzeros */ /* ---------------------------------------------------------------------- */ Symbolic = KLU_alloc_symbolic (n, Ap, Ai, Common) ; if (Symbolic == NULL) { return (NULL) ; } P = Symbolic->P ; Q = Symbolic->Q ; R = Symbolic->R ; Lnz = Symbolic->Lnz ; nz = Symbolic->nz ; /* ---------------------------------------------------------------------- */ /* Q = Quser, or identity if Quser is NULL */ /* ---------------------------------------------------------------------- */ if (Quser == (Int *) NULL) { for (k = 0 ; k < n ; k++) { Q [k] = k ; } } else { for (k = 0 ; k < n ; k++) { Q [k] = Quser [k] ; } } /* ---------------------------------------------------------------------- */ /* get the control parameters for BTF and ordering method */ /* ---------------------------------------------------------------------- */ do_btf = Common->btf ; do_btf = (do_btf) ? TRUE : FALSE ; Symbolic->ordering = 2 ; Symbolic->do_btf = do_btf ; /* ---------------------------------------------------------------------- */ /* find the block triangular form, if requested */ /* ---------------------------------------------------------------------- */ if (do_btf) { /* ------------------------------------------------------------------ */ /* get workspace for BTF_strongcomp */ /* ------------------------------------------------------------------ */ Int *Pinv, *Work, *Bi, k1, k2, nk, oldcol ; Work = (Int *) KLU_malloc (4*n, sizeof (Int), Common) ; Pinv = (Int *) KLU_malloc (n, sizeof (Int), Common) ; if (Puser != (Int *) NULL) { Bi = (Int *) KLU_malloc (nz+1, sizeof (Int), Common) ; } else { Bi = Ai ; } if (Common->status < KLU_OK) { /* out of memory */ KLU_free (Work, 4*n, sizeof (Int), Common) ; KLU_free (Pinv, n, sizeof (Int), Common) ; if (Puser != (Int *) NULL) { KLU_free (Bi, nz+1, sizeof (Int), Common) ; } KLU_free_symbolic (&Symbolic, Common) ; Common->status = KLU_OUT_OF_MEMORY ; return (NULL) ; } /* ------------------------------------------------------------------ */ /* B = Puser * A */ /* ------------------------------------------------------------------ */ if (Puser != (Int *) NULL) { for (k = 0 ; k < n ; k++) { Pinv [Puser [k]] = k ; } for (p = 0 ; p < nz ; p++) { Bi [p] = Pinv [Ai [p]] ; } } /* ------------------------------------------------------------------ */ /* find the strongly-connected components */ /* ------------------------------------------------------------------ */ /* TODO : Correct version of BTF */ /* modifies Q, and determines P and R */ /*nblocks = BTF_strongcomp (n, Ap, Bi, Q, P, R, Work) ;*/ nblocks = KLU_OrdinalTraits<Int>::btf_strongcomp (n, Ap, Bi, Q, P, R, Work) ; /* ------------------------------------------------------------------ */ /* P = P * Puser */ /* ------------------------------------------------------------------ */ if (Puser != (Int *) NULL) { for (k = 0 ; k < n ; k++) { Work [k] = Puser [P [k]] ; } for (k = 0 ; k < n ; k++) { P [k] = Work [k] ; } } /* ------------------------------------------------------------------ */ /* Pinv = inverse of P */ /* ------------------------------------------------------------------ */ for (k = 0 ; k < n ; k++) { Pinv [P [k]] = k ; } /* ------------------------------------------------------------------ */ /* analyze each block */ /* ------------------------------------------------------------------ */ nzoff = 0 ; /* nz in off-diagonal part */ maxblock = 1 ; /* size of the largest block */ for (block = 0 ; block < nblocks ; block++) { /* -------------------------------------------------------------- */ /* the block is from rows/columns k1 to k2-1 */ /* -------------------------------------------------------------- */ k1 = R [block] ; k2 = R [block+1] ; nk = k2 - k1 ; PRINTF (("BLOCK %d, k1 %d k2-1 %d nk %d\n", block, k1, k2-1, nk)) ; maxblock = MAX (maxblock, nk) ; /* -------------------------------------------------------------- */ /* scan the kth block, C */ /* -------------------------------------------------------------- */ for (k = k1 ; k < k2 ; k++) { oldcol = Q [k] ; pend = Ap [oldcol+1] ; for (p = Ap [oldcol] ; p < pend ; p++) { if (Pinv [Ai [p]] < k1) { nzoff++ ; } } } /* fill-in not estimated */ Lnz [block] = EMPTY ; } /* ------------------------------------------------------------------ */ /* free all workspace */ /* ------------------------------------------------------------------ */ KLU_free (Work, 4*n, sizeof (Int), Common) ; KLU_free (Pinv, n, sizeof (Int), Common) ; if (Puser != (Int *) NULL) { KLU_free (Bi, nz+1, sizeof (Int), Common) ; } } else { /* ------------------------------------------------------------------ */ /* BTF not requested */ /* ------------------------------------------------------------------ */ nzoff = 0 ; nblocks = 1 ; maxblock = n ; R [0] = 0 ; R [1] = n ; Lnz [0] = EMPTY ; /* ------------------------------------------------------------------ */ /* P = Puser, or identity if Puser is NULL */ /* ------------------------------------------------------------------ */ for (k = 0 ; k < n ; k++) { P [k] = (Puser == NULL) ? k : Puser [k] ; } } /* ---------------------------------------------------------------------- */ /* return the symbolic object */ /* ---------------------------------------------------------------------- */ Symbolic->nblocks = nblocks ; Symbolic->maxblock = maxblock ; Symbolic->lnz = EMPTY ; Symbolic->unz = EMPTY ; Symbolic->nzoff = nzoff ; return (Symbolic) ; }