/*
* idaLapackDenseSolve handles the solve operation for the dense linear solver
* by calling the dense backsolve routine.
*/
static int idaLapackDenseSolve(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;
idadls_mem = (IDADlsMem) lmem;
intn = (int) n;
bd = N_VGetArrayPointer(b);
dgetrs_f77("N", &intn, &one, JJ->data, &intn, pivots, bd, &intn, &ier, 1);
if (ier > 0) return(1);
/* 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);
}
/*
* cvLapackDenseSolve handles the solve operation for the dense linear solver
* by calling the dense backsolve routine.
*/
static int cvLapackDenseSolve(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;
cvdls_mem = (CVDlsMem) lmem;
intn = (int) n;
bd = N_VGetArrayPointer(b);
dgetrs_f77("N", &intn, &one, M->data, &intn, 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 kinLapackDenseSolve(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 */
dgetrs_f77("N", &n, &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);
}
/*---------------------------------------------------------------
arkLapackDenseSolve handles the solve operation for the dense
linear solver by calling the dense backsolve routine.
---------------------------------------------------------------*/
static int arkLapackDenseSolve(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;
arkdls_mem = (ARKDlsMem) ark_mem->ark_lmem;
intn = (int) arkdls_mem->d_n;
bd = N_VGetArrayPointer(b);
dgetrs_f77("N", &intn, &one, arkdls_mem->d_M->data, &intn,
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);
}
/*---------------------------------------------------------------
arkMassLapackDenseSolve handles the solve operation for the
dense mass matrix solver by calling the dense backsolve routine.
---------------------------------------------------------------*/
static int arkMassLapackDenseSolve(ARKodeMem ark_mem, N_Vector b,
N_Vector weight)
{
ARKDlsMassMem arkdls_mem;
realtype *bd;
int ier, one = 1;
int intn;
arkdls_mem = (ARKDlsMassMem) ark_mem->ark_mass_mem;
intn = (int) arkdls_mem->d_n;
bd = N_VGetArrayPointer(b);
dgetrs_f77("N", &intn, &one, arkdls_mem->d_M->data, &intn,
arkdls_mem->d_pivots, bd, &intn, &ier, 1);
if (ier > 0) return(1);
arkdls_mem->d_last_flag = ARKDLS_SUCCESS;
return(0);
}
/*
* cpLapackDenseSolve handles the solve operation for the dense linear solver
* by calling the dense backsolve routine.
*/
static int cpLapackDenseSolve(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);
dgetrs_f77("N", &n, &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);
}
