GLOBAL Int UMF_grow_front ( NumericType *Numeric, Int fnr2, /* desired size is fnr2-by-fnc2 */ Int fnc2, WorkType *Work, Int do_what /* -1: UMF_start_front * 0: UMF_init_front, do not recompute Fcpos * 1: UMF_extend_front * 2: UMF_init_front, recompute Fcpos */ ) { /* ---------------------------------------------------------------------- */ /* local variables */ /* ---------------------------------------------------------------------- */ double s ; Entry *Fcold, *Fcnew ; Int j, i, col, *Fcpos, *Fcols, fnrows_max, fncols_max, fnr_curr, nb, fnrows_new, fncols_new, fnr_min, fnc_min, minsize, newsize, fnrows, fncols, *E, eloc ; /* ---------------------------------------------------------------------- */ /* get parameters */ /* ---------------------------------------------------------------------- */ #ifndef NDEBUG if (do_what != -1) UMF_debug++ ; DEBUG0 (("\n\n====================GROW FRONT: do_what: "ID"\n", do_what)) ; if (do_what != -1) UMF_debug-- ; ASSERT (Work->do_grow) ; ASSERT (Work->fnpiv == 0) ; #endif Fcols = Work->Fcols ; Fcpos = Work->Fcpos ; E = Work->E ; /* ---------------------------------------------------------------------- */ /* The current front is too small, find the new size */ /* ---------------------------------------------------------------------- */ /* maximum size of frontal matrix for this chain */ nb = Work->nb ; fnrows_max = Work->fnrows_max + nb ; fncols_max = Work->fncols_max + nb ; ASSERT (fnrows_max >= 0 && (fnrows_max % 2) == 1) ; DEBUG0 (("Max size: "ID"-by-"ID" (incl. "ID" pivot block\n", fnrows_max, fncols_max, nb)) ; /* current dimensions of frontal matrix: fnr-by-fnc */ DEBUG0 (("Current : "ID"-by-"ID" (excl "ID" pivot blocks)\n", Work->fnr_curr, Work->fnc_curr, nb)) ; ASSERT (Work->fnr_curr >= 0) ; ASSERT ((Work->fnr_curr % 2 == 1) || Work->fnr_curr == 0) ; /* required dimensions of frontal matrix: fnr_min-by-fnc_min */ fnrows_new = Work->fnrows_new + 1 ; fncols_new = Work->fncols_new + 1 ; ASSERT (fnrows_new >= 0) ; if (fnrows_new % 2 == 0) fnrows_new++ ; fnrows_new += nb ; fncols_new += nb ; fnr_min = MIN (fnrows_new, fnrows_max) ; fnc_min = MIN (fncols_new, fncols_max) ; minsize = fnr_min * fnc_min ; if (INT_OVERFLOW ((double) fnr_min * (double) fnc_min * sizeof (Entry))) { /* :: the minimum front size is bigger than the integer maximum :: */ return (FALSE) ; } ASSERT (fnr_min >= 0) ; ASSERT (fnr_min % 2 == 1) ; DEBUG0 (("Min : "ID"-by-"ID"\n", fnr_min, fnc_min)) ; /* grow the front to fnr2-by-fnc2, but no bigger than the maximum, * and no smaller than the minumum. */ DEBUG0 (("Desired : ("ID"+"ID")-by-("ID"+"ID")\n", fnr2, nb, fnc2, nb)) ; fnr2 += nb ; fnc2 += nb ; ASSERT (fnr2 >= 0) ; if (fnr2 % 2 == 0) fnr2++ ; fnr2 = MAX (fnr2, fnr_min) ; fnc2 = MAX (fnc2, fnc_min) ; fnr2 = MIN (fnr2, fnrows_max) ; fnc2 = MIN (fnc2, fncols_max) ; DEBUG0 (("Try : "ID"-by-"ID"\n", fnr2, fnc2)) ; ASSERT (fnr2 >= 0) ; ASSERT (fnr2 % 2 == 1) ; s = ((double) fnr2) * ((double) fnc2) ; if (INT_OVERFLOW (s * sizeof (Entry))) { /* :: frontal matrix size int overflow :: */ /* the desired front size is bigger than the integer maximum */ /* compute a such that a*a*s < Int_MAX / sizeof (Entry) */ double a = 0.9 * sqrt ((Int_MAX / sizeof (Entry)) / s) ; fnr2 = MAX (fnr_min, a * fnr2) ; fnc2 = MAX (fnc_min, a * fnc2) ; /* the new frontal size is a*r*a*c = a*a*s */ newsize = fnr2 * fnc2 ; ASSERT (fnr2 >= 0) ; if (fnr2 % 2 == 0) fnr2++ ; fnc2 = newsize / fnr2 ; } fnr2 = MAX (fnr2, fnr_min) ; fnc2 = MAX (fnc2, fnc_min) ; newsize = fnr2 * fnc2 ; ASSERT (fnr2 >= 0) ; ASSERT (fnr2 % 2 == 1) ; ASSERT (fnr2 >= fnr_min) ; ASSERT (fnc2 >= fnc_min) ; ASSERT (newsize >= minsize) ; /* ---------------------------------------------------------------------- */ /* free the current front if it is empty of any numerical values */ /* ---------------------------------------------------------------------- */ if (E [0] && do_what != 1) { /* free the current front, if it exists and has nothing in it */ DEBUG0 (("Freeing empty front\n")) ; UMF_mem_free_tail_block (Numeric, E [0]) ; E [0] = 0 ; Work->Flublock = (Entry *) NULL ; Work->Flblock = (Entry *) NULL ; Work->Fublock = (Entry *) NULL ; Work->Fcblock = (Entry *) NULL ; } /* ---------------------------------------------------------------------- */ /* allocate the new front, doing garbage collection if necessary */ /* ---------------------------------------------------------------------- */ #ifndef NDEBUG UMF_allocfail = FALSE ; if (UMF_gprob > 0) /* a double relop, but ignore NaN case */ { double rrr = ((double) (rand ( ))) / (((double) RAND_MAX) + 1) ; DEBUG1 (("Check random %e %e\n", rrr, UMF_gprob)) ; UMF_allocfail = rrr < UMF_gprob ; if (UMF_allocfail) DEBUGm2 (("Random garbage collection (grow)\n")) ; } #endif DEBUG0 (("Attempt size: "ID"-by-"ID"\n", fnr2, fnc2)) ; eloc = UMF_mem_alloc_tail_block (Numeric, UNITS (Entry, newsize)) ; if (!eloc) { /* Do garbage collection, realloc, and try again. Compact the current * contribution block in the front to fnrows-by-fncols. Note that * there are no pivot rows/columns in current front. Do not recompute * Fcpos in UMF_garbage_collection. */ DEBUGm3 (("get_memory from umf_grow_front\n")) ; if (!UMF_get_memory (Numeric, Work, 1 + UNITS (Entry, newsize), Work->fnrows, Work->fncols, FALSE)) { /* :: out of memory in umf_grow_front :: */ return (FALSE) ; /* out of memory */ } DEBUG0 (("Attempt size: "ID"-by-"ID" again\n", fnr2, fnc2)) ; eloc = UMF_mem_alloc_tail_block (Numeric, UNITS (Entry, newsize)) ; } /* try again with something smaller */ while ((fnr2 != fnr_min || fnc2 != fnc_min) && !eloc) { fnr2 = MIN (fnr2 - 2, fnr2 * UMF_REALLOC_REDUCTION) ; fnc2 = MIN (fnc2 - 2, fnc2 * UMF_REALLOC_REDUCTION) ; ASSERT (fnr_min >= 0) ; ASSERT (fnr_min % 2 == 1) ; fnr2 = MAX (fnr_min, fnr2) ; fnc2 = MAX (fnc_min, fnc2) ; ASSERT (fnr2 >= 0) ; if (fnr2 % 2 == 0) fnr2++ ; newsize = fnr2 * fnc2 ; DEBUGm3 (("Attempt smaller size: "ID"-by-"ID" minsize "ID"-by-"ID"\n", fnr2, fnc2, fnr_min, fnc_min)) ; eloc = UMF_mem_alloc_tail_block (Numeric, UNITS (Entry, newsize)) ; } /* try again with the smallest possible size */ if (!eloc) { fnr2 = fnr_min ; fnc2 = fnc_min ; newsize = minsize ; DEBUG0 (("Attempt minsize: "ID"-by-"ID"\n", fnr2, fnc2)) ; eloc = UMF_mem_alloc_tail_block (Numeric, UNITS (Entry, newsize)) ; } if (!eloc) { /* out of memory */ return (FALSE) ; } ASSERT (fnr2 >= 0) ; ASSERT (fnr2 % 2 == 1) ; ASSERT (fnr2 >= fnr_min && fnc2 >= fnc_min) ; /* ---------------------------------------------------------------------- */ /* copy the old frontal matrix into the new one */ /* ---------------------------------------------------------------------- */ /* old contribution block (if any) */ fnr_curr = Work->fnr_curr ; /* garbage collection can change fn*_curr */ ASSERT (fnr_curr >= 0) ; ASSERT ((fnr_curr % 2 == 1) || fnr_curr == 0) ; fnrows = Work->fnrows ; fncols = Work->fncols ; Fcold = Work->Fcblock ; /* remove nb from the sizes */ fnr2 -= nb ; fnc2 -= nb ; /* new frontal matrix */ Work->Flublock = (Entry *) (Numeric->Memory + eloc) ; Work->Flblock = Work->Flublock + nb * nb ; Work->Fublock = Work->Flblock + nb * fnr2 ; Work->Fcblock = Work->Fublock + nb * fnc2 ; Fcnew = Work->Fcblock ; if (E [0]) { /* copy the old contribution block into the new one */ for (j = 0 ; j < fncols ; j++) { col = Fcols [j] ; DEBUG1 (("copy col "ID" \n",col)) ; ASSERT (col >= 0 && col < Work->n_col) ; for (i = 0 ; i < fnrows ; i++) { Fcnew [i] = Fcold [i] ; } Fcnew += fnr2 ; Fcold += fnr_curr ; DEBUG1 (("new offset col "ID" "ID"\n",col, j * fnr2)) ; Fcpos [col] = j * fnr2 ; } } else if (do_what == 2) { /* just find the new column offsets */ for (j = 0 ; j < fncols ; j++) { col = Fcols [j] ; DEBUG1 (("new offset col "ID" "ID"\n",col, j * fnr2)) ; Fcpos [col] = j * fnr2 ; } } /* free the old frontal matrix */ UMF_mem_free_tail_block (Numeric, E [0]) ; /* ---------------------------------------------------------------------- */ /* new frontal matrix size */ /* ---------------------------------------------------------------------- */ E [0] = eloc ; Work->fnr_curr = fnr2 ; /* C block is fnr2-by-fnc2 */ Work->fnc_curr = fnc2 ; Work->fcurr_size = newsize ; /* including LU, L, U, and C blocks */ Work->do_grow = FALSE ; /* the front has just been grown */ ASSERT (Work->fnr_curr >= 0) ; ASSERT (Work->fnr_curr % 2 == 1) ; DEBUG0 (("Newly grown front: "ID"+"ID" by "ID"+"ID"\n", Work->fnr_curr, nb, Work->fnc_curr, nb)) ; return (TRUE) ; }
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_create_element ( NumericType *Numeric, WorkType *Work, SymbolicType *Symbolic ) { /* ---------------------------------------------------------------------- */ /* local variables */ /* ---------------------------------------------------------------------- */ Int j, col, row, *Fcols, *Frows, fnrows, fncols, *Cols, len, needunits, t1, t2, size, e, i, *E, *Fcpos, *Frpos, *Rows, eloc, fnr_curr, f, got_memory, *Row_tuples, *Row_degree, *Row_tlen, *Col_tuples, max_mark, *Col_degree, *Col_tlen, nn, n_row, n_col, r2, c2, do_Fcpos ; Entry *C, *Fcol ; Element *ep ; Unit *p, *Memory ; Tuple *tp, *tp1, *tp2, tuple, *tpend ; #ifndef NDEBUG DEBUG2 (("FRONTAL WRAPUP\n")) ; UMF_dump_current_front (Numeric, Work, TRUE) ; #endif /* ---------------------------------------------------------------------- */ /* get parameters */ /* ---------------------------------------------------------------------- */ ASSERT (Work->fnpiv == 0) ; ASSERT (Work->fnzeros == 0) ; Row_degree = Numeric->Rperm ; Row_tuples = Numeric->Uip ; Row_tlen = Numeric->Uilen ; Col_degree = Numeric->Cperm ; Col_tuples = Numeric->Lip ; Col_tlen = Numeric->Lilen ; n_row = Work->n_row ; n_col = Work->n_col ; nn = MAX (n_row, n_col) ; Fcols = Work->Fcols ; Frows = Work->Frows ; Fcpos = Work->Fcpos ; Frpos = Work->Frpos ; Memory = Numeric->Memory ; fncols = Work->fncols ; fnrows = Work->fnrows ; tp = (Tuple *) NULL ; tp1 = (Tuple *) NULL ; tp2 = (Tuple *) NULL ; /* ---------------------------------------------------------------------- */ /* add the current frontal matrix to the degrees of each column */ /* ---------------------------------------------------------------------- */ if (!Symbolic->fixQ) { /* but only if the column ordering is not fixed */ #pragma ivdep for (j = 0 ; j < fncols ; j++) { /* add the current frontal matrix to the degree */ ASSERT (Fcols [j] >= 0 && Fcols [j] < n_col) ; Col_degree [Fcols [j]] += fnrows ; } } /* ---------------------------------------------------------------------- */ /* add the current frontal matrix to the degrees of each row */ /* ---------------------------------------------------------------------- */ #pragma ivdep for (i = 0 ; i < fnrows ; i++) { /* add the current frontal matrix to the degree */ ASSERT (Frows [i] >= 0 && Frows [i] < n_row) ; Row_degree [Frows [i]] += fncols ; } /* ---------------------------------------------------------------------- */ /* Reset the external degree counters */ /* ---------------------------------------------------------------------- */ E = Work->E ; max_mark = MAX_MARK (nn) ; if (!Work->pivcol_in_front) { /* clear the external column degrees. no more Usons of current front */ Work->cdeg0 += (nn + 1) ; if (Work->cdeg0 >= max_mark) { /* guard against integer overflow. This is very rare */ DEBUG1 (("Integer overflow, cdeg\n")) ; Work->cdeg0 = 1 ; #pragma ivdep for (e = 1 ; e <= Work->nel ; e++) { if (E [e]) { ep = (Element *) (Memory + E [e]) ; ep->cdeg = 0 ; } } } } if (!Work->pivrow_in_front) { /* clear the external row degrees. no more Lsons of current front */ Work->rdeg0 += (nn + 1) ; if (Work->rdeg0 >= max_mark) { /* guard against integer overflow. This is very rare */ DEBUG1 (("Integer overflow, rdeg\n")) ; Work->rdeg0 = 1 ; #pragma ivdep for (e = 1 ; e <= Work->nel ; e++) { if (E [e]) { ep = (Element *) (Memory + E [e]) ; ep->rdeg = 0 ; } } } } /* ---------------------------------------------------------------------- */ /* clear row/col offsets */ /* ---------------------------------------------------------------------- */ if (!Work->pivrow_in_front) { #pragma ivdep for (j = 0 ; j < fncols ; j++) { Fcpos [Fcols [j]] = EMPTY ; } } if (!Work->pivcol_in_front) { #pragma ivdep for (i = 0 ; i < fnrows ; i++) { Frpos [Frows [i]] = EMPTY ; } } if (fncols <= 0 || fnrows <= 0) { /* no element to create */ DEBUG2 (("Element evaporation\n")) ; Work->prior_element = EMPTY ; return (TRUE) ; } /* ---------------------------------------------------------------------- */ /* create element for later assembly */ /* ---------------------------------------------------------------------- */ #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 collection (create)\n")); } #endif needunits = 0 ; got_memory = FALSE ; eloc = UMF_mem_alloc_element (Numeric, fnrows, fncols, &Rows, &Cols, &C, &needunits, &ep) ; /* if UMF_get_memory needs to be called */ if (Work->do_grow) { /* full compaction of current frontal matrix, since UMF_grow_front will * be called next anyway. */ r2 = fnrows ; c2 = fncols ; do_Fcpos = FALSE ; } else { /* partial compaction. */ r2 = MAX (fnrows, Work->fnrows_new + 1) ; c2 = MAX (fncols, Work->fncols_new + 1) ; /* recompute Fcpos if pivot row is in the front */ do_Fcpos = Work->pivrow_in_front ; } if (!eloc) { /* Do garbage collection, realloc, and try again. */ /* Compact the current front if it needs to grow anyway. */ /* Note that there are no pivot rows or columns in the current front */ DEBUGm3 (("get_memory from umf_create_element, 1\n")) ; if (!UMF_get_memory (Numeric, Work, needunits, r2, c2, do_Fcpos)) { /* :: out of memory in umf_create_element (1) :: */ DEBUGm4 (("out of memory: create element (1)\n")) ; return (FALSE) ; /* out of memory */ } got_memory = TRUE ; Memory = Numeric->Memory ; eloc = UMF_mem_alloc_element (Numeric, fnrows, fncols, &Rows, &Cols, &C, &needunits, &ep) ; ASSERT (eloc >= 0) ; if (!eloc) { /* :: out of memory in umf_create_element (2) :: */ DEBUGm4 (("out of memory: create element (2)\n")) ; return (FALSE) ; /* out of memory */ } } e = ++(Work->nel) ; /* get the name of this new frontal matrix */ Work->prior_element = e ; DEBUG8 (("wrapup e "ID" nel "ID"\n", e, Work->nel)) ; ASSERT (e > 0 && e < Work->elen) ; ASSERT (E [e] == 0) ; E [e] = eloc ; if (Work->pivcol_in_front) { /* the new element is a Uson of the next frontal matrix */ ep->cdeg = Work->cdeg0 ; } if (Work->pivrow_in_front) { /* the new element is an Lson of the next frontal matrix */ ep->rdeg = Work->rdeg0 ; } /* ---------------------------------------------------------------------- */ /* copy frontal matrix into the new element */ /* ---------------------------------------------------------------------- */ #pragma ivdep for (i = 0 ; i < fnrows ; i++) { Rows [i] = Frows [i] ; } #pragma ivdep for (i = 0 ; i < fncols ; i++) { Cols [i] = Fcols [i] ; } Fcol = Work->Fcblock ; DEBUG0 (("copy front "ID" by "ID"\n", fnrows, fncols)) ; fnr_curr = Work->fnr_curr ; ASSERT (fnr_curr >= 0 && fnr_curr % 2 == 1) ; for (j = 0 ; j < fncols ; j++) { copy_column (fnrows, Fcol, C) ; Fcol += fnr_curr ; C += fnrows ; } DEBUG8 (("element copied\n")) ; /* ---------------------------------------------------------------------- */ /* add tuples for the new element */ /* ---------------------------------------------------------------------- */ tuple.e = e ; if (got_memory) { /* ------------------------------------------------------------------ */ /* UMF_get_memory ensures enough space exists for each new tuple */ /* ------------------------------------------------------------------ */ /* place (e,f) in the element list of each column */ for (tuple.f = 0 ; tuple.f < fncols ; tuple.f++) { col = Fcols [tuple.f] ; ASSERT (col >= 0 && col < n_col) ; ASSERT (NON_PIVOTAL_COL (col)) ; ASSERT (Col_tuples [col]) ; tp = ((Tuple *) (Memory + Col_tuples [col])) + Col_tlen [col]++ ; *tp = tuple ; } /* ------------------------------------------------------------------ */ /* place (e,f) in the element list of each row */ for (tuple.f = 0 ; tuple.f < fnrows ; tuple.f++) { row = Frows [tuple.f] ; ASSERT (row >= 0 && row < n_row) ; ASSERT (NON_PIVOTAL_ROW (row)) ; ASSERT (Row_tuples [row]) ; tp = ((Tuple *) (Memory + Row_tuples [row])) + Row_tlen [row]++ ; *tp = tuple ; } } else { /* ------------------------------------------------------------------ */ /* place (e,f) in the element list of each column */ /* ------------------------------------------------------------------ */ /* might not have enough space for each tuple */ for (tuple.f = 0 ; tuple.f < fncols ; tuple.f++) { col = Fcols [tuple.f] ; ASSERT (col >= 0 && col < n_col) ; ASSERT (NON_PIVOTAL_COL (col)) ; t1 = Col_tuples [col] ; DEBUG1 (("Placing on col:"ID" , tuples at "ID"\n", col, Col_tuples [col])) ; size = 0 ; len = 0 ; if (t1) { p = Memory + t1 ; tp = (Tuple *) p ; size = GET_BLOCK_SIZE (p) ; len = Col_tlen [col] ; tp2 = tp + len ; } needunits = UNITS (Tuple, len + 1) ; DEBUG1 (("len: "ID" size: "ID" needunits: "ID"\n", len, size, needunits)); if (needunits > size && t1) { /* prune the tuples */ tp1 = tp ; tp2 = tp ; tpend = tp + len ; for ( ; tp < tpend ; tp++) { e = tp->e ; ASSERT (e > 0 && e <= Work->nel) ; if (!E [e]) continue ; /* element already deallocated */ f = tp->f ; p = Memory + E [e] ; ep = (Element *) p ; p += UNITS (Element, 1) ; Cols = (Int *) p ; ; if (Cols [f] == EMPTY) continue ; /* already assembled */ ASSERT (col == Cols [f]) ; *tp2++ = *tp ; /* leave the tuple in the list */ } len = tp2 - tp1 ; Col_tlen [col] = len ; needunits = UNITS (Tuple, len + 1) ; } if (needunits > size) { /* no room exists - reallocate elsewhere */ DEBUG1 (("REALLOCATE Col: "ID", size "ID" to "ID"\n", col, size, 2*needunits)) ; #ifndef NDEBUG UMF_allocfail = FALSE ; if (UMF_gprob > 0) /* a double relop, but ignore NaN case */ { double rrr = ((double) (rand ( ))) / (((double) RAND_MAX) + 1) ; DEBUG1 (("Check random %e %e\n", rrr, UMF_gprob)) ; UMF_allocfail = rrr < UMF_gprob ; if (UMF_allocfail) DEBUGm2 (("Random gar. (col tuple)\n")) ; } #endif needunits = MIN (2*needunits, (Int) UNITS (Tuple, nn)) ; t2 = UMF_mem_alloc_tail_block (Numeric, needunits) ; if (!t2) { /* :: get memory in umf_create_element (1) :: */ /* get memory, reconstruct all tuple lists, and return */ /* Compact the current front if it needs to grow anyway. */ /* Note: no pivot rows or columns in the current front */ DEBUGm4 (("get_memory from umf_create_element, 1\n")) ; return (UMF_get_memory (Numeric, Work, 0, r2, c2,do_Fcpos)); } Col_tuples [col] = t2 ; tp2 = (Tuple *) (Memory + t2) ; if (t1) { for (i = 0 ; i < len ; i++) { *tp2++ = *tp1++ ; } UMF_mem_free_tail_block (Numeric, t1) ; } } /* place the new (e,f) tuple in the element list of the column */ Col_tlen [col]++ ; *tp2 = tuple ; } /* ------------------------------------------------------------------ */ /* place (e,f) in the element list of each row */ /* ------------------------------------------------------------------ */ for (tuple.f = 0 ; tuple.f < fnrows ; tuple.f++) { row = Frows [tuple.f] ; ASSERT (row >= 0 && row < n_row) ; ASSERT (NON_PIVOTAL_ROW (row)) ; t1 = Row_tuples [row] ; DEBUG1 (("Placing on row:"ID" , tuples at "ID"\n", row, Row_tuples [row])) ; size = 0 ; len = 0 ; if (t1) { p = Memory + t1 ; tp = (Tuple *) p ; size = GET_BLOCK_SIZE (p) ; len = Row_tlen [row] ; tp2 = tp + len ; } needunits = UNITS (Tuple, len + 1) ; DEBUG1 (("len: "ID" size: "ID" needunits: "ID"\n", len, size, needunits)) ; if (needunits > size && t1) { /* prune the tuples */ tp1 = tp ; tp2 = tp ; tpend = tp + len ; for ( ; tp < tpend ; tp++) { e = tp->e ; ASSERT (e > 0 && e <= Work->nel) ; if (!E [e]) { continue ; /* element already deallocated */ } f = tp->f ; p = Memory + E [e] ; ep = (Element *) p ; p += UNITS (Element, 1) ; Cols = (Int *) p ; Rows = Cols + (ep->ncols) ; if (Rows [f] == EMPTY) continue ; /* already assembled */ ASSERT (row == Rows [f]) ; *tp2++ = *tp ; /* leave the tuple in the list */ } len = tp2 - tp1 ; Row_tlen [row] = len ; needunits = UNITS (Tuple, len + 1) ; } if (needunits > size) { /* no room exists - reallocate elsewhere */ DEBUG1 (("REALLOCATE Row: "ID", size "ID" to "ID"\n", row, size, 2*needunits)) ; #ifndef NDEBUG UMF_allocfail = FALSE ; if (UMF_gprob > 0) /* a double relop, but ignore NaN case */ { double rrr = ((double) (rand ( ))) / (((double) RAND_MAX) + 1) ; DEBUG1 (("Check random %e %e\n", rrr, UMF_gprob)) ; UMF_allocfail = rrr < UMF_gprob ; if (UMF_allocfail) DEBUGm2 (("Random gar. (row tuple)\n")) ; } #endif needunits = MIN (2*needunits, (Int) UNITS (Tuple, nn)) ; t2 = UMF_mem_alloc_tail_block (Numeric, needunits) ; if (!t2) { /* :: get memory in umf_create_element (2) :: */ /* get memory, reconstruct all tuple lists, and return */ /* Compact the current front if it needs to grow anyway. */ /* Note: no pivot rows or columns in the current front */ DEBUGm4 (("get_memory from umf_create_element, 2\n")) ; return (UMF_get_memory (Numeric, Work, 0, r2, c2,do_Fcpos)); } Row_tuples [row] = t2 ; tp2 = (Tuple *) (Memory + t2) ; if (t1) { for (i = 0 ; i < len ; i++) { *tp2++ = *tp1++ ; } UMF_mem_free_tail_block (Numeric, t1) ; } } /* place the new (e,f) tuple in the element list of the row */ Row_tlen [row]++ ; *tp2 = tuple ; } } /* ---------------------------------------------------------------------- */ #ifndef NDEBUG DEBUG1 (("Done extending\nFINAL: element row pattern: len="ID"\n", fncols)); for (j = 0 ; j < fncols ; j++) DEBUG1 ((""ID"\n", Fcols [j])) ; DEBUG1 (("FINAL: element col pattern: len="ID"\n", fnrows)) ; for (j = 0 ; j < fnrows ; j++) DEBUG1 ((""ID"\n", Frows [j])) ; for (j = 0 ; j < fncols ; j++) { col = Fcols [j] ; ASSERT (col >= 0 && col < n_col) ; UMF_dump_rowcol (1, Numeric, Work, col, !Symbolic->fixQ) ; } for (j = 0 ; j < fnrows ; j++) { row = Frows [j] ; ASSERT (row >= 0 && row < n_row) ; UMF_dump_rowcol (0, Numeric, Work, row, TRUE) ; } if (n_row < 1000 && n_col < 1000) { UMF_dump_memory (Numeric) ; } DEBUG1 (("New element, after filling with stuff: "ID"\n", e)) ; UMF_dump_element (Numeric, Work, e, TRUE) ; if (nn < 1000) { DEBUG4 (("Matrix dump, after New element: "ID"\n", e)) ; UMF_dump_matrix (Numeric, Work, TRUE) ; } DEBUG3 (("FRONTAL WRAPUP DONE\n")) ; #endif return (TRUE) ; }