GLOBAL void UMF_garbage_collection ( NumericType *Numeric, WorkType *Work, Int drnew, /* compact current front to drnew-by-dcnew */ Int dcnew, Int do_Fcpos ) { /* ---------------------------------------------------------------------- */ /* local variables */ /* ---------------------------------------------------------------------- */ Int size, e, n_row, n_col, nrows, ncols, nrowsleft, ncolsleft, prevsize, csize, size2, i2, j2, i, j, cdeg, rdeg, *E, row, col, *Rows, *Cols, *Rows2, *Cols2, nel, e2, *Row_tuples, *Col_tuples, *Row_degree, *Col_degree ; Entry *C, *C1, *C3, *C2 ; Unit *psrc, *pdest, *p, *pnext ; Element *epsrc, *epdest ; #ifndef NDEBUG Int nmark ; #endif /* ---------------------------------------------------------------------- */ /* get parameters */ /* ---------------------------------------------------------------------- */ Col_degree = Numeric->Cperm ; /* for NON_PIVOTAL_COL macro */ Row_degree = Numeric->Rperm ; /* for NON_PIVOTAL_ROW macro */ Row_tuples = Numeric->Uip ; Col_tuples = Numeric->Lip ; E = Work->E ; n_row = Work->n_row ; n_col = Work->n_col ; /* note that the tuple lengths (Col_tlen and Row_tlen) are updated, but */ /* the tuple lists themselves are stale and are about to be destroyed */ /* and recreated. Do not attempt to scan them until they are recreated. */ #ifndef NDEBUG DEBUGm1 (("::::GARBAGE COLLECTION::::\n")) ; UMF_dump_memory (Numeric) ; #endif Numeric->ngarbage++ ; /* ---------------------------------------------------------------------- */ /* delete the tuple lists by marking the blocks as free */ /* ---------------------------------------------------------------------- */ /* do not modify Row_tlen and Col_tlen */ /* those are needed for UMF_build_tuples */ for (row = 0 ; row < n_row ; row++) { if (NON_PIVOTAL_ROW (row) && Row_tuples [row]) { DEBUG2 (("row "ID" tuples "ID"\n", row, Row_tuples [row])) ; p = Numeric->Memory + Row_tuples [row] - 1 ; DEBUG2 (("Freeing tuple list row "ID", p-S "ID", size "ID"\n", row, (Int) (p-Numeric->Memory), p->header.size)) ; ASSERT (p->header.size > 0) ; ASSERT (p >= Numeric->Memory + Numeric->itail) ; ASSERT (p < Numeric->Memory + Numeric->size) ; p->header.size = -p->header.size ; Row_tuples [row] = 0 ; } } for (col = 0 ; col < n_col ; col++) { if (NON_PIVOTAL_COL (col) && Col_tuples [col]) { DEBUG2 (("col "ID" tuples "ID"\n", col, Col_tuples [col])) ; p = Numeric->Memory + Col_tuples [col] - 1 ; DEBUG2 (("Freeing tuple list col "ID", p-S "ID", size "ID"\n", col, (Int) (p-Numeric->Memory), p->header.size)) ; ASSERT (p->header.size > 0) ; ASSERT (p >= Numeric->Memory + Numeric->itail) ; ASSERT (p < Numeric->Memory + Numeric->size) ; p->header.size = -p->header.size ; Col_tuples [col] = 0 ; } } /* ---------------------------------------------------------------------- */ /* mark the elements, and compress the name space */ /* ---------------------------------------------------------------------- */ nel = Work->nel ; ASSERT (nel < Work->elen) ; #ifndef NDEBUG nmark = 0 ; UMF_dump_current_front (Numeric, Work, FALSE) ; DEBUGm1 (("E [0] "ID" \n", E [0])) ; ASSERT (IMPLIES (E [0], Work->Flublock == (Entry *) (Numeric->Memory + E [0]))) ; ASSERT (IMPLIES (Work->Flublock, Work->Flublock == (Entry *) (Numeric->Memory + E [0]))) ; ASSERT ((E [0] != 0) == (Work->Flublock != (Entry *) NULL)) ; #endif e2 = 0 ; for (e = 0 ; e <= nel ; e++) /* for all elements in order of creation */ { if (E [e]) { psrc = Numeric->Memory + E [e] ; psrc-- ; /* get the header of this block */ if (e > 0) { e2++ ; /* do not renumber element zero */ } ASSERT (psrc->header.size > 0) ; psrc->header.size = e2 ; /* store the new name in the header */ #ifndef NDEBUG nmark++ ; #endif DEBUG7 ((ID":: Mark e "ID" at psrc-S "ID", new e "ID"\n", nmark, e, (Int) (psrc-Numeric->Memory), e2)) ; E [e] = 0 ; if (e == Work->prior_element) { Work->prior_element = e2 ; } } } /* all 1..e2 are now in use (element zero may or may not be in use) */ Work->nel = e2 ; nel = Work->nel ; #ifndef NDEBUG for (e = 0 ; e < Work->elen ; e++) { ASSERT (!E [e]) ; } #endif /* ---------------------------------------------------------------------- */ /* compress the elements */ /* ---------------------------------------------------------------------- */ /* point to tail marker block of size 1 + header */ psrc = Numeric->Memory + Numeric->size - 2 ; pdest = psrc ; prevsize = psrc->header.prevsize ; DEBUG7 (("Starting the compression:\n")) ; while (prevsize > 0) { /* ------------------------------------------------------------------ */ /* move up to the next element above the current header, and */ /* get the element name and size */ /* (if it is an element, the name will be positive) */ /* ------------------------------------------------------------------ */ size = prevsize ; psrc -= (size + 1) ; e = psrc->header.size ; prevsize = psrc->header.prevsize ; /* top block at tail has prevsize of 0 */ /* a free block will have a negative size, so skip it */ /* otherwise, if size >= 0, it holds the element name, not the size */ DEBUG8 (("psrc-S: "ID" prevsize: "ID" size: "ID, (Int) (psrc-Numeric->Memory), prevsize, size)) ; if (e == 0) { /* -------------------------------------------------------------- */ /* this is the current frontal matrix */ /* -------------------------------------------------------------- */ Entry *F1, *F2, *Fsrc, *Fdst ; Int c, r, k, dr, dc, gap, gap1, gap2, nb ; /* shift the frontal matrix down */ F1 = (Entry *) (psrc + 1) ; /* get the size of the current front. r and c could be zero */ k = Work->fnpiv ; dr = Work->fnr_curr ; dc = Work->fnc_curr ; r = Work->fnrows ; c = Work->fncols ; nb = Work->nb ; ASSERT ((dr >= 0 && (dr % 2) == 1) || dr == 0) ; ASSERT (drnew >= 0) ; if (drnew % 2 == 0) { /* make sure leading frontal matrix dimension is always odd */ drnew++ ; } drnew = MIN (dr, drnew) ; ASSERT ((drnew >= 0 && (drnew % 2) == 1) || drnew == 0) ; pnext = pdest ; #ifndef NDEBUG DEBUGm2 (("move front: dr "ID" dc "ID" r "ID" drnew "ID" c "ID " dcnew " ID" k "ID"\n", dr, dc, r, drnew, c, dcnew, k)) ; DEBUG7 (("\n")) ; DEBUG7 ((ID":: Move current frontal matrix from: psrc-S: "ID" \n", nmark, (Int) (psrc-Numeric->Memory))) ; nmark-- ; ASSERT (E [e] == 0) ; ASSERT (Work->Flublock == F1) ; ASSERT (Work->Flblock == Work->Flublock + nb*nb) ; ASSERT (Work->Fublock == Work->Flblock + dr*nb) ; ASSERT (Work->Fcblock == Work->Fublock + nb*dc) ; DEBUG7 (("C block: ")) ; UMF_dump_dense (Work->Fcblock, dr, r, c) ; DEBUG7 (("L block: ")) ; UMF_dump_dense (Work->Flblock, dr, r, k); DEBUG7 (("U' block: ")) ; UMF_dump_dense (Work->Fublock, dc, c, k) ; DEBUG7 (("LU block: ")) ; UMF_dump_dense (Work->Flublock, nb, k, k) ; ASSERT (r <= drnew && c <= dcnew && drnew <= dr && dcnew <= dc) ; #endif /* compact frontal matrix to drnew-by-dcnew before moving it */ /* do not compact the LU block (nb-by-nb) */ /* compact the columns of L (from dr-by-nb to drnew-by-nb) */ Fsrc = Work->Flblock ; Fdst = Work->Flblock ; ASSERT (Fdst == F1 + nb*nb) ; gap1 = dr - r ; gap2 = drnew - r ; ASSERT (gap1 >= 0) ; for (j = 0 ; j < k ; j++) { for (i = 0 ; i < r ; i++) { *Fdst++ = *Fsrc++ ; } Fsrc += gap1 ; Fdst += gap2 ; } ASSERT (Fdst == F1 + nb*nb + drnew*k) ; Fdst += drnew * (nb - k) ; /* compact the rows of U (U' from dc-by-nb to dcnew-by-nb) */ Fsrc = Work->Fublock ; ASSERT (Fdst == F1 + nb*nb + drnew*nb) ; gap1 = dc - c ; gap2 = dcnew - c ; for (i = 0 ; i < k ; i++) { for (j = 0 ; j < c ; j++) { *Fdst++ = *Fsrc++ ; } Fsrc += gap1 ; Fdst += gap2 ; } ASSERT (Fdst == F1 + nb*nb + drnew*nb + dcnew*k) ; Fdst += dcnew * (nb - k) ; /* compact the columns of C (from dr-by-dc to drnew-by-dcnew) */ Fsrc = Work->Fcblock ; ASSERT (Fdst == F1 + nb*nb + drnew*nb + nb*dcnew) ; gap1 = dr - r ; gap2 = drnew - r ; for (j = 0 ; j < c ; j++) { for (i = 0 ; i < r ; i++) { *Fdst++ = *Fsrc++ ; } Fsrc += gap1 ; Fdst += gap2 ; } ASSERT (Fdst == F1 + nb*nb + drnew*nb + nb*dcnew + drnew*c) ; /* recompute Fcpos, if necessary */ if (do_Fcpos) { Int *Fcols, *Fcpos ; Fcols = Work->Fcols ; Fcpos = Work->Fcpos ; for (j = 0 ; j < c ; j++) { col = Fcols [j] ; ASSERT (col >= 0 && col < Work->n_col) ; ASSERT (Fcpos [col] == j * dr) ; Fcpos [col] = j * drnew ; } #ifndef NDEBUG { Int cnt = 0 ; for (j = 0 ; j < Work->n_col ; j++) { if (Fcpos [j] != EMPTY) cnt++ ; } DEBUGm2 (("Recompute Fcpos cnt "ID" c "ID"\n", cnt, c)) ; ASSERT (cnt == c) ; } #endif } #ifndef NDEBUG DEBUGm2 (("Compacted front, drnew "ID" dcnew "ID"\n", drnew, dcnew)) ; DEBUG7 (("C block: ")) ; UMF_dump_dense (F1 + nb*nb + drnew*nb + nb*dcnew, drnew, r, c) ; DEBUG7 (("L block: ")) ; UMF_dump_dense (F1 + nb*nb, drnew, r, k) ; DEBUG7 (("U block: ")) ; UMF_dump_dense (F1 + nb*nb + drnew*nb, nb, k, c) ; DEBUG7 (("LU block: ")) ; UMF_dump_dense (F1, nb, k, k) ; #endif /* Compacted dimensions of the new frontal matrix. */ Work->fnr_curr = drnew ; Work->fnc_curr = dcnew ; Work->fcurr_size = (drnew + nb) * (dcnew + nb) ; size = UNITS (Entry, Work->fcurr_size) ; /* make sure the object doesn't evaporate. The front can have * zero size (Work->fcurr_size = 0), but the size of the memory * block containing it cannot have zero size. */ size = MAX (1, size) ; /* get the destination of frontal matrix */ pnext->header.prevsize = size ; pdest -= (size + 1) ; F2 = (Entry *) (pdest + 1) ; ASSERT ((unsigned Int) psrc + 1 + size <= (unsigned Int) pnext) ; ASSERT (psrc <= pdest) ; ASSERT (F1 <= F2) ; /* move the C block first */ Fsrc = F1 + nb*nb + drnew*nb + nb*dcnew + drnew*c ; Fdst = F2 + nb*nb + drnew*nb + nb*dcnew + drnew*c ; gap = drnew - r ; for (j = c-1 ; j >= 0 ; j--) { Fsrc -= gap ; Fdst -= gap ; /* move column j of C */ for (i = r-1 ; i >= 0 ; i--) { *--Fdst = *--Fsrc ; } } ASSERT (Fsrc == F1 + nb*nb + drnew*nb + nb*dcnew) ; ASSERT (Fdst == F2 + nb*nb + drnew*nb + nb*dcnew) ; /* move the U block */ Fsrc -= dcnew * (nb - k) ; Fdst -= dcnew * (nb - k) ; ASSERT (Fsrc == F1 + nb*nb + drnew*nb + dcnew*k) ; ASSERT (Fdst == F2 + nb*nb + drnew*nb + dcnew*k) ; gap = dcnew - c ; for (i = k-1 ; i >= 0 ; i--) { Fsrc -= gap ; Fdst -= gap ; for (j = c-1 ; j >= 0 ; j--) { *--Fdst = *--Fsrc ; } } ASSERT (Fsrc == F1 + nb*nb + drnew*nb) ; ASSERT (Fdst == F2 + nb*nb + drnew*nb) ; /* move the L block */ Fsrc -= drnew * (nb - k) ; Fdst -= drnew * (nb - k) ; ASSERT (Fsrc == F1 + nb*nb + drnew*k) ; ASSERT (Fdst == F2 + nb*nb + drnew*k) ; gap = drnew - r ; for (j = k-1 ; j >= 0 ; j--) { Fsrc -= gap ; Fdst -= gap ; for (i = r-1 ; i >= 0 ; i--) { *--Fdst = *--Fsrc ; } } ASSERT (Fsrc == F1 + nb*nb) ; ASSERT (Fdst == F2 + nb*nb) ; /* move the LU block */ Fsrc -= nb * (nb - k) ; Fdst -= nb * (nb - k) ; ASSERT (Fsrc == F1 + nb*k) ; ASSERT (Fdst == F2 + nb*k) ; gap = nb - k ; for (j = k-1 ; j >= 0 ; j--) { Fsrc -= gap ; Fdst -= gap ; for (i = k-1 ; i >= 0 ; i--) { *--Fdst = *--Fsrc ; } } ASSERT (Fsrc == F1) ; ASSERT (Fdst == F2) ; E [0] = (pdest + 1) - Numeric->Memory ; Work->Flublock = (Entry *) (Numeric->Memory + E [0]) ; ASSERT (Work->Flublock == F2) ; Work->Flblock = Work->Flublock + nb * nb ; Work->Fublock = Work->Flblock + drnew * nb ; Work->Fcblock = Work->Fublock + nb * dcnew ; pdest->header.prevsize = 0 ; pdest->header.size = size ; #ifndef NDEBUG DEBUG7 (("After moving compressed current frontal matrix:\n")) ; DEBUG7 (("C block: ")) ; UMF_dump_dense (Work->Fcblock, drnew, r, c) ; DEBUG7 (("L block: ")) ; UMF_dump_dense (Work->Flblock, drnew, r, k); DEBUG7 (("U' block: ")) ; UMF_dump_dense (Work->Fublock, dcnew, c, k) ; DEBUG7 (("LU block: ")) ; UMF_dump_dense (Work->Flublock, nb, k, k) ; #endif } else if (e > 0) { /* -------------------------------------------------------------- */ /* this is an element, compress and move from psrc down to pdest */ /* -------------------------------------------------------------- */ #ifndef NDEBUG DEBUG7 (("\n")) ; DEBUG7 ((ID":: Move element "ID": from: "ID" \n", nmark, e, (Int) (psrc-Numeric->Memory))) ; nmark-- ; ASSERT (e <= nel) ; ASSERT (E [e] == 0) ; #endif /* -------------------------------------------------------------- */ /* get the element scalars, and pointers to C, Rows, and Cols: */ /* -------------------------------------------------------------- */ p = psrc + 1 ; GET_ELEMENT (epsrc, p, Cols, Rows, ncols, nrows, C) ; nrowsleft = epsrc->nrowsleft ; ncolsleft = epsrc->ncolsleft ; cdeg = epsrc->cdeg ; rdeg = epsrc->rdeg ; #ifndef NDEBUG DEBUG7 ((" nrows "ID" nrowsleft "ID"\n", nrows, nrowsleft)) ; DEBUG7 ((" ncols "ID" ncolsleft "ID"\n", ncols, ncolsleft)) ; DEBUG8 ((" Rows:")) ; for (i = 0 ; i < nrows ; i++) DEBUG8 ((" "ID, Rows [i])) ; DEBUG8 (("\n Cols:")) ; for (j = 0 ; j < ncols ; j++) DEBUG8 ((" "ID, Cols [j])) ; DEBUG8 (("\n")) ; #endif /* -------------------------------------------------------------- */ /* determine the layout of the new element */ /* -------------------------------------------------------------- */ csize = nrowsleft * ncolsleft ; size2 = UNITS (Element, 1) + UNITS (Int, nrowsleft + ncolsleft) + UNITS (Entry, csize) ; DEBUG7 (("Old size "ID" New size "ID"\n", size, size2)) ; pnext = pdest ; pnext->header.prevsize = size2 ; pdest -= (size2 + 1) ; ASSERT (size2 <= size) ; ASSERT ((unsigned Int) psrc + 1 + size <= (unsigned Int) pnext) ; ASSERT (psrc <= pdest) ; p = pdest + 1 ; epdest = (Element *) p ; p += UNITS (Element, 1) ; Cols2 = (Int *) p ; Rows2 = Cols2 + ncolsleft ; p += UNITS (Int, nrowsleft + ncolsleft) ; C2 = (Entry *) p ; ASSERT (epdest >= epsrc) ; ASSERT (Rows2 >= Rows) ; ASSERT (Cols2 >= Cols) ; ASSERT (C2 >= C) ; ASSERT (p + UNITS (Entry, csize) == pnext) ; /* -------------------------------------------------------------- */ /* move the contribution block */ /* -------------------------------------------------------------- */ /* overlap = psrc + size + 1 > pdest ; */ if (nrowsleft < nrows || ncolsleft < ncols) { /* ---------------------------------------------------------- */ /* compress contribution block in place prior to moving it */ /* ---------------------------------------------------------- */ DEBUG7 (("Compress C in place prior to move:\n")); #ifndef NDEBUG UMF_dump_dense (C, nrows, nrows, ncols) ; #endif C1 = C ; C3 = C ; for (j = 0 ; j < ncols ; j++) { if (Cols [j] >= 0) { for (i = 0 ; i < nrows ; i++) { if (Rows [i] >= 0) { *C3++ = C1 [i] ; } } } C1 += nrows ; } ASSERT (C3-C == csize) ; DEBUG8 (("Newly compressed contrib. block (all in use):\n")) ; #ifndef NDEBUG UMF_dump_dense (C, nrowsleft, nrowsleft, ncolsleft) ; #endif } /* shift the contribution block down */ C += csize ; C2 += csize ; for (i = 0 ; i < csize ; i++) { *--C2 = *--C ; } /* -------------------------------------------------------------- */ /* move the row indices */ /* -------------------------------------------------------------- */ i2 = nrowsleft ; for (i = nrows - 1 ; i >= 0 ; i--) { ASSERT (Rows2+i2 >= Rows+i) ; if (Rows [i] >= 0) { Rows2 [--i2] = Rows [i] ; } } ASSERT (i2 == 0) ; j2 = ncolsleft ; for (j = ncols - 1 ; j >= 0 ; j--) { ASSERT (Cols2+j2 >= Cols+j) ; if (Cols [j] >= 0) { Cols2 [--j2] = Cols [j] ; } } ASSERT (j2 == 0) ; /* -------------------------------------------------------------- */ /* construct the new header */ /* -------------------------------------------------------------- */ /* E [0...e] is now valid */ E [e] = (pdest + 1) - Numeric->Memory ; epdest = (Element *) (pdest + 1) ; epdest->next = EMPTY ; /* destroys the son list */ epdest->ncols = ncolsleft ; epdest->nrows = nrowsleft ; epdest->ncolsleft = ncolsleft ; epdest->nrowsleft = nrowsleft ; epdest->rdeg = rdeg ; epdest->cdeg = cdeg ; ASSERT (size2 <= size) ; pdest->header.prevsize = 0 ; pdest->header.size = size2 ; DEBUG7 (("After moving it:\n")) ; #ifndef NDEBUG UMF_dump_element (Numeric, Work, e, FALSE) ; #endif } #ifndef NDEBUG else { DEBUG8 ((" free\n")) ; } #endif DEBUG7 (("psrc "ID" tail "ID"\n", (Int) (psrc-Numeric->Memory), Numeric->itail)) ; } ASSERT (psrc == Numeric->Memory + Numeric->itail) ; ASSERT (nmark == 0) ; /* ---------------------------------------------------------------------- */ /* final tail pointer */ /* ---------------------------------------------------------------------- */ ASSERT (pdest >= Numeric->Memory + Numeric->itail) ; Numeric->itail = pdest - Numeric->Memory ; pdest->header.prevsize = 0 ; Numeric->ibig = EMPTY ; Numeric->tail_usage = Numeric->size - Numeric->itail ; /* ---------------------------------------------------------------------- */ /* clear the unused E [nel+1 .. Work->elen - 1] */ /* ---------------------------------------------------------------------- */ for (e = nel+1 ; e < Work->elen ; e++) { E [e] = 0 ; } #ifndef NDEBUG UMF_dump_packed_memory (Numeric, Work) ; #endif DEBUG8 (("::::GARBAGE COLLECTION DONE::::\n")) ; }
GLOBAL Int UMF_store_lu_drop #else GLOBAL Int UMF_store_lu #endif ( NumericType *Numeric, WorkType *Work ) { /* ---------------------------------------------------------------------- */ /* local variables */ /* ---------------------------------------------------------------------- */ Entry pivot_value ; #ifdef DROP double droptol ; #endif Entry *D, *Lval, *Uval, *Fl1, *Fl2, *Fu1, *Fu2, *Flublock, *Flblock, *Fublock ; Int i, k, fnr_curr, fnrows, fncols, row, col, pivrow, pivcol, *Frows, *Fcols, *Lpattern, *Upattern, *Lpos, *Upos, llen, ulen, fnc_curr, fnpiv, uilen, lnz, unz, nb, *Lilen, *Uilen, *Lip, *Uip, *Li, *Ui, pivcol_position, newLchain, newUchain, pivrow_position, p, size, lip, uip, lnzi, lnzx, unzx, lnz2i, lnz2x, unz2i, unz2x, zero_pivot, *Pivrow, *Pivcol, kk, Lnz [MAXNB] ; #ifndef NDEBUG Int *Col_degree, *Row_degree ; #endif #ifdef DROP Int all_lnz, all_unz ; droptol = Numeric->droptol ; #endif /* ---------------------------------------------------------------------- */ /* get parameters */ /* ---------------------------------------------------------------------- */ fnrows = Work->fnrows ; fncols = Work->fncols ; fnpiv = Work->fnpiv ; Lpos = Numeric->Lpos ; Upos = Numeric->Upos ; Lilen = Numeric->Lilen ; Uilen = Numeric->Uilen ; Lip = Numeric->Lip ; Uip = Numeric->Uip ; D = Numeric->D ; Flublock = Work->Flublock ; Flblock = Work->Flblock ; Fublock = Work->Fublock ; fnr_curr = Work->fnr_curr ; fnc_curr = Work->fnc_curr ; Frows = Work->Frows ; Fcols = Work->Fcols ; #ifndef NDEBUG Col_degree = Numeric->Cperm ; /* for NON_PIVOTAL_COL macro */ Row_degree = Numeric->Rperm ; /* for NON_PIVOTAL_ROW macro */ #endif Lpattern = Work->Lpattern ; llen = Work->llen ; Upattern = Work->Upattern ; ulen = Work->ulen ; nb = Work->nb ; #ifndef NDEBUG DEBUG1 (("\nSTORE LU: fnrows "ID " fncols "ID"\n", fnrows, fncols)) ; DEBUG2 (("\nFrontal matrix, including all space:\n" "fnr_curr "ID" fnc_curr "ID" nb "ID"\n" "fnrows "ID" fncols "ID" fnpiv "ID"\n", fnr_curr, fnc_curr, nb, fnrows, fncols, fnpiv)) ; DEBUG2 (("\nJust the active part:\n")) ; DEBUG7 (("C block: ")) ; UMF_dump_dense (Work->Fcblock, fnr_curr, fnrows, fncols) ; DEBUG7 (("L block: ")) ; UMF_dump_dense (Work->Flblock, fnr_curr, fnrows, fnpiv); DEBUG7 (("U' block: ")) ; UMF_dump_dense (Work->Fublock, fnc_curr, fncols, fnpiv) ; DEBUG7 (("LU block: ")) ; UMF_dump_dense (Work->Flublock, nb, fnpiv, fnpiv) ; DEBUG7 (("Current frontal matrix: (prior to store LU)\n")) ; UMF_dump_current_front (Numeric, Work, TRUE) ; #endif Pivrow = Work->Pivrow ; Pivcol = Work->Pivcol ; /* ---------------------------------------------------------------------- */ /* store the columns of L */ /* ---------------------------------------------------------------------- */ for (kk = 0 ; kk < fnpiv ; kk++) { /* ------------------------------------------------------------------ */ /* one more pivot row and column is being stored into L and U */ /* ------------------------------------------------------------------ */ k = Work->npiv + kk ; /* ------------------------------------------------------------------ */ /* find the kth pivot row and pivot column */ /* ------------------------------------------------------------------ */ pivrow = Pivrow [kk] ; pivcol = Pivcol [kk] ; #ifndef NDEBUG ASSERT (pivrow >= 0 && pivrow < Work->n_row) ; ASSERT (pivcol >= 0 && pivcol < Work->n_col) ; DEBUGm4 (( "\n -------------------------------------------------------------" "Store LU: step " ID"\n", k)) ; ASSERT (k < MIN (Work->n_row, Work->n_col)) ; DEBUG2 (("Store column of L, k = "ID", llen "ID"\n", k, llen)) ; for (i = 0 ; i < llen ; i++) { row = Lpattern [i] ; ASSERT (row >= 0 && row < Work->n_row) ; DEBUG2 ((" Lpattern["ID"] "ID" Lpos "ID, i, row, Lpos [row])) ; if (row == pivrow) DEBUG2 ((" <- pivot row")) ; DEBUG2 (("\n")) ; ASSERT (i == Lpos [row]) ; } #endif /* ------------------------------------------------------------------ */ /* remove pivot row from L */ /* ------------------------------------------------------------------ */ /* remove pivot row index from current column of L */ /* if a new Lchain starts, then all entries are removed later */ DEBUG2 (("Removing pivrow from Lpattern, k = "ID"\n", k)) ; ASSERT (!NON_PIVOTAL_ROW (pivrow)) ; pivrow_position = Lpos [pivrow] ; if (pivrow_position != EMPTY) { /* place the last entry in the column in the */ /* position of the pivot row index */ ASSERT (pivrow == Lpattern [pivrow_position]) ; row = Lpattern [--llen] ; /* ASSERT (NON_PIVOTAL_ROW (row)) ; */ Lpattern [pivrow_position] = row ; Lpos [row] = pivrow_position ; Lpos [pivrow] = EMPTY ; } /* ------------------------------------------------------------------ */ /* store the pivot value, for the diagonal matrix D */ /* ------------------------------------------------------------------ */ /* kk-th column of LU block */ Fl1 = Flublock + kk * nb ; /* kk-th column of L in the L block */ Fl2 = Flblock + kk * fnr_curr ; /* kk-th pivot in frontal matrix located in Flublock [kk, kk] */ pivot_value = Fl1 [kk] ; D [k] = pivot_value ; zero_pivot = IS_ZERO (pivot_value) ; DEBUG4 (("Pivot D["ID"]=", k)) ; EDEBUG4 (pivot_value) ; DEBUG4 (("\n")) ; /* ------------------------------------------------------------------ */ /* count nonzeros in kth column of L */ /* ------------------------------------------------------------------ */ lnz = 0 ; lnz2i = 0 ; lnz2x = llen ; #ifdef DROP all_lnz = 0 ; for (i = kk + 1 ; i < fnpiv ; i++) { Entry x ; double s ; x = Fl1 [i] ; if (IS_ZERO (x)) continue ; all_lnz++ ; APPROX_ABS (s, x) ; if (s <= droptol) continue ; lnz++ ; if (Lpos [Pivrow [i]] == EMPTY) lnz2i++ ; } for (i = 0 ; i < fnrows ; i++) { Entry x ; double s ; x = Fl2 [i] ; if (IS_ZERO (x)) continue ; all_lnz++ ; APPROX_ABS (s, x) ; if (s <= droptol) continue ; lnz++ ; if (Lpos [Frows [i]] == EMPTY) lnz2i++ ; } #else for (i = kk + 1 ; i < fnpiv ; i++) { if (IS_ZERO (Fl1 [i])) continue ; lnz++ ; if (Lpos [Pivrow [i]] == EMPTY) lnz2i++ ; } for (i = 0 ; i < fnrows ; i++) { if (IS_ZERO (Fl2 [i])) continue ; lnz++ ; if (Lpos [Frows [i]] == EMPTY) lnz2i++ ; } #endif lnz2x += lnz2i ; /* determine if we start a new Lchain or continue the old one */ if (llen == 0 || zero_pivot) { /* llen == 0 means there is no prior Lchain */ /* D [k] == 0 means the pivot column is empty */ newLchain = TRUE ; } else { newLchain = /* storage for starting a new Lchain */ UNITS (Entry, lnz) + UNITS (Int, lnz) <= /* storage for continuing a prior Lchain */ UNITS (Entry, lnz2x) + UNITS (Int, lnz2i) ; } if (newLchain) { /* start a new chain for column k of L */ DEBUG2 (("Start new Lchain, k = "ID"\n", k)) ; pivrow_position = EMPTY ; /* clear the prior Lpattern */ for (i = 0 ; i < llen ; i++) { row = Lpattern [i] ; Lpos [row] = EMPTY ; } llen = 0 ; lnzi = lnz ; lnzx = lnz ; } else { /* continue the prior Lchain */ DEBUG2 (("Continue Lchain, k = "ID"\n", k)) ; lnzi = lnz2i ; lnzx = lnz2x ; } /* ------------------------------------------------------------------ */ /* allocate space for the column of L */ /* ------------------------------------------------------------------ */ size = UNITS (Int, lnzi) + UNITS (Entry, lnzx) ; #ifndef NDEBUG UMF_allocfail = FALSE ; if (UMF_gprob > 0) { double rrr = ((double) (rand ( ))) / (((double) RAND_MAX) + 1) ; DEBUG4 (("Check random %e %e\n", rrr, UMF_gprob)) ; UMF_allocfail = rrr < UMF_gprob ; if (UMF_allocfail) DEBUGm2 (("Random garbage coll. (store LU)\n")); } #endif p = UMF_mem_alloc_head_block (Numeric, size) ; if (!p) { Int r2, c2 ; /* Do garbage collection, realloc, and try again. */ /* Note that there are pivot rows/columns in current front. */ if (Work->do_grow) { /* full compaction of current frontal matrix, since * UMF_grow_front will be called next anyway. */ r2 = fnrows ; c2 = fncols ; } else { /* partial compaction. */ r2 = MAX (fnrows, Work->fnrows_new + 1) ; c2 = MAX (fncols, Work->fncols_new + 1) ; } DEBUGm3 (("get_memory from umf_store_lu:\n")) ; if (!UMF_get_memory (Numeric, Work, size, r2, c2, TRUE)) { DEBUGm4 (("out of memory: store LU (1)\n")) ; return (FALSE) ; /* out of memory */ } p = UMF_mem_alloc_head_block (Numeric, size) ; if (!p) { DEBUGm4 (("out of memory: store LU (2)\n")) ; return (FALSE) ; /* out of memory */ } /* garbage collection may have moved the current front */ fnc_curr = Work->fnc_curr ; fnr_curr = Work->fnr_curr ; Flublock = Work->Flublock ; Flblock = Work->Flblock ; Fublock = Work->Fublock ; Fl1 = Flublock + kk * nb ; Fl2 = Flblock + kk * fnr_curr ; } /* ------------------------------------------------------------------ */ /* store the column of L */ /* ------------------------------------------------------------------ */ lip = p ; Li = (Int *) (Numeric->Memory + p) ; p += UNITS (Int, lnzi) ; Lval = (Entry *) (Numeric->Memory + p) ; p += UNITS (Entry, lnzx) ; for (i = 0 ; i < lnzx ; i++) { CLEAR (Lval [i]) ; } /* store the numerical entries */ if (newLchain) { /* flag the first column in the Lchain by negating Lip [k] */ lip = -lip ; ASSERT (llen == 0) ; #ifdef DROP for (i = kk + 1 ; i < fnpiv ; i++) { Entry x ; double s ; Int row2, pos ; x = Fl1 [i] ; APPROX_ABS (s, x) ; if (s <= droptol) continue ; row2 = Pivrow [i] ; pos = llen++ ; Lpattern [pos] = row2 ; Lpos [row2] = pos ; Li [pos] = row2 ; Lval [pos] = x ; } for (i = 0 ; i < fnrows ; i++) { Entry x ; double s ; Int row2, pos ; x = Fl2 [i] ; APPROX_ABS (s, x) ; if (s <= droptol) continue ; row2 = Frows [i] ; pos = llen++ ; Lpattern [pos] = row2 ; Lpos [row2] = pos ; Li [pos] = row2 ; Lval [pos] = x ; } #else for (i = kk + 1 ; i < fnpiv ; i++) { Entry x ; Int row2, pos ; x = Fl1 [i] ; if (IS_ZERO (x)) continue ; row2 = Pivrow [i] ; pos = llen++ ; Lpattern [pos] = row2 ; Lpos [row2] = pos ; Li [pos] = row2 ; Lval [pos] = x ; } for (i = 0 ; i < fnrows ; i++) { Entry x ; Int row2, pos ; x = Fl2 [i] ; if (IS_ZERO (x)) continue ; row2 = Frows [i] ; pos = llen++ ; Lpattern [pos] = row2 ; Lpos [row2] = pos ; Li [pos] = row2 ; Lval [pos] = x ; } #endif } else { ASSERT (llen > 0) ; #ifdef DROP for (i = kk + 1 ; i < fnpiv ; i++) { Entry x ; double s ; Int row2, pos ; x = Fl1 [i] ; APPROX_ABS (s, x) ; if (s <= droptol) continue ; row2 = Pivrow [i] ; pos = Lpos [row2] ; if (pos == EMPTY) { pos = llen++ ; Lpattern [pos] = row2 ; Lpos [row2] = pos ; *Li++ = row2 ; } Lval [pos] = x ; } for (i = 0 ; i < fnrows ; i++) { Entry x ; double s ; Int row2, pos ; x = Fl2 [i] ; APPROX_ABS (s, x) ; if (s <= droptol) continue ; row2 = Frows [i] ; pos = Lpos [row2] ; if (pos == EMPTY) { pos = llen++ ; Lpattern [pos] = row2 ; Lpos [row2] = pos ; *Li++ = row2 ; } Lval [pos] = x ; } #else for (i = kk + 1 ; i < fnpiv ; i++) { Entry x ; Int row2, pos ; x = Fl1 [i] ; if (IS_ZERO (x)) continue ; row2 = Pivrow [i] ; pos = Lpos [row2] ; if (pos == EMPTY) { pos = llen++ ; Lpattern [pos] = row2 ; Lpos [row2] = pos ; *Li++ = row2 ; } Lval [pos] = x ; } for (i = 0 ; i < fnrows ; i++) { Entry x ; Int row2, pos ; x = Fl2 [i] ; if (IS_ZERO (x)) continue ; row2 = Frows [i] ; pos = Lpos [row2] ; if (pos == EMPTY) { pos = llen++ ; Lpattern [pos] = row2 ; Lpos [row2] = pos ; *Li++ = row2 ; } Lval [pos] = x ; } #endif } DEBUG4 (("llen "ID" lnzx "ID"\n", llen, lnzx)) ; ASSERT (llen == lnzx) ; ASSERT (lnz <= llen) ; DEBUG4 (("lnz "ID" \n", lnz)) ; #ifdef DROP DEBUG4 (("all_lnz "ID" \n", all_lnz)) ; ASSERT (lnz <= all_lnz) ; Numeric->lnz += lnz ; Numeric->all_lnz += all_lnz ; Lnz [kk] = all_lnz ; #else Numeric->lnz += lnz ; Numeric->all_lnz += lnz ; Lnz [kk] = lnz ; #endif Numeric->nLentries += lnzx ; Work->llen = llen ; Numeric->isize += lnzi ; /* ------------------------------------------------------------------ */ /* the pivot column is fully assembled and scaled, and is now the */ /* k-th column of L */ /* ------------------------------------------------------------------ */ Lpos [pivrow] = pivrow_position ; /* not aliased */ Lip [pivcol] = lip ; /* aliased with Col_tuples */ Lilen [pivcol] = lnzi ; /* aliased with Col_tlen */ } /* ---------------------------------------------------------------------- */ /* store the rows of U */ /* ---------------------------------------------------------------------- */ for (kk = 0 ; kk < fnpiv ; kk++) { /* ------------------------------------------------------------------ */ /* one more pivot row and column is being stored into L and U */ /* ------------------------------------------------------------------ */ k = Work->npiv + kk ; /* ------------------------------------------------------------------ */ /* find the kth pivot row and pivot column */ /* ------------------------------------------------------------------ */ pivrow = Pivrow [kk] ; pivcol = Pivcol [kk] ; #ifndef NDEBUG ASSERT (pivrow >= 0 && pivrow < Work->n_row) ; ASSERT (pivcol >= 0 && pivcol < Work->n_col) ; DEBUG2 (("Store row of U, k = "ID", ulen "ID"\n", k, ulen)) ; for (i = 0 ; i < ulen ; i++) { col = Upattern [i] ; DEBUG2 ((" Upattern["ID"] "ID, i, col)) ; if (col == pivcol) DEBUG2 ((" <- pivot col")) ; DEBUG2 (("\n")) ; ASSERT (col >= 0 && col < Work->n_col) ; ASSERT (i == Upos [col]) ; } #endif /* ------------------------------------------------------------------ */ /* get the pivot value, for the diagonal matrix D */ /* ------------------------------------------------------------------ */ zero_pivot = IS_ZERO (D [k]) ; /* ------------------------------------------------------------------ */ /* count the nonzeros in the row of U */ /* ------------------------------------------------------------------ */ /* kk-th row of U in the LU block */ Fu1 = Flublock + kk ; /* kk-th row of U in the U block */ Fu2 = Fublock + kk * fnc_curr ; unz = 0 ; unz2i = 0 ; unz2x = ulen ; DEBUG2 (("unz2x is "ID", lnzx "ID"\n", unz2x, lnzx)) ; /* if row k does not end a Uchain, pivcol not included in ulen */ ASSERT (!NON_PIVOTAL_COL (pivcol)) ; pivcol_position = Upos [pivcol] ; if (pivcol_position != EMPTY) { unz2x-- ; DEBUG2 (("(exclude pivcol) unz2x is now "ID"\n", unz2x)) ; } ASSERT (unz2x >= 0) ; #ifdef DROP all_unz = 0 ; for (i = kk + 1 ; i < fnpiv ; i++) { Entry x ; double s ; x = Fu1 [i*nb] ; if (IS_ZERO (x)) continue ; all_unz++ ; APPROX_ABS (s, x) ; if (s <= droptol) continue ; unz++ ; if (Upos [Pivcol [i]] == EMPTY) unz2i++ ; } for (i = 0 ; i < fncols ; i++) { Entry x ; double s ; x = Fu2 [i] ; if (IS_ZERO (x)) continue ; all_unz++ ; APPROX_ABS (s, x) ; if (s <= droptol) continue ; unz++ ; if (Upos [Fcols [i]] == EMPTY) unz2i++ ; } #else for (i = kk + 1 ; i < fnpiv ; i++) { if (IS_ZERO (Fu1 [i*nb])) continue ; unz++ ; if (Upos [Pivcol [i]] == EMPTY) unz2i++ ; } for (i = 0 ; i < fncols ; i++) { if (IS_ZERO (Fu2 [i])) continue ; unz++ ; if (Upos [Fcols [i]] == EMPTY) unz2i++ ; } #endif unz2x += unz2i ; ASSERT (IMPLIES (k == 0, ulen == 0)) ; /* determine if we start a new Uchain or continue the old one */ if (ulen == 0 || zero_pivot) { /* ulen == 0 means there is no prior Uchain */ /* D [k] == 0 means the matrix is singular (pivot row might */ /* not be empty, however, but start a new Uchain to prune zero */ /* entries for the deg > 0 test in UMF_u*solve) */ newUchain = TRUE ; } else { newUchain = /* approximate storage for starting a new Uchain */ UNITS (Entry, unz) + UNITS (Int, unz) <= /* approximate storage for continuing a prior Uchain */ UNITS (Entry, unz2x) + UNITS (Int, unz2i) ; /* this would be exact, except for the Int to Unit rounding, */ /* because the Upattern is stored only at the end of the Uchain */ } /* ------------------------------------------------------------------ */ /* allocate space for the row of U */ /* ------------------------------------------------------------------ */ size = 0 ; if (newUchain) { /* store the pattern of the last row in the prior Uchain */ size += UNITS (Int, ulen) ; unzx = unz ; } else { unzx = unz2x ; } size += UNITS (Entry, unzx) ; #ifndef NDEBUG UMF_allocfail = FALSE ; if (UMF_gprob > 0) { double rrr = ((double) (rand ( ))) / (((double) RAND_MAX) + 1) ; DEBUG4 (("Check random %e %e\n", rrr, UMF_gprob)) ; UMF_allocfail = rrr < UMF_gprob ; if (UMF_allocfail) DEBUGm2 (("Random garbage coll. (store LU)\n")); } #endif p = UMF_mem_alloc_head_block (Numeric, size) ; if (!p) { Int r2, c2 ; /* Do garbage collection, realloc, and try again. */ /* Note that there are pivot rows/columns in current front. */ if (Work->do_grow) { /* full compaction of current frontal matrix, since * UMF_grow_front will be called next anyway. */ r2 = fnrows ; c2 = fncols ; } else { /* partial compaction. */ r2 = MAX (fnrows, Work->fnrows_new + 1) ; c2 = MAX (fncols, Work->fncols_new + 1) ; } DEBUGm3 (("get_memory from umf_store_lu:\n")) ; if (!UMF_get_memory (Numeric, Work, size, r2, c2, TRUE)) { /* :: get memory, column of L :: */ DEBUGm4 (("out of memory: store LU (1)\n")) ; return (FALSE) ; /* out of memory */ } p = UMF_mem_alloc_head_block (Numeric, size) ; if (!p) { /* :: out of memory, column of U :: */ DEBUGm4 (("out of memory: store LU (2)\n")) ; return (FALSE) ; /* out of memory */ } /* garbage collection may have moved the current front */ fnc_curr = Work->fnc_curr ; fnr_curr = Work->fnr_curr ; Flublock = Work->Flublock ; Flblock = Work->Flblock ; Fublock = Work->Fublock ; Fu1 = Flublock + kk ; Fu2 = Fublock + kk * fnc_curr ; } /* ------------------------------------------------------------------ */ /* store the row of U */ /* ------------------------------------------------------------------ */ uip = p ; if (newUchain) { /* starting a new Uchain - flag this by negating Uip [k] */ uip = -uip ; DEBUG2 (("Start new Uchain, k = "ID"\n", k)) ; pivcol_position = EMPTY ; /* end the prior Uchain */ /* save the current Upattern, and then */ /* clear it and start a new Upattern */ DEBUG2 (("Ending prior chain, k-1 = "ID"\n", k-1)) ; uilen = ulen ; Ui = (Int *) (Numeric->Memory + p) ; Numeric->isize += ulen ; p += UNITS (Int, ulen) ; for (i = 0 ; i < ulen ; i++) { col = Upattern [i] ; ASSERT (col >= 0 && col < Work->n_col) ; Upos [col] = EMPTY ; Ui [i] = col ; } ulen = 0 ; } else { /* continue the prior Uchain */ DEBUG2 (("Continue Uchain, k = "ID"\n", k)) ; ASSERT (k > 0) ; /* remove pivot col index from current row of U */ /* if a new Uchain starts, then all entries are removed later */ DEBUG2 (("Removing pivcol from Upattern, k = "ID"\n", k)) ; if (pivcol_position != EMPTY) { /* place the last entry in the row in the */ /* position of the pivot col index */ ASSERT (pivcol == Upattern [pivcol_position]) ; col = Upattern [--ulen] ; ASSERT (col >= 0 && col < Work->n_col) ; Upattern [pivcol_position] = col ; Upos [col] = pivcol_position ; Upos [pivcol] = EMPTY ; } /* this row continues the Uchain. Keep track of how much */ /* to trim from the k-th length to get the length of the */ /* (k-1)st row of U */ uilen = unz2i ; } Uval = (Entry *) (Numeric->Memory + p) ; /* p += UNITS (Entry, unzx), no need to increment p */ for (i = 0 ; i < unzx ; i++) { CLEAR (Uval [i]) ; } if (newUchain) { ASSERT (ulen == 0) ; #ifdef DROP for (i = kk + 1 ; i < fnpiv ; i++) { Entry x ; double s ; Int col2, pos ; x = Fu1 [i*nb] ; APPROX_ABS (s, x) ; if (s <= droptol) continue ; col2 = Pivcol [i] ; pos = ulen++ ; Upattern [pos] = col2 ; Upos [col2] = pos ; Uval [pos] = x ; } for (i = 0 ; i < fncols ; i++) { Entry x ; double s ; Int col2, pos ; x = Fu2 [i] ; APPROX_ABS (s, x) ; if (s <= droptol) continue ; col2 = Fcols [i] ; pos = ulen++ ; Upattern [pos] = col2 ; Upos [col2] = pos ; Uval [pos] = x ; } #else for (i = kk + 1 ; i < fnpiv ; i++) { Entry x ; Int col2, pos ; x = Fu1 [i*nb] ; if (IS_ZERO (x)) continue ; col2 = Pivcol [i] ; pos = ulen++ ; Upattern [pos] = col2 ; Upos [col2] = pos ; Uval [pos] = x ; } for (i = 0 ; i < fncols ; i++) { Entry x ; Int col2, pos ; x = Fu2 [i] ; if (IS_ZERO (x)) continue ; col2 = Fcols [i] ; pos = ulen++ ; Upattern [pos] = col2 ; Upos [col2] = pos ; Uval [pos] = x ; } #endif } else { ASSERT (ulen > 0) ; /* store the numerical entries and find new nonzeros */ #ifdef DROP for (i = kk + 1 ; i < fnpiv ; i++) { Entry x ; double s ; Int col2, pos ; x = Fu1 [i*nb] ; APPROX_ABS (s, x) ; if (s <= droptol) continue ; col2 = Pivcol [i] ; pos = Upos [col2] ; if (pos == EMPTY) { pos = ulen++ ; Upattern [pos] = col2 ; Upos [col2] = pos ; } Uval [pos] = x ; } for (i = 0 ; i < fncols ; i++) { Entry x ; double s ; Int col2, pos ; x = Fu2 [i] ; APPROX_ABS (s, x) ; if (s <= droptol) continue ; col2 = Fcols [i] ; pos = Upos [col2] ; if (pos == EMPTY) { pos = ulen++ ; Upattern [pos] = col2 ; Upos [col2] = pos ; } Uval [pos] = x ; } #else for (i = kk + 1 ; i < fnpiv ; i++) { Entry x ; Int col2, pos ; x = Fu1 [i*nb] ; if (IS_ZERO (x)) continue ; col2 = Pivcol [i] ; pos = Upos [col2] ; if (pos == EMPTY) { pos = ulen++ ; Upattern [pos] = col2 ; Upos [col2] = pos ; } Uval [pos] = x ; } for (i = 0 ; i < fncols ; i++) { Entry x ; Int col2, pos ; x = Fu2 [i] ; if (IS_ZERO (x)) continue ; col2 = Fcols [i] ; pos = Upos [col2] ; if (pos == EMPTY) { pos = ulen++ ; Upattern [pos] = col2 ; Upos [col2] = pos ; } Uval [pos] = x ; } #endif } ASSERT (ulen == unzx) ; ASSERT (unz <= ulen) ; DEBUG4 (("unz "ID" \n", unz)) ; #ifdef DROP DEBUG4 (("all_unz "ID" \n", all_unz)) ; ASSERT (unz <= all_unz) ; Numeric->unz += unz ; Numeric->all_unz += all_unz ; /* count the "true" flops, based on LU pattern only */ Numeric->flops += DIV_FLOPS * Lnz [kk] /* scale pivot column */ + MULTSUB_FLOPS * (Lnz [kk] * all_unz) ; /* outer product */ #else Numeric->unz += unz ; Numeric->all_unz += unz ; /* count the "true" flops, based on LU pattern only */ Numeric->flops += DIV_FLOPS * Lnz [kk] /* scale pivot column */ + MULTSUB_FLOPS * (Lnz [kk] * unz) ; /* outer product */ #endif Numeric->nUentries += unzx ; Work->ulen = ulen ; DEBUG1 (("Work->ulen = "ID" at end of pivot step, k: "ID"\n", ulen, k)); /* ------------------------------------------------------------------ */ /* the pivot row is the k-th row of U */ /* ------------------------------------------------------------------ */ Upos [pivcol] = pivcol_position ; /* not aliased */ Uip [pivrow] = uip ; /* aliased with Row_tuples */ Uilen [pivrow] = uilen ; /* aliased with Row_tlen */ } /* ---------------------------------------------------------------------- */ /* no more pivots in frontal working array */ /* ---------------------------------------------------------------------- */ Work->npiv += fnpiv ; Work->fnpiv = 0 ; Work->fnzeros = 0 ; return (TRUE) ; }
GLOBAL Int UMF_extend_front ( NumericType *Numeric, WorkType *Work ) { /* ---------------------------------------------------------------------- */ /* local variables */ /* ---------------------------------------------------------------------- */ Int j, i, *Frows, row, col, *Wrow, fnr2, fnc2, *Frpos, *Fcpos, *Fcols, fnrows_extended, rrdeg, ccdeg, fncols_extended, fnr_curr, fnc_curr, fnrows, fncols, pos, fnpiv, *Wm ; Entry *Wx, *Wy, *Fu, *Fl ; /* ---------------------------------------------------------------------- */ /* get current frontal matrix and check for frontal growth */ /* ---------------------------------------------------------------------- */ fnpiv = Work->fnpiv ; #ifndef NDEBUG DEBUG2 (("EXTEND FRONT\n")) ; DEBUG2 (("Work->fnpiv "ID"\n", fnpiv)) ; ASSERT (Work->Flblock == Work->Flublock + Work->nb*Work->nb) ; ASSERT (Work->Fublock == Work->Flblock + Work->fnr_curr*Work->nb) ; ASSERT (Work->Fcblock == Work->Fublock + Work->nb*Work->fnc_curr) ; DEBUG7 (("C block: ")) ; UMF_dump_dense (Work->Fcblock, Work->fnr_curr, Work->fnrows, Work->fncols) ; DEBUG7 (("L block: ")) ; UMF_dump_dense (Work->Flblock, Work->fnr_curr, Work->fnrows, fnpiv); DEBUG7 (("U' block: ")) ; UMF_dump_dense (Work->Fublock, Work->fnc_curr, Work->fncols, fnpiv) ; DEBUG7 (("LU block: ")) ; UMF_dump_dense (Work->Flublock, Work->nb, fnpiv, fnpiv) ; #endif if (Work->do_grow) { fnr2 = UMF_FRONTAL_GROWTH * Work->fnrows_new + 2 ; fnc2 = UMF_FRONTAL_GROWTH * Work->fncols_new + 2 ; if (!UMF_grow_front (Numeric, fnr2, fnc2, Work, 1)) { DEBUGm4 (("out of memory: extend front\n")) ; return (FALSE) ; } } fnr_curr = Work->fnr_curr ; fnc_curr = Work->fnc_curr ; ASSERT (Work->fnrows_new + 1 <= fnr_curr) ; ASSERT (Work->fncols_new + 1 <= fnc_curr) ; ASSERT (fnr_curr >= 0 && fnr_curr % 2 == 1) ; /* ---------------------------------------------------------------------- */ /* get parameters */ /* ---------------------------------------------------------------------- */ Frows = Work->Frows ; Frpos = Work->Frpos ; Fcols = Work->Fcols ; Fcpos = Work->Fcpos ; fnrows = Work->fnrows ; fncols = Work->fncols ; rrdeg = Work->rrdeg ; ccdeg = Work->ccdeg ; /* scan starts at the first new column in Fcols */ /* also scan the pivot column if it was not in the front */ Work->fscan_col = fncols ; Work->NewCols = Fcols ; /* scan1 starts at the first new row in Frows */ /* also scan the pivot row if it was not in the front */ Work->fscan_row = fnrows ; Work->NewRows = Frows ; /* ---------------------------------------------------------------------- */ /* extend row pattern of the front with the new pivot column */ /* ---------------------------------------------------------------------- */ fnrows_extended = fnrows ; fncols_extended = fncols ; #ifndef NDEBUG DEBUG2 (("Pivot col, before extension: "ID"\n", fnrows)) ; for (i = 0 ; i < fnrows ; i++) { DEBUG2 ((" "ID": row "ID"\n", i, Frows [i])) ; ASSERT (Frpos [Frows [i]] == i) ; } DEBUG2 (("Extending pivot column: pivcol_in_front: "ID"\n", Work->pivcol_in_front)) ; #endif Fl = Work->Flblock + fnpiv * fnr_curr ; if (Work->pivcol_in_front) { /* extended pattern and position already in Frows, Frpos. Values above * the diagonal are already in LU block. Values on and below the * diagonal are in Wy [0 .. fnrows_extended-1]. Copy into the L * block. */ fnrows_extended += ccdeg ; Wy = Work->Wy ; for (i = 0 ; i < fnrows_extended ; i++) { Fl [i] = Wy [i] ; #ifndef NDEBUG row = Frows [i] ; DEBUG2 ((" "ID": row "ID" ", i, row)) ; EDEBUG2 (Fl [i]) ; if (row == Work->pivrow) DEBUG2 ((" <- pivrow")) ; DEBUG2 (("\n")) ; if (i == fnrows - 1) DEBUG2 ((" :::::::\n")) ; ASSERT (row >= 0 && row < Work->n_row) ; ASSERT (Frpos [row] == i) ; #endif } } else { /* extended pattern,values is in (Wm,Wx), not yet in the front */ Entry *F ; Fu = Work->Flublock + fnpiv * Work->nb ; Wm = Work->Wm ; Wx = Work->Wx ; F = Fu ; for (i = 0 ; i < fnpiv ; i++) { CLEAR_AND_INCREMENT (F) ; } F = Fl ; for (i = 0 ; i < fnrows ; i++) { CLEAR_AND_INCREMENT (F) ; } for (i = 0 ; i < ccdeg ; i++) { row = Wm [i] ; #ifndef NDEBUG DEBUG2 ((" "ID": row "ID" (ext) ", fnrows_extended, row)) ; EDEBUG2 (Wx [i]) ; if (row == Work->pivrow) DEBUG2 ((" <- pivrow")) ; DEBUG2 (("\n")) ; ASSERT (row >= 0 && row < Work->n_row) ; #endif pos = Frpos [row] ; if (pos < 0) { pos = fnrows_extended++ ; Frows [pos] = row ; Frpos [row] = pos ; } Fl [pos] = Wx [i] ; } } ASSERT (fnrows_extended <= fnr_curr) ; /* ---------------------------------------------------------------------- */ /* extend the column pattern of the front with the new pivot row */ /* ---------------------------------------------------------------------- */ #ifndef NDEBUG DEBUG6 (("Pivot row, before extension: "ID"\n", fncols)) ; for (j = 0 ; j < fncols ; j++) { DEBUG7 ((" "ID": col "ID"\n", j, Fcols [j])) ; ASSERT (Fcpos [Fcols [j]] == j * fnr_curr) ; } DEBUG6 (("Extending pivot row:\n")) ; #endif if (Work->pivrow_in_front) { if (Work->pivcol_in_front) { ASSERT (Fcols == Work->Wrow) ; for (j = fncols ; j < rrdeg ; j++) { #ifndef NDEBUG col = Fcols [j] ; DEBUG2 ((" "ID": col "ID" (ext)\n", j, col)) ; ASSERT (col != Work->pivcol) ; ASSERT (col >= 0 && col < Work->n_col) ; ASSERT (Fcpos [col] < 0) ; #endif Fcpos [Fcols [j]] = j * fnr_curr ; } } else { /* OUT-IN option: pivcol not in front, but pivrow is in front */ Wrow = Work->Wrow ; ASSERT (IMPLIES (Work->pivcol_in_front, Wrow == Fcols)) ; if (Wrow == Fcols) { /* Wrow and Fcols are equivalenced */ for (j = fncols ; j < rrdeg ; j++) { col = Wrow [j] ; DEBUG2 ((" "ID": col "ID" (ext)\n", j, col)) ; ASSERT (Fcpos [col] < 0) ; /* Fcols [j] = col ; not needed */ Fcpos [col] = j * fnr_curr ; } } else { for (j = fncols ; j < rrdeg ; j++) { col = Wrow [j] ; DEBUG2 ((" "ID": col "ID" (ext)\n", j, col)) ; ASSERT (Fcpos [col] < 0) ; Fcols [j] = col ; Fcpos [col] = j * fnr_curr ; } } } fncols_extended = rrdeg ; } else { ASSERT (Fcols != Work->Wrow) ; Wrow = Work->Wrow ; for (j = 0 ; j < rrdeg ; j++) { col = Wrow [j] ; ASSERT (col >= 0 && col < Work->n_col) ; if (Fcpos [col] < 0) { DEBUG2 ((" col:: "ID" (ext)\n", col)) ; Fcols [fncols_extended] = col ; Fcpos [col] = fncols_extended * fnr_curr ; fncols_extended++ ; } } } /* ---------------------------------------------------------------------- */ /* pivot row and column have been extended */ /* ---------------------------------------------------------------------- */ #ifndef NDEBUG ASSERT (fncols_extended <= fnc_curr) ; ASSERT (fnrows_extended <= fnr_curr) ; DEBUG6 (("Pivot col, after ext: "ID" "ID"\n", fnrows,fnrows_extended)) ; for (i = 0 ; i < fnrows_extended ; i++) { row = Frows [i] ; DEBUG7 ((" "ID": row "ID" pos "ID" old: %d", i, row, Frpos [row], i < fnrows)) ; if (row == Work->pivrow ) DEBUG7 ((" <-- pivrow")) ; DEBUG7 (("\n")) ; ASSERT (Frpos [Frows [i]] == i) ; } DEBUG6 (("Pivot row position: "ID"\n", Frpos [Work->pivrow])) ; ASSERT (Frpos [Work->pivrow] >= 0) ; ASSERT (Frpos [Work->pivrow] < fnrows_extended) ; DEBUG6 (("Pivot row, after ext: "ID" "ID"\n", fncols,fncols_extended)) ; for (j = 0 ; j < fncols_extended ; j++) { col = Fcols [j] ; DEBUG7 ((" "ID": col "ID" pos "ID" old: %d", j, col, Fcpos [col], j < fncols)) ; if (col == Work->pivcol ) DEBUG7 ((" <-- pivcol")) ; DEBUG7 (("\n")) ; ASSERT (Fcpos [Fcols [j]] == j * fnr_curr) ; } DEBUG6 (("Pivot col position: "ID"\n", Fcpos [Work->pivcol])) ; ASSERT (Fcpos [Work->pivcol] >= 0) ; ASSERT (Fcpos [Work->pivcol] < fncols_extended * fnr_curr) ; #endif /* ---------------------------------------------------------------------- */ /* Zero the newly extended frontal matrix */ /* ---------------------------------------------------------------------- */ zero_front (Work->Flblock, Work->Fublock, Work->Fcblock, fnrows, fncols, fnr_curr, fnc_curr, fnpiv, fnrows_extended, fncols_extended) ; /* ---------------------------------------------------------------------- */ /* finalize extended row and column pattern of the frontal matrix */ /* ---------------------------------------------------------------------- */ Work->fnrows = fnrows_extended ; Work->fncols = fncols_extended ; ASSERT (fnrows_extended == Work->fnrows_new + 1) ; ASSERT (fncols_extended == Work->fncols_new + 1) ; return (TRUE) ; }
GLOBAL void UMF_blas3_update ( WorkType *Work ) { /* ---------------------------------------------------------------------- */ /* local variables */ /* ---------------------------------------------------------------------- */ Entry *L, *U, *C, *LU ; Int i, j, s, k, m, n, d, nb, dc ; #ifndef NBLAS Int blas_ok = TRUE ; #else #define blas_ok FALSE #endif DEBUG5 (("In UMF_blas3_update "ID" "ID" "ID"\n", Work->fnpiv, Work->fnrows, Work->fncols)) ; k = Work->fnpiv ; if (k == 0) { /* no work to do */ return ; } m = Work->fnrows ; n = Work->fncols ; d = Work->fnr_curr ; dc = Work->fnc_curr ; nb = Work->nb ; ASSERT (d >= 0 && (d % 2) == 1) ; C = Work->Fcblock ; /* ldc is fnr_curr */ L = Work->Flblock ; /* ldl is fnr_curr */ U = Work->Fublock ; /* ldu is fnc_curr, stored by rows */ LU = Work->Flublock ; /* nb-by-nb */ #ifndef NDEBUG DEBUG5 (("DO RANK-NB UPDATE of frontal:\n")) ; DEBUG5 (("DGEMM : "ID" "ID" "ID"\n", k, m, n)) ; DEBUG7 (("C block: ")) ; UMF_dump_dense (C, d, m, n) ; DEBUG7 (("A block: ")) ; UMF_dump_dense (L, d, m, k) ; DEBUG7 (("B' block: ")) ; UMF_dump_dense (U, dc, n, k) ; DEBUG7 (("LU block: ")) ; UMF_dump_dense (LU, nb, k, k) ; #endif if (k == 1) { #ifndef NBLAS BLAS_GER (m, n, L, U, C, d) ; #endif if (!blas_ok) { /* rank-1 outer product to update the C block */ for (j = 0 ; j < n ; j++) { Entry u_j = U [j] ; if (IS_NONZERO (u_j)) { Entry *c_ij, *l_is ; c_ij = & C [j*d] ; l_is = & L [0] ; #pragma ivdep for (i = 0 ; i < m ; i++) { /* C [i+j*d]-= L [i] * U [j] */ MULT_SUB (*c_ij, *l_is, u_j) ; c_ij++ ; l_is++ ; } } } } } else { /* triangular solve to update the U block */ #ifndef NBLAS BLAS_TRSM_RIGHT (n, k, LU, nb, U, dc) ; #endif if (!blas_ok) { /* use plain C code if no BLAS at compile time, or if integer * overflow has occurred */ for (s = 0 ; s < k ; s++) { for (i = s+1 ; i < k ; i++) { Entry l_is = LU [i+s*nb] ; if (IS_NONZERO (l_is)) { Entry *u_ij, *u_sj ; u_ij = & U [i*dc] ; u_sj = & U [s*dc] ; #pragma ivdep for (j = 0 ; j < n ; j++) { /* U [i*dc+j] -= LU [i+s*nb] * U [s*dc+j] ; */ MULT_SUB (*u_ij, l_is, *u_sj) ; u_ij++ ; u_sj++ ; } } } } } /* rank-k outer product to update the C block */ /* C = C - L*U' (U is stored by rows, not columns) */ #ifndef NBLAS BLAS_GEMM (m, n, k, L, U, dc, C, d) ; #endif if (!blas_ok) { /* use plain C code if no BLAS at compile time, or if integer * overflow has occurred */ for (s = 0 ; s < k ; s++) { for (j = 0 ; j < n ; j++) { Entry u_sj = U [j+s*dc] ; if (IS_NONZERO (u_sj)) { Entry *c_ij, *l_is ; c_ij = & C [j*d] ; l_is = & L [s*d] ; #pragma ivdep for (i = 0 ; i < m ; i++) { /* C [i+j*d]-= L [i+s*d] * U [s*dc+j] */ MULT_SUB (*c_ij, *l_is, u_sj) ; c_ij++ ; l_is++ ; } } } } } } #ifndef NDEBUG DEBUG5 (("RANK-NB UPDATE of frontal done:\n")) ; DEBUG5 (("DGEMM : "ID" "ID" "ID"\n", k, m, n)) ; DEBUG7 (("C block: ")) ; UMF_dump_dense (C, d, m, n) ; DEBUG7 (("A block: ")) ; UMF_dump_dense (L, d, m, k) ; DEBUG7 (("B' block: ")) ; UMF_dump_dense (U, dc, n, k) ; DEBUG7 (("LU block: ")) ; UMF_dump_dense (LU, nb, k, k) ; #endif DEBUG2 (("blas3 "ID" "ID" "ID"\n", k, Work->fnrows, Work->fncols)) ; }
GLOBAL void UMF_scale_column ( NumericType *Numeric, WorkType *Work ) { /* ---------------------------------------------------------------------- */ /* local variables */ /* ---------------------------------------------------------------------- */ Entry pivot_value ; Entry *Fcol, *Flublock, *Flblock, *Fublock, *Fcblock ; Int k, k1, fnr_curr, fnrows, fncols, *Frpos, *Fcpos, pivrow, pivcol, *Frows, *Fcols, fnc_curr, fnpiv, *Row_tuples, nb, *Col_tuples, *Rperm, *Cperm, fspos, col2, row2 ; #ifndef NDEBUG Int *Col_degree, *Row_degree ; #endif /* ---------------------------------------------------------------------- */ /* get parameters */ /* ---------------------------------------------------------------------- */ fnrows = Work->fnrows ; fncols = Work->fncols ; fnpiv = Work->fnpiv ; /* ---------------------------------------------------------------------- */ Rperm = Numeric->Rperm ; Cperm = Numeric->Cperm ; /* ---------------------------------------------------------------------- */ Flublock = Work->Flublock ; Flblock = Work->Flblock ; Fublock = Work->Fublock ; Fcblock = Work->Fcblock ; fnr_curr = Work->fnr_curr ; fnc_curr = Work->fnc_curr ; Frpos = Work->Frpos ; Fcpos = Work->Fcpos ; Frows = Work->Frows ; Fcols = Work->Fcols ; pivrow = Work->pivrow ; pivcol = Work->pivcol ; ASSERT (pivrow >= 0 && pivrow < Work->n_row) ; ASSERT (pivcol >= 0 && pivcol < Work->n_col) ; #ifndef NDEBUG Col_degree = Numeric->Cperm ; /* for NON_PIVOTAL_COL macro */ Row_degree = Numeric->Rperm ; /* for NON_PIVOTAL_ROW macro */ #endif Row_tuples = Numeric->Uip ; Col_tuples = Numeric->Lip ; nb = Work->nb ; #ifndef NDEBUG ASSERT (fnrows == Work->fnrows_new + 1) ; ASSERT (fncols == Work->fncols_new + 1) ; DEBUG1 (("SCALE COL: fnrows "ID" fncols "ID"\n", fnrows, fncols)) ; DEBUG2 (("\nFrontal matrix, including all space:\n" "fnr_curr "ID" fnc_curr "ID" nb "ID"\n" "fnrows "ID" fncols "ID" fnpiv "ID"\n", fnr_curr, fnc_curr, nb, fnrows, fncols, fnpiv)) ; DEBUG2 (("\nJust the active part:\n")) ; DEBUG7 (("C block: ")) ; UMF_dump_dense (Fcblock, fnr_curr, fnrows, fncols) ; DEBUG7 (("L block: ")) ; UMF_dump_dense (Flblock, fnr_curr, fnrows, fnpiv); DEBUG7 (("U' block: ")) ; UMF_dump_dense (Fublock, fnc_curr, fncols, fnpiv) ; DEBUG7 (("LU block: ")) ; UMF_dump_dense (Flublock, nb, fnpiv, fnpiv) ; #endif /* ====================================================================== */ /* === Shift pivot row and column ======================================= */ /* ====================================================================== */ /* ---------------------------------------------------------------------- */ /* move pivot column into place */ /* ---------------------------------------------------------------------- */ /* Note that the pivot column is already in place. Just shift the last * column into the position vacated by the pivot column. */ fspos = Fcpos [pivcol] ; /* one less column in the contribution block */ fncols = --(Work->fncols) ; if (fspos != fncols * fnr_curr) { Int fs = fspos / fnr_curr ; DEBUG6 (("Shift pivot column in front\n")) ; DEBUG6 (("fspos: "ID" flpos: "ID"\n", fspos, fncols * fnr_curr)) ; /* ------------------------------------------------------------------ */ /* move Fe => Fs */ /* ------------------------------------------------------------------ */ /* column of the contribution block: */ { /* Fs: current position of pivot column in contribution block */ /* Fe: position of last column in contribution block */ Int i ; Entry *Fs, *Fe ; Fs = Fcblock + fspos ; Fe = Fcblock + fncols * fnr_curr ; #pragma ivdep for (i = 0 ; i < fnrows ; i++) { Fs [i] = Fe [i] ; } } /* column of the U2 block */ { /* Fs: current position of pivot column in U block */ /* Fe: last column in U block */ Int i ; Entry *Fs, *Fe ; Fs = Fublock + fs ; Fe = Fublock + fncols ; #pragma ivdep for (i = 0 ; i < fnpiv ; i++) { Fs [i * fnc_curr] = Fe [i * fnc_curr] ; } } /* move column Fe to Fs in the Fcols pattern */ col2 = Fcols [fncols] ; Fcols [fs] = col2 ; Fcpos [col2] = fspos ; } /* pivot column is no longer in the frontal matrix */ Fcpos [pivcol] = EMPTY ; #ifndef NDEBUG DEBUG2 (("\nFrontal matrix after col swap, including all space:\n" "fnr_curr "ID" fnc_curr "ID" nb "ID"\n" "fnrows "ID" fncols "ID" fnpiv "ID"\n", fnr_curr, fnc_curr, nb, fnrows, fncols, fnpiv)) ; DEBUG2 (("\nJust the active part:\n")) ; DEBUG7 (("C block: ")) ; UMF_dump_dense (Fcblock, fnr_curr, fnrows, fncols) ; DEBUG7 (("L block: ")) ; UMF_dump_dense (Flblock, fnr_curr, fnrows, fnpiv+1); DEBUG7 (("U' block: ")) ; UMF_dump_dense (Fublock, fnc_curr, fncols, fnpiv) ; DEBUG7 (("LU block: ")) ; UMF_dump_dense (Flublock, nb, fnpiv, fnpiv+1) ; #endif /* ---------------------------------------------------------------------- */ /* move pivot row into place */ /* ---------------------------------------------------------------------- */ fspos = Frpos [pivrow] ; /* one less row in the contribution block */ fnrows = --(Work->fnrows) ; DEBUG6 (("Swap/shift pivot row in front:\n")) ; DEBUG6 (("fspos: "ID" flpos: "ID"\n", fspos, fnrows)) ; if (fspos == fnrows) { /* ------------------------------------------------------------------ */ /* move Fs => Fd */ /* ------------------------------------------------------------------ */ DEBUG6 (("row case 1\n")) ; /* row of the contribution block: */ { Int j ; Entry *Fd, *Fs ; Fd = Fublock + fnpiv * fnc_curr ; Fs = Fcblock + fspos ; #pragma ivdep for (j = 0 ; j < fncols ; j++) { Fd [j] = Fs [j * fnr_curr] ; } } /* row of the L2 block: */ if (Work->pivrow_in_front) { Int j ; Entry *Fd, *Fs ; Fd = Flublock + fnpiv ; Fs = Flblock + fspos ; #pragma ivdep for (j = 0 ; j <= fnpiv ; j++) { Fd [j * nb] = Fs [j * fnr_curr] ; } } else { Int j ; Entry *Fd, *Fs ; Fd = Flublock + fnpiv ; Fs = Flblock + fspos ; #pragma ivdep for (j = 0 ; j < fnpiv ; j++) { ASSERT (IS_ZERO (Fs [j * fnr_curr])) ; CLEAR (Fd [j * nb]) ; } Fd [fnpiv * nb] = Fs [fnpiv * fnr_curr] ; } } else { /* ------------------------------------------------------------------ */ /* move Fs => Fd */ /* move Fe => Fs */ /* ------------------------------------------------------------------ */ DEBUG6 (("row case 2\n")) ; /* this is the most common case, by far */ /* row of the contribution block: */ { /* Fd: destination of pivot row on U block */ /* Fs: current position of pivot row in contribution block */ /* Fe: position of last row in contribution block */ Entry *Fd, *Fs, *Fe ; Fd = Fublock + fnpiv * fnc_curr ; Fs = Fcblock + fspos ; Fe = Fcblock + fnrows ; shift_pivot_row (Fd, Fs, Fe, fncols, fnr_curr) ; } /* row of the L2 block: */ if (Work->pivrow_in_front) { /* Fd: destination of pivot row in LU block */ /* Fs: current position of pivot row in L block */ /* Fe: last row in L block */ Int j ; Entry *Fd, *Fs, *Fe ; Fd = Flublock + fnpiv ; Fs = Flblock + fspos ; Fe = Flblock + fnrows ; #pragma ivdep for (j = 0 ; j <= fnpiv ; j++) { Fd [j * nb] = Fs [j * fnr_curr] ; Fs [j * fnr_curr] = Fe [j * fnr_curr] ; } } else { Int j ; Entry *Fd, *Fs, *Fe ; Fd = Flublock + fnpiv ; Fs = Flblock + fspos ; Fe = Flblock + fnrows ; #pragma ivdep for (j = 0 ; j < fnpiv ; j++) { ASSERT (IS_ZERO (Fs [j * fnr_curr])) ; CLEAR (Fd [j * nb]) ; Fs [j * fnr_curr] = Fe [j * fnr_curr] ; } Fd [fnpiv * nb] = Fs [fnpiv * fnr_curr] ; Fs [fnpiv * fnr_curr] = Fe [fnpiv * fnr_curr] ; } /* move row Fe to Fs in the Frows pattern */ row2 = Frows [fnrows] ; Frows [fspos] = row2 ; Frpos [row2] = fspos ; } /* pivot row is no longer in the frontal matrix */ Frpos [pivrow] = EMPTY ; #ifndef NDEBUG DEBUG2 (("\nFrontal matrix after row swap, including all space:\n" "fnr_curr "ID" fnc_curr "ID" nb "ID"\n" "fnrows "ID" fncols "ID" fnpiv "ID"\n", Work->fnr_curr, Work->fnc_curr, Work->nb, Work->fnrows, Work->fncols, Work->fnpiv)) ; DEBUG2 (("\nJust the active part:\n")) ; DEBUG7 (("C block: ")) ; UMF_dump_dense (Fcblock, fnr_curr, fnrows, fncols) ; DEBUG7 (("L block: ")) ; UMF_dump_dense (Flblock, fnr_curr, fnrows, fnpiv+1); DEBUG7 (("U' block: ")) ; UMF_dump_dense (Fublock, fnc_curr, fncols, fnpiv+1) ; DEBUG7 (("LU block: ")) ; UMF_dump_dense (Flublock, nb, fnpiv+1, fnpiv+1) ; #endif /* ---------------------------------------------------------------------- */ /* Frpos [row] >= 0 for each row in pivot column pattern. */ /* offset into pattern is given by: */ /* Frpos [row] == offset - 1 */ /* Frpos [pivrow] is EMPTY */ /* Fcpos [col] >= 0 for each col in pivot row pattern. */ /* Fcpos [col] == (offset - 1) * fnr_curr */ /* Fcpos [pivcol] is EMPTY */ /* Fcols [0..fncols-1] is the pivot row pattern (excl pivot cols) */ /* Frows [0..fnrows-1] is the pivot col pattern (excl pivot rows) */ /* ====================================================================== */ /* === scale pivot column =============================================== */ /* ====================================================================== */ /* pivot column (except for pivot entry itself) */ Fcol = Flblock + fnpiv * fnr_curr ; /* fnpiv-th pivot in frontal matrix located in Flublock (fnpiv, fnpiv) */ pivot_value = Flublock [fnpiv + fnpiv * nb] ; /* this is the kth global pivot */ k = Work->npiv + fnpiv ; DEBUG4 (("Pivot value: ")) ; EDEBUG4 (pivot_value) ; DEBUG4 (("\n")) ; UMF_scale (fnrows, pivot_value, Fcol) ; /* ---------------------------------------------------------------------- */ /* deallocate the pivot row and pivot column tuples */ /* ---------------------------------------------------------------------- */ UMF_mem_free_tail_block (Numeric, Row_tuples [pivrow]) ; UMF_mem_free_tail_block (Numeric, Col_tuples [pivcol]) ; Row_tuples [pivrow] = 0 ; Col_tuples [pivcol] = 0 ; DEBUG5 (("number of pivots prior to this one: "ID"\n", k)) ; ASSERT (NON_PIVOTAL_ROW (pivrow)) ; ASSERT (NON_PIVOTAL_COL (pivcol)) ; /* save row and column inverse permutation */ k1 = ONES_COMPLEMENT (k) ; Rperm [pivrow] = k1 ; /* aliased with Row_degree */ Cperm [pivcol] = k1 ; /* aliased with Col_degree */ ASSERT (!NON_PIVOTAL_ROW (pivrow)) ; ASSERT (!NON_PIVOTAL_COL (pivcol)) ; /* ---------------------------------------------------------------------- */ /* Keep track of the pivot order. This is the kth pivot row and column. */ /* ---------------------------------------------------------------------- */ /* keep track of pivot rows and columns in the LU, L, and U blocks */ ASSERT (fnpiv < MAXNB) ; Work->Pivrow [fnpiv] = pivrow ; Work->Pivcol [fnpiv] = pivcol ; /* ====================================================================== */ /* === one step in the factorization is done ============================ */ /* ====================================================================== */ /* One more step is done, except for pending updates to the U and C blocks * of this frontal matrix. Those are saved up, and applied by * UMF_blas3_update when enough pivots have accumulated. Also, the * LU factors for these pending pivots have not yet been stored. */ Work->fnpiv++ ; #ifndef NDEBUG DEBUG7 (("Current frontal matrix: (after pivcol scale)\n")) ; UMF_dump_current_front (Numeric, Work, TRUE) ; #endif }