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_factor(double omega, int n1, int n2, float d1, float d2,
float **v, int npml, int pad1, int pad2, int uts)
/*< sparse factor>*/
{
int its;
char *append=NULL;
SuiteSparse_long status;
fdprep(omega, n1, n2, d1, d2, v,
npml, pad1, pad2, Ti, Tj, Tx, Tz);
status = umfpack_zl_triplet_to_col(n, n, nz,
Ti, Tj, Tx, Tz, Ap, Ai, Ax, Az, Map);
status = umfpack_zl_symbolic(n, n, Ap, Ai, Ax, Az,
&Symbolic, Control, NULL);
status = umfpack_zl_numeric(Ap, Ai, Ax, Az, Symbolic, &Numeric[0],
Control, NULL);
/* save Numeric */
#ifdef _OPENMP
status = umfpack_zl_save_numeric (Numeric[0], append);
for (its=1; its < uts; its++) {
status = umfpack_zl_load_numeric (&Numeric[its], append);
}
(void) remove (append);
(void) remove ("numeric.umf");
#endif
}
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);
}
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
}