/* PCG - Conjugate Gradients Algorithm */ void pcg(int n, double *x, double *b, double tol, int maxit, int clvl, int *iter, double *relres, int *flag, double *work, void (*matvec)(double *, double *), void (*precon)(double *, double *)) { double ALPHA; /* used for passing parameters */ int ONE = 1; /* to BLAS routines */ double n2b; /* norm of rhs vector */ double tolb; /* requested tolerance for residual */ double normr; /* residual norm */ double alpha, beta; double rho, rho1; double pq; double dmax, ddum; /* used to detect stagnation */ int stag; /* flag to indicate stagnation */ int it; /* current iteration number */ int i; /* index variable */ double *r, *z, *p, *q; /* pointers to vectors in PCG algorithm */ /* setup pointers into work */ r = work; z = work + n; p = work + 2*n; q = work + 3*n; /* Check for all zero right hand side vector => all zero solution */ n2b = F77(dnrm2)(&n, b, &ONE);/* Norm of rhs vector, b */ if (n2b == 0.0) { /* if rhs vector is all zeros */ for (i = 0; i < n; i ++) /* then solution is all zeros */ x[i] = 0.0; *flag = 0; /* a valid solution has been obtained */ *relres = 0.0; /* the relative residual is actually 0/0 */ *iter = 0; /* no iterations need be performed */ if (clvl) itermsg(tol,maxit,*flag,*iter,*relres); return; } /* Set up for the method */ *flag = 1; tolb = tol * n2b; /* Relative tolerance */ matvec(x, r); /* Zero-th residual: r = b - A * x*/ for (i = 0; i < n; i ++) /* then solution is all zeros */ r[i] = b[i] - r[i]; normr = F77(dnrm2)(&n, r, &ONE); /* Norm of residual */ if (normr <= tolb) { /* Initial guess is a good enough solution */ *flag = 0; *relres = normr / n2b; *iter = 0; if (clvl) itermsg(tol,maxit,*flag,*iter,*relres); return; } rho = 1.0; stag = 0; /* stagnation of the method */ /* loop over maxit iterations (unless convergence or failure) */ for (it = 1; it <= maxit; it ++) { if (precon) { precon(r, z); /* if isinf(norm(y,inf)) flag = 2; break end */ } else { F77(dcopy)(&n, r, &ONE, z, &ONE); } rho1 = rho; rho = F77(ddot)(&n, r, &ONE, z, &ONE); if (rho == 0.0) { /* or isinf(rho) */ *flag = 4; break; } if (it == 1) { F77(dcopy)(&n, z, &ONE, p, &ONE); } else { beta = rho / rho1; if (beta == 0.0) { /* | isinf(beta) */ *flag = 4; break; } for (i = 0; i < n; i ++) /* p = z + beta * p; */ p[i] = z[i] + beta * p[i]; } matvec(p, q); /* q = A * p */ pq = F77(ddot)(&n, p, &ONE, q, &ONE); /* pq = p' * q */ if (pq == 0.0) { /* | isinf(pq) */ *flag = 4; break; } else { alpha = rho / pq; } /* if isinf(alpha) flag = 4; break end */ if (alpha == 0.0) /* stagnation of the method */ stag = 1; /* Check for stagnation of the method */ if (stag == 0) { dmax = 0.0; for (i = 0; i < n; i ++) if (x[i] != 0.0) { ddum = fabs(alpha * p[i]/x[i]); if (ddum > dmax) dmax = ddum; } else if (p[i] != 0.0) dmax = 1.0; stag = (1.0 + dmax == 1.0); } F77(daxpy)(&n, &alpha, p, &ONE, x, &ONE); /* form new iterate */ ALPHA = -alpha; F77(daxpy)(&n, &ALPHA, q, &ONE, r, &ONE); /* r = r - alpha * q */ /* check for convergence */ #ifdef EXPENSIVE_CRIT matvec(x, z); /* normr = norm(b - A * x) */ for (i = 0; i < n; i ++) z[i] = b[i] - z[i]; normr = F77(dnrm2)(&n, z, &ONE); #else normr = F77(dnrm2)(&n, r, &ONE); /* normr = norm(r) */ #endif if (normr <= tolb) { *flag = 0; break; } if (stag == 1) { *flag = 3; break; } } /* for it = 1 : maxit */ *iter = it; *relres = normr / n2b; if (clvl) itermsg(tol,maxit,*flag,*iter,*relres); }
void production_schur_test( int argc, char *argv[] ) { //int _debugwait = 1; int loop; TMPI_dat This; Tdomain dom; Tmtx_CRS_dist Ad; Tvec_dist x, b; int i, thisroot, root=0, nloop=7; Tgmres run; Tprecon P; char *fname_stub; double precon_time, gmres_time; //double *col_norms; // TESTING 2006 // ------------ // double* xx = NULL; // ------------ Ad.init = Ad.mtx.init = 0; x.init = b.init = 0; P.init = 0; /* * initialise the MPI stuff */ // setup MPI as per command line BMPI_init( argc, argv, &This ); // setup a local communicator for This process BMPI_local_comm_create( &This ); if( root==This.this_proc ) thisroot = 1; else thisroot = 0; /*if( thisroot ) while( _debugwait ); MPI_Barrier( This.comm );*/ // Load the matrix if( !This.this_proc ) printf( "loading matrix...\n" ); fname_stub = argv[1]; if( !jacobian_load( &Ad, &dom, fname_stub, &This ) ) { if( thisroot ) printf( "Unable to reload the jacobian data\n\n" ); MPI_Finalize(); return; } // create the preconditioner if( !This.this_proc ) printf( "loading preconditioner parameters... %s\n", "./params/precon.txt" ); if( !precon_load( &P, &Ad, "./params/precon.txt") ) { printf( "ERROR : Unable to load preconditioner\n" ); MPI_Finalize(); return; } if( !This.this_proc ) { printf( "calculating preconditioner... " ); precon_print_name( stdout, P.type ); } // setup the GMRES parameters if( !This.this_proc ) printf( "loading GMRES info... %s\n", "./params/GMRES.txt" ); if( !GMRES_params_load( &run, "./params/GMRES.txt" ) ) { printf( "P%d : ERROR loading GMRES info\n", This.this_proc ); MPI_Finalize(); exit(1); } // loop the preconditioner and GMRES calculation to illustrate the solver // in a loop precon_time = gmres_time = 0.; for( loop=0; loop<nloop; loop++ ) { MPI_Barrier( This.comm ); precon_time = MPI_Wtime() - precon_time; // initialise the preconditioner // this preserves the parameters in the preconditioner precon_init( &P, &Ad, P.type ); if( P.type==PRECON_SCHUR ) { if( !precon( &P, &Ad, &dom ) ) { printf( "ERROR : Unable to form preconditioner\n" ); MPI_Finalize(); return; } } else if( !precon( &P, &Ad, NULL ) ) { printf( "ERROR : Unable to form preconditioner\n" ); MPI_Finalize(); return; } MPI_Barrier( This.comm ); precon_time = MPI_Wtime() - precon_time; // initialise the vectors vec_dist_init( &b, &This, Ad.mtx.nrows, Ad.mtx.block, Ad.vtxdist ); vec_dist_init_vec( &x, &b ); // make RHS vector by finding b = A*ones for( i=0; i<x.n; i++ ) x.dat[i] = 1; mtx_CRS_dist_gemv( &Ad, &x, &b, 1., 0., 'N' ); vec_dist_clear( &x ); // perform GMRES iteration // if( !This.this_proc ) // printf( "starting GMRES...\n" ); gmresFH( &Ad, &b, &x, &run, &P, 0 ); gmres_time += run.time_gmres; } // print out some stats if( !This.this_proc ) fprintf( stdout, "\nTimes\n\tpreconditioner calculation :\t%g seconds\n\tGMRES iterations :\t\t%g seconds\n", precon_time/(double)nloop, gmres_time/(double)nloop ); MPI_Barrier( This.comm ); if( !This.this_proc ) printf( "\nFreeing data...\n" ); precon_free( &P ); vec_dist_free( &x ); vec_dist_free( &b ); mtx_CRS_dist_free( &Ad ); GMRES_params_free( &run ); BMPI_free( &This ); // BUGFIX 2006 // ----------- domain_free( &dom ); // ----------- // close MPI MPI_Finalize(); }