/* 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();
}
