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) ; }
/*! \fn solve linear system with Klu method * * \param [in] [data] * [sysNumber] index of the corresponding linear system * * * author: wbraun */ int solveKlu(DATA *data, threadData_t *threadData, int sysNumber) { void *dataAndThreadData[2] = {data, threadData}; LINEAR_SYSTEM_DATA* systemData = &(data->simulationInfo->linearSystemData[sysNumber]); DATA_KLU* solverData = (DATA_KLU*)systemData->solverData; int i, j, status = 0, success = 0, n = systemData->size, eqSystemNumber = systemData->equationIndex, indexes[2] = {1,eqSystemNumber}; infoStreamPrintWithEquationIndexes(LOG_LS, 0, indexes, "Start solving Linear System %d (size %d) at time %g with Klu Solver", eqSystemNumber, (int) systemData->size, data->localData[0]->timeValue); rt_ext_tp_tick(&(solverData->timeClock)); if (0 == systemData->method) { /* set A matrix */ solverData->Ap[0] = 0; systemData->setA(data, threadData, systemData); solverData->Ap[solverData->n_row] = solverData->nnz; if (ACTIVE_STREAM(LOG_LS_V)) { infoStreamPrint(LOG_LS_V, 1, "Matrix A"); printMatrixCSR(solverData->Ap, solverData->Ai, solverData->Ax, n); messageClose(LOG_LS_V); } /* set b vector */ systemData->setb(data, threadData, systemData); } else { solverData->Ap[0] = 0; /* calculate jacobian -> matrix A*/ if(systemData->jacobianIndex != -1){ getAnalyticalJacobian(data, threadData, sysNumber); } else { assertStreamPrint(threadData, 1, "jacobian function pointer is invalid" ); } solverData->Ap[solverData->n_row] = solverData->nnz; /* calculate vector b (rhs) */ memcpy(solverData->work, systemData->x, sizeof(double)*solverData->n_row); residual_wrapper(solverData->work, systemData->b, dataAndThreadData, sysNumber); } infoStreamPrint(LOG_LS, 0, "### %f time to set Matrix A and vector b.", rt_ext_tp_tock(&(solverData->timeClock))); if (ACTIVE_STREAM(LOG_LS_V)) { if (ACTIVE_STREAM(LOG_LS_V)) { infoStreamPrint(LOG_LS_V, 1, "Old solution x:"); for(i = 0; i < solverData->n_row; ++i) infoStreamPrint(LOG_LS_V, 0, "[%d] %s = %g", i+1, modelInfoGetEquation(&data->modelData->modelDataXml,eqSystemNumber).vars[i], systemData->x[i]); messageClose(LOG_LS_V); } infoStreamPrint(LOG_LS_V, 1, "Matrix A n_rows = %d", solverData->n_row); for (i=0; i<solverData->n_row; i++){ infoStreamPrint(LOG_LS_V, 0, "%d. Ap => %d -> %d", i, solverData->Ap[i], solverData->Ap[i+1]); for (j=solverData->Ap[i]; j<solverData->Ap[i+1]; j++){ infoStreamPrint(LOG_LS_V, 0, "A[%d,%d] = %f", i, solverData->Ai[j], solverData->Ax[j]); } } messageClose(LOG_LS_V); for (i=0; i<solverData->n_row; i++) infoStreamPrint(LOG_LS_V, 0, "b[%d] = %e", i, systemData->b[i]); } rt_ext_tp_tick(&(solverData->timeClock)); /* symbolic pre-ordering of A to reduce fill-in of L and U */ if (0 == solverData->numberSolving) { infoStreamPrint(LOG_LS_V, 0, "Perform analyze settings:\n - ordering used: %d\n - current status: %d", solverData->common.ordering, solverData->common.status); solverData->symbolic = klu_analyze(solverData->n_col, solverData->Ap, solverData->Ai, &solverData->common); } /* compute the LU factorization of A */ if (0 == solverData->common.status){ solverData->numeric = klu_factor(solverData->Ap, solverData->Ai, solverData->Ax, solverData->symbolic, &solverData->common); } if (0 == solverData->common.status){ if (1 == systemData->method){ if (klu_solve(solverData->symbolic, solverData->numeric, solverData->n_col, 1, systemData->b, &solverData->common)){ success = 1; } } else { if (klu_tsolve(solverData->symbolic, solverData->numeric, solverData->n_col, 1, systemData->b, &solverData->common)){ success = 1; } } } infoStreamPrint(LOG_LS, 0, "Solve System: %f", rt_ext_tp_tock(&(solverData->timeClock))); /* print solution */ if (1 == success){ if (1 == systemData->method){ /* take the solution */ for(i = 0; i < solverData->n_row; ++i) systemData->x[i] += systemData->b[i]; /* update inner equations */ residual_wrapper(systemData->x, solverData->work, dataAndThreadData, sysNumber); } else { /* the solution is automatically in x */ memcpy(systemData->x, systemData->b, sizeof(double)*systemData->size); } if (ACTIVE_STREAM(LOG_LS_V)) { infoStreamPrint(LOG_LS_V, 1, "Solution x:"); infoStreamPrint(LOG_LS_V, 0, "System %d numVars %d.", eqSystemNumber, modelInfoGetEquation(&data->modelData->modelDataXml,eqSystemNumber).numVar); for(i = 0; i < systemData->size; ++i) infoStreamPrint(LOG_LS_V, 0, "[%d] %s = %g", i+1, modelInfoGetEquation(&data->modelData->modelDataXml,eqSystemNumber).vars[i], systemData->x[i]); messageClose(LOG_LS_V); } } else { warningStreamPrint(LOG_STDOUT, 0, "Failed to solve linear system of equations (no. %d) at time %f, system status %d.", (int)systemData->equationIndex, data->localData[0]->timeValue, status); } solverData->numberSolving += 1; return 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) ; }