int UMF_cholmod ( /* inputs */ Int nrow, /* A is nrow-by-ncol */ Int ncol, /* A is nrow-by-ncol */ Int symmetric, /* if true and nrow=ncol do A+A', else do A'A */ Int Ap [ ], /* column pointers, size ncol+1 */ Int Ai [ ], /* row indices, size nz = Ap [ncol] */ /* output */ Int Perm [ ], /* fill-reducing permutation, size ncol */ /* user-defined */ void *user_params, /* Int array of size 3 */ double user_info [3] /* [0]: max col count for L=chol(P(A+A')P') [1]: nnz (L) [2]: flop count for chol, if A real */ ) { #ifndef NCHOLMOD double dmax, flops, c, lnz ; cholmod_sparse Amatrix, *A, *AT, *S ; cholmod_factor *L ; cholmod_common cm ; Int *P, *ColCount ; Int k, ordering_option, print_level, *params ; params = (Int *) user_params ; ordering_option = params [0] ; print_level = params [1] - 1 ; params [2] = -1 ; if (Ap == NULL || Ai == NULL || Perm == NULL || nrow < 0 || ncol < 0) { /* invalid inputs */ return (FALSE) ; } if (nrow != ncol) { /* force symmetric to be false */ symmetric = FALSE ; } /* start CHOLMOD */ CHOLMOD_start (&cm) ; cm.supernodal = CHOLMOD_SIMPLICIAL ; cm.print = print_level ; /* adjust cm based on ordering_option */ switch (ordering_option) { default: case UMFPACK_ORDERING_AMD: /* AMD on A+A' if symmetric, COLAMD on A otherwise */ cm.nmethods = 1 ; cm.method [0].ordering = symmetric ? CHOLMOD_AMD : CHOLMOD_COLAMD ; cm.postorder = TRUE ; break ; case UMFPACK_ORDERING_METIS: /* metis on A+A' if symmetric, A'A otherwise */ cm.nmethods = 1 ; cm.method [0].ordering = CHOLMOD_METIS ; cm.postorder = TRUE ; break ; case UMFPACK_ORDERING_NONE: case UMFPACK_ORDERING_GIVEN: case UMFPACK_ORDERING_USER: /* no ordering. No input permutation here, and no user function, so all these are the same as "none". */ cm.nmethods = 1 ; cm.method [0].ordering = CHOLMOD_NATURAL ; cm.postorder = FALSE ; break ; case UMFPACK_ORDERING_BEST: /* try AMD, METIS and NESDIS on A+A', or COLAMD(A), METIS(A'A), and NESDIS (A'A) */ cm.nmethods = 3 ; cm.method [0].ordering = symmetric ? CHOLMOD_AMD : CHOLMOD_COLAMD ; cm.method [1].ordering = CHOLMOD_METIS ; cm.method [2].ordering = CHOLMOD_NESDIS ; cm.postorder = TRUE ; break ; case UMFPACK_ORDERING_CHOLMOD: /* no change to CHOLMOD defaults: Do not use given permutation, since it's not provided. Try AMD. If fill-in and flop count are low, use AMD. Otherwise, try METIS and take the best of AMD and METIS. cm.method [0].ordering = CHOLMOD_GIVEN cm.method [1].ordering = CHOLMOD_AMD cm.method [2].ordering = CHOLMOD_METIS cm.nmethods = 2 if METIS installed, 3 otherwise ('given' is skipped) */ break ; } /* construct a CHOLMOD version of the input matrix A */ A = &Amatrix ; A->nrow = nrow ; /* A is nrow-by-ncol */ A->ncol = ncol ; A->nzmax = Ap [ncol] ; /* with nzmax entries */ A->packed = TRUE ; /* there is no A->nz array */ if (symmetric) { A->stype = 1 ; /* A is symmetric */ } else { A->stype = 0 ; /* A is unsymmetric */ } A->itype = CHOLMOD_INT ; A->xtype = CHOLMOD_PATTERN ; A->dtype = CHOLMOD_DOUBLE ; A->nz = NULL ; A->p = Ap ; /* column pointers */ A->i = Ai ; /* row indices */ A->x = NULL ; /* no numerical values */ A->z = NULL ; A->sorted = FALSE ; /* columns of A might not be sorted */ if (symmetric) { /* CHOLMOD with order the symmetric matrix A */ AT = NULL ; S = A ; } else { /* S = A'. CHOLMOD will order S*S', which is A'*A */ AT = CHOLMOD_transpose (A, 0, &cm) ; S = AT ; } /* order and analyze S or S*S' */ L = CHOLMOD_analyze (S, &cm) ; CHOLMOD_free_sparse (&AT, &cm) ; if (L == NULL) { return (FALSE) ; } /* determine the ordering used */ switch (L->ordering) { case CHOLMOD_AMD: case CHOLMOD_COLAMD: params [2] = UMFPACK_ORDERING_AMD ; break ; case CHOLMOD_METIS: case CHOLMOD_NESDIS: params [2] = UMFPACK_ORDERING_METIS ; break ; case CHOLMOD_GIVEN: case CHOLMOD_NATURAL: default: params [2] = UMFPACK_ORDERING_NONE ; break ; } /* copy the permutation from L to the output and compute statistics */ P = L->Perm ; ColCount = L->ColCount ; dmax = 1 ; lnz = 0 ; flops = 0 ; for (k = 0 ; k < ncol ; k++) { Perm [k] = P [k] ; c = ColCount [k] ; if (c > dmax) dmax = c ; lnz += c ; flops += c*c ; } user_info [0] = dmax ; user_info [1] = lnz ; user_info [2] = flops ; CHOLMOD_free_factor (&L, &cm) ; if (print_level > 0) { CHOLMOD_print_common ("for UMFPACK", &cm) ; } CHOLMOD_finish (&cm) ; return (TRUE) ; #else /* CHOLMOD and its supporting packages (CAMD, CCOLAMD, COLAMD, metis-4.0) not installed */ return (FALSE) ; #endif }
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) ; }