static int cpBBDPrecSetupImpl(realtype t, N_Vector y, N_Vector yp, N_Vector r, realtype gamma, void *bbd_data, N_Vector tmp1, N_Vector tmp2, N_Vector tmp3) { int ier, retval; CPBBDPrecData pdata; CPodeMem cp_mem; pdata =(CPBBDPrecData) bbd_data; cp_mem = (CPodeMem) pdata->cpode_mem; /* Call cpBBDDQJacImpl for a new Jacobian calculation and store in savedP. */ BandZero(savedP); retval = cpBBDDQJacImpl(pdata, t, gamma, y, yp, tmp1, tmp2, tmp3, pdata->tmp4); if (retval < 0) { cpProcessError(cp_mem, CPBBDPRE_FUNC_UNRECVR, "CPBBDPRE", "cpBBDPrecSetupImpl", MSGBBDP_FUNC_FAILED); return(-1); } if (retval > 0) { return(+1); } /* Do LU factorization of preconditioner block in place (in savedP). */ ier = BandGBTRF(savedP, pivots); /* Return 0 if the LU was complete, or +1 otherwise. */ if (ier > 0) return(+1); return(0); }
static int KINBBDPrecSetup(N_Vector uu, N_Vector uscale, N_Vector fval, N_Vector fscale, void *bbd_data, N_Vector vtemp1, N_Vector vtemp2) { KBBDPrecData pdata; KINMem kin_mem; int retval; long int ier; pdata = (KBBDPrecData) bbd_data; kin_mem = (KINMem) pdata->kin_mem; /* call KBBDDQJac for a new jacobian and store in PP */ SetToZero(PP); retval = KBBDDQJac(pdata, uu, uscale, vtemp1, vtemp2, vtemp3); if (retval != 0) { KINProcessError(kin_mem, -1, "KINBBDPRE", "KINBBDPrecSetup", MSGBBD_FUNC_FAILED); return(-1); } nge += (1 + SUNMIN(mldq+mudq+1, Nlocal)); /* do LU factorization of P in place (in PP) */ ier = BandGBTRF(PP, lpivots); /* return 0 if the LU was complete, else return 1 */ if (ier > 0) return(1); else return(0); }
static int kinBandSetup(KINMem kin_mem) { KINDlsMem kindls_mem; int retval; long int ier; kindls_mem = (KINDlsMem) lmem; nje++; SetToZero(J); retval = bjac(n, mu, ml, uu, fval, J, J_data, vtemp1, vtemp2); if (retval != 0) { last_flag = -1; return(-1); } /* Do LU factorization of J */ ier = BandGBTRF(J, lpivots); /* Return 0 if the LU was complete; otherwise return -1 */ last_flag = ier; if (ier > 0) return(-1); return(0); }
int IDABBDPrecSetup(realtype tt, N_Vector yy, N_Vector yp, N_Vector rr, realtype c_j, void *prec_data, N_Vector tempv1, N_Vector tempv2, N_Vector tempv3) { long int retfac; int retval; IBBDPrecData pdata; IDAMem IDA_mem; pdata =(IBBDPrecData) prec_data; IDA_mem = (IDAMem) pdata->ida_mem; /* Call IBBDDQJac for a new Jacobian calculation and store in PP. */ BandZero(PP); retval = IBBDDQJac(pdata, tt, c_j, yy, yp, tempv1, tempv2, tempv3, pdata->tempv4); if (retval < 0) { IDAProcessError(IDA_mem, IDABBDPRE_FUNC_UNRECVR, "IDABBDPRE", "IDABBDPrecSetup", MSGBBD_FUNC_FAILED); return(-1); } if (retval > 0) { return(+1); } /* Do LU factorization of preconditioner block in place (in PP). */ retfac = BandGBTRF(PP, pivots); /* Return 0 if the LU was complete, or +1 otherwise. */ if (retfac > 0) return(+1); return(0); }
/*--------------------------------------------------------------- ARKBandPrecSetup: Together ARKBandPrecSetup and ARKBandPrecSolve use a banded difference quotient Jacobian to create a preconditioner. ARKBandPrecSetup calculates a new J, if necessary, then calculates P = I - gamma*J, and does an LU factorization of P. The parameters of ARKBandPrecSetup are as follows: t is the current value of the independent variable. y is the current value of the dependent variable vector, namely the predicted value of y(t). fy is the vector f(t,y). jok is an input flag indicating whether Jacobian-related data needs to be recomputed, as follows: jok == FALSE means recompute Jacobian-related data from scratch. jok == TRUE means that Jacobian data from the previous PrecSetup call will be reused (with the current value of gamma). A ARKBandPrecSetup call with jok == TRUE should only occur after a call with jok == FALSE. *jcurPtr is a pointer to an output integer flag which is set by ARKBandPrecond as follows: *jcurPtr = TRUE if Jacobian data was recomputed. *jcurPtr = FALSE if Jacobian data was not recomputed, but saved data was reused. gamma is the scalar appearing in the Newton matrix. bp_data is a pointer to preconditoner data (set by ARKBandPrecInit) tmp1, tmp2, and tmp3 are pointers to memory allocated for vectors of length N for work space. This routine uses only tmp1 and tmp2. The value to be returned by the ARKBandPrecSetup function is 0 if successful, or 1 if the band factorization failed. ---------------------------------------------------------------*/ static int ARKBandPrecSetup(realtype t, N_Vector y, N_Vector fy, booleantype jok, booleantype *jcurPtr, realtype gamma, void *bp_data, N_Vector tmp1, N_Vector tmp2, N_Vector tmp3) { ARKBandPrecData pdata; ARKodeMem ark_mem; int retval; long int ier; /* Assume matrix and lpivots have already been allocated. */ pdata = (ARKBandPrecData) bp_data; ark_mem = (ARKodeMem) pdata->arkode_mem; if (jok) { /* If jok = TRUE, use saved copy of J. */ *jcurPtr = FALSE; BandCopy(pdata->savedJ, pdata->savedP, pdata->mu, pdata->ml); } else { /* If jok = FALSE, call ARKBandPDQJac for new J value. */ *jcurPtr = TRUE; SetToZero(pdata->savedJ); retval = ARKBandPDQJac(pdata, t, y, fy, tmp1, tmp2); if (retval < 0) { arkProcessError(ark_mem, -1, "ARKBANDPRE", "ARKBandPrecSetup", MSGBP_RHSFUNC_FAILED); return(-1); } if (retval > 0) { return(1); } BandCopy(pdata->savedJ, pdata->savedP, pdata->mu, pdata->ml); } /* Scale and add I to get savedP = I - gamma*J. */ BandScale(-gamma, pdata->savedP); AddIdentity(pdata->savedP); /* Do LU factorization of matrix. */ ier = BandGBTRF(pdata->savedP, pdata->lpivots); /* Return 0 if the LU was complete; otherwise return 1. */ if (ier > 0) return(1); return(0); }
static int CVBBDPrecSetup(realtype t, N_Vector y, N_Vector fy, booleantype jok, booleantype *jcurPtr, realtype gamma, void *bbd_data, N_Vector tmp1, N_Vector tmp2, N_Vector tmp3) { int ier; CVBBDPrecData pdata; CVodeMem cv_mem; int retval; pdata = (CVBBDPrecData) bbd_data; cv_mem = (CVodeMem) pdata->cvode_mem; if (jok) { /* If jok = TRUE, use saved copy of J */ *jcurPtr = FALSE; BandCopy(savedJ, savedP, mukeep, mlkeep); } else { /* Otherwise call CVBBDDQJac for new J value */ *jcurPtr = TRUE; SetToZero(savedJ); retval = CVBBDDQJac(pdata, t, y, tmp1, tmp2, tmp3); if (retval < 0) { CVProcessError(cv_mem, -1, "CVBBDPRE", "CVBBDPrecSetup", MSGBBD_FUNC_FAILED); return(-1); } if (retval > 0) { return(1); } BandCopy(savedJ, savedP, mukeep, mlkeep); } /* Scale and add I to get P = I - gamma*J */ BandScale(-gamma, savedP); AddIdentity(savedP); /* Do LU factorization of P in place */ ier = BandGBTRF(savedP, pivots); /* Return 0 if the LU was complete; otherwise return 1 */ if (ier > 0) return(1); return(0); }
static int cvBandPrecSetup(realtype t, N_Vector y, N_Vector fy, booleantype jok, booleantype *jcurPtr, realtype gamma, void *bp_data, N_Vector tmp1, N_Vector tmp2, N_Vector tmp3) { CVBandPrecData pdata; CVodeMem cv_mem; int retval; /* Assume matrix and pivots have already been allocated. */ pdata = (CVBandPrecData) bp_data; cv_mem = (CVodeMem) pdata->cvode_mem; if (jok) { /* If jok = TRUE, use saved copy of J. */ *jcurPtr = FALSE; BandCopy(savedJ, savedP, mu, ml); } else { /* If jok = FALSE, call cvBandPrecDQJac for new J value. */ *jcurPtr = TRUE; SetToZero(savedJ); retval = cvBandPrecDQJac(pdata, t, y, fy, tmp1, tmp2); if (retval < 0) { cvProcessError(cv_mem, -1, "CVBANDPRE", "cvBandPrecSetup", MSGBP_RHSFUNC_FAILED); return(-1); } if (retval > 0) { return(1); } BandCopy(savedJ, savedP, mu, ml); } /* Scale and add I to get savedP = I - gamma*J. */ BandScale(-gamma, savedP); AddIdentity(savedP); /* Do LU factorization of matrix. */ retval = BandGBTRF(savedP, pivots); /* Return 0 if the LU was complete; otherwise return 1. */ if (retval > 0) return(1); return(0); }
static int IDABandSetup(IDAMem IDA_mem, N_Vector yyp, N_Vector ypp, N_Vector rrp, N_Vector tmp1, N_Vector tmp2, N_Vector tmp3) { int retval; long int retfac; IDADlsMem idadls_mem; idadls_mem = (IDADlsMem) lmem; /* Increment nje counter. */ nje++; /* Zero out JJ; call Jacobian routine jac; return if it failed. */ SetToZero(JJ); retval = bjac(neq, mu, ml, tn, cj, yyp, ypp, rrp, JJ, jacdata, tmp1, tmp2, tmp3); if (retval < 0) { IDAProcessError(IDA_mem, IDADLS_JACFUNC_UNRECVR, "IDASBAND", "IDABandSetup", MSGD_JACFUNC_FAILED); last_flag = IDADLS_JACFUNC_UNRECVR; return(-1); } if (retval > 0) { last_flag = IDADLS_JACFUNC_RECVR; return(+1); } /* Do LU factorization of JJ; return success or fail flag. */ retfac = BandGBTRF(JJ, pivots); if (retfac != 0) { last_flag = retfac; return(+1); } last_flag = IDADLS_SUCCESS; return(0); }
CAMLprim value c_bandmatrix_gbtrf(value va, value vp) { CAMLparam2(va, vp); BandGBTRF(DLSMAT(va), LONG_ARRAY(vp)); CAMLreturn (Val_unit); }
static int cvBandSetup(CVodeMem cv_mem, int convfail, N_Vector ypred, N_Vector fpred, booleantype *jcurPtr, N_Vector vtemp1, N_Vector vtemp2, N_Vector vtemp3) { CVDlsMem cvdls_mem; booleantype jbad, jok; realtype dgamma; int ier, retval; cvdls_mem = (CVDlsMem) lmem; /* Use nst, gamma/gammap, and convfail to set J eval. flag jok */ dgamma = ABS((gamma/gammap) - ONE); jbad = (nst == 0) || (nst > nstlj + CVD_MSBJ) || ((convfail == CV_FAIL_BAD_J) && (dgamma < CVD_DGMAX)) || (convfail == CV_FAIL_OTHER); jok = !jbad; if (jok) { /* If jok = TRUE, use saved copy of J */ *jcurPtr = FALSE; BandCopy(savedJ, M, mu, ml); } else { /* If jok = FALSE, call jac routine for new J value */ nje++; nstlj = nst; *jcurPtr = TRUE; SetToZero(M); retval = jac(n, mu, ml, tn, ypred, fpred, M, J_data, vtemp1, vtemp2, vtemp3); if (retval < 0) { cvProcessError(cv_mem, CVDLS_JACFUNC_UNRECVR, "CVSBAND", "cvBandSetup", MSGD_JACFUNC_FAILED); last_flag = CVDLS_JACFUNC_UNRECVR; return(-1); } if (retval > 0) { last_flag = CVDLS_JACFUNC_RECVR; return(1); } BandCopy(M, savedJ, mu, ml); } /* Scale and add I to get M = I - gamma*J */ BandScale(-gamma, M); AddIdentity(M); /* Do LU factorization of M */ ier = BandGBTRF(M, pivots); /* Return 0 if the LU was complete; otherwise return 1 */ if (ier > 0) { last_flag = ier; return(1); } last_flag = CVDLS_SUCCESS; return(0); }