int main (void) { KLU_common Common ; cholmod_sparse *A, *A2 ; cholmod_dense *X, *B ; cholmod_common ch ; Int *Ap, *Ai, *Puser, *Quser, *Gunk ; double *Ax, *Bx, *Xx, *A2x ; double one [2], zero [2], xsave, maxerr ; Int n, i, j, nz, save, isreal, k, nan ; KLU_symbolic *Symbolic, *Symbolic2 ; KLU_numeric *Numeric ; one [0] = 1 ; one [1] = 0 ; zero [0] = 0 ; zero [1] = 0 ; printf ("klu test: -------------------------------------------------\n") ; OK (klu_defaults (&Common)) ; CHOLMOD_start (&ch) ; ch.print = 0 ; normal_memory_handler (&Common) ; /* ---------------------------------------------------------------------- */ /* read in a sparse matrix from stdin */ /* ---------------------------------------------------------------------- */ A = CHOLMOD_read_sparse (stdin, &ch) ; if (A->nrow != A->ncol || A->stype != 0) { fprintf (stderr, "error: only square unsymmetric matrices handled\n") ; CHOLMOD_free_sparse (&A, &ch) ; return (0) ; } if (!(A->xtype == CHOLMOD_REAL || A->xtype == CHOLMOD_COMPLEX)) { fprintf (stderr, "error: only real or complex matrices hanlded\n") ; CHOLMOD_free_sparse (&A, &ch) ; return (0) ; } n = A->nrow ; Ap = A->p ; Ai = A->i ; Ax = A->x ; nz = Ap [n] ; isreal = (A->xtype == CHOLMOD_REAL) ; /* ---------------------------------------------------------------------- */ /* construct random permutations */ /* ---------------------------------------------------------------------- */ Puser = randperm (n, n) ; Quser = randperm (n, n) ; /* ---------------------------------------------------------------------- */ /* select known solution to Ax=b */ /* ---------------------------------------------------------------------- */ X = CHOLMOD_allocate_dense (n, NRHS, n, A->xtype, &ch) ; Xx = X->x ; for (j = 0 ; j < NRHS ; j++) { for (i = 0 ; i < n ; i++) { if (isreal) { Xx [i] = 1 + ((double) i) / ((double) n) + j * 100; } else { Xx [2*i ] = 1 + ((double) i) / ((double) n) + j * 100 ; Xx [2*i+1] = - ((double) i+1) / ((double) n + j) ; if (j == NRHS-1) { Xx [2*i+1] = 0 ; /* zero imaginary part */ } else if (j == NRHS-2) { Xx [2*i] = 0 ; /* zero real part */ } } } Xx += isreal ? n : 2*n ; } /* B = A*X */ B = CHOLMOD_allocate_dense (n, NRHS, n, A->xtype, &ch) ; CHOLMOD_sdmult (A, 0, one, zero, X, B, &ch) ; Bx = B->x ; /* ---------------------------------------------------------------------- */ /* test KLU */ /* ---------------------------------------------------------------------- */ test_memory_handler (&Common) ; maxerr = do_solves (A, B, X, Puser, Quser, &Common, &ch, &nan) ; /* ---------------------------------------------------------------------- */ /* basic error checking */ /* ---------------------------------------------------------------------- */ FAIL (klu_defaults (NULL)) ; FAIL (klu_extract (NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL)) ; FAIL (klu_extract (NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL, &Common)) ; FAIL (klu_z_extract (NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL)) ; FAIL (klu_z_extract (NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL, &Common)) ; FAIL (klu_analyze (0, NULL, NULL, NULL)) ; FAIL (klu_analyze (0, NULL, NULL, &Common)) ; FAIL (klu_analyze_given (0, NULL, NULL, NULL, NULL, NULL)) ; FAIL (klu_analyze_given (0, NULL, NULL, NULL, NULL, &Common)) ; FAIL (klu_cholmod (0, NULL, NULL, NULL, NULL)) ; FAIL (klu_factor (NULL, NULL, NULL, NULL, NULL)) ; FAIL (klu_factor (NULL, NULL, NULL, NULL, &Common)) ; FAIL (klu_z_factor (NULL, NULL, NULL, NULL, NULL)) ; FAIL (klu_z_factor (NULL, NULL, NULL, NULL, &Common)) ; FAIL (klu_refactor (NULL, NULL, NULL, NULL, NULL, NULL)) ; FAIL (klu_refactor (NULL, NULL, NULL, NULL, NULL, &Common)) ; FAIL (klu_z_refactor (NULL, NULL, NULL, NULL, NULL, NULL)) ; FAIL (klu_z_refactor (NULL, NULL, NULL, NULL, NULL, &Common)) ; FAIL (klu_rgrowth (NULL, NULL, NULL, NULL, NULL, NULL)) ; FAIL (klu_rgrowth (NULL, NULL, NULL, NULL, NULL, &Common)) ; FAIL (klu_z_rgrowth (NULL, NULL, NULL, NULL, NULL, NULL)) ; FAIL (klu_z_rgrowth (NULL, NULL, NULL, NULL, NULL, &Common)) ; FAIL (klu_condest (NULL, NULL, NULL, NULL, NULL)) ; FAIL (klu_condest (NULL, NULL, NULL, NULL, &Common)) ; FAIL (klu_z_condest (NULL, NULL, NULL, NULL, NULL)) ; FAIL (klu_z_condest (NULL, NULL, NULL, NULL, &Common)) ; FAIL (klu_flops (NULL, NULL, NULL)) ; FAIL (klu_flops (NULL, NULL, &Common)) ; FAIL (klu_z_flops (NULL, NULL, NULL)) ; FAIL (klu_z_flops (NULL, NULL, &Common)) ; FAIL (klu_rcond (NULL, NULL, NULL)) ; FAIL (klu_rcond (NULL, NULL, &Common)) ; FAIL (klu_z_rcond (NULL, NULL, NULL)) ; FAIL (klu_z_rcond (NULL, NULL, &Common)) ; FAIL (klu_free_symbolic (NULL, NULL)) ; OK (klu_free_symbolic (NULL, &Common)) ; FAIL (klu_free_numeric (NULL, NULL)) ; OK (klu_free_numeric (NULL, &Common)) ; FAIL (klu_z_free_numeric (NULL, NULL)) ; OK (klu_z_free_numeric (NULL, &Common)) ; FAIL (klu_scale (0, 0, NULL, NULL, NULL, NULL, NULL, NULL)) ; FAIL (klu_scale (0, 0, NULL, NULL, NULL, NULL, NULL, &Common)) ; OK (klu_scale (-1, 0, NULL, NULL, NULL, NULL, NULL, &Common)) ; FAIL (klu_z_scale (0, 0, NULL, NULL, NULL, NULL, NULL, NULL)) ; FAIL (klu_z_scale (0, 0, NULL, NULL, NULL, NULL, NULL, &Common)) ; OK (klu_z_scale (-1, 0, NULL, NULL, NULL, NULL, NULL, &Common)) ; FAIL (klu_solve (NULL, NULL, 0, 0, NULL, NULL)) ; FAIL (klu_solve (NULL, NULL, 0, 0, NULL, &Common)) ; FAIL (klu_z_solve (NULL, NULL, 0, 0, NULL, NULL)) ; FAIL (klu_z_solve (NULL, NULL, 0, 0, NULL, &Common)) ; FAIL (klu_tsolve (NULL, NULL, 0, 0, NULL, NULL)) ; FAIL (klu_tsolve (NULL, NULL, 0, 0, NULL, &Common)) ; FAIL (klu_z_tsolve (NULL, NULL, 0, 0, NULL, 0, NULL)) ; FAIL (klu_z_tsolve (NULL, NULL, 0, 0, NULL, 0, &Common)) ; FAIL (klu_malloc (0, 0, NULL)) ; FAIL (klu_malloc (0, 0, &Common)) ; FAIL (klu_malloc (Int_MAX, 1, &Common)) ; FAIL (klu_realloc (0, 0, 0, NULL, NULL)) ; FAIL (klu_realloc (0, 0, 0, NULL, &Common)) ; FAIL (klu_realloc (Int_MAX, 1, 0, NULL, &Common)) ; Gunk = (Int *) klu_realloc (1, 0, sizeof (Int), NULL, &Common) ; OK (Gunk) ; OK (klu_realloc (Int_MAX, 1, sizeof (Int), Gunk, &Common)) ; OK (Common.status == KLU_TOO_LARGE) ; klu_free (Gunk, 1, sizeof (Int), &Common) ; /* ---------------------------------------------------------------------- */ /* mangle the matrix, and other error checking */ /* ---------------------------------------------------------------------- */ printf ("\nerror handling:\n") ; Symbolic = klu_analyze (n, Ap, Ai, &Common) ; OK (Symbolic) ; Xx = X->x ; if (nz > 0) { /* ------------------------------------------------------------------ */ /* row index out of bounds */ /* ------------------------------------------------------------------ */ save = Ai [0] ; Ai [0] = -1 ; FAIL (klu_analyze (n, Ap, Ai, &Common)) ; if (isreal) { FAIL (klu_scale (1, n, Ap, Ai, Ax, Xx, Puser, &Common)) ; } else { FAIL (klu_z_scale (1, n, Ap, Ai, Ax, Xx, Puser, &Common)) ; } Ai [0] = save ; /* ------------------------------------------------------------------ */ /* row index out of bounds */ /* ------------------------------------------------------------------ */ save = Ai [0] ; Ai [0] = Int_MAX ; FAIL (klu_analyze (n, Ap, Ai, &Common)) ; if (isreal) { FAIL (klu_scale (1, n, Ap, Ai, Ax, Xx, Puser, &Common)) ; } else { FAIL (klu_z_scale (1, n, Ap, Ai, Ax, Xx, Puser, &Common)) ; } Ai [0] = save ; /* ------------------------------------------------------------------ */ /* column pointers mangled */ /* ------------------------------------------------------------------ */ save = Ap [n] ; Ap [n] = -1 ; FAIL (klu_analyze (n, Ap, Ai, &Common)) ; if (isreal) { FAIL (klu_scale (1, n, Ap, Ai, Ax, Xx, Puser, &Common)) ; } else { FAIL (klu_z_scale (1, n, Ap, Ai, Ax, Xx, Puser, &Common)) ; } Ap [n] = save ; /* ------------------------------------------------------------------ */ /* column pointers mangled */ /* ------------------------------------------------------------------ */ save = Ap [n] ; Ap [n] = Ap [n-1] - 1 ; FAIL (klu_analyze (n, Ap, Ai, &Common)) ; if (isreal) { FAIL (klu_scale (1, n, Ap, Ai, Ax, Xx, Puser, &Common)) ; } else { FAIL (klu_z_scale (1, n, Ap, Ai, Ax, Xx, Puser, &Common)) ; } Ap [n] = save ; /* ------------------------------------------------------------------ */ /* duplicates */ /* ------------------------------------------------------------------ */ if (n > 1 && Ap [1] - Ap [0] > 1) { save = Ai [1] ; Ai [1] = Ai [0] ; FAIL (klu_analyze (n, Ap, Ai, &Common)) ; if (isreal) { FAIL (klu_scale (1, n, Ap, Ai, Ax, Xx, Puser, &Common)) ; } else { FAIL (klu_z_scale (1, n, Ap, Ai, Ax, Xx, Puser, &Common)) ; } Ai [1] = save ; } /* ------------------------------------------------------------------ */ /* invalid ordering */ /* ------------------------------------------------------------------ */ save = Common.ordering ; Common.ordering = 42 ; FAIL (klu_analyze (n, Ap, Ai, &Common)) ; Common.ordering = save ; /* ------------------------------------------------------------------ */ /* invalid ordering (klu_cholmod, with NULL user_ordering) */ /* ------------------------------------------------------------------ */ save = Common.ordering ; Common.user_order = NULL ; Common.ordering = 3 ; FAIL (klu_analyze (n, Ap, Ai, &Common)) ; Common.ordering = save ; } /* ---------------------------------------------------------------------- */ /* tests with valid symbolic factorization */ /* ---------------------------------------------------------------------- */ Common.halt_if_singular = FALSE ; Common.scale = 0 ; Numeric = NULL ; if (nz > 0) { /* ------------------------------------------------------------------ */ /* Int overflow */ /* ------------------------------------------------------------------ */ if (n == 100) { Common.ordering = 2 ; Symbolic2 = klu_analyze (n, Ap, Ai, &Common) ; OK (Symbolic2) ; Common.memgrow = Int_MAX ; if (isreal) { Numeric = klu_factor (Ap, Ai, Ax, Symbolic2, &Common) ; } else { Numeric = klu_z_factor (Ap, Ai, Ax, Symbolic2, &Common) ; } Common.memgrow = 1.2 ; Common.ordering = 0 ; klu_free_symbolic (&Symbolic2, &Common) ; klu_free_numeric (&Numeric, &Common) ; } /* ------------------------------------------------------------------ */ /* Int overflow again */ /* ------------------------------------------------------------------ */ Common.initmem = Int_MAX ; Common.initmem_amd = Int_MAX ; if (isreal) { Numeric = klu_factor (Ap, Ai, Ax, Symbolic, &Common) ; } else { Numeric = klu_z_factor (Ap, Ai, Ax, Symbolic, &Common) ; } Common.initmem = 10 ; Common.initmem_amd = 1.2 ; klu_free_numeric (&Numeric, &Common) ; /* ------------------------------------------------------------------ */ /* mangle the matrix */ /* ------------------------------------------------------------------ */ save = Ai [0] ; Ai [0] = -1 ; if (isreal) { Numeric = klu_factor (Ap, Ai, Ax, Symbolic, &Common) ; } else { Numeric = klu_z_factor (Ap, Ai, Ax, Symbolic, &Common) ; } FAIL (Numeric) ; Ai [0] = save ; /* ------------------------------------------------------------------ */ /* nan and inf handling */ /* ------------------------------------------------------------------ */ xsave = Ax [0] ; Ax [0] = one [0] / zero [0] ; if (isreal) { Numeric = klu_factor (Ap, Ai, Ax, Symbolic, &Common) ; klu_rcond (Symbolic, Numeric, &Common) ; klu_condest (Ap, Ax, Symbolic, Numeric, &Common) ; } else { Numeric = klu_z_factor (Ap, Ai, Ax, Symbolic, &Common) ; klu_z_rcond (Symbolic, Numeric, &Common) ; klu_z_condest (Ap, Ax, Symbolic, Numeric, &Common) ; } printf ("Nan case: rcond %g condest %g\n", Common.rcond, Common.condest) ; OK (Numeric) ; Ax [0] = xsave ; /* ------------------------------------------------------------------ */ /* mangle the matrix again */ /* ------------------------------------------------------------------ */ save = Ai [0] ; Ai [0] = -1 ; if (isreal) { FAIL (klu_refactor (Ap, Ai, Ax, Symbolic, Numeric, &Common)) ; } else { FAIL (klu_z_refactor (Ap, Ai, Ax, Symbolic, Numeric, &Common)) ; } Ai [0] = save ; /* ------------------------------------------------------------------ */ /* all zero */ /* ------------------------------------------------------------------ */ A2 = CHOLMOD_copy_sparse (A, &ch) ; A2x = A2->x ; for (k = 0 ; k < nz * (isreal ? 1:2) ; k++) { A2x [k] = 0 ; } for (Common.halt_if_singular = 0 ; Common.halt_if_singular <= 1 ; Common.halt_if_singular++) { for (Common.scale = -1 ; Common.scale <= 2 ; Common.scale++) { if (isreal) { klu_refactor (Ap, Ai, A2x, Symbolic, Numeric, &Common) ; klu_condest (Ap, A2x, Symbolic, Numeric, &Common) ; } else { klu_z_refactor (Ap, Ai, A2x, Symbolic, Numeric, &Common) ; klu_z_condest (Ap, A2x, Symbolic, Numeric, &Common) ; } OK (Common.status = KLU_SINGULAR) ; } } CHOLMOD_free_sparse (&A2, &ch) ; /* ------------------------------------------------------------------ */ /* all one, or all 1i for complex case */ /* ------------------------------------------------------------------ */ A2 = CHOLMOD_copy_sparse (A, &ch) ; A2x = A2->x ; for (k = 0 ; k < nz ; k++) { if (isreal) { A2x [k] = 1 ; } else { A2x [2*k ] = 0 ; A2x [2*k+1] = 1 ; } } Common.halt_if_singular = 0 ; Common.scale = 0 ; if (isreal) { klu_refactor (Ap, Ai, A2x, Symbolic, Numeric, &Common) ; klu_condest (Ap, A2x, Symbolic, Numeric, &Common) ; } else { klu_z_refactor (Ap, Ai, A2x, Symbolic, Numeric, &Common) ; klu_z_condest (Ap, A2x, Symbolic, Numeric, &Common) ; } OK (Common.status = KLU_SINGULAR) ; CHOLMOD_free_sparse (&A2, &ch) ; } klu_free_symbolic (&Symbolic, &Common) ; if (isreal) { klu_free_numeric (&Numeric, &Common) ; } else { klu_z_free_numeric (&Numeric, &Common) ; } /* ---------------------------------------------------------------------- */ /* free problem and quit */ /* ---------------------------------------------------------------------- */ CHOLMOD_free_dense (&X, &ch) ; CHOLMOD_free_dense (&B, &ch) ; CHOLMOD_free_sparse (&A, &ch) ; free (Puser) ; free (Quser) ; CHOLMOD_finish (&ch) ; fprintf (stderr, " maxerr %10.3e", maxerr) ; printf (" maxerr %10.3e", maxerr) ; if (maxerr < 1e-8) { fprintf (stderr, " test passed") ; printf (" test passed") ; } else { fprintf (stderr, " test FAILED") ; printf (" test FAILED") ; } if (nan) { fprintf (stderr, " *") ; printf (" *") ; } fprintf (stderr, "\n") ; printf ("\n-----------------------------------------------------------\n") ; return (0) ; }
/* Setup KLU for a linear solve. This function factors the Jacobian matrix before handing off the factors for a back solve. Optionally, this function also computes a new fill-reducing ordering (using KLU) in the case that the matrix graph has been updated. */ int SetupKINKlu(KINMem kin_memory){ //get the KINKlu memory block KINKluMem kin_klu_mem=(KINKluMem)kin_memory->kin_lmem; if(!kin_klu_mem) return 1; //grab appropriate klu objects cs_di *jac=kin_klu_mem->jac; klu_symbolic *symb=kin_klu_mem->symbolic; klu_numeric *numeric=kin_klu_mem->numeric; klu_common *comm=&(kin_klu_mem->klu_comm); int n=kin_klu_mem->n, update_fr_order=0; //call the jacobian evaluation function kin_klu_mem->jac_fun(n, kin_memory->kin_uu, kin_memory->kin_fval, jac, kin_memory->kin_user_data, &update_fr_order, kin_memory->kin_vtemp1, kin_memory->kin_vtemp2); /* if a new fill-reducing ordering has been requested, or if the graph and values have been specified but no ordering has been computed yet, perform the computation */ if(update_fr_order){ //if a symbolic object already exists, free it if(symb){ klu_free_symbolic(&symb, comm); kin_klu_mem->symbolic=NULL; } //perform the fill-reducing ordering symb=klu_analyze(n, jac->p, jac->i, comm); if(!symb) return 1; kin_klu_mem->symbolic=symb; /* now we need to perform a numeric factorization. first, free an existing numeric factorization if there is one. */ if(numeric){ klu_free_numeric(&numeric, comm); kin_klu_mem->numeric=NULL; } //perform the factorization numeric=klu_factor(jac->p, jac->i, jac->x, symb, comm); /* check if the factorization was successful and return if not */ if(!numeric){ klu_free_symbolic(&symb, comm); kin_klu_mem->symbolic=NULL; return 1; } kin_klu_mem->numeric=numeric; //otherwise, the factorization was a success and we can return return(KINDLS_SUCCESS); } /* if a new fill-reducing ordering is not necessary, we can proceed with factorization. first, check if a numeric factorization exists. if not, compute it */ if(!numeric) { //perform the factorization numeric=klu_factor(jac->p, jac->i, jac->x, symb, comm); /* check if the factorization was successful and return if not */ if(!numeric) return 1; kin_klu_mem->numeric=numeric; return(KINDLS_SUCCESS); } /* if a symbolic and numeric factorization already exist, try a refactor using the old numeric factorization. this is much faster than a full numeric factorization and requires no new memory */ klu_refactor(jac->p, jac->i, jac->x, symb, numeric, comm); #ifdef _VERBOSE /* check the pivot growth factor. i confess that i dont understand what this factor means, but a small value is supposed to indicate numerical instability for testing i'm going to compute it and do a full numerical factorization if it's too small. */ klu_rgrowth(jac->p, jac->i, jac->x, symb, numeric, comm); /* print the growth factor to the console for testing */ printf("Reciprocal pivot growth after refactor: %1.5e\n\n", kin_klu_mem->klu_comm.rgrowth); #endif //return return(KINDLS_SUCCESS); };
static double do_1_solve (cholmod_sparse *A, cholmod_dense *B, cholmod_dense *Xknown, Int *Puser, Int *Quser, KLU_common *Common, cholmod_common *ch, Int *nan) { Int *Ai, *Ap ; double *Ax, *Bx, *Xknownx, *Xx, *Ax2, *Axx ; KLU_symbolic *Symbolic = NULL ; KLU_numeric *Numeric = NULL ; cholmod_dense *X = NULL, *R = NULL ; cholmod_sparse *AT = NULL, *A2 = NULL, *AT2 = NULL ; double one [2], minusone [2], rnorm, anorm, bnorm, xnorm, relresid, relerr, err = 0. ; Int i, j, nrhs2, isreal, n, nrhs, transpose, step, k, save, tries ; printf ("\ndo_1_solve: btf "ID" maxwork %g scale "ID" ordering "ID" user: "******" P,Q: %d halt: "ID"\n", Common->btf, Common->maxwork, Common->scale, Common->ordering, Common->user_data ? (*((Int *) Common->user_data)) : -1, (Puser != NULL || Quser != NULL), Common->halt_if_singular) ; fflush (stdout) ; fflush (stderr) ; CHOLMOD_print_sparse (A, "A", ch) ; CHOLMOD_print_dense (B, "B", ch) ; Ap = A->p ; Ai = A->i ; Ax = A->x ; n = A->nrow ; isreal = (A->xtype == CHOLMOD_REAL) ; Bx = B->x ; Xknownx = Xknown->x ; nrhs = B->ncol ; one [0] = 1 ; one [1] = 0 ; minusone [0] = -1 ; minusone [1] = 0 ; /* ---------------------------------------------------------------------- */ /* symbolic analysis */ /* ---------------------------------------------------------------------- */ Symbolic = NULL ; my_tries = 0 ; for (tries = 0 ; Symbolic == NULL && my_tries == 0 ; tries++) { my_tries = tries ; if (Puser != NULL || Quser != NULL) { Symbolic = klu_analyze_given (n, Ap, Ai, Puser, Quser, Common) ; } else { Symbolic = klu_analyze (n, Ap, Ai, Common) ; } } printf ("sym try "ID" btf "ID" ordering "ID"\n", tries, Common->btf, Common->ordering) ; if (Symbolic == NULL) { printf ("Symbolic is null\n") ; return (998) ; } my_tries = -1 ; /* create a modified version of A */ A2 = CHOLMOD_copy_sparse (A, ch) ; Ax2 = A2->x ; my_srand (42) ; for (k = 0 ; k < Ap [n] * (isreal ? 1:2) ; k++) { Ax2 [k] = Ax [k] * (1 + 1e-4 * ((double) my_rand ( )) / ((double) MY_RAND_MAX)) ; } AT = isreal ? NULL : CHOLMOD_transpose (A, 1, ch) ; AT2 = isreal ? NULL : CHOLMOD_transpose (A2, 1, ch) ; /* ---------------------------------------------------------------------- */ /* factorize then solve */ /* ---------------------------------------------------------------------- */ for (step = 1 ; step <= 3 ; step++) { printf ("step: "ID"\n", step) ; fflush (stdout) ; /* ------------------------------------------------------------------ */ /* factorization or refactorization */ /* ------------------------------------------------------------------ */ /* step 1: factor step 2: refactor with same A step 3: refactor with modified A, and scaling forced on and solve each time */ if (step == 1) { /* numeric factorization */ Numeric = NULL ; my_tries = 0 ; for (tries = 0 ; Numeric == NULL && my_tries == 0 ; tries++) { my_tries = tries ; if (isreal) { Numeric = klu_factor (Ap, Ai, Ax, Symbolic, Common) ; } else { Numeric = klu_z_factor (Ap, Ai, Ax, Symbolic, Common) ; } } printf ("num try "ID" btf "ID"\n", tries, Common->btf) ; my_tries = -1 ; if (Common->status == KLU_OK || (Common->status == KLU_SINGULAR && !Common->halt_if_singular)) { OK (Numeric) ; } else { FAIL (Numeric) ; } if (Common->status < KLU_OK) { printf ("factor failed: "ID"\n", Common->status) ; } } else if (step == 2) { /* numeric refactorization with same values, same scaling */ if (isreal) { klu_refactor (Ap, Ai, Ax, Symbolic, Numeric, Common) ; } else { klu_z_refactor (Ap, Ai, Ax, Symbolic, Numeric, Common) ; } } else { /* numeric refactorization with different values */ save = Common->scale ; if (Common->scale == 0) { Common->scale = 1 ; } for (tries = 0 ; tries <= 1 ; tries++) { my_tries = tries ; if (isreal) { klu_refactor (Ap, Ai, Ax2, Symbolic, Numeric, Common) ; } else { klu_z_refactor (Ap, Ai, Ax2, Symbolic, Numeric, Common) ; } } my_tries = -1 ; Common->scale = save ; } if (Common->status == KLU_SINGULAR) { printf ("# singular column : "ID"\n", Common->singular_col) ; } /* ------------------------------------------------------------------ */ /* diagnostics */ /* ------------------------------------------------------------------ */ Axx = (step == 3) ? Ax2 : Ax ; if (isreal) { klu_rgrowth (Ap, Ai, Axx, Symbolic, Numeric, Common) ; klu_condest (Ap, Axx, Symbolic, Numeric, Common) ; klu_rcond (Symbolic, Numeric, Common) ; klu_flops (Symbolic, Numeric, Common) ; } else { klu_z_rgrowth (Ap, Ai, Axx, Symbolic, Numeric, Common) ; klu_z_condest (Ap, Axx, Symbolic, Numeric, Common) ; klu_z_rcond (Symbolic, Numeric, Common) ; klu_z_flops (Symbolic, Numeric, Common) ; } printf ("growth %g condest %g rcond %g flops %g\n", Common->rgrowth, Common->condest, Common->rcond, Common->flops) ; ludump (Symbolic, Numeric, isreal, ch, Common) ; if (Numeric == NULL || Common->status < KLU_OK) { continue ; } /* ------------------------------------------------------------------ */ /* solve */ /* ------------------------------------------------------------------ */ /* forward/backsolve to solve A*X=B or A'*X=B */ for (transpose = (isreal ? 0 : -1) ; transpose <= 1 ; transpose++) { for (nrhs2 = 1 ; nrhs2 <= nrhs ; nrhs2++) { /* mangle B so that it has only nrhs2 columns */ B->ncol = nrhs2 ; X = CHOLMOD_copy_dense (B, ch) ; CHOLMOD_print_dense (X, "X before solve", ch) ; Xx = X->x ; if (isreal) { if (transpose) { /* solve A'x=b */ klu_tsolve (Symbolic, Numeric, n, nrhs2, Xx, Common) ; } else { /* solve A*x=b */ klu_solve (Symbolic, Numeric, n, nrhs2, Xx, Common) ; } } else { if (transpose) { /* solve A'x=b (if 1) or A.'x=b (if -1) */ klu_z_tsolve (Symbolic, Numeric, n, nrhs2, Xx, (transpose == 1), Common) ; } else { /* solve A*x=b */ klu_z_solve (Symbolic, Numeric, n, nrhs2, Xx, Common) ; } } CHOLMOD_print_dense (X, "X", ch) ; /* compute the residual, R = B-A*X, B-A'*X, or B-A.'*X */ R = CHOLMOD_copy_dense (B, ch) ; if (transpose == -1) { /* R = B-A.'*X (use A.' explicitly) */ CHOLMOD_sdmult ((step == 3) ? AT2 : AT, 0, minusone, one, X, R, ch) ; } else { /* R = B-A*X or B-A'*X */ CHOLMOD_sdmult ((step == 3) ? A2 :A, transpose, minusone, one, X, R, ch) ; } CHOLMOD_print_dense (R, "R", ch) ; /* compute the norms of R, A, X, and B */ rnorm = CHOLMOD_norm_dense (R, 1, ch) ; anorm = CHOLMOD_norm_sparse ((step == 3) ? A2 : A, 1, ch) ; xnorm = CHOLMOD_norm_dense (X, 1, ch) ; bnorm = CHOLMOD_norm_dense (B, 1, ch) ; CHOLMOD_free_dense (&R, ch) ; /* relative residual = norm (r) / (norm (A) * norm (x)) */ relresid = rnorm ; if (anorm > 0) { relresid /= anorm ; } if (xnorm > 0) { relresid /= xnorm ; } if (SCALAR_IS_NAN (relresid)) { *nan = TRUE ; } else { err = MAX (err, relresid) ; } /* relative error = norm (x - xknown) / norm (xknown) */ /* overwrite X with X - Xknown */ if (transpose || step == 3) { /* not computed */ relerr = -1 ; } else { for (j = 0 ; j < nrhs2 ; j++) { for (i = 0 ; i < n ; i++) { if (isreal) { Xx [i+j*n] -= Xknownx [i+j*n] ; } else { Xx [2*(i+j*n) ] -= Xknownx [2*(i+j*n) ] ; Xx [2*(i+j*n)+1] -= Xknownx [2*(i+j*n)+1] ; } } } relerr = CHOLMOD_norm_dense (X, 1, ch) ; xnorm = CHOLMOD_norm_dense (Xknown, 1, ch) ; if (xnorm > 0) { relerr /= xnorm ; } if (SCALAR_IS_NAN (relerr)) { *nan = TRUE ; } else { err = MAX (relerr, err) ; } } CHOLMOD_free_dense (&X, ch) ; printf (ID" "ID" relresid %10.3g relerr %10.3g %g\n", transpose, nrhs2, relresid, relerr, err) ; B->ncol = nrhs ; /* restore B */ } } } /* ---------------------------------------------------------------------- */ /* free factorization and temporary matrices, and return */ /* ---------------------------------------------------------------------- */ klu_free_symbolic (&Symbolic, Common) ; if (isreal) { klu_free_numeric (&Numeric, Common) ; } else { klu_z_free_numeric (&Numeric, Common) ; } CHOLMOD_free_sparse (&A2, ch) ; CHOLMOD_free_sparse (&AT, ch) ; CHOLMOD_free_sparse (&AT2, ch) ; fflush (stdout) ; fflush (stderr) ; return (err) ; }