void tlin::multiplyS(const SuperMatrix *A, const double *x, double *&y) { /* int sp_dgemv (char *, double, SuperMatrix *, double *, int, double, double *, int); */ if (!y) { y = (double *)malloc(A->nrow * sizeof(double)); memset(y, 0, A->nrow * sizeof(double)); } SuperMatrix *_A = const_cast<SuperMatrix *>(A); double *_x = const_cast<double *>(x); sp_dgemv((char *)"N", 1.0, _A, _x, 1, 1.0, y, 1); }
int sp_dgemm(char *trans, int m, int n, int k, double alpha, SuperMatrix *A, double *b, int ldb, double beta, double *c, int ldc) { /* Purpose ======= sp_d performs one of the matrix-matrix operations C := alpha*op( A )*op( B ) + beta*C, where op( X ) is one of op( X ) = X or op( X ) = X' or op( X ) = conjg( X' ), alpha and beta are scalars, and A, B and C are matrices, with op( A ) an m by k matrix, op( B ) a k by n matrix and C an m by n matrix. Parameters ========== TRANS - (input) char* On entry, TRANS specifies the operation to be performed as follows: TRANS = 'N' or 'n' y := alpha*A*x + beta*y. TRANS = 'T' or 't' y := alpha*A'*x + beta*y. TRANS = 'C' or 'c' y := alpha*A'*x + beta*y. M - (input) int On entry, M specifies the number of rows of the matrix op( A ) and of the matrix C. M must be at least zero. Unchanged on exit. N - (input) int On entry, N specifies the number of columns of the matrix op( B ) and the number of columns of the matrix C. N must be at least zero. Unchanged on exit. K - (input) int On entry, K specifies the number of columns of the matrix op( A ) and the number of rows of the matrix op( B ). K must be at least zero. Unchanged on exit. ALPHA - (input) double On entry, ALPHA specifies the scalar alpha. A - (input) SuperMatrix* Matrix A with a sparse format, of dimension (A->nrow, A->ncol). Currently, the type of A can be: Stype = NC or NCP; Dtype = SLU_D; Mtype = GE. In the future, more general A can be handled. B - DOUBLE PRECISION array of DIMENSION ( LDB, kb ), where kb is n when TRANSB = 'N' or 'n', and is k otherwise. Before entry with TRANSB = 'N' or 'n', the leading k by n part of the array B must contain the matrix B, otherwise the leading n by k part of the array B must contain the matrix B. Unchanged on exit. LDB - (input) int On entry, LDB specifies the first dimension of B as declared in the calling (sub) program. LDB must be at least max( 1, n ). Unchanged on exit. BETA - (input) double On entry, BETA specifies the scalar beta. When BETA is supplied as zero then C need not be set on input. C - DOUBLE PRECISION array of DIMENSION ( LDC, n ). Before entry, the leading m by n part of the array C must contain the matrix C, except when beta is zero, in which case C need not be set on entry. On exit, the array C is overwritten by the m by n matrix ( alpha*op( A )*B + beta*C ). LDC - (input) int On entry, LDC specifies the first dimension of C as declared in the calling (sub)program. LDC must be at least max(1,m). Unchanged on exit. ==== Sparse Level 3 Blas routine. */ int incx = 1, incy = 1; int j; for (j = 0; j < n; ++j) { sp_dgemv(trans, alpha, A, &b[ldb*j], incx, beta, &c[ldc*j], incy); } return 0; }
/*! \brief * * <pre> * Purpose * ======= * * DGSRFS improves the computed solution to a system of linear * equations and provides error bounds and backward error estimates for * the solution. * * If equilibration was performed, the system becomes: * (diag(R)*A_original*diag(C)) * X = diag(R)*B_original. * * See supermatrix.h for the definition of 'SuperMatrix' structure. * * Arguments * ========= * * trans (input) trans_t * Specifies the form of the system of equations: * = NOTRANS: A * X = B (No transpose) * = TRANS: A'* X = B (Transpose) * = CONJ: A**H * X = B (Conjugate transpose) * * A (input) SuperMatrix* * The original matrix A in the system, or the scaled A if * equilibration was done. The type of A can be: * Stype = SLU_NC, Dtype = SLU_D, Mtype = SLU_GE. * * L (input) SuperMatrix* * The factor L from the factorization Pr*A*Pc=L*U. Use * compressed row subscripts storage for supernodes, * i.e., L has types: Stype = SLU_SC, Dtype = SLU_D, Mtype = SLU_TRLU. * * U (input) SuperMatrix* * The factor U from the factorization Pr*A*Pc=L*U as computed by * dgstrf(). Use column-wise storage scheme, * i.e., U has types: Stype = SLU_NC, Dtype = SLU_D, Mtype = SLU_TRU. * * perm_c (input) int*, dimension (A->ncol) * Column permutation vector, which defines the * permutation matrix Pc; perm_c[i] = j means column i of A is * in position j in A*Pc. * * perm_r (input) int*, dimension (A->nrow) * Row permutation vector, which defines the permutation matrix Pr; * perm_r[i] = j means row i of A is in position j in Pr*A. * * equed (input) Specifies the form of equilibration that was done. * = 'N': No equilibration. * = 'R': Row equilibration, i.e., A was premultiplied by diag(R). * = 'C': Column equilibration, i.e., A was postmultiplied by * diag(C). * = 'B': Both row and column equilibration, i.e., A was replaced * by diag(R)*A*diag(C). * * R (input) double*, dimension (A->nrow) * The row scale factors for A. * If equed = 'R' or 'B', A is premultiplied by diag(R). * If equed = 'N' or 'C', R is not accessed. * * C (input) double*, dimension (A->ncol) * The column scale factors for A. * If equed = 'C' or 'B', A is postmultiplied by diag(C). * If equed = 'N' or 'R', C is not accessed. * * B (input) SuperMatrix* * B has types: Stype = SLU_DN, Dtype = SLU_D, Mtype = SLU_GE. * The right hand side matrix B. * if equed = 'R' or 'B', B is premultiplied by diag(R). * * X (input/output) SuperMatrix* * X has types: Stype = SLU_DN, Dtype = SLU_D, Mtype = SLU_GE. * On entry, the solution matrix X, as computed by dgstrs(). * On exit, the improved solution matrix X. * if *equed = 'C' or 'B', X should be premultiplied by diag(C) * in order to obtain the solution to the original system. * * FERR (output) double*, dimension (B->ncol) * The estimated forward error bound for each solution vector * X(j) (the j-th column of the solution matrix X). * If XTRUE is the true solution corresponding to X(j), FERR(j) * is an estimated upper bound for the magnitude of the largest * element in (X(j) - XTRUE) divided by the magnitude of the * largest element in X(j). The estimate is as reliable as * the estimate for RCOND, and is almost always a slight * overestimate of the true error. * * BERR (output) double*, dimension (B->ncol) * The componentwise relative backward error of each solution * vector X(j) (i.e., the smallest relative change in * any element of A or B that makes X(j) an exact solution). * * stat (output) SuperLUStat_t* * Record the statistics on runtime and floating-point operation count. * See util.h for the definition of 'SuperLUStat_t'. * * info (output) int* * = 0: successful exit * < 0: if INFO = -i, the i-th argument had an illegal value * * Internal Parameters * =================== * * ITMAX is the maximum number of steps of iterative refinement. * * </pre> */ void dgsrfs(trans_t trans, SuperMatrix *A, SuperMatrix *L, SuperMatrix *U, int *perm_c, int *perm_r, char *equed, double *R, double *C, SuperMatrix *B, SuperMatrix *X, double *ferr, double *berr, SuperLUStat_t *stat, int *info) { #define ITMAX 5 /* Table of constant values */ int ione = 1; double ndone = -1.; double done = 1.; /* Local variables */ NCformat *Astore; double *Aval; SuperMatrix Bjcol; DNformat *Bstore, *Xstore, *Bjcol_store; double *Bmat, *Xmat, *Bptr, *Xptr; int kase; double safe1, safe2; int i, j, k, irow, nz, count, notran, rowequ, colequ; int ldb, ldx, nrhs; double s, xk, lstres, eps, safmin; char transc[1]; trans_t transt; double *work; double *rwork; int *iwork; int isave[3]; extern int dlacon2_(int *, double *, double *, int *, double *, int *, int []); #ifdef _CRAY extern int SCOPY(int *, double *, int *, double *, int *); extern int SSAXPY(int *, double *, double *, int *, double *, int *); #else extern int dcopy_(int *, double *, int *, double *, int *); extern int daxpy_(int *, double *, double *, int *, double *, int *); #endif Astore = A->Store; Aval = Astore->nzval; Bstore = B->Store; Xstore = X->Store; Bmat = Bstore->nzval; Xmat = Xstore->nzval; ldb = Bstore->lda; ldx = Xstore->lda; nrhs = B->ncol; /* Test the input parameters */ *info = 0; notran = (trans == NOTRANS); if ( !notran && trans != TRANS && trans != CONJ ) *info = -1; else if ( A->nrow != A->ncol || A->nrow < 0 || A->Stype != SLU_NC || A->Dtype != SLU_D || A->Mtype != SLU_GE ) *info = -2; else if ( L->nrow != L->ncol || L->nrow < 0 || L->Stype != SLU_SC || L->Dtype != SLU_D || L->Mtype != SLU_TRLU ) *info = -3; else if ( U->nrow != U->ncol || U->nrow < 0 || U->Stype != SLU_NC || U->Dtype != SLU_D || U->Mtype != SLU_TRU ) *info = -4; else if ( ldb < SUPERLU_MAX(0, A->nrow) || B->Stype != SLU_DN || B->Dtype != SLU_D || B->Mtype != SLU_GE ) *info = -10; else if ( ldx < SUPERLU_MAX(0, A->nrow) || X->Stype != SLU_DN || X->Dtype != SLU_D || X->Mtype != SLU_GE ) *info = -11; if (*info != 0) { i = -(*info); input_error("dgsrfs", &i); return; } /* Quick return if possible */ if ( A->nrow == 0 || nrhs == 0) { for (j = 0; j < nrhs; ++j) { ferr[j] = 0.; berr[j] = 0.; } return; } rowequ = strncmp(equed, "R", 1)==0 || strncmp(equed, "B", 1)==0; colequ = strncmp(equed, "C", 1)==0 || strncmp(equed, "B", 1)==0; /* Allocate working space */ work = doubleMalloc(2*A->nrow); rwork = (double *) SUPERLU_MALLOC( A->nrow * sizeof(double) ); iwork = intMalloc(2*A->nrow); if ( !work || !rwork || !iwork ) ABORT("Malloc fails for work/rwork/iwork."); if ( notran ) { *(unsigned char *)transc = 'N'; transt = TRANS; } else if ( trans == TRANS ) { *(unsigned char *)transc = 'T'; transt = NOTRANS; } else if ( trans == CONJ ) { *(unsigned char *)transc = 'C'; transt = NOTRANS; } /* NZ = maximum number of nonzero elements in each row of A, plus 1 */ nz = A->ncol + 1; eps = dmach("Epsilon"); safmin = dmach("Safe minimum"); /* Set SAFE1 essentially to be the underflow threshold times the number of additions in each row. */ safe1 = nz * safmin; safe2 = safe1 / eps; /* Compute the number of nonzeros in each row (or column) of A */ for (i = 0; i < A->nrow; ++i) iwork[i] = 0; if ( notran ) { for (k = 0; k < A->ncol; ++k) for (i = Astore->colptr[k]; i < Astore->colptr[k+1]; ++i) ++iwork[Astore->rowind[i]]; } else { for (k = 0; k < A->ncol; ++k) iwork[k] = Astore->colptr[k+1] - Astore->colptr[k]; } /* Copy one column of RHS B into Bjcol. */ Bjcol.Stype = B->Stype; Bjcol.Dtype = B->Dtype; Bjcol.Mtype = B->Mtype; Bjcol.nrow = B->nrow; Bjcol.ncol = 1; Bjcol.Store = (void *) SUPERLU_MALLOC( sizeof(DNformat) ); if ( !Bjcol.Store ) ABORT("SUPERLU_MALLOC fails for Bjcol.Store"); Bjcol_store = Bjcol.Store; Bjcol_store->lda = ldb; Bjcol_store->nzval = work; /* address aliasing */ /* Do for each right hand side ... */ for (j = 0; j < nrhs; ++j) { count = 0; lstres = 3.; Bptr = &Bmat[j*ldb]; Xptr = &Xmat[j*ldx]; while (1) { /* Loop until stopping criterion is satisfied. */ /* Compute residual R = B - op(A) * X, where op(A) = A, A**T, or A**H, depending on TRANS. */ #ifdef _CRAY SCOPY(&A->nrow, Bptr, &ione, work, &ione); #else dcopy_(&A->nrow, Bptr, &ione, work, &ione); #endif sp_dgemv(transc, ndone, A, Xptr, ione, done, work, ione); /* Compute componentwise relative backward error from formula max(i) ( abs(R(i)) / ( abs(op(A))*abs(X) + abs(B) )(i) ) where abs(Z) is the componentwise absolute value of the matrix or vector Z. If the i-th component of the denominator is less than SAFE2, then SAFE1 is added to the i-th component of the numerator before dividing. */ for (i = 0; i < A->nrow; ++i) rwork[i] = fabs( Bptr[i] ); /* Compute abs(op(A))*abs(X) + abs(B). */ if ( notran ) { for (k = 0; k < A->ncol; ++k) { xk = fabs( Xptr[k] ); for (i = Astore->colptr[k]; i < Astore->colptr[k+1]; ++i) rwork[Astore->rowind[i]] += fabs(Aval[i]) * xk; } } else { /* trans = TRANS or CONJ */ for (k = 0; k < A->ncol; ++k) { s = 0.; for (i = Astore->colptr[k]; i < Astore->colptr[k+1]; ++i) { irow = Astore->rowind[i]; s += fabs(Aval[i]) * fabs(Xptr[irow]); } rwork[k] += s; } } s = 0.; for (i = 0; i < A->nrow; ++i) { if (rwork[i] > safe2) { s = SUPERLU_MAX( s, fabs(work[i]) / rwork[i] ); } else if ( rwork[i] != 0.0 ) { /* Adding SAFE1 to the numerator guards against spuriously zero residuals (underflow). */ s = SUPERLU_MAX( s, (safe1 + fabs(work[i])) / rwork[i] ); } /* If rwork[i] is exactly 0.0, then we know the true residual also must be exactly 0.0. */ } berr[j] = s; /* Test stopping criterion. Continue iterating if 1) The residual BERR(J) is larger than machine epsilon, and 2) BERR(J) decreased by at least a factor of 2 during the last iteration, and 3) At most ITMAX iterations tried. */ if (berr[j] > eps && berr[j] * 2. <= lstres && count < ITMAX) { /* Update solution and try again. */ dgstrs (trans, L, U, perm_c, perm_r, &Bjcol, stat, info); #ifdef _CRAY SAXPY(&A->nrow, &done, work, &ione, &Xmat[j*ldx], &ione); #else daxpy_(&A->nrow, &done, work, &ione, &Xmat[j*ldx], &ione); #endif lstres = berr[j]; ++count; } else { break; } } /* end while */ stat->RefineSteps = count; /* Bound error from formula: norm(X - XTRUE) / norm(X) .le. FERR = norm( abs(inv(op(A)))* ( abs(R) + NZ*EPS*( abs(op(A))*abs(X)+abs(B) ))) / norm(X) where norm(Z) is the magnitude of the largest component of Z inv(op(A)) is the inverse of op(A) abs(Z) is the componentwise absolute value of the matrix or vector Z NZ is the maximum number of nonzeros in any row of A, plus 1 EPS is machine epsilon The i-th component of abs(R)+NZ*EPS*(abs(op(A))*abs(X)+abs(B)) is incremented by SAFE1 if the i-th component of abs(op(A))*abs(X) + abs(B) is less than SAFE2. Use DLACON2 to estimate the infinity-norm of the matrix inv(op(A)) * diag(W), where W = abs(R) + NZ*EPS*( abs(op(A))*abs(X)+abs(B) ))) */ for (i = 0; i < A->nrow; ++i) rwork[i] = fabs( Bptr[i] ); /* Compute abs(op(A))*abs(X) + abs(B). */ if ( notran ) { for (k = 0; k < A->ncol; ++k) { xk = fabs( Xptr[k] ); for (i = Astore->colptr[k]; i < Astore->colptr[k+1]; ++i) rwork[Astore->rowind[i]] += fabs(Aval[i]) * xk; } } else { /* trans == TRANS or CONJ */ for (k = 0; k < A->ncol; ++k) { s = 0.; for (i = Astore->colptr[k]; i < Astore->colptr[k+1]; ++i) { irow = Astore->rowind[i]; xk = fabs( Xptr[irow] ); s += fabs(Aval[i]) * xk; } rwork[k] += s; } } for (i = 0; i < A->nrow; ++i) if (rwork[i] > safe2) rwork[i] = fabs(work[i]) + (iwork[i]+1)*eps*rwork[i]; else rwork[i] = fabs(work[i])+(iwork[i]+1)*eps*rwork[i]+safe1; kase = 0; do { dlacon2_(&A->nrow, &work[A->nrow], work, &iwork[A->nrow], &ferr[j], &kase, isave); if (kase == 0) break; if (kase == 1) { /* Multiply by diag(W)*inv(op(A)**T)*(diag(C) or diag(R)). */ if ( notran && colequ ) for (i = 0; i < A->ncol; ++i) work[i] *= C[i]; else if ( !notran && rowequ ) for (i = 0; i < A->nrow; ++i) work[i] *= R[i]; dgstrs (transt, L, U, perm_c, perm_r, &Bjcol, stat, info); for (i = 0; i < A->nrow; ++i) work[i] *= rwork[i]; } else { /* Multiply by (diag(C) or diag(R))*inv(op(A))*diag(W). */ for (i = 0; i < A->nrow; ++i) work[i] *= rwork[i]; dgstrs (trans, L, U, perm_c, perm_r, &Bjcol, stat, info); if ( notran && colequ ) for (i = 0; i < A->ncol; ++i) work[i] *= C[i]; else if ( !notran && rowequ ) for (i = 0; i < A->ncol; ++i) work[i] *= R[i]; } } while ( kase != 0 ); /* Normalize error. */ lstres = 0.; if ( notran && colequ ) { for (i = 0; i < A->nrow; ++i) lstres = SUPERLU_MAX( lstres, C[i] * fabs( Xptr[i]) ); } else if ( !notran && rowequ ) { for (i = 0; i < A->nrow; ++i) lstres = SUPERLU_MAX( lstres, R[i] * fabs( Xptr[i]) ); } else { for (i = 0; i < A->nrow; ++i) lstres = SUPERLU_MAX( lstres, fabs( Xptr[i]) ); } if ( lstres != 0. ) ferr[j] /= lstres; } /* for each RHS j ... */ SUPERLU_FREE(work); SUPERLU_FREE(rwork); SUPERLU_FREE(iwork); SUPERLU_FREE(Bjcol.Store); return; } /* dgsrfs */
int main(int argc, char* argv[]) { const char* program_name = "decomp_sparse_nystrom"; bool optsOK = true; copyright(program_name); cout << " Reads the symmetric CSC format sparse matrix from" << endl; cout << " input-file, and computes the number of requested" << endl; cout << " eigenvalues/vectors of the normalized laplacian" << endl; cout << " using ARPACK and a gaussian kernel of width sigma." << endl; cout << " The general CSC format sparse matrix is projected" << endl; cout << " onto the eigenvectors of the symmetric matrix for" << endl; cerr << " out-of-sample prediction." << endl; cout << endl; cout << " Use -h or --help to see the complete list of options." << endl; cout << endl; // Option vars... double sigma_a; int nev; string ssm_filename; string gsm_filename; string evals_filename; string evecs_filename; string residuals_filename; // Declare the supported options. po::options_description cmdline_options; po::options_description program_options("Program options"); program_options.add_options() ("help,h", "show this help message and exit") ("sigma,q", po::value<double>(&sigma_a), "Input: Standard deviation of gaussian kernel (real)") ("nevals,n", po::value<int>(&nev), "Input: Number of eigenvalues/vectors (int)") ("ssm-file,s", po::value<string>(&ssm_filename)->default_value("distances.ssm"), "Input: Symmetric sparse matrix file (string:filename)") ("gsm-file,g", po::value<string>(&gsm_filename)->default_value("distances.gsm"), "Input: General sparse matrix file (string:filename)") ("evals-file,v", po::value<string>(&evals_filename)->default_value("eigenvalues.dat"), "Output: Eigenvalues file (string:filename)") ("evecs-file,e", po::value<string>(&evecs_filename)->default_value("eigenvectors.dat"), "Output: Eigenvectors file (string:filename)") ("residuals-file,r", po::value<string>(&residuals_filename)->default_value("residuals.dat"), "Output: Residuals file (string:filename)") ; cmdline_options.add(program_options); po::variables_map vm; po::store(po::parse_command_line(argc, argv, cmdline_options), vm); po::notify(vm); if (vm.count("help")) { cout << "usage: " << program_name << " [options]" << endl; cout << cmdline_options << endl; return 1; } if (!vm.count("sigma")) { cout << "ERROR: --sigma not supplied." << endl; cout << endl; optsOK = false; } if (!vm.count("nevals")) { cout << "ERROR: --nevals not supplied." << endl; cout << endl; optsOK = false; } if (!optsOK) { return -1; } cout << "Running with the following options:" << endl; cout << "sigma = " << sigma_a << endl; cout << "nevals = " << nev << endl; cout << "ssm-file = " << ssm_filename << endl; cout << "gsm-file = " << gsm_filename << endl; cout << "evals-file = " << evals_filename << endl; cout << "evecs-file = " << evecs_filename << endl; cout << "residuals-file = " << residuals_filename << endl; cout << endl; // General int n; // Dimension of the problem. int m; // Outer dimension // Main affinity matrix int nnzA; int *irowA; int *pcolA; double *A; // Pointer to an array that stores the lower // triangular elements of A. // Expanded affinity matrix int nnzB; int *irowB; int *pcolB; double *B; // Pointer to an array that stores the // sparse elements of B. // File input streams ifstream ssm; ifstream gsm; // File output streams ofstream eigenvalues; ofstream eigenvectors; ofstream residuals; // EPS double eps = 1.0; do { eps /= 2.0; } while (1.0 + (eps / 2.0) != 1.0); eps = sqrt(eps); // Open files ssm.open(ssm_filename.c_str()); gsm.open(gsm_filename.c_str()); eigenvalues.open(evals_filename.c_str()); eigenvectors.open(evecs_filename.c_str()); residuals.open(residuals_filename.c_str()); // Read symmetric CSC matrix ssm.read((char*) &n, (sizeof(int) / sizeof(char))); pcolA = new int[n+1]; ssm.read((char*) pcolA, (sizeof(int) / sizeof(char)) * (n+1)); nnzA = pcolA[n]; A = new double[nnzA]; irowA = new int[nnzA]; ssm.read((char*) irowA, (sizeof(int) / sizeof(char)) * nnzA); ssm.read((char*) A, (sizeof(double) / sizeof(char)) * nnzA); ssm.close(); // Read general CSC matrix gsm.read((char*) &m, (sizeof(int) / sizeof(char))); pcolB = new int[m+1]; gsm.read((char*) pcolB, (sizeof(int) / sizeof(char)) * (m+1)); nnzB = pcolB[m]; B = new double[nnzB]; irowB = new int[nnzB]; gsm.read((char*) irowB, (sizeof(int) / sizeof(char)) * nnzB); gsm.read((char*) B, (sizeof(double) / sizeof(char)) * nnzB); gsm.close(); // Turn distances into normalized affinities... double *d_a = new double[n]; double *d_b = new double[m]; // Make affinity matrices... for (int x = 0; x < nnzA; x++) A[x] = exp(-(A[x] * A[x]) / (2.0 * sigma_a * sigma_a)); for (int x = 0; x < nnzB; x++) B[x] = exp(-(B[x] * B[x]) / (2.0 * sigma_a * sigma_a)); // Calculate D_A for (int x = 0; x < n; x++) d_a[x] = 0.0; for (int x = 0; x < n; x++) { for (int y = pcolA[x]; y < pcolA[x+1]; y++) { d_a[x] += A[y]; d_a[irowA[y]] += A[y]; } } for (int x = 0; x < n; x++) d_a[x] = 1.0 / sqrt(d_a[x]); // Calculate D_B for (int x = 0; x < m; x++) d_b[x] = 0.0; for (int x = 0; x < m; x++) { for (int y = pcolB[x]; y < pcolB[x+1]; y++) { d_b[x] += B[y]; } } for (int x = 0; x < m; x++) d_b[x] = 1.0 / sqrt(d_b[x]); // Normalize the affinity matrix... for (int x = 0; x < n; x++) { for (int y = pcolA[x]; y < pcolA[x+1]; y++) { A[y] *= d_a[irowA[y]] * d_a[x]; } } // Normalized B matrix... for (int x = 0; x < m; x++) { for (int y = pcolB[x]; y < pcolB[x+1]; y++) { B[y] *= d_a[irowB[y]] * d_b[x]; } } delete [] d_a; delete [] d_b; // Eigen decomposition of nomalized affinity matrix... // ARPACK setup... double *Ax = new double[n]; // Array for residual calculation double residual = 0.0; double max_residual = 0.0; int ido = 0; char bmat = 'I'; char which[2]; which[0] = 'L'; which[1] = 'A'; double tol = 0.0; double *resid = new double[n]; // NOTE: Need about one order of magnitude more arnoldi vectors to // converge for the normalized Laplacian (according to residuals...) int ncv = ((10*nev+1)>n)?n:(10*nev+1); double *V = new double[(ncv*n)+1]; int ldv = n; int *iparam = new int[12]; iparam[1] = 1; iparam[3] = 100 * nev; iparam[4] = 1; iparam[7] = 1; int *ipntr = new int[15]; double *workd = new double[(3*n)+1]; int lworkl = ncv*(ncv+9); double *workl = new double[lworkl+1]; int info = 0; int rvec = 1; char HowMny = 'A'; int *lselect = new int[ncv]; double *d = new double[nev]; double *Z = &V[1]; int ldz = n; double sigma = 0.0; double *extrap_evec = new double[m]; double *norm_evec = new double[n]; while (ido != 99) { dsaupd_(&ido, &bmat, &n, which, &nev, &tol, resid, &ncv, &V[1], &ldv, &iparam[1], &ipntr[1], &workd[1], &workl[1], &lworkl, &info); if (ido == -1 || ido == 1) { // Matrix-vector multiplication sp_dsymv(n, irowA, pcolA, A, &workd[ipntr[1]], &workd[ipntr[2]]); } } dseupd_(&rvec, &HowMny, lselect, d, Z, &ldz, &sigma, &bmat, &n, which, &nev, &tol, resid, &ncv, &V[1], &ldv, &iparam[1], &ipntr[1], &workd[1], &workl[1], &lworkl, &info); cout << "Number of converged eigenvalues/vectors found: " << iparam[5] << endl; for (int x = nev-1; x >= 0; x--) { #ifdef DECOMP_WRITE_DOUBLE eigenvalues.write((char*) &d[x],(sizeof(double) / sizeof(char))); eigenvectors.write((char*) &Z[n*x],(sizeof(double) * n) / sizeof(char)); #else eigenvalues << d[x] << endl; for (int y = 0; y < n; y++) eigenvectors << Z[(n*x)+y] << " "; #endif // Extrapolate remaining points onto the vector space for (int y = 0; y < n; y++) norm_evec[y] = Z[(n*x)+y] / d[x]; sp_dgemv(m, irowB, pcolB, B, norm_evec, extrap_evec); #ifdef DECOMP_WRITE_DOUBLE eigenvectors.write((char*) extrap_evec,(sizeof(double) * m) / sizeof(char)); #else for (int y = 0; y < m; y++) eigenvectors << extrap_evec[y] << " "; eigenvectors << endl; #endif // Calculate residual... // Matrix-vector multiplication sp_dsymv(n, irowA, pcolA, A, &Z[n*x], Ax); double t = -d[x]; int i = 1; daxpy_(&n, &t, &Z[n*x], &i, Ax, &i); residual = dnrm2_(&n, Ax, &i)/fabs(d[x]); if (residual > max_residual) max_residual = residual; #ifdef DECOMP_WRITE_DOUBLE residuals.write((char*) &residual, sizeof(double) / sizeof(char)); #else residuals << residual << endl; #endif } cout << "Max residual: " << max_residual << " (eps: " << eps << ")" << endl; if (max_residual > eps) { cout << "*** Sum of residuals too high (max_r > eps)!" << endl; cout << "*** Please, check results manually..." << endl; } eigenvalues.close(); eigenvectors.close(); residuals.close(); delete [] irowA; delete [] pcolA; delete [] A; delete [] irowB; delete [] pcolB; delete [] B; // ARPACK delete [] lselect; delete [] d; delete [] resid; delete [] Ax; delete [] V; delete [] iparam; delete [] ipntr; delete [] workd; delete [] workl; delete [] norm_evec; delete [] extrap_evec; return 0; }
void dgsrfs(char *trans, SuperMatrix *A, SuperMatrix *L, SuperMatrix *U, int *perm_r, int *perm_c, char *equed, double *R, double *C, SuperMatrix *B, SuperMatrix *X, double *ferr, double *berr, int *info) { /* * Purpose * ======= * * DGSRFS improves the computed solution to a system of linear * equations and provides error bounds and backward error estimates for * the solution. * * If equilibration was performed, the system becomes: * (diag(R)*A_original*diag(C)) * X = diag(R)*B_original. * * See supermatrix.h for the definition of 'SuperMatrix' structure. * * Arguments * ========= * * trans (input) char* * Specifies the form of the system of equations: * = 'N': A * X = B (No transpose) * = 'T': A**T * X = B (Transpose) * = 'C': A**H * X = B (Conjugate transpose = Transpose) * * A (input) SuperMatrix* * The original matrix A in the system, or the scaled A if * equilibration was done. The type of A can be: * Stype = NC, Dtype = _D, Mtype = GE. * * L (input) SuperMatrix* * The factor L from the factorization Pr*A*Pc=L*U. Use * compressed row subscripts storage for supernodes, * i.e., L has types: Stype = SC, Dtype = _D, Mtype = TRLU. * * U (input) SuperMatrix* * The factor U from the factorization Pr*A*Pc=L*U as computed by * dgstrf(). Use column-wise storage scheme, * i.e., U has types: Stype = NC, Dtype = _D, Mtype = TRU. * * perm_r (input) int*, dimension (A->nrow) * Row permutation vector, which defines the permutation matrix Pr; * perm_r[i] = j means row i of A is in position j in Pr*A. * * perm_c (input) int*, dimension (A->ncol) * Column permutation vector, which defines the * permutation matrix Pc; perm_c[i] = j means column i of A is * in position j in A*Pc. * * equed (input) Specifies the form of equilibration that was done. * = 'N': No equilibration. * = 'R': Row equilibration, i.e., A was premultiplied by diag(R). * = 'C': Column equilibration, i.e., A was postmultiplied by * diag(C). * = 'B': Both row and column equilibration, i.e., A was replaced * by diag(R)*A*diag(C). * * R (input) double*, dimension (A->nrow) * The row scale factors for A. * If equed = 'R' or 'B', A is premultiplied by diag(R). * If equed = 'N' or 'C', R is not accessed. * * C (input) double*, dimension (A->ncol) * The column scale factors for A. * If equed = 'C' or 'B', A is postmultiplied by diag(C). * If equed = 'N' or 'R', C is not accessed. * * B (input) SuperMatrix* * B has types: Stype = DN, Dtype = _D, Mtype = GE. * The right hand side matrix B. * if equed = 'R' or 'B', B is premultiplied by diag(R). * * X (input/output) SuperMatrix* * X has types: Stype = DN, Dtype = _D, Mtype = GE. * On entry, the solution matrix X, as computed by dgstrs(). * On exit, the improved solution matrix X. * if *equed = 'C' or 'B', X should be premultiplied by diag(C) * in order to obtain the solution to the original system. * * FERR (output) double*, dimension (B->ncol) * The estimated forward error bound for each solution vector * X(j) (the j-th column of the solution matrix X). * If XTRUE is the true solution corresponding to X(j), FERR(j) * is an estimated upper bound for the magnitude of the largest * element in (X(j) - XTRUE) divided by the magnitude of the * largest element in X(j). The estimate is as reliable as * the estimate for RCOND, and is almost always a slight * overestimate of the true error. * * BERR (output) double*, dimension (B->ncol) * The componentwise relative backward error of each solution * vector X(j) (i.e., the smallest relative change in * any element of A or B that makes X(j) an exact solution). * * info (output) int* * = 0: successful exit * < 0: if INFO = -i, the i-th argument had an illegal value * * Internal Parameters * =================== * * ITMAX is the maximum number of steps of iterative refinement. * */ #define ITMAX 5 /* Table of constant values */ int ione = 1; double ndone = -1.; double done = 1.; /* Local variables */ NCformat *Astore; double *Aval; SuperMatrix Bjcol; DNformat *Bstore, *Xstore, *Bjcol_store; double *Bmat, *Xmat, *Bptr, *Xptr; int kase; double safe1, safe2; int i, j, k, irow, nz, count, notran, rowequ, colequ; int ldb, ldx, nrhs; double s, xk, lstres, eps, safmin; char transt[1]; double *work; double *rwork; int *iwork; extern double dlamch_(char *); extern int dlacon_(int *, double *, double *, int *, double *, int *); #ifdef _CRAY extern int SCOPY(int *, double *, int *, double *, int *); extern int SSAXPY(int *, double *, double *, int *, double *, int *); #else extern int dcopy_(int *, double *, int *, double *, int *); extern int daxpy_(int *, double *, double *, int *, double *, int *); #endif Astore = A->Store; Aval = Astore->nzval; Bstore = B->Store; Xstore = X->Store; Bmat = Bstore->nzval; Xmat = Xstore->nzval; ldb = Bstore->lda; ldx = Xstore->lda; nrhs = B->ncol; /* Test the input parameters */ *info = 0; notran = lsame_(trans, "N"); if ( !notran && !lsame_(trans, "T") && !lsame_(trans, "C")) *info = -1; else if ( A->nrow != A->ncol || A->nrow < 0 || A->Stype != NC || A->Dtype != _D || A->Mtype != GE ) *info = -2; else if ( L->nrow != L->ncol || L->nrow < 0 || L->Stype != SC || L->Dtype != _D || L->Mtype != TRLU ) *info = -3; else if ( U->nrow != U->ncol || U->nrow < 0 || U->Stype != NC || U->Dtype != _D || U->Mtype != TRU ) *info = -4; else if ( ldb < MAX(0, A->nrow) || B->Stype != DN || B->Dtype != _D || B->Mtype != GE ) *info = -10; else if ( ldx < MAX(0, A->nrow) || X->Stype != DN || X->Dtype != _D || X->Mtype != GE ) *info = -11; if (*info != 0) { i = -(*info); xerbla_("dgsrfs", &i); return; } /* Quick return if possible */ if ( A->nrow == 0 || nrhs == 0) { for (j = 0; j < nrhs; ++j) { ferr[j] = 0.; berr[j] = 0.; } return; } rowequ = lsame_(equed, "R") || lsame_(equed, "B"); colequ = lsame_(equed, "C") || lsame_(equed, "B"); /* Allocate working space */ work = doubleMalloc(2*A->nrow); rwork = (double *) SUPERLU_MALLOC( A->nrow * sizeof(double) ); iwork = intMalloc(2*A->nrow); if ( !work || !rwork || !iwork ) ABORT("Malloc fails for work/rwork/iwork."); if ( notran ) { *(unsigned char *)transt = 'T'; } else { *(unsigned char *)transt = 'N'; } /* NZ = maximum number of nonzero elements in each row of A, plus 1 */ nz = A->ncol + 1; eps = dlamch_("Epsilon"); safmin = dlamch_("Safe minimum"); safe1 = nz * safmin; safe2 = safe1 / eps; /* Compute the number of nonzeros in each row (or column) of A */ for (i = 0; i < A->nrow; ++i) iwork[i] = 0; if ( notran ) { for (k = 0; k < A->ncol; ++k) for (i = Astore->colptr[k]; i < Astore->colptr[k+1]; ++i) ++iwork[Astore->rowind[i]]; } else { for (k = 0; k < A->ncol; ++k) iwork[k] = Astore->colptr[k+1] - Astore->colptr[k]; } /* Copy one column of RHS B into Bjcol. */ Bjcol.Stype = B->Stype; Bjcol.Dtype = B->Dtype; Bjcol.Mtype = B->Mtype; Bjcol.nrow = B->nrow; Bjcol.ncol = 1; Bjcol.Store = (void *) SUPERLU_MALLOC( sizeof(DNformat) ); if ( !Bjcol.Store ) ABORT("SUPERLU_MALLOC fails for Bjcol.Store"); Bjcol_store = Bjcol.Store; Bjcol_store->lda = ldb; Bjcol_store->nzval = work; /* address aliasing */ /* Do for each right hand side ... */ for (j = 0; j < nrhs; ++j) { count = 0; lstres = 3.; Bptr = &Bmat[j*ldb]; Xptr = &Xmat[j*ldx]; while (1) { /* Loop until stopping criterion is satisfied. */ /* Compute residual R = B - op(A) * X, where op(A) = A, A**T, or A**H, depending on TRANS. */ #ifdef _CRAY SCOPY(&A->nrow, Bptr, &ione, work, &ione); #else dcopy_(&A->nrow, Bptr, &ione, work, &ione); #endif sp_dgemv(trans, ndone, A, Xptr, ione, done, work, ione); /* Compute componentwise relative backward error from formula max(i) ( abs(R(i)) / ( abs(op(A))*abs(X) + abs(B) )(i) ) where abs(Z) is the componentwise absolute value of the matrix or vector Z. If the i-th component of the denominator is less than SAFE2, then SAFE1 is added to the i-th component of the numerator and denominator before dividing. */ for (i = 0; i < A->nrow; ++i) rwork[i] = fabs( Bptr[i] ); /* Compute abs(op(A))*abs(X) + abs(B). */ if (notran) { for (k = 0; k < A->ncol; ++k) { xk = fabs( Xptr[k] ); for (i = Astore->colptr[k]; i < Astore->colptr[k+1]; ++i) rwork[Astore->rowind[i]] += fabs(Aval[i]) * xk; } } else { for (k = 0; k < A->ncol; ++k) { s = 0.; for (i = Astore->colptr[k]; i < Astore->colptr[k+1]; ++i) { irow = Astore->rowind[i]; s += fabs(Aval[i]) * fabs(Xptr[irow]); } rwork[k] += s; } } s = 0.; for (i = 0; i < A->nrow; ++i) { if (rwork[i] > safe2) s = MAX( s, fabs(work[i]) / rwork[i] ); else s = MAX( s, (fabs(work[i]) + safe1) / (rwork[i] + safe1) ); } berr[j] = s; /* Test stopping criterion. Continue iterating if 1) The residual BERR(J) is larger than machine epsilon, and 2) BERR(J) decreased by at least a factor of 2 during the last iteration, and 3) At most ITMAX iterations tried. */ if (berr[j] > eps && berr[j] * 2. <= lstres && count < ITMAX) { /* Update solution and try again. */ dgstrs (trans, L, U, perm_r, perm_c, &Bjcol, info); #ifdef _CRAY SAXPY(&A->nrow, &done, work, &ione, &Xmat[j*ldx], &ione); #else daxpy_(&A->nrow, &done, work, &ione, &Xmat[j*ldx], &ione); #endif lstres = berr[j]; ++count; } else { break; } } /* end while */ /* Bound error from formula: norm(X - XTRUE) / norm(X) .le. FERR = norm( abs(inv(op(A)))* ( abs(R) + NZ*EPS*( abs(op(A))*abs(X)+abs(B) ))) / norm(X) where norm(Z) is the magnitude of the largest component of Z inv(op(A)) is the inverse of op(A) abs(Z) is the componentwise absolute value of the matrix or vector Z NZ is the maximum number of nonzeros in any row of A, plus 1 EPS is machine epsilon The i-th component of abs(R)+NZ*EPS*(abs(op(A))*abs(X)+abs(B)) is incremented by SAFE1 if the i-th component of abs(op(A))*abs(X) + abs(B) is less than SAFE2. Use DLACON to estimate the infinity-norm of the matrix inv(op(A)) * diag(W), where W = abs(R) + NZ*EPS*( abs(op(A))*abs(X)+abs(B) ))) */ for (i = 0; i < A->nrow; ++i) rwork[i] = fabs( Bptr[i] ); /* Compute abs(op(A))*abs(X) + abs(B). */ if ( notran ) { for (k = 0; k < A->ncol; ++k) { xk = fabs( Xptr[k] ); for (i = Astore->colptr[k]; i < Astore->colptr[k+1]; ++i) rwork[Astore->rowind[i]] += fabs(Aval[i]) * xk; } } else { for (k = 0; k < A->ncol; ++k) { s = 0.; for (i = Astore->colptr[k]; i < Astore->colptr[k+1]; ++i) { irow = Astore->rowind[i]; xk = fabs( Xptr[irow] ); s += fabs(Aval[i]) * xk; } rwork[k] += s; } } for (i = 0; i < A->nrow; ++i) if (rwork[i] > safe2) rwork[i] = fabs(work[i]) + (iwork[i]+1)*eps*rwork[i]; else rwork[i] = fabs(work[i])+(iwork[i]+1)*eps*rwork[i]+safe1; kase = 0; do { dlacon_(&A->nrow, &work[A->nrow], work, &iwork[A->nrow], &ferr[j], &kase); if (kase == 0) break; if (kase == 1) { /* Multiply by diag(W)*inv(op(A)**T)*(diag(C) or diag(R)). */ if ( notran && colequ ) for (i = 0; i < A->ncol; ++i) work[i] *= C[i]; else if ( !notran && rowequ ) for (i = 0; i < A->nrow; ++i) work[i] *= R[i]; dgstrs (transt, L, U, perm_r, perm_c, &Bjcol, info); for (i = 0; i < A->nrow; ++i) work[i] *= rwork[i]; } else { /* Multiply by (diag(C) or diag(R))*inv(op(A))*diag(W). */ for (i = 0; i < A->nrow; ++i) work[i] *= rwork[i]; dgstrs (trans, L, U, perm_r, perm_c, &Bjcol, info); if ( notran && colequ ) for (i = 0; i < A->ncol; ++i) work[i] *= C[i]; else if ( !notran && rowequ ) for (i = 0; i < A->ncol; ++i) work[i] *= R[i]; } } while ( kase != 0 ); /* Normalize error. */ lstres = 0.; if ( notran && colequ ) { for (i = 0; i < A->nrow; ++i) lstres = MAX( lstres, C[i] * fabs( Xptr[i]) ); } else if ( !notran && rowequ ) { for (i = 0; i < A->nrow; ++i) lstres = MAX( lstres, R[i] * fabs( Xptr[i]) ); } else { for (i = 0; i < A->nrow; ++i) lstres = MAX( lstres, fabs( Xptr[i]) ); } if ( lstres != 0. ) ferr[j] /= lstres; } /* for each RHS j ... */ SUPERLU_FREE(work); SUPERLU_FREE(rwork); SUPERLU_FREE(iwork); SUPERLU_FREE(Bjcol.Store); return; } /* dgsrfs */
int main(int argc, char *argv[]) { void dmatvec_mult(double alpha, double x[], double beta, double y[]); void dpsolve(int n, double x[], double y[]); extern int dfgmr( int n, void (*matvec_mult)(double, double [], double, double []), void (*psolve)(int n, double [], double[]), double *rhs, double *sol, double tol, int restrt, int *itmax, FILE *fits); extern int dfill_diag(int n, NCformat *Astore); char equed[1] = {'B'}; yes_no_t equil; trans_t trans; SuperMatrix A, L, U; SuperMatrix B, X; NCformat *Astore; NCformat *Ustore; SCformat *Lstore; double *a; int *asub, *xa; int *etree; int *perm_c; /* column permutation vector */ int *perm_r; /* row permutations from partial pivoting */ int nrhs, ldx, lwork, info, m, n, nnz; double *rhsb, *rhsx, *xact; double *work = NULL; double *R, *C; double u, rpg, rcond; double zero = 0.0; double one = 1.0; mem_usage_t mem_usage; superlu_options_t options; SuperLUStat_t stat; int restrt, iter, maxit, i; double resid; double *x, *b; #ifdef DEBUG extern int num_drop_L, num_drop_U; #endif #if ( DEBUGlevel>=1 ) CHECK_MALLOC("Enter main()"); #endif /* Defaults */ lwork = 0; nrhs = 1; equil = YES; u = 0.1; /* u=1.0 for complete factorization */ trans = NOTRANS; /* Set the default input options: options.Fact = DOFACT; options.Equil = YES; options.ColPerm = COLAMD; options.DiagPivotThresh = 0.1; //different from complete LU options.Trans = NOTRANS; options.IterRefine = NOREFINE; options.SymmetricMode = NO; options.PivotGrowth = NO; options.ConditionNumber = NO; options.PrintStat = YES; options.RowPerm = LargeDiag; options.ILU_DropTol = 1e-4; options.ILU_FillTol = 1e-2; options.ILU_FillFactor = 10.0; options.ILU_DropRule = DROP_BASIC | DROP_AREA; options.ILU_Norm = INF_NORM; options.ILU_MILU = SILU; */ ilu_set_default_options(&options); /* Modify the defaults. */ options.PivotGrowth = YES; /* Compute reciprocal pivot growth */ options.ConditionNumber = YES;/* Compute reciprocal condition number */ if ( lwork > 0 ) { work = SUPERLU_MALLOC(lwork); if ( !work ) ABORT("Malloc fails for work[]."); } /* Read matrix A from a file in Harwell-Boeing format.*/ if (argc < 2) { printf("Usage:\n%s [OPTION] < [INPUT] > [OUTPUT]\nOPTION:\n" "-h -hb:\n\t[INPUT] is a Harwell-Boeing format matrix.\n" "-r -rb:\n\t[INPUT] is a Rutherford-Boeing format matrix.\n" "-t -triplet:\n\t[INPUT] is a triplet format matrix.\n", argv[0]); return 0; } else { switch (argv[1][1]) { case 'H': case 'h': printf("Input a Harwell-Boeing format matrix:\n"); dreadhb(&m, &n, &nnz, &a, &asub, &xa); break; case 'R': case 'r': printf("Input a Rutherford-Boeing format matrix:\n"); dreadrb(&m, &n, &nnz, &a, &asub, &xa); break; case 'T': case 't': printf("Input a triplet format matrix:\n"); dreadtriple(&m, &n, &nnz, &a, &asub, &xa); break; default: printf("Unrecognized format.\n"); return 0; } } dCreate_CompCol_Matrix(&A, m, n, nnz, a, asub, xa, SLU_NC, SLU_D, SLU_GE); Astore = A.Store; dfill_diag(n, Astore); printf("Dimension %dx%d; # nonzeros %d\n", A.nrow, A.ncol, Astore->nnz); fflush(stdout); if ( !(rhsb = doubleMalloc(m * nrhs)) ) ABORT("Malloc fails for rhsb[]."); if ( !(rhsx = doubleMalloc(m * nrhs)) ) ABORT("Malloc fails for rhsx[]."); dCreate_Dense_Matrix(&B, m, nrhs, rhsb, m, SLU_DN, SLU_D, SLU_GE); dCreate_Dense_Matrix(&X, m, nrhs, rhsx, m, SLU_DN, SLU_D, SLU_GE); xact = doubleMalloc(n * nrhs); ldx = n; dGenXtrue(n, nrhs, xact, ldx); dFillRHS(trans, nrhs, xact, ldx, &A, &B); if ( !(etree = intMalloc(n)) ) ABORT("Malloc fails for etree[]."); if ( !(perm_r = intMalloc(m)) ) ABORT("Malloc fails for perm_r[]."); if ( !(perm_c = intMalloc(n)) ) ABORT("Malloc fails for perm_c[]."); if ( !(R = (double *) SUPERLU_MALLOC(A.nrow * sizeof(double))) ) ABORT("SUPERLU_MALLOC fails for R[]."); if ( !(C = (double *) SUPERLU_MALLOC(A.ncol * sizeof(double))) ) ABORT("SUPERLU_MALLOC fails for C[]."); info = 0; #ifdef DEBUG num_drop_L = 0; num_drop_U = 0; #endif /* Initialize the statistics variables. */ StatInit(&stat); /* Compute the incomplete factorization and compute the condition number and pivot growth using dgsisx. */ dgsisx(&options, &A, perm_c, perm_r, etree, equed, R, C, &L, &U, work, lwork, &B, &X, &rpg, &rcond, &mem_usage, &stat, &info); Lstore = (SCformat *) L.Store; Ustore = (NCformat *) U.Store; printf("dgsisx(): info %d\n", info); if (info > 0 || rcond < 1e-8 || rpg > 1e8) printf("WARNING: This preconditioner might be unstable.\n"); if ( info == 0 || info == n+1 ) { if ( options.PivotGrowth == YES ) printf("Recip. pivot growth = %e\n", rpg); if ( options.ConditionNumber == YES ) printf("Recip. condition number = %e\n", rcond); } else if ( info > 0 && lwork == -1 ) { printf("** Estimated memory: %d bytes\n", info - n); } printf("n(A) = %d, nnz(A) = %d\n", n, Astore->nnz); printf("No of nonzeros in factor L = %d\n", Lstore->nnz); printf("No of nonzeros in factor U = %d\n", Ustore->nnz); printf("No of nonzeros in L+U = %d\n", Lstore->nnz + Ustore->nnz - n); printf("Fill ratio: nnz(F)/nnz(A) = %.3f\n", ((double)(Lstore->nnz) + (double)(Ustore->nnz) - (double)n) / (double)Astore->nnz); printf("L\\U MB %.3f\ttotal MB needed %.3f\n", mem_usage.for_lu/1e6, mem_usage.total_needed/1e6); fflush(stdout); /* Set the global variables. */ GLOBAL_A = &A; GLOBAL_L = &L; GLOBAL_U = &U; GLOBAL_STAT = &stat; GLOBAL_PERM_C = perm_c; GLOBAL_PERM_R = perm_r; /* Set the variables used by GMRES. */ restrt = SUPERLU_MIN(n / 3 + 1, 50); maxit = 1000; iter = maxit; resid = 1e-8; if (!(b = doubleMalloc(m))) ABORT("Malloc fails for b[]."); if (!(x = doubleMalloc(n))) ABORT("Malloc fails for x[]."); if (info <= n + 1) { int i_1 = 1; double maxferr = 0.0, nrmA, nrmB, res, t; double temp; extern double dnrm2_(int *, double [], int *); extern void daxpy_(int *, double *, double [], int *, double [], int *); /* Call GMRES. */ for (i = 0; i < n; i++) b[i] = rhsb[i]; for (i = 0; i < n; i++) x[i] = zero; t = SuperLU_timer_(); dfgmr(n, dmatvec_mult, dpsolve, b, x, resid, restrt, &iter, stdout); t = SuperLU_timer_() - t; /* Output the result. */ nrmA = dnrm2_(&(Astore->nnz), (double *)((DNformat *)A.Store)->nzval, &i_1); nrmB = dnrm2_(&m, b, &i_1); sp_dgemv("N", -1.0, &A, x, 1, 1.0, b, 1); res = dnrm2_(&m, b, &i_1); resid = res / nrmB; printf("||A||_F = %.1e, ||B||_2 = %.1e, ||B-A*X||_2 = %.1e, " "relres = %.1e\n", nrmA, nrmB, res, resid); if (iter >= maxit) { if (resid >= 1.0) iter = -180; else if (resid > 1e-8) iter = -111; } printf("iteration: %d\nresidual: %.1e\nGMRES time: %.2f seconds.\n", iter, resid, t); /* Scale the solution back if equilibration was performed. */ if (*equed == 'C' || *equed == 'B') for (i = 0; i < n; i++) x[i] *= C[i]; for (i = 0; i < m; i++) { maxferr = SUPERLU_MAX(maxferr, fabs(x[i] - xact[i])); } printf("||X-X_true||_oo = %.1e\n", maxferr); } #ifdef DEBUG printf("%d entries in L and %d entries in U dropped.\n", num_drop_L, num_drop_U); #endif fflush(stdout); if ( options.PrintStat ) StatPrint(&stat); StatFree(&stat); SUPERLU_FREE (rhsb); SUPERLU_FREE (rhsx); SUPERLU_FREE (xact); SUPERLU_FREE (etree); SUPERLU_FREE (perm_r); SUPERLU_FREE (perm_c); SUPERLU_FREE (R); SUPERLU_FREE (C); Destroy_CompCol_Matrix(&A); Destroy_SuperMatrix_Store(&B); Destroy_SuperMatrix_Store(&X); if ( lwork >= 0 ) { Destroy_SuperNode_Matrix(&L); Destroy_CompCol_Matrix(&U); } SUPERLU_FREE(b); SUPERLU_FREE(x); #if ( DEBUGlevel>=1 ) CHECK_MALLOC("Exit main()"); #endif return 0; }
void dmatvec_mult(double alpha, double x[], double beta, double y[]) { SuperMatrix *A = GLOBAL_A; sp_dgemv("N", alpha, A, x, 1, beta, y, 1); }