Пример #1
1
int main (int argc, char **argv)
{
    double Info [UMFPACK_INFO], Control [UMFPACK_CONTROL], *Ax, *Cx, *Lx, *Ux,
	*W, t [2], *Dx, rnorm, *Rb, *y, *Rs ;
    double *Az, *Lz, *Uz, *Dz, *Cz, *Rbz, *yz ;
    SuiteSparse_long *Ap, *Ai, *Cp, *Ci, row, col, p, lnz, unz, nr, nc, *Lp, *Li, *Ui, *Up,
	*P, *Q, *Lj, i, j, k, anz, nfr, nchains, *Qinit, fnpiv, lnz1, unz1, nz1,
	status, *Front_npivcol, *Front_parent, *Chain_start, *Wi, *Pinit, n1,
	*Chain_maxrows, *Chain_maxcols, *Front_1strow, *Front_leftmostdesc,
	nzud, do_recip ;
    void *Symbolic, *Numeric ;

    /* ---------------------------------------------------------------------- */
    /* initializations */
    /* ---------------------------------------------------------------------- */

    umfpack_tic (t) ;

    printf ("\nUMFPACK V%d.%d (%s) demo: _zl_ version\n",
	    UMFPACK_MAIN_VERSION, UMFPACK_SUB_VERSION, UMFPACK_DATE) ;

    /* get the default control parameters */
    umfpack_zl_defaults (Control) ;

    /* change the default print level for this demo */
    /* (otherwise, nothing will print) */
    Control [UMFPACK_PRL] = 6 ;

    /* print the license agreement */
    umfpack_zl_report_status (Control, UMFPACK_OK) ;
    Control [UMFPACK_PRL] = 5 ;

    /* print the control parameters */
    umfpack_zl_report_control (Control) ;

    /* ---------------------------------------------------------------------- */
    /* print A and b, and convert A to column-form */
    /* ---------------------------------------------------------------------- */

    /* print the right-hand-side */
    printf ("\nb: ") ;
    (void) umfpack_zl_report_vector (n, b, bz, Control) ;

    /* print the triplet form of the matrix */
    printf ("\nA: ") ;
    (void) umfpack_zl_report_triplet (n, n, nz, Arow, Acol, Aval, Avalz,
	Control) ;

    /* convert to column form */
    nz1 = MAX (nz,1) ;	/* ensure arrays are not of size zero. */
    Ap = (SuiteSparse_long *) malloc ((n+1) * sizeof (SuiteSparse_long)) ;
    Ai = (SuiteSparse_long *) malloc (nz1 * sizeof (SuiteSparse_long)) ;
    Ax = (double *) malloc (nz1 * sizeof (double)) ;
    Az = (double *) malloc (nz1 * sizeof (double)) ;
    if (!Ap || !Ai || !Ax || !Az)
    {
	error ("out of memory") ;
    }

    status = umfpack_zl_triplet_to_col (n, n, nz, Arow, Acol, Aval, Avalz,
	Ap, Ai, Ax, Az, (SuiteSparse_long *) NULL) ;

    if (status < 0)
    {
	umfpack_zl_report_status (Control, status) ;
	error ("umfpack_zl_triplet_to_col failed") ;
    }

    /* print the column-form of A */
    printf ("\nA: ") ;
    (void) umfpack_zl_report_matrix (n, n, Ap, Ai, Ax, Az, 1, Control) ;

    /* ---------------------------------------------------------------------- */
    /* symbolic factorization */
    /* ---------------------------------------------------------------------- */

    status = umfpack_zl_symbolic (n, n, Ap, Ai, Ax, Az, &Symbolic,
	Control, Info) ;
    if (status < 0)
    {
	umfpack_zl_report_info (Control, Info) ;
	umfpack_zl_report_status (Control, status) ;
	error ("umfpack_zl_symbolic failed") ;
    }

    /* print the symbolic factorization */

    printf ("\nSymbolic factorization of A: ") ;
    (void) umfpack_zl_report_symbolic (Symbolic, Control) ;

    /* ---------------------------------------------------------------------- */
    /* numeric factorization */
    /* ---------------------------------------------------------------------- */

    status = umfpack_zl_numeric (Ap, Ai, Ax, Az, Symbolic, &Numeric,
	Control, Info) ;
    if (status < 0)
    {
	umfpack_zl_report_info (Control, Info) ;
	umfpack_zl_report_status (Control, status) ;
	error ("umfpack_zl_numeric failed") ;
    }

    /* print the numeric factorization */
    printf ("\nNumeric factorization of A: ") ;
    (void) umfpack_zl_report_numeric (Numeric, Control) ;

    /* ---------------------------------------------------------------------- */
    /* solve Ax=b */
    /* ---------------------------------------------------------------------- */

    status = umfpack_zl_solve (UMFPACK_A, Ap, Ai, Ax, Az, x, xz, b, bz,
	Numeric, Control, Info) ;
    umfpack_zl_report_info (Control, Info) ;
    umfpack_zl_report_status (Control, status) ;
    if (status < 0)
    {
	error ("umfpack_zl_solve failed") ;
    }
    printf ("\nx (solution of Ax=b): ") ;
    (void) umfpack_zl_report_vector (n, x, xz, Control) ;
    rnorm = resid (FALSE, Ap, Ai, Ax, Az) ;
    printf ("maxnorm of residual: %g\n\n", rnorm) ;

    /* ---------------------------------------------------------------------- */
    /* compute the determinant */
    /* ---------------------------------------------------------------------- */

    status = umfpack_zl_get_determinant (x, xz, r, Numeric, Info) ;
    umfpack_zl_report_status (Control, status) ;
    if (status < 0)
    {
	error ("umfpack_zl_get_determinant failed") ;
    }
    printf ("determinant: (%g", x [0]) ;
    printf ("+ (%g)i", xz [0]) ; /* complex */
    printf (") * 10^(%g)\n", r [0]) ;

    /* ---------------------------------------------------------------------- */
    /* solve Ax=b, broken down into steps */
    /* ---------------------------------------------------------------------- */

    /* Rb = R*b */
    Rb  = (double *) malloc (n * sizeof (double)) ;
    Rbz = (double *) malloc (n * sizeof (double)) ;
    y   = (double *) malloc (n * sizeof (double)) ;
    yz  = (double *) malloc (n * sizeof (double)) ;
    if (!Rb || !y) error ("out of memory") ;
    if (!Rbz || !yz) error ("out of memory") ;

    status = umfpack_zl_scale (Rb, Rbz, b, bz, Numeric) ;
    if (status < 0) error ("umfpack_zl_scale failed") ;
    /* solve Ly = P*(Rb) */
    status = umfpack_zl_solve (UMFPACK_Pt_L, Ap, Ai, Ax, Az, y, yz, Rb, Rbz,
	Numeric, Control, Info) ;
    if (status < 0) error ("umfpack_zl_solve failed") ;
    /* solve UQ'x=y */
    status = umfpack_zl_solve (UMFPACK_U_Qt, Ap, Ai, Ax, Az, x, xz, y, yz,
	Numeric, Control, Info) ;
    if (status < 0) error ("umfpack_zl_solve failed") ;
    printf ("\nx (solution of Ax=b, solve is split into 3 steps): ") ;
    (void) umfpack_zl_report_vector (n, x, xz, Control) ;
    rnorm = resid (FALSE, Ap, Ai, Ax, Az) ;
    printf ("maxnorm of residual: %g\n\n", rnorm) ;

    free (Rb) ;
    free (Rbz) ;
    free (y) ;
    free (yz) ;

    /* ---------------------------------------------------------------------- */
    /* solve A'x=b */
    /* ---------------------------------------------------------------------- */

    /* note that this is the complex conjugate transpose, A' */
    status = umfpack_zl_solve (UMFPACK_At, Ap, Ai, Ax, Az, x, xz, b, bz,
	Numeric, Control, Info) ;
    umfpack_zl_report_info (Control, Info) ;
    if (status < 0)
    {
	error ("umfpack_zl_solve failed") ;
    }
    printf ("\nx (solution of A'x=b): ") ;
    (void) umfpack_zl_report_vector (n, x, xz, Control) ;
    rnorm = resid (TRUE, Ap, Ai, Ax, Az) ;
    printf ("maxnorm of residual: %g\n\n", rnorm) ;

    /* ---------------------------------------------------------------------- */
    /* modify one numerical value in the column-form of A */
    /* ---------------------------------------------------------------------- */

    /* change A (1,4), look for row 1 in column 4. */
    row = 1 ;
    col = 4 ;
    for (p = Ap [col] ; p < Ap [col+1] ; p++)
    {
	if (row == Ai [p])
	{
	    printf ("\nchanging A (%ld,%ld) to zero\n", row, col) ;
	    Ax [p] = 0.0 ;
	    Az [p] = 0.0 ;
	    break ;
	}
    }
    printf ("\nmodified A: ") ;
    (void) umfpack_zl_report_matrix (n, n, Ap, Ai, Ax, Az, 1, Control) ;

    /* ---------------------------------------------------------------------- */
    /* redo the numeric factorization */
    /* ---------------------------------------------------------------------- */

    /* The pattern (Ap and Ai) hasn't changed, so the symbolic factorization */
    /* doesn't have to be redone, no matter how much we change Ax. */

    /* We don't need the Numeric object any more, so free it. */
    umfpack_zl_free_numeric (&Numeric) ;

    /* Note that a memory leak would have occurred if the old Numeric */
    /* had not been free'd with umfpack_zl_free_numeric above. */
    status = umfpack_zl_numeric (Ap, Ai, Ax, Az, Symbolic, &Numeric,
	Control, Info) ;
    if (status < 0)
    {
	umfpack_zl_report_info (Control, Info) ;
	umfpack_zl_report_status (Control, status) ;
	error ("umfpack_zl_numeric failed") ;
    }
    printf ("\nNumeric factorization of modified A: ") ;
    (void) umfpack_zl_report_numeric (Numeric, Control) ;

    /* ---------------------------------------------------------------------- */
    /* solve Ax=b, with the modified A */
    /* ---------------------------------------------------------------------- */

    status = umfpack_zl_solve (UMFPACK_A, Ap, Ai, Ax, Az, x, xz, b, bz,
	Numeric, Control, Info) ;
    umfpack_zl_report_info (Control, Info) ;
    if (status < 0)
    {
	umfpack_zl_report_status (Control, status) ;
	error ("umfpack_zl_solve failed") ;
    }
    printf ("\nx (with modified A): ") ;
    (void) umfpack_zl_report_vector (n, x, xz, Control) ;
    rnorm = resid (FALSE, Ap, Ai, Ax, Az) ;
    printf ("maxnorm of residual: %g\n\n", rnorm) ;

    /* ---------------------------------------------------------------------- */
    /* modify all of the numerical values of A, but not the pattern */
    /* ---------------------------------------------------------------------- */

    for (col = 0 ; col < n ; col++)
    {
	for (p = Ap [col] ; p < Ap [col+1] ; p++)
	{
	    row = Ai [p] ;
	    printf ("changing ") ;
	    /* complex: */ printf ("real part of ") ;
	    printf ("A (%ld,%ld) from %g", row, col, Ax [p]) ;
	    Ax [p] = Ax [p] + col*10 - row ;
	    printf (" to %g\n", Ax [p]) ;
	}
    }
    printf ("\ncompletely modified A (same pattern): ") ;
    (void) umfpack_zl_report_matrix (n, n, Ap, Ai, Ax, Az, 1, Control) ;

    /* ---------------------------------------------------------------------- */
    /* save the Symbolic object to file, free it, and load it back in */
    /* ---------------------------------------------------------------------- */

    /* use the default filename, "symbolic.umf" */
    printf ("\nSaving symbolic object:\n") ;
    status = umfpack_zl_save_symbolic (Symbolic, (char *) NULL) ;
    if (status < 0)
    {
	umfpack_zl_report_status (Control, status) ;
	error ("umfpack_zl_save_symbolic failed") ;
    }
    printf ("\nFreeing symbolic object:\n") ;
    umfpack_zl_free_symbolic (&Symbolic) ;
    printf ("\nLoading symbolic object:\n") ;
    status = umfpack_zl_load_symbolic (&Symbolic, (char *) NULL) ;
    if (status < 0)
    {
	umfpack_zl_report_status (Control, status) ;
	error ("umfpack_zl_load_symbolic failed") ;
    }
    printf ("\nDone loading symbolic object\n") ;

    /* ---------------------------------------------------------------------- */
    /* redo the numeric factorization */
    /* ---------------------------------------------------------------------- */

    umfpack_zl_free_numeric (&Numeric) ;
    status = umfpack_zl_numeric (Ap, Ai, Ax, Az, Symbolic, &Numeric,
	Control, Info) ;
    if (status < 0)
    {
	umfpack_zl_report_info (Control, Info) ;
	umfpack_zl_report_status (Control, status) ;
	error ("umfpack_zl_numeric failed") ;
    }
    printf ("\nNumeric factorization of completely modified A: ") ;
    (void) umfpack_zl_report_numeric (Numeric, Control) ;

    /* ---------------------------------------------------------------------- */
    /* solve Ax=b, with the modified A */
    /* ---------------------------------------------------------------------- */

    status = umfpack_zl_solve (UMFPACK_A, Ap, Ai, Ax, Az, x, xz, b, bz,
	Numeric, Control, Info) ;
    umfpack_zl_report_info (Control, Info) ;
    if (status < 0)
    {
	umfpack_zl_report_status (Control, status) ;
	error ("umfpack_zl_solve failed") ;
    }
    printf ("\nx (with completely modified A): ") ;
    (void) umfpack_zl_report_vector (n, x, xz, Control) ;
    rnorm = resid (FALSE, Ap, Ai, Ax, Az) ;
    printf ("maxnorm of residual: %g\n\n", rnorm) ;

    /* ---------------------------------------------------------------------- */
    /* free the symbolic and numeric factorization */
    /* ---------------------------------------------------------------------- */

    umfpack_zl_free_symbolic (&Symbolic) ;
    umfpack_zl_free_numeric (&Numeric) ;

    /* ---------------------------------------------------------------------- */
    /* C = transpose of A */
    /* ---------------------------------------------------------------------- */

    Cp = (SuiteSparse_long *) malloc ((n+1) * sizeof (SuiteSparse_long)) ;
    Ci = (SuiteSparse_long *) malloc (nz1 * sizeof (SuiteSparse_long)) ;
    Cx = (double *) malloc (nz1 * sizeof (double)) ;
    Cz = (double *) malloc (nz1 * sizeof (double)) ;
    if (!Cp || !Ci || !Cx || !Cz)
    {
	error ("out of memory") ;
    }
    status = umfpack_zl_transpose (n, n, Ap, Ai, Ax, Az,
	(SuiteSparse_long *) NULL, (SuiteSparse_long *) NULL, Cp, Ci, Cx, Cz, TRUE) ;
    if (status < 0)
    {
	umfpack_zl_report_status (Control, status) ;
	error ("umfpack_zl_transpose failed: ") ;
    }
    printf ("\nC (transpose of A): ") ;
    (void) umfpack_zl_report_matrix (n, n, Cp, Ci, Cx, Cz, 1, Control) ;

    /* ---------------------------------------------------------------------- */
    /* symbolic factorization of C */
    /* ---------------------------------------------------------------------- */

    status = umfpack_zl_symbolic (n, n, Cp, Ci, Cx, Cz, &Symbolic,
	Control, Info) ;
    if (status < 0)
    {
	umfpack_zl_report_info (Control, Info) ;
	umfpack_zl_report_status (Control, status) ;
	error ("umfpack_zl_symbolic failed") ;
    }
    printf ("\nSymbolic factorization of C: ") ;
    (void) umfpack_zl_report_symbolic (Symbolic, Control) ;

    /* ---------------------------------------------------------------------- */
    /* copy the contents of Symbolic into user arrays print them */
    /* ---------------------------------------------------------------------- */

    printf ("\nGet the contents of the Symbolic object for C:\n") ;
    printf ("(compare with umfpack_zl_report_symbolic output, above)\n") ;
    Pinit = (SuiteSparse_long *) malloc ((n+1) * sizeof (SuiteSparse_long)) ;
    Qinit = (SuiteSparse_long *) malloc ((n+1) * sizeof (SuiteSparse_long)) ;
    Front_npivcol = (SuiteSparse_long *) malloc ((n+1) * sizeof (SuiteSparse_long)) ;
    Front_1strow = (SuiteSparse_long *) malloc ((n+1) * sizeof (SuiteSparse_long)) ;
    Front_leftmostdesc = (SuiteSparse_long *) malloc ((n+1) * sizeof (SuiteSparse_long)) ;
    Front_parent = (SuiteSparse_long *) malloc ((n+1) * sizeof (SuiteSparse_long)) ;
    Chain_start = (SuiteSparse_long *) malloc ((n+1) * sizeof (SuiteSparse_long)) ;
    Chain_maxrows = (SuiteSparse_long *) malloc ((n+1) * sizeof (SuiteSparse_long)) ;
    Chain_maxcols = (SuiteSparse_long *) malloc ((n+1) * sizeof (SuiteSparse_long)) ;
    if (!Pinit || !Qinit || !Front_npivcol || !Front_parent || !Chain_start ||
	!Chain_maxrows || !Chain_maxcols || !Front_1strow ||
	!Front_leftmostdesc)
    {
	error ("out of memory") ;
    }

    status = umfpack_zl_get_symbolic (&nr, &nc, &n1, &anz, &nfr, &nchains,
	Pinit, Qinit, Front_npivcol, Front_parent, Front_1strow,
	Front_leftmostdesc, Chain_start, Chain_maxrows, Chain_maxcols,
	Symbolic) ;

    if (status < 0)
    {
	error ("symbolic factorization invalid") ;
    }

    printf ("From the Symbolic object, C is of dimension %ld-by-%ld\n", nr, nc);
    printf ("   with nz = %ld, number of fronts = %ld,\n", nz, nfr) ;
    printf ("   number of frontal matrix chains = %ld\n", nchains) ;

    printf ("\nPivot columns in each front, and parent of each front:\n") ;
    k = 0 ;
    for (i = 0 ; i < nfr ; i++)
    {
	fnpiv = Front_npivcol [i] ;
	printf ("    Front %ld: parent front: %ld number of pivot cols: %ld\n",
		i, Front_parent [i], fnpiv) ;
	for (j = 0 ; j < fnpiv ; j++)
	{
	    col = Qinit [k] ;
	    printf (
	    "        %ld-th pivot column is column %ld in original matrix\n",
		k, col) ;
	    k++ ;
	}
    }

    printf ("\nNote that the column ordering, above, will be refined\n") ;
    printf ("in the numeric factorization below.  The assignment of pivot\n") ;
    printf ("columns to frontal matrices will always remain unchanged.\n") ;

    printf ("\nTotal number of pivot columns in frontal matrices: %ld\n", k) ;

    printf ("\nFrontal matrix chains:\n") ;
    for (j = 0 ; j < nchains ; j++)
    {
	printf ("   Frontal matrices %ld to %ld are factorized in a single\n",
	    Chain_start [j], Chain_start [j+1] - 1) ;
	printf ("        working array of size %ld-by-%ld\n",
	    Chain_maxrows [j], Chain_maxcols [j]) ;
    }

    /* ---------------------------------------------------------------------- */
    /* numeric factorization of C */
    /* ---------------------------------------------------------------------- */

    status = umfpack_zl_numeric (Cp, Ci, Cx, Cz, Symbolic, &Numeric,
	Control, Info) ;
    if (status < 0)
    {
	error ("umfpack_zl_numeric failed") ;
    }
    printf ("\nNumeric factorization of C: ") ;
    (void) umfpack_zl_report_numeric (Numeric, Control) ;

    /* ---------------------------------------------------------------------- */
    /* extract the LU factors of C and print them */
    /* ---------------------------------------------------------------------- */

    if (umfpack_zl_get_lunz (&lnz, &unz, &nr, &nc, &nzud, Numeric) < 0)
    {
	error ("umfpack_zl_get_lunz failed") ;
    }
    /* ensure arrays are not of zero size */
    lnz1 = MAX (lnz,1) ;
    unz1 = MAX (unz,1) ;
    Lp = (SuiteSparse_long *) malloc ((n+1) * sizeof (SuiteSparse_long)) ;
    Lj = (SuiteSparse_long *) malloc (lnz1 * sizeof (SuiteSparse_long)) ;
    Lx = (double *) malloc (lnz1 * sizeof (double)) ;
    Lz = (double *) malloc (lnz1 * sizeof (double)) ;
    Up = (SuiteSparse_long *) malloc ((n+1) * sizeof (SuiteSparse_long)) ;
    Ui = (SuiteSparse_long *) malloc (unz1 * sizeof (SuiteSparse_long)) ;
    Ux = (double *) malloc (unz1 * sizeof (double)) ;
    Uz = (double *) malloc (unz1 * sizeof (double)) ;
    P = (SuiteSparse_long *) malloc (n * sizeof (SuiteSparse_long)) ;
    Q = (SuiteSparse_long *) malloc (n * sizeof (SuiteSparse_long)) ;
    Dx = (double *) NULL ;	/* D vector not requested */
    Dz = (double *) NULL ;
    Rs  = (double *) malloc (n * sizeof (double)) ;
    if (!Lp || !Lj || !Lx || !Lz || !Up || !Ui || !Ux || !Uz || !P || !Q || !Rs)
    {
	error ("out of memory") ;
    }
    status = umfpack_zl_get_numeric (Lp, Lj, Lx, Lz, Up, Ui, Ux, Uz,
	P, Q, Dx, Dz, &do_recip, Rs, Numeric) ;
    if (status < 0)
    {
	error ("umfpack_zl_get_numeric failed") ;
    }

    printf ("\nL (lower triangular factor of C): ") ;
    (void) umfpack_zl_report_matrix (n, n, Lp, Lj, Lx, Lz, 0, Control) ;
    printf ("\nU (upper triangular factor of C): ") ;
    (void) umfpack_zl_report_matrix (n, n, Up, Ui, Ux, Uz, 1, Control) ;
    printf ("\nP: ") ;
    (void) umfpack_zl_report_perm (n, P, Control) ;
    printf ("\nQ: ") ;
    (void) umfpack_zl_report_perm (n, Q, Control) ;
    printf ("\nScale factors: row i of A is to be ") ;
    if (do_recip)
    {
	printf ("multiplied by the ith scale factor\n") ;
    }
    else
    {
	printf ("divided by the ith scale factor\n") ;
    }
    for (i = 0 ; i < n ; i++) printf ("%ld: %g\n", i, Rs [i]) ;

    /* ---------------------------------------------------------------------- */
    /* convert L to triplet form and print it */
    /* ---------------------------------------------------------------------- */

    /* Note that L is in row-form, so it is the row indices that are created */
    /* by umfpack_zl_col_to_triplet. */

    printf ("\nConverting L to triplet form, and printing it:\n") ;
    Li = (SuiteSparse_long *) malloc (lnz1 * sizeof (SuiteSparse_long)) ;
    if (!Li)
    {
	error ("out of memory") ;
    }
    if (umfpack_zl_col_to_triplet (n, Lp, Li) < 0)
    {
	error ("umfpack_zl_col_to_triplet failed") ;
    }
    printf ("\nL, in triplet form: ") ;
    (void) umfpack_zl_report_triplet (n, n, lnz, Li, Lj, Lx, Lz, Control) ;

    /* ---------------------------------------------------------------------- */
    /* save the Numeric object to file, free it, and load it back in */
    /* ---------------------------------------------------------------------- */

    /* use the default filename, "numeric.umf" */
    printf ("\nSaving numeric object:\n") ;
    status = umfpack_zl_save_numeric (Numeric, (char *) NULL) ;
    if (status < 0)
    {
	umfpack_zl_report_status (Control, status) ;
	error ("umfpack_zl_save_numeric failed") ;
    }
    printf ("\nFreeing numeric object:\n") ;
    umfpack_zl_free_numeric (&Numeric) ;
    printf ("\nLoading numeric object:\n") ;
    status = umfpack_zl_load_numeric (&Numeric, (char *) NULL) ;
    if (status < 0)
    {
	umfpack_zl_report_status (Control, status) ;
	error ("umfpack_zl_load_numeric failed") ;
    }
    printf ("\nDone loading numeric object\n") ;

    /* ---------------------------------------------------------------------- */
    /* solve C'x=b */
    /* ---------------------------------------------------------------------- */

    status = umfpack_zl_solve (UMFPACK_At, Cp, Ci, Cx, Cz, x, xz, b, bz,
	Numeric, Control, Info) ;
    umfpack_zl_report_info (Control, Info) ;
    if (status < 0)
    {
	umfpack_zl_report_status (Control, status) ;
	error ("umfpack_zl_solve failed") ;
    }
    printf ("\nx (solution of C'x=b): ") ;
    (void) umfpack_zl_report_vector (n, x, xz, Control) ;
    rnorm = resid (TRUE, Cp, Ci, Cx, Cz) ;
    printf ("maxnorm of residual: %g\n\n", rnorm) ;

    /* ---------------------------------------------------------------------- */
    /* solve C'x=b again, using umfpack_zl_wsolve instead */
    /* ---------------------------------------------------------------------- */

    printf ("\nSolving C'x=b again, using umfpack_zl_wsolve instead:\n") ;
    Wi = (SuiteSparse_long *) malloc (n * sizeof (SuiteSparse_long)) ;
    W = (double *) malloc (10*n * sizeof (double)) ;
    if (!Wi || !W)
    {
	error ("out of memory") ;
    }

    status = umfpack_zl_wsolve (UMFPACK_At, Cp, Ci, Cx, Cz, x, xz, b, bz,
	Numeric, Control, Info, Wi, W) ;
    umfpack_zl_report_info (Control, Info) ;
    if (status < 0)
    {
	umfpack_zl_report_status (Control, status) ;
	error ("umfpack_zl_wsolve failed") ;
    }
    printf ("\nx (solution of C'x=b): ") ;
    (void) umfpack_zl_report_vector (n, x, xz, Control) ;
    rnorm = resid (TRUE, Cp, Ci, Cx, Cz) ;
    printf ("maxnorm of residual: %g\n\n", rnorm) ;

    /* ---------------------------------------------------------------------- */
    /* free everything */
    /* ---------------------------------------------------------------------- */

    /* This is not strictly required since the process is exiting and the */
    /* system will reclaim the memory anyway.  It's useful, though, just as */
    /* a list of what is currently malloc'ed by this program.  Plus, it's */
    /* always a good habit to explicitly free whatever you malloc. */

    free (Ap) ;
    free (Ai) ;
    free (Ax) ;
    free (Az) ;

    free (Cp) ;
    free (Ci) ;
    free (Cx) ;
    free (Cz) ;

    free (Pinit) ;
    free (Qinit) ;
    free (Front_npivcol) ;
    free (Front_1strow) ;
    free (Front_leftmostdesc) ;
    free (Front_parent) ;
    free (Chain_start) ;
    free (Chain_maxrows) ;
    free (Chain_maxcols) ;

    free (Lp) ;
    free (Lj) ;
    free (Lx) ;
    free (Lz) ;

    free (Up) ;
    free (Ui) ;
    free (Ux) ;
    free (Uz) ;

    free (P) ;
    free (Q) ;

    free (Li) ;

    free (Wi) ;
    free (W) ;

    umfpack_zl_free_symbolic (&Symbolic) ;
    umfpack_zl_free_numeric (&Numeric) ;

    /* ---------------------------------------------------------------------- */
    /* print the total time spent in this demo */
    /* ---------------------------------------------------------------------- */

    umfpack_toc (t) ;
    printf ("\numfpack_zl_demo complete.\nTotal time: %5.2f seconds"
	" (CPU time), %5.2f seconds (wallclock time)\n", t [1], t [0]) ;
    return (0) ;
}
void sparse_free(int uts)
/*< sparse free>*/
{
    int its;

    (void) umfpack_zl_free_symbolic(&Symbolic);

    for (its=0; its<uts; its++) {
        (void) umfpack_zl_free_numeric(&Numeric[its]);
    }

    free(Ti); free(Tj); free(Tx); free(Tz);
    free(Ap); free(Ai); free(Map);
    free(Ax); free(Az);

    for (its=0; its< uts; its++ ) {
        free(Bx[its]); free(Bz[its]); free(Xx[its]); free(Xz[its]);
    }
}
Пример #3
0
int main(int argc, char* argv[])
{
    bool verb, save, load;
    int npml, pad1, pad2, n1, n2; 
    int ih, nh, is, ns, iw, nw, i, j;
    SuiteSparse_long n, nz, *Ti, *Tj;
    float d1, d2, **vel, ****image, ****timage, dw, ow;
    double omega, *Tx, *Tz;
    SuiteSparse_long *Ap, *Ai, *Map;
    double *Ax, *Az, **Xx, **Xz, **Bx, **Bz;
    void *Symbolic, **Numeric;
    double Control[UMFPACK_CONTROL];
    sf_complex ***srce, ***recv;
    char *datapath, *insert, *append;
    size_t srclen, inslen;
    sf_file in, out, source, data, us, ur, timg;
    int uts, its, mts;
    sf_timer timer;
    char *order;

    sf_init(argc,argv);
    in  = sf_input("in");
    out = sf_output("out");

    if (!sf_getbool("verb",&verb)) verb=false;
    /* verbosity flag */

    if (verb)
	timer = sf_timer_init();
    else
	timer = NULL;

    if (!sf_getbool("save",&save)) save=false;
    /* save LU */

    if (!sf_getbool("load",&load)) load=false;
    /* load LU */

    if (save || load) {
	datapath = sf_histstring(in,"in");
	srclen = strlen(datapath);
	insert = sf_charalloc(6);
    } else {
	datapath = NULL;
	srclen = 0;
	insert = NULL;
	append = NULL;
    }

    if (!sf_getint("uts",&uts)) uts=0;
    /* number of OMP threads */

#ifdef _OPENMP
    mts = omp_get_max_threads();
#else
    mts = 1;
#endif

    uts = (uts < 1)? mts: uts;
    if (verb) sf_warning("Using %d out of %d threads.",uts,mts);

    if (!sf_getint("nh",&nh)) nh=0;
    /* horizontal space-lag */

    if (!sf_getint("npml",&npml)) npml=10;
    /* PML width */

    if (NULL == (order = sf_getstring("order"))) order="j";
    /* discretization scheme (default optimal 9-point) */

    fdprep_order(order);

    /* read model */
    if (!sf_histint(in,"n1",&n1)) sf_error("No n1= in input.");
    if (!sf_histint(in,"n2",&n2)) sf_error("No n2= in input.");

    if (!sf_histfloat(in,"d1",&d1)) sf_error("No d1= in input.");
    if (!sf_histfloat(in,"d2",&d2)) sf_error("No d2= in input.");

    vel = sf_floatalloc2(n1,n2);
    sf_floatread(vel[0],n1*n2,in);

    /* read source */
    if (NULL == sf_getstring("source"))
	sf_error("Need source=");
    source = sf_input("source");

    if (!sf_histint(source,"n3",&ns)) sf_error("No ns=.");
    if (!sf_histint(source,"n4",&nw)) sf_error("No nw=.");
    if (!sf_histfloat(source,"d4",&dw)) sf_error("No dw=.");
    if (!sf_histfloat(source,"o4",&ow)) sf_error("No ow=.");

    srce = sf_complexalloc3(n1,n2,ns);

    /* read receiver */
    if (NULL == sf_getstring("data"))
	sf_error("Need data=");
    data = sf_input("data");

    recv = sf_complexalloc3(n1,n2,ns);

    /* write output header */
    sf_putint(out,"n3",2*nh+1);
    sf_putfloat(out,"d3",d2);
    sf_putfloat(out,"o3",(float) -nh*d2);

    /* output source wavefield */
    if (NULL != sf_getstring("us")) {
	us = sf_output("us");
	
	sf_settype(us,SF_COMPLEX);
	sf_putint(us,"n3",ns);
	sf_putstring(us,"label3","Shot");
	sf_putstring(us,"unit3","");
	sf_putint(us,"n4",nw);
	sf_putfloat(us,"d4",dw);
	sf_putfloat(us,"o4",ow);
	sf_putstring(us,"label4","Frequency");
	sf_putstring(us,"unit4","Hz");
    } else {
	us = NULL;
    }

    /* output receiver wavefield */
    if (NULL != sf_getstring("ur")) {
	ur = sf_output("ur");
	
	sf_settype(ur,SF_COMPLEX);
	sf_putint(ur,"n3",ns);
	sf_putstring(ur,"label3","Shot");
	sf_putstring(ur,"unit3","");
	sf_putint(ur,"n4",nw);
	sf_putfloat(ur,"d4",dw);
	sf_putfloat(ur,"o4",ow);
	sf_putstring(ur,"label4","Frequency");
	sf_putstring(ur,"unit4","Hz");
    } else {
	ur = NULL;
    }

    /* output time-shift image derivative */
    if (NULL != sf_getstring("timg")) {
	timg = sf_output("timg");

	sf_putint(timg,"n3",2*nh+1);
	sf_putfloat(timg,"d3",d2);
	sf_putfloat(timg,"o3",(float) -nh*d2);

	timage = (float****) sf_alloc(uts,sizeof(float***));
	for (its=0; its < uts; its++) {
	    timage[its] = sf_floatalloc3(n1,n2,2*nh+1);
	}
    } else {
	timg = NULL;
	timage = NULL;
    }

    /* allocate temporary memory */    
    if (load) {
	Ti = NULL; Tj = NULL; Tx = NULL; Tz = NULL; 
	Ap = NULL; Ai = NULL; Map = NULL; Ax = NULL; Az = NULL;
    }
    
    Bx = (double**) sf_alloc(uts,sizeof(double*));
    Bz = (double**) sf_alloc(uts,sizeof(double*));
    Xx = (double**) sf_alloc(uts,sizeof(double*));
    Xz = (double**) sf_alloc(uts,sizeof(double*));

    image = (float****) sf_alloc(uts,sizeof(float***));
    for (its=0; its < uts; its++) {
	image[its] = sf_floatalloc3(n1,n2,2*nh+1);
    }
    
    Numeric = (void**) sf_alloc(uts,sizeof(void*));

    /* LU control */
    umfpack_zl_defaults (Control);
    Control [UMFPACK_IRSTEP] = 0;

    /* loop over frequency */
    for (iw=0; iw < nw; iw++) {
	omega = (double) 2.*SF_PI*(ow+iw*dw);

	/* PML padding */
	pad1 = n1+2*npml;
	pad2 = n2+2*npml;

	n  = fdprep_n (pad1,pad2);
	nz = fdprep_nz(pad1,pad2);

	if (!load) {
	    Ti = (SuiteSparse_long*) sf_alloc(nz,sizeof(SuiteSparse_long));
	    Tj = (SuiteSparse_long*) sf_alloc(nz,sizeof(SuiteSparse_long));
	    Tx = (double*) sf_alloc(nz,sizeof(double));
	    Tz = (double*) sf_alloc(nz,sizeof(double));
	    
	    Ap = (SuiteSparse_long*) sf_alloc(n+1,sizeof(SuiteSparse_long));
	    Ai = (SuiteSparse_long*) sf_alloc(nz,sizeof(SuiteSparse_long));
	    Map = (SuiteSparse_long*) sf_alloc(nz,sizeof(SuiteSparse_long));
	    
	    Ax = (double*) sf_alloc(nz,sizeof(double));
	    Az = (double*) sf_alloc(nz,sizeof(double));
	}
	for (its=0; its < uts; its++) {
	    Bx[its] = (double*) sf_alloc(n,sizeof(double));
	    Bz[its] = (double*) sf_alloc(n,sizeof(double));
	    Xx[its] = (double*) sf_alloc(n,sizeof(double));
	    Xz[its] = (double*) sf_alloc(n,sizeof(double));
	}

	if (verb) {
	    sf_warning("Frequency %d of %d.",iw+1,nw);
	    sf_timer_start(timer);
	}

	/* LU file (append _lu* after velocity file) */
	if (save || load) {
	    sprintf(insert,"_lu%d",iw);
	    inslen = strlen(insert);
	    
	    append = malloc(srclen+inslen+1);

	    memcpy(append,datapath,srclen-5);
	    memcpy(append+srclen-5,insert,inslen);
	    memcpy(append+srclen-5+inslen,datapath+srclen-5,5+1);
	}

	if (!load) {
	    /* assemble matrix */
	    fdprep(omega,
		   n1, n2, d1, d2, vel,
		   npml, pad1, pad2,
		   Ti, Tj, Tx, Tz);	    
	    
	    (void) umfpack_zl_triplet_to_col (n, n, nz, 
					      Ti, Tj, Tx, Tz, 
					      Ap, Ai, Ax, Az, Map);	    

	    /* LU */
	    (void) umfpack_zl_symbolic (n, n, 
					Ap, Ai, Ax, Az, 
					&Symbolic, Control, NULL);
	    
	    (void) umfpack_zl_numeric (Ap, Ai, Ax, Az, 
				       Symbolic, &Numeric[0], 
				       Control, NULL);
	    
	    /* save Numeric */
#ifdef _OPENMP
	    (void) umfpack_zl_save_numeric (Numeric[0], append);
	    
	    for (its=1; its < uts; its++) {
		(void) umfpack_zl_load_numeric (&Numeric[its], append);
	    }
	    
	    if (!save) {
		(void) remove (append);
		(void) remove ("numeric.umf");
	    }
#else
	    if (save) (void) umfpack_zl_save_numeric (Numeric[0], append);
#endif
	} else {
	    /* load Numeric */
	    for (its=0; its < uts; its++) {
		(void) umfpack_zl_load_numeric (&Numeric[its], append);
	    }
	}
	
	if (save || load) free(append);

	/* read source and data */
	sf_complexread(srce[0][0],n1*n2*ns,source);
	sf_complexread(recv[0][0],n1*n2*ns,data);

	/* loop over shots */
#ifdef _OPENMP
#pragma omp parallel for num_threads(uts) private(its,ih,j,i)
#endif
	for (is=0; is < ns; is++) {
#ifdef _OPENMP
	    its = omp_get_thread_num();
#else
	    its = 0;
#endif

	    /* source wavefield */
	    fdpad(npml,pad1,pad2, srce[is],Bx[its],Bz[its]);	    

	    (void) umfpack_zl_solve (UMFPACK_A, 
				     NULL, NULL, NULL, NULL, 
				     Xx[its], Xz[its], Bx[its], Bz[its], 
				     Numeric[its], Control, NULL);
	    
	    fdcut(npml,pad1,pad2, srce[is],Xx[its],Xz[its]);

	    /* receiver wavefield */
	    fdpad(npml,pad1,pad2, recv[is],Bx[its],Bz[its]);	    
	    
	    (void) umfpack_zl_solve (UMFPACK_At, 
				     NULL, NULL, NULL, NULL, 
				     Xx[its], Xz[its], Bx[its], Bz[its], 
				     Numeric[its], Control, NULL);
	    	    
	    fdcut(npml,pad1,pad2, recv[is],Xx[its],Xz[its]);

	    /* imaging condition */
	    for (ih=-nh; ih < nh+1; ih++) {
		for (j=0; j < n2; j++) {
		    for (i=0; i < n1; i++) {
			if (j-abs(ih) >= 0 && j+abs(ih) < n2) {
			    image[its][ih+nh][j][i] += crealf(conjf(srce[is][j-ih][i])*recv[is][j+ih][i]);
			    if (timg != NULL) timage[its][ih+nh][j][i] 
						  += crealf(2.*I*omega*conjf(srce[is][j-ih][i])*recv[is][j+ih][i]);
			}
		    }
		}
	    }
	}

	if (verb) {
	    sf_timer_stop (timer);
	    sf_warning("Finished in %g seconds.",sf_timer_get_diff_time(timer)/1.e3);
	}
	
	if (!load) (void) umfpack_zl_free_symbolic (&Symbolic);
	for (its=0; its < uts; its++) {
	    (void) umfpack_zl_free_numeric (&Numeric[its]);
	}

	if (!load) {
	    free(Ti); free(Tj); free(Tx); free(Tz);
	    free(Ap); free(Ai); free(Map);
	    free(Ax); free(Az);
	}
	for (its=0; its < uts; its++) {
	    free(Bx[its]); free(Bz[its]); free(Xx[its]); free(Xz[its]);
	}

	if (us != NULL) sf_complexwrite(srce[0][0],n1*n2*ns,us);
	if (ur != NULL) sf_complexwrite(recv[0][0],n1*n2*ns,ur);	
    }

#ifdef _OPENMP
#pragma omp parallel for num_threads(uts) private(j,i,its)
    for (ih=-nh; ih < nh+1; ih++) {
	for (j=0; j < n2; j++) {
	    for (i=0; i < n1; i++) {
		for (its=1; its < uts; its++) {
		    image[0][ih+nh][j][i] += image[its][ih+nh][j][i];
		    if (timg != NULL) timage[0][ih+nh][j][i] 
					  += timage[its][ih+nh][j][i];
		}
	    }
	}
    }
#endif
    
    sf_floatwrite(image[0][0][0],n1*n2*(2*nh+1),out);
    if (timg != NULL) sf_floatwrite(timage[0][0][0],n1*n2*(2*nh+1),timg);

    exit(0);
}
Пример #4
0
void iwigrad_oper(bool adj, bool add, int nx, int nr, float *x, float *r)
/*< linear operator >*/
{
    int iw, is, its, i;
    int pad1, pad2;
    SuiteSparse_long n, nz;
    double omega;

    sf_adjnull(adj,add,nx,nr,x,r);

    /* PML padding */
    pad1 = n1+2*npml;
    pad2 = n2+2*npml;

    n  = fdprep_n (pad1,pad2);
    nz = fdprep_nz(pad1,pad2);

    /* loop over frequency */
    for (iw=0; iw < nw; iw++) {
        omega = (double) 2.*SF_PI*(ow+iw*dw);

        if (!load) {
            Ti = (SuiteSparse_long*) sf_alloc(nz,sizeof(SuiteSparse_long));
            Tj = (SuiteSparse_long*) sf_alloc(nz,sizeof(SuiteSparse_long));
            Tx = (double*) sf_alloc(nz,sizeof(double));
            Tz = (double*) sf_alloc(nz,sizeof(double));

            Ap = (SuiteSparse_long*) sf_alloc(n+1,sizeof(SuiteSparse_long));
            Ai = (SuiteSparse_long*) sf_alloc(nz,sizeof(SuiteSparse_long));
            Map = (SuiteSparse_long*) sf_alloc(nz,sizeof(SuiteSparse_long));

            Ax = (double*) sf_alloc(nz,sizeof(double));
            Az = (double*) sf_alloc(nz,sizeof(double));
        }
        for (its=0; its < uts; its++) {
            Bx[its] = (double*) sf_alloc(n,sizeof(double));
            Bz[its] = (double*) sf_alloc(n,sizeof(double));
            Xx[its] = (double*) sf_alloc(n,sizeof(double));
            Xz[its] = (double*) sf_alloc(n,sizeof(double));
        }

        /* LU file (append _inv* after velocity file) */
        if (load) {
            sprintf(insert,"_inv%d",iw);
            inslen = strlen(insert);

            append = malloc(srclen+inslen+1);

            memcpy(append,datapath,srclen-5);
            memcpy(append+srclen-5,insert,inslen);
            memcpy(append+srclen-5+inslen,datapath+srclen-5,5+1);
        }

        if (!load) {
            /* assemble matrix */
            fdprep(omega,
                   n1, n2, d1, d2, vel,
                   npml, pad1, pad2,
                   Ti, Tj, Tx, Tz);

            (void) umfpack_zl_triplet_to_col (n, n, nz,
                                              Ti, Tj, Tx, Tz,
                                              Ap, Ai, Ax, Az, Map);

            /* LU */
            (void) umfpack_zl_symbolic (n, n,
                                        Ap, Ai, Ax, Az,
                                        &Symbolic, Control, NULL);

            (void) umfpack_zl_numeric (Ap, Ai, Ax, Az,
                                       Symbolic, &Numeric[0],
                                       Control, NULL);

#ifdef _OPENMP
            (void) umfpack_zl_save_numeric (Numeric[0], append);

            for (its=1; its < uts; its++) {
                (void) umfpack_zl_load_numeric (&Numeric[its], append);
            }

            (void) remove (append);
            (void) remove ("numeric.umf");
#endif
        } else {
            /* load Numeric */
            for (its=0; its < uts; its++) {
                (void) umfpack_zl_load_numeric (&Numeric[its], append);
            }
        }

        if (load) free(append);

        /* read wavefields from temporary file */
        sf_fslice_get(sfile,iw,us[0][0]);
        sf_fslice_get(rfile,iw,ur[0][0]);

        /* loop over shots */
#ifdef _OPENMP
        #pragma omp parallel for num_threads(uts) private(its)
#endif
        for (is=0; is < ns; is++) {
#ifdef _OPENMP
            its = omp_get_thread_num();
#else
            its = 0;
#endif

            /* adjoint source */
            adjsrce(ur[is],as[is], x,r,adj);

            fdpad(npml,pad1,pad2, as[is],Bx[its],Bz[its]);

            (void) umfpack_zl_solve (UMFPACK_At,
                                     NULL, NULL, NULL, NULL,
                                     Xx[its], Xz[its], Bx[its], Bz[its],
                                     Numeric[its], Control, NULL);

            fdcut(npml,pad1,pad2, as[is],Xx[its],Xz[its]);

            /* adjoint receiver */
            adjrecv(us[is],ar[is], x,r,adj);

            fdpad(npml,pad1,pad2, ar[is],Bx[its],Bz[its]);

            (void) umfpack_zl_solve (UMFPACK_A,
                                     NULL, NULL, NULL, NULL,
                                     Xx[its], Xz[its], Bx[its], Bz[its],
                                     Numeric[its], Control, NULL);

            fdcut(npml,pad1,pad2, ar[is],Xx[its],Xz[its]);

            /* assemble */
            iwiadd(omega, us[is],ur[is],as[is],ar[is], tempx[its],tempr[its],adj);

            /* clean up */
            if (adj) adjclean(as[is],ar[is]);
        }

        if (!load) (void) umfpack_zl_free_symbolic (&Symbolic);
        for (its=0; its < uts; its++) {
            (void) umfpack_zl_free_numeric (&Numeric[its]);
        }

        if (!load) {
            free(Ti);
            free(Tj);
            free(Tx);
            free(Tz);
            free(Ap);
            free(Ai);
            free(Map);
            free(Ax);
            free(Az);
        }
        for (its=0; its < uts; its++) {
            free(Bx[its]);
            free(Bz[its]);
            free(Xx[its]);
            free(Xz[its]);
        }
    }

#ifdef _OPENMP
    if (adj) {
        #pragma omp parallel for num_threads(uts) private(its)
        for (i=0; i < n1*n2; i++) {
            for (its=0; its < uts; its++) {
                x[i] += tempx[its][i];
                tempx[its][i] = 0.;
            }
        }
    } else {
        #pragma omp parallel for num_threads(uts) private(its)
        for (i=0; i < n1*n2*(2*nh+1); i++) {
            for (its=0; its < uts; its++) {
                r[i] += tempr[its][i];
                tempr[its][i] = 0.;
            }
        }
    }
#else
    if (adj) {
        for (i=0; i < n1*n2; i++) {
            x[i] = tempx[0][i];
            tempx[0][i] = 0.;
        }
    } else {
        for (i=0; i < n1*n2*(2*nh+1); i++) {
            r[i] = tempr[0][i];
            tempr[0][i] = 0.;
        }
    }
#endif
}