Exemple #1
0
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) ;
}
Exemple #2
0
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
}
Exemple #3
0
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) ;
}