int SUNLinSolSolve_LapackDense(SUNLinearSolver S, SUNMatrix A, N_Vector x,
N_Vector b, realtype tol)
{
int n, one, ier;
realtype *xdata;
if ( (A == NULL) || (S == NULL) || (x == NULL) || (b == NULL) )
return(SUNLS_MEM_NULL);
/* copy b into x */
N_VScale(ONE, b, x);
/* access x data array */
xdata = N_VGetArrayPointer(x);
if (xdata == NULL) {
LASTFLAG(S) = SUNLS_MEM_FAIL;
return(LASTFLAG(S));
}
/* Call LAPACK to solve the linear system */
n = SUNDenseMatrix_Rows(A);
one = 1;
xgetrs_f77("N", &n, &one, SUNDenseMatrix_Data(A),
&n, PIVOTS(S), xdata, &n, &ier, 1);
LASTFLAG(S) = (long int) ier;
if (ier < 0)
return(SUNLS_PACKAGE_FAIL_UNREC);
LASTFLAG(S) = SUNLS_SUCCESS;
return(LASTFLAG(S));
}
int SUNLinSolSetup_SPBCGS(SUNLinearSolver S, SUNMatrix A)
{
int ier;
PSetupFn Psetup;
void* PData;
/* Set shortcuts to SPBCGS memory structures */
if (S == NULL) return(SUNLS_MEM_NULL);
Psetup = SPBCGS_CONTENT(S)->Psetup;
PData = SPBCGS_CONTENT(S)->PData;
/* no solver-specific setup is required, but if user-supplied
Psetup routine exists, call that here */
if (Psetup != NULL) {
ier = Psetup(PData);
if (ier != 0) {
LASTFLAG(S) = (ier < 0) ?
SUNLS_PSET_FAIL_UNREC : SUNLS_PSET_FAIL_REC;
return(LASTFLAG(S));
}
}
/* return with success */
LASTFLAG(S) = SUNLS_SUCCESS;
return(LASTFLAG(S));
}
int SUNLinSolSetScalingVectors_PCG(SUNLinearSolver S, N_Vector s,
N_Vector nul)
{
/* set N_Vector pointer to integrator-supplied scaling vector
(only use the first one), and return with success */
if (S == NULL) return(SUNLS_MEM_NULL);
PCG_CONTENT(S)->s = s;
LASTFLAG(S) = SUNLS_SUCCESS;
return(LASTFLAG(S));
}
int SUNLinSolSetScalingVectors_SPBCGS(SUNLinearSolver S, N_Vector s1,
N_Vector s2)
{
/* set N_Vector pointers to integrator-supplied scaling vectors,
and return with success */
if (S == NULL) return(SUNLS_MEM_NULL);
SPBCGS_CONTENT(S)->s1 = s1;
SPBCGS_CONTENT(S)->s2 = s2;
LASTFLAG(S) = SUNLS_SUCCESS;
return(LASTFLAG(S));
}
int SUNLinSolSetATimes_SPBCGS(SUNLinearSolver S, void* ATData,
ATimesFn ATimes)
{
/* set function pointers to integrator-supplied ATimes routine
and data, and return with success */
if (S == NULL) return(SUNLS_MEM_NULL);
SPBCGS_CONTENT(S)->ATimes = ATimes;
SPBCGS_CONTENT(S)->ATData = ATData;
LASTFLAG(S) = SUNLS_SUCCESS;
return(LASTFLAG(S));
}
int SUNLinSolSetPreconditioner_SPBCGS(SUNLinearSolver S, void* PData,
PSetupFn Psetup, PSolveFn Psolve)
{
/* set function pointers to integrator-supplied Psetup and PSolve
routines and data, and return with success */
if (S == NULL) return(SUNLS_MEM_NULL);
SPBCGS_CONTENT(S)->Psetup = Psetup;
SPBCGS_CONTENT(S)->Psolve = Psolve;
SPBCGS_CONTENT(S)->PData = PData;
LASTFLAG(S) = SUNLS_SUCCESS;
return(LASTFLAG(S));
}
int SUNLinSolInitialize_SPBCGS(SUNLinearSolver S)
{
/* ensure valid options */
if (S == NULL) return(SUNLS_MEM_NULL);
if ( (PRETYPE(S) != PREC_LEFT) &&
(PRETYPE(S) != PREC_RIGHT) &&
(PRETYPE(S) != PREC_BOTH) )
PRETYPE(S) = PREC_NONE;
if (SPBCGS_CONTENT(S)->maxl <= 0)
SPBCGS_CONTENT(S)->maxl = SUNSPBCGS_MAXL_DEFAULT;
/* no additional memory to allocate */
/* return with success */
LASTFLAG(S) = SUNLS_SUCCESS;
return(LASTFLAG(S));
}
int SUNLinSolSetup_LapackDense(SUNLinearSolver S, SUNMatrix A)
{
int n, ier;
/* check for valid inputs */
if ( (A == NULL) || (S == NULL) )
return(SUNLS_MEM_NULL);
/* Ensure that A is a dense matrix */
if (SUNMatGetID(A) != SUNMATRIX_DENSE) {
LASTFLAG(S) = SUNLS_ILL_INPUT;
return(LASTFLAG(S));
}
/* Call LAPACK to do LU factorization of A */
n = SUNDenseMatrix_Rows(A);
xgetrf_f77(&n, &n, SUNDenseMatrix_Data(A), &n, PIVOTS(S), &ier);
LASTFLAG(S) = (long int) ier;
if (ier > 0)
return(SUNLS_LUFACT_FAIL);
if (ier < 0)
return(SUNLS_PACKAGE_FAIL_UNREC);
return(SUNLS_SUCCESS);
}
long int SUNLinSolLastFlag_SPBCGS(SUNLinearSolver S)
{
/* return the stored 'last_flag' value */
if (S == NULL) return(-1);
return (LASTFLAG(S));
}
int SUNLinSolSolve_SPBCGS(SUNLinearSolver S, SUNMatrix A, N_Vector x,
N_Vector b, realtype delta)
{
/* local data and shortcut variables */
realtype alpha, beta, omega, omega_denom, beta_num, beta_denom, r_norm, rho;
N_Vector r_star, r, p, q, u, Ap, vtemp;
booleantype preOnLeft, preOnRight, scale_x, scale_b, converged;
int l, l_max, ier;
void *A_data, *P_data;
N_Vector sx, sb;
ATimesFn atimes;
PSolveFn psolve;
realtype *res_norm;
int *nli;
/* local variables for fused vector operations */
realtype cv[3];
N_Vector Xv[3];
/* Make local shorcuts to solver variables. */
if (S == NULL) return(SUNLS_MEM_NULL);
l_max = SPBCGS_CONTENT(S)->maxl;
r_star = SPBCGS_CONTENT(S)->r_star;
r = SPBCGS_CONTENT(S)->r;
p = SPBCGS_CONTENT(S)->p;
q = SPBCGS_CONTENT(S)->q;
u = SPBCGS_CONTENT(S)->u;
Ap = SPBCGS_CONTENT(S)->Ap;
vtemp = SPBCGS_CONTENT(S)->vtemp;
sb = SPBCGS_CONTENT(S)->s1;
sx = SPBCGS_CONTENT(S)->s2;
A_data = SPBCGS_CONTENT(S)->ATData;
P_data = SPBCGS_CONTENT(S)->PData;
atimes = SPBCGS_CONTENT(S)->ATimes;
psolve = SPBCGS_CONTENT(S)->Psolve;
nli = &(SPBCGS_CONTENT(S)->numiters);
res_norm = &(SPBCGS_CONTENT(S)->resnorm);
/* Initialize counters and convergence flag */
*nli = 0;
converged = SUNFALSE;
/* set booleantype flags for internal solver options */
preOnLeft = ( (PRETYPE(S) == PREC_LEFT) ||
(PRETYPE(S) == PREC_BOTH) );
preOnRight = ( (PRETYPE(S) == PREC_RIGHT) ||
(PRETYPE(S) == PREC_BOTH) );
scale_x = (sx != NULL);
scale_b = (sb != NULL);
/* Set r_star to initial (unscaled) residual r_0 = b - A*x_0 */
if (N_VDotProd(x, x) == ZERO) N_VScale(ONE, b, r_star);
else {
ier = atimes(A_data, x, r_star);
if (ier != 0) {
LASTFLAG(S) = (ier < 0) ?
SUNLS_ATIMES_FAIL_UNREC : SUNLS_ATIMES_FAIL_REC;
return(LASTFLAG(S));
}
N_VLinearSum(ONE, b, -ONE, r_star, r_star);
}
/* Apply left preconditioner and b-scaling to r_star = r_0 */
if (preOnLeft) {
ier = psolve(P_data, r_star, r, delta, PREC_LEFT);
if (ier != 0) {
LASTFLAG(S) = (ier < 0) ?
SUNLS_PSOLVE_FAIL_UNREC : SUNLS_PSOLVE_FAIL_REC;
return(LASTFLAG(S));
}
}
else N_VScale(ONE, r_star, r);
if (scale_b) N_VProd(sb, r, r_star);
else N_VScale(ONE, r, r_star);
/* Initialize beta_denom to the dot product of r0 with r0 */
beta_denom = N_VDotProd(r_star, r_star);
/* Set r_norm to L2 norm of r_star = sb P1_inv r_0, and
return if small */
*res_norm = r_norm = rho = SUNRsqrt(beta_denom);
if (r_norm <= delta) {
LASTFLAG(S) = SUNLS_SUCCESS;
return(LASTFLAG(S));
}
/* Copy r_star to r and p */
N_VScale(ONE, r_star, r);
N_VScale(ONE, r_star, p);
/* Begin main iteration loop */
for(l = 0; l < l_max; l++) {
(*nli)++;
/* Generate Ap = A-tilde p, where A-tilde = sb P1_inv A P2_inv sx_inv */
/* Apply x-scaling: vtemp = sx_inv p */
if (scale_x) N_VDiv(p, sx, vtemp);
else N_VScale(ONE, p, vtemp);
/* Apply right preconditioner: vtemp = P2_inv sx_inv p */
if (preOnRight) {
N_VScale(ONE, vtemp, Ap);
ier = psolve(P_data, Ap, vtemp, delta, PREC_RIGHT);
if (ier != 0) {
LASTFLAG(S) = (ier < 0) ?
SUNLS_PSOLVE_FAIL_UNREC : SUNLS_PSOLVE_FAIL_REC;
return(LASTFLAG(S));
}
}
/* Apply A: Ap = A P2_inv sx_inv p */
ier = atimes(A_data, vtemp, Ap );
if (ier != 0) {
LASTFLAG(S) = (ier < 0) ?
SUNLS_ATIMES_FAIL_UNREC : SUNLS_ATIMES_FAIL_REC;
return(LASTFLAG(S));
}
/* Apply left preconditioner: vtemp = P1_inv A P2_inv sx_inv p */
if (preOnLeft) {
ier = psolve(P_data, Ap, vtemp, delta, PREC_LEFT);
if (ier != 0) {
LASTFLAG(S) = (ier < 0) ?
SUNLS_PSOLVE_FAIL_UNREC : SUNLS_PSOLVE_FAIL_REC;
return(LASTFLAG(S));
}
}
else N_VScale(ONE, Ap, vtemp);
/* Apply b-scaling: Ap = sb P1_inv A P2_inv sx_inv p */
if (scale_b) N_VProd(sb, vtemp, Ap);
else N_VScale(ONE, vtemp, Ap);
/* Calculate alpha = <r,r_star>/<Ap,r_star> */
alpha = ((beta_denom / N_VDotProd(Ap, r_star)));
/* Update q = r - alpha*Ap = r - alpha*(sb P1_inv A P2_inv sx_inv p) */
N_VLinearSum(ONE, r, -alpha, Ap, q);
/* Generate u = A-tilde q */
/* Apply x-scaling: vtemp = sx_inv q */
if (scale_x) N_VDiv(q, sx, vtemp);
else N_VScale(ONE, q, vtemp);
/* Apply right preconditioner: vtemp = P2_inv sx_inv q */
if (preOnRight) {
N_VScale(ONE, vtemp, u);
ier = psolve(P_data, u, vtemp, delta, PREC_RIGHT);
if (ier != 0) {
LASTFLAG(S) = (ier < 0) ?
SUNLS_PSOLVE_FAIL_UNREC : SUNLS_PSOLVE_FAIL_REC;
return(LASTFLAG(S));
}
}
/* Apply A: u = A P2_inv sx_inv u */
ier = atimes(A_data, vtemp, u );
if (ier != 0) {
LASTFLAG(S) = (ier < 0) ?
SUNLS_ATIMES_FAIL_UNREC : SUNLS_ATIMES_FAIL_REC;
return(LASTFLAG(S));
}
/* Apply left preconditioner: vtemp = P1_inv A P2_inv sx_inv p */
if (preOnLeft) {
ier = psolve(P_data, u, vtemp, delta, PREC_LEFT);
if (ier != 0) {
LASTFLAG(S) = (ier < 0) ?
SUNLS_PSOLVE_FAIL_UNREC : SUNLS_PSOLVE_FAIL_REC;
return(LASTFLAG(S));
}
}
else N_VScale(ONE, u, vtemp);
/* Apply b-scaling: u = sb P1_inv A P2_inv sx_inv u */
if (scale_b) N_VProd(sb, vtemp, u);
else N_VScale(ONE, vtemp, u);
/* Calculate omega = <u,q>/<u,u> */
omega_denom = N_VDotProd(u, u);
if (omega_denom == ZERO) omega_denom = ONE;
omega = (N_VDotProd(u, q) / omega_denom);
/* Update x = x + alpha*p + omega*q */
cv[0] = ONE;
Xv[0] = x;
cv[1] = alpha;
Xv[1] = p;
cv[2] = omega;
Xv[2] = q;
ier = N_VLinearCombination(3, cv, Xv, x);
if (ier != SUNLS_SUCCESS) return(SUNLS_VECTOROP_ERR);
/* Update the residual r = q - omega*u */
N_VLinearSum(ONE, q, -omega, u, r);
/* Set rho = norm(r) and check convergence */
*res_norm = rho = SUNRsqrt(N_VDotProd(r, r));
if (rho <= delta) {
converged = SUNTRUE;
break;
}
/* Not yet converged, continue iteration */
/* Update beta = <rnew,r_star> / <rold,r_start> * alpha / omega */
beta_num = N_VDotProd(r, r_star);
beta = ((beta_num / beta_denom) * (alpha / omega));
/* Update p = r + beta*(p - omega*Ap) = beta*p - beta*omega*Ap + r */
cv[0] = beta;
Xv[0] = p;
cv[1] = -alpha*(beta_num / beta_denom);
Xv[1] = Ap;
cv[2] = ONE;
Xv[2] = r;
ier = N_VLinearCombination(3, cv, Xv, p);
if (ier != SUNLS_SUCCESS) return(SUNLS_VECTOROP_ERR);
/* udpate beta_denom for next iteration */
beta_denom = beta_num;
}
/* Main loop finished */
if ((converged == SUNTRUE) || (rho < r_norm)) {
/* Apply the x-scaling and right preconditioner: x = P2_inv sx_inv x */
if (scale_x) N_VDiv(x, sx, x);
if (preOnRight) {
ier = psolve(P_data, x, vtemp, delta, PREC_RIGHT);
if (ier != 0) {
LASTFLAG(S) = (ier < 0) ?
SUNLS_PSOLVE_FAIL_UNREC : SUNLS_PSOLVE_FAIL_REC;
return(LASTFLAG(S));
}
N_VScale(ONE, vtemp, x);
}
if (converged == SUNTRUE)
LASTFLAG(S) = SUNLS_SUCCESS;
else
LASTFLAG(S) = SUNLS_RES_REDUCED;
return(LASTFLAG(S));
}
else {
LASTFLAG(S) = SUNLS_CONV_FAIL;
return(LASTFLAG(S));
}
}
int SUNLinSolSolve_PCG(SUNLinearSolver S, SUNMatrix nul, N_Vector x,
N_Vector b, realtype delta)
{
/* local data and shortcut variables */
realtype alpha, beta, r0_norm, rho, rz, rz_old;
N_Vector r, p, z, Ap, w;
booleantype UsePrec, UseScaling, converged;
int l, l_max, pretype, ier;
void *A_data, *P_data;
ATimesFn atimes;
PSolveFn psolve;
realtype *res_norm;
int *nli;
/* Make local shorcuts to solver variables. */
if (S == NULL) return(SUNLS_MEM_NULL);
l_max = PCG_CONTENT(S)->maxl;
r = PCG_CONTENT(S)->r;
p = PCG_CONTENT(S)->p;
z = PCG_CONTENT(S)->z;
Ap = PCG_CONTENT(S)->Ap;
w = PCG_CONTENT(S)->s;
A_data = PCG_CONTENT(S)->ATData;
P_data = PCG_CONTENT(S)->PData;
atimes = PCG_CONTENT(S)->ATimes;
psolve = PCG_CONTENT(S)->Psolve;
pretype = PCG_CONTENT(S)->pretype;
nli = &(PCG_CONTENT(S)->numiters);
res_norm = &(PCG_CONTENT(S)->resnorm);
/* Initialize counters and convergence flag */
*nli = 0;
converged = SUNFALSE;
/* set booleantype flags for internal solver options */
UsePrec = ( (pretype == PREC_BOTH) ||
(pretype == PREC_LEFT) ||
(pretype == PREC_RIGHT) );
UseScaling = (w != NULL);
/* Set r to initial residual r_0 = b - A*x_0 */
if (N_VDotProd(x, x) == ZERO) N_VScale(ONE, b, r);
else {
ier = atimes(A_data, x, r);
if (ier != 0) {
LASTFLAG(S) = (ier < 0) ?
SUNLS_ATIMES_FAIL_UNREC : SUNLS_ATIMES_FAIL_REC;
return(LASTFLAG(S));
}
N_VLinearSum(ONE, b, -ONE, r, r);
}
/* Set rho to scaled L2 norm of r, and return if small */
if (UseScaling) N_VProd(r, w, Ap);
else N_VScale(ONE, r, Ap);
*res_norm = r0_norm = rho = SUNRsqrt(N_VDotProd(Ap, Ap));
if (rho <= delta) {
LASTFLAG(S) = SUNLS_SUCCESS;
return(LASTFLAG(S));
}
/* Apply preconditioner and b-scaling to r = r_0 */
if (UsePrec) {
ier = psolve(P_data, r, z, delta, PREC_LEFT); /* z = P^{-1}r */
if (ier != 0) {
LASTFLAG(S) = (ier < 0) ?
SUNLS_PSOLVE_FAIL_UNREC : SUNLS_PSOLVE_FAIL_REC;
return(LASTFLAG(S));
}
}
else N_VScale(ONE, r, z);
/* Initialize rz to <r,z> */
rz = N_VDotProd(r, z);
/* Copy z to p */
N_VScale(ONE, z, p);
/* Begin main iteration loop */
for(l=0; l<l_max; l++) {
/* increment counter */
(*nli)++;
/* Generate Ap = A*p */
ier = atimes(A_data, p, Ap);
if (ier != 0) {
LASTFLAG(S) = (ier < 0) ?
SUNLS_ATIMES_FAIL_UNREC : SUNLS_ATIMES_FAIL_REC;
return(LASTFLAG(S));
}
/* Calculate alpha = <r,z> / <Ap,p> */
alpha = rz / N_VDotProd(Ap, p);
/* Update x = x + alpha*p */
N_VLinearSum(ONE, x, alpha, p, x);
/* Update r = r - alpha*Ap */
N_VLinearSum(ONE, r, -alpha, Ap, r);
/* Set rho and check convergence */
if (UseScaling) N_VProd(r, w, Ap);
else N_VScale(ONE, r, Ap);
*res_norm = rho = SUNRsqrt(N_VDotProd(Ap, Ap));
if (rho <= delta) {
converged = SUNTRUE;
break;
}
/* Apply preconditioner: z = P^{-1}*r */
if (UsePrec) {
ier = psolve(P_data, r, z, delta, PREC_LEFT);
if (ier != 0) {
LASTFLAG(S) = (ier < 0) ?
SUNLS_PSOLVE_FAIL_UNREC : SUNLS_PSOLVE_FAIL_REC;
return(LASTFLAG(S));
}
}
else N_VScale(ONE, r, z);
/* update rz */
rz_old = rz;
rz = N_VDotProd(r, z);
/* Calculate beta = <r,z> / <r_old,z_old> */
beta = rz / rz_old;
/* Update p = z + beta*p */
N_VLinearSum(ONE, z, beta, p, p);
}
/* Main loop finished, return with result */
if (converged == SUNTRUE) {
LASTFLAG(S) = SUNLS_SUCCESS;
} else if (rho < r0_norm) {
LASTFLAG(S) = SUNLS_RES_REDUCED;
} else {
LASTFLAG(S) = SUNLS_CONV_FAIL;
}
return(LASTFLAG(S));
}
long int SUNLinSolLastFlag_LapackDense(SUNLinearSolver S)
{
/* return the stored 'last_flag' value */
return(LASTFLAG(S));
}
int SUNLinSolInitialize_LapackDense(SUNLinearSolver S)
{
/* all solver-specific memory has already been allocated */
LASTFLAG(S) = SUNLS_SUCCESS;
return(LASTFLAG(S));
}
