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 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); }