void NR::mglin(Mat_IO_DP &u, const int ncycle)
{
int j,jcycle,ng=0,ngrid,nn;
Mat_DP *uj,*uj1;
int n=u.nrows();
nn=n;
while (nn >>= 1) ng++;
if ((n-1) != (1 << ng))
nrerror("n-1 must be a power of 2 in mglin.");
Vec_Mat_DP_p rho(ng);
nn=n;
ngrid=ng-1;
rho[ngrid] = new Mat_DP(nn,nn);
copy(*rho[ngrid],u);
while (nn > 3) {
nn=nn/2+1;
rho[--ngrid]=new Mat_DP(nn,nn);
rstrct(*rho[ngrid],*rho[ngrid+1]);
}
nn=3;
uj=new Mat_DP(nn,nn);
slvsml(*uj,*rho[0]);
for (j=1;j<ng;j++) {
nn=2*nn-1;
uj1=uj;
uj=new Mat_DP(nn,nn);
interp(*uj,*uj1);
delete uj1;
for (jcycle=0;jcycle<ncycle;jcycle++)
mg(j,*uj,*rho[j]);
}
copy(u,*uj);
delete uj;
for (j=0;j<ng;j++)
delete rho[j];
}
void mglin(float ***u, int n, int ncycle){
/*
Full Multigrid Algorithm for solution of the steady state heat
equation with forcing. On input u[1..n][1..n] contains the
right-hand side ρ, while on output it returns the solution. The
dimension n must be of the form 2j + 1 for some integer j. (j is
actually the number of grid levels used in the solution, called ng
below.) ncycle is the number of V-cycles to be used at each level.
*/
unsigned int j,jcycle,jj,jpost,jpre,nf,ng=0,ngrid,nn;
/*** setup multigrid jagged arrays ***/
float ***iu[NGMAX+1]; /* stores solution at each grid level */
float ***irhs[NGMAX+1]; /* stores rhs at each grid level */
float ***ires[NGMAX+1]; /* stores residual at each grid level */
float ***irho[NGMAX+1]; /* stores rhs during intial solution of FMG */
/*** use bitshift to find the number of grid levels, stored in ng ***/
nn=n;
while (nn >>= 1) ng++;
/*** some simple input checks ***/
if (n != 1+(1L << ng)) nrerror("n-1 must be a power of 2 in mglin.");
if (ng > NGMAX) nrerror("increase NGMAX in mglin.");
/***restrict solution to next coarsest grid (irho[ng-1])***/
nn=n/2+1;
ngrid=ng-1;
irho[ngrid]=f3tensor(1,nn,1,nn,1,nn);
rstrct(irho[ngrid],u,nn);/* coarsens rhs (u at this point) to irho on mesh size nn */
/***continue setting up coarser grids down to coarsest level***/
while (nn > 3) {
nn=nn/2+1;
irho[--ngrid]=f3tensor(1,nn,1,nn,1,nn);
rstrct(irho[ngrid],irho[ngrid+1],nn);
}
/***now setup and solve coarsest level iu[1],irhs[1] ***/
nn=3;
iu[1]=f3tensor(1,nn,1,nn,1,nn);
irhs[1]=f3tensor(1,nn,1,nn,1,nn);
slvsml(iu[1],irho[1]); /* solve the small system directly */
free_f3tensor(irho[1],1,nn,1,nn,1,nn);
ngrid=ng; /* reset ngrid to original size */
for (j=2;j<=ngrid;j++) { /* loop over coarse to fine, starting at level 2 */
printf("at grid level %d\n",j);
nn=2*nn-1;
iu[j]=f3tensor(1,nn,1,nn,1,nn); /* setup grids for lhs,rhs, and residual */
irhs[j]=f3tensor(1,nn,1,nn,1,nn);
ires[j]=f3tensor(1,nn,1,nn,1,nn);
interp(iu[j],iu[j-1],nn);
/* irho contains rhs except on fine grid where it is in u */
copy(irhs[j],(j != ngrid ? irho[j] : u),nn);
/* v-cycle at current grid level */
for (jcycle=1;jcycle<=ncycle;jcycle++) {
/* nf is # points on finest grid for current v-sweep */
nf=nn;
for (jj=j;jj>=2;jj--) {
for (jpre=1;jpre<=NPRE;jpre++) /* NPRE g-s sweeps on the finest (relatively) scale */
relax(iu[jj],iu[jj-1],irhs[jj],nf); //need iu[jj-1] for jacobi
resid(ires[jj],iu[jj],irhs[jj],nf); /* compute res on finest scale, store in ires */
nf=nf/2+1; /* next coarsest scale */
rstrct(irhs[jj-1],ires[jj],nf); /* restrict residuals as rhs of next coarsest scale */
fill0(iu[jj-1],nf); /* set the initial solution guess to zero */
}
slvsml(iu[1],irhs[1]); /* solve the small problem exactly */
nf=3; /* fine scale now n=3 */
for (jj=2;jj<=j;jj++) { /* work way back up to current finest grid */
nf=2*nf-1; /* next finest scale */
addint(iu[jj],iu[jj-1],ires[jj],nf); /* inter error and add to previous solution guess */
for (jpost=1;jpost<=NPOST;jpost++) /* do NPOST g-s sweeps */
relax(iu[jj],iu[jj-1],irhs[jj],nf);
}
}
}
copy(u,iu[ngrid],n); /* copy solution into input array (implicitly returned) */
/*** clean up memory ***/
for (nn=n,j=ng;j>=2;j--,nn=nn/2+1) {
free_f3tensor(ires[j],1,nn,1,nn,1,nn);
free_f3tensor(irhs[j],1,nn,1,nn,1,nn);
free_f3tensor(iu[j],1,nn,1,nn,1,nn);
if (j != ng) free_f3tensor(irho[j],1,nn,1,nn,1,nn);
}
free_f3tensor(irhs[1],1,3,1,3,1,3);
free_f3tensor(iu[1],1,3,1,3,1,3);
}
void mgfas(double **u, int n, int maxcyc)
{
double anorm2(double **a, int n);
void copy(double **aout, double **ain, int n);
void interp(double **uf, double **uc, int nf);
void lop(double **out, double **u, int n);
void matadd(double **a, double **b, double **c, int n);
void matsub(double **a, double **b, double **c, int n);
void relax2(double **u, double **rhs, int n);
void rstrct(double **uc, double **uf, int nc);
void slvsm2(double **u, double **rhs);
unsigned int j,jcycle,jj,jm1,jpost,jpre,nf,ng=0,ngrid,nn;
double **irho[NGMAX+1],**irhs[NGMAX+1],**itau[NGMAX+1],
**itemp[NGMAX+1],**iu[NGMAX+1];
double res,trerr;
nn=n;
while (nn >>= 1) ng++;
if (n != 1+(1L << ng)) nrerror("n-1 must be a power of 2 in mgfas.");
if (ng > NGMAX) nrerror("increase NGMAX in mglin.");
nn=n/2+1;
ngrid=ng-1;
irho[ngrid]=dmatrix(1,nn,1,nn);
rstrct(irho[ngrid],u,nn);
while (nn > 3) {
nn=nn/2+1;
irho[--ngrid]=dmatrix(1,nn,1,nn);
rstrct(irho[ngrid],irho[ngrid+1],nn);
}
nn=3;
iu[1]=dmatrix(1,nn,1,nn);
irhs[1]=dmatrix(1,nn,1,nn);
itau[1]=dmatrix(1,nn,1,nn);
itemp[1]=dmatrix(1,nn,1,nn);
slvsm2(iu[1],irho[1]);
free_dmatrix(irho[1],1,nn,1,nn);
ngrid=ng;
for (j=2;j<=ngrid;j++) {
nn=2*nn-1;
iu[j]=dmatrix(1,nn,1,nn);
irhs[j]=dmatrix(1,nn,1,nn);
itau[j]=dmatrix(1,nn,1,nn);
itemp[j]=dmatrix(1,nn,1,nn);
interp(iu[j],iu[j-1],nn);
copy(irhs[j],(j != ngrid ? irho[j] : u),nn);
for (jcycle=1;jcycle<=maxcyc;jcycle++) {
nf=nn;
for (jj=j;jj>=2;jj--) {
for (jpre=1;jpre<=NPRE;jpre++)
relax2(iu[jj],irhs[jj],nf);
lop(itemp[jj],iu[jj],nf);
nf=nf/2+1;
jm1=jj-1;
rstrct(itemp[jm1],itemp[jj],nf);
rstrct(iu[jm1],iu[jj],nf);
lop(itau[jm1],iu[jm1],nf);
matsub(itau[jm1],itemp[jm1],itau[jm1],nf);
if (jj == j)
trerr=ALPHA*anorm2(itau[jm1],nf);
rstrct(irhs[jm1],irhs[jj],nf);
matadd(irhs[jm1],itau[jm1],irhs[jm1],nf);
}
slvsm2(iu[1],irhs[1]);
nf=3;
for (jj=2;jj<=j;jj++) {
jm1=jj-1;
rstrct(itemp[jm1],iu[jj],nf);
matsub(iu[jm1],itemp[jm1],itemp[jm1],nf);
nf=2*nf-1;
interp(itau[jj],itemp[jm1],nf);
matadd(iu[jj],itau[jj],iu[jj],nf);
for (jpost=1;jpost<=NPOST;jpost++)
relax2(iu[jj],irhs[jj],nf);
}
lop(itemp[j],iu[j],nf);
matsub(itemp[j],irhs[j],itemp[j],nf);
res=anorm2(itemp[j],nf);
if (res < trerr) break;
}
}
copy(u,iu[ngrid],n);
for (nn=n,j=ng;j>=1;j--,nn=nn/2+1) {
free_dmatrix(itemp[j],1,nn,1,nn);
free_dmatrix(itau[j],1,nn,1,nn);
free_dmatrix(irhs[j],1,nn,1,nn);
free_dmatrix(iu[j],1,nn,1,nn);
if (j != ng && j != 1) free_dmatrix(irho[j],1,nn,1,nn);
}
}
void mglin(double **u, int n, int ncycle)
{
void addint(double **uf, double **uc, double **res, int nf);
void copy(double **aout, double **ain, int n);
void fill0(double **u, int n);
void interp(double **uf, double **uc, int nf);
void relax(double **u, double **rhs, int n);
void resid(double **res, double **u, double **rhs, int n);
void rstrct(double **uc, double **uf, int nc);
void slvsml(double **u, double **rhs);
unsigned int j,jcycle,jj,jpost,jpre,nf,ng=0,ngrid,nn;
double **ires[NGMAX+1],**irho[NGMAX+1],**irhs[NGMAX+1],**iu[NGMAX+1];
nn=n;
while (nn >>= 1) ng++;
if (n != 1+(1L << ng)) nrerror("n-1 must be a power of 2 in mglin.");
if (ng > NGMAX) nrerror("increase NGMAX in mglin.");
nn=n/2+1;
ngrid=ng-1;
irho[ngrid]=dmatrix(1,nn,1,nn);
rstrct(irho[ngrid],u,nn);
while (nn > 3) {
nn=nn/2+1;
irho[--ngrid]=dmatrix(1,nn,1,nn);
rstrct(irho[ngrid],irho[ngrid+1],nn);
}
nn=3;
iu[1]=dmatrix(1,nn,1,nn);
irhs[1]=dmatrix(1,nn,1,nn);
slvsml(iu[1],irho[1]);
free_dmatrix(irho[1],1,nn,1,nn);
ngrid=ng;
for (j=2;j<=ngrid;j++) {
nn=2*nn-1;
iu[j]=dmatrix(1,nn,1,nn);
irhs[j]=dmatrix(1,nn,1,nn);
ires[j]=dmatrix(1,nn,1,nn);
interp(iu[j],iu[j-1],nn);
copy(irhs[j],(j != ngrid ? irho[j] : u),nn);
for (jcycle=1;jcycle<=ncycle;jcycle++) {
nf=nn;
for (jj=j;jj>=2;jj--) {
for (jpre=1;jpre<=NPRE;jpre++)
relax(iu[jj],irhs[jj],nf);
resid(ires[jj],iu[jj],irhs[jj],nf);
nf=nf/2+1;
rstrct(irhs[jj-1],ires[jj],nf);
fill0(iu[jj-1],nf);
}
slvsml(iu[1],irhs[1]);
nf=3;
for (jj=2;jj<=j;jj++) {
nf=2*nf-1;
addint(iu[jj],iu[jj-1],ires[jj],nf);
for (jpost=1;jpost<=NPOST;jpost++)
relax(iu[jj],irhs[jj],nf);
}
}
}
copy(u,iu[ngrid],n);
for (nn=n,j=ng;j>=2;j--,nn=nn/2+1) {
free_dmatrix(ires[j],1,nn,1,nn);
free_dmatrix(irhs[j],1,nn,1,nn);
free_dmatrix(iu[j],1,nn,1,nn);
if (j != ng) free_dmatrix(irho[j],1,nn,1,nn);
}
free_dmatrix(irhs[1],1,3,1,3);
free_dmatrix(iu[1],1,3,1,3);
}
