VPUBLIC void Vdpbsl(double *abd, int *lda, int *n, int *m, double *b) {
double t;
int k, kb, la, lb, lm;
MAT2(abd, *lda, 1);
for (k=1; k<=*n; k++) {
lm = VMIN2(k-1, *m);
la = *m + 1 - lm;
lb = k - lm;
t = Vddot(lm, RAT2(abd, la, k ), 1, RAT(b, lb), 1 );
VAT(b, k) = (VAT(b, k) - t) / VAT2(abd, *m+1, k);
}
// Solve R*X = Y
for (kb=1; kb<=*n; kb++) {
k = *n + 1 - kb;
lm = VMIN2(k-1, *m);
la = *m + 1 - lm;
lb = k - lm;
VAT(b, k) /= VAT2(abd, *m+1, k);
t = -VAT(b, k);
Vdaxpy(lm, t, RAT2(abd, la, k), 1, RAT(b, lb), 1);
}
}
VPUBLIC void Vgetjac(int *nx, int *ny, int *nz,
int *nlev_real, int *iz, int *lev, int *ipkey,
double *x, double *r,
double *cprime, double *rhs,
double *cc, double *pc) {
int nxx, nyy, nzz;
int nxold, nyold, nzold;
int level, numlev;
MAT2(iz, 50, 1);
// Setup
nxx = *nx;
nyy = *ny;
nzz = *nz;
// Form the rhs of the newton system -- just current residual
Vxcopy(nx, ny, nz, r, RAT(rhs, VAT2(iz, 1,*lev)));
// Get nonlinear part of the jacobian operator
Vdc_vec(RAT(cc, VAT2(iz, 1,*lev)), RAT(x, VAT2(iz, 1,*lev)),
RAT(cprime, VAT2(iz, 1,*lev)),
nx, ny, nz, ipkey);
// Build the (nlev-1) level operators
for (level=*lev+1; level<=*nlev_real; level++) {
nxold = nxx;
nyold = nyy;
nzold = nzz;
numlev = 1;
Vmkcors(&numlev, &nxold, &nyold, &nzold, &nxx, &nyy, &nzz);
// Make the coarse grid rhs functions
Vrestrc(&nxold, &nyold, &nzold,
&nxx, &nyy, &nzz,
RAT(rhs, VAT2(iz, 1,level-1)),
RAT(rhs, VAT2(iz, 1,level )),
RAT( pc, VAT2(iz, 11,level-1)));
// Make the coarse grid helmholtz terms
Vrestrc(&nxold, &nyold, &nzold,
&nxx, &nyy, &nzz,
RAT(cprime, VAT2(iz, 1, level-1)),
RAT(cprime, VAT2(iz, 1, level )),
RAT( pc, VAT2(iz, 11, level-1)));
}
}
VPUBLIC void Vdpbfa(double *abd, int *lda, int *n, int *m, int *info) {
double t, s;
int ik, j, jk, k, mu;
MAT2(abd, *lda, 1);
*info = 0;
for(j = 1; j <= *n; j++) {
s = 0.0;
ik = *m + 1;
jk = VMAX2(j - *m, 1);
mu = VMAX2(*m + 2 - j, 1);
if (*m >= mu ) {
for(k = mu; k <= *m; k++) {
t = VAT2(abd, k, j) - Vddot(k - mu,
RAT2(abd, ik, jk), 1,
RAT2(abd, mu, j), 1);
t /= VAT2(abd, *m + 1, jk);
VAT2(abd, k, j) = t;
s += t * t;
ik--;
jk++;
}
}
s = VAT2(abd, *m + 1, j) - s;
if (s <= 0.0) {
*info = j;
break;
}
VAT2(abd, *m + 1, j) = VSQRT(s);
}
}
VPUBLIC void Vfnewton(int *nx,int *ny,int *nz,
double *x, int *iz,
double *w0, double *w1, double *w2, double *w3,
int *istop, int *itmax, int *iters, int *ierror,
int *nlev, int *ilev, int *nlev_real,
int *mgsolv, int *iok, int *iinfo,
double *epsiln, double *errtol, double *omega,
int *nu1, int *nu2, int *mgsmoo,
double *cprime, double *rhs, double *xtmp,
int *ipc, double *rpc,
double *pc, double *ac, double *cc, double *fc, double *tru) {
int level, itmxd, nlevd, iterd, iokd;
int nxf, nyf, nzf;
int nxc, nyc, nzc;
int istpd;
int numlev;
double errd;
MAT2( iz, 50, 1);
// Recover gridsizes ***
nxf = *nx;
nyf = *ny;
nzf = *nz;
numlev = *nlev - 1;
Vmkcors(&numlev, &nxf, &nyf, &nzf, &nxc, &nyc, &nzc);
// Move up grids: interpolate solution to finer, do newton
if (*iinfo > 1) {
VMESSAGE0("Starting");
VMESSAGE3("Fine Grid Size: (%d, %d, %d)", nxf, nyf, nzf);
VMESSAGE3("Course Grid Size: (%d, %d, %d)", nxc, nyc, nzc);
}
for (level=*nlev_real; level<=*ilev+1; level--) {
// Call mv cycle
errd = *errtol;
itmxd = 1000;
nlevd = *nlev_real - level + 1;
iterd = 0;
iokd = *iok;
istpd = *istop;
Vnewton(&nxc, &nyc, &nzc,
x, iz,
w0, w1, w2, w3,
&istpd, &itmxd, &iterd, ierror,
&nlevd, &level, nlev_real,
mgsolv, &iokd, iinfo,
epsiln, &errd, omega,
nu1, nu2, mgsmoo,
cprime, rhs, xtmp,
ipc, rpc,
pc, ac, cc, fc, tru);
// Find new grid size ***
numlev = 1;
Vmkfine(&numlev, &nxc, &nyc, &nzc, &nxf, &nyf, &nzf);
// Interpolate to next finer grid (use correct bc's)
VinterpPMG(&nxc, &nyc, &nzc,
&nxf, &nyf, &nzf,
RAT( x, VAT2(iz, 1, level )),
RAT( x, VAT2(iz, 1, level-1)),
RAT(pc, VAT2(iz, 11, level-1)));
/*
Commented out fortran code. May need to implement later
call ninterpPMG(nxc,nyc,nzc,nxf,nyf,nzf,
x(iz(1,level)),x(iz(1,level-1)),pc(iz(11,level-1)),
ipc(iz(5,level-1)),rpc(iz(6,level-1)),
ac(iz(7,level-1)),cc(iz(1,level-1)),fc(iz(1,level-1)))
*/
// New grid size
nxc = nxf;
nyc = nyf;
nzc = nzf;
}
// Call mv cycle
level = *ilev;
Vnewton(nx, ny, nz,
x, iz,
w0, w1, w2, w3,
istop, itmax, iters, ierror,
nlev, &level, nlev_real,
mgsolv, iok, iinfo,
epsiln, errtol, omega,
nu1, nu2, mgsmoo,
cprime, rhs, xtmp,
ipc, rpc,
pc, ac, cc, fc, tru);
}
VPUBLIC void Vnewton(int *nx, int *ny, int *nz,
double *x, int *iz,
double *w0, double *w1, double *w2, double *w3,
int *istop, int *itmax, int *iters, int *ierror,
int *nlev, int *ilev, int *nlev_real,
int *mgsolv, int *iok, int *iinfo,
double *epsiln, double *errtol, double *omega,
int *nu1, int *nu2, int *mgsmoo,
double *cprime, double *rhs, double *xtmp,
int *ipc, double *rpc,
double *pc, double *ac, double *cc, double *fc, double *tru) {
int level, lev;
int itmax_s, iters_s, ierror_s, iok_s, iinfo_s, istop_s;
double errtol_s, ord, bigc;
double rsden, rsnrm, orsnrm;
double xnorm_old, xnorm_new, damp, xnorm_med, xnorm_den;
double rho_max, rho_min, rho_max_mod, rho_min_mod, errtol_p;
int iter_d, itmax_d, mode, idamp, ipkey;
int itmax_p, iters_p, iok_p, iinfo_p;
// Utility and temproary parameters
double alpha;
MAT2(iz, 50, 1);
// Recover level information
level = 1;
lev = (*ilev - 1) + level;
// Do some i/o if requested
if (*iinfo > 1) {
VMESSAGE3("Starting: (%d, %d, %d)", *nx, *ny, *nz);
}
if (*iok != 0) {
Vprtstp(*iok, -1, 0.0, 0.0, 0.0);
}
/**************************************************************
*** note: if (iok!=0) then: use a stopping test. ***
*** else: use just the itmax to stop iteration. ***
**************************************************************
*** istop=0 most efficient (whatever it is) ***
*** istop=1 relative residual ***
*** istop=2 rms difference of successive iterates ***
*** istop=3 relative true error (provided for testing) ***
**************************************************************/
// Compute denominator for stopping criterion
if (*istop == 0) {
rsden = 1.0;
} else if (*istop == 1) {
// Compute initial residual with zero initial guess
// this is analogous to the linear case where one can
// simply take norm of rhs for a zero initial guess
Vazeros(nx, ny, nz, w1);
Vnmresid(nx, ny, nz,
RAT(ipc, VAT2(iz, 5, lev)), RAT(rpc, VAT2(iz, 6, lev)),
RAT( ac, VAT2(iz, 7, lev)), RAT( cc, VAT2(iz, 1, lev)),
RAT( fc, VAT2(iz, 1, lev)),
w1, w2, w3);
rsden = Vxnrm1(nx, ny, nz, w2);
} else if (*istop == 2) {
rsden = VSQRT( *nx * *ny * *nz);
} else if (*istop == 3) {
rsden = Vxnrm2(nx, ny, nz, RAT(tru, VAT2(iz, 1, lev)));
} else if (*istop == 4) {
rsden = Vxnrm2(nx, ny, nz, RAT(tru, VAT2(iz, 1, lev)));
} else if (*istop == 5) {
Vnmatvec(nx, ny, nz,
RAT(ipc, VAT2(iz, 5, lev)), RAT(rpc, VAT2(iz, 6, lev)),
RAT( ac, VAT2(iz, 7, lev)), RAT( cc, VAT2(iz, 1, lev)),
RAT(tru, VAT2(iz, 1, lev)),
w1, w2);
rsden = VSQRT(Vxdot(nx, ny, nz, RAT(tru, VAT2(iz, 1, lev)), w1));
} else {
VABORT_MSG1("Bad istop value: %d\n", *istop);
}
if (rsden == 0.0) {
rsden = 1.0;
VWARN_MSG0(rsden != 0, "rhs is zero");
}
rsnrm = rsden;
orsnrm = rsnrm;
if (*iok != 0) {
Vprtstp(*iok, 0, rsnrm, rsden, orsnrm);
}
/*********************************************************************
*** begin newton iteration
*********************************************************************/
// Now compute residual with the initial guess
Vnmresid(nx, ny, nz,
RAT(ipc, VAT2(iz, 5, lev)), RAT(rpc, VAT2(iz, 6, lev)),
RAT( ac, VAT2(iz, 7, lev)), RAT( cc, VAT2(iz, 1, lev)),
RAT( fc, VAT2(iz, 1, lev)), RAT( x, VAT2(iz, 1, lev)),
w0, w2);
xnorm_old = Vxnrm1(nx, ny, nz, w0);
if (*iok != 0) {
xnorm_den = rsden;
} else {
xnorm_den = xnorm_old;
}
/*********************************************************************
*** begin the loop
*********************************************************************/
// Setup for the looping
VMESSAGE0("Damping enabled");
idamp = 1;
*iters = 0;
//30
while(1) {
(*iters)++;
// Save iterate if stop test will use it on next iter
if (*istop == 2) {
Vxcopy(nx, ny, nz,
RAT(x, VAT2(iz, 1, lev)), RAT(tru, VAT2(iz, 1, lev)));
}
// Compute the current jacobian system and rhs
ipkey = VAT(ipc, 10);
Vgetjac(nx, ny, nz, nlev_real, iz, ilev, &ipkey,
x, w0, cprime, rhs, cc, pc);
// Determine number of correct digits in current residual
// Algorithm 5.3 in the thesis, test version (1')
// Global-superlinear convergence
bigc = 1.0;
ord = 2.0;
/* NAB 06-18-01: If complex problems are not converging, set this to
* machine epsilon. This makes it use the exact jacobian rather than
* the appropriate form (as here)
*/
errtol_s = VMIN2((0.9 * xnorm_old), (bigc * VPOW(xnorm_old, ord)));
VMESSAGE1("Using errtol_s: %f", errtol_s);
// Do a linear multigrid solve of the newton equations
Vazeros(nx, ny, nz, RAT(xtmp, VAT2(iz, 1, lev)));
itmax_s = 1000;
istop_s = 0;
iters_s = 0;
ierror_s = 0;
// NAB 06-18-01 -- What this used to be:
iok_s = 0;
iinfo_s = 0;
if ((*iinfo >= 2) && (*ilev == 1))
iok_s = 2;
// What it's changed to:
if (*iinfo >= 2)
iinfo_s = *iinfo;
iok_s = 2;
// End of NAB hack.
Vmvcs(nx, ny, nz,
xtmp, iz,
w0, w1, w2, w3,
&istop_s, &itmax_s, &iters_s, &ierror_s,
nlev, ilev, nlev_real, mgsolv,
&iok_s, &iinfo_s,
epsiln, &errtol_s, omega,
nu1, nu2, mgsmoo,
ipc, rpc, pc, ac, cprime, rhs, tru);
/**************************************************************
*** note: rhs and cprime are now available as temp vectors ***
**************************************************************/
// If damping is still enabled -- doit
if (idamp == 1) {
// Try the correction
Vxcopy(nx, ny, nz,
RAT(x, VAT2(iz, 1, lev)), w1);
damp = 1.0;
Vxaxpy(nx, ny, nz, &damp, RAT(xtmp, VAT2(iz, 1, lev)), w1);
Vnmresid(nx, ny, nz,
RAT(ipc, VAT2(iz, 5, lev)), RAT(rpc, VAT2(iz, 6, lev)),
RAT( ac, VAT2(iz, 7, lev)), RAT( cc, VAT2(iz, 1, lev)),
RAT( fc, VAT2(iz, 1, lev)),
w1, w0,
RAT(rhs, VAT2(iz, 1, lev)));
xnorm_new = Vxnrm1(nx, ny, nz, w0);
// Damping is still enabled -- doit
damp = 1.0;
iter_d = 0;
itmax_d = 10;
mode = 0;
VMESSAGE1("Attempting damping, relres = %f", xnorm_new / xnorm_den);
while(iter_d < itmax_d) {
if (mode == 0) {
if (xnorm_new < xnorm_old) {
mode = 1;
}
} else if (xnorm_new > xnorm_med) {
break;
}
// Keep old soln and residual around, and its norm
Vxcopy(nx, ny, nz, w1, w2);
Vxcopy(nx, ny, nz, w0, w3);
xnorm_med = xnorm_new;
// New damped correction, residual, and its norm
Vxcopy(nx, ny, nz,
RAT(x, VAT2(iz, 1, lev)), w1);
damp = damp / 2.0;
Vxaxpy(nx, ny, nz, &damp, RAT(xtmp, VAT2(iz, 1, lev)), w1);
Vnmresid(nx, ny, nz,
RAT(ipc, VAT2(iz, 5, lev)), RAT(rpc, VAT2(iz, 6, lev)),
RAT( ac, VAT2(iz, 7, lev)), RAT( cc, VAT2(iz, 1, lev)),
RAT( fc, VAT2(iz, 1, lev)),
w1, w0,
RAT(rhs, VAT2(iz, 1, lev)));
xnorm_new = Vxnrm1(nx, ny, nz, w0);
// Next iter...
iter_d = iter_d + 1;
VMESSAGE1("Attempting damping, relres = %f",
xnorm_new / xnorm_den);
}
Vxcopy(nx, ny, nz, w2, RAT(x, VAT2(iz, 1, lev)));
Vxcopy(nx, ny, nz, w3, w0);
xnorm_new = xnorm_med;
xnorm_old = xnorm_new;
VMESSAGE1("Damping accepted, relres = %f", xnorm_new / xnorm_den);
// Determine whether or not to disable damping
if ((iter_d - 1) == 0) {
VMESSAGE0("Damping disabled");
idamp = 0;
}
} else {
// Damping is disabled -- accept the newton step
damp = 1.0;
Vxaxpy(nx, ny, nz, &damp,
RAT(xtmp, VAT2(iz, 1, lev)), RAT(x, VAT2(iz, 1, lev)));
Vnmresid(nx, ny, nz,
RAT(ipc, VAT2(iz, 5, lev)), RAT(rpc, VAT2(iz, 6, lev)),
RAT( ac, VAT2(iz, 7, lev)), RAT( cc, VAT2(iz, 1, lev)),
RAT( fc, VAT2(iz, 1, lev)), RAT( x, VAT2(iz, 1, lev)),
w0,
RAT(rhs, VAT2(iz, 1, lev)));
xnorm_new = Vxnrm1(nx, ny, nz, w0);
xnorm_old = xnorm_new;
}
// Compute/check the current stopping test ***
if (iok != 0) {
orsnrm = rsnrm;
if (*istop == 0) {
rsnrm = xnorm_new;
} else if (*istop == 1) {
rsnrm = xnorm_new;
} else if (*istop == 2) {
Vxcopy(nx, ny, nz, RAT(tru, VAT2(iz, 1, lev)), w1);
alpha = -1.0;
Vxaxpy(nx, ny, nz, &alpha, RAT(x, VAT2(iz, 1, lev)), w1);
rsnrm = Vxnrm1(nx, ny, nz, w1);
} else if (*istop == 3) {
Vxcopy(nx, ny, nz, RAT(tru, VAT2(iz, 1, lev)), w1);
alpha = -1.0;
Vxaxpy(nx, ny, nz, &alpha, RAT(x, VAT2(iz, 1, lev)), w1);
rsnrm = Vxnrm2(nx, ny, nz, w1);
} else if (*istop == 4) {
Vxcopy(nx, ny, nz, RAT(tru, VAT2(iz, 1, lev)), w1);
alpha = -1.0;
Vxaxpy(nx, ny, nz, &alpha, RAT(x, VAT2(iz, 1, lev)), w1);
rsnrm = Vxnrm2(nx, ny, nz, w1);
} else if (*istop == 5) {
Vxcopy(nx, ny, nz, RAT(tru, VAT2(iz, 1, lev)), w1);
alpha = -1.0;
Vxaxpy(nx, ny, nz, &alpha, RAT(x, VAT2(iz, 1, lev)), w1);
Vnmatvec(nx, ny, nz,
RAT(ipc, VAT2(iz, 5, lev)), RAT(rpc, VAT2(iz, 6, lev)),
RAT( ac, VAT2(iz, 7, lev)), RAT( cc, VAT2(iz, 1, lev)),
w1, w2, w3);
rsnrm = VSQRT(Vxdot(nx, ny, nz, w1, w2));
} else {
VABORT_MSG1("Bad istop value: %d", *istop);
}
Vprtstp(*iok, *iters, rsnrm, rsden, orsnrm);
if ((rsnrm/rsden) <= *errtol)
break;
}
// Check iteration count ***
if (*iters >= *itmax)
break;
}
// Condition estimate of final jacobian
if (*iinfo > 2) {
Vnm_print(2, "%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%\n");
Vnm_print(2, "% Vnewton: JACOBIAN ANALYSIS ==> (%d, %d, %d)\n",
*nx, *ny, *nz );
// Largest eigenvalue of the jacobian matrix
Vnm_print(2, "% Vnewton: Power calculating rho(JAC)\n");
itmax_p = 1000;
errtol_p = 1.0e-4;
iters_p = 0;
iinfo_p = *iinfo;
Vpower(nx, ny, nz,
iz, ilev,
ipc, rpc, ac, cprime,
w0, w1, w2, w3,
&rho_max, &rho_max_mod,
&errtol_p, &itmax_p, &iters_p, &iinfo_p);
Vnm_print(2, "% Vnewton: power iters = %d\n", iters_p);
Vnm_print(2, "% Vnewton: power eigmax = %d\n", rho_max);
Vnm_print(2, "% Vnewton: power (MODEL) = %d\n", rho_max_mod);
// Smallest eigenvalue of the system matrix A ***
Vnm_print(2, "% Vnewton: ipower calculating lambda_min(JAC)...\n");
itmax_p = 1000;
errtol_p = 1.0e-4;
iters_p = 0;
iinfo_p = *iinfo;
Vazeros(nx, ny, nz, xtmp);
Vipower(nx, ny, nz,
xtmp, iz,
w0, w1, w2, w3,
rhs, &rho_min, &rho_min_mod,
&errtol_p, &itmax_p, &iters_p,
nlev, ilev, nlev_real, mgsolv,
&iok_p, &iinfo_p,
epsiln, errtol, omega,
nu1, nu2, mgsmoo,
ipc, rpc,
pc, ac, cprime, tru);
Vnm_print(2, "% Vnewton: ipower iters = %d\n", iters_p);
Vnm_print(2, "% Vnewton: ipower eigmin = %d\n", rho_min);
Vnm_print(2, "% Vnewton: ipower (MODEL) = %d\n", rho_min_mod);
// Condition number estimate
Vnm_print(2, "% Vnewton: condition number = %f\n",
(double)rho_max / rho_min);
Vnm_print(2, "% Vnewton: condition (MODEL) = %f\n",
(double)rho_max_mod / rho_min_mod);
Vnm_print(2, "%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%\n");
}
}
VPUBLIC void Vpower(int *nx, int *ny, int *nz,
int *iz, int *ilev,
int *ipc, double *rpc, double *ac, double *cc,
double *w1, double *w2, double *w3, double *w4,
double *eigmax, double *eigmax_model, double *tol,
int *itmax, int *iters, int *iinfo) {
int lev, level;
double denom, fac, rho, oldrho, error, relerr;
/// @todo Just use a constant definition of PI here
double pi = 4.0 * atan( 1.0 );
// Utility variables
int skipIters = 0;
double alpha;
MAT2(iz, 50, 1);
WARN_UNTESTED;
// Recover level information
level = 1;
lev = (*ilev - 1) + level;
// Seed vector: random to contain all components
Vaxrand(nx, ny, nz, w1);
Vazeros(nx, ny, nz, w2);
Vazeros(nx, ny, nz, w3);
Vazeros(nx, ny, nz, w4);
// Compute raleigh quotient with the seed vector
denom = Vxnrm2(nx, ny, nz, w1);
fac = 1.0 / denom;
Vxscal(nx, ny, nz, &fac, w1);
Vmatvec(nx, ny, nz,
RAT(ipc, VAT2(iz, 5, lev)), RAT(rpc, VAT2(iz, 6,lev)),
RAT(ac, VAT2(iz, 7, lev)), RAT(cc, VAT2(iz, 1,lev)), w1, w2);
oldrho = Vxdot(nx, ny, nz, w1, w2);
// I/O
if (oldrho == 0.0) {
if (*iinfo > 3) {
Vnm_print(2, "POWER: iter: estimate = %d %g\n", *iters, oldrho);
}
rho = oldrho;
} else {
// Main iteration
*iters = 0;
while(1) {
(*iters)++;
// Apply the matrix A
Vmatvec(nx, ny, nz,
RAT(ipc, VAT2(iz, 5, lev)), RAT(rpc, VAT2(iz, 6, lev)),
RAT(ac, VAT2(iz, 7, lev)), RAT(cc, VAT2(iz, 1, lev)), w1, w2);
Vxcopy(nx, ny, nz, w2, w1);
// Normalize the new vector
denom = Vxnrm2(nx, ny, nz, w1);
fac = 1.0 / denom;
Vxscal(nx, ny, nz, &fac, w1);
// Compute the new raleigh quotient
Vmatvec(nx, ny, nz,
RAT(ipc, VAT2(iz, 5, lev)), RAT(rpc, VAT2(iz, 6, lev)),
RAT( ac, VAT2(iz, 7, lev)), RAT( cc, VAT2(iz, 1, lev)), w1, w2);
rho = Vxdot(nx, ny, nz, w1, w2);
// Stopping test ***
// w2=A*x, w1=x, stop = 2-norm(A*x-lamda*x)
Vxcopy(nx, ny, nz, w1, w3);
Vxcopy(nx, ny, nz, w2, w4);
Vxscal(nx, ny, nz, &rho, w3);
alpha = -1.0;
Vxaxpy(nx, ny, nz, &alpha, w3, w4);
error = Vxnrm2(nx, ny, nz, w4);
relerr = VABS(rho - oldrho ) / VABS( rho );
// I/O
if (*iinfo > 3) {
Vnm_print(2, "POWER: iters =%d\n", *iters);
Vnm_print(2, " error =%g\n", error);
Vnm_print(2, " relerr =%g\n", relerr);
Vnm_print(2, " rho =%g\n", rho);
}
if( relerr < *tol || *iters == *itmax)
break;
oldrho = rho;
}
}
// Return some stuff ***
*eigmax = rho;
fac = VPOW(2.0, *ilev - 1);
*eigmax_model = fac * (6.0 - 2.0 * VCOS((*nx - 2) * pi / (*nx - 1))
- 2.0 * VCOS((*ny - 2) * pi / (*ny - 1)));
}
VEXTERNC void Vmpower(int *nx, int *ny, int *nz,
double *u, int *iz,
double *w0, double *w1, double *w2, double *w3, double *w4,
double *eigmax, double *tol,
int *itmax, int *iters, int *nlev, int *ilev, int *nlev_real,
int *mgsolv, int *iok, int *iinfo,
double *epsiln, double *errtol, double *omega,
int *nu1, int *nu2, int *mgsmoo, int *ipc, double *rpc,
double *pc, double *ac, double *cc, double *fc, double *tru) {
// Local variables
int lev, level;
double denom, fac, rho, oldrho, error;
double relerr;
int itmax_s, iters_s, ierror_s, iok_s, iinfo_s, istop_s;
double alpha;
MAT2(iz, 50, 1);
// Recover level information
level = 1;
lev = (*ilev - 1) + level;
// Seed vector: random to contain all components
Vaxrand(nx, ny, nz, w1);
Vazeros(nx, ny, nz, w2);
Vazeros(nx, ny, nz, w3);
Vazeros(nx, ny, nz, w4);
Vazeros(nx, ny, nz, RAT(u, VAT2(iz, 1, lev)));
// NOTE: we destroy "fc" on this level due to lack of vectors... ***
Vazeros(nx,ny,nz,RAT(fc, VAT2(iz, 1, lev)));
// Normalize the seed vector
denom = Vxnrm2(nx, ny, nz, w1);
fac = 1.0 / denom;
Vxscal(nx, ny, nz, &fac, w1);
// Compute raleigh quotient with the seed vector
Vxcopy(nx, ny, nz, w1, RAT(u, VAT2(iz, 1, lev)));
itmax_s = 1;
iters_s = 0;
ierror_s = 0;
iok_s = 0;
iinfo_s = 0;
istop_s = 1;
Vmvcs(nx, ny, nz,
u, iz, w0, w2, w3, w4,
&istop_s, &itmax_s, &iters_s, &ierror_s,
nlev, ilev, nlev_real, mgsolv,
&iok_s, &iinfo_s,
epsiln, errtol, omega, nu1, nu2, mgsmoo,
ipc, rpc,
pc, ac, cc, fc, tru);
oldrho = Vxdot(nx, ny, nz, w1, RAT(u, VAT2(iz, 1, lev)));
// I/O
if (oldrho == 0.0) {
if (*iinfo > 3) {
Vnm_print(2, "Vmp0ower: iter=%d, estimate=%f", *iters, oldrho);
}
rho = oldrho;
} else {
// Main iteration
*iters = 0;
while (1) {
(*iters)++;
// Apply the matrix M
Vxcopy(nx, ny, nz, w1, RAT(u, VAT2(iz, 1, lev)));
itmax_s = 1;
iters_s = 0;
ierror_s = 0;
iok_s = 0;
iinfo_s = 0;
istop_s = 1;
Vmvcs(nx, ny, nz,
u, iz, w1, w2, w3, w4,
&istop_s, &itmax_s, &iters_s, &ierror_s,
nlev, ilev, nlev_real, mgsolv,
&iok_s, &iinfo_s,
epsiln, errtol, omega, nu1, nu2, mgsmoo,
ipc, rpc,
pc, ac, cc, fc, tru);
Vxcopy(nx, ny, nz, RAT(u, VAT2(iz, 1, lev)), w1);
// Normalize the new vector
denom = Vxnrm2(nx, ny, nz, w1);
fac = 1.0 / denom;
Vxscal(nx, ny, nz, &fac, w1);
// Compute the new raleigh quotient
Vxcopy(nx, ny, nz, w1, RAT(u, VAT2(iz, 1, lev)));
itmax_s = 1;
iters_s = 0;
ierror_s = 0;
iok_s = 0;
iinfo_s = 0;
istop_s = 1;
Vmvcs(nx, ny, nz,
u, iz, w0, w2, w3, w4,
&istop_s, &itmax_s, &iters_s, &ierror_s,
nlev, ilev, nlev_real, mgsolv,
&iok_s, &iinfo_s,
epsiln, errtol, omega, nu1, nu2, mgsmoo,
ipc, rpc,
pc, ac, cc, fc, tru);
Vxcopy(nx, ny, nz, RAT(u, VAT2(iz, 1, lev)), w2);
rho = Vxdot(nx, ny, nz, w1, w2);
// Stopping test
// w2=A*x, w1=x, stop = 2-norm(A*x-lamda*x)
alpha = -1.0;
Vxcopy(nx, ny, nz, w1, w3);
Vxcopy(nx, ny, nz, w2, w4);
Vxscal(nx, ny, nz, &rho, w3);
Vxaxpy(nx, ny, nz, &alpha, w3, w4);
error = Vxnrm2(nx, ny, nz, w4);
relerr = VABS( rho - oldrho ) / VABS( rho );
// I/O
if (*iinfo > 3) {
Vnm_print(2, "Vmpower: iter=%d; error=%f; relerr=%f; estimate=%f",
*iters, error, relerr, rho);
}
if ((relerr < *tol) || (*iters == *itmax)) {
break;
}
oldrho = rho;
}
}
*eigmax = rho;
}
VPUBLIC void Vipower(int *nx,int *ny,int *nz,
double *u, int *iz,
double *w0, double *w1, double *w2, double *w3, double *w4,
double *eigmin, double *eigmin_model, double *tol,
int *itmax, int *iters,
int *nlev, int *ilev, int *nlev_real, int *mgsolv,
int *iok, int *iinfo, double *epsiln, double *errtol, double *omega,
int *nu1, int *nu2, int *mgsmoo,
int *ipc, double *rpc,
double *pc, double *ac, double *cc, double *tru) {
int level, lev;
double denom, fac, rho, oldrho;
double error, relerr, errtol_s;
int itmax_s, iters_s, ierror_s, iok_s, iinfo_s, istop_s;
int nu1_s, nu2_s, mgsmoo_s;
/// @todo Just use a constant definition of PI here
double pi = 4.0 * atan( 1.0 );
// Utility variables
double alpha;
MAT2(iz, 50, 1);
WARN_UNTESTED;
// Recover level information
level = 1;
lev = (*ilev - 1) + level;
// Seed vector: random to contain all components
Vaxrand(nx, ny, nz, w1);
Vazeros(nx, ny, nz, w2);
Vazeros(nx, ny, nz, w3);
Vazeros(nx, ny, nz, w4);
Vazeros(nx, ny, nz, RAT(w0, VAT2(iz, 1, lev)));
Vazeros(nx, ny, nz, RAT( u, VAT2(iz, 1, lev)));
// Compute raleigh quotient with the seed vector ***
denom = Vxnrm2(nx, ny, nz, w1);
fac = 1.0 / denom;
Vxscal(nx, ny, nz, &fac, w1);
Vmatvec(nx, ny, nz,
RAT(ipc, VAT2(iz, 5, lev)), RAT(rpc, VAT2(iz, 6, lev)),
RAT( ac, VAT2(iz, 7, lev)), RAT( cc, VAT2(iz, 1, lev)), w1, w2);
oldrho = Vxdot(nx, ny, nz, w1, w2);
// I/O
if (oldrho == 0.0) {
if (*iinfo > 3) {
Vnm_print(2, "Vipower: iters=%d\n", *iters);
Vnm_print(2, " estimate=%f\n", oldrho);
}
rho = oldrho;
} else {
//main iteration
*iters = 0;
while (1) {
(*iters)++;
// Apply the matrix A^{-1} (using MG solver)
itmax_s = 100;
iters_s = 0;
ierror_s = 0;
iok_s = 0;
iinfo_s = 0;
istop_s = 0;
mgsmoo_s = 1;
nu1_s = 1;
nu2_s = 1;
errtol_s = *epsiln;
Vxcopy(nx, ny, nz, w1, RAT(w0, VAT2(iz, 1,lev)));
Vmvcs(nx, ny, nz, u, iz,
w1, w2, w3, w4,
&istop_s, &itmax_s, &iters_s, &ierror_s,
nlev, ilev, nlev_real, mgsolv,
&iok_s, &iinfo_s, epsiln,
&errtol_s, omega, &nu1_s, &nu2_s, &mgsmoo_s,
ipc, rpc, pc, ac, cc, w0, tru);
Vxcopy(nx, ny, nz, RAT(u, VAT2(iz, 1, lev)), w1);
// Normalize the new vector
denom = Vxnrm2(nx, ny, nz, w1);
fac = 1.0 / denom;
Vxscal(nx, ny, nz, &fac, w1);
// Compute the new raleigh quotient
Vmatvec(nx, ny, nz,
RAT(ipc, VAT2(iz, 5, lev)), RAT(rpc, VAT2(iz, 6, lev)),
RAT(ac, VAT2(iz, 7,lev)), RAT(cc, VAT2(iz, 1, lev)), w1, w2);
rho = Vxdot(nx, ny, nz, w1, w2);
// Stopping test
// w2=A*x, w1=x, stop = 2-norm(A*x-lamda*x) ***
Vxcopy(nx, ny, nz, w1, w3);
Vxcopy(nx, ny, nz, w2, w4);
Vxscal(nx, ny, nz, &rho, w3);
alpha = -1.0;
Vxaxpy(nx, ny, nz, &alpha, w3, w4);
error = Vxnrm2(nx, ny, nz, w4);
relerr = VABS(rho - oldrho ) / VABS( rho );
// I/O
if (*iinfo > 3) {
Vnm_print(2, "POWER: iters =%d\n", *iters);
Vnm_print(2, " error =%g\n", error);
Vnm_print(2, " relerr =%g\n", relerr);
Vnm_print(2, " rho =%g\n", rho);
}
if (relerr < *tol || *iters == *itmax)
break;
oldrho = rho;
}
}
// Return some stuff
*eigmin = rho;
fac = VPOW(2.0, *ilev - 1);
*eigmin_model = fac * (6.0 - 2.0 * VCOS(pi / (*nx - 1))
- 2.0 * VCOS(pi / (*ny - 1))
- 2.0 * VCOS(pi / (*nz - 1)));
}