/*
* idaLapackBandSolve handles the solve operation for the band linear solver
* by calling the band backsolve routine.
*/
static int idaLapackBandSolve(IDAMem IDA_mem, N_Vector b, N_Vector weight,
N_Vector yC, N_Vector ypC, N_Vector fctC)
{
IDADlsMem idadls_mem;
realtype *bd, fact;
int ier, one = 1;
int intn, iml, imu, ldmat;
idadls_mem = (IDADlsMem) lmem;
intn = (int) n;
iml = (int) ml;
imu = (int) mu;
ldmat = JJ->ldim;
bd = N_VGetArrayPointer(b);
dgbtrs_f77("N", &intn, &iml, &imu, &one, JJ->data, &ldmat, pivots, bd, &intn, &ier, 1);
if (ier > 0) return(1);
/* For BDF, scale the correction to account for change in cj */
if (cjratio != ONE) {
fact = TWO/(ONE + cjratio);
dscal_f77(&intn, &fact, bd, &one);
}
last_flag = IDADLS_SUCCESS;
return(0);
}
/*
* cvLapackBandSolve handles the solve operation for the band linear solver
* by calling the band backsolve routine.
*/
static int cvLapackBandSolve(CVodeMem cv_mem, N_Vector b, N_Vector weight,
N_Vector yC, N_Vector fctC)
{
CVDlsMem cvdls_mem;
realtype *bd, fact;
int ier, one = 1;
int intn, iml, imu, ldmat;
cvdls_mem = (CVDlsMem) lmem;
intn = (int) n;
iml = (int) ml;
imu = (int) mu;
ldmat = M->ldim;
bd = N_VGetArrayPointer(b);
dgbtrs_f77("N", &intn, &iml, &imu, &one, M->data, &ldmat, pivots, bd, &intn, &ier, 1);
if (ier > 0) return(1);
/* For BDF, scale the correction to account for change in gamma */
if ((lmm == CV_BDF) && (gamrat != ONE)) {
fact = TWO/(ONE + gamrat);
dscal_f77(&intn, &fact, bd, &one);
}
last_flag = CVDLS_SUCCESS;
return(0);
}
static int kinLapackBandSolve(KINMem kin_mem, N_Vector x, N_Vector b, realtype *res_norm)
{
KINDlsMem kindls_mem;
realtype *xd;
int ier, one = 1;
kindls_mem = (KINDlsMem) lmem;
/* Copy the right-hand side into x */
N_VScale(ONE, b, x);
xd = N_VGetArrayPointer(x);
/* Back-solve and get solution in x */
dgbtrs_f77("N", &n, &ml, &mu, &one, J->data, &(J->ldim), pivots, xd, &n, &ier, 1);
if (ier > 0) return(-1);
/* Compute the terms Jpnorm and sfdotJp for use in the global strategy
* routines and in KINForcingTerm. Both of these terms are subsequently
* corrected if the step is reduced by constraints or the line search.
*
* sJpnorm is the norm of the scaled product (scaled by fscale) of
* the current Jacobian matrix J and the step vector p.
*
* sfdotJp is the dot product of the scaled f vector and the scaled
* vector J*p, where the scaling uses fscale.
*/
sJpnorm = N_VWL2Norm(b,fscale);
N_VProd(b, fscale, b);
N_VProd(b, fscale, b);
sfdotJp = N_VDotProd(fval, b);
last_flag = KINDLS_SUCCESS;
return(0);
}
/*---------------------------------------------------------------
arkLapackBandSolve handles the solve operation for the band
linear solver by calling the band backsolve routine.
---------------------------------------------------------------*/
static int arkLapackBandSolve(ARKodeMem ark_mem, N_Vector b,
N_Vector weight, N_Vector yC,
N_Vector fctC)
{
ARKDlsMem arkdls_mem;
realtype *bd, fact;
int ier, one = 1;
int intn, iml, imu, ldmat;
arkdls_mem = (ARKDlsMem) ark_mem->ark_lmem;
intn = (int) arkdls_mem->d_n;
iml = (int) arkdls_mem->d_ml;
imu = (int) arkdls_mem->d_mu;
ldmat = arkdls_mem->d_M->ldim;
bd = N_VGetArrayPointer(b);
dgbtrs_f77("N", &intn, &iml, &imu, &one, arkdls_mem->d_M->data,
&ldmat, arkdls_mem->d_pivots, bd, &intn, &ier, 1);
if (ier > 0) return(1);
/* scale the correction to account for change in gamma */
if (ark_mem->ark_gamrat != ONE) {
fact = TWO/(ONE + ark_mem->ark_gamrat);
dscal_f77(&intn, &fact, bd, &one);
}
arkdls_mem->d_last_flag = ARKDLS_SUCCESS;
return(0);
}
/*---------------------------------------------------------------
arkMassLapackBandSolve handles the solve operation for the band
mass matrix solver by calling the band backsolve routine.
---------------------------------------------------------------*/
static int arkMassLapackBandSolve(ARKodeMem ark_mem, N_Vector b,
N_Vector weight)
{
ARKDlsMassMem arkdls_mem;
realtype *bd;
int ier, one = 1;
int intn, iml, imu, ldmat;
arkdls_mem = (ARKDlsMassMem) ark_mem->ark_mass_mem;
intn = (int) arkdls_mem->d_n;
iml = (int) arkdls_mem->d_ml;
imu = (int) arkdls_mem->d_mu;
ldmat = arkdls_mem->d_M->ldim;
bd = N_VGetArrayPointer(b);
dgbtrs_f77("N", &intn, &iml, &imu, &one, arkdls_mem->d_M->data,
&ldmat, arkdls_mem->d_pivots, bd, &intn, &ier, 1);
if (ier > 0) return(1);
arkdls_mem->d_last_flag = ARKDLS_SUCCESS;
return(0);
}
/*
* cpLapackBandSolve handles the solve operation for the band linear solver
* by calling the band backsolve routine.
*/
static int cpLapackBandSolve(CPodeMem cp_mem, N_Vector b, N_Vector weight,
N_Vector yC, N_Vector ypC, N_Vector fctC)
{
CPDlsMem cpdls_mem;
realtype *bd, fact;
int ier, one = 1;
cpdls_mem = (CPDlsMem) lmem;
bd = N_VGetArrayPointer(b);
dgbtrs_f77("N", &n, &ml, &mu, &one, M->data, &(M->ldim), pivots, bd, &n, &ier, 1);
if (ier > 0) return(1);
/* For BDF, scale the correction to account for change in gamma */
if ((lmm_type == CP_BDF) && (gamrat != ONE)) {
fact = TWO/(ONE + gamrat);
dscal_f77(&n, &fact, bd, &one);
}
last_flag = CPDIRECT_SUCCESS;
return(0);
}
