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_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; }
int FIDALapackBandJac(long int N, long int mupper, long int mlower, realtype t, realtype c_j, N_Vector yy, N_Vector yp, N_Vector rr, DlsMat J, void *user_data, N_Vector vtemp1, N_Vector vtemp2, N_Vector vtemp3) { realtype *yy_data, *yp_data, *rr_data, *jacdata, *ewtdata, *v1data, *v2data, *v3data; realtype h; long int eband; int ier; FIDAUserData IDA_userdata; /* Initialize all pointers to NULL */ yy_data = yp_data = rr_data = jacdata = ewtdata = NULL; v1data = v2data = v3data = NULL; /* NOTE: The user-supplied routine should set ier to an appropriate value, but we preset the value to zero (meaning SUCCESS) so the user need only reset the value if an error occurred */ ier = 0; IDAGetErrWeights(IDA_idamem, F2C_IDA_ewtvec); IDAGetLastStep(IDA_idamem, &h); /* Get pointers to vector data */ yy_data = N_VGetArrayPointer(yy); yp_data = N_VGetArrayPointer(yp); rr_data = N_VGetArrayPointer(rr); ewtdata = N_VGetArrayPointer(F2C_IDA_ewtvec); v1data = N_VGetArrayPointer(vtemp1); v2data = N_VGetArrayPointer(vtemp2); v3data = N_VGetArrayPointer(vtemp3); eband = (J->s_mu) + mlower + 1; jacdata = BAND_COL(J,0) - mupper; IDA_userdata = (FIDAUserData) user_data; /* Call user-supplied routine */ FIDA_BJAC(&N, &mupper, &mlower, &eband, &t, yy_data, yp_data, rr_data, &c_j, jacdata, ewtdata, &h, IDA_userdata->ipar, IDA_userdata->rpar, v1data, v2data, v3data, &ier); return(ier); }
int FIDAJtimes(realtype t, N_Vector yy, N_Vector yp, N_Vector rr, N_Vector v, N_Vector Jv, realtype c_j, void *jac_data, N_Vector vtemp1, N_Vector vtemp2) { realtype *yy_data, *yp_data, *rr_data, *vdata, *Jvdata, *ewtdata; realtype *v1data, *v2data; realtype h; FIDAUserData IDA_userdata; int ier; /* Initialize all pointers to NULL */ yy_data = yp_data = rr_data = vdata = Jvdata = ewtdata = NULL; /* NOTE: The user-supplied routine should set ier to an appropriate value, but we preset the value to zero (meaning SUCCESS) so the user need only reset the value if an error occurred */ ier = 0; IDAGetErrWeights(IDA_idamem, F2C_IDA_ewtvec); IDAGetLastStep(IDA_idamem, &h); /* Get pointers to vector data */ yy_data = N_VGetArrayPointer(yy); yp_data = N_VGetArrayPointer(yp); rr_data = N_VGetArrayPointer(rr); ewtdata = N_VGetArrayPointer(F2C_IDA_ewtvec); vdata = N_VGetArrayPointer(v); Jvdata = N_VGetArrayPointer(Jv); v1data = N_VGetArrayPointer(vtemp1); v2data = N_VGetArrayPointer(vtemp2); IDA_userdata = (FIDAUserData) jac_data; /* Call user-supplied routine */ FIDA_JTIMES(&t, yy_data, yp_data, rr_data, vdata, Jvdata, &c_j, ewtdata, &h, IDA_userdata->ipar, IDA_userdata->rpar, v1data, v2data, &ier); return(ier); }
int FIDAPSol(realtype t, N_Vector yy, N_Vector yp, N_Vector rr, N_Vector rvec, N_Vector zvec, realtype c_j, realtype delta, void *user_data, N_Vector vtemp1) { realtype *yy_data, *yp_data, *rr_data, *ewtdata, *rdata, *zdata, *v1data; int ier; FIDAUserData IDA_userdata; /* Initialize all pointers to NULL */ yy_data = yp_data = rr_data = ewtdata = zdata = v1data = NULL; /* NOTE: The user-supplied routine should set ier to an appropriate value, but we preset the value to zero (meaning SUCCESS) so the user need only reset the value if an error occurred */ ier = 0; IDAGetErrWeights(IDA_idamem, F2C_IDA_ewtvec); /* Get pointers to vector data */ yy_data = N_VGetArrayPointer(yy); yp_data = N_VGetArrayPointer(yp); rr_data = N_VGetArrayPointer(rr); ewtdata = N_VGetArrayPointer(F2C_IDA_ewtvec); rdata = N_VGetArrayPointer(rvec); zdata = N_VGetArrayPointer(zvec); v1data = N_VGetArrayPointer(vtemp1); IDA_userdata = (FIDAUserData) user_data; /* Call user-supplied routine */ FIDA_PSOL(&t, yy_data, yp_data, rr_data, rdata, zdata, &c_j, &delta, ewtdata, IDA_userdata->ipar, IDA_userdata->rpar, v1data, &ier); return(ier); }
int Ida::calcJacobian(double t, long int N, N_Vector fHelp, N_Vector errorWeight, N_Vector jthCol, double* y, N_Vector fy, DlsMat Jac) { try { int l,g; double fnorm, minInc, *f_data, *fHelp_data, *errorWeight_data, h, srur, delta_inv; f_data = NV_DATA_S(fy); errorWeight_data = NV_DATA_S(errorWeight); fHelp_data = NV_DATA_S(fHelp); //Get relevant info _idid = IDAGetErrWeights(_idaMem, errorWeight); if (_idid < 0) { _idid = -5; throw std::invalid_argument("IDA::calcJacobian()"); } _idid = IDAGetCurrentStep(_idaMem, &h); if (_idid < 0) { _idid = -5; throw std::invalid_argument("IDA::calcJacobian()"); } srur = sqrt(UROUND); fnorm = N_VWrmsNorm(fy, errorWeight); minInc = (fnorm != 0.0) ? (1000.0 * abs(h) * UROUND * N * fnorm) : 1.0; for(int j=0;j<N;j++) { _delta[j] = max(srur*abs(y[j]), minInc/errorWeight_data[j]); } for(int j=0;j<N;j++) { _deltaInv[j] = 1/_delta[j]; } // Calculation of the jacobian if (_jacobianANonzeros != 0) { for(int color=1; color <= _maxColors; color++) { for(int k=0; k < _dimSys; k++) { if((_colorOfColumn[k] ) == color) { _ysave[k] = y[k]; y[k]+= _delta[k]; } } calcFunction(t, y, fHelp_data,fHelp_data); for (int k = 0; k < _dimSys; k++) { if((_colorOfColumn[k]) == color) { y[k] = _ysave[k]; int startOfColumn = k * _dimSys; for (int j = _jacobianALeadindex[k]; j < _jacobianALeadindex[k+1];j++) { l = _jacobianAIndex[j]; g = l + startOfColumn; Jac->data[g] = (fHelp_data[l] - f_data[l]) * _deltaInv[k]; } } } } } /* //Calculation of J without colouring for (j = 0; j < N; j++) { //N_VSetArrayPointer(DENSE_COL(Jac,j), jthCol); _ysave[j] = y[j]; y[j] += _delta[j]; calcFunction(t, y, fHelp_data); y[j] = _ysave[j]; delta_inv = 1.0/_delta[j]; N_VLinearSum(delta_inv, fHelp, -delta_inv, fy, jthCol); for(int i=0; i<_dimSys; ++i) { Jac->data[i+j*_dimSys] = NV_Ith_S(jthCol,i); } //DENSE_COL(Jac,j) = N_VGetArrayPointer(jthCol); } */ } //workaround until exception can be catch from c- libraries catch (std::exception& ex) { std::string error = ex.what(); cerr << "IDA integration error: " << error; return 1; } return 0; }
static int Precondbd(realtype tt, N_Vector cc, N_Vector cp, N_Vector rr, realtype cj, void *user_data, N_Vector tempv1, N_Vector tempv2, N_Vector tempv3) { int flag, thispe; realtype uround; realtype xx, yy, *cxy, *ewtxy, cctemp, **Pxy, *ratesxy, *Pxycol, *cpxy; realtype inc, sqru, fac, perturb_rates[NUM_SPECIES]; int is, js, ix, jy, ret; UserData webdata; void *mem; N_Vector ewt; realtype hh; webdata = (UserData)user_data; uround = UNIT_ROUNDOFF; sqru = SUNRsqrt(uround); thispe = webdata->thispe; mem = webdata->ida_mem; ewt = webdata->ewt; flag = IDAGetErrWeights(mem, ewt); check_flag(&flag, "IDAGetErrWeights", 1, thispe); flag = IDAGetCurrentStep(mem, &hh); check_flag(&flag, "IDAGetCurrentStep", 1, thispe); for (jy = 0; jy < mysub; jy++) { yy = (jy + jysub*mysub)*dy; for (ix = 0; ix < mxsub; ix++) { xx = (ix+ ixsub*mxsub)*dx; Pxy = (webdata->PP)[ix][jy]; cxy = IJ_Vptr(cc,ix,jy); cpxy = IJ_Vptr(cp,ix,jy); ewtxy= IJ_Vptr(ewt,ix,jy); ratesxy = IJ_Vptr(rates,ix,jy); for (js = 0; js < ns; js++) { inc = sqru*(SUNMAX(SUNRabs(cxy[js]), SUNMAX(hh*SUNRabs(cpxy[js]), ONE/ewtxy[js]))); cctemp = cxy[js]; /* Save the (js,ix,jy) element of cc. */ cxy[js] += inc; /* Perturb the (js,ix,jy) element of cc. */ fac = -ONE/inc; WebRates(xx, yy, cxy, perturb_rates, webdata); Pxycol = Pxy[js]; for (is = 0; is < ns; is++) Pxycol[is] = (perturb_rates[is] - ratesxy[is])*fac; if (js < np) Pxycol[js] += cj; /* Add partial with respect to cp. */ cxy[js] = cctemp; /* Restore (js,ix,jy) element of cc. */ } /* End of js loop. */ /* Do LU decomposition of matrix block for grid point (ix,jy). */ ret = denseGETRF(Pxy, ns, ns, (webdata->pivot)[ix][jy]); if (ret != 0) return(1); } /* End of ix loop. */ } /* End of jy loop. */ return(0); }
static int Precond(realtype tt, N_Vector cc, N_Vector cp, N_Vector rr, realtype cj, void *user_data, N_Vector tmp1, N_Vector tmp2, N_Vector tmp3) { int flag; realtype uround, xx, yy, del_x, del_y; realtype **Pxy, *ratesxy, *Pxycol, *cxy, *cpxy, *ewtxy, cctmp; realtype inc, fac, sqru, perturb_rates[NUM_SPECIES]; int is, js, jx, jy, ret; void *mem; N_Vector ewt; realtype hh; UserData webdata; webdata = (UserData) user_data; del_x = webdata->dx; del_y = webdata->dy; uround = UNIT_ROUNDOFF; sqru = SUNRsqrt(uround); mem = webdata->ida_mem; ewt = webdata->ewt; flag = IDAGetErrWeights(mem, ewt); if(check_flag(&flag, "IDAGetErrWeights", 1)) return(1); flag = IDAGetCurrentStep(mem, &hh); if(check_flag(&flag, "IDAGetCurrentStep", 1)) return(1); for (jy = 0; jy < MY; jy++) { yy = jy * del_y; for (jx = 0; jx < MX; jx++) { xx = jx * del_x; Pxy = (webdata->PP)[jx][jy]; cxy = IJ_Vptr(cc, jx, jy); cpxy = IJ_Vptr(cp, jx, jy); ewtxy = IJ_Vptr(ewt, jx, jy); ratesxy = IJ_Vptr((webdata->rates), jx, jy); for (js = 0; js < NUM_SPECIES; js++) { inc = sqru*(SUNMAX(SUNRabs(cxy[js]), SUNMAX(hh*SUNRabs(cpxy[js]), ONE/ewtxy[js]))); cctmp = cxy[js]; cxy[js] += inc; fac = -ONE/inc; WebRates(xx, yy, cxy, perturb_rates, webdata); Pxycol = Pxy[js]; for (is = 0; is < NUM_SPECIES; is++) Pxycol[is] = (perturb_rates[is] - ratesxy[is])*fac; if (js < 1) Pxycol[js] += cj; cxy[js] = cctmp; } ret = denseGETRF(Pxy, NUM_SPECIES, NUM_SPECIES, (webdata->pivot)[jx][jy]); if (ret != 0) return(1); } } return(0); }