/*----------------------------------------------------------------- cvDlsDenseDQJac ----------------------------------------------------------------- This routine generates a dense difference quotient approximation to the Jacobian of f(t,y). It assumes that a dense SUNMatrix is stored column-wise, and that elements within each column are contiguous. The address of the jth column of J is obtained via the accessor function SUNDenseMatrix_Column, and this pointer is associated with an N_Vector using the N_VSetArrayPointer function. Finally, the actual computation of the jth column of the Jacobian is done with a call to N_VLinearSum. -----------------------------------------------------------------*/ int cvDlsDenseDQJac(realtype t, N_Vector y, N_Vector fy, SUNMatrix Jac, CVodeMem cv_mem, N_Vector tmp1) { realtype fnorm, minInc, inc, inc_inv, yjsaved, srur; realtype *y_data, *ewt_data; N_Vector ftemp, jthCol; sunindextype j, N; int retval = 0; CVDlsMem cvdls_mem; /* access DlsMem interface structure */ cvdls_mem = (CVDlsMem) cv_mem->cv_lmem; /* access matrix dimension */ N = SUNDenseMatrix_Rows(Jac); /* Rename work vector for readibility */ ftemp = tmp1; /* Create an empty vector for matrix column calculations */ jthCol = N_VCloneEmpty(tmp1); /* Obtain pointers to the data for ewt, y */ ewt_data = N_VGetArrayPointer(cv_mem->cv_ewt); y_data = N_VGetArrayPointer(y); /* Set minimum increment based on uround and norm of f */ srur = SUNRsqrt(cv_mem->cv_uround); fnorm = N_VWrmsNorm(fy, cv_mem->cv_ewt); minInc = (fnorm != ZERO) ? (MIN_INC_MULT * SUNRabs(cv_mem->cv_h) * cv_mem->cv_uround * N * fnorm) : ONE; for (j = 0; j < N; j++) { /* Generate the jth col of J(tn,y) */ N_VSetArrayPointer(SUNDenseMatrix_Column(Jac,j), jthCol); yjsaved = y_data[j]; inc = SUNMAX(srur*SUNRabs(yjsaved), minInc/ewt_data[j]); y_data[j] += inc; retval = cv_mem->cv_f(t, y, ftemp, cv_mem->cv_user_data); cvdls_mem->nfeDQ++; if (retval != 0) break; y_data[j] = yjsaved; inc_inv = ONE/inc; N_VLinearSum(inc_inv, ftemp, -inc_inv, fy, jthCol); /* DENSE_COL(Jac,j) = N_VGetArrayPointer(jthCol); /\*UNNECESSARY?? *\/ */ } /* Destroy jthCol vector */ N_VSetArrayPointer(NULL, jthCol); /* SHOULDN'T BE NEEDED */ N_VDestroy(jthCol); return(retval); }
static int KINDenseDQJac(long int n, DenseMat J, N_Vector u, N_Vector fu, void *jac_data, N_Vector tmp1, N_Vector tmp2) { realtype inc, inc_inv, ujsaved, ujscale, sign; realtype *tmp2_data, *u_data, *uscale_data; N_Vector ftemp, jthCol; long int j; int retval; KINMem kin_mem; KINDenseMem kindense_mem; /* jac_data points to kin_mem */ kin_mem = (KINMem) jac_data; kindense_mem = (KINDenseMem) lmem; /* Save pointer to the array in tmp2 */ tmp2_data = N_VGetArrayPointer(tmp2); /* Rename work vectors for readibility */ ftemp = tmp1; jthCol = tmp2; /* Obtain pointers to the data for u and uscale */ u_data = N_VGetArrayPointer(u); uscale_data = N_VGetArrayPointer(uscale); /* This is the only for loop for 0..N-1 in KINSOL */ for (j = 0; j < n; j++) { /* Generate the jth col of J(u) */ N_VSetArrayPointer(DENSE_COL(J,j), jthCol); ujsaved = u_data[j]; ujscale = ONE/uscale_data[j]; sign = (ujsaved >= ZERO) ? ONE : -ONE; inc = sqrt_relfunc*MAX(ABS(ujsaved), ujscale)*sign; u_data[j] += inc; retval = func(u, ftemp, f_data); if (retval != 0) return(-1); u_data[j] = ujsaved; inc_inv = ONE/inc; N_VLinearSum(inc_inv, ftemp, -inc_inv, fu, jthCol); } /* Restore original array pointer in tmp2 */ N_VSetArrayPointer(tmp2_data, tmp2); /* Increment counter nfeD */ nfeD += n; return(0); }
void FIDA_SETVIN(char key_name[], realtype *vval, int *ier) { N_Vector Vec; *ier = 0; if (!strncmp(key_name,"ID_VEC",6)) { Vec = NULL; Vec = N_VCloneEmpty(F2C_IDA_vec); if (Vec == NULL) { *ier = -1; return; } N_VSetArrayPointer(vval, Vec); IDASetId(IDA_idamem, Vec); N_VDestroy(Vec); } else if (!strncmp(key_name,"CONSTR_VEC",10)) { Vec = NULL; Vec = N_VCloneEmpty(F2C_IDA_vec); if (Vec == NULL) { *ier = -1; return; } N_VSetArrayPointer(vval, Vec); IDASetConstraints(IDA_idamem, Vec); N_VDestroy(Vec); } else { *ier = -99; printf("FIDASETVIN: Unrecognized key.\n\n"); } }
static void CVDenseDQJac(long int N, DenseMat J, realtype t, N_Vector y, N_Vector fy, void *jac_data, N_Vector tmp1, N_Vector tmp2, N_Vector tmp3) { realtype fnorm, minInc, inc, inc_inv, yjsaved, srur; realtype *tmp2_data, *y_data, *ewt_data; N_Vector ftemp, jthCol; long int j; CVodeMem cv_mem; CVDenseMem cvdense_mem; /* jac_data points to cvode_mem */ cv_mem = (CVodeMem) jac_data; cvdense_mem = (CVDenseMem) lmem; /* Save pointer to the array in tmp2 */ tmp2_data = N_VGetArrayPointer(tmp2); /* Rename work vectors for readibility */ ftemp = tmp1; jthCol = tmp2; /* Obtain pointers to the data for ewt, y */ ewt_data = N_VGetArrayPointer(ewt); y_data = N_VGetArrayPointer(y); /* Set minimum increment based on uround and norm of f */ srur = RSqrt(uround); fnorm = N_VWrmsNorm(fy, ewt); minInc = (fnorm != ZERO) ? (MIN_INC_MULT * ABS(h) * uround * N * fnorm) : ONE; /* This is the only for loop for 0..N-1 in CVODE */ for (j = 0; j < N; j++) { /* Generate the jth col of J(tn,y) */ N_VSetArrayPointer(DENSE_COL(J,j), jthCol); yjsaved = y_data[j]; inc = MAX(srur*ABS(yjsaved), minInc/ewt_data[j]); y_data[j] += inc; f(tn, y, ftemp, f_data); y_data[j] = yjsaved; inc_inv = ONE/inc; N_VLinearSum(inc_inv, ftemp, -inc_inv, fy, jthCol); DENSE_COL(J,j) = N_VGetArrayPointer(jthCol); } /* Restore original array pointer in tmp2 */ N_VSetArrayPointer(tmp2_data, tmp2); /* Increment counter nfeD */ nfeD += N; }
void FIDA_REINIT(realtype *t0, realtype *yy0, realtype *yp0, int *iatol, realtype *rtol, realtype *atol, int *ier) { N_Vector Vatol; *ier = 0; /* Initialize all pointers to NULL */ Vatol = NULL; /* Attach user's yy0 to F2C_IDA_vec */ N_VSetArrayPointer(yy0, F2C_IDA_vec); /* Attach user's yp0 to F2C_IDA_ypvec */ N_VSetArrayPointer(yp0, F2C_IDA_ypvec); /* Call IDAReInit */ *ier = IDAReInit(IDA_idamem, *t0, F2C_IDA_vec, F2C_IDA_ypvec); /* Reset data pointers */ N_VSetArrayPointer(NULL, F2C_IDA_vec); N_VSetArrayPointer(NULL, F2C_IDA_ypvec); /* On failure, exit */ if (*ier != IDA_SUCCESS) { *ier = -1; return; } /* Set tolerances */ switch (*iatol) { case 1: *ier = IDASStolerances(IDA_idamem, *rtol, *atol); break; case 2: Vatol = NULL; Vatol= N_VCloneEmpty(F2C_IDA_vec); if (Vatol == NULL) { *ier = -1; return; } N_VSetArrayPointer(atol, Vatol); *ier = IDASVtolerances(IDA_idamem, *rtol, Vatol); N_VDestroy(Vatol); break; } /* On failure, exit */ if (*ier != IDA_SUCCESS) { *ier = -1; return; } return; }
void FCV_REINIT(realtype *t0, realtype *y0, int *iatol, realtype *rtol, realtype *atol, int *ier) { N_Vector Vatol; *ier = 0; /* Initialize all pointers to NULL */ Vatol = NULL; /* Set data in F2C_CVODE_vec to y0 */ N_VSetArrayPointer(y0, F2C_CVODE_vec); /* Call CVReInit */ *ier = CVodeReInit(CV_cvodemem, *t0, F2C_CVODE_vec); /* Reset data pointers */ N_VSetArrayPointer(NULL, F2C_CVODE_vec); /* On failure, exit */ if (*ier != CV_SUCCESS) { *ier = -1; return; } /* Set tolerances */ switch (*iatol) { case 1: *ier = CVodeSStolerances(CV_cvodemem, *rtol, *atol); break; case 2: Vatol = NULL; Vatol = N_VCloneEmpty(F2C_CVODE_vec); if (Vatol == NULL) { *ier = -1; return; } N_VSetArrayPointer(atol, Vatol); *ier = CVodeSVtolerances(CV_cvodemem, *rtol, Vatol); N_VDestroy(Vatol); break; } /* On failure, exit */ if (*ier != CV_SUCCESS) { *ier = -1; return; } return; }
void FIDA_GETESTLOCALERR(realtype *ele, int *ier) { /* Attach user data to vector */ N_VSetArrayPointer(ele, F2C_IDA_vec); *ier = 0; *ier = IDAGetEstLocalErrors(IDA_idamem, F2C_IDA_vec); /* Reset data pointers */ N_VSetArrayPointer(NULL, F2C_IDA_vec); return; }
void FIDA_GETERRWEIGHTS(realtype *eweight, int *ier) { /* Attach user data to vector */ N_VSetArrayPointer(eweight, F2C_IDA_vec); *ier = 0; *ier = IDAGetErrWeights(IDA_idamem, F2C_IDA_vec); /* Reset data pointer */ N_VSetArrayPointer(NULL, F2C_IDA_vec); return; }
void FIDA_GETDKY(realtype *t, int *k, realtype *dky, int *ier) { /* Attach user data to vectors */ N_VSetArrayPointer(dky, F2C_IDA_vec); *ier = 0; *ier = IDAGetDky(IDA_idamem, *t, *k, F2C_IDA_vec); /* Reset data pointers */ N_VSetArrayPointer(NULL, F2C_IDA_vec); return; }
void FCV_GETERRWEIGHTS(realtype *eweight, int *ier) { /* Attach user data to vector */ realtype *f2c_data = N_VGetArrayPointer(F2C_CVODE_vec); N_VSetArrayPointer(eweight, F2C_CVODE_vec); *ier = 0; *ier = CVodeGetErrWeights(CV_cvodemem, F2C_CVODE_vec); /* Reset data pointers */ N_VSetArrayPointer(f2c_data, F2C_CVODE_vec); return; }
void FCV_GETESTLOCALERR(realtype *ele, int *ier) { /* Attach user data to vector */ realtype *f2c_data = N_VGetArrayPointer(F2C_CVODE_vec); N_VSetArrayPointer(ele, F2C_CVODE_vec); *ier = 0; *ier = CVodeGetEstLocalErrors(CV_cvodemem, F2C_CVODE_vec); /* Reset data pointers */ N_VSetArrayPointer(f2c_data, F2C_CVODE_vec); return; }
void FIDA_GETSOL(realtype *t, realtype *yret, realtype *ypret, int *ier) { /* Attach user data to vectors */ N_VSetArrayPointer(yret, F2C_IDA_vec); N_VSetArrayPointer(ypret, F2C_IDA_ypvec); *ier = 0; *ier = IDAGetSolution(IDA_idamem, *t, F2C_IDA_vec, F2C_IDA_ypvec); /* Reset data pointers */ N_VSetArrayPointer(NULL, F2C_IDA_vec); N_VSetArrayPointer(NULL, F2C_IDA_ypvec); return; }
void FIDA_GETDKY(realtype *t, int *k, realtype *dky, int *ier) { /* Store existing F2C_IDA_vec data pointer */ realtype *f2c_data = N_VGetArrayPointer(F2C_IDA_vec); /* Attach user data to vectors */ N_VSetArrayPointer(dky, F2C_IDA_vec); *ier = 0; *ier = IDAGetDky(IDA_idamem, *t, *k, F2C_IDA_vec); /* Reset data pointers */ N_VSetArrayPointer(f2c_data, F2C_IDA_vec); return; }
void FIDA_GETESTLOCALERR(realtype *ele, int *ier) { /* Store existing F2C_IDA_vec data pointer */ realtype *f2c_data = N_VGetArrayPointer(F2C_IDA_vec); /* Attach user data to vector */ N_VSetArrayPointer(ele, F2C_IDA_vec); *ier = 0; *ier = IDAGetEstLocalErrors(IDA_idamem, F2C_IDA_vec); /* Reset data pointers */ N_VSetArrayPointer(f2c_data, F2C_IDA_vec); return; }
/* Fortran interface routine to set residual tolerance scalar/array; functions as an all-in-one interface to the C routines ARKodeResStolerance and ARKodeResVtolerance; see farkode.h for further details */ void FARK_SETRESTOLERANCE(int *itol, realtype *atol, int *ier) { N_Vector Vatol; realtype abstol; *ier = 0; /* Set tolerance, based on itol argument */ abstol=1.e-9; switch (*itol) { case 1: if (*atol > 0.0) abstol = *atol; *ier = ARKodeResStolerance(ARK_arkodemem, abstol); break; case 2: Vatol = NULL; Vatol = N_VCloneEmpty(F2C_ARKODE_vec); if (Vatol == NULL) { *ier = -1; return; } N_VSetArrayPointer(atol, Vatol); if (N_VMin(Vatol) <= 0.0) N_VConst(abstol, Vatol); *ier = ARKodeResVtolerance(ARK_arkodemem, Vatol); N_VDestroy(Vatol); break; } return; }
static PetscErrorCode TSInterpolate_Sundials(TS ts,PetscReal t,Vec X) { TS_Sundials *cvode = (TS_Sundials*)ts->data; N_Vector y; PetscErrorCode ierr; PetscScalar *x_data; PetscInt glosize,locsize; PetscFunctionBegin; /* get the vector size */ ierr = VecGetSize(X,&glosize);CHKERRQ(ierr); ierr = VecGetLocalSize(X,&locsize);CHKERRQ(ierr); /* allocate the memory for N_Vec y */ y = N_VNew_Parallel(cvode->comm_sundials,locsize,glosize); if (!y) SETERRQ(PETSC_COMM_SELF,1,"Interpolated y is not allocated"); ierr = VecGetArray(X,&x_data);CHKERRQ(ierr); N_VSetArrayPointer((realtype *)x_data,y); ierr = CVodeGetDky(cvode->mem,t,0,y);CHKERRQ(ierr); ierr = VecRestoreArray(X,&x_data);CHKERRQ(ierr); PetscFunctionReturn(0); }
/* Fortran interface to C routine ARKodeGetErrWeights; see farkode.h for further details */ void FARK_GETERRWEIGHTS(realtype *eweight, int *ier) { /* store pointer existing F2C_ARKODE_vec data array */ realtype *f2c_data = N_VGetArrayPointer(F2C_ARKODE_vec); /* attach output data array to F2C_ARKODE_vec */ N_VSetArrayPointer(eweight, F2C_ARKODE_vec); /* call ARKodeGetErrWeights */ *ier = 0; *ier = ARKodeGetErrWeights(ARK_arkodemem, F2C_ARKODE_vec); /* reattach F2C_ARKODE_vec to previous data array */ N_VSetArrayPointer(f2c_data, F2C_ARKODE_vec); return; }
/* Fortran interface to C routine ARKodeGetDky; see farkode.h for further details */ void FARK_DKY(realtype *t, int *k, realtype *dky, int *ier) { /* store pointer existing F2C_ARKODE_vec data array */ realtype *f2c_data = N_VGetArrayPointer(F2C_ARKODE_vec); /* attach output data array to F2C_ARKODE_vec */ N_VSetArrayPointer(dky, F2C_ARKODE_vec); /* call ARKodeGetDky */ *ier = 0; *ier = ARKodeGetDky(ARK_arkodemem, *t, *k, F2C_ARKODE_vec); /* reattach F2C_ARKODE_vec to previous data array */ N_VSetArrayPointer(f2c_data, F2C_ARKODE_vec); return; }
/* Fortran interface to C routine ARKStepFree; see farkode.h for further details */ void FARK_FREE() { ARKodeMem ark_mem; ark_mem = (ARKodeMem) ARK_arkodemem; /* free user_data structure */ if (ark_mem->user_data) free(ark_mem->user_data); ark_mem->user_data = NULL; /* free main integrator memory structure (internally frees time step module, rootfinding, interpolation structures) */ ARKStepFree(&ARK_arkodemem); /* free interface vector / matrices / linear solvers */ N_VSetArrayPointer(NULL, F2C_ARKODE_vec); N_VDestroy(F2C_ARKODE_vec); if (F2C_ARKODE_matrix) SUNMatDestroy(F2C_ARKODE_matrix); if (F2C_ARKODE_mass_matrix) SUNMatDestroy(F2C_ARKODE_mass_matrix); if (F2C_ARKODE_linsol) SUNLinSolFree(F2C_ARKODE_linsol); if (F2C_ARKODE_mass_sol) SUNLinSolFree(F2C_ARKODE_mass_sol); return; }
void FIDA_GETERRWEIGHTS(realtype *eweight, int *ier) { /* Store existing F2C_IDA_vec data pointer */ realtype *f2c_data = N_VGetArrayPointer(F2C_IDA_vec); /* Attach user data to vector */ N_VSetArrayPointer(eweight, F2C_IDA_vec); *ier = 0; *ier = IDAGetErrWeights(IDA_idamem, F2C_IDA_vec); /* Reset data pointer */ N_VSetArrayPointer(f2c_data, F2C_IDA_vec); return; }
void FCV_FREE () { CVodeMem cv_mem; cv_mem = (CVodeMem) CV_cvodemem; if (cv_mem->cv_lfree) cv_mem->cv_lfree(cv_mem); cv_mem->cv_lmem = NULL; free(cv_mem->cv_user_data); cv_mem->cv_user_data = NULL; CVodeFree(&CV_cvodemem); N_VSetArrayPointer(NULL, F2C_CVODE_vec); N_VDestroy(F2C_CVODE_vec); if (F2C_CVODE_matrix) SUNMatDestroy(F2C_CVODE_matrix); if (F2C_CVODE_linsol) SUNLinSolFree(F2C_CVODE_linsol); /* already freed by CVodeFree */ if (F2C_CVODE_nonlinsol) F2C_CVODE_nonlinsol = NULL; return; }
/* Fortran interface to C routine ARKodeGetEstLocalErrors; see farkode.h for further details */ void FARK_GETESTLOCALERR(realtype *ele, int *ier) { /* store pointer existing F2C_ARKODE_vec data array */ realtype *f2c_data = N_VGetArrayPointer(F2C_ARKODE_vec); /* attach output data array to F2C_ARKODE_vec */ N_VSetArrayPointer(ele, F2C_ARKODE_vec); /* call ARKodeGetEstLocalErrors */ *ier = 0; *ier = ARKodeGetEstLocalErrors(ARK_arkodemem, F2C_ARKODE_vec); /* reattach F2C_ARKODE_vec to previous data array */ N_VSetArrayPointer(f2c_data, F2C_ARKODE_vec); return; }
void FCV_FREE () { CVodeFree(CV_cvodemem); /* Restore data array in F2C_vec */ N_VSetArrayPointer(data_F2C_vec, F2C_vec); }
void FCV_DKY (realtype *t, int *k, realtype *dky, int *ier) { /* t is the t value where output is desired k is the derivative order F2C_CVODE_vec is the N_Vector containing the solution derivative on return */ realtype *f2c_data = N_VGetArrayPointer(F2C_CVODE_vec); N_VSetArrayPointer(dky, F2C_CVODE_vec); *ier = 0; *ier = CVodeGetDky(CV_cvodemem, *t, *k, F2C_CVODE_vec); N_VSetArrayPointer(f2c_data, F2C_CVODE_vec); }
static void KIM_Solve(int nlhs, mxArray *plhs[], int nrhs, const mxArray *prhs[]) { double *y0, *ys, *fs; N_Vector yscale, fscale; int buflen, status, strategy; char *bufval; if ( kim_Kdata == NULL) return ; /* Exract y0 and load initial guess in y */ y0 = mxGetPr(prhs[0]); PutData(y, y0, N); /* Extract strategy */ buflen = mxGetM(prhs[1]) * mxGetN(prhs[1]) + 1; bufval = mxCalloc(buflen, sizeof(char)); status = mxGetString(prhs[1], bufval, buflen); if(!strcmp(bufval,"None")) strategy = KIN_NONE; if(!strcmp(bufval,"LineSearch")) strategy = KIN_LINESEARCH; /* Extract yscale */ ys = mxGetPr(prhs[2]); yscale = N_VCloneEmpty(y); N_VSetArrayPointer(ys, yscale); /* Extract fscale */ fs = mxGetPr(prhs[3]); fscale = N_VCloneEmpty(y); N_VSetArrayPointer(fs, fscale); /* call KINSol() */ status = KINSol(kin_mem, y, strategy, yscale, fscale); /* KINSOL return flag */ plhs[0] = mxCreateScalarDouble((double)status); /* Solution vector */ plhs[1] = mxCreateDoubleMatrix(N,1,mxREAL); GetData(y, mxGetPr(plhs[1]), N); /* Free temporary N_Vectors */ N_VDestroy(yscale); N_VDestroy(fscale); return; }
/* Fortran interface to C routine ARKodeFree; see farkode.h for further details */ void FARK_FREE() { ARKodeMem ark_mem; ark_mem = (ARKodeMem) ARK_arkodemem; free(ark_mem->ark_user_data); ark_mem->ark_user_data = NULL; ARKodeFree(&ARK_arkodemem); N_VSetArrayPointer(NULL, F2C_ARKODE_vec); N_VDestroy(F2C_ARKODE_vec); return; }
void FKIN_FREE(void) { /* call KINFree: KIN_kinmem is the pointer to the KINSOL memory block */ KINFree(&KIN_kinmem); N_VSetArrayPointer(NULL , F2C_KINSOL_vec); N_VDestroy(F2C_KINSOL_vec); return; }
PetscErrorCode TSStep_Sundials_Nonlinear(TS ts,int *steps,double *time) { TS_Sundials *cvode = (TS_Sundials*)ts->data; Vec sol = ts->vec_sol; PetscErrorCode ierr; PetscInt i,max_steps = ts->max_steps,flag; long int its; realtype t,tout; PetscScalar *y_data; void *mem; PetscFunctionBegin; mem = cvode->mem; tout = ts->max_time; ierr = VecGetArray(ts->vec_sol,&y_data);CHKERRQ(ierr); N_VSetArrayPointer((realtype *)y_data,cvode->y); ierr = VecRestoreArray(ts->vec_sol,PETSC_NULL);CHKERRQ(ierr); for (i = 0; i < max_steps; i++) { if (ts->ptime >= ts->max_time) break; ierr = TSPreStep(ts);CHKERRQ(ierr); if (cvode->monitorstep){ flag = CVode(mem,tout,cvode->y,&t,CV_ONE_STEP); } else { flag = CVode(mem,tout,cvode->y,&t,CV_NORMAL); } if (flag)SETERRQ1(PETSC_ERR_LIB,"CVode() fails, flag %d",flag); if (t > ts->max_time && cvode->exact_final_time) { /* interpolate to final requested time */ ierr = CVodeGetDky(mem,tout,0,cvode->y);CHKERRQ(ierr); t = tout; } ts->time_step = t - ts->ptime; ts->ptime = t; /* copy the solution from cvode->y to cvode->update and sol */ ierr = VecPlaceArray(cvode->w1,y_data); CHKERRQ(ierr); ierr = VecCopy(cvode->w1,cvode->update);CHKERRQ(ierr); ierr = VecResetArray(cvode->w1); CHKERRQ(ierr); ierr = VecCopy(cvode->update,sol);CHKERRQ(ierr); ierr = CVodeGetNumNonlinSolvIters(mem,&its);CHKERRQ(ierr); ts->nonlinear_its = its; ierr = CVSpilsGetNumLinIters(mem, &its); ts->linear_its = its; ts->steps++; ierr = TSPostStep(ts);CHKERRQ(ierr); ierr = TSMonitor(ts,ts->steps,t,sol);CHKERRQ(ierr); } *steps += ts->steps; *time = t; PetscFunctionReturn(0); }
/*--------------------------------------------------------------- IDABBDPrecSolve The function IDABBDPrecSolve computes a solution to the linear system P z = r, where P is the left preconditioner defined by the routine IDABBDPrecSetup. The IDABBDPrecSolve parameters used here are as follows: rvec is the input right-hand side vector r. zvec is the computed solution vector z. bbd_data is the pointer to BBD data set by IDABBDInit. The arguments tt, yy, yp, rr, c_j and delta are NOT used. IDABBDPrecSolve returns the value returned from the linear solver object. ---------------------------------------------------------------*/ static int IDABBDPrecSolve(realtype tt, N_Vector yy, N_Vector yp, N_Vector rr, N_Vector rvec, N_Vector zvec, realtype c_j, realtype delta, void *bbd_data) { IBBDPrecData pdata; int retval; pdata = (IBBDPrecData) bbd_data; /* Attach local data arrays for rvec and zvec to rlocal and zlocal */ N_VSetArrayPointer(N_VGetArrayPointer(rvec), pdata->rlocal); N_VSetArrayPointer(N_VGetArrayPointer(zvec), pdata->zlocal); /* Call banded solver object to do the work */ retval = SUNLinSolSolve(pdata->LS, pdata->PP, pdata->zlocal, pdata->rlocal, ZERO); /* Detach local data arrays from rlocal and zlocal */ N_VSetArrayPointer(NULL, pdata->rlocal); N_VSetArrayPointer(NULL, pdata->zlocal); return(retval); }
/* Fortran interface routine to re-initialize ARKode memory structure for a problem with a new size but similar time scale; functions as an all-in-one interface to the C routines ARKodeResize (and potentially ARKodeSVtolerances); see farkode.h for further details */ void FARK_RESIZE(realtype *t0, realtype *y0, realtype *hscale, int *itol, realtype *rtol, realtype *atol, int *ier) { *ier = 0; /* Set data in F2C_ARKODE_vec to y0 */ N_VSetArrayPointer(y0, F2C_ARKODE_vec); /* Call ARKodeResize (currently does not allow Fortran user-supplied vector resize function) */ *ier = ARKodeResize(ARK_arkodemem, F2C_ARKODE_vec, *hscale, *t0, NULL, NULL); /* Reset data pointer */ N_VSetArrayPointer(NULL, F2C_ARKODE_vec); /* On failure, exit */ if (*ier != ARK_SUCCESS) { *ier = -1; return; } /* Set tolerances, based on itol argument */ if (*itol) { N_Vector Vatol = NULL; Vatol = N_VCloneEmpty(F2C_ARKODE_vec); if (Vatol == NULL) { *ier = -1; return; } N_VSetArrayPointer(atol, Vatol); *ier = ARKodeSVtolerances(ARK_arkodemem, *rtol, Vatol); N_VDestroy(Vatol); } return; }