GLOBAL Int UMFPACK_get_determinant ( double *Mx, #ifdef COMPLEX double *Mz, #endif double *Ex, void *NumericHandle, double User_Info [UMFPACK_INFO] ) { /* ---------------------------------------------------------------------- */ /* local variables */ /* ---------------------------------------------------------------------- */ Entry d_mantissa, d_tmp ; double d_exponent, Info2 [UMFPACK_INFO], one [2] = {1.0, 0.0}, d_sign ; Entry *D ; double *Info, *Rs ; NumericType *Numeric ; Int i, n, itmp, npiv, *Wi, *Rperm, *Cperm, do_scale ; #ifndef NRECIPROCAL Int do_recip ; #endif /* ---------------------------------------------------------------------- */ /* check input parameters */ /* ---------------------------------------------------------------------- */ if (User_Info != (double *) NULL) { /* return Info in user's array */ Info = User_Info ; } else { /* no Info array passed - use local one instead */ Info = Info2 ; for (i = 0 ; i < UMFPACK_INFO ; i++) { Info [i] = EMPTY ; } } Info [UMFPACK_STATUS] = UMFPACK_OK ; Numeric = (NumericType *) NumericHandle ; if (!UMF_valid_numeric (Numeric)) { Info [UMFPACK_STATUS] = UMFPACK_ERROR_invalid_Numeric_object ; return (UMFPACK_ERROR_invalid_Numeric_object) ; } if (Numeric->n_row != Numeric->n_col) { /* only square systems can be handled */ Info [UMFPACK_STATUS] = UMFPACK_ERROR_invalid_system ; return (UMFPACK_ERROR_invalid_system) ; } if (Mx == (double *) NULL) { Info [UMFPACK_STATUS] = UMFPACK_ERROR_argument_missing ; return (UMFPACK_ERROR_argument_missing) ; } n = Numeric->n_row ; /* ---------------------------------------------------------------------- */ /* allocate workspace */ /* ---------------------------------------------------------------------- */ Wi = (Int *) UMF_malloc (n, sizeof (Int)) ; if (!Wi) { DEBUGm4 (("out of memory: get determinant\n")) ; Info [UMFPACK_STATUS] = UMFPACK_ERROR_out_of_memory ; return (UMFPACK_ERROR_out_of_memory) ; } /* ---------------------------------------------------------------------- */ /* compute the determinant */ /* ---------------------------------------------------------------------- */ Rs = Numeric->Rs ; /* row scale factors */ do_scale = (Rs != (double *) NULL) ; #ifndef NRECIPROCAL do_recip = Numeric->do_recip ; #endif d_mantissa = ((Entry *) one) [0] ; d_exponent = 0.0 ; D = Numeric->D ; /* compute product of diagonal entries of U */ for (i = 0 ; i < n ; i++) { MULT (d_tmp, d_mantissa, D [i]) ; d_mantissa = d_tmp ; if (!rescale_determinant (&d_mantissa, &d_exponent)) { /* the determinant is zero or NaN */ Info [UMFPACK_STATUS] = UMFPACK_WARNING_singular_matrix ; /* no need to compute the determinant of R */ do_scale = FALSE ; break ; } } /* compute product of diagonal entries of R (or its inverse) */ if (do_scale) { for (i = 0 ; i < n ; i++) { #ifndef NRECIPROCAL if (do_recip) { /* compute determinant of R inverse */ SCALE_DIV (d_mantissa, Rs [i]) ; } else #endif { /* compute determinant of R */ SCALE (d_mantissa, Rs [i]) ; } if (!rescale_determinant (&d_mantissa, &d_exponent)) { /* the determinant is zero or NaN. This is very unlikey to * occur here, since the scale factors for a tiny or zero row * are set to 1. */ Info [UMFPACK_STATUS] = UMFPACK_WARNING_singular_matrix ; break ; } } } /* ---------------------------------------------------------------------- */ /* determine if P and Q are odd or even permutations */ /* ---------------------------------------------------------------------- */ npiv = 0 ; Rperm = Numeric->Rperm ; for (i = 0 ; i < n ; i++) { Wi [i] = Rperm [i] ; } for (i = 0 ; i < n ; i++) { while (Wi [i] != i) { itmp = Wi [Wi [i]] ; Wi [Wi [i]] = Wi [i] ; Wi [i] = itmp ; npiv++ ; } } Cperm = Numeric->Cperm ; for (i = 0 ; i < n ; i++) { Wi [i] = Cperm [i] ; } for (i = 0 ; i < n ; i++) { while (Wi [i] != i) { itmp = Wi [Wi [i]] ; Wi [Wi [i]] = Wi [i] ; Wi [i] = itmp ; npiv++ ; } } /* if npiv is odd, the sign is -1. if it is even, the sign is +1 */ d_sign = (npiv % 2) ? -1. : 1. ; /* ---------------------------------------------------------------------- */ /* free workspace */ /* ---------------------------------------------------------------------- */ (void) UMF_free ((void *) Wi) ; /* ---------------------------------------------------------------------- */ /* compute the magnitude and exponent of the determinant */ /* ---------------------------------------------------------------------- */ if (Ex == (double *) NULL) { /* Ex is not provided, so return the entire determinant in d_mantissa */ SCALE (d_mantissa, pow (10.0, d_exponent)) ; } else { Ex [0] = d_exponent ; } Mx [0] = d_sign * REAL_COMPONENT (d_mantissa) ; #ifdef COMPLEX if (SPLIT (Mz)) { Mz [0] = d_sign * IMAG_COMPONENT (d_mantissa) ; } else { Mx [1] = d_sign * IMAG_COMPONENT (d_mantissa) ; } #endif /* determine if the determinant has (or will) overflow or underflow */ if (d_exponent + 1.0 > log10 (DBL_MAX)) { Info [UMFPACK_STATUS] = UMFPACK_WARNING_determinant_overflow ; } else if (d_exponent - 1.0 < log10 (DBL_MIN)) { Info [UMFPACK_STATUS] = UMFPACK_WARNING_determinant_underflow ; } return (UMFPACK_OK) ; }
PRIVATE void get_U ( Int Up [ ], /* of size n_col+1 */ Int Ui [ ], /* of size unz, where unz = Up [n_col] */ double Ux [ ], /* of size unz */ #ifdef COMPLEX double Uz [ ], /* of size unz */ #endif NumericType *Numeric, Int Pattern [ ], /* workspace of size n_col */ Int Wi [ ] /* workspace of size n_col */ ) { /* ---------------------------------------------------------------------- */ /* local variables */ /* ---------------------------------------------------------------------- */ Entry value ; Entry *xp, *D, *Uval ; Int deg, j, *ip, col, *Upos, *Uilen, *Uip, n_col, ulen, *Usi, unz2, p, k, up, newUchain, pos, npiv, n1 ; #ifdef COMPLEX Int split = SPLIT (Uz) ; #endif #ifndef NDEBUG Int nnzpiv = 0 ; #endif /* ---------------------------------------------------------------------- */ /* get parameters */ /* ---------------------------------------------------------------------- */ DEBUG4 (("get_U start:\n")) ; n_col = Numeric->n_col ; n1 = Numeric->n1 ; npiv = Numeric->npiv ; Upos = Numeric->Upos ; Uilen = Numeric->Uilen ; Uip = Numeric->Uip ; D = Numeric->D ; /* ---------------------------------------------------------------------- */ /* count the nonzeros in each column of U */ /* ---------------------------------------------------------------------- */ for (col = 0 ; col < npiv ; col++) { /* include the diagonal entry in the column counts */ DEBUG4 (("D ["ID"] = ", col)) ; EDEBUG4 (D [col]) ; Wi [col] = IS_NONZERO (D [col]) ; DEBUG4 ((" is nonzero: "ID"\n", Wi [col])) ; #ifndef NDEBUG nnzpiv += IS_NONZERO (D [col]) ; #endif } DEBUG4 (("nnzpiv "ID" "ID"\n", nnzpiv, Numeric->nnzpiv)) ; ASSERT (nnzpiv == Numeric->nnzpiv) ; for (col = npiv ; col < n_col ; col++) { /* diagonal entries are zero for structurally singular part */ Wi [col] = 0 ; } deg = Numeric->ulen ; if (deg > 0) { /* make last pivot row of U (singular matrices only) */ DEBUG0 (("Last pivot row of U: ulen "ID"\n", deg)) ; for (j = 0 ; j < deg ; j++) { Pattern [j] = Numeric->Upattern [j] ; DEBUG0 ((" column "ID"\n", Pattern [j])) ; } } /* non-singletons */ for (k = npiv-1 ; k >= n1 ; k--) { /* ------------------------------------------------------------------ */ /* use row k of U */ /* ------------------------------------------------------------------ */ up = Uip [k] ; ulen = Uilen [k] ; newUchain = (up < 0) ; if (newUchain) { up = -up ; xp = (Entry *) (Numeric->Memory + up + UNITS (Int, ulen)) ; } else { xp = (Entry *) (Numeric->Memory + up) ; } for (j = 0 ; j < deg ; j++) { DEBUG4 ((" k "ID" col "ID" value\n", k, Pattern [j])) ; col = Pattern [j] ; ASSERT (col >= 0 && col < n_col) ; value = *xp++ ; EDEBUG4 (value) ; DEBUG4 (("\n")) ; if (IS_NONZERO (value)) { Wi [col]++ ; } } /* ------------------------------------------------------------------ */ /* make row k-1 of U in Pattern [0..deg-1] */ /* ------------------------------------------------------------------ */ if (k == n1) break ; if (newUchain) { /* next row is a new Uchain */ deg = ulen ; DEBUG4 (("end of chain for row of U "ID" deg "ID"\n", k-1, deg)) ; ip = (Int *) (Numeric->Memory + up) ; for (j = 0 ; j < deg ; j++) { col = *ip++ ; DEBUG4 ((" k "ID" col "ID"\n", k-1, col)) ; ASSERT (k <= col) ; Pattern [j] = col ; } } else { deg -= ulen ; DEBUG4 (("middle of chain for row of U "ID" deg "ID"\n", k-1, deg)); ASSERT (deg >= 0) ; pos = Upos [k] ; if (pos != EMPTY) { /* add the pivot column */ DEBUG4 (("k "ID" add pivot entry at position "ID"\n", k, pos)) ; ASSERT (pos >= 0 && pos <= deg) ; Pattern [deg++] = Pattern [pos] ; Pattern [pos] = k ; } } } /* singletons */ for (k = n1 - 1 ; k >= 0 ; k--) { deg = Uilen [k] ; DEBUG4 (("Singleton k "ID"\n", k)) ; if (deg > 0) { up = Uip [k] ; Usi = (Int *) (Numeric->Memory + up) ; up += UNITS (Int, deg) ; Uval = (Entry *) (Numeric->Memory + up) ; for (j = 0 ; j < deg ; j++) { col = Usi [j] ; value = Uval [j] ; DEBUG4 ((" k "ID" col "ID" value", k, col)) ; EDEBUG4 (value) ; DEBUG4 (("\n")) ; if (IS_NONZERO (value)) { Wi [col]++ ; } } } } /* ---------------------------------------------------------------------- */ /* construct the final column form of U */ /* ---------------------------------------------------------------------- */ /* create the column pointers */ unz2 = 0 ; for (col = 0 ; col < n_col ; col++) { Up [col] = unz2 ; unz2 += Wi [col] ; } Up [n_col] = unz2 ; DEBUG1 (("Numeric->unz "ID" npiv "ID" nnzpiv "ID" unz2 "ID"\n", Numeric->unz, npiv, Numeric->nnzpiv, unz2)) ; ASSERT (Numeric->unz + Numeric->nnzpiv == unz2) ; for (col = 0 ; col < n_col ; col++) { Wi [col] = Up [col+1] ; } /* add all of the diagonal entries */ for (col = 0 ; col < npiv ; col++) { if (IS_NONZERO (D [col])) { p = --(Wi [col]) ; Ui [p] = col ; #ifdef COMPLEX if (split) { Ux [p] = REAL_COMPONENT (D [col]) ; Uz [p] = IMAG_COMPONENT (D [col]) ; } else { Ux [2*p ] = REAL_COMPONENT (D [col]) ; Ux [2*p+1] = IMAG_COMPONENT (D [col]) ; } #else Ux [p] = D [col] ; #endif } } /* add all the entries from the rows of U */ deg = Numeric->ulen ; if (deg > 0) { /* make last pivot row of U (singular matrices only) */ for (j = 0 ; j < deg ; j++) { Pattern [j] = Numeric->Upattern [j] ; } } /* non-singletons */ for (k = npiv-1 ; k >= n1 ; k--) { /* ------------------------------------------------------------------ */ /* use row k of U */ /* ------------------------------------------------------------------ */ up = Uip [k] ; ulen = Uilen [k] ; newUchain = (up < 0) ; if (newUchain) { up = -up ; xp = (Entry *) (Numeric->Memory + up + UNITS (Int, ulen)) ; } else { xp = (Entry *) (Numeric->Memory + up) ; } xp += deg ; for (j = deg-1 ; j >= 0 ; j--) { DEBUG4 ((" k "ID" col "ID" value", k, Pattern [j])) ; col = Pattern [j] ; ASSERT (col >= 0 && col < n_col) ; value = *(--xp) ; EDEBUG4 (value) ; DEBUG4 (("\n")) ; if (IS_NONZERO (value)) { p = --(Wi [col]) ; Ui [p] = k ; #ifdef COMPLEX if (split) { Ux [p] = REAL_COMPONENT (value) ; Uz [p] = IMAG_COMPONENT (value) ; } else { Ux [2*p ] = REAL_COMPONENT (value) ; Ux [2*p+1] = IMAG_COMPONENT (value) ; } #else Ux [p] = value ; #endif } } /* ------------------------------------------------------------------ */ /* make row k-1 of U in Pattern [0..deg-1] */ /* ------------------------------------------------------------------ */ if (newUchain) { /* next row is a new Uchain */ deg = ulen ; DEBUG4 (("end of chain for row of U "ID" deg "ID"\n", k-1, deg)) ; ip = (Int *) (Numeric->Memory + up) ; for (j = 0 ; j < deg ; j++) { col = *ip++ ; DEBUG4 ((" k "ID" col "ID"\n", k-1, col)) ; ASSERT (k <= col) ; Pattern [j] = col ; } } else { deg -= ulen ; DEBUG4 (("middle of chain for row of U "ID" deg "ID"\n", k-1, deg)); ASSERT (deg >= 0) ; pos = Upos [k] ; if (pos != EMPTY) { /* add the pivot column */ DEBUG4 (("k "ID" add pivot entry at position "ID"\n", k, pos)) ; ASSERT (pos >= 0 && pos <= deg) ; Pattern [deg++] = Pattern [pos] ; Pattern [pos] = k ; } } } /* singletons */ for (k = n1 - 1 ; k >= 0 ; k--) { deg = Uilen [k] ; DEBUG4 (("Singleton k "ID"\n", k)) ; if (deg > 0) { up = Uip [k] ; Usi = (Int *) (Numeric->Memory + up) ; up += UNITS (Int, deg) ; Uval = (Entry *) (Numeric->Memory + up) ; for (j = 0 ; j < deg ; j++) { col = Usi [j] ; value = Uval [j] ; DEBUG4 ((" k "ID" col "ID" value", k, col)) ; EDEBUG4 (value) ; DEBUG4 (("\n")) ; if (IS_NONZERO (value)) { p = --(Wi [col]) ; Ui [p] = k ; #ifdef COMPLEX if (split) { Ux [p] = REAL_COMPONENT (value) ; Uz [p] = IMAG_COMPONENT (value) ; } else { Ux [2*p ] = REAL_COMPONENT (value) ; Ux [2*p+1] = IMAG_COMPONENT (value) ; } #else Ux [p] = value ; #endif } } } } #ifndef NDEBUG DEBUG6 (("U matrix:")) ; UMF_dump_col_matrix (Ux, #ifdef COMPLEX Uz, #endif Ui, Up, Numeric->n_row, n_col, Numeric->unz + Numeric->nnzpiv) ; #endif }
PRIVATE void get_L ( Int Lp [ ], /* of size n_row+1 */ Int Lj [ ], /* of size lnz, where lnz = Lp [n_row] */ double Lx [ ], /* of size lnz */ #ifdef COMPLEX double Lz [ ], /* of size lnz */ #endif NumericType *Numeric, Int Pattern [ ], /* workspace of size n_row */ Int Wi [ ] /* workspace of size n_row */ ) { /* ---------------------------------------------------------------------- */ /* local variables */ /* ---------------------------------------------------------------------- */ Entry value ; Entry *xp, *Lval ; Int deg, *ip, j, row, n_row, n_col, n_inner, *Lpos, *Lilen, *Lip, p, llen, lnz2, lp, newLchain, k, pos, npiv, *Li, n1 ; #ifdef COMPLEX Int split = SPLIT (Lz) ; #endif /* ---------------------------------------------------------------------- */ /* get parameters */ /* ---------------------------------------------------------------------- */ DEBUG4 (("get_L start:\n")) ; n_row = Numeric->n_row ; n_col = Numeric->n_col ; n_inner = MIN (n_row, n_col) ; npiv = Numeric->npiv ; n1 = Numeric->n1 ; Lpos = Numeric->Lpos ; Lilen = Numeric->Lilen ; Lip = Numeric->Lip ; deg = 0 ; /* ---------------------------------------------------------------------- */ /* count the nonzeros in each row of L */ /* ---------------------------------------------------------------------- */ #pragma ivdep for (row = 0 ; row < n_inner ; row++) { /* include the diagonal entry in the row counts */ Wi [row] = 1 ; } #pragma ivdep for (row = n_inner ; row < n_row ; row++) { Wi [row] = 0 ; } /* singletons */ for (k = 0 ; k < n1 ; k++) { DEBUG4 (("Singleton k "ID"\n", k)) ; deg = Lilen [k] ; if (deg > 0) { lp = Lip [k] ; Li = (Int *) (Numeric->Memory + lp) ; lp += UNITS (Int, deg) ; Lval = (Entry *) (Numeric->Memory + lp) ; for (j = 0 ; j < deg ; j++) { row = Li [j] ; value = Lval [j] ; DEBUG4 ((" row "ID" k "ID" value", row, k)) ; EDEBUG4 (value) ; DEBUG4 (("\n")) ; if (IS_NONZERO (value)) { Wi [row]++ ; } } } } /* non-singletons */ for (k = n1 ; k < npiv ; k++) { /* ------------------------------------------------------------------ */ /* make column of L in Pattern [0..deg-1] */ /* ------------------------------------------------------------------ */ lp = Lip [k] ; newLchain = (lp < 0) ; if (newLchain) { lp = -lp ; deg = 0 ; DEBUG4 (("start of chain for column of L\n")) ; } /* remove pivot row */ pos = Lpos [k] ; if (pos != EMPTY) { DEBUG4 ((" k "ID" removing row "ID" at position "ID"\n", k, Pattern [pos], pos)) ; ASSERT (!newLchain) ; ASSERT (deg > 0) ; ASSERT (pos >= 0 && pos < deg) ; ASSERT (Pattern [pos] == k) ; Pattern [pos] = Pattern [--deg] ; } /* concatenate the pattern */ ip = (Int *) (Numeric->Memory + lp) ; llen = Lilen [k] ; for (j = 0 ; j < llen ; j++) { row = *ip++ ; DEBUG4 ((" row "ID" k "ID"\n", row, k)) ; ASSERT (row > k && row < n_row) ; Pattern [deg++] = row ; } xp = (Entry *) (Numeric->Memory + lp + UNITS (Int, llen)) ; for (j = 0 ; j < deg ; j++) { DEBUG4 ((" row "ID" k "ID" value", Pattern [j], k)) ; row = Pattern [j] ; value = *xp++ ; EDEBUG4 (value) ; DEBUG4 (("\n")) ; if (IS_NONZERO (value)) { Wi [row]++ ; } } } /* ---------------------------------------------------------------------- */ /* construct the final row form of L */ /* ---------------------------------------------------------------------- */ /* create the row pointers */ lnz2 = 0 ; for (row = 0 ; row < n_row ; row++) { Lp [row] = lnz2 ; lnz2 += Wi [row] ; Wi [row] = Lp [row] ; } Lp [n_row] = lnz2 ; ASSERT (Numeric->lnz + n_inner == lnz2) ; /* add entries from the rows of L (singletons) */ for (k = 0 ; k < n1 ; k++) { DEBUG4 (("Singleton k "ID"\n", k)) ; deg = Lilen [k] ; if (deg > 0) { lp = Lip [k] ; Li = (Int *) (Numeric->Memory + lp) ; lp += UNITS (Int, deg) ; Lval = (Entry *) (Numeric->Memory + lp) ; for (j = 0 ; j < deg ; j++) { row = Li [j] ; value = Lval [j] ; DEBUG4 ((" row "ID" k "ID" value", row, k)) ; EDEBUG4 (value) ; DEBUG4 (("\n")) ; if (IS_NONZERO (value)) { p = Wi [row]++ ; Lj [p] = k ; #ifdef COMPLEX if (split) { Lx [p] = REAL_COMPONENT (value) ; Lz [p] = IMAG_COMPONENT (value) ; } else { Lx [2*p ] = REAL_COMPONENT (value) ; Lx [2*p+1] = IMAG_COMPONENT (value) ; } #else Lx [p] = value ; #endif } } } } /* add entries from the rows of L (non-singletons) */ for (k = n1 ; k < npiv ; k++) { /* ------------------------------------------------------------------ */ /* make column of L in Pattern [0..deg-1] */ /* ------------------------------------------------------------------ */ lp = Lip [k] ; newLchain = (lp < 0) ; if (newLchain) { lp = -lp ; deg = 0 ; DEBUG4 (("start of chain for column of L\n")) ; } /* remove pivot row */ pos = Lpos [k] ; if (pos != EMPTY) { DEBUG4 ((" k "ID" removing row "ID" at position "ID"\n", k, Pattern [pos], pos)) ; ASSERT (!newLchain) ; ASSERT (deg > 0) ; ASSERT (pos >= 0 && pos < deg) ; ASSERT (Pattern [pos] == k) ; Pattern [pos] = Pattern [--deg] ; } /* concatenate the pattern */ ip = (Int *) (Numeric->Memory + lp) ; llen = Lilen [k] ; for (j = 0 ; j < llen ; j++) { row = *ip++ ; DEBUG4 ((" row "ID" k "ID"\n", row, k)) ; ASSERT (row > k) ; Pattern [deg++] = row ; } xp = (Entry *) (Numeric->Memory + lp + UNITS (Int, llen)) ; for (j = 0 ; j < deg ; j++) { DEBUG4 ((" row "ID" k "ID" value", Pattern [j], k)) ; row = Pattern [j] ; value = *xp++ ; EDEBUG4 (value) ; DEBUG4 (("\n")) ; if (IS_NONZERO (value)) { p = Wi [row]++ ; Lj [p] = k ; #ifdef COMPLEX if (split) { Lx [p] = REAL_COMPONENT (value) ; Lz [p] = IMAG_COMPONENT (value) ; } else { Lx [2*p ] = REAL_COMPONENT (value) ; Lx [2*p+1] = IMAG_COMPONENT (value) ; } #else Lx [p] = value ; #endif } } } /* add all of the diagonal entries (L is unit diagonal) */ for (row = 0 ; row < n_inner ; row++) { p = Wi [row]++ ; Lj [p] = row ; #ifdef COMPLEX if (split) { Lx [p] = 1. ; Lz [p] = 0. ; } else { Lx [2*p ] = 1. ; Lx [2*p+1] = 0. ; } #else Lx [p] = 1. ; #endif ASSERT (Wi [row] == Lp [row+1]) ; } #ifndef NDEBUG DEBUG6 (("L matrix (stored by rows):")) ; UMF_dump_col_matrix (Lx, #ifdef COMPLEX Lz, #endif Lj, Lp, n_inner, n_row, Numeric->lnz+n_inner) ; #endif DEBUG4 (("get_L done:\n")) ; }
GLOBAL Int UMFPACK_get_numeric ( Int Lp [ ], Int Lj [ ], double Lx [ ], #ifdef COMPLEX double Lz [ ], #endif Int Up [ ], Int Ui [ ], double Ux [ ], #ifdef COMPLEX double Uz [ ], #endif Int P [ ], Int Q [ ], double Dx [ ], #ifdef COMPLEX double Dz [ ], #endif Int *p_do_recip, double Rs [ ], void *NumericHandle ) { /* ---------------------------------------------------------------------- */ /* local variables */ /* ---------------------------------------------------------------------- */ NumericType *Numeric ; Int getL, getU, *Rperm, *Cperm, k, nn, n_row, n_col, *Wi, *Pattern, n_inner ; double *Rs1 ; Entry *D ; #ifndef NDEBUG init_count = UMF_malloc_count ; #endif Wi = (Int *) NULL ; Pattern = (Int *) NULL ; /* ---------------------------------------------------------------------- */ /* check input parameters */ /* ---------------------------------------------------------------------- */ Numeric = (NumericType *) NumericHandle ; if (!UMF_valid_numeric (Numeric)) { return (UMFPACK_ERROR_invalid_Numeric_object) ; } n_row = Numeric->n_row ; n_col = Numeric->n_col ; nn = MAX (n_row, n_col) ; n_inner = MIN (n_row, n_col) ; /* ---------------------------------------------------------------------- */ /* allocate workspace */ /* ---------------------------------------------------------------------- */ getL = Lp && Lj && Lx ; getU = Up && Ui && Ux ; if (getL || getU) { Wi = (Int *) UMF_malloc (nn, sizeof (Int)) ; Pattern = (Int *) UMF_malloc (nn, sizeof (Int)) ; if (!Wi || !Pattern) { (void) UMF_free ((void *) Wi) ; (void) UMF_free ((void *) Pattern) ; ASSERT (UMF_malloc_count == init_count) ; DEBUGm4 (("out of memory: get numeric\n")) ; return (UMFPACK_ERROR_out_of_memory) ; } ASSERT (UMF_malloc_count == init_count + 2) ; } /* ---------------------------------------------------------------------- */ /* get contents of Numeric */ /* ---------------------------------------------------------------------- */ if (P != (Int *) NULL) { Rperm = Numeric->Rperm ; for (k = 0 ; k < n_row ; k++) { P [k] = Rperm [k] ; } } if (Q != (Int *) NULL) { Cperm = Numeric->Cperm ; for (k = 0 ; k < n_col ; k++) { Q [k] = Cperm [k] ; } } if (getL) { get_L (Lp, Lj, Lx, #ifdef COMPLEX Lz, #endif Numeric, Pattern, Wi) ; } if (getU) { get_U (Up, Ui, Ux, #ifdef COMPLEX Uz, #endif Numeric, Pattern, Wi) ; } if (Dx != (double *) NULL) { D = Numeric->D ; #ifdef COMPLEX if (SPLIT (Dz)) { for (k = 0 ; k < n_inner ; k++) { Dx [k] = REAL_COMPONENT (D [k]) ; Dz [k] = IMAG_COMPONENT (D [k]) ; } } else { for (k = 0 ; k < n_inner ; k++) { Dx [2*k ] = REAL_COMPONENT (D [k]) ; Dx [2*k+1] = IMAG_COMPONENT (D [k]) ; } } #else { D = Numeric->D ; for (k = 0 ; k < n_inner ; k++) { Dx [k] = D [k] ; } } #endif } /* return the flag stating whether the scale factors are to be multiplied, * or divided. If do_recip is TRUE, multiply. Otherwise, divided. * If NRECIPROCAL is defined at compile time, the scale factors are always * to be used by dividing. */ if (p_do_recip != (Int *) NULL) { #ifndef NRECIPROCAL *p_do_recip = Numeric->do_recip ; #else *p_do_recip = FALSE ; #endif } if (Rs != (double *) NULL) { Rs1 = Numeric->Rs ; if (Rs1 == (double *) NULL) { /* R is the identity matrix. */ for (k = 0 ; k < n_row ; k++) { Rs [k] = 1.0 ; } } else { for (k = 0 ; k < n_row ; k++) { Rs [k] = Rs1 [k] ; } } } /* ---------------------------------------------------------------------- */ /* free the workspace */ /* ---------------------------------------------------------------------- */ (void) UMF_free ((void *) Wi) ; (void) UMF_free ((void *) Pattern) ; ASSERT (UMF_malloc_count == init_count) ; return (UMFPACK_OK) ; }
GLOBAL Int UMF_solve ( Int sys, const Int Ap [ ], const Int Ai [ ], const double Ax [ ], double Xx [ ], const double Bx [ ], #ifdef COMPLEX const double Az [ ], double Xz [ ], const double Bz [ ], #endif NumericType *Numeric, Int irstep, double Info [UMFPACK_INFO], Int Pattern [ ], /* size n */ double SolveWork [ ] /* if irstep>0 real: size 5*n. complex:10*n */ /* otherwise real: size n. complex: 4*n */ ) { /* ---------------------------------------------------------------------- */ /* local variables */ /* ---------------------------------------------------------------------- */ Entry axx, wi, xj, zi, xi, aij, bi ; double omega [3], d, z2i, yi, flops ; Entry *W, *Z, *S, *X ; double *Z2, *Y, *B2, *Rs ; Int *Rperm, *Cperm, i, n, p, step, j, nz, status, p2, do_scale ; #ifdef COMPLEX Int AXsplit ; Int Bsplit ; #endif #ifndef NRECIPROCAL Int do_recip = Numeric->do_recip ; #endif /* ---------------------------------------------------------------------- */ /* initializations */ /* ---------------------------------------------------------------------- */ #ifndef NDEBUG UMF_dump_lu (Numeric) ; ASSERT (Numeric && Xx && Bx && Pattern && SolveWork && Info) ; #endif nz = 0 ; omega [0] = 0. ; omega [1] = 0. ; omega [2] = 0. ; Rperm = Numeric->Rperm ; Cperm = Numeric->Cperm ; Rs = Numeric->Rs ; /* row scale factors */ do_scale = (Rs != (double *) NULL) ; flops = 0 ; Info [UMFPACK_SOLVE_FLOPS] = 0 ; Info [UMFPACK_IR_TAKEN] = 0 ; Info [UMFPACK_IR_ATTEMPTED] = 0 ; /* UMFPACK_solve does not call this routine if A is rectangular */ ASSERT (Numeric->n_row == Numeric->n_col) ; n = Numeric->n_row ; if (Numeric->nnzpiv < n || SCALAR_IS_ZERO (Numeric->rcond) || SCALAR_IS_NAN (Numeric->rcond)) { /* Note that systems involving just L return UMFPACK_OK, even if */ /* A is singular (L is always has a unit diagonal). */ DEBUGm4 (("Note, matrix is singular in umf_solve\n")) ; status = UMFPACK_WARNING_singular_matrix ; irstep = 0 ; } else { status = UMFPACK_OK ; } irstep = MAX (0, irstep) ; /* make sure irstep is >= 0 */ W = (Entry *) SolveWork ; /* Entry W [0..n-1] */ Z = (Entry *) NULL ; /* unused if no iterative refinement */ S = (Entry *) NULL ; Y = (double *) NULL ; Z2 = (double *) NULL ; B2 = (double *) NULL ; #ifdef COMPLEX if (irstep > 0) { if (!Ap || !Ai || !Ax) { return (UMFPACK_ERROR_argument_missing) ; } /* A, B, and X in split format if Az, Bz, and Xz present */ AXsplit = SPLIT (Az) || SPLIT(Xz); Z = (Entry *) (SolveWork + 4*n) ; /* Entry Z [0..n-1] */ S = (Entry *) (SolveWork + 6*n) ; /* Entry S [0..n-1] */ Y = (double *) (SolveWork + 8*n) ; /* double Y [0..n-1] */ B2 = (double *) (SolveWork + 9*n) ; /* double B2 [0..n-1] */ Z2 = (double *) Z ; /* double Z2 [0..n-1], equiv. to Z */ } else { /* A is ignored, only look at X for split/packed cases */ AXsplit = SPLIT(Xz); } Bsplit = SPLIT (Bz); if (AXsplit) { X = (Entry *) (SolveWork + 2*n) ; /* Entry X [0..n-1] */ } else { X = (Entry *) Xx ; /* Entry X [0..n-1] */ } #else X = (Entry *) Xx ; /* Entry X [0..n-1] */ if (irstep > 0) { if (!Ap || !Ai || !Ax) { return (UMFPACK_ERROR_argument_missing) ; } Z = (Entry *) (SolveWork + n) ; /* Entry Z [0..n-1] */ S = (Entry *) (SolveWork + 2*n) ; /* Entry S [0..n-1] */ Y = (double *) (SolveWork + 3*n) ; /* double Y [0..n-1] */ B2 = (double *) (SolveWork + 4*n) ; /* double B2 [0..n-1] */ Z2 = (double *) Z ; /* double Z2 [0..n-1], equiv. to Z */ } #endif /* ---------------------------------------------------------------------- */ /* determine which system to solve */ /* ---------------------------------------------------------------------- */ if (sys == UMFPACK_A) { /* ------------------------------------------------------------------ */ /* solve A x = b with optional iterative refinement */ /* ------------------------------------------------------------------ */ if (irstep > 0) { /* -------------------------------------------------------------- */ /* using iterative refinement: compute Y and B2 */ /* -------------------------------------------------------------- */ nz = Ap [n] ; Info [UMFPACK_NZ] = nz ; /* A is stored by column */ /* Y (i) = ||R A_i||, 1-norm of row i of R A */ for (i = 0 ; i < n ; i++) { Y [i] = 0. ; } flops += (ABS_FLOPS + 1) * nz ; p2 = Ap [n] ; for (p = 0 ; p < p2 ; p++) { /* Y [Ai [p]] += ABS (Ax [p]) ; */ ASSIGN (aij, Ax, Az, p, AXsplit) ; ABS (d, aij) ; Y [Ai [p]] += d ; } /* B2 = abs (B) */ flops += ABS_FLOPS * n ; for (i = 0 ; i < n ; i++) { /* B2 [i] = ABS (B [i]) ; */ ASSIGN (bi, Bx, Bz, i, Bsplit) ; ABS (B2 [i], bi) ; } /* scale Y and B2. */ if (do_scale) { /* Y = R Y */ /* B2 = R B2 */ #ifndef NRECIPROCAL if (do_recip) { /* multiply by the scale factors */ for (i = 0 ; i < n ; i++) { Y [i] *= Rs [i] ; B2 [i] *= Rs [i] ; } } else #endif { /* divide by the scale factors */ for (i = 0 ; i < n ; i++) { Y [i] /= Rs [i] ; B2 [i] /= Rs [i] ; } } flops += 2 * n ; } } for (step = 0 ; step <= irstep ; step++) { /* -------------------------------------------------------------- */ /* Solve A x = b (step 0): */ /* x = Q (U \ (L \ (P R b))) */ /* and then perform iterative refinement (step > 0): */ /* x = x + Q (U \ (L \ (P R (b - A x)))) */ /* -------------------------------------------------------------- */ if (step == 0) { if (do_scale) { /* W = P R b, using X as workspace, since Z is not * allocated if irstep = 0. */ #ifndef NRECIPROCAL if (do_recip) { /* multiply by the scale factors */ for (i = 0 ; i < n ; i++) { ASSIGN (X [i], Bx, Bz, i, Bsplit) ; SCALE (X [i], Rs [i]) ; } } else #endif { /* divide by the scale factors */ for (i = 0 ; i < n ; i++) { ASSIGN (X [i], Bx, Bz, i, Bsplit) ; SCALE_DIV (X [i], Rs [i]) ; } } flops += SCALE_FLOPS * n ; for (i = 0 ; i < n ; i++) { W [i] = X [Rperm [i]] ; } } else { /* W = P b, since the row scaling R = I */ for (i = 0 ; i < n ; i++) { /* W [i] = B [Rperm [i]] ; */ ASSIGN (W [i], Bx, Bz, Rperm [i], Bsplit) ; } } } else { for (i = 0 ; i < n ; i++) { /* Z [i] = B [i] ; */ ASSIGN (Z [i], Bx, Bz, i, Bsplit) ; } flops += MULTSUB_FLOPS * nz ; for (i = 0 ; i < n ; i++) { xi = X [i] ; p2 = Ap [i+1] ; for (p = Ap [i] ; p < p2 ; p++) { /* Z [Ai [p]] -= Ax [p] * xi ; */ ASSIGN (aij, Ax, Az, p, AXsplit) ; MULT_SUB (Z [Ai [p]], aij, xi) ; } } /* scale, Z = R Z */ if (do_scale) { #ifndef NRECIPROCAL if (do_recip) { /* multiply by the scale factors */ for (i = 0 ; i < n ; i++) { SCALE (Z [i], Rs [i]) ; } } else #endif { /* divide by the scale factors */ for (i = 0 ; i < n ; i++) { SCALE_DIV (Z [i], Rs [i]) ; } } flops += SCALE_FLOPS * n ; } for (i = 0 ; i < n ; i++) { W [i] = Z [Rperm [i]] ; } } flops += UMF_lsolve (Numeric, W, Pattern) ; flops += UMF_usolve (Numeric, W, Pattern) ; if (step == 0) { for (i = 0 ; i < n ; i++) { X [Cperm [i]] = W [i] ; } } else { flops += ASSEMBLE_FLOPS * n ; for (i = 0 ; i < n ; i++) { /* X [Cperm [i]] += W [i] ; */ ASSEMBLE (X [Cperm [i]], W [i]) ; } } /* -------------------------------------------------------------- */ /* sparse backward error estimate */ /* -------------------------------------------------------------- */ if (irstep > 0) { /* ---------------------------------------------------------- */ /* A is stored by column */ /* W (i) = R (b - A x)_i, residual */ /* Z2 (i) = R (|A||x|)_i */ /* ---------------------------------------------------------- */ for (i = 0 ; i < n ; i++) { /* W [i] = B [i] ; */ ASSIGN (W [i], Bx, Bz, i, Bsplit) ; Z2 [i] = 0. ; } flops += (MULT_FLOPS + DECREMENT_FLOPS + ABS_FLOPS + 1) * nz ; for (j = 0 ; j < n ; j++) { xj = X [j] ; p2 = Ap [j+1] ; for (p = Ap [j] ; p < p2 ; p++) { i = Ai [p] ; /* axx = Ax [p] * xj ; */ ASSIGN (aij, Ax, Az, p, AXsplit) ; MULT (axx, aij, xj) ; /* W [i] -= axx ; */ DECREMENT (W [i], axx) ; /* Z2 [i] += ABS (axx) ; */ ABS (d, axx) ; Z2 [i] += d ; } } /* scale W and Z2 */ if (do_scale) { /* Z2 = R Z2 */ /* W = R W */ #ifndef NRECIPROCAL if (do_recip) { /* multiply by the scale factors */ for (i = 0 ; i < n ; i++) { SCALE (W [i], Rs [i]) ; Z2 [i] *= Rs [i] ; } } else #endif { /* divide by the scale factors */ for (i = 0 ; i < n ; i++) { SCALE_DIV (W [i], Rs [i]) ; Z2 [i] /= Rs [i] ; } } flops += (SCALE_FLOPS + 1) * n ; } flops += (2*ABS_FLOPS + 5) * n ; if (do_step (omega, step, B2, X, W, Y, Z2, S, n, Info)) { /* iterative refinement is done */ break ; } } } } else if (sys == UMFPACK_At) { /* ------------------------------------------------------------------ */ /* solve A' x = b with optional iterative refinement */ /* ------------------------------------------------------------------ */ /* A' is the complex conjugate transpose */ if (irstep > 0) { /* -------------------------------------------------------------- */ /* using iterative refinement: compute Y */ /* -------------------------------------------------------------- */ nz = Ap [n] ; Info [UMFPACK_NZ] = nz ; /* A' is stored by row */ /* Y (i) = ||(A' R)_i||, 1-norm of row i of A' R */ if (do_scale) { flops += (ABS_FLOPS + 2) * nz ; #ifndef NRECIPROCAL if (do_recip) { /* multiply by the scale factors */ for (i = 0 ; i < n ; i++) { yi = 0. ; p2 = Ap [i+1] ; for (p = Ap [i] ; p < p2 ; p++) { /* yi += ABS (Ax [p]) * Rs [Ai [p]] ; */ /* note that abs (aij) is the same as * abs (conj (aij)) */ ASSIGN (aij, Ax, Az, p, AXsplit) ; ABS (d, aij) ; yi += (d * Rs [Ai [p]]) ; } Y [i] = yi ; } } else #endif { /* divide by the scale factors */ for (i = 0 ; i < n ; i++) { yi = 0. ; p2 = Ap [i+1] ; for (p = Ap [i] ; p < p2 ; p++) { /* yi += ABS (Ax [p]) / Rs [Ai [p]] ; */ /* note that abs (aij) is the same as * abs (conj (aij)) */ ASSIGN (aij, Ax, Az, p, AXsplit) ; ABS (d, aij) ; yi += (d / Rs [Ai [p]]) ; } Y [i] = yi ; } } } else { /* no scaling */ flops += (ABS_FLOPS + 1) * nz ; for (i = 0 ; i < n ; i++) { yi = 0. ; p2 = Ap [i+1] ; for (p = Ap [i] ; p < p2 ; p++) { /* yi += ABS (Ax [p]) ; */ /* note that abs (aij) is the same as * abs (conj (aij)) */ ASSIGN (aij, Ax, Az, p, AXsplit) ; ABS (d, aij) ; yi += d ; } Y [i] = yi ; } } /* B2 = abs (B) */ for (i = 0 ; i < n ; i++) { /* B2 [i] = ABS (B [i]) ; */ ASSIGN (bi, Bx, Bz, i, Bsplit) ; ABS (B2 [i], bi) ; } } for (step = 0 ; step <= irstep ; step++) { /* -------------------------------------------------------------- */ /* Solve A' x = b (step 0): */ /* x = R P' (L' \ (U' \ (Q' b))) */ /* and then perform iterative refinement (step > 0): */ /* x = x + R P' (L' \ (U' \ (Q' (b - A' x)))) */ /* -------------------------------------------------------------- */ if (step == 0) { /* W = Q' b */ for (i = 0 ; i < n ; i++) { /* W [i] = B [Cperm [i]] ; */ ASSIGN (W [i], Bx, Bz, Cperm [i], Bsplit) ; } } else { /* Z = b - A' x */ for (i = 0 ; i < n ; i++) { /* Z [i] = B [i] ; */ ASSIGN (Z [i], Bx, Bz, i, Bsplit) ; } flops += MULTSUB_FLOPS * nz ; for (i = 0 ; i < n ; i++) { zi = Z [i] ; p2 = Ap [i+1] ; for (p = Ap [i] ; p < p2 ; p++) { /* zi -= conjugate (Ax [p]) * X [Ai [p]] ; */ ASSIGN (aij, Ax, Az, p, Bsplit) ; MULT_SUB_CONJ (zi, X [Ai [p]], aij) ; } Z [i] = zi ; } /* W = Q' Z */ for (i = 0 ; i < n ; i++) { W [i] = Z [Cperm [i]] ; } } flops += UMF_uhsolve (Numeric, W, Pattern) ; flops += UMF_lhsolve (Numeric, W, Pattern) ; if (step == 0) { /* X = R P' W */ /* do not use Z, since it isn't allocated if irstep = 0 */ /* X = P' W */ for (i = 0 ; i < n ; i++) { X [Rperm [i]] = W [i] ; } if (do_scale) { /* X = R X */ #ifndef NRECIPROCAL if (do_recip) { /* multiply by the scale factors */ for (i = 0 ; i < n ; i++) { SCALE (X [i], Rs [i]) ; } } else #endif { /* divide by the scale factors */ for (i = 0 ; i < n ; i++) { SCALE_DIV (X [i], Rs [i]) ; } } flops += SCALE_FLOPS * n ; } } else { /* Z = P' W */ for (i = 0 ; i < n ; i++) { Z [Rperm [i]] = W [i] ; } if (do_scale) { /* Z = R Z */ #ifndef NRECIPROCAL if (do_recip) { /* multiply by the scale factors */ for (i = 0 ; i < n ; i++) { SCALE (Z [i], Rs [i]) ; } } else #endif { /* divide by the scale factors */ for (i = 0 ; i < n ; i++) { SCALE_DIV (Z [i], Rs [i]) ; } } flops += SCALE_FLOPS * n ; } flops += ASSEMBLE_FLOPS * n ; /* X += Z */ for (i = 0 ; i < n ; i++) { /* X [i] += Z [i] ; was +=W[i] in v4.3, which is wrong */ ASSEMBLE (X [i], Z [i]) ; /* bug fix, v4.3.1 */ } } /* -------------------------------------------------------------- */ /* sparse backward error estimate */ /* -------------------------------------------------------------- */ if (irstep > 0) { /* ---------------------------------------------------------- */ /* A' is stored by row */ /* W (i) = (b - A' x)_i, residual */ /* Z2 (i) = (|A'||x|)_i */ /* ---------------------------------------------------------- */ flops += (MULT_FLOPS + DECREMENT_FLOPS + ABS_FLOPS + 1) * nz ; for (i = 0 ; i < n ; i++) { /* wi = B [i] ; */ ASSIGN (wi, Bx, Bz, i, Bsplit) ; z2i = 0. ; p2 = Ap [i+1] ; for (p = Ap [i] ; p < p2 ; p++) { /* axx = conjugate (Ax [p]) * X [Ai [p]] ; */ ASSIGN (aij, Ax, Az, p, AXsplit) ; MULT_CONJ (axx, X [Ai [p]], aij) ; /* wi -= axx ; */ DECREMENT (wi, axx) ; /* z2i += ABS (axx) ; */ ABS (d, axx) ; z2i += d ; } W [i] = wi ; Z2 [i] = z2i ; } flops += (2*ABS_FLOPS + 5) * n ; if (do_step (omega, step, B2, X, W, Y, Z2, S, n, Info)) { /* iterative refinement is done */ break ; } } } } else if (sys == UMFPACK_Aat) { /* ------------------------------------------------------------------ */ /* solve A.' x = b with optional iterative refinement */ /* ------------------------------------------------------------------ */ /* A' is the array transpose */ if (irstep > 0) { /* -------------------------------------------------------------- */ /* using iterative refinement: compute Y */ /* -------------------------------------------------------------- */ nz = Ap [n] ; Info [UMFPACK_NZ] = nz ; /* A.' is stored by row */ /* Y (i) = ||(A.' R)_i||, 1-norm of row i of A.' R */ if (do_scale) { flops += (ABS_FLOPS + 2) * nz ; #ifndef NRECIPROCAL if (do_recip) { /* multiply by the scale factors */ for (i = 0 ; i < n ; i++) { yi = 0. ; p2 = Ap [i+1] ; for (p = Ap [i] ; p < p2 ; p++) { /* yi += ABS (Ax [p]) * Rs [Ai [p]] ; */ /* note that A.' is the array transpose, * so no conjugate */ ASSIGN (aij, Ax, Az, p, AXsplit) ; ABS (d, aij) ; yi += (d * Rs [Ai [p]]) ; } Y [i] = yi ; } } else #endif { /* divide by the scale factors */ for (i = 0 ; i < n ; i++) { yi = 0. ; p2 = Ap [i+1] ; for (p = Ap [i] ; p < p2 ; p++) { /* yi += ABS (Ax [p]) / Rs [Ai [p]] ; */ /* note that A.' is the array transpose, * so no conjugate */ ASSIGN (aij, Ax, Az, p, AXsplit) ; ABS (d, aij) ; yi += (d / Rs [Ai [p]]) ; } Y [i] = yi ; } } } else { /* no scaling */ flops += (ABS_FLOPS + 1) * nz ; for (i = 0 ; i < n ; i++) { yi = 0. ; p2 = Ap [i+1] ; for (p = Ap [i] ; p < p2 ; p++) { /* yi += ABS (Ax [p]) */ /* note that A.' is the array transpose, * so no conjugate */ ASSIGN (aij, Ax, Az, p, AXsplit) ; ABS (d, aij) ; yi += d ; } Y [i] = yi ; } } /* B2 = abs (B) */ for (i = 0 ; i < n ; i++) { /* B2 [i] = ABS (B [i]) ; */ ASSIGN (bi, Bx, Bz, i, Bsplit) ; ABS (B2 [i], bi) ; } } for (step = 0 ; step <= irstep ; step++) { /* -------------------------------------------------------------- */ /* Solve A.' x = b (step 0): */ /* x = R P' (L.' \ (U.' \ (Q' b))) */ /* and then perform iterative refinement (step > 0): */ /* x = x + R P' (L.' \ (U.' \ (Q' (b - A.' x)))) */ /* -------------------------------------------------------------- */ if (step == 0) { /* W = Q' b */ for (i = 0 ; i < n ; i++) { /* W [i] = B [Cperm [i]] ; */ ASSIGN (W [i], Bx, Bz, Cperm [i], Bsplit) ; } } else { /* Z = b - A.' x */ for (i = 0 ; i < n ; i++) { /* Z [i] = B [i] ; */ ASSIGN (Z [i], Bx, Bz, i, Bsplit) ; } flops += MULTSUB_FLOPS * nz ; for (i = 0 ; i < n ; i++) { zi = Z [i] ; p2 = Ap [i+1] ; for (p = Ap [i] ; p < p2 ; p++) { /* zi -= Ax [p] * X [Ai [p]] ; */ ASSIGN (aij, Ax, Az, p, AXsplit) ; MULT_SUB (zi, aij, X [Ai [p]]) ; } Z [i] = zi ; } /* W = Q' Z */ for (i = 0 ; i < n ; i++) { W [i] = Z [Cperm [i]] ; } } flops += UMF_utsolve (Numeric, W, Pattern) ; flops += UMF_ltsolve (Numeric, W, Pattern) ; if (step == 0) { /* X = R P' W */ /* do not use Z, since it isn't allocated if irstep = 0 */ /* X = P' W */ for (i = 0 ; i < n ; i++) { X [Rperm [i]] = W [i] ; } if (do_scale) { /* X = R X */ #ifndef NRECIPROCAL if (do_recip) { /* multiply by the scale factors */ for (i = 0 ; i < n ; i++) { SCALE (X [i], Rs [i]) ; } } else #endif { /* divide by the scale factors */ for (i = 0 ; i < n ; i++) { SCALE_DIV (X [i], Rs [i]) ; } } flops += SCALE_FLOPS * n ; } } else { /* Z = P' W */ for (i = 0 ; i < n ; i++) { Z [Rperm [i]] = W [i] ; } if (do_scale) { /* Z = R Z */ #ifndef NRECIPROCAL if (do_recip) { /* multiply by the scale factors */ for (i = 0 ; i < n ; i++) { SCALE (Z [i], Rs [i]) ; } } else #endif { /* divide by the scale factors */ for (i = 0 ; i < n ; i++) { SCALE_DIV (Z [i], Rs [i]) ; } } flops += SCALE_FLOPS * n ; } flops += ASSEMBLE_FLOPS * n ; /* X += Z */ for (i = 0 ; i < n ; i++) { /* X [i] += Z [i] ; was +=W[i] in v4.3, which is wrong */ ASSEMBLE (X [i], Z [i]) ; /* bug fix, v4.3.1 */ } } /* -------------------------------------------------------------- */ /* sparse backward error estimate */ /* -------------------------------------------------------------- */ if (irstep > 0) { /* ---------------------------------------------------------- */ /* A.' is stored by row */ /* W (i) = (b - A.' x)_i, residual */ /* Z (i) = (|A.'||x|)_i */ /* ---------------------------------------------------------- */ flops += (MULT_FLOPS + DECREMENT_FLOPS + ABS_FLOPS + 1) * nz ; for (i = 0 ; i < n ; i++) { /* wi = B [i] ; */ ASSIGN (wi, Bx, Bz, i, Bsplit) ; z2i = 0. ; p2 = Ap [i+1] ; for (p = Ap [i] ; p < p2 ; p++) { /* axx = Ax [p] * X [Ai [p]] ; */ ASSIGN (aij, Ax, Az, p, AXsplit) ; MULT (axx, aij, X [Ai [p]]) ; /* wi -= axx ; */ DECREMENT (wi, axx) ; /* z2i += ABS (axx) ; */ ABS (d, axx) ; z2i += d ; } W [i] = wi ; Z2 [i] = z2i ; } flops += (2*ABS_FLOPS + 5) * n ; if (do_step (omega, step, B2, X, W, Y, Z2, S, n, Info)) { /* iterative refinement is done */ break ; } } } } else if (sys == UMFPACK_Pt_L) { /* ------------------------------------------------------------------ */ /* Solve P'Lx=b: x = L \ Pb */ /* ------------------------------------------------------------------ */ for (i = 0 ; i < n ; i++) { /* X [i] = B [Rperm [i]] ; */ ASSIGN (X [i], Bx, Bz, Rperm [i], Bsplit) ; } flops = UMF_lsolve (Numeric, X, Pattern) ; status = UMFPACK_OK ; } else if (sys == UMFPACK_L) { /* ------------------------------------------------------------------ */ /* Solve Lx=b: x = L \ b */ /* ------------------------------------------------------------------ */ for (i = 0 ; i < n ; i++) { /* X [i] = B [i] ; */ ASSIGN (X [i], Bx, Bz, i, Bsplit) ; } flops = UMF_lsolve (Numeric, X, Pattern) ; status = UMFPACK_OK ; } else if (sys == UMFPACK_Lt_P) { /* ------------------------------------------------------------------ */ /* Solve L'Px=b: x = P' (L' \ b) */ /* ------------------------------------------------------------------ */ for (i = 0 ; i < n ; i++) { /* W [i] = B [i] ; */ ASSIGN (W [i], Bx, Bz, i, Bsplit) ; } flops = UMF_lhsolve (Numeric, W, Pattern) ; for (i = 0 ; i < n ; i++) { X [Rperm [i]] = W [i] ; } status = UMFPACK_OK ; } else if (sys == UMFPACK_Lat_P) { /* ------------------------------------------------------------------ */ /* Solve L.'Px=b: x = P' (L.' \ b) */ /* ------------------------------------------------------------------ */ for (i = 0 ; i < n ; i++) { /* W [i] = B [i] ; */ ASSIGN (W [i], Bx, Bz, i, Bsplit) ; } flops = UMF_ltsolve (Numeric, W, Pattern) ; for (i = 0 ; i < n ; i++) { X [Rperm [i]] = W [i] ; } status = UMFPACK_OK ; } else if (sys == UMFPACK_Lt) { /* ------------------------------------------------------------------ */ /* Solve L'x=b: x = L' \ b */ /* ------------------------------------------------------------------ */ for (i = 0 ; i < n ; i++) { /* X [i] = B [i] ; */ ASSIGN (X [i], Bx, Bz, i, Bsplit) ; } flops = UMF_lhsolve (Numeric, X, Pattern) ; status = UMFPACK_OK ; } else if (sys == UMFPACK_Lat) { /* ------------------------------------------------------------------ */ /* Solve L.'x=b: x = L.' \ b */ /* ------------------------------------------------------------------ */ for (i = 0 ; i < n ; i++) { /* X [i] = B [i] ; */ ASSIGN (X [i], Bx, Bz, i, Bsplit) ; } flops = UMF_ltsolve (Numeric, X, Pattern) ; status = UMFPACK_OK ; } else if (sys == UMFPACK_U_Qt) { /* ------------------------------------------------------------------ */ /* Solve UQ'x=b: x = Q (U \ b) */ /* ------------------------------------------------------------------ */ for (i = 0 ; i < n ; i++) { /* W [i] = B [i] ; */ ASSIGN (W [i], Bx, Bz, i, Bsplit) ; } flops = UMF_usolve (Numeric, W, Pattern) ; for (i = 0 ; i < n ; i++) { X [Cperm [i]] = W [i] ; } } else if (sys == UMFPACK_U) { /* ------------------------------------------------------------------ */ /* Solve Ux=b: x = U \ b */ /* ------------------------------------------------------------------ */ for (i = 0 ; i < n ; i++) { /* X [i] = B [i] ; */ ASSIGN (X [i], Bx, Bz, i, Bsplit) ; } flops = UMF_usolve (Numeric, X, Pattern) ; } else if (sys == UMFPACK_Q_Ut) { /* ------------------------------------------------------------------ */ /* Solve QU'x=b: x = U' \ Q'b */ /* ------------------------------------------------------------------ */ for (i = 0 ; i < n ; i++) { /* X [i] = B [Cperm [i]] ; */ ASSIGN (X [i], Bx, Bz, Cperm [i], Bsplit) ; } flops = UMF_uhsolve (Numeric, X, Pattern) ; } else if (sys == UMFPACK_Q_Uat) { /* ------------------------------------------------------------------ */ /* Solve QU.'x=b: x = U.' \ Q'b */ /* ------------------------------------------------------------------ */ for (i = 0 ; i < n ; i++) { /* X [i] = B [Cperm [i]] ; */ ASSIGN (X [i], Bx, Bz, Cperm [i], Bsplit) ; } flops = UMF_utsolve (Numeric, X, Pattern) ; } else if (sys == UMFPACK_Ut) { /* ------------------------------------------------------------------ */ /* Solve U'x=b: x = U' \ b */ /* ------------------------------------------------------------------ */ for (i = 0 ; i < n ; i++) { /* X [i] = B [i] ; */ ASSIGN (X [i], Bx, Bz, i, Bsplit) ; } flops = UMF_uhsolve (Numeric, X, Pattern) ; } else if (sys == UMFPACK_Uat) { /* ------------------------------------------------------------------ */ /* Solve U'x=b: x = U' \ b */ /* ------------------------------------------------------------------ */ for (i = 0 ; i < n ; i++) { /* X [i] = B [i] ; */ ASSIGN (X [i], Bx, Bz, i, Bsplit) ; } flops = UMF_utsolve (Numeric, X, Pattern) ; } else { return (UMFPACK_ERROR_invalid_system) ; } #ifdef COMPLEX /* copy the solution back, from Entry X [ ] to double Xx [ ] and Xz [ ] */ if (AXsplit) { for (i = 0 ; i < n ; i++) { Xx [i] = REAL_COMPONENT (X [i]) ; Xz [i] = IMAG_COMPONENT (X [i]) ; } } #endif /* return UMFPACK_OK, or UMFPACK_WARNING_singular_matrix */ /* Note that systems involving just L will return UMFPACK_OK */ Info [UMFPACK_SOLVE_FLOPS] = flops ; return (status) ; }