1 /* -----------------------------------------------------------------
2 * Programmer(s): Radu Serban @ LLNL
3 * -----------------------------------------------------------------
4 * SUNDIALS Copyright Start
5 * Copyright (c) 2002-2021, Lawrence Livermore National Security
6 * and Southern Methodist University.
7 * All rights reserved.
8 *
9 * See the top-level LICENSE and NOTICE files for details.
10 *
11 * SPDX-License-Identifier: BSD-3-Clause
12 * SUNDIALS Copyright End
13 * -----------------------------------------------------------------
14 * This is the implementation file for the main IDAS solver.
15 * -----------------------------------------------------------------
16 *
17 * EXPORTED FUNCTIONS
18 * ------------------
19 * Creation, allocation and re-initialization functions
20 * IDACreate
21 * IDAInit
22 * IDAReInit
23 * IDAQuadInit
24 * IDAQuadReInit
25 * IDAQuadSStolerances
26 * IDAQuadSVtolerances
27 * IDASensInit
28 * IDASensReInit
29 * IDASensToggleOff
30 * IDASensSStolerances
31 * IDASensSVtolerances
32 * IDASensEEtolerances
33 * IDAQuadSensInit
34 * IDAQuadSensReInit
35 * IDARootInit
36 * Main solver function
37 * IDASolve
38 * Interpolated output and extraction functions
39 * IDAGetDky
40 * IDAGetQuad
41 * IDAGetQuadDky
42 * IDAGetSens
43 * IDAGetSens1
44 * IDAGetSensDky
45 * IDAGetSensDky1
46 * Deallocation functions
47 * IDAFree
48 * IDAQuadFree
49 * IDASensFree
50 * IDAQuadSensFree
51 *
52 * PRIVATE FUNCTIONS
53 * -----------------
54 * IDACheckNvector
55 * Memory allocation/deallocation
56 * IDAAllocVectors
57 * IDAFreeVectors
58 * IDAQuadAllocVectors
59 * IDAQuadFreeVectors
60 * IDASensAllocVectors
61 * IDASensFreeVectors
62 * IDAQuadSensAllocVectors
63 * IDAQuadSensFreeVectors
64 * Initial setup
65 * IDAInitialSetup
66 * IDAEwtSet
67 * IDAEwtSetSS
68 * IDAEwtSetSV
69 * IDAQuadEwtSet
70 * IDAQuadEwtSetSS
71 * IDAQuadEwtSetSV
72 * IDASensEwtSet
73 * IDASensEwtSetEE
74 * IDASensEwtSetSS
75 * IDASensEwtSetSV
76 * IDAQuadSensEwtSet
77 * IDAQuadSensEwtSetEE
78 * IDAQuadSensEwtSetSS
79 * IDAQuadSensEwtSetSV
80 * Stopping tests
81 * IDAStopTest1
82 * IDAStopTest2
83 * Error handler
84 * IDAHandleFailure
85 * Main IDAStep function
86 * IDAStep
87 * IDASetCoeffs
88 * Nonlinear solver functions
89 * IDANls
90 * IDAPredict
91 * IDAQuadNls
92 * IDAQuadSensNls
93 * IDAQuadPredict
94 * IDAQuadSensPredict
95 * IDASensNls
96 * IDASensPredict
97 * Error test
98 * IDATestError
99 * IDAQuadTestError
100 * IDASensTestError
101 * IDAQuadSensTestError
102 * IDARestore
103 * Handler for convergence and/or error test failures
104 * IDAHandleNFlag
105 * IDAReset
106 * Function called after a successful step
107 * IDACompleteStep
108 * Get solution
109 * IDAGetSolution
110 * Norm functions
111 * IDAWrmsNorm
112 * IDASensWrmsNorm
113 * IDAQuadSensWrmsNorm
114 * IDAQuadWrmsNormUpdate
115 * IDASensWrmsNormUpdate
116 * IDAQuadSensWrmsNormUpdate
117 * Functions for rootfinding
118 * IDARcheck1
119 * IDARcheck2
120 * IDARcheck3
121 * IDARootfind
122 * IDA Error message handling functions
123 * IDAProcessError
124 * IDAErrHandler
125 * Internal DQ approximations for sensitivity RHS
126 * IDASensResDQ
127 * IDASensRes1DQ
128 * IDAQuadSensResDQ
129 * IDAQuadSensRes1DQ
130 * -----------------------------------------------------------------
131 */
132
133 /*
134 * =================================================================
135 * IMPORTED HEADER FILES
136 * =================================================================
137 */
138
139 #include <stdio.h>
140 #include <stdlib.h>
141 #include <stdarg.h>
142 #include <string.h>
143
144 #include "idas_impl.h"
145 #include <sundials/sundials_math.h>
146 #include <sundials/sundials_nvector_senswrapper.h>
147 #include <sunnonlinsol/sunnonlinsol_newton.h>
148
149 /*
150 * =================================================================
151 * IDAS PRIVATE CONSTANTS
152 * =================================================================
153 */
154
155 #define ZERO RCONST(0.0) /* real 0.0 */
156 #define HALF RCONST(0.5) /* real 0.5 */
157 #define QUARTER RCONST(0.25) /* real 0.25 */
158 #define TWOTHIRDS RCONST(0.667) /* real 2/3 */
159 #define ONE RCONST(1.0) /* real 1.0 */
160 #define ONEPT5 RCONST(1.5) /* real 1.5 */
161 #define TWO RCONST(2.0) /* real 2.0 */
162 #define FOUR RCONST(4.0) /* real 4.0 */
163 #define FIVE RCONST(5.0) /* real 5.0 */
164 #define TEN RCONST(10.0) /* real 10.0 */
165 #define TWELVE RCONST(12.0) /* real 12.0 */
166 #define TWENTY RCONST(20.0) /* real 20.0 */
167 #define HUNDRED RCONST(100.0) /* real 100.0 */
168 #define PT9 RCONST(0.9) /* real 0.9 */
169 #define PT99 RCONST(0.99) /* real 0.99 */
170 #define PT1 RCONST(0.1) /* real 0.1 */
171 #define PT01 RCONST(0.01) /* real 0.01 */
172 #define PT001 RCONST(0.001) /* real 0.001 */
173 #define PT0001 RCONST(0.0001) /* real 0.0001 */
174
175 /*
176 * =================================================================
177 * IDAS ROUTINE-SPECIFIC CONSTANTS
178 * =================================================================
179 */
180
181 /*
182 * Control constants for lower-level functions used by IDASolve
183 * ------------------------------------------------------------
184 */
185
186 /* IDAStep control constants */
187
188 #define PREDICT_AGAIN 20
189
190 /* Return values for lower level routines used by IDASolve */
191
192 #define CONTINUE_STEPS +99
193
194 /* IDACompleteStep constants */
195
196 #define UNSET -1
197 #define LOWER +1
198 #define RAISE +2
199 #define MAINTAIN +3
200
201 /* IDATestError constants */
202
203 #define ERROR_TEST_FAIL +7
204
205 /*
206 * Control constants for lower-level rootfinding functions
207 * -------------------------------------------------------
208 */
209
210 #define RTFOUND +1
211 #define CLOSERT +3
212
213 /*
214 * Control constants for sensitivity DQ
215 * ------------------------------------
216 */
217
218 #define CENTERED1 +1
219 #define CENTERED2 +2
220 #define FORWARD1 +3
221 #define FORWARD2 +4
222
223 /*
224 * Algorithmic constants
225 * ---------------------
226 */
227
228 #define MXNCF 10 /* max number of convergence failures allowed */
229 #define MXNEF 10 /* max number of error test failures allowed */
230 #define MAXNH 5 /* max. number of h tries in IC calc. */
231 #define MAXNJ 4 /* max. number of J tries in IC calc. */
232 #define MAXNI 10 /* max. Newton iterations in IC calc. */
233 #define EPCON RCONST(0.33) /* Newton convergence test constant */
234 #define MAXBACKS 100 /* max backtracks per Newton step in IDACalcIC */
235 #define XRATE RCONST(0.25) /* constant for updating Jacobian/preconditioner */
236
237 /*
238 * =================================================================
239 * PRIVATE FUNCTION PROTOTYPES
240 * =================================================================
241 */
242
243 static booleantype IDACheckNvector(N_Vector tmpl);
244
245 /* Memory allocation/deallocation */
246
247 static booleantype IDAAllocVectors(IDAMem IDA_mem, N_Vector tmpl);
248 static void IDAFreeVectors(IDAMem IDA_mem);
249
250 static booleantype IDAQuadAllocVectors(IDAMem IDA_mem, N_Vector tmpl);
251 static void IDAQuadFreeVectors(IDAMem IDA_mem);
252
253 static booleantype IDASensAllocVectors(IDAMem IDA_mem, N_Vector tmpl);
254 static void IDASensFreeVectors(IDAMem IDA_mem);
255
256 static booleantype IDAQuadSensAllocVectors(IDAMem ida_mem, N_Vector tmpl);
257 static void IDAQuadSensFreeVectors(IDAMem ida_mem);
258
259 /* Initial setup */
260
261 int IDAInitialSetup(IDAMem IDA_mem);
262
263 static int IDAEwtSetSS(IDAMem IDA_mem, N_Vector ycur, N_Vector weight);
264 static int IDAEwtSetSV(IDAMem IDA_mem, N_Vector ycur, N_Vector weight);
265
266 static int IDAQuadEwtSet(IDAMem IDA_mem, N_Vector qcur, N_Vector weightQ);
267 static int IDAQuadEwtSetSS(IDAMem IDA_mem, N_Vector qcur, N_Vector weightQ);
268 static int IDAQuadEwtSetSV(IDAMem IDA_mem, N_Vector qcur, N_Vector weightQ);
269
270 /* Used in IC for sensitivities. */
271 int IDASensEwtSet(IDAMem IDA_mem, N_Vector *yScur, N_Vector *weightS);
272 static int IDASensEwtSetEE(IDAMem IDA_mem, N_Vector *yScur, N_Vector *weightS);
273 static int IDASensEwtSetSS(IDAMem IDA_mem, N_Vector *yScur, N_Vector *weightS);
274 static int IDASensEwtSetSV(IDAMem IDA_mem, N_Vector *yScur, N_Vector *weightS);
275
276 int IDAQuadSensEwtSet(IDAMem IDA_mem, N_Vector *yQScur, N_Vector *weightQS);
277 static int IDAQuadSensEwtSetEE(IDAMem IDA_mem, N_Vector *yScur, N_Vector *weightS);
278 static int IDAQuadSensEwtSetSS(IDAMem IDA_mem, N_Vector *yScur, N_Vector *weightS);
279 static int IDAQuadSensEwtSetSV(IDAMem IDA_mem, N_Vector *yScur, N_Vector *weightS);
280
281 /* Main IDAStep function */
282
283 static int IDAStep(IDAMem IDA_mem);
284
285 /* Function called at beginning of step */
286
287 static void IDASetCoeffs(IDAMem IDA_mem, realtype *ck);
288
289 /* Nonlinear solver functions */
290
291 static void IDAPredict(IDAMem IDA_mem);
292 static void IDAQuadPredict(IDAMem IDA_mem);
293 static void IDASensPredict(IDAMem IDA_mem, N_Vector *yySens, N_Vector *ypSens);
294 static void IDAQuadSensPredict(IDAMem IDA_mem, N_Vector *yQS, N_Vector *ypQS);
295
296 static int IDANls(IDAMem IDA_mem);
297 static int IDASensNls(IDAMem IDA_mem);
298
299 static int IDAQuadNls(IDAMem IDA_mem);
300 static int IDAQuadSensNls(IDAMem IDA_mem);
301
302 /* Error test */
303
304 static int IDATestError(IDAMem IDA_mem, realtype ck,
305 realtype *err_k, realtype *err_km1, realtype *err_km2);
306 static int IDAQuadTestError(IDAMem IDA_mem, realtype ck,
307 realtype *err_k, realtype *err_km1, realtype *err_km2);
308 static int IDASensTestError(IDAMem IDA_mem, realtype ck,
309 realtype *err_k, realtype *err_km1, realtype *err_km2);
310 static int IDAQuadSensTestError(IDAMem IDA_mem, realtype ck,
311 realtype *err_k, realtype *err_km1, realtype *err_km2);
312
313 /* Handling of convergence and/or error test failures */
314
315 static void IDARestore(IDAMem IDA_mem, realtype saved_t);
316 static int IDAHandleNFlag(IDAMem IDA_mem, int nflag, realtype err_k, realtype err_km1,
317 long int *ncfnPtr, int *ncfPtr, long int *netfPtr, int *nefPtr);
318 static void IDAReset(IDAMem IDA_mem);
319
320 /* Function called after a successful step */
321
322 static void IDACompleteStep(IDAMem IDA_mem, realtype err_k, realtype err_km1);
323
324 /* Function called to evaluate the solutions y(t) and y'(t) at t. Also used in IDAA */
325
326 int IDAGetSolution(void *ida_mem, realtype t, N_Vector yret, N_Vector ypret);
327
328 /* Stopping tests and failure handling */
329
330 static int IDAStopTest1(IDAMem IDA_mem, realtype tout,realtype *tret,
331 N_Vector yret, N_Vector ypret, int itask);
332 static int IDAStopTest2(IDAMem IDA_mem, realtype tout, realtype *tret,
333 N_Vector yret, N_Vector ypret, int itask);
334 static int IDAHandleFailure(IDAMem IDA_mem, int sflag);
335
336 /* Norm functions */
337
338 static realtype IDAQuadWrmsNormUpdate(IDAMem IDA_mem, realtype old_nrm,
339 N_Vector xQ, N_Vector wQ);
340
341 static realtype IDAQuadSensWrmsNorm(IDAMem IDA_mem, N_Vector *xQS, N_Vector *wQS);
342 static realtype IDAQuadSensWrmsNormUpdate(IDAMem IDA_mem, realtype old_nrm,
343 N_Vector *xQS, N_Vector *wQS);
344
345 /* Functions for rootfinding */
346
347 static int IDARcheck1(IDAMem IDA_mem);
348 static int IDARcheck2(IDAMem IDA_mem);
349 static int IDARcheck3(IDAMem IDA_mem);
350 static int IDARootfind(IDAMem IDA_mem);
351
352 /* Sensitivity residual DQ function */
353
354 static int IDASensRes1DQ(int Ns, realtype t,
355 N_Vector yy, N_Vector yp, N_Vector resval,
356 int iS,
357 N_Vector yyS, N_Vector ypS, N_Vector resvalS,
358 void *user_dataS,
359 N_Vector ytemp, N_Vector yptemp, N_Vector restemp);
360
361 static int IDAQuadSensRhsInternalDQ(int Ns, realtype t,
362 N_Vector yy, N_Vector yp,
363 N_Vector *yyS, N_Vector *ypS,
364 N_Vector rrQ, N_Vector *resvalQS,
365 void *ida_mem,
366 N_Vector yytmp, N_Vector yptmp, N_Vector tmpQS);
367
368 static int IDAQuadSensRhs1InternalDQ(IDAMem IDA_mem, int is, realtype t,
369 N_Vector yy, N_Vector y,
370 N_Vector yyS, N_Vector ypS,
371 N_Vector resvalQ, N_Vector resvalQS,
372 N_Vector yytmp, N_Vector yptmp, N_Vector tmpQS);
373 /*
374 * =================================================================
375 * EXPORTED FUNCTIONS IMPLEMENTATION
376 * =================================================================
377 */
378
379 /*
380 * -----------------------------------------------------------------
381 * Creation, allocation and re-initialization functions
382 * -----------------------------------------------------------------
383 */
384
385 /*
386 * IDACreate
387 *
388 * IDACreate creates an internal memory block for a problem to
389 * be solved by IDA.
390 * If successful, IDACreate returns a pointer to the problem memory.
391 * This pointer should be passed to IDAInit.
392 * If an initialization error occurs, IDACreate prints an error
393 * message to standard err and returns NULL.
394 */
395
IDACreate(void)396 void *IDACreate(void)
397 {
398 IDAMem IDA_mem;
399
400 IDA_mem = NULL;
401 IDA_mem = (IDAMem) malloc(sizeof(struct IDAMemRec));
402 if (IDA_mem == NULL) {
403 IDAProcessError(NULL, 0, "IDAS", "IDACreate", MSG_MEM_FAIL);
404 return (NULL);
405 }
406
407 /* Zero out ida_mem */
408 memset(IDA_mem, 0, sizeof(struct IDAMemRec));
409
410 /* Set unit roundoff in IDA_mem */
411 IDA_mem->ida_uround = UNIT_ROUNDOFF;
412
413 /* Set default values for integrator optional inputs */
414 IDA_mem->ida_res = NULL;
415 IDA_mem->ida_user_data = NULL;
416 IDA_mem->ida_itol = IDA_NN;
417 IDA_mem->ida_atolmin0 = SUNTRUE;
418 IDA_mem->ida_user_efun = SUNFALSE;
419 IDA_mem->ida_efun = NULL;
420 IDA_mem->ida_edata = NULL;
421 IDA_mem->ida_ehfun = IDAErrHandler;
422 IDA_mem->ida_eh_data = IDA_mem;
423 IDA_mem->ida_errfp = stderr;
424 IDA_mem->ida_maxord = MAXORD_DEFAULT;
425 IDA_mem->ida_mxstep = MXSTEP_DEFAULT;
426 IDA_mem->ida_hmax_inv = HMAX_INV_DEFAULT;
427 IDA_mem->ida_hin = ZERO;
428 IDA_mem->ida_epcon = EPCON;
429 IDA_mem->ida_maxnef = MXNEF;
430 IDA_mem->ida_maxncf = MXNCF;
431 IDA_mem->ida_suppressalg = SUNFALSE;
432 IDA_mem->ida_id = NULL;
433 IDA_mem->ida_constraints = NULL;
434 IDA_mem->ida_constraintsSet = SUNFALSE;
435 IDA_mem->ida_tstopset = SUNFALSE;
436
437 /* set the saved value maxord_alloc */
438 IDA_mem->ida_maxord_alloc = MAXORD_DEFAULT;
439
440 /* Set default values for IC optional inputs */
441 IDA_mem->ida_epiccon = PT01 * EPCON;
442 IDA_mem->ida_maxnh = MAXNH;
443 IDA_mem->ida_maxnj = MAXNJ;
444 IDA_mem->ida_maxnit = MAXNI;
445 IDA_mem->ida_maxbacks = MAXBACKS;
446 IDA_mem->ida_lsoff = SUNFALSE;
447 IDA_mem->ida_steptol = SUNRpowerR(IDA_mem->ida_uround, TWOTHIRDS);
448
449 /* Set default values for quad. optional inputs */
450 IDA_mem->ida_quadr = SUNFALSE;
451 IDA_mem->ida_rhsQ = NULL;
452 IDA_mem->ida_errconQ = SUNFALSE;
453 IDA_mem->ida_itolQ = IDA_NN;
454 IDA_mem->ida_atolQmin0 = SUNTRUE;
455
456 /* Set default values for sensi. optional inputs */
457 IDA_mem->ida_sensi = SUNFALSE;
458 IDA_mem->ida_user_dataS = (void *)IDA_mem;
459 IDA_mem->ida_resS = IDASensResDQ;
460 IDA_mem->ida_resSDQ = SUNTRUE;
461 IDA_mem->ida_DQtype = IDA_CENTERED;
462 IDA_mem->ida_DQrhomax = ZERO;
463 IDA_mem->ida_p = NULL;
464 IDA_mem->ida_pbar = NULL;
465 IDA_mem->ida_plist = NULL;
466 IDA_mem->ida_errconS = SUNFALSE;
467 IDA_mem->ida_itolS = IDA_EE;
468 IDA_mem->ida_atolSmin0 = NULL;
469 IDA_mem->ida_ism = -1; /* initialize to invalid option */
470
471 /* Defaults for sensi. quadr. optional inputs. */
472 IDA_mem->ida_quadr_sensi = SUNFALSE;
473 IDA_mem->ida_user_dataQS = (void *)IDA_mem;
474 IDA_mem->ida_rhsQS = IDAQuadSensRhsInternalDQ;
475 IDA_mem->ida_rhsQSDQ = SUNTRUE;
476 IDA_mem->ida_errconQS = SUNFALSE;
477 IDA_mem->ida_itolQS = IDA_EE;
478 IDA_mem->ida_atolQSmin0 = NULL;
479
480 /* Set defaults for ASA. */
481 IDA_mem->ida_adj = SUNFALSE;
482 IDA_mem->ida_adj_mem = NULL;
483
484 /* Initialize lrw and liw */
485 IDA_mem->ida_lrw = 25 + 5*MXORDP1;
486 IDA_mem->ida_liw = 38;
487
488 /* No mallocs have been done yet */
489 IDA_mem->ida_VatolMallocDone = SUNFALSE;
490 IDA_mem->ida_constraintsMallocDone = SUNFALSE;
491 IDA_mem->ida_idMallocDone = SUNFALSE;
492 IDA_mem->ida_MallocDone = SUNFALSE;
493
494 IDA_mem->ida_VatolQMallocDone = SUNFALSE;
495 IDA_mem->ida_quadMallocDone = SUNFALSE;
496
497 IDA_mem->ida_VatolSMallocDone = SUNFALSE;
498 IDA_mem->ida_SatolSMallocDone = SUNFALSE;
499 IDA_mem->ida_sensMallocDone = SUNFALSE;
500
501 IDA_mem->ida_VatolQSMallocDone = SUNFALSE;
502 IDA_mem->ida_SatolQSMallocDone = SUNFALSE;
503 IDA_mem->ida_quadSensMallocDone = SUNFALSE;
504
505 IDA_mem->ida_adjMallocDone = SUNFALSE;
506
507 /* Initialize nonlinear solver variables */
508 IDA_mem->NLS = NULL;
509 IDA_mem->ownNLS = SUNFALSE;
510
511 IDA_mem->NLSsim = NULL;
512 IDA_mem->ownNLSsim = SUNFALSE;
513 IDA_mem->ypredictSim = NULL;
514 IDA_mem->ycorSim = NULL;
515 IDA_mem->ewtSim = NULL;
516 IDA_mem->simMallocDone = SUNFALSE;
517
518 IDA_mem->NLSstg = NULL;
519 IDA_mem->ownNLSstg = SUNFALSE;
520 IDA_mem->ypredictStg = NULL;
521 IDA_mem->ycorStg = NULL;
522 IDA_mem->ewtStg = NULL;
523 IDA_mem->stgMallocDone = SUNFALSE;
524
525 /* Return pointer to IDA memory block */
526 return((void *)IDA_mem);
527 }
528
529 /*-----------------------------------------------------------------*/
530
531 /*
532 * IDAInit
533 *
534 * IDAInit allocates and initializes memory for a problem. All
535 * problem specification inputs are checked for errors. If any
536 * error occurs during initialization, it is reported to the
537 * error handler function.
538 */
539
IDAInit(void * ida_mem,IDAResFn res,realtype t0,N_Vector yy0,N_Vector yp0)540 int IDAInit(void *ida_mem, IDAResFn res,
541 realtype t0, N_Vector yy0, N_Vector yp0)
542 {
543 int retval;
544 IDAMem IDA_mem;
545 booleantype nvectorOK, allocOK;
546 sunindextype lrw1, liw1;
547 SUNNonlinearSolver NLS;
548
549 /* Check ida_mem */
550
551 if (ida_mem == NULL) {
552 IDAProcessError(NULL, IDA_MEM_NULL, "IDAS", "IDAInit", MSG_NO_MEM);
553 return(IDA_MEM_NULL);
554 }
555 IDA_mem = (IDAMem) ida_mem;
556
557 /* Check for legal input parameters */
558
559 if (yy0 == NULL) {
560 IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDAInit", MSG_Y0_NULL);
561 return(IDA_ILL_INPUT);
562 }
563
564 if (yp0 == NULL) {
565 IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDAInit", MSG_YP0_NULL);
566 return(IDA_ILL_INPUT);
567 }
568
569 if (res == NULL) {
570 IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDAInit", MSG_RES_NULL);
571 return(IDA_ILL_INPUT);
572 }
573
574 /* Test if all required vector operations are implemented */
575
576 nvectorOK = IDACheckNvector(yy0);
577 if (!nvectorOK) {
578 IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDAInit", MSG_BAD_NVECTOR);
579 return(IDA_ILL_INPUT);
580 }
581
582 /* Set space requirements for one N_Vector */
583
584 if (yy0->ops->nvspace != NULL) {
585 N_VSpace(yy0, &lrw1, &liw1);
586 } else {
587 lrw1 = 0;
588 liw1 = 0;
589 }
590 IDA_mem->ida_lrw1 = lrw1;
591 IDA_mem->ida_liw1 = liw1;
592
593 /* Allocate the vectors (using yy0 as a template) */
594
595 allocOK = IDAAllocVectors(IDA_mem, yy0);
596 if (!allocOK) {
597 IDAProcessError(IDA_mem, IDA_MEM_FAIL, "IDAS", "IDAInit", MSG_MEM_FAIL);
598 return(IDA_MEM_FAIL);
599 }
600
601 /* Allocate temporary work arrays for fused vector ops */
602 IDA_mem->ida_cvals = NULL;
603 IDA_mem->ida_cvals = (realtype *) malloc(MXORDP1*sizeof(realtype));
604
605 IDA_mem->ida_Xvecs = NULL;
606 IDA_mem->ida_Xvecs = (N_Vector *) malloc(MXORDP1*sizeof(N_Vector));
607
608 IDA_mem->ida_Zvecs = NULL;
609 IDA_mem->ida_Zvecs = (N_Vector *) malloc(MXORDP1*sizeof(N_Vector));
610
611 if ((IDA_mem->ida_cvals == NULL) ||
612 (IDA_mem->ida_Xvecs == NULL) ||
613 (IDA_mem->ida_Zvecs == NULL)) {
614 IDAFreeVectors(IDA_mem);
615 IDAProcessError(IDA_mem, IDA_MEM_FAIL, "IDAS", "IDAInit", MSG_MEM_FAIL);
616 return(IDA_MEM_FAIL);
617 }
618
619 /* create a Newton nonlinear solver object by default */
620 NLS = SUNNonlinSol_Newton(yy0);
621
622 /* check that nonlinear solver is non-NULL */
623 if (NLS == NULL) {
624 IDAProcessError(IDA_mem, IDA_MEM_FAIL, "IDAS", "IDAInit", MSG_MEM_FAIL);
625 IDAFreeVectors(IDA_mem);
626 return(IDA_MEM_FAIL);
627 }
628
629 /* attach the nonlinear solver to the IDA memory */
630 retval = IDASetNonlinearSolver(IDA_mem, NLS);
631
632 /* check that the nonlinear solver was successfully attached */
633 if (retval != IDA_SUCCESS) {
634 IDAProcessError(IDA_mem, retval, "IDAS", "IDAInit",
635 "Setting the nonlinear solver failed");
636 IDAFreeVectors(IDA_mem);
637 SUNNonlinSolFree(NLS);
638 return(IDA_MEM_FAIL);
639 }
640
641 /* set ownership flag */
642 IDA_mem->ownNLS = SUNTRUE;
643
644 /* All error checking is complete at this point */
645
646 /* Copy the input parameters into IDA memory block */
647
648 IDA_mem->ida_res = res;
649 IDA_mem->ida_tn = t0;
650
651 /* Set the linear solver addresses to NULL */
652
653 IDA_mem->ida_linit = NULL;
654 IDA_mem->ida_lsetup = NULL;
655 IDA_mem->ida_lsolve = NULL;
656 IDA_mem->ida_lperf = NULL;
657 IDA_mem->ida_lfree = NULL;
658 IDA_mem->ida_lmem = NULL;
659
660 /* Set forceSetup to SUNFALSE */
661
662 IDA_mem->ida_forceSetup = SUNFALSE;
663
664 /* Initialize the phi array */
665
666 N_VScale(ONE, yy0, IDA_mem->ida_phi[0]);
667 N_VScale(ONE, yp0, IDA_mem->ida_phi[1]);
668
669 /* Initialize all the counters and other optional output values */
670
671 IDA_mem->ida_nst = 0;
672 IDA_mem->ida_nre = 0;
673 IDA_mem->ida_ncfn = 0;
674 IDA_mem->ida_netf = 0;
675 IDA_mem->ida_nni = 0;
676 IDA_mem->ida_nsetups = 0;
677
678 IDA_mem->ida_kused = 0;
679 IDA_mem->ida_hused = ZERO;
680 IDA_mem->ida_tolsf = ONE;
681
682 IDA_mem->ida_nge = 0;
683
684 IDA_mem->ida_irfnd = 0;
685
686 /* Initialize counters specific to IC calculation. */
687 IDA_mem->ida_nbacktr = 0;
688
689 /* Initialize root-finding variables */
690
691 IDA_mem->ida_glo = NULL;
692 IDA_mem->ida_ghi = NULL;
693 IDA_mem->ida_grout = NULL;
694 IDA_mem->ida_iroots = NULL;
695 IDA_mem->ida_rootdir = NULL;
696 IDA_mem->ida_gfun = NULL;
697 IDA_mem->ida_nrtfn = 0;
698 IDA_mem->ida_gactive = NULL;
699 IDA_mem->ida_mxgnull = 1;
700
701 /* Initial setup not done yet */
702
703 IDA_mem->ida_SetupDone = SUNFALSE;
704
705 /* Problem memory has been successfully allocated */
706
707 IDA_mem->ida_MallocDone = SUNTRUE;
708
709 return(IDA_SUCCESS);
710 }
711
712 /*-----------------------------------------------------------------*/
713
714 /*
715 * IDAReInit
716 *
717 * IDAReInit re-initializes IDA's memory for a problem, assuming
718 * it has already beeen allocated in a prior IDAInit call.
719 * All problem specification inputs are checked for errors.
720 * The problem size Neq is assumed to be unchanged since the call
721 * to IDAInit, and the maximum order maxord must not be larger.
722 * If any error occurs during reinitialization, it is reported to
723 * the error handler function.
724 * The return value is IDA_SUCCESS = 0 if no errors occurred, or
725 * a negative value otherwise.
726 */
727
IDAReInit(void * ida_mem,realtype t0,N_Vector yy0,N_Vector yp0)728 int IDAReInit(void *ida_mem,
729 realtype t0, N_Vector yy0, N_Vector yp0)
730 {
731 IDAMem IDA_mem;
732
733 /* Check for legal input parameters */
734
735 if (ida_mem == NULL) {
736 IDAProcessError(NULL, IDA_MEM_NULL, "IDAS", "IDAReInit", MSG_NO_MEM);
737 return(IDA_MEM_NULL);
738 }
739 IDA_mem = (IDAMem) ida_mem;
740
741 /* Check if problem was malloc'ed */
742
743 if (IDA_mem->ida_MallocDone == SUNFALSE) {
744 IDAProcessError(IDA_mem, IDA_NO_MALLOC, "IDAS", "IDAReInit", MSG_NO_MALLOC);
745 return(IDA_NO_MALLOC);
746 }
747
748 /* Check for legal input parameters */
749
750 if (yy0 == NULL) {
751 IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDAReInit", MSG_Y0_NULL);
752 return(IDA_ILL_INPUT);
753 }
754
755 if (yp0 == NULL) {
756 IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDAReInit", MSG_YP0_NULL);
757 return(IDA_ILL_INPUT);
758 }
759
760 /* Copy the input parameters into IDA memory block */
761
762 IDA_mem->ida_tn = t0;
763
764 /* Set forceSetup to SUNFALSE */
765
766 IDA_mem->ida_forceSetup = SUNFALSE;
767
768 /* Initialize the phi array */
769
770 N_VScale(ONE, yy0, IDA_mem->ida_phi[0]);
771 N_VScale(ONE, yp0, IDA_mem->ida_phi[1]);
772
773 /* Initialize all the counters and other optional output values */
774
775 IDA_mem->ida_nst = 0;
776 IDA_mem->ida_nre = 0;
777 IDA_mem->ida_ncfn = 0;
778 IDA_mem->ida_netf = 0;
779 IDA_mem->ida_nni = 0;
780 IDA_mem->ida_nsetups = 0;
781
782 IDA_mem->ida_kused = 0;
783 IDA_mem->ida_hused = ZERO;
784 IDA_mem->ida_tolsf = ONE;
785
786 IDA_mem->ida_nge = 0;
787
788 IDA_mem->ida_irfnd = 0;
789
790 /* Initial setup not done yet */
791
792 IDA_mem->ida_SetupDone = SUNFALSE;
793
794 /* Problem has been successfully re-initialized */
795
796 return(IDA_SUCCESS);
797 }
798
799 /*-----------------------------------------------------------------*/
800
801 /*
802 * IDASStolerances
803 * IDASVtolerances
804 * IDAWFtolerances
805 *
806 * These functions specify the integration tolerances. One of them
807 * MUST be called before the first call to IDA.
808 *
809 * IDASStolerances specifies scalar relative and absolute tolerances.
810 * IDASVtolerances specifies scalar relative tolerance and a vector
811 * absolute tolerance (a potentially different absolute tolerance
812 * for each vector component).
813 * IDAWFtolerances specifies a user-provides function (of type IDAEwtFn)
814 * which will be called to set the error weight vector.
815 */
816
IDASStolerances(void * ida_mem,realtype reltol,realtype abstol)817 int IDASStolerances(void *ida_mem, realtype reltol, realtype abstol)
818 {
819 IDAMem IDA_mem;
820
821 if (ida_mem==NULL) {
822 IDAProcessError(NULL, IDA_MEM_NULL, "IDAS", "IDASStolerances", MSG_NO_MEM);
823 return(IDA_MEM_NULL);
824 }
825 IDA_mem = (IDAMem) ida_mem;
826
827 if (IDA_mem->ida_MallocDone == SUNFALSE) {
828 IDAProcessError(IDA_mem, IDA_NO_MALLOC, "IDAS", "IDASStolerances", MSG_NO_MALLOC);
829 return(IDA_NO_MALLOC);
830 }
831
832 /* Check inputs */
833
834 if (reltol < ZERO) {
835 IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDASStolerances", MSG_BAD_RTOL);
836 return(IDA_ILL_INPUT);
837 }
838
839 if (abstol < ZERO) {
840 IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDASStolerances", MSG_BAD_ATOL);
841 return(IDA_ILL_INPUT);
842 }
843
844 /* Copy tolerances into memory */
845
846 IDA_mem->ida_rtol = reltol;
847 IDA_mem->ida_Satol = abstol;
848 IDA_mem->ida_atolmin0 = (abstol == ZERO);
849
850 IDA_mem->ida_itol = IDA_SS;
851
852 IDA_mem->ida_user_efun = SUNFALSE;
853 IDA_mem->ida_efun = IDAEwtSet;
854 IDA_mem->ida_edata = NULL; /* will be set to ida_mem in InitialSetup */
855
856 return(IDA_SUCCESS);
857 }
858
859
IDASVtolerances(void * ida_mem,realtype reltol,N_Vector abstol)860 int IDASVtolerances(void *ida_mem, realtype reltol, N_Vector abstol)
861 {
862 IDAMem IDA_mem;
863 realtype atolmin;
864
865 if (ida_mem==NULL) {
866 IDAProcessError(NULL, IDA_MEM_NULL, "IDAS", "IDASVtolerances", MSG_NO_MEM);
867 return(IDA_MEM_NULL);
868 }
869 IDA_mem = (IDAMem) ida_mem;
870
871 if (IDA_mem->ida_MallocDone == SUNFALSE) {
872 IDAProcessError(IDA_mem, IDA_NO_MALLOC, "IDAS", "IDASVtolerances", MSG_NO_MALLOC);
873 return(IDA_NO_MALLOC);
874 }
875
876 /* Check inputs */
877
878 if (reltol < ZERO) {
879 IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDASVtolerances", MSG_BAD_RTOL);
880 return(IDA_ILL_INPUT);
881 }
882
883 atolmin = N_VMin(abstol);
884 if (atolmin < ZERO) {
885 IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDASVtolerances", MSG_BAD_ATOL);
886 return(IDA_ILL_INPUT);
887 }
888
889 /* Copy tolerances into memory */
890
891 if ( !(IDA_mem->ida_VatolMallocDone) ) {
892 IDA_mem->ida_Vatol = N_VClone(IDA_mem->ida_ewt);
893 IDA_mem->ida_lrw += IDA_mem->ida_lrw1;
894 IDA_mem->ida_liw += IDA_mem->ida_liw1;
895 IDA_mem->ida_VatolMallocDone = SUNTRUE;
896 }
897
898 IDA_mem->ida_rtol = reltol;
899 N_VScale(ONE, abstol, IDA_mem->ida_Vatol);
900 IDA_mem->ida_atolmin0 = (atolmin == ZERO);
901
902 IDA_mem->ida_itol = IDA_SV;
903
904 IDA_mem->ida_user_efun = SUNFALSE;
905 IDA_mem->ida_efun = IDAEwtSet;
906 IDA_mem->ida_edata = NULL; /* will be set to ida_mem in InitialSetup */
907
908 return(IDA_SUCCESS);
909 }
910
911
IDAWFtolerances(void * ida_mem,IDAEwtFn efun)912 int IDAWFtolerances(void *ida_mem, IDAEwtFn efun)
913 {
914 IDAMem IDA_mem;
915
916 if (ida_mem==NULL) {
917 IDAProcessError(NULL, IDA_MEM_NULL, "IDAS", "IDAWFtolerances", MSG_NO_MEM);
918 return(IDA_MEM_NULL);
919 }
920 IDA_mem = (IDAMem) ida_mem;
921
922 if (IDA_mem->ida_MallocDone == SUNFALSE) {
923 IDAProcessError(IDA_mem, IDA_NO_MALLOC, "IDAS", "IDAWFtolerances", MSG_NO_MALLOC);
924 return(IDA_NO_MALLOC);
925 }
926
927 IDA_mem->ida_itol = IDA_WF;
928
929 IDA_mem->ida_user_efun = SUNTRUE;
930 IDA_mem->ida_efun = efun;
931 IDA_mem->ida_edata = NULL; /* will be set to user_data in InitialSetup */
932
933 return(IDA_SUCCESS);
934 }
935
936 /*-----------------------------------------------------------------*/
937
938 /*
939 * IDAQuadMalloc
940 *
941 * IDAQuadMalloc allocates and initializes quadrature related
942 * memory for a problem. All problem specification inputs are
943 * checked for errors. If any error occurs during initialization,
944 * it is reported to the file whose file pointer is errfp.
945 * The return value is IDA_SUCCESS = 0 if no errors occurred, or
946 * a negative value otherwise.
947 */
948
IDAQuadInit(void * ida_mem,IDAQuadRhsFn rhsQ,N_Vector yQ0)949 int IDAQuadInit(void *ida_mem, IDAQuadRhsFn rhsQ, N_Vector yQ0)
950 {
951 IDAMem IDA_mem;
952 booleantype allocOK;
953 sunindextype lrw1Q, liw1Q;
954 int retval;
955
956 /* Check ida_mem */
957 if (ida_mem==NULL) {
958 IDAProcessError(NULL, IDA_MEM_NULL, "IDAS", "IDAQuadInit", MSG_NO_MEM);
959 return(IDA_MEM_NULL);
960 }
961 IDA_mem = (IDAMem) ida_mem;
962
963 /* Set space requirements for one N_Vector */
964 N_VSpace(yQ0, &lrw1Q, &liw1Q);
965 IDA_mem->ida_lrw1Q = lrw1Q;
966 IDA_mem->ida_liw1Q = liw1Q;
967
968 /* Allocate the vectors (using yQ0 as a template) */
969 allocOK = IDAQuadAllocVectors(IDA_mem, yQ0);
970 if (!allocOK) {
971 IDAProcessError(IDA_mem, IDA_MEM_FAIL, "IDAS", "IDAQuadInit", MSG_MEM_FAIL);
972 return(IDA_MEM_FAIL);
973 }
974
975 /* Initialize phiQ in the history array */
976 N_VScale(ONE, yQ0, IDA_mem->ida_phiQ[0]);
977
978 retval = N_VConstVectorArray(IDA_mem->ida_maxord, ZERO, IDA_mem->ida_phiQ+1);
979 if (retval != IDA_SUCCESS) return (IDA_VECTOROP_ERR);
980
981 /* Copy the input parameters into IDAS state */
982 IDA_mem->ida_rhsQ = rhsQ;
983
984 /* Initialize counters */
985 IDA_mem->ida_nrQe = 0;
986 IDA_mem->ida_netfQ = 0;
987
988 /* Quadrature integration turned ON */
989 IDA_mem->ida_quadr = SUNTRUE;
990 IDA_mem->ida_quadMallocDone = SUNTRUE;
991
992 /* Quadrature initialization was successfull */
993 return(IDA_SUCCESS);
994 }
995
996 /*-----------------------------------------------------------------*/
997
998 /*
999 * IDAQuadReInit
1000 *
1001 * IDAQuadReInit re-initializes IDAS's quadrature related memory
1002 * for a problem, assuming it has already been allocated in prior
1003 * calls to IDAInit and IDAQuadMalloc.
1004 * All problem specification inputs are checked for errors.
1005 * If any error occurs during initialization, it is reported to the
1006 * file whose file pointer is errfp.
1007 * The return value is IDA_SUCCESS = 0 if no errors occurred, or
1008 * a negative value otherwise.
1009 */
1010
IDAQuadReInit(void * ida_mem,N_Vector yQ0)1011 int IDAQuadReInit(void *ida_mem, N_Vector yQ0)
1012 {
1013 IDAMem IDA_mem;
1014 int retval;
1015
1016 /* Check ida_mem */
1017 if (ida_mem==NULL) {
1018 IDAProcessError(NULL, IDA_MEM_NULL, "IDAS", "IDAQuadReInit", MSG_NO_MEM);
1019 return(IDA_MEM_NULL);
1020 }
1021 IDA_mem = (IDAMem) ida_mem;
1022
1023 /* Ckeck if quadrature was initialized */
1024 if (IDA_mem->ida_quadMallocDone == SUNFALSE) {
1025 IDAProcessError(IDA_mem, IDA_NO_QUAD, "IDAS", "IDAQuadReInit", MSG_NO_QUAD);
1026 return(IDA_NO_QUAD);
1027 }
1028
1029 /* Initialize phiQ in the history array */
1030 N_VScale(ONE, yQ0, IDA_mem->ida_phiQ[0]);
1031
1032 retval = N_VConstVectorArray(IDA_mem->ida_maxord, ZERO, IDA_mem->ida_phiQ+1);
1033 if (retval != IDA_SUCCESS) return (IDA_VECTOROP_ERR);
1034
1035 /* Initialize counters */
1036 IDA_mem->ida_nrQe = 0;
1037 IDA_mem->ida_netfQ = 0;
1038
1039 /* Quadrature integration turned ON */
1040 IDA_mem->ida_quadr = SUNTRUE;
1041
1042 /* Quadrature re-initialization was successfull */
1043 return(IDA_SUCCESS);
1044 }
1045
1046
1047 /*
1048 * IDAQuadSStolerances
1049 * IDAQuadSVtolerances
1050 *
1051 *
1052 * These functions specify the integration tolerances for quadrature
1053 * variables. One of them MUST be called before the first call to
1054 * IDA IF error control on the quadrature variables is enabled
1055 * (see IDASetQuadErrCon).
1056 *
1057 * IDASStolerances specifies scalar relative and absolute tolerances.
1058 * IDASVtolerances specifies scalar relative tolerance and a vector
1059 * absolute tolerance (a potentially different absolute tolerance
1060 * for each vector component).
1061 */
IDAQuadSStolerances(void * ida_mem,realtype reltolQ,realtype abstolQ)1062 int IDAQuadSStolerances(void *ida_mem, realtype reltolQ, realtype abstolQ)
1063 {
1064 IDAMem IDA_mem;
1065
1066 /*Check ida mem*/
1067 if (ida_mem==NULL) {
1068 IDAProcessError(NULL, IDA_MEM_NULL, "IDAS", "IDAQuadSStolerances", MSG_NO_MEM);
1069 return(IDA_MEM_NULL);
1070 }
1071 IDA_mem = (IDAMem) ida_mem;
1072
1073 /* Ckeck if quadrature was initialized */
1074 if (IDA_mem->ida_quadMallocDone == SUNFALSE) {
1075 IDAProcessError(IDA_mem, IDA_NO_QUAD, "IDAS", "IDAQuadSStolerances", MSG_NO_QUAD);
1076 return(IDA_NO_QUAD);
1077 }
1078
1079 /* Test user-supplied tolerances */
1080 if (reltolQ < ZERO) {
1081 IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDAQuadSStolerances", MSG_BAD_RTOLQ);
1082 return(IDA_ILL_INPUT);
1083 }
1084
1085 if (abstolQ < ZERO) {
1086 IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDAQuadSStolerances", MSG_BAD_ATOLQ);
1087 return(IDA_ILL_INPUT);
1088 }
1089
1090 /* Copy tolerances into memory */
1091 IDA_mem->ida_itolQ = IDA_SS;
1092
1093 IDA_mem->ida_rtolQ = reltolQ;
1094 IDA_mem->ida_SatolQ = abstolQ;
1095 IDA_mem->ida_atolQmin0 = (abstolQ == ZERO);
1096
1097
1098 return (IDA_SUCCESS);
1099 }
1100
IDAQuadSVtolerances(void * ida_mem,realtype reltolQ,N_Vector abstolQ)1101 int IDAQuadSVtolerances(void *ida_mem, realtype reltolQ, N_Vector abstolQ)
1102 {
1103 IDAMem IDA_mem;
1104 realtype atolmin;
1105
1106 /*Check ida mem*/
1107 if (ida_mem==NULL) {
1108 IDAProcessError(NULL, IDA_MEM_NULL, "IDAS", "IDAQuadSVtolerances", MSG_NO_MEM);
1109 return(IDA_MEM_NULL);
1110 }
1111 IDA_mem = (IDAMem) ida_mem;
1112
1113 /* Ckeck if quadrature was initialized */
1114 if (IDA_mem->ida_quadMallocDone == SUNFALSE) {
1115 IDAProcessError(IDA_mem, IDA_NO_QUAD, "IDAS", "IDAQuadSVtolerances", MSG_NO_QUAD);
1116 return(IDA_NO_QUAD);
1117 }
1118
1119 /* Test user-supplied tolerances */
1120 if (reltolQ < ZERO) {
1121 IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDAQuadSVtolerances", MSG_BAD_RTOLQ);
1122 return(IDA_ILL_INPUT);
1123 }
1124
1125 if (abstolQ == NULL) {
1126 IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDAQuadSVtolerances", MSG_NULL_ATOLQ);
1127 return(IDA_ILL_INPUT);
1128 }
1129
1130 atolmin = N_VMin(abstolQ);
1131 if (atolmin < ZERO) {
1132 IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDAQuadSVtolerances", MSG_BAD_ATOLQ);
1133 return(IDA_ILL_INPUT);
1134 }
1135
1136 /* Copy tolerances into memory */
1137 IDA_mem->ida_itolQ = IDA_SV;
1138 IDA_mem->ida_rtolQ = reltolQ;
1139
1140 /* clone the absolute tolerances vector (if necessary) */
1141 if (SUNFALSE == IDA_mem->ida_VatolQMallocDone) {
1142 IDA_mem->ida_VatolQ = N_VClone(abstolQ);
1143 IDA_mem->ida_lrw += IDA_mem->ida_lrw1Q;
1144 IDA_mem->ida_liw += IDA_mem->ida_liw1Q;
1145 IDA_mem->ida_VatolQMallocDone = SUNTRUE;
1146 }
1147
1148 N_VScale(ONE, abstolQ, IDA_mem->ida_VatolQ);
1149 IDA_mem->ida_atolQmin0 = (atolmin == ZERO);
1150
1151 return(IDA_SUCCESS);
1152 }
1153
1154 /*
1155 * IDASenMalloc
1156 *
1157 * IDASensInit allocates and initializes sensitivity related
1158 * memory for a problem. All problem specification inputs are
1159 * checked for errors. If any error occurs during initialization,
1160 * it is reported to the file whose file pointer is errfp.
1161 * The return value is IDA_SUCCESS = 0 if no errors occurred, or
1162 * a negative value otherwise.
1163 */
1164
IDASensInit(void * ida_mem,int Ns,int ism,IDASensResFn fS,N_Vector * yS0,N_Vector * ypS0)1165 int IDASensInit(void *ida_mem, int Ns, int ism,
1166 IDASensResFn fS,
1167 N_Vector *yS0, N_Vector *ypS0)
1168
1169 {
1170 IDAMem IDA_mem;
1171 booleantype allocOK;
1172 int is, retval;
1173 SUNNonlinearSolver NLS;
1174
1175 /* Check ida_mem */
1176 if (ida_mem==NULL) {
1177 IDAProcessError(NULL, IDA_MEM_NULL, "IDAS", "IDASensInit", MSG_NO_MEM);
1178 return(IDA_MEM_NULL);
1179 }
1180 IDA_mem = (IDAMem) ida_mem;
1181
1182 /* Check if Ns is legal */
1183 if (Ns<=0) {
1184 IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDASensInit", MSG_BAD_NS);
1185 return(IDA_ILL_INPUT);
1186 }
1187 IDA_mem->ida_Ns = Ns;
1188
1189 /* Check if ism is legal */
1190 if ((ism!=IDA_SIMULTANEOUS) && (ism!=IDA_STAGGERED)) {
1191 IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDASensInit", MSG_BAD_ISM);
1192 return(IDA_ILL_INPUT);
1193 }
1194 IDA_mem->ida_ism = ism;
1195
1196 /* Check if yS0 and ypS0 are non-null */
1197 if (yS0 == NULL) {
1198 IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDASensInit", MSG_NULL_YYS0);
1199 return(IDA_ILL_INPUT);
1200 }
1201 if (ypS0 == NULL) {
1202 IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDASensInit", MSG_NULL_YPS0);
1203 return(IDA_ILL_INPUT);
1204 }
1205
1206 /* Store sensitivity RHS-related data */
1207
1208 if (fS != NULL) {
1209 IDA_mem->ida_resS = fS;
1210 IDA_mem->ida_user_dataS = IDA_mem->ida_user_data;
1211 IDA_mem->ida_resSDQ = SUNFALSE;
1212 } else {
1213 IDA_mem->ida_resS = IDASensResDQ;
1214 IDA_mem->ida_user_dataS = ida_mem;
1215 IDA_mem->ida_resSDQ = SUNTRUE;
1216 }
1217
1218 /* Allocate the vectors (using yS0[0] as a template) */
1219
1220 allocOK = IDASensAllocVectors(IDA_mem, yS0[0]);
1221 if (!allocOK) {
1222 IDAProcessError(IDA_mem, IDA_MEM_FAIL, "IDAS", "IDASensInit", MSG_MEM_FAIL);
1223 return(IDA_MEM_FAIL);
1224 }
1225
1226 /* Allocate temporary work arrays for fused vector ops */
1227 if (Ns*MXORDP1 > MXORDP1) {
1228 free(IDA_mem->ida_cvals); IDA_mem->ida_cvals = NULL;
1229 free(IDA_mem->ida_Xvecs); IDA_mem->ida_Xvecs = NULL;
1230 free(IDA_mem->ida_Zvecs); IDA_mem->ida_Zvecs = NULL;
1231
1232 IDA_mem->ida_cvals = (realtype *) malloc((Ns*MXORDP1)*sizeof(realtype));
1233 IDA_mem->ida_Xvecs = (N_Vector *) malloc((Ns*MXORDP1)*sizeof(N_Vector));
1234 IDA_mem->ida_Zvecs = (N_Vector *) malloc((Ns*MXORDP1)*sizeof(N_Vector));
1235
1236 if ((IDA_mem->ida_cvals == NULL) ||
1237 (IDA_mem->ida_Xvecs == NULL) ||
1238 (IDA_mem->ida_Zvecs == NULL)) {
1239 IDASensFreeVectors(IDA_mem);
1240 IDAProcessError(IDA_mem, IDA_MEM_FAIL, "IDAS", "IDASensInit", MSG_MEM_FAIL);
1241 return(IDA_MEM_FAIL);
1242 }
1243 }
1244
1245 /*----------------------------------------------
1246 All error checking is complete at this point
1247 -----------------------------------------------*/
1248
1249 /* Initialize the phiS array */
1250 for (is=0; is<Ns; is++)
1251 IDA_mem->ida_cvals[is] = ONE;
1252
1253 retval = N_VScaleVectorArray(Ns, IDA_mem->ida_cvals, yS0, IDA_mem->ida_phiS[0]);
1254 if (retval != IDA_SUCCESS) return (IDA_VECTOROP_ERR);
1255
1256 retval = N_VScaleVectorArray(Ns, IDA_mem->ida_cvals, ypS0, IDA_mem->ida_phiS[1]);
1257 if (retval != IDA_SUCCESS) return (IDA_VECTOROP_ERR);
1258
1259 /* Initialize all sensitivity related counters */
1260 IDA_mem->ida_nrSe = 0;
1261 IDA_mem->ida_nreS = 0;
1262 IDA_mem->ida_ncfnS = 0;
1263 IDA_mem->ida_netfS = 0;
1264 IDA_mem->ida_nniS = 0;
1265 IDA_mem->ida_nsetupsS = 0;
1266
1267 /* Set default values for plist and pbar */
1268 for (is=0; is<Ns; is++) {
1269 IDA_mem->ida_plist[is] = is;
1270 IDA_mem->ida_pbar[is] = ONE;
1271 }
1272
1273 /* Sensitivities will be computed */
1274 IDA_mem->ida_sensi = SUNTRUE;
1275 IDA_mem->ida_sensMallocDone = SUNTRUE;
1276
1277 /* create a Newton nonlinear solver object by default */
1278 if (ism == IDA_SIMULTANEOUS)
1279 NLS = SUNNonlinSol_NewtonSens(Ns+1, IDA_mem->ida_delta);
1280 else
1281 NLS = SUNNonlinSol_NewtonSens(Ns, IDA_mem->ida_delta);
1282
1283 /* check that the nonlinear solver is non-NULL */
1284 if (NLS == NULL) {
1285 IDAProcessError(IDA_mem, IDA_MEM_FAIL, "IDAS", "IDASensInit", MSG_MEM_FAIL);
1286 IDASensFreeVectors(IDA_mem);
1287 return(IDA_MEM_FAIL);
1288 }
1289
1290 /* attach the nonlinear solver to the IDA memory */
1291 if (ism == IDA_SIMULTANEOUS)
1292 retval = IDASetNonlinearSolverSensSim(IDA_mem, NLS);
1293 else
1294 retval = IDASetNonlinearSolverSensStg(IDA_mem, NLS);
1295
1296 /* check that the nonlinear solver was successfully attached */
1297 if (retval != IDA_SUCCESS) {
1298 IDAProcessError(IDA_mem, retval, "IDAS", "IDASensInit",
1299 "Setting the nonlinear solver failed");
1300 IDASensFreeVectors(IDA_mem);
1301 SUNNonlinSolFree(NLS);
1302 return(IDA_MEM_FAIL);
1303 }
1304
1305 /* set ownership flag */
1306 if (ism == IDA_SIMULTANEOUS)
1307 IDA_mem->ownNLSsim = SUNTRUE;
1308 else
1309 IDA_mem->ownNLSstg = SUNTRUE;
1310
1311 /* Sensitivity initialization was successfull */
1312 return(IDA_SUCCESS);
1313 }
1314
1315 /*-----------------------------------------------------------------*/
1316
1317 /*
1318 * IDASensReInit
1319 *
1320 * IDASensReInit re-initializes IDAS's sensitivity related memory
1321 * for a problem, assuming it has already been allocated in prior
1322 * calls to IDAInit and IDASensInit.
1323 * All problem specification inputs are checked for errors.
1324 * The number of sensitivities Ns is assumed to be unchanged since
1325 * the previous call to IDASensInit.
1326 * If any error occurs during initialization, it is reported to the
1327 * file whose file pointer is errfp.
1328 * The return value is IDA_SUCCESS = 0 if no errors occurred, or
1329 * a negative value otherwise.
1330 */
1331
IDASensReInit(void * ida_mem,int ism,N_Vector * yS0,N_Vector * ypS0)1332 int IDASensReInit(void *ida_mem, int ism, N_Vector *yS0, N_Vector *ypS0)
1333 {
1334 IDAMem IDA_mem;
1335 int is, retval;
1336 SUNNonlinearSolver NLS;
1337
1338 /* Check ida_mem */
1339 if (ida_mem==NULL) {
1340 IDAProcessError(NULL, IDA_MEM_NULL, "IDAS",
1341 "IDASensReInit", MSG_NO_MEM);
1342 return(IDA_MEM_NULL);
1343 }
1344 IDA_mem = (IDAMem) ida_mem;
1345
1346 /* Was sensitivity initialized? */
1347 if (IDA_mem->ida_sensMallocDone == SUNFALSE) {
1348 IDAProcessError(IDA_mem, IDA_NO_SENS, "IDAS",
1349 "IDASensReInit", MSG_NO_SENSI);
1350 return(IDA_NO_SENS);
1351 }
1352
1353 /* Check if ism is legal */
1354 if ((ism!=IDA_SIMULTANEOUS) && (ism!=IDA_STAGGERED)) {
1355 IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS",
1356 "IDASensReInit", MSG_BAD_ISM);
1357 return(IDA_ILL_INPUT);
1358 }
1359 IDA_mem->ida_ism = ism;
1360
1361 /* Check if yS0 and ypS0 are non-null */
1362 if (yS0 == NULL) {
1363 IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS",
1364 "IDASensReInit", MSG_NULL_YYS0);
1365 return(IDA_ILL_INPUT);
1366 }
1367 if (ypS0 == NULL) {
1368 IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS",
1369 "IDASensReInit", MSG_NULL_YPS0);
1370 return(IDA_ILL_INPUT);
1371 }
1372
1373 /*-----------------------------------------------
1374 All error checking is complete at this point
1375 -----------------------------------------------*/
1376
1377 /* Initialize the phiS array */
1378 for (is=0; is<IDA_mem->ida_Ns; is++)
1379 IDA_mem->ida_cvals[is] = ONE;
1380
1381 retval = N_VScaleVectorArray(IDA_mem->ida_Ns, IDA_mem->ida_cvals,
1382 yS0, IDA_mem->ida_phiS[0]);
1383 if (retval != IDA_SUCCESS) return (IDA_VECTOROP_ERR);
1384
1385 retval = N_VScaleVectorArray(IDA_mem->ida_Ns, IDA_mem->ida_cvals,
1386 ypS0, IDA_mem->ida_phiS[1]);
1387 if (retval != IDA_SUCCESS) return (IDA_VECTOROP_ERR);
1388
1389 /* Initialize all sensitivity related counters */
1390 IDA_mem->ida_nrSe = 0;
1391 IDA_mem->ida_nreS = 0;
1392 IDA_mem->ida_ncfnS = 0;
1393 IDA_mem->ida_netfS = 0;
1394 IDA_mem->ida_nniS = 0;
1395 IDA_mem->ida_nsetupsS = 0;
1396
1397 /* Set default values for plist and pbar */
1398 for (is=0; is<IDA_mem->ida_Ns; is++) {
1399 IDA_mem->ida_plist[is] = is;
1400 IDA_mem->ida_pbar[is] = ONE;
1401 }
1402
1403 /* Sensitivities will be computed */
1404 IDA_mem->ida_sensi = SUNTRUE;
1405
1406 /* Check if the NLS exists, create the default NLS if needed */
1407 if ((ism == IDA_SIMULTANEOUS && IDA_mem->NLSsim == NULL) ||
1408 (ism == IDA_STAGGERED && IDA_mem->NLSstg == NULL)) {
1409
1410 /* create a Newton nonlinear solver object by default */
1411 if (ism == IDA_SIMULTANEOUS)
1412 NLS = SUNNonlinSol_NewtonSens(IDA_mem->ida_Ns+1, IDA_mem->ida_delta);
1413 else
1414 NLS = SUNNonlinSol_NewtonSens(IDA_mem->ida_Ns, IDA_mem->ida_delta);
1415
1416 /* check that the nonlinear solver is non-NULL */
1417 if (NLS == NULL) {
1418 IDAProcessError(IDA_mem, IDA_MEM_FAIL, "IDAS",
1419 "IDASensReInit", MSG_MEM_FAIL);
1420 return(IDA_MEM_FAIL);
1421 }
1422
1423 /* attach the nonlinear solver to the IDA memory */
1424 if (ism == IDA_SIMULTANEOUS)
1425 retval = IDASetNonlinearSolverSensSim(IDA_mem, NLS);
1426 else
1427 retval = IDASetNonlinearSolverSensStg(IDA_mem, NLS);
1428
1429 /* check that the nonlinear solver was successfully attached */
1430 if (retval != IDA_SUCCESS) {
1431 IDAProcessError(IDA_mem, retval, "IDAS", "IDASensReInit",
1432 "Setting the nonlinear solver failed");
1433 SUNNonlinSolFree(NLS);
1434 return(IDA_MEM_FAIL);
1435 }
1436
1437 /* set ownership flag */
1438 if (ism == IDA_SIMULTANEOUS)
1439 IDA_mem->ownNLSsim = SUNTRUE;
1440 else
1441 IDA_mem->ownNLSstg = SUNTRUE;
1442
1443 /* initialize the NLS object, this assumes that the linear solver has
1444 already been initialized in IDAInit */
1445 if (ism == IDA_SIMULTANEOUS)
1446 retval = idaNlsInitSensSim(IDA_mem);
1447 else
1448 retval = idaNlsInitSensStg(IDA_mem);
1449
1450 if (retval != IDA_SUCCESS) {
1451 IDAProcessError(IDA_mem, IDA_NLS_INIT_FAIL, "IDAS",
1452 "IDASensReInit", MSG_NLS_INIT_FAIL);
1453 return(IDA_NLS_INIT_FAIL);
1454 }
1455 }
1456
1457 /* Sensitivity re-initialization was successfull */
1458 return(IDA_SUCCESS);
1459 }
1460
1461 /*-----------------------------------------------------------------*/
1462
1463 /*
1464 * IDASensSStolerances
1465 * IDASensSVtolerances
1466 * IDASensEEtolerances
1467 *
1468 * These functions specify the integration tolerances for sensitivity
1469 * variables. One of them MUST be called before the first call to IDASolve.
1470 *
1471 * IDASensSStolerances specifies scalar relative and absolute tolerances.
1472 * IDASensSVtolerances specifies scalar relative tolerance and a vector
1473 * absolute tolerance for each sensitivity vector (a potentially different
1474 * absolute tolerance for each vector component).
1475 * IDASensEEtolerances specifies that tolerances for sensitivity variables
1476 * should be estimated from those provided for the state variables.
1477 */
1478
1479
IDASensSStolerances(void * ida_mem,realtype reltolS,realtype * abstolS)1480 int IDASensSStolerances(void *ida_mem, realtype reltolS, realtype *abstolS)
1481 {
1482 IDAMem IDA_mem;
1483 int is;
1484
1485 /* Check ida_mem pointer */
1486 if (ida_mem == NULL) {
1487 IDAProcessError(NULL, IDA_MEM_NULL, "IDAS", "IDASensSStolerances", MSG_NO_MEM);
1488 return(IDA_MEM_NULL);
1489 }
1490 IDA_mem = (IDAMem) ida_mem;
1491
1492 /* Was sensitivity initialized? */
1493
1494 if (IDA_mem->ida_sensMallocDone == SUNFALSE) {
1495 IDAProcessError(IDA_mem, IDA_NO_SENS, "IDAS", "IDASensSStolerances", MSG_NO_SENSI);
1496 return(IDA_NO_SENS);
1497 }
1498
1499 /* Test user-supplied tolerances */
1500
1501 if (reltolS < ZERO) {
1502 IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDASensSStolerances", MSG_BAD_RTOLS);
1503 return(IDA_ILL_INPUT);
1504 }
1505
1506 if (abstolS == NULL) {
1507 IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDASensSStolerances", MSG_NULL_ATOLS);
1508 return(IDA_ILL_INPUT);
1509 }
1510
1511 for (is=0; is<IDA_mem->ida_Ns; is++)
1512 if (abstolS[is] < ZERO) {
1513 IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDASensSStolerances", MSG_BAD_ATOLS);
1514 return(IDA_ILL_INPUT);
1515 }
1516
1517 /* Copy tolerances into memory */
1518
1519 IDA_mem->ida_itolS = IDA_SS;
1520
1521 IDA_mem->ida_rtolS = reltolS;
1522
1523 if ( !(IDA_mem->ida_SatolSMallocDone) ) {
1524 IDA_mem->ida_SatolS = NULL;
1525 IDA_mem->ida_SatolS = (realtype *)malloc(IDA_mem->ida_Ns*sizeof(realtype));
1526 IDA_mem->ida_atolSmin0 = (booleantype *)malloc(IDA_mem->ida_Ns*sizeof(booleantype));
1527 IDA_mem->ida_lrw += IDA_mem->ida_Ns;
1528 IDA_mem->ida_SatolSMallocDone = SUNTRUE;
1529 }
1530
1531 for (is=0; is<IDA_mem->ida_Ns; is++) {
1532 IDA_mem->ida_SatolS[is] = abstolS[is];
1533 IDA_mem->ida_atolSmin0[is] = (abstolS[is] == ZERO);
1534 }
1535
1536 return(IDA_SUCCESS);
1537 }
1538
1539
IDASensSVtolerances(void * ida_mem,realtype reltolS,N_Vector * abstolS)1540 int IDASensSVtolerances(void *ida_mem, realtype reltolS, N_Vector *abstolS)
1541 {
1542 IDAMem IDA_mem;
1543 int is, retval;
1544 realtype *atolmin;
1545
1546 /* Check ida_mem pointer */
1547 if (ida_mem == NULL) {
1548 IDAProcessError(NULL, IDA_MEM_NULL, "IDAS", "IDASensSVtolerances", MSG_NO_MEM);
1549 return(IDA_MEM_NULL);
1550 }
1551 IDA_mem = (IDAMem) ida_mem;
1552
1553 /* Was sensitivity initialized? */
1554
1555 if (IDA_mem->ida_sensMallocDone == SUNFALSE) {
1556 IDAProcessError(IDA_mem, IDA_NO_SENS, "IDAS", "IDASensSVtolerances", MSG_NO_SENSI);
1557 return(IDA_NO_SENS);
1558 }
1559
1560 /* Test user-supplied tolerances */
1561
1562 if (reltolS < ZERO) {
1563 IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDASensSVtolerances", MSG_BAD_RTOLS);
1564 return(IDA_ILL_INPUT);
1565 }
1566
1567 if (abstolS == NULL) {
1568 IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDASensSVtolerances", MSG_NULL_ATOLS);
1569 return(IDA_ILL_INPUT);
1570 }
1571
1572 atolmin = (realtype *)malloc(IDA_mem->ida_Ns*sizeof(realtype));
1573 for (is=0; is<IDA_mem->ida_Ns; is++) {
1574 atolmin[is] = N_VMin(abstolS[is]);
1575 if (atolmin[is] < ZERO) {
1576 IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDASensSStolerances", MSG_BAD_ATOLS);
1577 free(atolmin);
1578 return(IDA_ILL_INPUT);
1579 }
1580 }
1581
1582 IDA_mem->ida_itolS = IDA_SV;
1583 IDA_mem->ida_rtolS = reltolS ;
1584
1585 if ( SUNFALSE == IDA_mem->ida_VatolSMallocDone ) {
1586 IDA_mem->ida_VatolS = N_VCloneVectorArray(IDA_mem->ida_Ns, IDA_mem->ida_tempv1);
1587 IDA_mem->ida_atolSmin0 = (booleantype *)malloc(IDA_mem->ida_Ns*sizeof(booleantype));
1588 IDA_mem->ida_lrw += IDA_mem->ida_Ns*IDA_mem->ida_lrw1;
1589 IDA_mem->ida_liw += IDA_mem->ida_Ns*IDA_mem->ida_liw1;
1590 IDA_mem->ida_VatolSMallocDone = SUNTRUE;
1591 }
1592
1593 for (is=0; is<IDA_mem->ida_Ns; is++) {
1594 IDA_mem->ida_cvals[is] = ONE;
1595 IDA_mem->ida_atolSmin0[is] = (atolmin[is] == ZERO);
1596 }
1597 free(atolmin);
1598
1599 retval = N_VScaleVectorArray(IDA_mem->ida_Ns, IDA_mem->ida_cvals,
1600 abstolS, IDA_mem->ida_VatolS);
1601 if (retval != IDA_SUCCESS) return (IDA_VECTOROP_ERR);
1602
1603 return(IDA_SUCCESS);
1604 }
1605
IDASensEEtolerances(void * ida_mem)1606 int IDASensEEtolerances(void *ida_mem)
1607 {
1608 IDAMem IDA_mem;
1609
1610 if (ida_mem==NULL) {
1611 IDAProcessError(NULL, IDA_MEM_NULL, "IDAS", "IDASensEEtolerances", MSG_NO_MEM);
1612 return(IDA_MEM_NULL);
1613 }
1614 IDA_mem = (IDAMem) ida_mem;
1615
1616 /* Was sensitivity initialized? */
1617
1618 if (IDA_mem->ida_sensMallocDone == SUNFALSE) {
1619 IDAProcessError(IDA_mem, IDA_NO_SENS, "IDAS", "IDASensEEtolerances", MSG_NO_SENSI);
1620 return(IDA_NO_SENS);
1621 }
1622
1623 IDA_mem->ida_itolS = IDA_EE;
1624
1625 return(IDA_SUCCESS);
1626 }
1627
1628
IDAQuadSensInit(void * ida_mem,IDAQuadSensRhsFn rhsQS,N_Vector * yQS0)1629 int IDAQuadSensInit(void *ida_mem, IDAQuadSensRhsFn rhsQS, N_Vector *yQS0)
1630 {
1631 IDAMem IDA_mem;
1632 booleantype allocOK;
1633 int is, retval;
1634
1635 if (ida_mem==NULL) {
1636 IDAProcessError(NULL, IDA_MEM_NULL, "IDAS", "IDAQuadSensInit", MSG_NO_MEM);
1637 return(IDA_MEM_NULL);
1638 }
1639 IDA_mem = (IDAMem) ida_mem;
1640
1641 /* Check if sensitivity analysis is active */
1642 if (!IDA_mem->ida_sensi) {
1643 IDAProcessError(NULL, IDA_NO_SENS, "IDAS", "IDAQuadSensInit", MSG_NO_SENSI);
1644 return(IDA_NO_SENS);
1645 }
1646
1647 /* Verifiy yQS0 parameter. */
1648 if (yQS0==NULL) {
1649 IDAProcessError(NULL, IDA_ILL_INPUT, "IDAS", "IDAQuadSensInit", MSG_NULL_YQS0);
1650 return(IDA_ILL_INPUT);
1651 }
1652
1653 /* Allocate vector needed for quadratures' sensitivities. */
1654 allocOK = IDAQuadSensAllocVectors(IDA_mem, yQS0[0]);
1655 if (!allocOK) {
1656 IDAProcessError(NULL, IDA_MEM_FAIL, "IDAS", "IDAQuadSensInit", MSG_MEM_FAIL);
1657 return(IDA_MEM_FAIL);
1658 }
1659
1660 /* Error checking complete. */
1661 if (rhsQS == NULL) {
1662 IDA_mem->ida_rhsQSDQ = SUNTRUE;
1663 IDA_mem->ida_rhsQS = IDAQuadSensRhsInternalDQ;
1664
1665 IDA_mem->ida_user_dataQS = ida_mem;
1666 } else {
1667 IDA_mem->ida_rhsQSDQ = SUNFALSE;
1668 IDA_mem->ida_rhsQS = rhsQS;
1669
1670 IDA_mem->ida_user_dataQS = IDA_mem->ida_user_data;
1671 }
1672
1673 /* Initialize phiQS[0] in the history array */
1674 for (is=0; is<IDA_mem->ida_Ns; is++)
1675 IDA_mem->ida_cvals[is] = ONE;
1676
1677 retval = N_VScaleVectorArray(IDA_mem->ida_Ns, IDA_mem->ida_cvals,
1678 yQS0, IDA_mem->ida_phiQS[0]);
1679 if (retval != IDA_SUCCESS) return (IDA_VECTOROP_ERR);
1680
1681 /* Initialize all sensitivities related counters. */
1682 IDA_mem->ida_nrQSe = 0;
1683 IDA_mem->ida_nrQeS = 0;
1684 IDA_mem->ida_netfQS = 0;
1685
1686 /* Everything allright, set the flags and return with success. */
1687 IDA_mem->ida_quadr_sensi = SUNTRUE;
1688 IDA_mem->ida_quadSensMallocDone = SUNTRUE;
1689
1690 return(IDA_SUCCESS);
1691 }
1692
IDAQuadSensReInit(void * ida_mem,N_Vector * yQS0)1693 int IDAQuadSensReInit(void *ida_mem, N_Vector *yQS0)
1694 {
1695 IDAMem IDA_mem;
1696 int is, retval;
1697
1698 if (ida_mem==NULL) {
1699 IDAProcessError(NULL, IDA_MEM_NULL, "IDAS", "IDAQuadSensReInit", MSG_NO_MEM);
1700 return(IDA_MEM_NULL);
1701 }
1702 IDA_mem = (IDAMem) ida_mem;
1703
1704 /* Check if sensitivity analysis is active */
1705 if (!IDA_mem->ida_sensi) {
1706 IDAProcessError(IDA_mem, IDA_NO_SENS, "IDAS", "IDAQuadSensReInit", MSG_NO_SENSI);
1707 return(IDA_NO_SENS);
1708 }
1709
1710 /* Was sensitivity for quadrature already initialized? */
1711 if (!IDA_mem->ida_quadSensMallocDone) {
1712 IDAProcessError(IDA_mem, IDA_NO_QUADSENS, "IDAS", "IDAQuadSensReInit", MSG_NO_QUADSENSI);
1713 return(IDA_NO_QUADSENS);
1714 }
1715
1716 /* Verifiy yQS0 parameter. */
1717 if (yQS0==NULL) {
1718 IDAProcessError(NULL, IDA_ILL_INPUT, "IDAS", "IDAQuadSensReInit", MSG_NULL_YQS0);
1719 return(IDA_ILL_INPUT);
1720 }
1721
1722 /* Error checking complete at this point. */
1723
1724 /* Initialize phiQS[0] in the history array */
1725 for (is=0; is<IDA_mem->ida_Ns; is++)
1726 IDA_mem->ida_cvals[is] = ONE;
1727
1728 retval = N_VScaleVectorArray(IDA_mem->ida_Ns, IDA_mem->ida_cvals,
1729 yQS0, IDA_mem->ida_phiQS[0]);
1730 if (retval != IDA_SUCCESS) return (IDA_VECTOROP_ERR);
1731
1732 /* Initialize all sensitivities related counters. */
1733 IDA_mem->ida_nrQSe = 0;
1734 IDA_mem->ida_nrQeS = 0;
1735 IDA_mem->ida_netfQS = 0;
1736
1737 /* Everything allright, set the flags and return with success. */
1738 IDA_mem->ida_quadr_sensi = SUNTRUE;
1739
1740 return(IDA_SUCCESS);
1741 }
1742
1743 /*
1744 * IDAQuadSensSStolerances
1745 * IDAQuadSensSVtolerances
1746 * IDAQuadSensEEtolerances
1747 *
1748 * These functions specify the integration tolerances for quadrature
1749 * sensitivity variables. One of them MUST be called before the first
1750 * call to IDAS IF these variables are included in the error test.
1751 *
1752 * IDAQuadSensSStolerances specifies scalar relative and absolute tolerances.
1753 * IDAQuadSensSVtolerances specifies scalar relative tolerance and a vector
1754 * absolute tolerance for each quadrature sensitivity vector (a potentially
1755 * different absolute tolerance for each vector component).
1756 * IDAQuadSensEEtolerances specifies that tolerances for sensitivity variables
1757 * should be estimated from those provided for the quadrature variables.
1758 * In this case, tolerances for the quadrature variables must be
1759 * specified through a call to one of IDAQuad**tolerances.
1760 */
1761
IDAQuadSensSStolerances(void * ida_mem,realtype reltolQS,realtype * abstolQS)1762 int IDAQuadSensSStolerances(void *ida_mem, realtype reltolQS, realtype *abstolQS)
1763 {
1764 IDAMem IDA_mem;
1765 int is;
1766
1767 if (ida_mem==NULL) {
1768 IDAProcessError(NULL, IDA_MEM_NULL, "IDAS", "IDAQuadSensSStolerances", MSG_NO_MEM);
1769 return(IDA_MEM_NULL);
1770 }
1771 IDA_mem = (IDAMem) ida_mem;
1772
1773 /* Check if sensitivity analysis is active */
1774 if (!IDA_mem->ida_sensi) {
1775 IDAProcessError(IDA_mem, IDA_NO_SENS, "IDAS", "IDAQuadSensSStolerances", MSG_NO_SENSI);
1776 return(IDA_NO_SENS);
1777 }
1778
1779 /* Was sensitivity for quadrature already initialized? */
1780 if (!IDA_mem->ida_quadSensMallocDone) {
1781 IDAProcessError(IDA_mem, IDA_NO_QUADSENS, "IDAS", "IDAQuadSensSStolerances", MSG_NO_QUADSENSI);
1782 return(IDA_NO_QUADSENS);
1783 }
1784
1785 /* Test user-supplied tolerances */
1786
1787 if (reltolQS < ZERO) {
1788 IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDAQuadSensSStolerances", MSG_BAD_RELTOLQS);
1789 return(IDA_ILL_INPUT);
1790 }
1791
1792 if (abstolQS == NULL) {
1793 IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDAQuadSensSStolerances", MSG_NULL_ABSTOLQS);
1794 return(IDA_ILL_INPUT);
1795 }
1796
1797 for (is=0; is<IDA_mem->ida_Ns; is++)
1798 if (abstolQS[is] < ZERO) {
1799 IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDAQuadSensSStolerances", MSG_BAD_ABSTOLQS);
1800 return(IDA_ILL_INPUT);
1801 }
1802
1803 /* Save data. */
1804 IDA_mem->ida_itolQS = IDA_SS;
1805 IDA_mem->ida_rtolQS = reltolQS;
1806
1807 if ( !(IDA_mem->ida_SatolQSMallocDone) ) {
1808 IDA_mem->ida_SatolQS = (realtype *)malloc(IDA_mem->ida_Ns*sizeof(realtype));
1809 IDA_mem->ida_atolQSmin0 = (booleantype *)malloc(IDA_mem->ida_Ns*sizeof(booleantype));
1810 IDA_mem->ida_lrw += IDA_mem->ida_Ns;
1811 IDA_mem->ida_SatolQSMallocDone = SUNTRUE;
1812 }
1813
1814 for (is=0; is<IDA_mem->ida_Ns; is++) {
1815 IDA_mem->ida_SatolQS[is] = abstolQS[is];
1816 IDA_mem->ida_atolQSmin0[is] = (abstolQS[is] == ZERO);
1817 }
1818
1819 return(IDA_SUCCESS);
1820 }
1821
IDAQuadSensSVtolerances(void * ida_mem,realtype reltolQS,N_Vector * abstolQS)1822 int IDAQuadSensSVtolerances(void *ida_mem, realtype reltolQS, N_Vector *abstolQS)
1823 {
1824 IDAMem IDA_mem;
1825 int is, retval;
1826 realtype *atolmin;
1827
1828 if (ida_mem==NULL) {
1829 IDAProcessError(NULL, IDA_MEM_NULL, "IDAS", "IDAQuadSensSVtolerances", MSG_NO_MEM);
1830 return(IDA_MEM_NULL);
1831 }
1832 IDA_mem = (IDAMem) ida_mem;
1833
1834 /* Check if sensitivity analysis is active */
1835 if (!IDA_mem->ida_sensi) {
1836 IDAProcessError(IDA_mem, IDA_NO_SENS, "IDAS", "IDAQuadSensSVtolerances", MSG_NO_SENSI);
1837 return(IDA_NO_SENS);
1838 }
1839
1840 /* Was sensitivity for quadrature already initialized? */
1841 if (!IDA_mem->ida_quadSensMallocDone) {
1842 IDAProcessError(IDA_mem, IDA_NO_QUADSENS, "IDAS", "IDAQuadSensSVtolerances", MSG_NO_QUADSENSI);
1843 return(IDA_NO_QUADSENS);
1844 }
1845
1846 /* Test user-supplied tolerances */
1847
1848 if (reltolQS < ZERO) {
1849 IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDAQuadSensSVtolerances", MSG_BAD_RELTOLQS);
1850 return(IDA_ILL_INPUT);
1851 }
1852
1853 if (abstolQS == NULL) {
1854 IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDAQuadSensSVtolerances", MSG_NULL_ABSTOLQS);
1855 return(IDA_ILL_INPUT);
1856 }
1857
1858 atolmin = (realtype *)malloc(IDA_mem->ida_Ns*sizeof(realtype));
1859 for (is=0; is<IDA_mem->ida_Ns; is++) {
1860 atolmin[is] = N_VMin(abstolQS[is]);
1861 if (atolmin[is] < ZERO) {
1862 IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDAQuadSensSVtolerances", MSG_BAD_ABSTOLQS);
1863 free(atolmin);
1864 return(IDA_ILL_INPUT);
1865 }
1866 }
1867
1868 /* Save data. */
1869 IDA_mem->ida_itolQS = IDA_SV;
1870 IDA_mem->ida_rtolQS = reltolQS;
1871
1872 if ( !(IDA_mem->ida_VatolQSMallocDone) ) {
1873 IDA_mem->ida_VatolQS = N_VCloneVectorArray(IDA_mem->ida_Ns, abstolQS[0]);
1874 IDA_mem->ida_atolQSmin0 = (booleantype *)malloc(IDA_mem->ida_Ns*sizeof(booleantype));
1875 IDA_mem->ida_lrw += IDA_mem->ida_Ns*IDA_mem->ida_lrw1Q;
1876 IDA_mem->ida_liw += IDA_mem->ida_Ns*IDA_mem->ida_liw1Q;
1877 IDA_mem->ida_VatolQSMallocDone = SUNTRUE;
1878 }
1879
1880 for (is=0; is<IDA_mem->ida_Ns; is++) {
1881 IDA_mem->ida_cvals[is] = ONE;
1882 IDA_mem->ida_atolQSmin0[is] = (atolmin[is] == ZERO);
1883 }
1884 free(atolmin);
1885
1886 retval = N_VScaleVectorArray(IDA_mem->ida_Ns, IDA_mem->ida_cvals,
1887 abstolQS, IDA_mem->ida_VatolQS);
1888 if (retval != IDA_SUCCESS) return (IDA_VECTOROP_ERR);
1889
1890 return(IDA_SUCCESS);
1891 }
1892
IDAQuadSensEEtolerances(void * ida_mem)1893 int IDAQuadSensEEtolerances(void *ida_mem)
1894 {
1895 IDAMem IDA_mem;
1896
1897 if (ida_mem==NULL) {
1898 IDAProcessError(NULL, IDA_MEM_NULL, "IDAS", "IDAQuadSensEEtolerances", MSG_NO_MEM);
1899 return(IDA_MEM_NULL);
1900 }
1901 IDA_mem = (IDAMem) ida_mem;
1902
1903 /* Check if sensitivity analysis is active */
1904 if (!IDA_mem->ida_sensi) {
1905 IDAProcessError(IDA_mem, IDA_NO_SENS, "IDAS", "IDAQuadSensEEtolerances", MSG_NO_SENSI);
1906 return(IDA_NO_SENS);
1907 }
1908
1909 /* Was sensitivity for quadrature already initialized? */
1910 if (!IDA_mem->ida_quadSensMallocDone) {
1911 IDAProcessError(IDA_mem, IDA_NO_QUADSENS, "IDAS", "IDAQuadSensEEtolerances", MSG_NO_QUADSENSI);
1912 return(IDA_NO_QUADSENS);
1913 }
1914
1915 IDA_mem->ida_itolQS = IDA_EE;
1916
1917 return(IDA_SUCCESS);
1918 }
1919
1920 /*
1921 * IDASensToggleOff
1922 *
1923 * IDASensToggleOff deactivates sensitivity calculations.
1924 * It does NOT deallocate sensitivity-related memory.
1925 */
IDASensToggleOff(void * ida_mem)1926 int IDASensToggleOff(void *ida_mem)
1927 {
1928 IDAMem IDA_mem;
1929
1930 /* Check ida_mem */
1931 if (ida_mem==NULL) {
1932 IDAProcessError(NULL, IDA_MEM_NULL, "IDAS",
1933 "IDASensToggleOff", MSG_NO_MEM);
1934 return(IDA_MEM_NULL);
1935 }
1936 IDA_mem = (IDAMem) ida_mem;
1937
1938 /* Disable sensitivities */
1939 IDA_mem->ida_sensi = SUNFALSE;
1940 IDA_mem->ida_quadr_sensi = SUNFALSE;
1941
1942 return(IDA_SUCCESS);
1943 }
1944
1945 /*
1946 * IDARootInit
1947 *
1948 * IDARootInit initializes a rootfinding problem to be solved
1949 * during the integration of the DAE system. It loads the root
1950 * function pointer and the number of root functions, and allocates
1951 * workspace memory. The return value is IDA_SUCCESS = 0 if no
1952 * errors occurred, or a negative value otherwise.
1953 */
1954
IDARootInit(void * ida_mem,int nrtfn,IDARootFn g)1955 int IDARootInit(void *ida_mem, int nrtfn, IDARootFn g)
1956 {
1957 IDAMem IDA_mem;
1958 int i, nrt;
1959
1960 /* Check ida_mem pointer */
1961 if (ida_mem == NULL) {
1962 IDAProcessError(NULL, IDA_MEM_NULL, "IDAS", "IDARootInit", MSG_NO_MEM);
1963 return(IDA_MEM_NULL);
1964 }
1965 IDA_mem = (IDAMem) ida_mem;
1966
1967 nrt = (nrtfn < 0) ? 0 : nrtfn;
1968
1969 /* If rerunning IDARootInit() with a different number of root
1970 functions (changing number of gfun components), then free
1971 currently held memory resources */
1972 if ((nrt != IDA_mem->ida_nrtfn) && (IDA_mem->ida_nrtfn > 0)) {
1973
1974 free(IDA_mem->ida_glo); IDA_mem->ida_glo = NULL;
1975 free(IDA_mem->ida_ghi); IDA_mem->ida_ghi = NULL;
1976 free(IDA_mem->ida_grout); IDA_mem->ida_grout = NULL;
1977 free(IDA_mem->ida_iroots); IDA_mem->ida_iroots = NULL;
1978 free(IDA_mem->ida_rootdir); IDA_mem->ida_rootdir = NULL;
1979 free(IDA_mem->ida_gactive); IDA_mem->ida_gactive = NULL;
1980
1981 IDA_mem->ida_lrw -= 3 * (IDA_mem->ida_nrtfn);
1982 IDA_mem->ida_liw -= 3 * (IDA_mem->ida_nrtfn);
1983
1984 }
1985
1986 /* If IDARootInit() was called with nrtfn == 0, then set ida_nrtfn to
1987 zero and ida_gfun to NULL before returning */
1988 if (nrt == 0) {
1989 IDA_mem->ida_nrtfn = nrt;
1990 IDA_mem->ida_gfun = NULL;
1991 return(IDA_SUCCESS);
1992 }
1993
1994 /* If rerunning IDARootInit() with the same number of root functions
1995 (not changing number of gfun components), then check if the root
1996 function argument has changed */
1997 /* If g != NULL then return as currently reserved memory resources
1998 will suffice */
1999 if (nrt == IDA_mem->ida_nrtfn) {
2000 if (g != IDA_mem->ida_gfun) {
2001 if (g == NULL) {
2002 free(IDA_mem->ida_glo); IDA_mem->ida_glo = NULL;
2003 free(IDA_mem->ida_ghi); IDA_mem->ida_ghi = NULL;
2004 free(IDA_mem->ida_grout); IDA_mem->ida_grout = NULL;
2005 free(IDA_mem->ida_iroots); IDA_mem->ida_iroots = NULL;
2006 free(IDA_mem->ida_rootdir); IDA_mem->ida_rootdir = NULL;
2007 free(IDA_mem->ida_gactive); IDA_mem->ida_gactive = NULL;
2008
2009 IDA_mem->ida_lrw -= 3*nrt;
2010 IDA_mem->ida_liw -= 3*nrt;
2011
2012 IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDARootInit", MSG_ROOT_FUNC_NULL);
2013 return(IDA_ILL_INPUT);
2014 }
2015 else {
2016 IDA_mem->ida_gfun = g;
2017 return(IDA_SUCCESS);
2018 }
2019 }
2020 else return(IDA_SUCCESS);
2021 }
2022
2023 /* Set variable values in IDA memory block */
2024 IDA_mem->ida_nrtfn = nrt;
2025 if (g == NULL) {
2026 IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDARootInit", MSG_ROOT_FUNC_NULL);
2027 return(IDA_ILL_INPUT);
2028 }
2029 else IDA_mem->ida_gfun = g;
2030
2031 /* Allocate necessary memory and return */
2032 IDA_mem->ida_glo = NULL;
2033 IDA_mem->ida_glo = (realtype *) malloc(nrt*sizeof(realtype));
2034 if (IDA_mem->ida_glo == NULL) {
2035 IDAProcessError(IDA_mem, IDA_MEM_FAIL, "IDAS", "IDARootInit", MSG_MEM_FAIL);
2036 return(IDA_MEM_FAIL);
2037 }
2038
2039 IDA_mem->ida_ghi = NULL;
2040 IDA_mem->ida_ghi = (realtype *) malloc(nrt*sizeof(realtype));
2041 if (IDA_mem->ida_ghi == NULL) {
2042 free(IDA_mem->ida_glo); IDA_mem->ida_glo = NULL;
2043 IDAProcessError(IDA_mem, IDA_MEM_FAIL, "IDAS", "IDARootInit", MSG_MEM_FAIL);
2044 return(IDA_MEM_FAIL);
2045 }
2046
2047 IDA_mem->ida_grout = NULL;
2048 IDA_mem->ida_grout = (realtype *) malloc(nrt*sizeof(realtype));
2049 if (IDA_mem->ida_grout == NULL) {
2050 free(IDA_mem->ida_glo); IDA_mem->ida_glo = NULL;
2051 free(IDA_mem->ida_ghi); IDA_mem->ida_ghi = NULL;
2052 IDAProcessError(IDA_mem, IDA_MEM_FAIL, "IDAS", "IDARootInit", MSG_MEM_FAIL);
2053 return(IDA_MEM_FAIL);
2054 }
2055
2056 IDA_mem->ida_iroots = NULL;
2057 IDA_mem->ida_iroots = (int *) malloc(nrt*sizeof(int));
2058 if (IDA_mem->ida_iroots == NULL) {
2059 free(IDA_mem->ida_glo); IDA_mem->ida_glo = NULL;
2060 free(IDA_mem->ida_ghi); IDA_mem->ida_ghi = NULL;
2061 free(IDA_mem->ida_grout); IDA_mem->ida_grout = NULL;
2062 IDAProcessError(IDA_mem, IDA_MEM_FAIL, "IDAS", "IDARootInit", MSG_MEM_FAIL);
2063 return(IDA_MEM_FAIL);
2064 }
2065
2066 IDA_mem->ida_rootdir = NULL;
2067 IDA_mem->ida_rootdir = (int *) malloc(nrt*sizeof(int));
2068 if (IDA_mem->ida_rootdir == NULL) {
2069 free(IDA_mem->ida_glo); IDA_mem->ida_glo = NULL;
2070 free(IDA_mem->ida_ghi); IDA_mem->ida_ghi = NULL;
2071 free(IDA_mem->ida_grout); IDA_mem->ida_grout = NULL;
2072 free(IDA_mem->ida_iroots); IDA_mem->ida_iroots = NULL;
2073 IDAProcessError(IDA_mem, IDA_MEM_FAIL, "IDAS", "IDARootInit", MSG_MEM_FAIL);
2074 return(IDA_MEM_FAIL);
2075 }
2076
2077 IDA_mem->ida_gactive = NULL;
2078 IDA_mem->ida_gactive = (booleantype *) malloc(nrt*sizeof(booleantype));
2079 if (IDA_mem->ida_gactive == NULL) {
2080 free(IDA_mem->ida_glo); IDA_mem->ida_glo = NULL;
2081 free(IDA_mem->ida_ghi); IDA_mem->ida_ghi = NULL;
2082 free(IDA_mem->ida_grout); IDA_mem->ida_grout = NULL;
2083 free(IDA_mem->ida_iroots); IDA_mem->ida_iroots = NULL;
2084 free(IDA_mem->ida_rootdir); IDA_mem->ida_rootdir = NULL;
2085 IDAProcessError(IDA_mem, IDA_MEM_FAIL, "IDA", "IDARootInit", MSG_MEM_FAIL);
2086 return(IDA_MEM_FAIL);
2087 }
2088
2089 /* Set default values for rootdir (both directions) */
2090 for(i=0; i<nrt; i++) IDA_mem->ida_rootdir[i] = 0;
2091
2092 /* Set default values for gactive (all active) */
2093 for(i=0; i<nrt; i++) IDA_mem->ida_gactive[i] = SUNTRUE;
2094
2095 IDA_mem->ida_lrw += 3*nrt;
2096 IDA_mem->ida_liw += 3*nrt;
2097
2098 return(IDA_SUCCESS);
2099 }
2100
2101
2102 /*
2103 * -----------------------------------------------------------------
2104 * Main solver function
2105 * -----------------------------------------------------------------
2106 */
2107
2108 /*
2109 * IDASolve
2110 *
2111 * This routine is the main driver of the IDA package.
2112 *
2113 * It integrates over an independent variable interval defined by the user,
2114 * by calling IDAStep to take internal independent variable steps.
2115 *
2116 * The first time that IDASolve is called for a successfully initialized
2117 * problem, it computes a tentative initial step size.
2118 *
2119 * IDASolve supports two modes, specified by itask:
2120 * In the IDA_NORMAL mode, the solver steps until it passes tout and then
2121 * interpolates to obtain y(tout) and yp(tout).
2122 * In the IDA_ONE_STEP mode, it takes one internal step and returns.
2123 *
2124 * IDASolve returns integer values corresponding to success and failure as below:
2125 *
2126 * successful returns:
2127 *
2128 * IDA_SUCCESS
2129 * IDA_TSTOP_RETURN
2130 *
2131 * failed returns:
2132 *
2133 * IDA_ILL_INPUT
2134 * IDA_TOO_MUCH_WORK
2135 * IDA_MEM_NULL
2136 * IDA_TOO_MUCH_ACC
2137 * IDA_CONV_FAIL
2138 * IDA_LSETUP_FAIL
2139 * IDA_LSOLVE_FAIL
2140 * IDA_CONSTR_FAIL
2141 * IDA_ERR_FAIL
2142 * IDA_REP_RES_ERR
2143 * IDA_RES_FAIL
2144 */
2145
IDASolve(void * ida_mem,realtype tout,realtype * tret,N_Vector yret,N_Vector ypret,int itask)2146 int IDASolve(void *ida_mem, realtype tout, realtype *tret,
2147 N_Vector yret, N_Vector ypret, int itask)
2148 {
2149 long int nstloc;
2150 int sflag, istate, ier, irfndp, ir, is;
2151 realtype tdist, troundoff, ypnorm, rh, nrm;
2152 IDAMem IDA_mem;
2153 booleantype inactive_roots;
2154
2155 /* Check for legal inputs in all cases. */
2156
2157 if (ida_mem == NULL) {
2158 IDAProcessError(NULL, IDA_MEM_NULL, "IDAS", "IDASolve", MSG_NO_MEM);
2159 return(IDA_MEM_NULL);
2160 }
2161 IDA_mem = (IDAMem) ida_mem;
2162
2163 /* Check if problem was malloc'ed */
2164
2165 if (IDA_mem->ida_MallocDone == SUNFALSE) {
2166 IDAProcessError(IDA_mem, IDA_NO_MALLOC, "IDAS", "IDASolve", MSG_NO_MALLOC);
2167 return(IDA_NO_MALLOC);
2168 }
2169
2170 /* Check for legal arguments */
2171
2172 if (yret == NULL) {
2173 IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDASolve", MSG_YRET_NULL);
2174 return(IDA_ILL_INPUT);
2175 }
2176 IDA_mem->ida_yy = yret;
2177
2178 if (ypret == NULL) {
2179 IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDASolve", MSG_YPRET_NULL);
2180 return(IDA_ILL_INPUT);
2181 }
2182 IDA_mem->ida_yp = ypret;
2183
2184 if (tret == NULL) {
2185 IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDASolve", MSG_TRET_NULL);
2186 return(IDA_ILL_INPUT);
2187 }
2188
2189 if ((itask != IDA_NORMAL) && (itask != IDA_ONE_STEP)) {
2190 IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDASolve", MSG_BAD_ITASK);
2191 return(IDA_ILL_INPUT);
2192 }
2193
2194 if (itask == IDA_NORMAL) IDA_mem->ida_toutc = tout;
2195 IDA_mem->ida_taskc = itask;
2196
2197 /* Sensitivity-specific tests (if using internal DQ functions) */
2198 if (IDA_mem->ida_sensi && IDA_mem->ida_resSDQ) {
2199 /* Make sure we have the right 'user data' */
2200 IDA_mem->ida_user_dataS = ida_mem;
2201 /* Test if we have the problem parameters */
2202 if(IDA_mem->ida_p == NULL) {
2203 IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDASolve", MSG_NULL_P);
2204 return(IDA_ILL_INPUT);
2205 }
2206 }
2207
2208 if (IDA_mem->ida_quadr_sensi && IDA_mem->ida_rhsQSDQ) {
2209 IDA_mem->ida_user_dataQS = ida_mem;
2210 /* Test if we have the problem parameters */
2211 if(IDA_mem->ida_p == NULL) {
2212 IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDASolve", MSG_NULL_P);
2213 return(IDA_ILL_INPUT);
2214 }
2215 }
2216
2217 if (IDA_mem->ida_nst == 0) { /* This is the first call */
2218
2219 /* Check inputs to IDA for correctness and consistency */
2220
2221 if (IDA_mem->ida_SetupDone == SUNFALSE) {
2222 ier = IDAInitialSetup(IDA_mem);
2223 if (ier != IDA_SUCCESS) return(ier);
2224 IDA_mem->ida_SetupDone = SUNTRUE;
2225 }
2226
2227 /* On first call, check for tout - tn too small, set initial hh,
2228 check for approach to tstop, and scale phi[1], phiQ[1], and phiS[1] by hh.
2229 Also check for zeros of root function g at and near t0. */
2230
2231 tdist = SUNRabs(tout - IDA_mem->ida_tn);
2232 if (tdist == ZERO) {
2233 IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDASolve", MSG_TOO_CLOSE);
2234 return(IDA_ILL_INPUT);
2235 }
2236 troundoff = TWO * IDA_mem->ida_uround * (SUNRabs(IDA_mem->ida_tn) + SUNRabs(tout));
2237 if (tdist < troundoff) {
2238 IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDASolve", MSG_TOO_CLOSE);
2239 return(IDA_ILL_INPUT);
2240 }
2241
2242 IDA_mem->ida_hh = IDA_mem->ida_hin;
2243 if ( (IDA_mem->ida_hh != ZERO) && ((tout-IDA_mem->ida_tn)*IDA_mem->ida_hh < ZERO) ) {
2244 IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDASolve", MSG_BAD_HINIT);
2245 return(IDA_ILL_INPUT);
2246 }
2247
2248 if (IDA_mem->ida_hh == ZERO) {
2249 IDA_mem->ida_hh = PT001*tdist;
2250 ypnorm = IDAWrmsNorm(IDA_mem, IDA_mem->ida_phi[1],
2251 IDA_mem->ida_ewt, IDA_mem->ida_suppressalg);
2252 if (IDA_mem->ida_errconQ)
2253 ypnorm = IDAQuadWrmsNormUpdate(IDA_mem, ypnorm,
2254 IDA_mem->ida_phiQ[1], IDA_mem->ida_ewtQ);
2255 if (IDA_mem->ida_errconS)
2256 ypnorm = IDASensWrmsNormUpdate(IDA_mem, ypnorm, IDA_mem->ida_phiS[1],
2257 IDA_mem->ida_ewtS, IDA_mem->ida_suppressalg);
2258 if (IDA_mem->ida_errconQS)
2259 ypnorm = IDAQuadSensWrmsNormUpdate(IDA_mem, ypnorm, IDA_mem->ida_phiQS[1],
2260 IDA_mem->ida_ewtQS);
2261
2262 if (ypnorm > HALF / IDA_mem->ida_hh) IDA_mem->ida_hh = HALF/ypnorm;
2263 if (tout < IDA_mem->ida_tn) IDA_mem->ida_hh = -IDA_mem->ida_hh;
2264 }
2265
2266 rh = SUNRabs(IDA_mem->ida_hh) * IDA_mem->ida_hmax_inv;
2267 if (rh > ONE) IDA_mem->ida_hh /= rh;
2268
2269 if (IDA_mem->ida_tstopset) {
2270 if ( (IDA_mem->ida_tstop - IDA_mem->ida_tn)*IDA_mem->ida_hh <= ZERO) {
2271 IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDASolve",
2272 MSG_BAD_TSTOP, IDA_mem->ida_tstop, IDA_mem->ida_tn);
2273 return(IDA_ILL_INPUT);
2274 }
2275 if ( (IDA_mem->ida_tn + IDA_mem->ida_hh - IDA_mem->ida_tstop)*IDA_mem->ida_hh > ZERO)
2276 IDA_mem->ida_hh = (IDA_mem->ida_tstop - IDA_mem->ida_tn)*(ONE - FOUR * IDA_mem->ida_uround);
2277 }
2278
2279 IDA_mem->ida_h0u = IDA_mem->ida_hh;
2280 IDA_mem->ida_kk = 0;
2281 IDA_mem->ida_kused = 0; /* set in case of an error return before a step */
2282
2283 /* Check for exact zeros of the root functions at or near t0. */
2284 if (IDA_mem->ida_nrtfn > 0) {
2285 ier = IDARcheck1(IDA_mem);
2286 if (ier == IDA_RTFUNC_FAIL) {
2287 IDAProcessError(IDA_mem, IDA_RTFUNC_FAIL, "IDAS", "IDARcheck1",
2288 MSG_RTFUNC_FAILED, IDA_mem->ida_tn);
2289 return(IDA_RTFUNC_FAIL);
2290 }
2291 }
2292
2293 /* set phi[1] = hh*y' */
2294 N_VScale(IDA_mem->ida_hh, IDA_mem->ida_phi[1], IDA_mem->ida_phi[1]);
2295
2296 /* set phiQ[1] = hh*yQ' */
2297 if (IDA_mem->ida_quadr)
2298 N_VScale(IDA_mem->ida_hh, IDA_mem->ida_phiQ[1], IDA_mem->ida_phiQ[1]);
2299
2300 if (IDA_mem->ida_sensi || IDA_mem->ida_quadr_sensi)
2301 for (is=0; is<IDA_mem->ida_Ns; is++)
2302 IDA_mem->ida_cvals[is] = IDA_mem->ida_hh;
2303
2304 if (IDA_mem->ida_sensi) {
2305 /* set phiS[1][i] = hh*yS_i' */
2306 ier = N_VScaleVectorArray(IDA_mem->ida_Ns, IDA_mem->ida_cvals,
2307 IDA_mem->ida_phiS[1], IDA_mem->ida_phiS[1]);
2308 if (ier != IDA_SUCCESS) return (IDA_VECTOROP_ERR);
2309 }
2310
2311 if (IDA_mem->ida_quadr_sensi) {
2312 ier = N_VScaleVectorArray(IDA_mem->ida_Ns, IDA_mem->ida_cvals,
2313 IDA_mem->ida_phiQS[1], IDA_mem->ida_phiQS[1]);
2314 if (ier != IDA_SUCCESS) return (IDA_VECTOROP_ERR);
2315 }
2316
2317 /* Set the convergence test constants epsNewt and toldel */
2318 IDA_mem->ida_epsNewt = IDA_mem->ida_epcon;
2319 IDA_mem->ida_toldel = PT0001 * IDA_mem->ida_epsNewt;
2320
2321 } /* end of first-call block. */
2322
2323 /* Call lperf function and set nstloc for later performance testing. */
2324
2325 if (IDA_mem->ida_lperf != NULL)
2326 IDA_mem->ida_lperf(IDA_mem, 0);
2327 nstloc = 0;
2328
2329 /* If not the first call, perform all stopping tests. */
2330
2331 if (IDA_mem->ida_nst > 0) {
2332
2333 /* First, check for a root in the last step taken, other than the
2334 last root found, if any. If itask = IDA_ONE_STEP and y(tn) was not
2335 returned because of an intervening root, return y(tn) now. */
2336
2337 if (IDA_mem->ida_nrtfn > 0) {
2338
2339 irfndp = IDA_mem->ida_irfnd;
2340
2341 ier = IDARcheck2(IDA_mem);
2342
2343 if (ier == CLOSERT) {
2344 IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDARcheck2",
2345 MSG_CLOSE_ROOTS, IDA_mem->ida_tlo);
2346 return(IDA_ILL_INPUT);
2347 } else if (ier == IDA_RTFUNC_FAIL) {
2348 IDAProcessError(IDA_mem, IDA_RTFUNC_FAIL, "IDAS", "IDARcheck2",
2349 MSG_RTFUNC_FAILED, IDA_mem->ida_tlo);
2350 return(IDA_RTFUNC_FAIL);
2351 } else if (ier == RTFOUND) {
2352 IDA_mem->ida_tretlast = *tret = IDA_mem->ida_tlo;
2353 return(IDA_ROOT_RETURN);
2354 }
2355
2356 /* If tn is distinct from tretlast (within roundoff),
2357 check remaining interval for roots */
2358 troundoff = HUNDRED * IDA_mem->ida_uround * (SUNRabs(IDA_mem->ida_tn) + SUNRabs(IDA_mem->ida_hh));
2359 if ( SUNRabs(IDA_mem->ida_tn - IDA_mem->ida_tretlast) > troundoff ) {
2360 ier = IDARcheck3(IDA_mem);
2361 if (ier == IDA_SUCCESS) { /* no root found */
2362 IDA_mem->ida_irfnd = 0;
2363 if ((irfndp == 1) && (itask == IDA_ONE_STEP)) {
2364 IDA_mem->ida_tretlast = *tret = IDA_mem->ida_tn;
2365 ier = IDAGetSolution(IDA_mem, IDA_mem->ida_tn, yret, ypret);
2366 return(IDA_SUCCESS);
2367 }
2368 } else if (ier == RTFOUND) { /* a new root was found */
2369 IDA_mem->ida_irfnd = 1;
2370 IDA_mem->ida_tretlast = *tret = IDA_mem->ida_tlo;
2371 return(IDA_ROOT_RETURN);
2372 } else if (ier == IDA_RTFUNC_FAIL) { /* g failed */
2373 IDAProcessError(IDA_mem, IDA_RTFUNC_FAIL, "IDAS", "IDARcheck3",
2374 MSG_RTFUNC_FAILED, IDA_mem->ida_tlo);
2375 return(IDA_RTFUNC_FAIL);
2376 }
2377 }
2378
2379 } /* end of root stop check */
2380
2381
2382 /* Now test for all other stop conditions. */
2383
2384 istate = IDAStopTest1(IDA_mem, tout, tret, yret, ypret, itask);
2385 if (istate != CONTINUE_STEPS) return(istate);
2386 }
2387
2388 /* Looping point for internal steps. */
2389
2390 for(;;) {
2391
2392 /* Check for too many steps taken. */
2393
2394 if ( (IDA_mem->ida_mxstep>0) && (nstloc >= IDA_mem->ida_mxstep) ) {
2395 IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDASolve",
2396 MSG_MAX_STEPS, IDA_mem->ida_tn);
2397 istate = IDA_TOO_MUCH_WORK;
2398 *tret = IDA_mem->ida_tretlast = IDA_mem->ida_tn;
2399 break; /* Here yy=yret and yp=ypret already have the current solution. */
2400 }
2401
2402 /* Call lperf to generate warnings of poor performance. */
2403
2404 if (IDA_mem->ida_lperf != NULL)
2405 IDA_mem->ida_lperf(IDA_mem, 1);
2406
2407 /* Reset and check ewt, ewtQ, ewtS and ewtQS (if not first call). */
2408
2409 if (IDA_mem->ida_nst > 0) {
2410
2411 ier = IDA_mem->ida_efun(IDA_mem->ida_phi[0], IDA_mem->ida_ewt,
2412 IDA_mem->ida_edata);
2413
2414 if (ier != 0) {
2415
2416 if (IDA_mem->ida_itol == IDA_WF)
2417 IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDASolve",
2418 MSG_EWT_NOW_FAIL, IDA_mem->ida_tn);
2419 else
2420 IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDASolve",
2421 MSG_EWT_NOW_BAD, IDA_mem->ida_tn);
2422
2423 istate = IDA_ILL_INPUT;
2424 ier = IDAGetSolution(IDA_mem, IDA_mem->ida_tn, yret, ypret);
2425 *tret = IDA_mem->ida_tretlast = IDA_mem->ida_tn;
2426 break;
2427
2428 }
2429
2430 if (IDA_mem->ida_quadr && IDA_mem->ida_errconQ) {
2431 ier = IDAQuadEwtSet(IDA_mem, IDA_mem->ida_phiQ[0], IDA_mem->ida_ewtQ);
2432 if (ier != 0) {
2433 IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDASolve",
2434 MSG_EWTQ_NOW_BAD, IDA_mem->ida_tn);
2435 istate = IDA_ILL_INPUT;
2436 ier = IDAGetSolution(IDA_mem, IDA_mem->ida_tn, yret, ypret);
2437 *tret = IDA_mem->ida_tretlast = IDA_mem->ida_tn;
2438 break;
2439 }
2440 }
2441
2442 if (IDA_mem->ida_sensi) {
2443 ier = IDASensEwtSet(IDA_mem, IDA_mem->ida_phiS[0], IDA_mem->ida_ewtS);
2444 if (ier != 0) {
2445 IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDASolve",
2446 MSG_EWTS_NOW_BAD, IDA_mem->ida_tn);
2447 istate = IDA_ILL_INPUT;
2448 ier = IDAGetSolution(IDA_mem, IDA_mem->ida_tn, yret, ypret);
2449 *tret = IDA_mem->ida_tretlast = IDA_mem->ida_tn;
2450 break;
2451 }
2452 }
2453
2454 if (IDA_mem->ida_quadr_sensi && IDA_mem->ida_errconQS) {
2455 ier = IDAQuadSensEwtSet(IDA_mem, IDA_mem->ida_phiQS[0], IDA_mem->ida_ewtQS);
2456 if (ier != 0) {
2457 IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDASolve",
2458 MSG_EWTQS_NOW_BAD, IDA_mem->ida_tn);
2459 istate = IDA_ILL_INPUT;
2460 ier = IDAGetSolution(IDA_mem, IDA_mem->ida_tn, yret, ypret);
2461 IDA_mem->ida_tretlast = *tret = IDA_mem->ida_tn;
2462 break;
2463 }
2464 }
2465
2466 }
2467
2468 /* Check for too much accuracy requested. */
2469
2470 nrm = IDAWrmsNorm(IDA_mem, IDA_mem->ida_phi[0], IDA_mem->ida_ewt,
2471 IDA_mem->ida_suppressalg);
2472 if (IDA_mem->ida_errconQ)
2473 nrm = IDAQuadWrmsNormUpdate(IDA_mem, nrm, IDA_mem->ida_phiQ[0],
2474 IDA_mem->ida_ewtQ);
2475 if (IDA_mem->ida_errconS)
2476 nrm = IDASensWrmsNormUpdate(IDA_mem, nrm, IDA_mem->ida_phiS[0],
2477 IDA_mem->ida_ewtS, IDA_mem->ida_suppressalg);
2478 if (IDA_mem->ida_errconQS)
2479 nrm = IDAQuadSensWrmsNormUpdate(IDA_mem, nrm, IDA_mem->ida_phiQS[0],
2480 IDA_mem->ida_ewtQS);
2481
2482 IDA_mem->ida_tolsf = IDA_mem->ida_uround * nrm;
2483 if (IDA_mem->ida_tolsf > ONE) {
2484 IDA_mem->ida_tolsf *= TEN;
2485 IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDASolve",
2486 MSG_TOO_MUCH_ACC, IDA_mem->ida_tn);
2487 istate = IDA_TOO_MUCH_ACC;
2488 *tret = IDA_mem->ida_tretlast = IDA_mem->ida_tn;
2489 if (IDA_mem->ida_nst > 0) ier = IDAGetSolution(IDA_mem, IDA_mem->ida_tn, yret, ypret);
2490 break;
2491 }
2492
2493 /* Call IDAStep to take a step. */
2494
2495 sflag = IDAStep(IDA_mem);
2496
2497 /* Process all failed-step cases, and exit loop. */
2498
2499 if (sflag != IDA_SUCCESS) {
2500 istate = IDAHandleFailure(IDA_mem, sflag);
2501 *tret = IDA_mem->ida_tretlast = IDA_mem->ida_tn;
2502 ier = IDAGetSolution(IDA_mem, IDA_mem->ida_tn, yret, ypret);
2503 break;
2504 }
2505
2506 nstloc++;
2507
2508 /* If tstop is set and was reached, reset IDA_mem->ida_tn = tstop */
2509 if (IDA_mem->ida_tstopset) {
2510 troundoff = HUNDRED * IDA_mem->ida_uround * (SUNRabs(IDA_mem->ida_tn) + SUNRabs(IDA_mem->ida_hh));
2511 if (SUNRabs(IDA_mem->ida_tn - IDA_mem->ida_tstop) <= troundoff)
2512 IDA_mem->ida_tn = IDA_mem->ida_tstop;
2513 }
2514
2515 /* After successful step, check for stop conditions; continue or break. */
2516
2517 /* First check for root in the last step taken. */
2518
2519 if (IDA_mem->ida_nrtfn > 0) {
2520
2521 ier = IDARcheck3(IDA_mem);
2522
2523 if (ier == RTFOUND) { /* A new root was found */
2524 IDA_mem->ida_irfnd = 1;
2525 istate = IDA_ROOT_RETURN;
2526 IDA_mem->ida_tretlast = *tret = IDA_mem->ida_tlo;
2527 break;
2528 } else if (ier == IDA_RTFUNC_FAIL) { /* g failed */
2529 IDAProcessError(IDA_mem, IDA_RTFUNC_FAIL, "IDAS", "IDARcheck3",
2530 MSG_RTFUNC_FAILED, IDA_mem->ida_tlo);
2531 istate = IDA_RTFUNC_FAIL;
2532 break;
2533 }
2534
2535 /* If we are at the end of the first step and we still have
2536 * some event functions that are inactive, issue a warning
2537 * as this may indicate a user error in the implementation
2538 * of the root function. */
2539
2540 if (IDA_mem->ida_nst==1) {
2541 inactive_roots = SUNFALSE;
2542 for (ir=0; ir<IDA_mem->ida_nrtfn; ir++) {
2543 if (!IDA_mem->ida_gactive[ir]) {
2544 inactive_roots = SUNTRUE;
2545 break;
2546 }
2547 }
2548 if ((IDA_mem->ida_mxgnull > 0) && inactive_roots) {
2549 IDAProcessError(IDA_mem, IDA_WARNING, "IDAS", "IDASolve",
2550 MSG_INACTIVE_ROOTS);
2551 }
2552 }
2553
2554 }
2555
2556 /* Now check all other stop conditions. */
2557
2558 istate = IDAStopTest2(IDA_mem, tout, tret, yret, ypret, itask);
2559 if (istate != CONTINUE_STEPS) break;
2560
2561 } /* End of step loop */
2562
2563 return(istate);
2564 }
2565
2566 /*
2567 * -----------------------------------------------------------------
2568 * Interpolated output and extraction functions
2569 * -----------------------------------------------------------------
2570 */
2571
2572 /*
2573 * IDAGetDky
2574 *
2575 * This routine evaluates the k-th derivative of y(t) as the value of
2576 * the k-th derivative of the interpolating polynomial at the independent
2577 * variable t, and stores the results in the vector dky. It uses the current
2578 * independent variable value, tn, and the method order last used, kused.
2579 *
2580 * The return values are:
2581 * IDA_SUCCESS if t is legal
2582 * IDA_BAD_T if t is not within the interval of the last step taken
2583 * IDA_BAD_DKY if the dky vector is NULL
2584 * IDA_BAD_K if the requested k is not in the range [0,order used]
2585 * IDA_VECTOROP_ERR if the fused vector operation fails
2586 *
2587 */
2588
IDAGetDky(void * ida_mem,realtype t,int k,N_Vector dky)2589 int IDAGetDky(void *ida_mem, realtype t, int k, N_Vector dky)
2590 {
2591 IDAMem IDA_mem;
2592 realtype tfuzz, tp, delt, psij_1;
2593 int i, j, retval;
2594 realtype cjk [MXORDP1];
2595 realtype cjk_1[MXORDP1];
2596
2597 /* Check ida_mem */
2598 if (ida_mem == NULL) {
2599 IDAProcessError(NULL, IDA_MEM_NULL, "IDAS", "IDAGetDky", MSG_NO_MEM);
2600 return (IDA_MEM_NULL);
2601 }
2602 IDA_mem = (IDAMem) ida_mem;
2603
2604 if (dky == NULL) {
2605 IDAProcessError(IDA_mem, IDA_BAD_DKY, "IDAS", "IDAGetDky", MSG_NULL_DKY);
2606 return(IDA_BAD_DKY);
2607 }
2608
2609 if ((k < 0) || (k > IDA_mem->ida_kused)) {
2610 IDAProcessError(IDA_mem, IDA_BAD_K, "IDAS", "IDAGetDky", MSG_BAD_K);
2611 return(IDA_BAD_K);
2612 }
2613
2614 /* Check t for legality. Here tn - hused is t_{n-1}. */
2615
2616 tfuzz = HUNDRED * IDA_mem->ida_uround * (SUNRabs(IDA_mem->ida_tn) + SUNRabs(IDA_mem->ida_hh));
2617 if (IDA_mem->ida_hh < ZERO) tfuzz = - tfuzz;
2618 tp = IDA_mem->ida_tn - IDA_mem->ida_hused - tfuzz;
2619 if ((t - tp)*IDA_mem->ida_hh < ZERO) {
2620 IDAProcessError(IDA_mem, IDA_BAD_T, "IDAS", "IDAGetDky", MSG_BAD_T, t,
2621 IDA_mem->ida_tn-IDA_mem->ida_hused, IDA_mem->ida_tn);
2622 return(IDA_BAD_T);
2623 }
2624
2625 /* Initialize the c_j^(k) and c_k^(k-1) */
2626 for(i=0; i<MXORDP1; i++) {
2627 cjk [i] = 0;
2628 cjk_1[i] = 0;
2629 }
2630
2631 delt = t-IDA_mem->ida_tn;
2632
2633 for(i=0; i<=k; i++) {
2634
2635 /* The below reccurence is used to compute the k-th derivative of the solution:
2636 c_j^(k) = ( k * c_{j-1}^(k-1) + c_{j-1}^{k} (Delta+psi_{j-1}) ) / psi_j
2637
2638 Translated in indexes notation:
2639 cjk[j] = ( k*cjk_1[j-1] + cjk[j-1]*(delt+psi[j-2]) ) / psi[j-1]
2640
2641 For k=0, j=1: c_1 = c_0^(-1) + (delt+psi[-1]) / psi[0]
2642
2643 In order to be able to deal with k=0 in the same way as for k>0, the
2644 following conventions were adopted:
2645 - c_0(t) = 1 , c_0^(-1)(t)=0
2646 - psij_1 stands for psi[-1]=0 when j=1
2647 for psi[j-2] when j>1
2648 */
2649 if(i==0) {
2650
2651 cjk[i] = 1;
2652 psij_1 = 0;
2653 }else {
2654 /* i i-1 1
2655 c_i^(i) can be always updated since c_i^(i) = ----- -------- ... -----
2656 psi_j psi_{j-1} psi_1
2657 */
2658 cjk[i] = cjk[i-1]*i / IDA_mem->ida_psi[i-1];
2659 psij_1 = IDA_mem->ida_psi[i-1];
2660 }
2661
2662 /* update c_j^(i) */
2663
2664 /*j does not need to go till kused */
2665 for(j=i+1; j<=IDA_mem->ida_kused-k+i; j++) {
2666
2667 cjk[j] = ( i* cjk_1[j-1] + cjk[j-1] * (delt + psij_1) ) / IDA_mem->ida_psi[j-1];
2668 psij_1 = IDA_mem->ida_psi[j-1];
2669 }
2670
2671 /* save existing c_j^(i)'s */
2672 for(j=i+1; j<=IDA_mem->ida_kused-k+i; j++) cjk_1[j] = cjk[j];
2673 }
2674
2675 /* Compute sum (c_j(t) * phi(t)) */
2676
2677 /* Sum j=k to j<=IDA_mem->ida_kused */
2678 retval = N_VLinearCombination(IDA_mem->ida_kused-k+1, cjk+k,
2679 IDA_mem->ida_phi+k, dky);
2680 if (retval != IDA_SUCCESS) return(IDA_VECTOROP_ERR);
2681
2682 return(IDA_SUCCESS);
2683 }
2684
2685 /*
2686 * IDAGetQuad
2687 *
2688 * The following function can be called to obtain the quadrature
2689 * variables after a successful integration step.
2690 *
2691 * This is just a wrapper that calls IDAGetQuadDky with k=0.
2692 */
2693
IDAGetQuad(void * ida_mem,realtype * ptret,N_Vector yQout)2694 int IDAGetQuad(void *ida_mem, realtype *ptret, N_Vector yQout)
2695 {
2696 IDAMem IDA_mem;
2697
2698 if (ida_mem == NULL) {
2699 IDAProcessError(NULL, IDA_MEM_NULL, "IDAS", "IDAGetQuad", MSG_NO_MEM);
2700 return(IDA_MEM_NULL);
2701 }
2702 IDA_mem = (IDAMem)ida_mem;
2703
2704 *ptret = IDA_mem->ida_tretlast;
2705
2706 return IDAGetQuadDky(ida_mem, IDA_mem->ida_tretlast, 0, yQout);
2707 }
2708
2709 /*
2710 * IDAGetQuadDky
2711 *
2712 * Returns the quadrature variables (or their
2713 * derivatives up to the current method order) at any time within
2714 * the last integration step (dense output).
2715 */
IDAGetQuadDky(void * ida_mem,realtype t,int k,N_Vector dkyQ)2716 int IDAGetQuadDky(void *ida_mem, realtype t, int k, N_Vector dkyQ)
2717 {
2718 IDAMem IDA_mem;
2719 realtype tfuzz, tp, delt, psij_1;
2720 int i, j, retval;
2721 realtype cjk [MXORDP1];
2722 realtype cjk_1[MXORDP1];
2723
2724 /* Check ida_mem */
2725 if (ida_mem == NULL) {
2726 IDAProcessError(NULL, IDA_MEM_NULL, "IDAS", "IDAGetQuadDky", MSG_NO_MEM);
2727 return (IDA_MEM_NULL);
2728 }
2729 IDA_mem = (IDAMem) ida_mem;
2730
2731 /* Ckeck if quadrature was initialized */
2732 if (IDA_mem->ida_quadr != SUNTRUE) {
2733 IDAProcessError(IDA_mem, IDA_NO_QUAD, "IDAS", "IDAGetQuadDky", MSG_NO_QUAD);
2734 return(IDA_NO_QUAD);
2735 }
2736
2737 if (dkyQ == NULL) {
2738 IDAProcessError(IDA_mem, IDA_BAD_DKY, "IDAS", "IDAGetQuadDky", MSG_NULL_DKY);
2739 return(IDA_BAD_DKY);
2740 }
2741
2742 if ((k < 0) || (k > IDA_mem->ida_kk)) {
2743 IDAProcessError(IDA_mem, IDA_BAD_K, "IDAS", "IDAGetQuadDky", MSG_BAD_K);
2744 return(IDA_BAD_K);
2745 }
2746
2747 /* Check t for legality. Here tn - hused is t_{n-1}. */
2748
2749 tfuzz = HUNDRED * IDA_mem->ida_uround * (IDA_mem->ida_tn + IDA_mem->ida_hh);
2750 tp = IDA_mem->ida_tn - IDA_mem->ida_hused - tfuzz;
2751 if ( (t - tp)*IDA_mem->ida_hh < ZERO) {
2752 IDAProcessError(IDA_mem, IDA_BAD_T, "IDAS", "IDAGetQuadDky", MSG_BAD_T,
2753 t, IDA_mem->ida_tn-IDA_mem->ida_hused, IDA_mem->ida_tn);
2754 return(IDA_BAD_T);
2755 }
2756
2757 /* Initialize the c_j^(k) and c_k^(k-1) */
2758 for(i=0; i<MXORDP1; i++) {
2759 cjk [i] = 0;
2760 cjk_1[i] = 0;
2761 }
2762 delt = t-IDA_mem->ida_tn;
2763
2764 for(i=0; i<=k; i++) {
2765
2766 if(i==0) {
2767 cjk[i] = 1;
2768 psij_1 = 0;
2769 }else {
2770 cjk[i] = cjk[i-1]*i / IDA_mem->ida_psi[i-1];
2771 psij_1 = IDA_mem->ida_psi[i-1];
2772 }
2773
2774 /* update c_j^(i) */
2775 for(j=i+1; j<=IDA_mem->ida_kused-k+i; j++) {
2776
2777 cjk[j] = ( i* cjk_1[j-1] + cjk[j-1] * (delt + psij_1) ) / IDA_mem->ida_psi[j-1];
2778 psij_1 = IDA_mem->ida_psi[j-1];
2779 }
2780
2781 /* save existing c_j^(i)'s */
2782 for(j=i+1; j<=IDA_mem->ida_kused-k+i; j++) cjk_1[j] = cjk[j];
2783 }
2784
2785 /* Compute sum (c_j(t) * phi(t)) */
2786
2787 retval = N_VLinearCombination(IDA_mem->ida_kused-k+1, cjk+k, IDA_mem->ida_phiQ+k, dkyQ);
2788 if (retval != IDA_SUCCESS) return (IDA_VECTOROP_ERR);
2789
2790 return(IDA_SUCCESS);
2791 }
2792
2793
2794 /*
2795 * IDAGetSens
2796 *
2797 * This routine extracts sensitivity solution into yySout at the
2798 * time at which IDASolve returned the solution.
2799 * This is just a wrapper that calls IDAGetSensDky1 with k=0 and
2800 * is=0, 1, ... ,NS-1.
2801 */
2802
IDAGetSens(void * ida_mem,realtype * ptret,N_Vector * yySout)2803 int IDAGetSens(void *ida_mem, realtype *ptret, N_Vector *yySout)
2804 {
2805 IDAMem IDA_mem;
2806 int is, ierr=0;
2807
2808 /* Check ida_mem */
2809 if (ida_mem == NULL) {
2810 IDAProcessError(NULL, IDA_MEM_NULL, "IDAS", "IDAGetSens", MSG_NO_MEM);
2811 return (IDA_MEM_NULL);
2812 }
2813 IDA_mem = (IDAMem) ida_mem;
2814
2815 /*Check the parameters */
2816 if (yySout == NULL) {
2817 IDAProcessError(IDA_mem, IDA_BAD_DKY, "IDAS", "IDAGetSens", MSG_NULL_DKY);
2818 return(IDA_BAD_DKY);
2819 }
2820
2821 /* are sensitivities enabled? */
2822 if (IDA_mem->ida_sensi==SUNFALSE) {
2823 IDAProcessError(IDA_mem, IDA_NO_SENS, "IDAS", "IDAGetSens", MSG_NO_SENSI);
2824 return(IDA_NO_SENS);
2825 }
2826
2827 *ptret = IDA_mem->ida_tretlast;
2828
2829 for(is=0; is<IDA_mem->ida_Ns; is++)
2830 if( IDA_SUCCESS != (ierr = IDAGetSensDky1(ida_mem, *ptret, 0, is, yySout[is])) ) break;
2831
2832 return(ierr);
2833 }
2834
2835 /*
2836 * IDAGetSensDky
2837 *
2838 * Computes the k-th derivative of all sensitivities of the y function at
2839 * time t. It repeatedly calls IDAGetSensDky1. The argument dkyS must be
2840 * a pointer to N_Vector and must be allocated by the user to hold at
2841 * least Ns vectors.
2842 */
IDAGetSensDky(void * ida_mem,realtype t,int k,N_Vector * dkySout)2843 int IDAGetSensDky(void *ida_mem, realtype t, int k, N_Vector *dkySout)
2844 {
2845 int is, ier=0;
2846 IDAMem IDA_mem;
2847
2848 /* Check all inputs for legality */
2849
2850 if (ida_mem == NULL) {
2851 IDAProcessError(NULL, IDA_MEM_NULL, "IDAS", "IDAGetSensDky", MSG_NO_MEM);
2852 return (IDA_MEM_NULL);
2853 }
2854 IDA_mem = (IDAMem) ida_mem;
2855
2856 if (IDA_mem->ida_sensi==SUNFALSE) {
2857 IDAProcessError(IDA_mem, IDA_NO_SENS, "IDAS", "IDAGetSensDky", MSG_NO_SENSI);
2858 return(IDA_NO_SENS);
2859 }
2860
2861 if (dkySout == NULL) {
2862 IDAProcessError(IDA_mem, IDA_BAD_DKY, "IDAS", "IDAGetSensDky", MSG_NULL_DKY);
2863 return(IDA_BAD_DKY);
2864 }
2865
2866 if ((k < 0) || (k > IDA_mem->ida_kk)) {
2867 IDAProcessError(IDA_mem, IDA_BAD_K, "IDAS", "IDAGetSensDky", MSG_BAD_K);
2868 return(IDA_BAD_K);
2869 }
2870
2871 for (is=0; is<IDA_mem->ida_Ns; is++) {
2872 ier = IDAGetSensDky1(ida_mem, t, k, is, dkySout[is]);
2873 if (ier!=IDA_SUCCESS) break;
2874 }
2875
2876 return(ier);
2877 }
2878
2879
2880 /*
2881 * IDAGetSens1
2882 *
2883 * This routine extracts the is-th sensitivity solution into ySout
2884 * at the time at which IDASolve returned the solution.
2885 * This is just a wrapper that calls IDASensDky1 with k=0.
2886 */
2887
IDAGetSens1(void * ida_mem,realtype * ptret,int is,N_Vector yySret)2888 int IDAGetSens1(void *ida_mem, realtype *ptret, int is, N_Vector yySret)
2889 {
2890 IDAMem IDA_mem;
2891
2892 if (ida_mem == NULL) {
2893 IDAProcessError(NULL, IDA_MEM_NULL, "IDAS", "IDAGetSens1", MSG_NO_MEM);
2894 return (IDA_MEM_NULL);
2895 }
2896 IDA_mem = (IDAMem) ida_mem;
2897
2898 *ptret = IDA_mem->ida_tretlast;
2899
2900 return IDAGetSensDky1(ida_mem, *ptret, 0, is, yySret);
2901 }
2902
2903 /*
2904 * IDAGetSensDky1
2905 *
2906 * IDASensDky1 computes the kth derivative of the yS[is] function
2907 * at time t, where tn-hu <= t <= tn, tn denotes the current
2908 * internal time reached, and hu is the last internal step size
2909 * successfully used by the solver. The user may request
2910 * is=0, 1, ..., Ns-1 and k=0, 1, ..., kk, where kk is the current
2911 * order. The derivative vector is returned in dky. This vector
2912 * must be allocated by the caller. It is only legal to call this
2913 * function after a successful return from IDASolve with sensitivity
2914 * computation enabled.
2915 */
IDAGetSensDky1(void * ida_mem,realtype t,int k,int is,N_Vector dkyS)2916 int IDAGetSensDky1(void *ida_mem, realtype t, int k, int is, N_Vector dkyS)
2917 {
2918 IDAMem IDA_mem;
2919 realtype tfuzz, tp, delt, psij_1;
2920 int i, j, retval;
2921 realtype cjk [MXORDP1];
2922 realtype cjk_1[MXORDP1];
2923
2924 /* Check all inputs for legality */
2925 if (ida_mem == NULL) {
2926 IDAProcessError(NULL, IDA_MEM_NULL, "IDAS", "IDAGetSensDky1", MSG_NO_MEM);
2927 return (IDA_MEM_NULL);
2928 }
2929 IDA_mem = (IDAMem) ida_mem;
2930
2931 if (IDA_mem->ida_sensi==SUNFALSE) {
2932 IDAProcessError(IDA_mem, IDA_NO_SENS, "IDAS", "IDAGetSensDky1", MSG_NO_SENSI);
2933 return(IDA_NO_SENS);
2934 }
2935
2936 if (dkyS == NULL) {
2937 IDAProcessError(IDA_mem, IDA_BAD_DKY, "IDAS", "IDAGetSensDky1", MSG_NULL_DKY);
2938 return(IDA_BAD_DKY);
2939 }
2940
2941 /* Is the requested sensitivity index valid? */
2942 if(is<0 || is >= IDA_mem->ida_Ns) {
2943 IDAProcessError(IDA_mem, IDA_BAD_IS, "IDAS", "IDAGetSensDky1", MSG_BAD_IS);
2944 }
2945
2946 /* Is the requested order valid? */
2947 if ((k < 0) || (k > IDA_mem->ida_kused)) {
2948 IDAProcessError(IDA_mem, IDA_BAD_K, "IDAS", "IDAGetSensDky1", MSG_BAD_K);
2949 return(IDA_BAD_K);
2950 }
2951
2952 /* Check t for legality. Here tn - hused is t_{n-1}. */
2953
2954 tfuzz = HUNDRED * IDA_mem->ida_uround * (SUNRabs(IDA_mem->ida_tn) + SUNRabs(IDA_mem->ida_hh));
2955 if (IDA_mem->ida_hh < ZERO) tfuzz = - tfuzz;
2956 tp = IDA_mem->ida_tn - IDA_mem->ida_hused - tfuzz;
2957 if ((t - tp)*IDA_mem->ida_hh < ZERO) {
2958 IDAProcessError(IDA_mem, IDA_BAD_T, "IDAS", "IDAGetSensDky1", MSG_BAD_T,
2959 t, IDA_mem->ida_tn-IDA_mem->ida_hused, IDA_mem->ida_tn);
2960 return(IDA_BAD_T);
2961 }
2962
2963 /* Initialize the c_j^(k) and c_k^(k-1) */
2964 for(i=0; i<MXORDP1; i++) {
2965 cjk [i] = 0;
2966 cjk_1[i] = 0;
2967 }
2968
2969 delt = t - IDA_mem->ida_tn;
2970
2971 for(i=0; i<=k; i++) {
2972
2973 if(i==0) {
2974 cjk[i] = 1;
2975 psij_1 = 0;
2976 }else {
2977 cjk[i] = cjk[i-1]*i / IDA_mem->ida_psi[i-1];
2978 psij_1 = IDA_mem->ida_psi[i-1];
2979 }
2980
2981 /* Update cjk based on the reccurence */
2982 for(j=i+1; j<=IDA_mem->ida_kused-k+i; j++) {
2983 cjk[j] = ( i* cjk_1[j-1] + cjk[j-1] * (delt + psij_1) ) / IDA_mem->ida_psi[j-1];
2984 psij_1 = IDA_mem->ida_psi[j-1];
2985 }
2986
2987 /* Update cjk_1 for the next step */
2988 for(j=i+1; j<=IDA_mem->ida_kused-k+i; j++) cjk_1[j] = cjk[j];
2989 }
2990
2991 /* Compute sum (c_j(t) * phi(t)) */
2992 for(j=k; j<=IDA_mem->ida_kused; j++)
2993 IDA_mem->ida_Xvecs[j-k] = IDA_mem->ida_phiS[j][is];
2994
2995 retval = N_VLinearCombination(IDA_mem->ida_kused-k+1, cjk+k,
2996 IDA_mem->ida_Xvecs, dkyS);
2997 if (retval != IDA_SUCCESS) return (IDA_VECTOROP_ERR);
2998
2999 return(IDA_SUCCESS);
3000 }
3001
3002 /*
3003 * IDAGetQuadSens
3004 *
3005 * This routine extracts quadrature sensitivity solution into yyQSout at the
3006 * time at which IDASolve returned the solution.
3007 * This is just a wrapper that calls IDAGetQuadSensDky1 with k=0 and
3008 * is=0, 1, ... ,NS-1.
3009 */
3010
IDAGetQuadSens(void * ida_mem,realtype * ptret,N_Vector * yyQSout)3011 int IDAGetQuadSens(void *ida_mem, realtype *ptret, N_Vector *yyQSout)
3012 {
3013 IDAMem IDA_mem;
3014 int is, ierr=0;
3015
3016 /* Check ida_mem */
3017 if (ida_mem == NULL) {
3018 IDAProcessError(NULL, IDA_MEM_NULL, "IDAS", "IDAGetQuadSens", MSG_NO_MEM);
3019 return (IDA_MEM_NULL);
3020 }
3021 IDA_mem = (IDAMem) ida_mem;
3022
3023 /*Check the parameters */
3024 if (yyQSout == NULL) {
3025 IDAProcessError(IDA_mem, IDA_BAD_DKY, "IDAS", "IDAGetQuadSens", MSG_NULL_DKY);
3026 return(IDA_BAD_DKY);
3027 }
3028
3029 /* are sensitivities enabled? */
3030 if (IDA_mem->ida_quadr_sensi==SUNFALSE) {
3031 IDAProcessError(IDA_mem, IDA_NO_SENS, "IDAS", "IDAGetQuadSens", MSG_NO_QUADSENSI);
3032 return(IDA_NO_SENS);
3033 }
3034
3035 *ptret = IDA_mem->ida_tretlast;
3036
3037 for(is=0; is<IDA_mem->ida_Ns; is++)
3038 if( IDA_SUCCESS != (ierr = IDAGetQuadSensDky1(ida_mem, *ptret, 0, is, yyQSout[is])) ) break;
3039
3040 return(ierr);
3041 }
3042
3043 /*
3044 * IDAGetQuadSensDky
3045 *
3046 * Computes the k-th derivative of all quadratures sensitivities of the y function at
3047 * time t. It repeatedly calls IDAGetQuadSensDky. The argument dkyS must be
3048 * a pointer to N_Vector and must be allocated by the user to hold at
3049 * least Ns vectors.
3050 */
IDAGetQuadSensDky(void * ida_mem,realtype t,int k,N_Vector * dkyQSout)3051 int IDAGetQuadSensDky(void *ida_mem, realtype t, int k, N_Vector *dkyQSout)
3052 {
3053 int is, ier=0;
3054 IDAMem IDA_mem;
3055
3056 /* Check all inputs for legality */
3057
3058 if (ida_mem == NULL) {
3059 IDAProcessError(NULL, IDA_MEM_NULL, "IDAS", "IDAGetQuadSensDky", MSG_NO_MEM);
3060 return (IDA_MEM_NULL);
3061 }
3062 IDA_mem = (IDAMem) ida_mem;
3063
3064 if (IDA_mem->ida_sensi==SUNFALSE) {
3065 IDAProcessError(IDA_mem, IDA_NO_SENS, "IDAS", "IDAGetQuadSensDky", MSG_NO_SENSI);
3066 return(IDA_NO_SENS);
3067 }
3068
3069 if (IDA_mem->ida_quadr_sensi==SUNFALSE) {
3070 IDAProcessError(IDA_mem, IDA_NO_QUADSENS, "IDAS", "IDAGetQuadSensDky", MSG_NO_QUADSENSI);
3071 return(IDA_NO_QUADSENS);
3072 }
3073
3074 if (dkyQSout == NULL) {
3075 IDAProcessError(IDA_mem, IDA_BAD_DKY, "IDAS", "IDAGetQuadSensDky", MSG_NULL_DKY);
3076 return(IDA_BAD_DKY);
3077 }
3078
3079 if ((k < 0) || (k > IDA_mem->ida_kk)) {
3080 IDAProcessError(IDA_mem, IDA_BAD_K, "IDAS", "IDAGetQuadSensDky", MSG_BAD_K);
3081 return(IDA_BAD_K);
3082 }
3083
3084 for (is=0; is<IDA_mem->ida_Ns; is++) {
3085 ier = IDAGetQuadSensDky1(ida_mem, t, k, is, dkyQSout[is]);
3086 if (ier!=IDA_SUCCESS) break;
3087 }
3088
3089 return(ier);
3090 }
3091
3092
3093 /*
3094 * IDAGetQuadSens1
3095 *
3096 * This routine extracts the is-th quadrature sensitivity solution into yQSout
3097 * at the time at which IDASolve returned the solution.
3098 * This is just a wrapper that calls IDASensDky1 with k=0.
3099 */
3100
IDAGetQuadSens1(void * ida_mem,realtype * ptret,int is,N_Vector yyQSret)3101 int IDAGetQuadSens1(void *ida_mem, realtype *ptret, int is, N_Vector yyQSret)
3102 {
3103 IDAMem IDA_mem;
3104
3105 if (ida_mem == NULL) {
3106 IDAProcessError(NULL, IDA_MEM_NULL, "IDAS", "IDAGetQuadSens1", MSG_NO_MEM);
3107 return (IDA_MEM_NULL);
3108 }
3109 IDA_mem = (IDAMem) ida_mem;
3110
3111 if (IDA_mem->ida_sensi==SUNFALSE) {
3112 IDAProcessError(IDA_mem, IDA_NO_SENS, "IDAS", "IDAGetQuadSens1", MSG_NO_SENSI);
3113 return(IDA_NO_SENS);
3114 }
3115
3116 if (IDA_mem->ida_quadr_sensi==SUNFALSE) {
3117 IDAProcessError(IDA_mem, IDA_NO_QUADSENS, "IDAS", "IDAGetQuadSens1", MSG_NO_QUADSENSI);
3118 return(IDA_NO_QUADSENS);
3119 }
3120
3121 if (yyQSret == NULL) {
3122 IDAProcessError(IDA_mem, IDA_BAD_DKY, "IDAS", "IDAGetQuadSens1", MSG_NULL_DKY);
3123 return(IDA_BAD_DKY);
3124 }
3125
3126 *ptret = IDA_mem->ida_tretlast;
3127
3128 return IDAGetQuadSensDky1(ida_mem, *ptret, 0, is, yyQSret);
3129 }
3130
3131 /*
3132 * IDAGetQuadSensDky1
3133 *
3134 * IDAGetQuadSensDky1 computes the kth derivative of the yS[is] function
3135 * at time t, where tn-hu <= t <= tn, tn denotes the current
3136 * internal time reached, and hu is the last internal step size
3137 * successfully used by the solver. The user may request
3138 * is=0, 1, ..., Ns-1 and k=0, 1, ..., kk, where kk is the current
3139 * order. The derivative vector is returned in dky. This vector
3140 * must be allocated by the caller. It is only legal to call this
3141 * function after a successful return from IDASolve with sensitivity
3142 * computation enabled.
3143 */
IDAGetQuadSensDky1(void * ida_mem,realtype t,int k,int is,N_Vector dkyQS)3144 int IDAGetQuadSensDky1(void *ida_mem, realtype t, int k, int is, N_Vector dkyQS)
3145 {
3146 IDAMem IDA_mem;
3147 realtype tfuzz, tp, delt, psij_1;
3148 int i, j, retval;
3149 realtype cjk [MXORDP1];
3150 realtype cjk_1[MXORDP1];
3151
3152 /* Check all inputs for legality */
3153 if (ida_mem == NULL) {
3154 IDAProcessError(NULL, IDA_MEM_NULL, "IDAS", "IDAGetQuadSensDky1", MSG_NO_MEM);
3155 return (IDA_MEM_NULL);
3156 }
3157 IDA_mem = (IDAMem) ida_mem;
3158
3159 if (IDA_mem->ida_sensi==SUNFALSE) {
3160 IDAProcessError(IDA_mem, IDA_NO_SENS, "IDAS", "IDAGetQuadSensDky1", MSG_NO_SENSI);
3161 return(IDA_NO_SENS);
3162 }
3163
3164 if (IDA_mem->ida_quadr_sensi==SUNFALSE) {
3165 IDAProcessError(IDA_mem, IDA_NO_QUADSENS, "IDAS", "IDAGetQuadSensDky1", MSG_NO_QUADSENSI);
3166 return(IDA_NO_QUADSENS);
3167 }
3168
3169
3170 if (dkyQS == NULL) {
3171 IDAProcessError(IDA_mem, IDA_BAD_DKY, "IDAS", "IDAGetQuadSensDky1", MSG_NULL_DKY);
3172 return(IDA_BAD_DKY);
3173 }
3174
3175 /* Is the requested sensitivity index valid*/
3176 if(is<0 || is >= IDA_mem->ida_Ns) {
3177 IDAProcessError(IDA_mem, IDA_BAD_IS, "IDAS", "IDAGetQuadSensDky1", MSG_BAD_IS);
3178 }
3179
3180 /* Is the requested order valid? */
3181 if ((k < 0) || (k > IDA_mem->ida_kused)) {
3182 IDAProcessError(IDA_mem, IDA_BAD_K, "IDAS", "IDAGetQuadSensDky1", MSG_BAD_K);
3183 return(IDA_BAD_K);
3184 }
3185
3186 /* Check t for legality. Here tn - hused is t_{n-1}. */
3187
3188 tfuzz = HUNDRED * IDA_mem->ida_uround * (SUNRabs(IDA_mem->ida_tn) + SUNRabs(IDA_mem->ida_hh));
3189 if (IDA_mem->ida_hh < ZERO) tfuzz = - tfuzz;
3190 tp = IDA_mem->ida_tn - IDA_mem->ida_hused - tfuzz;
3191 if ((t - tp)*IDA_mem->ida_hh < ZERO) {
3192 IDAProcessError(IDA_mem, IDA_BAD_T, "IDAS", "IDAGetQuadSensDky1", MSG_BAD_T,
3193 t, IDA_mem->ida_tn-IDA_mem->ida_hused, IDA_mem->ida_tn);
3194 return(IDA_BAD_T);
3195 }
3196
3197 /* Initialize the c_j^(k) and c_k^(k-1) */
3198 for(i=0; i<MXORDP1; i++) {
3199 cjk [i] = 0;
3200 cjk_1[i] = 0;
3201 }
3202
3203 delt = t - IDA_mem->ida_tn;
3204
3205 for(i=0; i<=k; i++) {
3206
3207 if(i==0) {
3208 cjk[i] = 1;
3209 psij_1 = 0;
3210 }else {
3211 cjk[i] = cjk[i-1]*i / IDA_mem->ida_psi[i-1];
3212 psij_1 = IDA_mem->ida_psi[i-1];
3213 }
3214
3215 /* Update cjk based on the reccurence */
3216 for(j=i+1; j<=IDA_mem->ida_kused-k+i; j++) {
3217 cjk[j] = ( i* cjk_1[j-1] + cjk[j-1] * (delt + psij_1) ) / IDA_mem->ida_psi[j-1];
3218 psij_1 = IDA_mem->ida_psi[j-1];
3219 }
3220
3221 /* Update cjk_1 for the next step */
3222 for(j=i+1; j<=IDA_mem->ida_kused-k+i; j++) cjk_1[j] = cjk[j];
3223 }
3224
3225 /* Compute sum (c_j(t) * phi(t)) */
3226 for(j=k; j<=IDA_mem->ida_kused; j++)
3227 IDA_mem->ida_Xvecs[j-k] = IDA_mem->ida_phiQS[j][is];
3228
3229 retval = N_VLinearCombination(IDA_mem->ida_kused-k+1, cjk+k,
3230 IDA_mem->ida_Xvecs, dkyQS);
3231 if (retval != IDA_SUCCESS) return (IDA_VECTOROP_ERR);
3232
3233 return(IDA_SUCCESS);
3234 }
3235
3236 /*
3237 * IDAComputeY
3238 *
3239 * Computes y based on the current prediction and given correction.
3240 */
IDAComputeY(void * ida_mem,N_Vector ycor,N_Vector y)3241 int IDAComputeY(void *ida_mem, N_Vector ycor, N_Vector y)
3242 {
3243 IDAMem IDA_mem;
3244
3245 if (ida_mem==NULL) {
3246 IDAProcessError(NULL, IDA_MEM_NULL, "IDAS", "IDAComputeY", MSG_NO_MEM);
3247 return(IDA_MEM_NULL);
3248 }
3249
3250 IDA_mem = (IDAMem) ida_mem;
3251
3252 N_VLinearSum(ONE, IDA_mem->ida_yypredict, ONE, ycor, y);
3253
3254 return(IDA_SUCCESS);
3255 }
3256
3257 /*
3258 * IDAComputeYp
3259 *
3260 * Computes y' based on the current prediction and given correction.
3261 */
IDAComputeYp(void * ida_mem,N_Vector ycor,N_Vector yp)3262 int IDAComputeYp(void *ida_mem, N_Vector ycor, N_Vector yp)
3263 {
3264 IDAMem IDA_mem;
3265
3266 if (ida_mem==NULL) {
3267 IDAProcessError(NULL, IDA_MEM_NULL, "IDAS", "IDAComputeYp", MSG_NO_MEM);
3268 return(IDA_MEM_NULL);
3269 }
3270
3271 IDA_mem = (IDAMem) ida_mem;
3272
3273 N_VLinearSum(ONE, IDA_mem->ida_yppredict, IDA_mem->ida_cj, ycor, yp);
3274
3275 return(IDA_SUCCESS);
3276 }
3277
3278 /*
3279 * IDAComputeYSens
3280 *
3281 * Computes yS based on the current prediction and given correction.
3282 */
IDAComputeYSens(void * ida_mem,N_Vector * ycorS,N_Vector * yyS)3283 int IDAComputeYSens(void *ida_mem, N_Vector *ycorS, N_Vector *yyS)
3284 {
3285 IDAMem IDA_mem;
3286
3287 if (ida_mem==NULL) {
3288 IDAProcessError(NULL, IDA_MEM_NULL, "IDAS", "IDAComputeYSens", MSG_NO_MEM);
3289 return(IDA_MEM_NULL);
3290 }
3291
3292 IDA_mem = (IDAMem) ida_mem;
3293
3294 N_VLinearSumVectorArray(IDA_mem->ida_Ns,
3295 ONE, IDA_mem->ida_yySpredict,
3296 ONE, ycorS, yyS);
3297
3298 return(IDA_SUCCESS);
3299 }
3300
3301 /*
3302 * IDAComputeYpSens
3303 *
3304 * Computes yS' based on the current prediction and given correction.
3305 */
IDAComputeYpSens(void * ida_mem,N_Vector * ycorS,N_Vector * ypS)3306 int IDAComputeYpSens(void *ida_mem, N_Vector *ycorS, N_Vector *ypS)
3307 {
3308 IDAMem IDA_mem;
3309
3310 if (ida_mem==NULL) {
3311 IDAProcessError(NULL, IDA_MEM_NULL, "IDAS", "IDAComputeYpSens", MSG_NO_MEM);
3312 return(IDA_MEM_NULL);
3313 }
3314
3315 IDA_mem = (IDAMem) ida_mem;
3316
3317 N_VLinearSumVectorArray(IDA_mem->ida_Ns,
3318 ONE, IDA_mem->ida_ypSpredict,
3319 IDA_mem->ida_cj, ycorS, ypS);
3320
3321 return(IDA_SUCCESS);
3322 }
3323
3324 /*
3325 * -----------------------------------------------------------------
3326 * Deallocation functions
3327 * -----------------------------------------------------------------
3328 */
3329
3330 /*
3331 * IDAFree
3332 *
3333 * This routine frees the problem memory allocated by IDAInit
3334 * Such memory includes all the vectors allocated by IDAAllocVectors,
3335 * and the memory lmem for the linear solver (deallocated by a call
3336 * to lfree).
3337 */
3338
IDAFree(void ** ida_mem)3339 void IDAFree(void **ida_mem)
3340 {
3341 IDAMem IDA_mem;
3342
3343 if (*ida_mem == NULL) return;
3344
3345 IDA_mem = (IDAMem) (*ida_mem);
3346
3347 IDAFreeVectors(IDA_mem);
3348
3349 IDAQuadFree(IDA_mem);
3350
3351 IDASensFree(IDA_mem);
3352
3353 IDAQuadSensFree(IDA_mem);
3354
3355 IDAAdjFree(IDA_mem);
3356
3357 /* if IDA created the NLS object then free it */
3358 if (IDA_mem->ownNLS) {
3359 SUNNonlinSolFree(IDA_mem->NLS);
3360 IDA_mem->ownNLS = SUNFALSE;
3361 IDA_mem->NLS = NULL;
3362 }
3363
3364 if (IDA_mem->ida_lfree != NULL)
3365 IDA_mem->ida_lfree(IDA_mem);
3366
3367 if (IDA_mem->ida_nrtfn > 0) {
3368 free(IDA_mem->ida_glo); IDA_mem->ida_glo = NULL;
3369 free(IDA_mem->ida_ghi); IDA_mem->ida_ghi = NULL;
3370 free(IDA_mem->ida_grout); IDA_mem->ida_grout = NULL;
3371 free(IDA_mem->ida_iroots); IDA_mem->ida_iroots = NULL;
3372 free(IDA_mem->ida_rootdir); IDA_mem->ida_rootdir = NULL;
3373 free(IDA_mem->ida_gactive); IDA_mem->ida_gactive = NULL;
3374 }
3375
3376 free(IDA_mem->ida_cvals); IDA_mem->ida_cvals = NULL;
3377 free(IDA_mem->ida_Xvecs); IDA_mem->ida_Xvecs = NULL;
3378 free(IDA_mem->ida_Zvecs); IDA_mem->ida_Zvecs = NULL;
3379
3380 free(*ida_mem);
3381 *ida_mem = NULL;
3382 }
3383
3384 /*
3385 * IDAQuadFree
3386 *
3387 * IDAQuadFree frees the problem memory in ida_mem allocated
3388 * for quadrature integration. Its only argument is the pointer
3389 * ida_mem returned by IDACreate.
3390 */
3391
IDAQuadFree(void * ida_mem)3392 void IDAQuadFree(void *ida_mem)
3393 {
3394 IDAMem IDA_mem;
3395
3396 if (ida_mem == NULL) return;
3397 IDA_mem = (IDAMem) ida_mem;
3398
3399 if(IDA_mem->ida_quadMallocDone) {
3400 IDAQuadFreeVectors(IDA_mem);
3401 IDA_mem->ida_quadMallocDone = SUNFALSE;
3402 IDA_mem->ida_quadr = SUNFALSE;
3403 }
3404 }
3405
3406 /*
3407 * IDASensFree
3408 *
3409 * IDASensFree frees the problem memory in ida_mem allocated
3410 * for sensitivity analysis. Its only argument is the pointer
3411 * ida_mem returned by IDACreate.
3412 */
3413
IDASensFree(void * ida_mem)3414 void IDASensFree(void *ida_mem)
3415 {
3416 IDAMem IDA_mem;
3417
3418 /* return immediately if IDA memory is NULL */
3419 if (ida_mem == NULL) return;
3420 IDA_mem = (IDAMem) ida_mem;
3421
3422 if(IDA_mem->ida_sensMallocDone) {
3423 IDASensFreeVectors(IDA_mem);
3424 IDA_mem->ida_sensMallocDone = SUNFALSE;
3425 IDA_mem->ida_sensi = SUNFALSE;
3426 }
3427
3428 /* free any vector wrappers */
3429 if (IDA_mem->simMallocDone) {
3430 N_VDestroy(IDA_mem->ypredictSim); IDA_mem->ypredictSim = NULL;
3431 N_VDestroy(IDA_mem->ycorSim); IDA_mem->ycorSim = NULL;
3432 N_VDestroy(IDA_mem->ewtSim); IDA_mem->ewtSim = NULL;
3433 IDA_mem->simMallocDone = SUNFALSE;
3434 }
3435 if (IDA_mem->stgMallocDone) {
3436 N_VDestroy(IDA_mem->ypredictStg); IDA_mem->ypredictStg = NULL;
3437 N_VDestroy(IDA_mem->ycorStg); IDA_mem->ycorStg = NULL;
3438 N_VDestroy(IDA_mem->ewtStg); IDA_mem->ewtStg = NULL;
3439 IDA_mem->stgMallocDone = SUNFALSE;
3440 }
3441
3442 /* if IDA created the NLS object then free it */
3443 if (IDA_mem->ownNLSsim) {
3444 SUNNonlinSolFree(IDA_mem->NLSsim);
3445 IDA_mem->ownNLSsim = SUNFALSE;
3446 IDA_mem->NLSsim = NULL;
3447 }
3448 if (IDA_mem->ownNLSstg) {
3449 SUNNonlinSolFree(IDA_mem->NLSstg);
3450 IDA_mem->ownNLSstg = SUNFALSE;
3451 IDA_mem->NLSstg = NULL;
3452 }
3453
3454 /* free min atol array if necessary */
3455 if (IDA_mem->ida_atolSmin0) {
3456 free(IDA_mem->ida_atolSmin0);
3457 IDA_mem->ida_atolSmin0 = NULL;
3458 }
3459 }
3460
3461 /*
3462 * IDAQuadSensFree
3463 *
3464 * IDAQuadSensFree frees the problem memory in ida_mem allocated
3465 * for quadrature sensitivity analysis. Its only argument is the
3466 * pointer ida_mem returned by IDACreate.
3467 */
IDAQuadSensFree(void * ida_mem)3468 void IDAQuadSensFree(void* ida_mem)
3469 {
3470 IDAMem IDA_mem;
3471
3472 if (ida_mem==NULL) return;
3473 IDA_mem = (IDAMem) ida_mem;
3474
3475 if (IDA_mem->ida_quadSensMallocDone) {
3476 IDAQuadSensFreeVectors(IDA_mem);
3477 IDA_mem->ida_quadSensMallocDone=SUNFALSE;
3478 IDA_mem->ida_quadr_sensi = SUNFALSE;
3479 }
3480
3481 /* free min atol array if necessary */
3482 if (IDA_mem->ida_atolQSmin0) {
3483 free(IDA_mem->ida_atolQSmin0);
3484 IDA_mem->ida_atolQSmin0 = NULL;
3485 }
3486 }
3487
3488 /*
3489 * =================================================================
3490 * PRIVATE FUNCTIONS
3491 * =================================================================
3492 */
3493
3494 /*
3495 * IDACheckNvector
3496 *
3497 * This routine checks if all required vector operations are present.
3498 * If any of them is missing it returns SUNFALSE.
3499 */
3500
IDACheckNvector(N_Vector tmpl)3501 static booleantype IDACheckNvector(N_Vector tmpl)
3502 {
3503 if ((tmpl->ops->nvclone == NULL) ||
3504 (tmpl->ops->nvdestroy == NULL) ||
3505 (tmpl->ops->nvlinearsum == NULL) ||
3506 (tmpl->ops->nvconst == NULL) ||
3507 (tmpl->ops->nvprod == NULL) ||
3508 (tmpl->ops->nvscale == NULL) ||
3509 (tmpl->ops->nvabs == NULL) ||
3510 (tmpl->ops->nvinv == NULL) ||
3511 (tmpl->ops->nvaddconst == NULL) ||
3512 (tmpl->ops->nvwrmsnorm == NULL) ||
3513 (tmpl->ops->nvmin == NULL))
3514 return(SUNFALSE);
3515 else
3516 return(SUNTRUE);
3517 }
3518
3519 /*
3520 * -----------------------------------------------------------------
3521 * Memory allocation/deallocation
3522 * -----------------------------------------------------------------
3523 */
3524
3525 /*
3526 * IDAAllocVectors
3527 *
3528 * This routine allocates the IDA vectors ewt, tempv1, tempv2, and
3529 * phi[0], ..., phi[maxord].
3530 * If all memory allocations are successful, IDAAllocVectors returns
3531 * SUNTRUE. Otherwise all allocated memory is freed and IDAAllocVectors
3532 * returns SUNFALSE.
3533 * This routine also sets the optional outputs lrw and liw, which are
3534 * (respectively) the lengths of the real and integer work spaces
3535 * allocated here.
3536 */
3537
IDAAllocVectors(IDAMem IDA_mem,N_Vector tmpl)3538 static booleantype IDAAllocVectors(IDAMem IDA_mem, N_Vector tmpl)
3539 {
3540 int i, j, maxcol;
3541
3542 /* Allocate ewt, ee, delta, yypredict, yppredict, savres, tempv1, tempv2, tempv3 */
3543
3544 IDA_mem->ida_ewt = N_VClone(tmpl);
3545 if (IDA_mem->ida_ewt == NULL) return(SUNFALSE);
3546
3547 IDA_mem->ida_ee = N_VClone(tmpl);
3548 if (IDA_mem->ida_ee == NULL) {
3549 N_VDestroy(IDA_mem->ida_ewt);
3550 return(SUNFALSE);
3551 }
3552
3553 IDA_mem->ida_delta = N_VClone(tmpl);
3554 if (IDA_mem->ida_delta == NULL) {
3555 N_VDestroy(IDA_mem->ida_ewt);
3556 N_VDestroy(IDA_mem->ida_ee);
3557 return(SUNFALSE);
3558 }
3559
3560 IDA_mem->ida_yypredict = N_VClone(tmpl);
3561 if (IDA_mem->ida_yypredict == NULL) {
3562 N_VDestroy(IDA_mem->ida_ewt);
3563 N_VDestroy(IDA_mem->ida_ee);
3564 N_VDestroy(IDA_mem->ida_delta);
3565 return(SUNFALSE);
3566 }
3567
3568 IDA_mem->ida_yppredict = N_VClone(tmpl);
3569 if (IDA_mem->ida_yppredict == NULL) {
3570 N_VDestroy(IDA_mem->ida_ewt);
3571 N_VDestroy(IDA_mem->ida_ee);
3572 N_VDestroy(IDA_mem->ida_delta);
3573 N_VDestroy(IDA_mem->ida_yypredict);
3574 return(SUNFALSE);
3575 }
3576
3577 IDA_mem->ida_savres = N_VClone(tmpl);
3578 if (IDA_mem->ida_savres == NULL) {
3579 N_VDestroy(IDA_mem->ida_ewt);
3580 N_VDestroy(IDA_mem->ida_ee);
3581 N_VDestroy(IDA_mem->ida_delta);
3582 N_VDestroy(IDA_mem->ida_yypredict);
3583 N_VDestroy(IDA_mem->ida_yppredict);
3584 return(SUNFALSE);
3585 }
3586
3587 IDA_mem->ida_tempv1 = N_VClone(tmpl);
3588 if (IDA_mem->ida_tempv1 == NULL) {
3589 N_VDestroy(IDA_mem->ida_ewt);
3590 N_VDestroy(IDA_mem->ida_ee);
3591 N_VDestroy(IDA_mem->ida_delta);
3592 N_VDestroy(IDA_mem->ida_yypredict);
3593 N_VDestroy(IDA_mem->ida_yppredict);
3594 N_VDestroy(IDA_mem->ida_savres);
3595 return(SUNFALSE);
3596 }
3597
3598 IDA_mem->ida_tempv2 = N_VClone(tmpl);
3599 if (IDA_mem->ida_tempv2 == NULL) {
3600 N_VDestroy(IDA_mem->ida_ewt);
3601 N_VDestroy(IDA_mem->ida_ee);
3602 N_VDestroy(IDA_mem->ida_delta);
3603 N_VDestroy(IDA_mem->ida_yypredict);
3604 N_VDestroy(IDA_mem->ida_yppredict);
3605 N_VDestroy(IDA_mem->ida_savres);
3606 N_VDestroy(IDA_mem->ida_tempv1);
3607 return(SUNFALSE);
3608 }
3609
3610 IDA_mem->ida_tempv3 = N_VClone(tmpl);
3611 if (IDA_mem->ida_tempv3 == NULL) {
3612 N_VDestroy(IDA_mem->ida_ewt);
3613 N_VDestroy(IDA_mem->ida_ee);
3614 N_VDestroy(IDA_mem->ida_delta);
3615 N_VDestroy(IDA_mem->ida_yypredict);
3616 N_VDestroy(IDA_mem->ida_yppredict);
3617 N_VDestroy(IDA_mem->ida_savres);
3618 N_VDestroy(IDA_mem->ida_tempv1);
3619 N_VDestroy(IDA_mem->ida_tempv2);
3620 return(SUNFALSE);
3621 }
3622
3623 /* Allocate phi[0] ... phi[maxord]. Make sure phi[2] and phi[3] are
3624 allocated (for use as temporary vectors), regardless of maxord. */
3625
3626 maxcol = SUNMAX(IDA_mem->ida_maxord,3);
3627 for (j=0; j <= maxcol; j++) {
3628 IDA_mem->ida_phi[j] = N_VClone(tmpl);
3629 if (IDA_mem->ida_phi[j] == NULL) {
3630 N_VDestroy(IDA_mem->ida_ewt);
3631 N_VDestroy(IDA_mem->ida_ee);
3632 N_VDestroy(IDA_mem->ida_delta);
3633 N_VDestroy(IDA_mem->ida_yypredict);
3634 N_VDestroy(IDA_mem->ida_yppredict);
3635 N_VDestroy(IDA_mem->ida_savres);
3636 N_VDestroy(IDA_mem->ida_tempv1);
3637 N_VDestroy(IDA_mem->ida_tempv2);
3638 N_VDestroy(IDA_mem->ida_tempv3);
3639 for (i=0; i < j; i++) N_VDestroy(IDA_mem->ida_phi[i]);
3640 return(SUNFALSE);
3641 }
3642 }
3643
3644 /* Update solver workspace lengths */
3645 IDA_mem->ida_lrw += (maxcol + 10)*IDA_mem->ida_lrw1;
3646 IDA_mem->ida_liw += (maxcol + 10)*IDA_mem->ida_liw1;
3647
3648 /* Store the value of maxord used here */
3649 IDA_mem->ida_maxord_alloc = IDA_mem->ida_maxord;
3650
3651 return(SUNTRUE);
3652 }
3653
3654 /*
3655 * IDAfreeVectors
3656 *
3657 * This routine frees the IDA vectors allocated for IDA.
3658 */
3659
IDAFreeVectors(IDAMem IDA_mem)3660 static void IDAFreeVectors(IDAMem IDA_mem)
3661 {
3662 int j, maxcol;
3663
3664 N_VDestroy(IDA_mem->ida_ewt); IDA_mem->ida_ewt = NULL;
3665 N_VDestroy(IDA_mem->ida_ee); IDA_mem->ida_ee = NULL;
3666 N_VDestroy(IDA_mem->ida_delta); IDA_mem->ida_delta = NULL;
3667 N_VDestroy(IDA_mem->ida_yypredict); IDA_mem->ida_yypredict = NULL;
3668 N_VDestroy(IDA_mem->ida_yppredict); IDA_mem->ida_yppredict = NULL;
3669 N_VDestroy(IDA_mem->ida_savres); IDA_mem->ida_savres = NULL;
3670 N_VDestroy(IDA_mem->ida_tempv1); IDA_mem->ida_tempv1 = NULL;
3671 N_VDestroy(IDA_mem->ida_tempv2); IDA_mem->ida_tempv2 = NULL;
3672 N_VDestroy(IDA_mem->ida_tempv3); IDA_mem->ida_tempv3 = NULL;
3673 maxcol = SUNMAX(IDA_mem->ida_maxord_alloc,3);
3674 for(j=0; j <= maxcol; j++) {
3675 N_VDestroy(IDA_mem->ida_phi[j]);
3676 IDA_mem->ida_phi[j] = NULL;
3677 }
3678
3679 IDA_mem->ida_lrw -= (maxcol + 10)*IDA_mem->ida_lrw1;
3680 IDA_mem->ida_liw -= (maxcol + 10)*IDA_mem->ida_liw1;
3681
3682 if (IDA_mem->ida_VatolMallocDone) {
3683 N_VDestroy(IDA_mem->ida_Vatol); IDA_mem->ida_Vatol = NULL;
3684 IDA_mem->ida_lrw -= IDA_mem->ida_lrw1;
3685 IDA_mem->ida_liw -= IDA_mem->ida_liw1;
3686 }
3687
3688 if (IDA_mem->ida_constraintsMallocDone) {
3689 N_VDestroy(IDA_mem->ida_constraints);
3690 IDA_mem->ida_constraints = NULL;
3691 IDA_mem->ida_lrw -= IDA_mem->ida_lrw1;
3692 IDA_mem->ida_liw -= IDA_mem->ida_liw1;
3693 }
3694
3695 if (IDA_mem->ida_idMallocDone) {
3696 N_VDestroy(IDA_mem->ida_id); IDA_mem->ida_id = NULL;
3697 IDA_mem->ida_lrw -= IDA_mem->ida_lrw1;
3698 IDA_mem->ida_liw -= IDA_mem->ida_liw1;
3699 }
3700
3701 }
3702
3703 /*
3704 * IDAQuadAllocVectors
3705 *
3706 * NOTE: Space for ewtQ is allocated even when errconQ=SUNFALSE,
3707 * although in this case, ewtQ is never used. The reason for this
3708 * decision is to allow the user to re-initialize the quadrature
3709 * computation with errconQ=SUNTRUE, after an initialization with
3710 * errconQ=SUNFALSE, without new memory allocation within
3711 * IDAQuadReInit.
3712 */
3713
IDAQuadAllocVectors(IDAMem IDA_mem,N_Vector tmpl)3714 static booleantype IDAQuadAllocVectors(IDAMem IDA_mem, N_Vector tmpl)
3715 {
3716 int i, j;
3717
3718 /* Allocate yyQ */
3719 IDA_mem->ida_yyQ = N_VClone(tmpl);
3720 if (IDA_mem->ida_yyQ == NULL) {
3721 return (SUNFALSE);
3722 }
3723
3724 /* Allocate ypQ */
3725 IDA_mem->ida_ypQ = N_VClone(tmpl);
3726 if (IDA_mem->ida_ypQ == NULL) {
3727 N_VDestroy(IDA_mem->ida_yyQ);
3728 return (SUNFALSE);
3729 }
3730
3731 /* Allocate ewtQ */
3732 IDA_mem->ida_ewtQ = N_VClone(tmpl);
3733 if (IDA_mem->ida_ewtQ == NULL) {
3734 N_VDestroy(IDA_mem->ida_yyQ);
3735 N_VDestroy(IDA_mem->ida_ypQ);
3736 return (SUNFALSE);
3737 }
3738
3739 /* Allocate eeQ */
3740 IDA_mem->ida_eeQ = N_VClone(tmpl);
3741 if (IDA_mem->ida_eeQ == NULL) {
3742 N_VDestroy(IDA_mem->ida_yyQ);
3743 N_VDestroy(IDA_mem->ida_ypQ);
3744 N_VDestroy(IDA_mem->ida_ewtQ);
3745 return (SUNFALSE);
3746 }
3747
3748 for (j=0; j <= IDA_mem->ida_maxord; j++) {
3749 IDA_mem->ida_phiQ[j] = N_VClone(tmpl);
3750 if (IDA_mem->ida_phiQ[j] == NULL) {
3751 N_VDestroy(IDA_mem->ida_yyQ);
3752 N_VDestroy(IDA_mem->ida_ypQ);
3753 N_VDestroy(IDA_mem->ida_ewtQ);
3754 N_VDestroy(IDA_mem->ida_eeQ);
3755 for (i=0; i < j; i++) N_VDestroy(IDA_mem->ida_phiQ[i]);
3756 return(SUNFALSE);
3757 }
3758 }
3759
3760 IDA_mem->ida_lrw += (IDA_mem->ida_maxord+4)*IDA_mem->ida_lrw1Q;
3761 IDA_mem->ida_liw += (IDA_mem->ida_maxord+4)*IDA_mem->ida_liw1Q;
3762
3763 return(SUNTRUE);
3764 }
3765
3766
3767
3768 /*
3769 * IDAQuadFreeVectors
3770 *
3771 * This routine frees the IDAS vectors allocated in IDAQuadAllocVectors.
3772 */
3773
IDAQuadFreeVectors(IDAMem IDA_mem)3774 static void IDAQuadFreeVectors(IDAMem IDA_mem)
3775 {
3776 int j;
3777
3778 N_VDestroy(IDA_mem->ida_yyQ); IDA_mem->ida_yyQ = NULL;
3779 N_VDestroy(IDA_mem->ida_ypQ); IDA_mem->ida_ypQ = NULL;
3780 N_VDestroy(IDA_mem->ida_ewtQ); IDA_mem->ida_ewtQ = NULL;
3781 N_VDestroy(IDA_mem->ida_eeQ); IDA_mem->ida_eeQ = NULL;
3782 for(j=0; j <= IDA_mem->ida_maxord; j++) {
3783 N_VDestroy(IDA_mem->ida_phiQ[j]);
3784 IDA_mem->ida_phiQ[j] = NULL;
3785 }
3786
3787 IDA_mem->ida_lrw -= (IDA_mem->ida_maxord+5)*IDA_mem->ida_lrw1Q;
3788 IDA_mem->ida_liw -= (IDA_mem->ida_maxord+5)*IDA_mem->ida_liw1Q;
3789
3790 if (IDA_mem->ida_VatolQMallocDone) {
3791 N_VDestroy(IDA_mem->ida_VatolQ); IDA_mem->ida_VatolQ = NULL;
3792 IDA_mem->ida_lrw -= IDA_mem->ida_lrw1Q;
3793 IDA_mem->ida_liw -= IDA_mem->ida_liw1Q;
3794 }
3795
3796 IDA_mem->ida_VatolQMallocDone = SUNFALSE;
3797 }
3798
3799 /*
3800 * IDASensAllocVectors
3801 *
3802 * Allocates space for the N_Vectors, plist, and pbar required for FSA.
3803 */
3804
IDASensAllocVectors(IDAMem IDA_mem,N_Vector tmpl)3805 static booleantype IDASensAllocVectors(IDAMem IDA_mem, N_Vector tmpl)
3806 {
3807 int j, maxcol;
3808
3809 IDA_mem->ida_tmpS1 = IDA_mem->ida_tempv1;
3810 IDA_mem->ida_tmpS2 = IDA_mem->ida_tempv2;
3811
3812 /* Allocate space for workspace vectors */
3813
3814 IDA_mem->ida_tmpS3 = N_VClone(tmpl);
3815 if (IDA_mem->ida_tmpS3==NULL) {
3816 return(SUNFALSE);
3817 }
3818
3819 IDA_mem->ida_ewtS = N_VCloneVectorArray(IDA_mem->ida_Ns, tmpl);
3820 if (IDA_mem->ida_ewtS==NULL) {
3821 N_VDestroy(IDA_mem->ida_tmpS3);
3822 return(SUNFALSE);
3823 }
3824
3825 IDA_mem->ida_eeS = N_VCloneVectorArray(IDA_mem->ida_Ns, tmpl);
3826 if (IDA_mem->ida_eeS==NULL) {
3827 N_VDestroy(IDA_mem->ida_tmpS3);
3828 N_VDestroyVectorArray(IDA_mem->ida_ewtS, IDA_mem->ida_Ns);
3829 return(SUNFALSE);
3830 }
3831
3832 IDA_mem->ida_yyS = N_VCloneVectorArray(IDA_mem->ida_Ns, tmpl);
3833 if (IDA_mem->ida_yyS==NULL) {
3834 N_VDestroyVectorArray(IDA_mem->ida_eeS, IDA_mem->ida_Ns);
3835 N_VDestroyVectorArray(IDA_mem->ida_ewtS, IDA_mem->ida_Ns);
3836 N_VDestroy(IDA_mem->ida_tmpS3);
3837 return(SUNFALSE);
3838 }
3839
3840 IDA_mem->ida_ypS = N_VCloneVectorArray(IDA_mem->ida_Ns, tmpl);
3841 if (IDA_mem->ida_ypS==NULL) {
3842 N_VDestroyVectorArray(IDA_mem->ida_yyS, IDA_mem->ida_Ns);
3843 N_VDestroyVectorArray(IDA_mem->ida_eeS, IDA_mem->ida_Ns);
3844 N_VDestroyVectorArray(IDA_mem->ida_ewtS, IDA_mem->ida_Ns);
3845 N_VDestroy(IDA_mem->ida_tmpS3);
3846 return(SUNFALSE);
3847 }
3848
3849 IDA_mem->ida_yySpredict = N_VCloneVectorArray(IDA_mem->ida_Ns, tmpl);
3850 if (IDA_mem->ida_yySpredict==NULL) {
3851 N_VDestroyVectorArray(IDA_mem->ida_ypS, IDA_mem->ida_Ns);
3852 N_VDestroyVectorArray(IDA_mem->ida_yyS, IDA_mem->ida_Ns);
3853 N_VDestroyVectorArray(IDA_mem->ida_eeS, IDA_mem->ida_Ns);
3854 N_VDestroyVectorArray(IDA_mem->ida_ewtS, IDA_mem->ida_Ns);
3855 N_VDestroy(IDA_mem->ida_tmpS3);
3856 return(SUNFALSE);
3857 }
3858
3859 IDA_mem->ida_ypSpredict = N_VCloneVectorArray(IDA_mem->ida_Ns, tmpl);
3860 if (IDA_mem->ida_ypSpredict==NULL) {
3861 N_VDestroyVectorArray(IDA_mem->ida_yySpredict, IDA_mem->ida_Ns);
3862 N_VDestroyVectorArray(IDA_mem->ida_ypS, IDA_mem->ida_Ns);
3863 N_VDestroyVectorArray(IDA_mem->ida_yyS, IDA_mem->ida_Ns);
3864 N_VDestroyVectorArray(IDA_mem->ida_eeS, IDA_mem->ida_Ns);
3865 N_VDestroyVectorArray(IDA_mem->ida_ewtS, IDA_mem->ida_Ns);
3866 N_VDestroy(IDA_mem->ida_tmpS3);
3867 return(SUNFALSE);
3868 }
3869
3870 IDA_mem->ida_deltaS = N_VCloneVectorArray(IDA_mem->ida_Ns, tmpl);
3871 if (IDA_mem->ida_deltaS==NULL) {
3872 N_VDestroyVectorArray(IDA_mem->ida_ypSpredict, IDA_mem->ida_Ns);
3873 N_VDestroyVectorArray(IDA_mem->ida_yySpredict, IDA_mem->ida_Ns);
3874 N_VDestroyVectorArray(IDA_mem->ida_ypS, IDA_mem->ida_Ns);
3875 N_VDestroyVectorArray(IDA_mem->ida_yyS, IDA_mem->ida_Ns);
3876 N_VDestroyVectorArray(IDA_mem->ida_eeS, IDA_mem->ida_Ns);
3877 N_VDestroyVectorArray(IDA_mem->ida_ewtS, IDA_mem->ida_Ns);
3878 N_VDestroy(IDA_mem->ida_tmpS3);
3879 return(SUNFALSE);
3880 }
3881
3882 /* Update solver workspace lengths */
3883 IDA_mem->ida_lrw += (5*IDA_mem->ida_Ns+1)*IDA_mem->ida_lrw1;
3884 IDA_mem->ida_liw += (5*IDA_mem->ida_Ns+1)*IDA_mem->ida_liw1;
3885
3886 /* Allocate space for phiS */
3887 /* Make sure phiS[2], phiS[3] and phiS[4] are
3888 allocated (for use as temporary vectors), regardless of maxord.*/
3889
3890 maxcol = SUNMAX(IDA_mem->ida_maxord,4);
3891 for (j=0; j <= maxcol; j++) {
3892 IDA_mem->ida_phiS[j] = N_VCloneVectorArray(IDA_mem->ida_Ns, tmpl);
3893 if (IDA_mem->ida_phiS[j] == NULL) {
3894 N_VDestroy(IDA_mem->ida_tmpS3);
3895 N_VDestroyVectorArray(IDA_mem->ida_ewtS, IDA_mem->ida_Ns);
3896 N_VDestroyVectorArray(IDA_mem->ida_eeS, IDA_mem->ida_Ns);
3897 N_VDestroyVectorArray(IDA_mem->ida_yyS, IDA_mem->ida_Ns);
3898 N_VDestroyVectorArray(IDA_mem->ida_ypS, IDA_mem->ida_Ns);
3899 N_VDestroyVectorArray(IDA_mem->ida_yySpredict, IDA_mem->ida_Ns);
3900 N_VDestroyVectorArray(IDA_mem->ida_ypSpredict, IDA_mem->ida_Ns);
3901 N_VDestroyVectorArray(IDA_mem->ida_deltaS, IDA_mem->ida_Ns);
3902 return(SUNFALSE);
3903 }
3904 }
3905
3906 /* Update solver workspace lengths */
3907 IDA_mem->ida_lrw += maxcol*IDA_mem->ida_Ns*IDA_mem->ida_lrw1;
3908 IDA_mem->ida_liw += maxcol*IDA_mem->ida_Ns*IDA_mem->ida_liw1;
3909
3910 /* Allocate space for pbar and plist */
3911
3912 IDA_mem->ida_pbar = NULL;
3913 IDA_mem->ida_pbar = (realtype *)malloc(IDA_mem->ida_Ns*sizeof(realtype));
3914 if (IDA_mem->ida_pbar == NULL) {
3915 N_VDestroy(IDA_mem->ida_tmpS3);
3916 N_VDestroyVectorArray(IDA_mem->ida_ewtS, IDA_mem->ida_Ns);
3917 N_VDestroyVectorArray(IDA_mem->ida_eeS, IDA_mem->ida_Ns);
3918 N_VDestroyVectorArray(IDA_mem->ida_yyS, IDA_mem->ida_Ns);
3919 N_VDestroyVectorArray(IDA_mem->ida_ypS, IDA_mem->ida_Ns);
3920 N_VDestroyVectorArray(IDA_mem->ida_yySpredict, IDA_mem->ida_Ns);
3921 N_VDestroyVectorArray(IDA_mem->ida_ypSpredict, IDA_mem->ida_Ns);
3922 N_VDestroyVectorArray(IDA_mem->ida_deltaS, IDA_mem->ida_Ns);
3923 for (j=0; j<=maxcol; j++) N_VDestroyVectorArray(IDA_mem->ida_phiS[j], IDA_mem->ida_Ns);
3924 return(SUNFALSE);
3925 }
3926
3927 IDA_mem->ida_plist = NULL;
3928 IDA_mem->ida_plist = (int *)malloc(IDA_mem->ida_Ns*sizeof(int));
3929 if (IDA_mem->ida_plist == NULL) {
3930 N_VDestroy(IDA_mem->ida_tmpS3);
3931 N_VDestroyVectorArray(IDA_mem->ida_ewtS, IDA_mem->ida_Ns);
3932 N_VDestroyVectorArray(IDA_mem->ida_eeS, IDA_mem->ida_Ns);
3933 N_VDestroyVectorArray(IDA_mem->ida_yyS, IDA_mem->ida_Ns);
3934 N_VDestroyVectorArray(IDA_mem->ida_ypS, IDA_mem->ida_Ns);
3935 N_VDestroyVectorArray(IDA_mem->ida_yySpredict, IDA_mem->ida_Ns);
3936 N_VDestroyVectorArray(IDA_mem->ida_ypSpredict, IDA_mem->ida_Ns);
3937 N_VDestroyVectorArray(IDA_mem->ida_deltaS, IDA_mem->ida_Ns);
3938 for (j=0; j<=maxcol; j++) N_VDestroyVectorArray(IDA_mem->ida_phiS[j], IDA_mem->ida_Ns);
3939 free(IDA_mem->ida_pbar); IDA_mem->ida_pbar = NULL;
3940 return(SUNFALSE);
3941 }
3942
3943 /* Update solver workspace lengths */
3944 IDA_mem->ida_lrw += IDA_mem->ida_Ns;
3945 IDA_mem->ida_liw += IDA_mem->ida_Ns;
3946
3947 return(SUNTRUE);
3948 }
3949
3950 /*
3951 * IDASensFreeVectors
3952 *
3953 * Frees memory allocated by IDASensAllocVectors.
3954 */
3955
IDASensFreeVectors(IDAMem IDA_mem)3956 static void IDASensFreeVectors(IDAMem IDA_mem)
3957 {
3958 int j, maxcol;
3959
3960 N_VDestroyVectorArray(IDA_mem->ida_deltaS, IDA_mem->ida_Ns);
3961 N_VDestroyVectorArray(IDA_mem->ida_ypSpredict, IDA_mem->ida_Ns);
3962 N_VDestroyVectorArray(IDA_mem->ida_yySpredict, IDA_mem->ida_Ns);
3963 N_VDestroyVectorArray(IDA_mem->ida_ypS, IDA_mem->ida_Ns);
3964 N_VDestroyVectorArray(IDA_mem->ida_yyS, IDA_mem->ida_Ns);
3965 N_VDestroyVectorArray(IDA_mem->ida_eeS, IDA_mem->ida_Ns);
3966 N_VDestroyVectorArray(IDA_mem->ida_ewtS, IDA_mem->ida_Ns);
3967 N_VDestroy(IDA_mem->ida_tmpS3);
3968
3969 maxcol = SUNMAX(IDA_mem->ida_maxord_alloc, 4);
3970 for (j=0; j<=maxcol; j++)
3971 N_VDestroyVectorArray(IDA_mem->ida_phiS[j], IDA_mem->ida_Ns);
3972
3973 free(IDA_mem->ida_pbar); IDA_mem->ida_pbar = NULL;
3974 free(IDA_mem->ida_plist); IDA_mem->ida_plist = NULL;
3975
3976 IDA_mem->ida_lrw -= ( (maxcol+3)*IDA_mem->ida_Ns + 1 ) * IDA_mem->ida_lrw1 + IDA_mem->ida_Ns;
3977 IDA_mem->ida_liw -= ( (maxcol+3)*IDA_mem->ida_Ns + 1 ) * IDA_mem->ida_liw1 + IDA_mem->ida_Ns;
3978
3979 if (IDA_mem->ida_VatolSMallocDone) {
3980 N_VDestroyVectorArray(IDA_mem->ida_VatolS, IDA_mem->ida_Ns);
3981 IDA_mem->ida_lrw -= IDA_mem->ida_Ns*IDA_mem->ida_lrw1;
3982 IDA_mem->ida_liw -= IDA_mem->ida_Ns*IDA_mem->ida_liw1;
3983 IDA_mem->ida_VatolSMallocDone = SUNFALSE;
3984 }
3985 if (IDA_mem->ida_SatolSMallocDone) {
3986 free(IDA_mem->ida_SatolS); IDA_mem->ida_SatolS = NULL;
3987 IDA_mem->ida_lrw -= IDA_mem->ida_Ns;
3988 IDA_mem->ida_SatolSMallocDone = SUNFALSE;
3989 }
3990 }
3991
3992
3993 /*
3994 * IDAQuadSensAllocVectors
3995 *
3996 * Create (through duplication) N_Vectors used for quadrature sensitivity analysis,
3997 * using the N_Vector 'tmpl' as a template.
3998 */
3999
IDAQuadSensAllocVectors(IDAMem IDA_mem,N_Vector tmpl)4000 static booleantype IDAQuadSensAllocVectors(IDAMem IDA_mem, N_Vector tmpl)
4001 {
4002 int i, j, maxcol;
4003
4004 /* Allocate yQS */
4005 IDA_mem->ida_yyQS = N_VCloneVectorArray(IDA_mem->ida_Ns, tmpl);
4006 if (IDA_mem->ida_yyQS == NULL) {
4007 return(SUNFALSE);
4008 }
4009
4010 /* Allocate ewtQS */
4011 IDA_mem->ida_ewtQS = N_VCloneVectorArray(IDA_mem->ida_Ns, tmpl);
4012 if (IDA_mem->ida_ewtQS == NULL) {
4013 N_VDestroyVectorArray(IDA_mem->ida_yyQS, IDA_mem->ida_Ns);
4014 return(SUNFALSE);
4015 }
4016
4017 /* Allocate tempvQS */
4018 IDA_mem->ida_tempvQS = N_VCloneVectorArray(IDA_mem->ida_Ns, tmpl);
4019 if (IDA_mem->ida_tempvQS == NULL) {
4020 N_VDestroyVectorArray(IDA_mem->ida_yyQS, IDA_mem->ida_Ns);
4021 N_VDestroyVectorArray(IDA_mem->ida_ewtQS, IDA_mem->ida_Ns);
4022 return(SUNFALSE);
4023 }
4024
4025 IDA_mem->ida_eeQS = N_VCloneVectorArray(IDA_mem->ida_Ns, tmpl);
4026 if (IDA_mem->ida_eeQS == NULL) {
4027 N_VDestroyVectorArray(IDA_mem->ida_yyQS, IDA_mem->ida_Ns);
4028 N_VDestroyVectorArray(IDA_mem->ida_ewtQS, IDA_mem->ida_Ns);
4029 N_VDestroyVectorArray(IDA_mem->ida_tempvQS, IDA_mem->ida_Ns);
4030 return(SUNFALSE);
4031 }
4032
4033 IDA_mem->ida_savrhsQ = N_VClone(tmpl);
4034 if (IDA_mem->ida_savrhsQ == NULL) {
4035 N_VDestroyVectorArray(IDA_mem->ida_yyQS, IDA_mem->ida_Ns);
4036 N_VDestroyVectorArray(IDA_mem->ida_ewtQS, IDA_mem->ida_Ns);
4037 N_VDestroyVectorArray(IDA_mem->ida_tempvQS, IDA_mem->ida_Ns);
4038 N_VDestroyVectorArray(IDA_mem->ida_eeQS, IDA_mem->ida_Ns);
4039 }
4040
4041 maxcol = SUNMAX(IDA_mem->ida_maxord,4);
4042 /* Allocate phiQS */
4043 for (j=0; j<=maxcol; j++) {
4044 IDA_mem->ida_phiQS[j] = N_VCloneVectorArray(IDA_mem->ida_Ns, tmpl);
4045 if (IDA_mem->ida_phiQS[j] == NULL) {
4046 N_VDestroyVectorArray(IDA_mem->ida_yyQS, IDA_mem->ida_Ns);
4047 N_VDestroyVectorArray(IDA_mem->ida_ewtQS, IDA_mem->ida_Ns);
4048 N_VDestroyVectorArray(IDA_mem->ida_tempvQS, IDA_mem->ida_Ns);
4049 N_VDestroyVectorArray(IDA_mem->ida_eeQS, IDA_mem->ida_Ns);
4050 N_VDestroy(IDA_mem->ida_savrhsQ);
4051 for (i=0; i<j; i++)
4052 N_VDestroyVectorArray(IDA_mem->ida_phiQS[i], IDA_mem->ida_Ns);
4053 return(SUNFALSE);
4054 }
4055 }
4056
4057 /* Update solver workspace lengths */
4058 IDA_mem->ida_lrw += (maxcol + 5)*IDA_mem->ida_Ns*IDA_mem->ida_lrw1Q;
4059 IDA_mem->ida_liw += (maxcol + 5)*IDA_mem->ida_Ns*IDA_mem->ida_liw1Q;
4060
4061 return(SUNTRUE);
4062 }
4063
4064
4065 /*
4066 * IDAQuadSensFreeVectors
4067 *
4068 * This routine frees the IDAS vectors allocated in IDAQuadSensAllocVectors.
4069 */
4070
IDAQuadSensFreeVectors(IDAMem IDA_mem)4071 static void IDAQuadSensFreeVectors(IDAMem IDA_mem)
4072 {
4073 int j, maxcol;
4074
4075 maxcol = SUNMAX(IDA_mem->ida_maxord, 4);
4076
4077 N_VDestroyVectorArray(IDA_mem->ida_yyQS, IDA_mem->ida_Ns);
4078 N_VDestroyVectorArray(IDA_mem->ida_ewtQS, IDA_mem->ida_Ns);
4079 N_VDestroyVectorArray(IDA_mem->ida_eeQS, IDA_mem->ida_Ns);
4080 N_VDestroyVectorArray(IDA_mem->ida_tempvQS, IDA_mem->ida_Ns);
4081 N_VDestroy(IDA_mem->ida_savrhsQ);
4082
4083 for (j=0; j<=maxcol; j++) N_VDestroyVectorArray(IDA_mem->ida_phiQS[j], IDA_mem->ida_Ns);
4084
4085 IDA_mem->ida_lrw -= (maxcol + 5)*IDA_mem->ida_Ns*IDA_mem->ida_lrw1Q;
4086 IDA_mem->ida_liw -= (maxcol + 5)*IDA_mem->ida_Ns*IDA_mem->ida_liw1Q;
4087
4088 if (IDA_mem->ida_VatolQSMallocDone) {
4089 N_VDestroyVectorArray(IDA_mem->ida_VatolQS, IDA_mem->ida_Ns);
4090 IDA_mem->ida_lrw -= IDA_mem->ida_Ns*IDA_mem->ida_lrw1Q;
4091 IDA_mem->ida_liw -= IDA_mem->ida_Ns*IDA_mem->ida_liw1Q;
4092 }
4093 if (IDA_mem->ida_SatolQSMallocDone) {
4094 free(IDA_mem->ida_SatolQS); IDA_mem->ida_SatolQS = NULL;
4095 IDA_mem->ida_lrw -= IDA_mem->ida_Ns;
4096 }
4097 IDA_mem->ida_VatolQSMallocDone = SUNFALSE;
4098 IDA_mem->ida_SatolQSMallocDone = SUNFALSE;
4099 }
4100
4101
4102 /*
4103 * -----------------------------------------------------------------
4104 * Initial setup
4105 * -----------------------------------------------------------------
4106 */
4107
4108 /*
4109 * IDAInitialSetup
4110 *
4111 * This routine is called by IDASolve once at the first step.
4112 * It performs all checks on optional inputs and inputs to
4113 * IDAInit/IDAReInit that could not be done before.
4114 *
4115 * If no error is encountered, IDAInitialSetup returns IDA_SUCCESS.
4116 * Otherwise, it returns an error flag and reported to the error
4117 * handler function.
4118 */
4119
IDAInitialSetup(IDAMem IDA_mem)4120 int IDAInitialSetup(IDAMem IDA_mem)
4121 {
4122 booleantype conOK;
4123 int ier;
4124
4125 /* Test for more vector operations, depending on options */
4126 if (IDA_mem->ida_suppressalg)
4127 if (IDA_mem->ida_phi[0]->ops->nvwrmsnormmask == NULL) {
4128 IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDAInitialSetup",
4129 MSG_BAD_NVECTOR);
4130 return(IDA_ILL_INPUT);
4131 }
4132
4133 /* Test id vector for legality */
4134 if (IDA_mem->ida_suppressalg && (IDA_mem->ida_id==NULL)){
4135 IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDAInitialSetup",
4136 MSG_MISSING_ID);
4137 return(IDA_ILL_INPUT);
4138 }
4139
4140 /* Did the user specify tolerances? */
4141 if (IDA_mem->ida_itol == IDA_NN) {
4142 IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDAInitialSetup",
4143 MSG_NO_TOLS);
4144 return(IDA_ILL_INPUT);
4145 }
4146
4147 /* Set data for efun */
4148 if (IDA_mem->ida_user_efun) IDA_mem->ida_edata = IDA_mem->ida_user_data;
4149 else IDA_mem->ida_edata = IDA_mem;
4150
4151 /* Initial error weight vector */
4152 ier = IDA_mem->ida_efun(IDA_mem->ida_phi[0], IDA_mem->ida_ewt, IDA_mem->ida_edata);
4153 if (ier != 0) {
4154 if (IDA_mem->ida_itol == IDA_WF)
4155 IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDAInitialSetup",
4156 MSG_FAIL_EWT);
4157 else
4158 IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDAInitialSetup",
4159 MSG_BAD_EWT);
4160 return(IDA_ILL_INPUT);
4161 }
4162
4163 if (IDA_mem->ida_quadr) {
4164
4165 /* Evaluate quadrature rhs and set phiQ[1] */
4166 ier = IDA_mem->ida_rhsQ(IDA_mem->ida_tn, IDA_mem->ida_phi[0],
4167 IDA_mem->ida_phi[1], IDA_mem->ida_phiQ[1],
4168 IDA_mem->ida_user_data);
4169 IDA_mem->ida_nrQe++;
4170 if (ier < 0) {
4171 IDAProcessError(IDA_mem, IDA_QRHS_FAIL, "IDAS", "IDAInitialSetup",
4172 MSG_QRHSFUNC_FAILED);
4173 return(IDA_QRHS_FAIL);
4174 } else if (ier > 0) {
4175 IDAProcessError(IDA_mem, IDA_FIRST_QRHS_ERR, "IDAS", "IDAInitialSetup",
4176 MSG_QRHSFUNC_FIRST);
4177 return(IDA_FIRST_QRHS_ERR);
4178 }
4179
4180 if (IDA_mem->ida_errconQ) {
4181
4182 /* Did the user specify tolerances? */
4183 if (IDA_mem->ida_itolQ == IDA_NN) {
4184 IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDAInitialSetup",
4185 MSG_NO_TOLQ);
4186 return(IDA_ILL_INPUT);
4187 }
4188
4189 /* Load ewtQ */
4190 ier = IDAQuadEwtSet(IDA_mem, IDA_mem->ida_phiQ[0], IDA_mem->ida_ewtQ);
4191 if (ier != 0) {
4192 IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDAInitialSetup",
4193 MSG_BAD_EWTQ);
4194 return(IDA_ILL_INPUT);
4195 }
4196 }
4197 } else {
4198 IDA_mem->ida_errconQ = SUNFALSE;
4199 }
4200
4201 if (IDA_mem->ida_sensi) {
4202
4203 /* Did the user specify tolerances? */
4204 if (IDA_mem->ida_itolS == IDA_NN) {
4205 IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDAInitialSetup",
4206 MSG_NO_TOLS);
4207 return(IDA_ILL_INPUT);
4208 }
4209
4210 /* Load ewtS */
4211 ier = IDASensEwtSet(IDA_mem, IDA_mem->ida_phiS[0], IDA_mem->ida_ewtS);
4212 if (ier != 0) {
4213 IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDAInitialSetup",
4214 MSG_BAD_EWTS);
4215 return(IDA_ILL_INPUT);
4216 }
4217 } else {
4218 IDA_mem->ida_errconS = SUNFALSE;
4219 }
4220
4221 if (IDA_mem->ida_quadr_sensi) {
4222
4223 /* store the quadrature sensitivity residual. */
4224 ier = IDA_mem->ida_rhsQS(IDA_mem->ida_Ns, IDA_mem->ida_tn,
4225 IDA_mem->ida_phi[0], IDA_mem->ida_phi[1],
4226 IDA_mem->ida_phiS[0], IDA_mem->ida_phiS[1],
4227 IDA_mem->ida_phiQ[1], IDA_mem->ida_phiQS[1],
4228 IDA_mem->ida_user_dataQS, IDA_mem->ida_tmpS1,
4229 IDA_mem->ida_tmpS2, IDA_mem->ida_tmpS3);
4230 IDA_mem->ida_nrQSe++;
4231 if (ier < 0) {
4232 IDAProcessError(IDA_mem, IDA_QSRHS_FAIL, "IDAS", "IDAInitialSetup",
4233 MSG_QSRHSFUNC_FAILED);
4234 return(IDA_QRHS_FAIL);
4235 } else if (ier > 0) {
4236 IDAProcessError(IDA_mem, IDA_FIRST_QSRHS_ERR, "IDAS", "IDAInitialSetup",
4237 MSG_QSRHSFUNC_FIRST);
4238 return(IDA_FIRST_QSRHS_ERR);
4239 }
4240
4241 /* If using the internal DQ functions, we must have access to fQ
4242 * (i.e. quadrature integration must be enabled) and to the problem parameters */
4243
4244 if (IDA_mem->ida_rhsQSDQ) {
4245
4246 /* Test if quadratures are defined, so we can use fQ */
4247 if (!IDA_mem->ida_quadr) {
4248 IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDAInitialSetup",
4249 MSG_NULL_RHSQ);
4250 return(IDA_ILL_INPUT);
4251 }
4252
4253 /* Test if we have the problem parameters */
4254 if (IDA_mem->ida_p == NULL) {
4255 IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDAInitialSetup",
4256 MSG_NULL_P);
4257 return(IDA_ILL_INPUT);
4258 }
4259 }
4260
4261 if (IDA_mem->ida_errconQS) {
4262 /* Did the user specify tolerances? */
4263 if (IDA_mem->ida_itolQS == IDA_NN) {
4264 IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDAInitialSetup",
4265 MSG_NO_TOLQS);
4266 return(IDA_ILL_INPUT);
4267 }
4268
4269 /* If needed, did the user provide quadrature tolerances? */
4270 if ( (IDA_mem->ida_itolQS == IDA_EE) && (IDA_mem->ida_itolQ == IDA_NN) ) {
4271 IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDAInitialSetup",
4272 MSG_NO_TOLQ);
4273 return(IDA_ILL_INPUT);
4274 }
4275
4276 /* Load ewtS */
4277 ier = IDAQuadSensEwtSet(IDA_mem, IDA_mem->ida_phiQS[0], IDA_mem->ida_ewtQS);
4278 if (ier != 0) {
4279 IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDAInitialSetup",
4280 MSG_BAD_EWTQS);
4281 return(IDA_ILL_INPUT);
4282 }
4283 }
4284 } else {
4285 IDA_mem->ida_errconQS = SUNFALSE;
4286 }
4287
4288 /* Check to see if y0 satisfies constraints. */
4289 if (IDA_mem->ida_constraintsSet) {
4290
4291 if (IDA_mem->ida_sensi && (IDA_mem->ida_ism==IDA_SIMULTANEOUS)) {
4292 IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDAInitialSetup",
4293 MSG_BAD_ISM_CONSTR);
4294 return(IDA_ILL_INPUT);
4295 }
4296
4297 conOK = N_VConstrMask(IDA_mem->ida_constraints, IDA_mem->ida_phi[0], IDA_mem->ida_tempv2);
4298 if (!conOK) {
4299 IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDAInitialSetup",
4300 MSG_Y0_FAIL_CONSTR);
4301 return(IDA_ILL_INPUT);
4302 }
4303 }
4304
4305 /* Call linit function if it exists. */
4306 if (IDA_mem->ida_linit != NULL) {
4307 ier = IDA_mem->ida_linit(IDA_mem);
4308 if (ier != 0) {
4309 IDAProcessError(IDA_mem, IDA_LINIT_FAIL, "IDAS", "IDAInitialSetup",
4310 MSG_LINIT_FAIL);
4311 return(IDA_LINIT_FAIL);
4312 }
4313 }
4314
4315 /* Initialize the nonlinear solver (must occur after linear solver is initialize) so
4316 * that lsetup and lsolve pointers have been set */
4317
4318 /* always initialize the DAE NLS in case the user disables sensitivities later */
4319 ier = idaNlsInit(IDA_mem);
4320 if (ier != IDA_SUCCESS) {
4321 IDAProcessError(IDA_mem, IDA_NLS_INIT_FAIL, "IDAS", "IDAInitialSetup",
4322 MSG_NLS_INIT_FAIL);
4323 return(IDA_NLS_INIT_FAIL);
4324 }
4325
4326 if (IDA_mem->NLSsim != NULL) {
4327 ier = idaNlsInitSensSim(IDA_mem);
4328 if (ier != IDA_SUCCESS) {
4329 IDAProcessError(IDA_mem, IDA_NLS_INIT_FAIL, "IDAS", "IDAInitialSetup",
4330 MSG_NLS_INIT_FAIL);
4331 return(IDA_NLS_INIT_FAIL);
4332 }
4333 }
4334
4335 if (IDA_mem->NLSstg != NULL) {
4336 ier = idaNlsInitSensStg(IDA_mem);
4337 if (ier != IDA_SUCCESS) {
4338 IDAProcessError(IDA_mem, IDA_NLS_INIT_FAIL, "IDAS", "IDAInitialSetup",
4339 MSG_NLS_INIT_FAIL);
4340 return(IDA_NLS_INIT_FAIL);
4341 }
4342 }
4343
4344 return(IDA_SUCCESS);
4345 }
4346
4347 /*
4348 * IDAEwtSet
4349 *
4350 * This routine is responsible for loading the error weight vector
4351 * ewt, according to itol, as follows:
4352 * (1) ewt[i] = 1 / (rtol * SUNRabs(ycur[i]) + atol), i=0,...,Neq-1
4353 * if itol = IDA_SS
4354 * (2) ewt[i] = 1 / (rtol * SUNRabs(ycur[i]) + atol[i]), i=0,...,Neq-1
4355 * if itol = IDA_SV
4356 *
4357 * IDAEwtSet returns 0 if ewt is successfully set as above to a
4358 * positive vector and -1 otherwise. In the latter case, ewt is
4359 * considered undefined.
4360 *
4361 * All the real work is done in the routines IDAEwtSetSS, IDAEwtSetSV.
4362 */
4363
IDAEwtSet(N_Vector ycur,N_Vector weight,void * data)4364 int IDAEwtSet(N_Vector ycur, N_Vector weight, void *data)
4365 {
4366 IDAMem IDA_mem;
4367 int flag = 0;
4368
4369 /* data points to IDA_mem here */
4370
4371 IDA_mem = (IDAMem) data;
4372
4373 switch(IDA_mem->ida_itol) {
4374 case IDA_SS:
4375 flag = IDAEwtSetSS(IDA_mem, ycur, weight);
4376 break;
4377 case IDA_SV:
4378 flag = IDAEwtSetSV(IDA_mem, ycur, weight);
4379 break;
4380 }
4381 return(flag);
4382 }
4383
4384 /*
4385 * IDAEwtSetSS
4386 *
4387 * This routine sets ewt as decribed above in the case itol=IDA_SS.
4388 * If the absolute tolerance is zero, it tests for non-positive components
4389 * before inverting. IDAEwtSetSS returns 0 if ewt is successfully set to a
4390 * positive vector and -1 otherwise. In the latter case, ewt is considered
4391 * undefined.
4392 */
4393
IDAEwtSetSS(IDAMem IDA_mem,N_Vector ycur,N_Vector weight)4394 static int IDAEwtSetSS(IDAMem IDA_mem, N_Vector ycur, N_Vector weight)
4395 {
4396 N_VAbs(ycur, IDA_mem->ida_tempv1);
4397 N_VScale(IDA_mem->ida_rtol, IDA_mem->ida_tempv1, IDA_mem->ida_tempv1);
4398 N_VAddConst(IDA_mem->ida_tempv1, IDA_mem->ida_Satol, IDA_mem->ida_tempv1);
4399 if (IDA_mem->ida_atolmin0) {
4400 if (N_VMin(IDA_mem->ida_tempv1) <= ZERO) return(-1);
4401 }
4402 N_VInv(IDA_mem->ida_tempv1, weight);
4403 return(0);
4404 }
4405
4406 /*
4407 * IDAEwtSetSV
4408 *
4409 * This routine sets ewt as decribed above in the case itol=IDA_SV.
4410 * If the absolute tolerance is zero, it tests for non-positive components
4411 * before inverting. IDAEwtSetSV returns 0 if ewt is successfully set to a
4412 * positive vector and -1 otherwise. In the latter case, ewt is considered
4413 * undefined.
4414 */
4415
IDAEwtSetSV(IDAMem IDA_mem,N_Vector ycur,N_Vector weight)4416 static int IDAEwtSetSV(IDAMem IDA_mem, N_Vector ycur, N_Vector weight)
4417 {
4418 N_VAbs(ycur, IDA_mem->ida_tempv1);
4419 N_VLinearSum(IDA_mem->ida_rtol, IDA_mem->ida_tempv1,
4420 ONE, IDA_mem->ida_Vatol, IDA_mem->ida_tempv1);
4421 if (IDA_mem->ida_atolmin0) {
4422 if (N_VMin(IDA_mem->ida_tempv1) <= ZERO) return(-1);
4423 }
4424 N_VInv(IDA_mem->ida_tempv1, weight);
4425 return(0);
4426 }
4427
4428 /*
4429 * IDAQuadEwtSet
4430 *
4431 */
4432
IDAQuadEwtSet(IDAMem IDA_mem,N_Vector qcur,N_Vector weightQ)4433 static int IDAQuadEwtSet(IDAMem IDA_mem, N_Vector qcur, N_Vector weightQ)
4434 {
4435 int flag=0;
4436
4437 switch (IDA_mem->ida_itolQ) {
4438 case IDA_SS:
4439 flag = IDAQuadEwtSetSS(IDA_mem, qcur, weightQ);
4440 break;
4441 case IDA_SV:
4442 flag = IDAQuadEwtSetSV(IDA_mem, qcur, weightQ);
4443 break;
4444 }
4445
4446 return(flag);
4447
4448 }
4449
4450 /*
4451 * IDAQuadEwtSetSS
4452 *
4453 */
4454
IDAQuadEwtSetSS(IDAMem IDA_mem,N_Vector qcur,N_Vector weightQ)4455 static int IDAQuadEwtSetSS(IDAMem IDA_mem, N_Vector qcur, N_Vector weightQ)
4456 {
4457 N_Vector tempvQ;
4458
4459 /* Use ypQ as temporary storage */
4460 tempvQ = IDA_mem->ida_ypQ;
4461
4462 N_VAbs(qcur, tempvQ);
4463 N_VScale(IDA_mem->ida_rtolQ, tempvQ, tempvQ);
4464 N_VAddConst(tempvQ, IDA_mem->ida_SatolQ, tempvQ);
4465 if (IDA_mem->ida_atolQmin0) {
4466 if (N_VMin(tempvQ) <= ZERO) return(-1);
4467 }
4468 N_VInv(tempvQ, weightQ);
4469
4470 return(0);
4471 }
4472
4473 /*
4474 * IDAQuadEwtSetSV
4475 *
4476 */
4477
IDAQuadEwtSetSV(IDAMem IDA_mem,N_Vector qcur,N_Vector weightQ)4478 static int IDAQuadEwtSetSV(IDAMem IDA_mem, N_Vector qcur, N_Vector weightQ)
4479 {
4480 N_Vector tempvQ;
4481
4482 /* Use ypQ as temporary storage */
4483 tempvQ = IDA_mem->ida_ypQ;
4484
4485 N_VAbs(qcur, tempvQ);
4486 N_VLinearSum(IDA_mem->ida_rtolQ, tempvQ, ONE, IDA_mem->ida_VatolQ, tempvQ);
4487 if (IDA_mem->ida_atolQmin0) {
4488 if (N_VMin(tempvQ) <= ZERO) return(-1);
4489 }
4490 N_VInv(tempvQ, weightQ);
4491
4492 return(0);
4493 }
4494
4495 /*
4496 * IDASensEwtSet
4497 *
4498 */
4499
IDASensEwtSet(IDAMem IDA_mem,N_Vector * yScur,N_Vector * weightS)4500 int IDASensEwtSet(IDAMem IDA_mem, N_Vector *yScur, N_Vector *weightS)
4501 {
4502 int flag=0;
4503
4504 switch (IDA_mem->ida_itolS) {
4505 case IDA_EE:
4506 flag = IDASensEwtSetEE(IDA_mem, yScur, weightS);
4507 break;
4508 case IDA_SS:
4509 flag = IDASensEwtSetSS(IDA_mem, yScur, weightS);
4510 break;
4511 case IDA_SV:
4512 flag = IDASensEwtSetSV(IDA_mem, yScur, weightS);
4513 break;
4514 }
4515
4516 return(flag);
4517
4518 }
4519
4520 /*
4521 * IDASensEwtSetEE
4522 *
4523 * In this case, the error weight vector for the i-th sensitivity is set to
4524 *
4525 * ewtS_i = pbar_i * efun(pbar_i*yS_i)
4526 *
4527 * In other words, the scaled sensitivity pbar_i * yS_i has the same error
4528 * weight vector calculation as the solution vector.
4529 *
4530 */
4531
IDASensEwtSetEE(IDAMem IDA_mem,N_Vector * yScur,N_Vector * weightS)4532 static int IDASensEwtSetEE(IDAMem IDA_mem, N_Vector *yScur, N_Vector *weightS)
4533 {
4534 int is;
4535 N_Vector pyS;
4536 int flag;
4537
4538 /* Use tempv1 as temporary storage for the scaled sensitivity */
4539 pyS = IDA_mem->ida_tempv1;
4540
4541 for (is=0; is<IDA_mem->ida_Ns; is++) {
4542 N_VScale(IDA_mem->ida_pbar[is], yScur[is], pyS);
4543 flag = IDA_mem->ida_efun(pyS, weightS[is], IDA_mem->ida_edata);
4544 if (flag != 0) return(-1);
4545 N_VScale(IDA_mem->ida_pbar[is], weightS[is], weightS[is]);
4546 }
4547
4548 return(0);
4549 }
4550
4551 /*
4552 * IDASensEwtSetSS
4553 *
4554 */
4555
IDASensEwtSetSS(IDAMem IDA_mem,N_Vector * yScur,N_Vector * weightS)4556 static int IDASensEwtSetSS(IDAMem IDA_mem, N_Vector *yScur, N_Vector *weightS)
4557 {
4558 int is;
4559
4560 for (is=0; is<IDA_mem->ida_Ns; is++) {
4561 N_VAbs(yScur[is], IDA_mem->ida_tempv1);
4562 N_VScale(IDA_mem->ida_rtolS, IDA_mem->ida_tempv1, IDA_mem->ida_tempv1);
4563 N_VAddConst(IDA_mem->ida_tempv1, IDA_mem->ida_SatolS[is], IDA_mem->ida_tempv1);
4564 if (IDA_mem->ida_atolSmin0[is]) {
4565 if (N_VMin(IDA_mem->ida_tempv1) <= ZERO) return(-1);
4566 }
4567 N_VInv(IDA_mem->ida_tempv1, weightS[is]);
4568 }
4569 return(0);
4570 }
4571
4572 /*
4573 * IDASensEwtSetSV
4574 *
4575 */
4576
IDASensEwtSetSV(IDAMem IDA_mem,N_Vector * yScur,N_Vector * weightS)4577 static int IDASensEwtSetSV(IDAMem IDA_mem, N_Vector *yScur, N_Vector *weightS)
4578 {
4579 int is;
4580
4581 for (is=0; is<IDA_mem->ida_Ns; is++) {
4582 N_VAbs(yScur[is], IDA_mem->ida_tempv1);
4583 N_VLinearSum(IDA_mem->ida_rtolS, IDA_mem->ida_tempv1, ONE, IDA_mem->ida_VatolS[is], IDA_mem->ida_tempv1);
4584 if (IDA_mem->ida_atolSmin0[is]) {
4585 if (N_VMin(IDA_mem->ida_tempv1) <= ZERO) return(-1);
4586 }
4587 N_VInv(IDA_mem->ida_tempv1, weightS[is]);
4588 }
4589
4590 return(0);
4591 }
4592
4593 /*
4594 * IDAQuadSensEwtSet
4595 *
4596 */
4597
IDAQuadSensEwtSet(IDAMem IDA_mem,N_Vector * yQScur,N_Vector * weightQS)4598 int IDAQuadSensEwtSet(IDAMem IDA_mem, N_Vector *yQScur, N_Vector *weightQS)
4599 {
4600 int flag=0;
4601
4602 switch (IDA_mem->ida_itolQS) {
4603 case IDA_EE:
4604 flag = IDAQuadSensEwtSetEE(IDA_mem, yQScur, weightQS);
4605 break;
4606 case IDA_SS:
4607 flag = IDAQuadSensEwtSetSS(IDA_mem, yQScur, weightQS);
4608 break;
4609 case IDA_SV:
4610 flag = IDAQuadSensEwtSetSV(IDA_mem, yQScur, weightQS);
4611 break;
4612 }
4613
4614 return(flag);
4615 }
4616
4617 /*
4618 * IDAQuadSensEwtSetEE
4619 *
4620 * In this case, the error weight vector for the i-th quadrature sensitivity
4621 * is set to
4622 *
4623 * ewtQS_i = pbar_i * IDAQuadEwtSet(pbar_i*yQS_i)
4624 *
4625 * In other words, the scaled sensitivity pbar_i * yQS_i has the same error
4626 * weight vector calculation as the quadrature vector.
4627 *
4628 */
IDAQuadSensEwtSetEE(IDAMem IDA_mem,N_Vector * yQScur,N_Vector * weightQS)4629 static int IDAQuadSensEwtSetEE(IDAMem IDA_mem, N_Vector *yQScur, N_Vector *weightQS)
4630 {
4631 int is;
4632 N_Vector pyS;
4633 int flag;
4634
4635 /* Use tempvQS[0] as temporary storage for the scaled sensitivity */
4636 pyS = IDA_mem->ida_tempvQS[0];
4637
4638 for (is=0; is<IDA_mem->ida_Ns; is++) {
4639 N_VScale(IDA_mem->ida_pbar[is], yQScur[is], pyS);
4640 flag = IDAQuadEwtSet(IDA_mem, pyS, weightQS[is]);
4641 if (flag != 0) return(-1);
4642 N_VScale(IDA_mem->ida_pbar[is], weightQS[is], weightQS[is]);
4643 }
4644
4645 return(0);
4646 }
4647
IDAQuadSensEwtSetSS(IDAMem IDA_mem,N_Vector * yQScur,N_Vector * weightQS)4648 static int IDAQuadSensEwtSetSS(IDAMem IDA_mem, N_Vector *yQScur, N_Vector *weightQS)
4649 {
4650 int is;
4651 N_Vector tempvQ;
4652
4653 /* Use ypQ as temporary storage */
4654 tempvQ = IDA_mem->ida_ypQ;
4655
4656 for (is=0; is<IDA_mem->ida_Ns; is++) {
4657 N_VAbs(yQScur[is], tempvQ);
4658 N_VScale(IDA_mem->ida_rtolQS, tempvQ, tempvQ);
4659 N_VAddConst(tempvQ, IDA_mem->ida_SatolQS[is], tempvQ);
4660 if (IDA_mem->ida_atolQSmin0[is]) {
4661 if (N_VMin(tempvQ) <= ZERO) return(-1);
4662 }
4663 N_VInv(tempvQ, weightQS[is]);
4664 }
4665
4666 return(0);
4667 }
4668
IDAQuadSensEwtSetSV(IDAMem IDA_mem,N_Vector * yQScur,N_Vector * weightQS)4669 static int IDAQuadSensEwtSetSV(IDAMem IDA_mem, N_Vector *yQScur, N_Vector *weightQS)
4670 {
4671 int is;
4672 N_Vector tempvQ;
4673
4674 /* Use ypQ as temporary storage */
4675 tempvQ = IDA_mem->ida_ypQ;
4676
4677 for (is=0; is<IDA_mem->ida_Ns; is++) {
4678 N_VAbs(yQScur[is], tempvQ);
4679 N_VLinearSum(IDA_mem->ida_rtolQS, tempvQ, ONE, IDA_mem->ida_VatolQS[is], tempvQ);
4680 if (IDA_mem->ida_atolQSmin0[is]) {
4681 if (N_VMin(tempvQ) <= ZERO) return(-1);
4682 }
4683 N_VInv(tempvQ, weightQS[is]);
4684 }
4685
4686 return(0);
4687 }
4688
4689 /*
4690 * -----------------------------------------------------------------
4691 * Stopping tests
4692 * -----------------------------------------------------------------
4693 */
4694
4695 /*
4696 * IDAStopTest1
4697 *
4698 * This routine tests for stop conditions before taking a step.
4699 * The tests depend on the value of itask.
4700 * The variable tretlast is the previously returned value of tret.
4701 *
4702 * The return values are:
4703 * CONTINUE_STEPS if no stop conditions were found
4704 * IDA_SUCCESS for a normal return to the user
4705 * IDA_TSTOP_RETURN for a tstop-reached return to the user
4706 * IDA_ILL_INPUT for an illegal-input return to the user
4707 *
4708 * In the tstop cases, this routine may adjust the stepsize hh to cause
4709 * the next step to reach tstop exactly.
4710 */
4711
IDAStopTest1(IDAMem IDA_mem,realtype tout,realtype * tret,N_Vector yret,N_Vector ypret,int itask)4712 static int IDAStopTest1(IDAMem IDA_mem, realtype tout, realtype *tret,
4713 N_Vector yret, N_Vector ypret, int itask)
4714 {
4715 int ier;
4716 realtype troundoff;
4717
4718 switch (itask) {
4719
4720 case IDA_NORMAL:
4721
4722 if (IDA_mem->ida_tstopset) {
4723 /* Test for tn past tstop, tn = tretlast, tn past tout, tn near tstop. */
4724 if ( (IDA_mem->ida_tn - IDA_mem->ida_tstop)*IDA_mem->ida_hh > ZERO) {
4725 IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDA", "IDASolve",
4726 MSG_BAD_TSTOP, IDA_mem->ida_tstop, IDA_mem->ida_tn);
4727 return(IDA_ILL_INPUT);
4728 }
4729 }
4730
4731 /* Test for tout = tretlast, and for tn past tout. */
4732 if (tout == IDA_mem->ida_tretlast) {
4733 *tret = IDA_mem->ida_tretlast = tout;
4734 return(IDA_SUCCESS);
4735 }
4736 if ((IDA_mem->ida_tn - tout)*IDA_mem->ida_hh >= ZERO) {
4737 ier = IDAGetSolution(IDA_mem, tout, yret, ypret);
4738 if (ier != IDA_SUCCESS) {
4739 IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDA", "IDASolve", MSG_BAD_TOUT, tout);
4740 return(IDA_ILL_INPUT);
4741 }
4742 *tret = IDA_mem->ida_tretlast = tout;
4743 return(IDA_SUCCESS);
4744 }
4745
4746 if (IDA_mem->ida_tstopset) {
4747 troundoff = HUNDRED * IDA_mem->ida_uround * (SUNRabs(IDA_mem->ida_tn) + SUNRabs(IDA_mem->ida_hh));
4748 if (SUNRabs(IDA_mem->ida_tn - IDA_mem->ida_tstop) <= troundoff) {
4749 ier = IDAGetSolution(IDA_mem, IDA_mem->ida_tstop, yret, ypret);
4750 if (ier != IDA_SUCCESS) {
4751 IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDA", "IDASolve",
4752 MSG_BAD_TSTOP, IDA_mem->ida_tstop, IDA_mem->ida_tn);
4753 return(IDA_ILL_INPUT);
4754 }
4755 *tret = IDA_mem->ida_tretlast = IDA_mem->ida_tstop;
4756 IDA_mem->ida_tstopset = SUNFALSE;
4757 return(IDA_TSTOP_RETURN);
4758 }
4759 if ((IDA_mem->ida_tn + IDA_mem->ida_hh - IDA_mem->ida_tstop)*IDA_mem->ida_hh > ZERO)
4760 IDA_mem->ida_hh = (IDA_mem->ida_tstop - IDA_mem->ida_tn)*(ONE - FOUR * IDA_mem->ida_uround);
4761 }
4762
4763 return(CONTINUE_STEPS);
4764
4765 case IDA_ONE_STEP:
4766
4767 if (IDA_mem->ida_tstopset) {
4768 /* Test for tn past tstop, tn past tretlast, and tn near tstop. */
4769 if ((IDA_mem->ida_tn - IDA_mem->ida_tstop)*IDA_mem->ida_hh > ZERO) {
4770 IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDA", "IDASolve",
4771 MSG_BAD_TSTOP, IDA_mem->ida_tstop, IDA_mem->ida_tn);
4772 return(IDA_ILL_INPUT);
4773 }
4774 }
4775
4776 /* Test for tn past tretlast. */
4777 if ((IDA_mem->ida_tn - IDA_mem->ida_tretlast)*IDA_mem->ida_hh > ZERO) {
4778 ier = IDAGetSolution(IDA_mem, IDA_mem->ida_tn, yret, ypret);
4779 *tret = IDA_mem->ida_tretlast = IDA_mem->ida_tn;
4780 return(IDA_SUCCESS);
4781 }
4782
4783 if (IDA_mem->ida_tstopset) {
4784 troundoff = HUNDRED * IDA_mem->ida_uround * (SUNRabs(IDA_mem->ida_tn) + SUNRabs(IDA_mem->ida_hh));
4785 if (SUNRabs(IDA_mem->ida_tn - IDA_mem->ida_tstop) <= troundoff) {
4786 ier = IDAGetSolution(IDA_mem, IDA_mem->ida_tstop, yret, ypret);
4787 if (ier != IDA_SUCCESS) {
4788 IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDA", "IDASolve",
4789 MSG_BAD_TSTOP, IDA_mem->ida_tstop, IDA_mem->ida_tn);
4790 return(IDA_ILL_INPUT);
4791 }
4792 *tret = IDA_mem->ida_tretlast = IDA_mem->ida_tstop;
4793 IDA_mem->ida_tstopset = SUNFALSE;
4794 return(IDA_TSTOP_RETURN);
4795 }
4796 if ((IDA_mem->ida_tn + IDA_mem->ida_hh - IDA_mem->ida_tstop)*IDA_mem->ida_hh > ZERO)
4797 IDA_mem->ida_hh = (IDA_mem->ida_tstop - IDA_mem->ida_tn)*(ONE - FOUR * IDA_mem->ida_uround);
4798 }
4799
4800 return(CONTINUE_STEPS);
4801
4802 }
4803 return(IDA_ILL_INPUT); /* This return should never happen. */
4804 }
4805
4806 /*
4807 * IDAStopTest2
4808 *
4809 * This routine tests for stop conditions after taking a step.
4810 * The tests depend on the value of itask.
4811 *
4812 * The return values are:
4813 * CONTINUE_STEPS if no stop conditions were found
4814 * IDA_SUCCESS for a normal return to the user
4815 * IDA_TSTOP_RETURN for a tstop-reached return to the user
4816 * IDA_ILL_INPUT for an illegal-input return to the user
4817 *
4818 * In the two cases with tstop, this routine may reset the stepsize hh
4819 * to cause the next step to reach tstop exactly.
4820 *
4821 * In the two cases with ONE_STEP mode, no interpolation to tn is needed
4822 * because yret and ypret already contain the current y and y' values.
4823 *
4824 * Note: No test is made for an error return from IDAGetSolution here,
4825 * because the same test was made prior to the step.
4826 */
4827
IDAStopTest2(IDAMem IDA_mem,realtype tout,realtype * tret,N_Vector yret,N_Vector ypret,int itask)4828 static int IDAStopTest2(IDAMem IDA_mem, realtype tout, realtype *tret,
4829 N_Vector yret, N_Vector ypret, int itask)
4830 {
4831 /* int ier; */
4832 realtype troundoff;
4833
4834 switch (itask) {
4835
4836 case IDA_NORMAL:
4837
4838 /* Test for tn past tout. */
4839 if ((IDA_mem->ida_tn - tout)*IDA_mem->ida_hh >= ZERO) {
4840 /* ier = */ IDAGetSolution(IDA_mem, tout, yret, ypret);
4841 *tret = IDA_mem->ida_tretlast = tout;
4842 return(IDA_SUCCESS);
4843 }
4844
4845 if (IDA_mem->ida_tstopset) {
4846 /* Test for tn at tstop and for tn near tstop */
4847 troundoff = HUNDRED * IDA_mem->ida_uround * (SUNRabs(IDA_mem->ida_tn) + SUNRabs(IDA_mem->ida_hh));
4848 if (SUNRabs(IDA_mem->ida_tn - IDA_mem->ida_tstop) <= troundoff) {
4849 /* ier = */ IDAGetSolution(IDA_mem, IDA_mem->ida_tstop, yret, ypret);
4850 *tret = IDA_mem->ida_tretlast = IDA_mem->ida_tstop;
4851 IDA_mem->ida_tstopset = SUNFALSE;
4852 return(IDA_TSTOP_RETURN);
4853 }
4854 if ((IDA_mem->ida_tn + IDA_mem->ida_hh - IDA_mem->ida_tstop)*IDA_mem->ida_hh > ZERO)
4855 IDA_mem->ida_hh = (IDA_mem->ida_tstop - IDA_mem->ida_tn)*(ONE - FOUR * IDA_mem->ida_uround);
4856 }
4857
4858 return(CONTINUE_STEPS);
4859
4860 case IDA_ONE_STEP:
4861
4862 if (IDA_mem->ida_tstopset) {
4863 /* Test for tn at tstop and for tn near tstop */
4864 troundoff = HUNDRED * IDA_mem->ida_uround * (SUNRabs(IDA_mem->ida_tn) + SUNRabs(IDA_mem->ida_hh));
4865 if (SUNRabs(IDA_mem->ida_tn - IDA_mem->ida_tstop) <= troundoff) {
4866 /* ier = */ IDAGetSolution(IDA_mem, IDA_mem->ida_tstop, yret, ypret);
4867 *tret = IDA_mem->ida_tretlast = IDA_mem->ida_tstop;
4868 IDA_mem->ida_tstopset = SUNFALSE;
4869 return(IDA_TSTOP_RETURN);
4870 }
4871 if ((IDA_mem->ida_tn + IDA_mem->ida_hh - IDA_mem->ida_tstop)*IDA_mem->ida_hh > ZERO)
4872 IDA_mem->ida_hh = (IDA_mem->ida_tstop - IDA_mem->ida_tn)*(ONE - FOUR * IDA_mem->ida_uround);
4873 }
4874
4875 *tret = IDA_mem->ida_tretlast = IDA_mem->ida_tn;
4876 return(IDA_SUCCESS);
4877
4878 }
4879 return IDA_ILL_INPUT; /* This return should never happen. */
4880 }
4881
4882 /*
4883 * -----------------------------------------------------------------
4884 * Error handler
4885 * -----------------------------------------------------------------
4886 */
4887
4888 /*
4889 * IDAHandleFailure
4890 *
4891 * This routine prints error messages for all cases of failure by
4892 * IDAStep. It returns to IDASolve the value that it is to return to
4893 * the user.
4894 */
4895
IDAHandleFailure(IDAMem IDA_mem,int sflag)4896 static int IDAHandleFailure(IDAMem IDA_mem, int sflag)
4897 {
4898 /* Depending on sflag, print error message and return error flag */
4899 switch (sflag) {
4900
4901 case IDA_ERR_FAIL:
4902 IDAProcessError(IDA_mem, IDA_ERR_FAIL, "IDAS", "IDASolve",
4903 MSG_ERR_FAILS, IDA_mem->ida_tn, IDA_mem->ida_hh);
4904 return(IDA_ERR_FAIL);
4905
4906 case IDA_CONV_FAIL:
4907 IDAProcessError(IDA_mem, IDA_CONV_FAIL, "IDAS", "IDASolve",
4908 MSG_CONV_FAILS, IDA_mem->ida_tn, IDA_mem->ida_hh);
4909 return(IDA_CONV_FAIL);
4910
4911 case IDA_LSETUP_FAIL:
4912 IDAProcessError(IDA_mem, IDA_LSETUP_FAIL, "IDAS", "IDASolve",
4913 MSG_SETUP_FAILED, IDA_mem->ida_tn);
4914 return(IDA_LSETUP_FAIL);
4915
4916 case IDA_LSOLVE_FAIL:
4917 IDAProcessError(IDA_mem, IDA_LSOLVE_FAIL, "IDAS", "IDASolve",
4918 MSG_SOLVE_FAILED, IDA_mem->ida_tn);
4919 return(IDA_LSOLVE_FAIL);
4920
4921 case IDA_REP_RES_ERR:
4922 IDAProcessError(IDA_mem, IDA_REP_RES_ERR, "IDAS", "IDASolve",
4923 MSG_REP_RES_ERR, IDA_mem->ida_tn);
4924 return(IDA_REP_RES_ERR);
4925
4926 case IDA_RES_FAIL:
4927 IDAProcessError(IDA_mem, IDA_RES_FAIL, "IDAS", "IDASolve",
4928 MSG_RES_NONRECOV, IDA_mem->ida_tn);
4929 return(IDA_RES_FAIL);
4930
4931 case IDA_REP_QRHS_ERR:
4932 IDAProcessError(IDA_mem, IDA_REP_QRHS_ERR, "IDAS", "IDASolve",
4933 MSG_QRHSFUNC_REPTD, IDA_mem->ida_tn);
4934 return(IDA_REP_QRHS_ERR);
4935
4936 case IDA_QRHS_FAIL:
4937 IDAProcessError(IDA_mem, IDA_QRHS_FAIL, "IDAS", "IDASolve",
4938 MSG_QRHSFUNC_FAILED, IDA_mem->ida_tn);
4939 return(IDA_QRHS_FAIL);
4940
4941 case IDA_REP_SRES_ERR:
4942 IDAProcessError(IDA_mem, IDA_REP_SRES_ERR, "IDAS", "IDASolve",
4943 MSG_SRES_REPTD, IDA_mem->ida_tn);
4944 return(IDA_REP_SRES_ERR);
4945
4946 case IDA_SRES_FAIL:
4947 IDAProcessError(IDA_mem, IDA_SRES_FAIL, "IDAS", "IDASolve",
4948 MSG_SRES_FAILED, IDA_mem->ida_tn);
4949 return(IDA_SRES_FAIL);
4950
4951 case IDA_REP_QSRHS_ERR:
4952 IDAProcessError(IDA_mem, IDA_REP_QSRHS_ERR, "IDAS", "IDASolve",
4953 MSG_QSRHSFUNC_REPTD, IDA_mem->ida_tn);
4954 return(IDA_REP_QSRHS_ERR);
4955
4956 case IDA_QSRHS_FAIL:
4957 IDAProcessError(IDA_mem, IDA_QSRHS_FAIL, "IDAS", "IDASolve",
4958 MSG_QSRHSFUNC_FAILED, IDA_mem->ida_tn);
4959 return(IDA_QSRHS_FAIL);
4960
4961 case IDA_CONSTR_FAIL:
4962 IDAProcessError(IDA_mem, IDA_CONSTR_FAIL, "IDAS", "IDASolve",
4963 MSG_FAILED_CONSTR, IDA_mem->ida_tn);
4964 return(IDA_CONSTR_FAIL);
4965
4966 case IDA_MEM_NULL:
4967 IDAProcessError(NULL, IDA_MEM_NULL, "IDAS", "IDASolve",
4968 MSG_NO_MEM);
4969 return(IDA_MEM_NULL);
4970
4971 case SUN_NLS_MEM_NULL:
4972 IDAProcessError(IDA_mem, IDA_MEM_NULL, "IDAS", "IDASolve",
4973 MSG_NLS_INPUT_NULL, IDA_mem->ida_tn);
4974 return(IDA_MEM_NULL);
4975
4976 case IDA_NLS_SETUP_FAIL:
4977 IDAProcessError(IDA_mem, IDA_NLS_SETUP_FAIL, "IDAS", "IDASolve",
4978 MSG_NLS_SETUP_FAILED, IDA_mem->ida_tn);
4979 return(IDA_NLS_SETUP_FAIL);
4980 case IDA_NLS_FAIL:
4981 IDAProcessError(IDA_mem, IDA_NLS_FAIL, "IDA", "IDASolve",
4982 MSG_NLS_FAIL, IDA_mem->ida_tn);
4983 return(IDA_NLS_FAIL);
4984 }
4985
4986 /* This return should never happen */
4987 IDAProcessError(IDA_mem, IDA_UNRECOGNIZED_ERROR, "IDAS", "IDASolve",
4988 "IDA encountered an unrecognized error. Please report this to the Sundials developers at sundials-users@llnl.gov");
4989 return (IDA_UNRECOGNIZED_ERROR);
4990 }
4991
4992 /*
4993 * -----------------------------------------------------------------
4994 * Main IDAStep function
4995 * -----------------------------------------------------------------
4996 */
4997
4998 /*
4999 * IDAStep
5000 *
5001 * This routine performs one internal IDA step, from tn to tn + hh.
5002 * It calls other routines to do all the work.
5003 *
5004 * It solves a system of differential/algebraic equations of the form
5005 * F(t,y,y') = 0, for one step. In IDA, tt is used for t,
5006 * yy is used for y, and yp is used for y'. The function F is supplied as 'res'
5007 * by the user.
5008 *
5009 * The methods used are modified divided difference, fixed leading
5010 * coefficient forms of backward differentiation formulas.
5011 * The code adjusts the stepsize and order to control the local error per step.
5012 *
5013 * The main operations done here are as follows:
5014 * * initialize various quantities;
5015 * * setting of multistep method coefficients;
5016 * * solution of the nonlinear system for yy at t = tn + hh;
5017 * * deciding on order reduction and testing the local error;
5018 * * attempting to recover from failure in nonlinear solver or error test;
5019 * * resetting stepsize and order for the next step.
5020 * * updating phi and other state data if successful;
5021 *
5022 * On a failure in the nonlinear system solution or error test, the
5023 * step may be reattempted, depending on the nature of the failure.
5024 *
5025 * Variables or arrays (all in the IDAMem structure) used in IDAStep are:
5026 *
5027 * tt -- Independent variable.
5028 * yy -- Solution vector at tt.
5029 * yp -- Derivative of solution vector after successful stelp.
5030 * res -- User-supplied function to evaluate the residual. See the
5031 * description given in file ida.h .
5032 * lsetup -- Routine to prepare for the linear solver call. It may either
5033 * save or recalculate quantities used by lsolve. (Optional)
5034 * lsolve -- Routine to solve a linear system. A prior call to lsetup
5035 * may be required.
5036 * hh -- Appropriate step size for next step.
5037 * ewt -- Vector of weights used in all convergence tests.
5038 * phi -- Array of divided differences used by IDAStep. This array is composed
5039 * of (maxord+1) nvectors (each of size Neq). (maxord+1) is the maximum
5040 * order for the problem, maxord, plus 1.
5041 *
5042 * Return values are:
5043 * IDA_SUCCESS IDA_RES_FAIL LSETUP_ERROR_NONRECVR
5044 * IDA_LSOLVE_FAIL IDA_ERR_FAIL
5045 * IDA_CONSTR_FAIL IDA_CONV_FAIL
5046 * IDA_REP_RES_ERR
5047 */
5048
IDAStep(IDAMem IDA_mem)5049 static int IDAStep(IDAMem IDA_mem)
5050 {
5051 realtype saved_t, ck;
5052 realtype err_k, err_km1, err_km2;
5053 int ncf, nef;
5054 int nflag, kflag;
5055 int retval;
5056 booleantype sensi_stg, sensi_sim;
5057
5058 /* Are we computing sensitivities with the staggered or simultaneous approach? */
5059 sensi_stg = (IDA_mem->ida_sensi && (IDA_mem->ida_ism==IDA_STAGGERED));
5060 sensi_sim = (IDA_mem->ida_sensi && (IDA_mem->ida_ism==IDA_SIMULTANEOUS));
5061
5062 saved_t = IDA_mem->ida_tn;
5063 ncf = nef = 0;
5064
5065 if (IDA_mem->ida_nst == ZERO){
5066 IDA_mem->ida_kk = 1;
5067 IDA_mem->ida_kused = 0;
5068 IDA_mem->ida_hused = ZERO;
5069 IDA_mem->ida_psi[0] = IDA_mem->ida_hh;
5070 IDA_mem->ida_cj = ONE/IDA_mem->ida_hh;
5071 IDA_mem->ida_phase = 0;
5072 IDA_mem->ida_ns = 0;
5073 }
5074
5075 /* To prevent 'unintialized variable' warnings */
5076 err_k = ZERO;
5077 err_km1 = ZERO;
5078 err_km2 = ZERO;
5079
5080 /* Looping point for attempts to take a step */
5081
5082 for(;;) {
5083
5084 /*-----------------------
5085 Set method coefficients
5086 -----------------------*/
5087
5088 IDASetCoeffs(IDA_mem, &ck);
5089
5090 kflag = IDA_SUCCESS;
5091
5092 /*----------------------------------------------------
5093 If tn is past tstop (by roundoff), reset it to tstop.
5094 -----------------------------------------------------*/
5095
5096 IDA_mem->ida_tn = IDA_mem->ida_tn + IDA_mem->ida_hh;
5097 if (IDA_mem->ida_tstopset) {
5098 if ((IDA_mem->ida_tn - IDA_mem->ida_tstop)*IDA_mem->ida_hh > ZERO)
5099 IDA_mem->ida_tn = IDA_mem->ida_tstop;
5100 }
5101
5102 /*-----------------------
5103 Advance state variables
5104 -----------------------*/
5105
5106 /* Compute predicted values for yy and yp */
5107 IDAPredict(IDA_mem);
5108
5109 /* Compute predicted values for yyS and ypS (if simultaneous approach) */
5110 if (sensi_sim)
5111 IDASensPredict(IDA_mem, IDA_mem->ida_yySpredict, IDA_mem->ida_ypSpredict);
5112
5113 /* Nonlinear system solution */
5114 nflag = IDANls(IDA_mem);
5115
5116 /* If NLS was successful, perform error test */
5117 if (nflag == IDA_SUCCESS)
5118 nflag = IDATestError(IDA_mem, ck, &err_k, &err_km1, &err_km2);
5119
5120 /* Test for convergence or error test failures */
5121 if (nflag != IDA_SUCCESS) {
5122
5123 /* restore and decide what to do */
5124 IDARestore(IDA_mem, saved_t);
5125 kflag = IDAHandleNFlag(IDA_mem, nflag, err_k, err_km1,
5126 &(IDA_mem->ida_ncfn), &ncf,
5127 &(IDA_mem->ida_netf), &nef);
5128
5129 /* exit on nonrecoverable failure */
5130 if (kflag != PREDICT_AGAIN) return(kflag);
5131
5132 /* recoverable error; predict again */
5133 if(IDA_mem->ida_nst==0) IDAReset(IDA_mem);
5134 continue;
5135
5136 }
5137
5138 /*----------------------------
5139 Advance quadrature variables
5140 ----------------------------*/
5141 if (IDA_mem->ida_quadr) {
5142
5143 nflag = IDAQuadNls(IDA_mem);
5144
5145 /* If NLS was successful, perform error test */
5146 if (IDA_mem->ida_errconQ && (nflag == IDA_SUCCESS))
5147 nflag = IDAQuadTestError(IDA_mem, ck, &err_k, &err_km1, &err_km2);
5148
5149 /* Test for convergence or error test failures */
5150 if (nflag != IDA_SUCCESS) {
5151
5152 /* restore and decide what to do */
5153 IDARestore(IDA_mem, saved_t);
5154 kflag = IDAHandleNFlag(IDA_mem, nflag, err_k, err_km1,
5155 &(IDA_mem->ida_ncfnQ), &ncf,
5156 &(IDA_mem->ida_netfQ), &nef);
5157
5158 /* exit on nonrecoverable failure */
5159 if (kflag != PREDICT_AGAIN) return(kflag);
5160
5161 /* recoverable error; predict again */
5162 if(IDA_mem->ida_nst==0) IDAReset(IDA_mem);
5163 continue;
5164 }
5165 }
5166
5167 /*--------------------------------------------------
5168 Advance sensitivity variables (Staggered approach)
5169 --------------------------------------------------*/
5170 if (sensi_stg) {
5171
5172 /* Evaluate res at converged y, needed for future evaluations of sens. RHS
5173 If res() fails recoverably, treat it as a convergence failure and
5174 attempt the step again */
5175
5176 retval = IDA_mem->ida_res(IDA_mem->ida_tn,
5177 IDA_mem->ida_yy, IDA_mem->ida_yp,
5178 IDA_mem->ida_delta, IDA_mem->ida_user_data);
5179
5180 if (retval < 0) return(IDA_RES_FAIL);
5181 if (retval > 0) continue;
5182
5183 /* Compute predicted values for yyS and ypS */
5184 IDASensPredict(IDA_mem, IDA_mem->ida_yySpredict, IDA_mem->ida_ypSpredict);
5185
5186 /* Nonlinear system solution */
5187 nflag = IDASensNls(IDA_mem);
5188
5189 /* If NLS was successful, perform error test */
5190 if (IDA_mem->ida_errconS && (nflag == IDA_SUCCESS))
5191 nflag = IDASensTestError(IDA_mem, ck, &err_k, &err_km1, &err_km2);
5192
5193 /* Test for convergence or error test failures */
5194 if (nflag != IDA_SUCCESS) {
5195
5196 /* restore and decide what to do */
5197 IDARestore(IDA_mem, saved_t);
5198 kflag = IDAHandleNFlag(IDA_mem, nflag, err_k, err_km1,
5199 &(IDA_mem->ida_ncfnQ), &ncf,
5200 &(IDA_mem->ida_netfQ), &nef);
5201
5202 /* exit on nonrecoverable failure */
5203 if (kflag != PREDICT_AGAIN) return(kflag);
5204
5205 /* recoverable error; predict again */
5206 if(IDA_mem->ida_nst==0) IDAReset(IDA_mem);
5207 continue;
5208 }
5209 }
5210
5211 /*-------------------------------------------
5212 Advance quadrature sensitivity variables
5213 -------------------------------------------*/
5214 if (IDA_mem->ida_quadr_sensi) {
5215
5216 nflag = IDAQuadSensNls(IDA_mem);
5217
5218 /* If NLS was successful, perform error test */
5219 if (IDA_mem->ida_errconQS && (nflag == IDA_SUCCESS))
5220 nflag = IDAQuadSensTestError(IDA_mem, ck, &err_k, &err_km1, &err_km2);
5221
5222 /* Test for convergence or error test failures */
5223 if (nflag != IDA_SUCCESS) {
5224
5225 /* restore and decide what to do */
5226 IDARestore(IDA_mem, saved_t);
5227 kflag = IDAHandleNFlag(IDA_mem, nflag, err_k, err_km1,
5228 &(IDA_mem->ida_ncfnQ), &ncf,
5229 &(IDA_mem->ida_netfQ), &nef);
5230
5231 /* exit on nonrecoverable failure */
5232 if (kflag != PREDICT_AGAIN) return(kflag);
5233
5234 /* recoverable error; predict again */
5235 if(IDA_mem->ida_nst==0) IDAReset(IDA_mem);
5236 continue;
5237 }
5238 }
5239
5240 /* kflag == IDA_SUCCESS */
5241 break;
5242
5243 } /* end loop */
5244
5245 /* Nonlinear system solve and error test were both successful;
5246 update data, and consider change of step and/or order */
5247
5248 IDACompleteStep(IDA_mem, err_k, err_km1);
5249
5250 /*
5251 Rescale ee vector to be the estimated local error
5252 Notes:
5253 (1) altering the value of ee is permissible since
5254 it will be overwritten by
5255 IDASolve()->IDAStep()->IDANls()
5256 before it is needed again
5257 (2) the value of ee is only valid if IDAHandleNFlag()
5258 returns either PREDICT_AGAIN or IDA_SUCCESS
5259 */
5260
5261 N_VScale(ck, IDA_mem->ida_ee, IDA_mem->ida_ee);
5262
5263 return(IDA_SUCCESS);
5264 }
5265
5266 /*
5267 * IDASetCoeffs
5268 *
5269 * This routine computes the coefficients relevant to the current step.
5270 * The counter ns counts the number of consecutive steps taken at
5271 * constant stepsize h and order k, up to a maximum of k + 2.
5272 * Then the first ns components of beta will be one, and on a step
5273 * with ns = k + 2, the coefficients alpha, etc. need not be reset here.
5274 * Also, IDACompleteStep prohibits an order increase until ns = k + 2.
5275 */
5276
IDASetCoeffs(IDAMem IDA_mem,realtype * ck)5277 static void IDASetCoeffs(IDAMem IDA_mem, realtype *ck)
5278 {
5279 int i, j, is;
5280 realtype temp1, temp2, alpha0, alphas;
5281
5282 /* Set coefficients for the current stepsize h */
5283
5284 if ( (IDA_mem->ida_hh != IDA_mem->ida_hused) ||
5285 (IDA_mem->ida_kk != IDA_mem->ida_kused) )
5286 IDA_mem->ida_ns = 0;
5287 IDA_mem->ida_ns = SUNMIN(IDA_mem->ida_ns+1, IDA_mem->ida_kused+2);
5288 if (IDA_mem->ida_kk + 1 >= IDA_mem->ida_ns) {
5289 IDA_mem->ida_beta[0] = ONE;
5290 IDA_mem->ida_alpha[0] = ONE;
5291 temp1 = IDA_mem->ida_hh;
5292 IDA_mem->ida_gamma[0] = ZERO;
5293 IDA_mem->ida_sigma[0] = ONE;
5294 for(i=1; i<=IDA_mem->ida_kk; i++) {
5295 temp2 = IDA_mem->ida_psi[i-1];
5296 IDA_mem->ida_psi[i-1] = temp1;
5297 IDA_mem->ida_beta[i] = IDA_mem->ida_beta[i-1] * IDA_mem->ida_psi[i-1] / temp2;
5298 temp1 = temp2 + IDA_mem->ida_hh;
5299 IDA_mem->ida_alpha[i] = IDA_mem->ida_hh / temp1;
5300 IDA_mem->ida_sigma[i] = i * IDA_mem->ida_sigma[i-1] * IDA_mem->ida_alpha[i];
5301 IDA_mem->ida_gamma[i] = IDA_mem->ida_gamma[i-1] + IDA_mem->ida_alpha[i-1] / IDA_mem->ida_hh;
5302 }
5303 IDA_mem->ida_psi[IDA_mem->ida_kk] = temp1;
5304 }
5305 /* compute alphas, alpha0 */
5306 alphas = ZERO;
5307 alpha0 = ZERO;
5308 for(i=0; i<IDA_mem->ida_kk; i++) {
5309 alphas = alphas - ONE/(i+1);
5310 alpha0 = alpha0 - IDA_mem->ida_alpha[i];
5311 }
5312
5313 /* compute leading coefficient cj */
5314 IDA_mem->ida_cjlast = IDA_mem->ida_cj;
5315 IDA_mem->ida_cj = -alphas/IDA_mem->ida_hh;
5316
5317 /* compute variable stepsize error coefficient ck */
5318
5319 *ck = SUNRabs(IDA_mem->ida_alpha[IDA_mem->ida_kk] + alphas - alpha0);
5320 *ck = SUNMAX(*ck, IDA_mem->ida_alpha[IDA_mem->ida_kk]);
5321
5322 /* change phi to phi-star */
5323
5324 /* Scale i=IDA_mem->ida_ns to i<=IDA_mem->ida_kk */
5325 if (IDA_mem->ida_ns <= IDA_mem->ida_kk) {
5326 for(i=IDA_mem->ida_ns; i<=IDA_mem->ida_kk; i++)
5327 IDA_mem->ida_cvals[i-IDA_mem->ida_ns] = IDA_mem->ida_beta[i];
5328
5329 (void) N_VScaleVectorArray(IDA_mem->ida_kk - IDA_mem->ida_ns + 1,
5330 IDA_mem->ida_cvals,
5331 IDA_mem->ida_phi+IDA_mem->ida_ns,
5332 IDA_mem->ida_phi+IDA_mem->ida_ns);
5333
5334 if (IDA_mem->ida_quadr)
5335 (void) N_VScaleVectorArray(IDA_mem->ida_kk - IDA_mem->ida_ns + 1,
5336 IDA_mem->ida_cvals,
5337 IDA_mem->ida_phiQ+IDA_mem->ida_ns,
5338 IDA_mem->ida_phiQ+IDA_mem->ida_ns);
5339
5340 if (IDA_mem->ida_sensi || IDA_mem->ida_quadr_sensi) {
5341 j = 0;
5342 for(i=IDA_mem->ida_ns; i<=IDA_mem->ida_kk; i++) {
5343 for(is=0; is<IDA_mem->ida_Ns; is++) {
5344 IDA_mem->ida_cvals[j] = IDA_mem->ida_beta[i];
5345 j++;
5346 }
5347 }
5348 }
5349
5350 if (IDA_mem->ida_sensi) {
5351 j = 0;
5352 for(i=IDA_mem->ida_ns; i<=IDA_mem->ida_kk; i++) {
5353 for(is=0; is<IDA_mem->ida_Ns; is++) {
5354 IDA_mem->ida_Xvecs[j] = IDA_mem->ida_phiS[i][is];
5355 j++;
5356 }
5357 }
5358
5359 (void) N_VScaleVectorArray(j, IDA_mem->ida_cvals, IDA_mem->ida_Xvecs,
5360 IDA_mem->ida_Xvecs);
5361 }
5362
5363 if (IDA_mem->ida_quadr_sensi) {
5364 j = 0;
5365 for(i=IDA_mem->ida_ns; i<=IDA_mem->ida_kk; i++) {
5366 for(is=0; is<IDA_mem->ida_Ns; is++) {
5367 IDA_mem->ida_Xvecs[j] = IDA_mem->ida_phiQS[i][is];
5368 j++;
5369 }
5370 }
5371
5372 (void) N_VScaleVectorArray(j, IDA_mem->ida_cvals, IDA_mem->ida_Xvecs,
5373 IDA_mem->ida_Xvecs);
5374 }
5375 }
5376
5377 }
5378
5379 /*
5380 * -----------------------------------------------------------------
5381 * Nonlinear solver functions
5382 * -----------------------------------------------------------------
5383 */
5384
5385 /*
5386 * IDANls
5387 *
5388 * This routine attempts to solve the nonlinear system using the linear
5389 * solver specified. NOTE: this routine uses N_Vector ee as the scratch
5390 * vector tempv3 passed to lsetup.
5391 *
5392 * Possible return values:
5393 *
5394 * IDA_SUCCESS
5395 *
5396 * IDA_RES_RECVR IDA_RES_FAIL
5397 * IDA_SRES_RECVR IDA_SRES_FAIL
5398 * IDA_LSETUP_RECVR IDA_LSETUP_FAIL
5399 * IDA_LSOLVE_RECVR IDA_LSOLVE_FAIL
5400 *
5401 * IDA_CONSTR_RECVR
5402 * SUN_NLS_CONV_RECVR
5403 * IDA_MEM_NULL
5404 */
5405
IDANls(IDAMem IDA_mem)5406 static int IDANls(IDAMem IDA_mem)
5407 {
5408 int retval;
5409 booleantype constraintsPassed, callLSetup, sensi_sim;
5410 realtype temp1, temp2, vnorm;
5411 N_Vector mm, tmp;
5412 long int nni_inc;
5413
5414 /* Are we computing sensitivities with the IDA_SIMULTANEOUS approach? */
5415 sensi_sim = (IDA_mem->ida_sensi && (IDA_mem->ida_ism==IDA_SIMULTANEOUS));
5416
5417 callLSetup = SUNFALSE;
5418
5419 /* Initialize if the first time called */
5420
5421 if (IDA_mem->ida_nst == 0){
5422 IDA_mem->ida_cjold = IDA_mem->ida_cj;
5423 IDA_mem->ida_ss = TWENTY;
5424 IDA_mem->ida_ssS = TWENTY;
5425 if (IDA_mem->ida_lsetup) callLSetup = SUNTRUE;
5426 }
5427
5428 /* Decide if lsetup is to be called */
5429
5430 if (IDA_mem->ida_lsetup) {
5431 IDA_mem->ida_cjratio = IDA_mem->ida_cj / IDA_mem->ida_cjold;
5432 temp1 = (ONE - XRATE) / (ONE + XRATE);
5433 temp2 = ONE/temp1;
5434 if (IDA_mem->ida_cjratio < temp1 || IDA_mem->ida_cjratio > temp2) callLSetup = SUNTRUE;
5435 if (IDA_mem->ida_forceSetup) callLSetup = SUNTRUE;
5436 if (IDA_mem->ida_cj != IDA_mem->ida_cjlast) {
5437 IDA_mem->ida_ss = HUNDRED;
5438 IDA_mem->ida_ssS = HUNDRED;
5439 }
5440 }
5441
5442 /* initial guess for the correction to the predictor */
5443 if (sensi_sim)
5444 N_VConst(ZERO, IDA_mem->ycorSim);
5445 else
5446 N_VConst(ZERO, IDA_mem->ida_ee);
5447
5448 /* call nonlinear solver setup if it exists */
5449 if ((IDA_mem->NLS)->ops->setup) {
5450 if (sensi_sim)
5451 retval = SUNNonlinSolSetup(IDA_mem->NLS, IDA_mem->ycorSim, IDA_mem);
5452 else
5453 retval = SUNNonlinSolSetup(IDA_mem->NLS, IDA_mem->ida_ee, IDA_mem);
5454
5455 if (retval < 0) return(IDA_NLS_SETUP_FAIL);
5456 if (retval > 0) return(IDA_NLS_SETUP_RECVR);
5457 }
5458
5459 /* solve the nonlinear system */
5460 if (sensi_sim) {
5461
5462 retval = SUNNonlinSolSolve(IDA_mem->NLSsim,
5463 IDA_mem->ypredictSim, IDA_mem->ycorSim,
5464 IDA_mem->ewtSim, IDA_mem->ida_epsNewt,
5465 callLSetup, IDA_mem);
5466
5467 /* increment counter */
5468 nni_inc = 0;
5469 (void) SUNNonlinSolGetNumIters(IDA_mem->NLSsim, &(nni_inc));
5470 IDA_mem->ida_nni += nni_inc;
5471
5472 } else {
5473
5474 retval = SUNNonlinSolSolve(IDA_mem->NLS,
5475 IDA_mem->ida_yypredict, IDA_mem->ida_ee,
5476 IDA_mem->ida_ewt, IDA_mem->ida_epsNewt,
5477 callLSetup, IDA_mem);
5478
5479 /* increment counter */
5480 nni_inc = 0;
5481 (void) SUNNonlinSolGetNumIters(IDA_mem->NLS, &(nni_inc));
5482 IDA_mem->ida_nni += nni_inc;
5483
5484 }
5485
5486 /* update the state using the final correction from the nonlinear solver */
5487 N_VLinearSum(ONE, IDA_mem->ida_yypredict, ONE, IDA_mem->ida_ee, IDA_mem->ida_yy);
5488 N_VLinearSum(ONE, IDA_mem->ida_yppredict, IDA_mem->ida_cj, IDA_mem->ida_ee, IDA_mem->ida_yp);
5489
5490 /* update the sensitivities based on the final correction from the nonlinear solver */
5491 if (sensi_sim) {
5492 N_VLinearSumVectorArray(IDA_mem->ida_Ns,
5493 ONE, IDA_mem->ida_yySpredict,
5494 ONE, IDA_mem->ida_eeS, IDA_mem->ida_yyS);
5495 N_VLinearSumVectorArray(IDA_mem->ida_Ns,
5496 ONE, IDA_mem->ida_ypSpredict,
5497 IDA_mem->ida_cj, IDA_mem->ida_eeS, IDA_mem->ida_ypS);
5498 }
5499
5500 /* return if nonlinear solver failed */
5501 if (retval != IDA_SUCCESS) return(retval);
5502
5503 /* If otherwise successful, check and enforce inequality constraints. */
5504
5505 if (IDA_mem->ida_constraintsSet) {
5506
5507 /* shortcut names for temporary work vectors */
5508 mm = IDA_mem->ida_tempv2;
5509 tmp = IDA_mem->ida_tempv1;
5510
5511 /* Get mask vector mm, set where constraints failed */
5512 constraintsPassed = N_VConstrMask(IDA_mem->ida_constraints,
5513 IDA_mem->ida_yy, mm);
5514 if (constraintsPassed) return(IDA_SUCCESS);
5515
5516 /* Constraints not met */
5517
5518 /* Compute correction to satisfy constraints */
5519 N_VCompare(ONEPT5, IDA_mem->ida_constraints, tmp); /* a[i] =1 when |c[i]| = 2 */
5520 N_VProd(tmp, IDA_mem->ida_constraints, tmp); /* a * c */
5521 N_VDiv(tmp, IDA_mem->ida_ewt, tmp); /* a * c * wt */
5522 N_VLinearSum(ONE, IDA_mem->ida_yy, -PT1, tmp, tmp); /* y - 0.1 * a * c * wt */
5523 N_VProd(tmp, mm, tmp); /* v = mm*(y-.1*a*c*wt) */
5524
5525 vnorm = IDAWrmsNorm(IDA_mem, tmp, IDA_mem->ida_ewt, SUNFALSE); /* ||v|| */
5526
5527 /* If vector v of constraint corrections is small in norm, correct and
5528 accept this step */
5529 if (vnorm <= IDA_mem->ida_epsNewt) {
5530 N_VLinearSum(ONE, IDA_mem->ida_ee,
5531 -ONE, tmp, IDA_mem->ida_ee); /* ee <- ee - v */
5532 return(IDA_SUCCESS);
5533 }
5534
5535 /* Constraints correction is too large, reduce h by computing rr = h'/h */
5536 N_VLinearSum(ONE, IDA_mem->ida_phi[0], -ONE, IDA_mem->ida_yy, tmp);
5537 N_VProd(mm, tmp, tmp);
5538 IDA_mem->ida_rr = PT9*N_VMinQuotient(IDA_mem->ida_phi[0], tmp);
5539 IDA_mem->ida_rr = SUNMAX(IDA_mem->ida_rr, PT1);
5540
5541 /* Reattempt step with new step size */
5542 return(IDA_CONSTR_RECVR);
5543 }
5544
5545 return(IDA_SUCCESS);
5546 }
5547
5548
5549 /*
5550 * IDAPredict
5551 *
5552 * This routine predicts the new values for vectors yy and yp.
5553 */
5554
IDAPredict(IDAMem IDA_mem)5555 static void IDAPredict(IDAMem IDA_mem)
5556 {
5557 int j;
5558
5559 for(j=0; j<=IDA_mem->ida_kk; j++)
5560 IDA_mem->ida_cvals[j] = ONE;
5561
5562 (void) N_VLinearCombination(IDA_mem->ida_kk+1, IDA_mem->ida_cvals,
5563 IDA_mem->ida_phi, IDA_mem->ida_yypredict);
5564
5565 (void) N_VLinearCombination(IDA_mem->ida_kk, IDA_mem->ida_gamma+1,
5566 IDA_mem->ida_phi+1, IDA_mem->ida_yppredict);
5567 }
5568
5569 /*
5570 * IDAQuadNls
5571 *
5572 * This routine solves for the quadrature variables at the new step.
5573 * It does not solve a nonlinear system, but rather updates the
5574 * quadrature variables. The name for this function is just for
5575 * uniformity purposes.
5576 *
5577 */
5578
IDAQuadNls(IDAMem IDA_mem)5579 static int IDAQuadNls(IDAMem IDA_mem)
5580 {
5581 int retval;
5582
5583 /* Predict: load yyQ and ypQ */
5584 IDAQuadPredict(IDA_mem);
5585
5586 /* Compute correction eeQ */
5587 retval = IDA_mem->ida_rhsQ(IDA_mem->ida_tn, IDA_mem->ida_yy,
5588 IDA_mem->ida_yp, IDA_mem->ida_eeQ,
5589 IDA_mem->ida_user_data);
5590 IDA_mem->ida_nrQe++;
5591 if (retval < 0) return(IDA_QRHS_FAIL);
5592 else if (retval > 0) return(IDA_QRHS_RECVR);
5593
5594 if (IDA_mem->ida_quadr_sensi)
5595 N_VScale(ONE, IDA_mem->ida_eeQ, IDA_mem->ida_savrhsQ);
5596
5597 N_VLinearSum(ONE, IDA_mem->ida_eeQ, -ONE, IDA_mem->ida_ypQ, IDA_mem->ida_eeQ);
5598 N_VScale(ONE/IDA_mem->ida_cj, IDA_mem->ida_eeQ, IDA_mem->ida_eeQ);
5599
5600 /* Apply correction: yyQ = yyQ + eeQ */
5601 N_VLinearSum(ONE, IDA_mem->ida_yyQ, ONE, IDA_mem->ida_eeQ, IDA_mem->ida_yyQ);
5602
5603 return(IDA_SUCCESS);
5604 }
5605
5606 /*
5607 * IDAQuadPredict
5608 *
5609 * This routine predicts the new value for vectors yyQ and ypQ
5610 */
5611
IDAQuadPredict(IDAMem IDA_mem)5612 static void IDAQuadPredict(IDAMem IDA_mem)
5613 {
5614 int j;
5615
5616 for(j=0; j<=IDA_mem->ida_kk; j++)
5617 IDA_mem->ida_cvals[j] = ONE;
5618
5619 (void) N_VLinearCombination(IDA_mem->ida_kk+1, IDA_mem->ida_cvals,
5620 IDA_mem->ida_phiQ, IDA_mem->ida_yyQ);
5621
5622 (void) N_VLinearCombination(IDA_mem->ida_kk, IDA_mem->ida_gamma+1,
5623 IDA_mem->ida_phiQ+1, IDA_mem->ida_ypQ);
5624
5625 }
5626
5627 /*
5628 * IDASensNls
5629 *
5630 * This routine attempts to solve, one by one, all the sensitivity
5631 * linear systems using nonlinear iterations and the linear solver
5632 * specified (Staggered approach).
5633 */
5634
IDASensNls(IDAMem IDA_mem)5635 static int IDASensNls(IDAMem IDA_mem)
5636 {
5637 booleantype callLSetup;
5638 long int nniS_inc;
5639 int retval;
5640
5641 callLSetup = SUNFALSE;
5642
5643 /* initial guess for the correction to the predictor */
5644 N_VConst(ZERO, IDA_mem->ycorStg);
5645
5646 /* solve the nonlinear system */
5647 retval = SUNNonlinSolSolve(IDA_mem->NLSstg,
5648 IDA_mem->ypredictStg, IDA_mem->ycorStg,
5649 IDA_mem->ewtStg, IDA_mem->ida_epsNewt,
5650 callLSetup, IDA_mem);
5651
5652 /* increment counter */
5653 nniS_inc = 0;
5654 (void) SUNNonlinSolGetNumIters(IDA_mem->NLSstg, &(nniS_inc));
5655 IDA_mem->ida_nniS += nniS_inc;
5656
5657 /* update using the final correction from the nonlinear solver */
5658 N_VLinearSumVectorArray(IDA_mem->ida_Ns,
5659 ONE, IDA_mem->ida_yySpredict,
5660 ONE, IDA_mem->ida_eeS, IDA_mem->ida_yyS);
5661 N_VLinearSumVectorArray(IDA_mem->ida_Ns,
5662 ONE, IDA_mem->ida_ypSpredict,
5663 IDA_mem->ida_cj, IDA_mem->ida_eeS, IDA_mem->ida_ypS);
5664
5665 if (retval != IDA_SUCCESS)
5666 IDA_mem->ida_ncfnS++;
5667
5668 return(retval);
5669
5670 }
5671
5672 /*
5673 * IDASensPredict
5674 *
5675 * This routine loads the predicted values for the is-th sensitivity
5676 * in the vectors yySens and ypSens.
5677 *
5678 * When ism=IDA_STAGGERED, yySens = yyS[is] and ypSens = ypS[is]
5679 */
5680
IDASensPredict(IDAMem IDA_mem,N_Vector * yySens,N_Vector * ypSens)5681 static void IDASensPredict(IDAMem IDA_mem, N_Vector *yySens, N_Vector *ypSens)
5682 {
5683 int j;
5684
5685 for(j=0; j<=IDA_mem->ida_kk; j++)
5686 IDA_mem->ida_cvals[j] = ONE;
5687
5688 (void) N_VLinearCombinationVectorArray(IDA_mem->ida_Ns, IDA_mem->ida_kk+1,
5689 IDA_mem->ida_cvals,
5690 IDA_mem->ida_phiS, yySens);
5691
5692 (void) N_VLinearCombinationVectorArray(IDA_mem->ida_Ns, IDA_mem->ida_kk,
5693 IDA_mem->ida_gamma+1,
5694 IDA_mem->ida_phiS+1, ypSens);
5695
5696 }
5697
5698 /*
5699 * IDAQuadSensNls
5700 *
5701 * This routine solves for the snesitivity quadrature variables at the
5702 * new step. It does not solve a nonlinear system, but rather updates
5703 * the sensitivity variables. The name for this function is just for
5704 * uniformity purposes.
5705 *
5706 */
5707
IDAQuadSensNls(IDAMem IDA_mem)5708 static int IDAQuadSensNls(IDAMem IDA_mem)
5709 {
5710 int retval;
5711 N_Vector *ypQS;
5712
5713 /* Predict: load yyQS and ypQS for each sensitivity. Store
5714 1st order information in tempvQS. */
5715
5716 ypQS = IDA_mem->ida_tempvQS;
5717 IDAQuadSensPredict(IDA_mem, IDA_mem->ida_yyQS, ypQS);
5718
5719 /* Compute correction eeQS */
5720 retval = IDA_mem->ida_rhsQS(IDA_mem->ida_Ns, IDA_mem->ida_tn,
5721 IDA_mem->ida_yy, IDA_mem->ida_yp,
5722 IDA_mem->ida_yyS, IDA_mem->ida_ypS,
5723 IDA_mem->ida_savrhsQ, IDA_mem->ida_eeQS,
5724 IDA_mem->ida_user_dataQS, IDA_mem->ida_tmpS1,
5725 IDA_mem->ida_tmpS2, IDA_mem->ida_tmpS3);
5726 IDA_mem->ida_nrQSe++;
5727
5728 if (retval < 0) return(IDA_QSRHS_FAIL);
5729 else if (retval > 0) return(IDA_QSRHS_RECVR);
5730
5731 retval = N_VLinearSumVectorArray(IDA_mem->ida_Ns,
5732 ONE/IDA_mem->ida_cj, IDA_mem->ida_eeQS,
5733 -ONE/IDA_mem->ida_cj, ypQS,
5734 IDA_mem->ida_eeQS);
5735 if (retval != IDA_SUCCESS) return (IDA_VECTOROP_ERR);
5736
5737 /* Apply correction: yyQS[is] = yyQ[is] + eeQ[is] */
5738 retval = N_VLinearSumVectorArray(IDA_mem->ida_Ns,
5739 ONE, IDA_mem->ida_yyQS,
5740 ONE, IDA_mem->ida_eeQS,
5741 IDA_mem->ida_yyQS);
5742 if (retval != IDA_SUCCESS) return (IDA_VECTOROP_ERR);
5743
5744 return(IDA_SUCCESS);
5745 }
5746
5747 /*
5748 * IDAQuadSensPredict
5749 *
5750 * This routine predicts the new value for vectors yyQS and ypQS
5751 */
5752
IDAQuadSensPredict(IDAMem IDA_mem,N_Vector * yQS,N_Vector * ypQS)5753 static void IDAQuadSensPredict(IDAMem IDA_mem, N_Vector *yQS, N_Vector *ypQS)
5754 {
5755 int j;
5756
5757 for(j=0; j<=IDA_mem->ida_kk; j++)
5758 IDA_mem->ida_cvals[j] = ONE;
5759
5760 (void) N_VLinearCombinationVectorArray(IDA_mem->ida_Ns, IDA_mem->ida_kk+1,
5761 IDA_mem->ida_cvals,
5762 IDA_mem->ida_phiQS, yQS);
5763
5764 (void) N_VLinearCombinationVectorArray(IDA_mem->ida_Ns, IDA_mem->ida_kk,
5765 IDA_mem->ida_gamma+1,
5766 IDA_mem->ida_phiQS+1, ypQS);
5767
5768 }
5769
5770
5771 /*
5772 * -----------------------------------------------------------------
5773 * Error test
5774 * -----------------------------------------------------------------
5775 */
5776
5777 /*
5778 * IDATestError
5779 *
5780 * This routine estimates errors at orders k, k-1, k-2, decides
5781 * whether or not to suggest an order decrease, and performs
5782 * the local error test.
5783 *
5784 * IDATestError returns either IDA_SUCCESS or ERROR_TEST_FAIL.
5785 */
5786
IDATestError(IDAMem IDA_mem,realtype ck,realtype * err_k,realtype * err_km1,realtype * err_km2)5787 static int IDATestError(IDAMem IDA_mem, realtype ck,
5788 realtype *err_k, realtype *err_km1, realtype *err_km2)
5789 {
5790 realtype enorm_k, enorm_km1, enorm_km2; /* error norms */
5791 realtype terr_k, terr_km1, terr_km2; /* local truncation error norms */
5792
5793 /* Compute error for order k. */
5794 enorm_k = IDAWrmsNorm(IDA_mem, IDA_mem->ida_ee, IDA_mem->ida_ewt, IDA_mem->ida_suppressalg);
5795 *err_k = IDA_mem->ida_sigma[IDA_mem->ida_kk] * enorm_k;
5796 terr_k = (IDA_mem->ida_kk + 1) * (*err_k);
5797
5798 IDA_mem->ida_knew = IDA_mem->ida_kk;
5799
5800 if ( IDA_mem->ida_kk > 1 ) {
5801
5802 /* Compute error at order k-1 */
5803 N_VLinearSum(ONE, IDA_mem->ida_phi[IDA_mem->ida_kk], ONE, IDA_mem->ida_ee, IDA_mem->ida_delta);
5804 enorm_km1 = IDAWrmsNorm(IDA_mem, IDA_mem->ida_delta,
5805 IDA_mem->ida_ewt, IDA_mem->ida_suppressalg);
5806 *err_km1 = IDA_mem->ida_sigma[IDA_mem->ida_kk - 1] * enorm_km1;
5807 terr_km1 = IDA_mem->ida_kk * (*err_km1);
5808
5809 if ( IDA_mem->ida_kk > 2 ) {
5810
5811 /* Compute error at order k-2 */
5812 N_VLinearSum(ONE, IDA_mem->ida_phi[IDA_mem->ida_kk - 1], ONE,
5813 IDA_mem->ida_delta, IDA_mem->ida_delta);
5814 enorm_km2 = IDAWrmsNorm(IDA_mem, IDA_mem->ida_delta,
5815 IDA_mem->ida_ewt, IDA_mem->ida_suppressalg);
5816 *err_km2 = IDA_mem->ida_sigma[IDA_mem->ida_kk - 2] * enorm_km2;
5817 terr_km2 = (IDA_mem->ida_kk - 1) * (*err_km2);
5818
5819 /* Decrease order if errors are reduced */
5820 if (SUNMAX(terr_km1, terr_km2) <= terr_k)
5821 IDA_mem->ida_knew = IDA_mem->ida_kk - 1;
5822
5823 } else {
5824
5825 /* Decrease order to 1 if errors are reduced by at least 1/2 */
5826 if (terr_km1 <= (HALF * terr_k) )
5827 IDA_mem->ida_knew = IDA_mem->ida_kk - 1;
5828
5829 }
5830
5831 }
5832
5833 /* Perform error test */
5834 if (ck * enorm_k > ONE) return(ERROR_TEST_FAIL);
5835 else return(IDA_SUCCESS);
5836 }
5837
5838 /*
5839 * IDAQuadTestError
5840 *
5841 * This routine estimates quadrature errors and updates errors at
5842 * orders k, k-1, k-2, decides whether or not to suggest an order reduction,
5843 * and performs the local error test.
5844 *
5845 * IDAQuadTestError returns the updated local error estimate at orders k,
5846 * k-1, and k-2. These are norms of type SUNMAX(|err|,|errQ|).
5847 *
5848 * The return flag can be either IDA_SUCCESS or ERROR_TEST_FAIL.
5849 */
5850
IDAQuadTestError(IDAMem IDA_mem,realtype ck,realtype * err_k,realtype * err_km1,realtype * err_km2)5851 static int IDAQuadTestError(IDAMem IDA_mem, realtype ck,
5852 realtype *err_k, realtype *err_km1, realtype *err_km2)
5853 {
5854 realtype enormQ;
5855 realtype errQ_k, errQ_km1, errQ_km2;
5856 realtype terr_k, terr_km1, terr_km2;
5857 N_Vector tempv;
5858 booleantype check_for_reduction = SUNFALSE;
5859
5860 /* Rename ypQ */
5861 tempv = IDA_mem->ida_ypQ;
5862
5863 /* Update error for order k. */
5864 enormQ = N_VWrmsNorm(IDA_mem->ida_eeQ, IDA_mem->ida_ewtQ);
5865 errQ_k = IDA_mem->ida_sigma[IDA_mem->ida_kk] * enormQ;
5866 if (errQ_k > *err_k) {
5867 *err_k = errQ_k;
5868 check_for_reduction = SUNTRUE;
5869 }
5870 terr_k = (IDA_mem->ida_kk+1) * (*err_k);
5871
5872 if ( IDA_mem->ida_kk > 1 ) {
5873
5874 /* Update error at order k-1 */
5875 N_VLinearSum(ONE, IDA_mem->ida_phiQ[IDA_mem->ida_kk], ONE, IDA_mem->ida_eeQ, tempv);
5876 errQ_km1 = IDA_mem->ida_sigma[IDA_mem->ida_kk-1] * N_VWrmsNorm(tempv, IDA_mem->ida_ewtQ);
5877 if (errQ_km1 > *err_km1) {
5878 *err_km1 = errQ_km1;
5879 check_for_reduction = SUNTRUE;
5880 }
5881 terr_km1 = IDA_mem->ida_kk * (*err_km1);
5882
5883 /* Has an order decrease already been decided in IDATestError? */
5884 if (IDA_mem->ida_knew != IDA_mem->ida_kk)
5885 check_for_reduction = SUNFALSE;
5886
5887 if (check_for_reduction) {
5888
5889 if ( IDA_mem->ida_kk > 2 ) {
5890
5891 /* Update error at order k-2 */
5892 N_VLinearSum(ONE, IDA_mem->ida_phiQ[IDA_mem->ida_kk-1], ONE, tempv, tempv);
5893 errQ_km2 = IDA_mem->ida_sigma[IDA_mem->ida_kk-2] * N_VWrmsNorm(tempv, IDA_mem->ida_ewtQ);
5894 if (errQ_km2 > *err_km2) {
5895 *err_km2 = errQ_km2;
5896 }
5897 terr_km2 = (IDA_mem->ida_kk-1) * (*err_km2);
5898
5899 /* Decrease order if errors are reduced */
5900 if (SUNMAX(terr_km1, terr_km2) <= terr_k)
5901 IDA_mem->ida_knew = IDA_mem->ida_kk - 1;
5902
5903 } else {
5904
5905 /* Decrease order to 1 if errors are reduced by at least 1/2 */
5906 if (terr_km1 <= (HALF * terr_k) )
5907 IDA_mem->ida_knew = IDA_mem->ida_kk - 1;
5908
5909 }
5910
5911 }
5912
5913 }
5914
5915 /* Perform error test */
5916 if (ck * enormQ > ONE) return(ERROR_TEST_FAIL);
5917 else return(IDA_SUCCESS);
5918
5919 }
5920
5921 /*
5922 * IDASensTestError
5923 *
5924 * This routine estimates sensitivity errors and updates errors at
5925 * orders k, k-1, k-2, decides whether or not to suggest an order reduction,
5926 * and performs the local error test. (Used only in staggered approach).
5927 *
5928 * IDASensTestError returns the updated local error estimate at orders k,
5929 * k-1, and k-2. These are norms of type SUNMAX(|err|,|errQ|,|errS|).
5930 *
5931 * The return flag can be either IDA_SUCCESS or ERROR_TEST_FAIL.
5932 */
5933
IDASensTestError(IDAMem IDA_mem,realtype ck,realtype * err_k,realtype * err_km1,realtype * err_km2)5934 static int IDASensTestError(IDAMem IDA_mem, realtype ck,
5935 realtype *err_k, realtype *err_km1, realtype *err_km2)
5936 {
5937 realtype enormS;
5938 realtype errS_k, errS_km1, errS_km2;
5939 realtype terr_k, terr_km1, terr_km2;
5940 N_Vector *tempv;
5941 booleantype check_for_reduction = SUNFALSE;
5942 int retval;
5943
5944 /* Rename deltaS */
5945 tempv = IDA_mem->ida_deltaS;
5946
5947 /* Update error for order k. */
5948 enormS = IDASensWrmsNorm(IDA_mem, IDA_mem->ida_eeS, IDA_mem->ida_ewtS, IDA_mem->ida_suppressalg);
5949 errS_k = IDA_mem->ida_sigma[IDA_mem->ida_kk] * enormS;
5950 if (errS_k > *err_k) {
5951 *err_k = errS_k;
5952 check_for_reduction = SUNTRUE;
5953 }
5954 terr_k = (IDA_mem->ida_kk+1) * (*err_k);
5955
5956 if ( IDA_mem->ida_kk > 1 ) {
5957
5958 /* Update error at order k-1 */
5959 retval = N_VLinearSumVectorArray(IDA_mem->ida_Ns,
5960 ONE, IDA_mem->ida_phiS[IDA_mem->ida_kk],
5961 ONE, IDA_mem->ida_eeS, tempv);
5962 if (retval != IDA_SUCCESS) return (IDA_VECTOROP_ERR);
5963
5964 errS_km1 = IDA_mem->ida_sigma[IDA_mem->ida_kk-1] *
5965 IDASensWrmsNorm(IDA_mem, tempv, IDA_mem->ida_ewtS, IDA_mem->ida_suppressalg);
5966
5967 if (errS_km1 > *err_km1) {
5968 *err_km1 = errS_km1;
5969 check_for_reduction = SUNTRUE;
5970 }
5971 terr_km1 = IDA_mem->ida_kk * (*err_km1);
5972
5973 /* Has an order decrease already been decided in IDATestError? */
5974 if (IDA_mem->ida_knew != IDA_mem->ida_kk)
5975 check_for_reduction = SUNFALSE;
5976
5977 if (check_for_reduction) {
5978
5979 if ( IDA_mem->ida_kk > 2 ) {
5980
5981 /* Update error at order k-2 */
5982 retval = N_VLinearSumVectorArray(IDA_mem->ida_Ns,
5983 ONE, IDA_mem->ida_phiS[IDA_mem->ida_kk-1],
5984 ONE, tempv, tempv);
5985 if (retval != IDA_SUCCESS) return (IDA_VECTOROP_ERR);
5986
5987 errS_km2 = IDA_mem->ida_sigma[IDA_mem->ida_kk-2] *
5988 IDASensWrmsNorm(IDA_mem, tempv, IDA_mem->ida_ewtS, IDA_mem->ida_suppressalg);
5989
5990 if (errS_km2 > *err_km2) {
5991 *err_km2 = errS_km2;
5992 }
5993 terr_km2 = (IDA_mem->ida_kk-1) * (*err_km2);
5994
5995 /* Decrease order if errors are reduced */
5996 if (SUNMAX(terr_km1, terr_km2) <= terr_k)
5997 IDA_mem->ida_knew = IDA_mem->ida_kk - 1;
5998
5999 } else {
6000
6001 /* Decrease order to 1 if errors are reduced by at least 1/2 */
6002 if (terr_km1 <= (HALF * terr_k) )
6003 IDA_mem->ida_knew = IDA_mem->ida_kk - 1;
6004
6005 }
6006
6007 }
6008
6009 }
6010
6011 /* Perform error test */
6012 if (ck * enormS > ONE) return(ERROR_TEST_FAIL);
6013 else return(IDA_SUCCESS);
6014
6015 }
6016
6017 /*
6018 * IDAQuadSensTestError
6019 *
6020 * This routine estimates quadrature sensitivity errors and updates
6021 * errors at orders k, k-1, k-2, decides whether or not to suggest
6022 * an order reduction and performs the local error test. (Used
6023 * only in staggered approach).
6024 *
6025 * IDAQuadSensTestError returns the updated local error estimate at
6026 * orders k, k-1, and k-2. These are norms of type
6027 * SUNMAX(|err|,|errQ|,|errS|,|errQS|).
6028 *
6029 * The return flag can be either IDA_SUCCESS or ERROR_TEST_FAIL.
6030 */
6031
IDAQuadSensTestError(IDAMem IDA_mem,realtype ck,realtype * err_k,realtype * err_km1,realtype * err_km2)6032 static int IDAQuadSensTestError(IDAMem IDA_mem, realtype ck,
6033 realtype *err_k, realtype *err_km1, realtype *err_km2)
6034 {
6035 realtype enormQS;
6036 realtype errQS_k, errQS_km1, errQS_km2;
6037 realtype terr_k, terr_km1, terr_km2;
6038 N_Vector *tempv;
6039 booleantype check_for_reduction = SUNFALSE;
6040 int retval;
6041
6042 tempv = IDA_mem->ida_yyQS;
6043
6044 enormQS = IDAQuadSensWrmsNorm(IDA_mem, IDA_mem->ida_eeQS, IDA_mem->ida_ewtQS);
6045 errQS_k = IDA_mem->ida_sigma[IDA_mem->ida_kk] * enormQS;
6046
6047 if (errQS_k > *err_k) {
6048 *err_k = errQS_k;
6049 check_for_reduction = SUNTRUE;
6050 }
6051 terr_k = (IDA_mem->ida_kk+1) * (*err_k);
6052
6053 if ( IDA_mem->ida_kk > 1 ) {
6054
6055 /* Update error at order k-1 */
6056 retval = N_VLinearSumVectorArray(IDA_mem->ida_Ns,
6057 ONE, IDA_mem->ida_phiQS[IDA_mem->ida_kk],
6058 ONE, IDA_mem->ida_eeQS, tempv);
6059 if (retval != IDA_SUCCESS) return (IDA_VECTOROP_ERR);
6060
6061 errQS_km1 = IDA_mem->ida_sigma[IDA_mem->ida_kk-1] *
6062 IDAQuadSensWrmsNorm(IDA_mem, tempv, IDA_mem->ida_ewtQS);
6063
6064 if (errQS_km1 > *err_km1) {
6065 *err_km1 = errQS_km1;
6066 check_for_reduction = SUNTRUE;
6067 }
6068 terr_km1 = IDA_mem->ida_kk * (*err_km1);
6069
6070 /* Has an order decrease already been decided in IDATestError? */
6071 if (IDA_mem->ida_knew != IDA_mem->ida_kk)
6072 check_for_reduction = SUNFALSE;
6073
6074 if (check_for_reduction) {
6075 if ( IDA_mem->ida_kk > 2 ) {
6076
6077 /* Update error at order k-2 */
6078 retval = N_VLinearSumVectorArray(IDA_mem->ida_Ns,
6079 ONE, IDA_mem->ida_phiQS[IDA_mem->ida_kk-1],
6080 ONE, tempv, tempv);
6081 if (retval != IDA_SUCCESS) return (IDA_VECTOROP_ERR);
6082
6083 errQS_km2 = IDA_mem->ida_sigma[IDA_mem->ida_kk-2] *
6084 IDAQuadSensWrmsNorm(IDA_mem, tempv, IDA_mem->ida_ewtQS);
6085
6086 if (errQS_km2 > *err_km2) {
6087 *err_km2 = errQS_km2;
6088 }
6089 terr_km2 = (IDA_mem->ida_kk-1) * (*err_km2);
6090
6091 /* Decrease order if errors are reduced */
6092 if (SUNMAX(terr_km1, terr_km2) <= terr_k)
6093 IDA_mem->ida_knew = IDA_mem->ida_kk - 1;
6094
6095 } else {
6096 /* Decrease order to 1 if errors are reduced by at least 1/2 */
6097 if (terr_km1 <= (HALF * terr_k) )
6098 IDA_mem->ida_knew = IDA_mem->ida_kk - 1;
6099 }
6100 }
6101 }
6102
6103 /* Perform error test */
6104 if (ck * enormQS > ONE) return(ERROR_TEST_FAIL);
6105 else return(IDA_SUCCESS);
6106 }
6107 /*
6108 * IDARestore
6109 *
6110 * This routine restores tn, psi, and phi in the event of a failure.
6111 * It changes back phi-star to phi (changed in IDASetCoeffs)
6112 */
6113
IDARestore(IDAMem IDA_mem,realtype saved_t)6114 static void IDARestore(IDAMem IDA_mem, realtype saved_t)
6115 {
6116 int i, j, is;
6117
6118 IDA_mem->ida_tn = saved_t;
6119
6120 for (i = 1; i <= IDA_mem->ida_kk; i++)
6121 IDA_mem->ida_psi[i-1] = IDA_mem->ida_psi[i] - IDA_mem->ida_hh;
6122
6123 if (IDA_mem->ida_ns <= IDA_mem->ida_kk) {
6124
6125 for(i = IDA_mem->ida_ns; i <= IDA_mem->ida_kk; i++)
6126 IDA_mem->ida_cvals[i-IDA_mem->ida_ns] = ONE/IDA_mem->ida_beta[i];
6127
6128 (void) N_VScaleVectorArray(IDA_mem->ida_kk - IDA_mem->ida_ns + 1,
6129 IDA_mem->ida_cvals,
6130 IDA_mem->ida_phi+IDA_mem->ida_ns,
6131 IDA_mem->ida_phi+IDA_mem->ida_ns);
6132
6133 if (IDA_mem->ida_quadr)
6134 (void) N_VScaleVectorArray(IDA_mem->ida_kk - IDA_mem->ida_ns + 1,
6135 IDA_mem->ida_cvals,
6136 IDA_mem->ida_phiQ+IDA_mem->ida_ns,
6137 IDA_mem->ida_phiQ+IDA_mem->ida_ns);
6138
6139 if (IDA_mem->ida_sensi || IDA_mem->ida_quadr_sensi) {
6140 j = 0;
6141 for(i=IDA_mem->ida_ns; i<=IDA_mem->ida_kk; i++) {
6142 for(is=0; is<IDA_mem->ida_Ns; is++) {
6143 IDA_mem->ida_cvals[j] = ONE/IDA_mem->ida_beta[i];
6144 j++;
6145 }
6146 }
6147 }
6148
6149 if (IDA_mem->ida_sensi) {
6150 j = 0;
6151 for(i=IDA_mem->ida_ns; i<=IDA_mem->ida_kk; i++) {
6152 for(is=0; is<IDA_mem->ida_Ns; is++) {
6153 IDA_mem->ida_Xvecs[j] = IDA_mem->ida_phiS[i][is];
6154 j++;
6155 }
6156 }
6157
6158 (void) N_VScaleVectorArray(j, IDA_mem->ida_cvals, IDA_mem->ida_Xvecs,
6159 IDA_mem->ida_Xvecs);
6160 }
6161
6162 if (IDA_mem->ida_quadr_sensi) {
6163 j = 0;
6164 for(i=IDA_mem->ida_ns; i<=IDA_mem->ida_kk; i++) {
6165 for(is=0; is<IDA_mem->ida_Ns; is++) {
6166 IDA_mem->ida_Xvecs[j] = IDA_mem->ida_phiQS[i][is];
6167 j++;
6168 }
6169 }
6170
6171 (void) N_VScaleVectorArray(j, IDA_mem->ida_cvals, IDA_mem->ida_Xvecs,
6172 IDA_mem->ida_Xvecs);
6173 }
6174 }
6175
6176 }
6177
6178 /*
6179 * -----------------------------------------------------------------
6180 * Handler for convergence and/or error test failures
6181 * -----------------------------------------------------------------
6182 */
6183
6184 /*
6185 * IDAHandleNFlag
6186 *
6187 * This routine handles failures indicated by the input variable nflag.
6188 * Positive values indicate various recoverable failures while negative
6189 * values indicate nonrecoverable failures. This routine adjusts the
6190 * step size for recoverable failures.
6191 *
6192 * Possible nflag values (input):
6193 *
6194 * --convergence failures--
6195 * IDA_RES_RECVR > 0
6196 * IDA_LSOLVE_RECVR > 0
6197 * IDA_CONSTR_RECVR > 0
6198 * SUN_NLS_CONV_RECVR > 0
6199 * IDA_QRHS_RECVR > 0
6200 * IDA_QSRHS_RECVR > 0
6201 * IDA_RES_FAIL < 0
6202 * IDA_LSOLVE_FAIL < 0
6203 * IDA_LSETUP_FAIL < 0
6204 * IDA_QRHS_FAIL < 0
6205 *
6206 * --error test failure--
6207 * ERROR_TEST_FAIL > 0
6208 *
6209 * Possible kflag values (output):
6210 *
6211 * --recoverable--
6212 * PREDICT_AGAIN
6213 *
6214 * --nonrecoverable--
6215 * IDA_CONSTR_FAIL
6216 * IDA_REP_RES_ERR
6217 * IDA_ERR_FAIL
6218 * IDA_CONV_FAIL
6219 * IDA_RES_FAIL
6220 * IDA_LSETUP_FAIL
6221 * IDA_LSOLVE_FAIL
6222 * IDA_QRHS_FAIL
6223 * IDA_REP_QRHS_ERR
6224 */
6225
IDAHandleNFlag(IDAMem IDA_mem,int nflag,realtype err_k,realtype err_km1,long int * ncfnPtr,int * ncfPtr,long int * netfPtr,int * nefPtr)6226 static int IDAHandleNFlag(IDAMem IDA_mem, int nflag, realtype err_k, realtype err_km1,
6227 long int *ncfnPtr, int *ncfPtr, long int *netfPtr, int *nefPtr)
6228 {
6229 realtype err_knew;
6230
6231 IDA_mem->ida_phase = 1;
6232
6233 if (nflag != ERROR_TEST_FAIL) {
6234
6235 /*-----------------------
6236 Nonlinear solver failed
6237 -----------------------*/
6238
6239 (*ncfPtr)++; /* local counter for convergence failures */
6240 (*ncfnPtr)++; /* global counter for convergence failures */
6241
6242 if (nflag < 0) { /* nonrecoverable failure */
6243
6244 if (nflag == IDA_LSOLVE_FAIL) return(IDA_LSOLVE_FAIL);
6245 else if (nflag == IDA_LSETUP_FAIL) return(IDA_LSETUP_FAIL);
6246 else if (nflag == IDA_RES_FAIL) return(IDA_RES_FAIL);
6247 else if (nflag == IDA_QRHS_FAIL) return(IDA_QRHS_FAIL);
6248 else if (nflag == IDA_SRES_FAIL) return(IDA_SRES_FAIL);
6249 else if (nflag == IDA_QSRHS_FAIL) return(IDA_QSRHS_FAIL);
6250 else return(IDA_NLS_FAIL);
6251
6252 } else { /* recoverable failure */
6253
6254 /* Reduce step size for a new prediction
6255 Note that if nflag=IDA_CONSTR_RECVR then rr was already set in IDANls */
6256 if (nflag != IDA_CONSTR_RECVR) IDA_mem->ida_rr = QUARTER;
6257 IDA_mem->ida_hh *= IDA_mem->ida_rr;
6258
6259 /* Test if there were too many convergence failures */
6260 if (*ncfPtr < IDA_mem->ida_maxncf) return(PREDICT_AGAIN);
6261 else if (nflag == IDA_RES_RECVR) return(IDA_REP_RES_ERR);
6262 else if (nflag == IDA_QRHS_RECVR) return(IDA_REP_QRHS_ERR);
6263 else if (nflag == IDA_SRES_RECVR) return(IDA_REP_SRES_ERR);
6264 else if (nflag == IDA_QSRHS_RECVR) return(IDA_REP_QSRHS_ERR);
6265 else if (nflag == IDA_CONSTR_RECVR) return(IDA_CONSTR_FAIL);
6266 else return(IDA_CONV_FAIL);
6267 }
6268
6269 } else {
6270
6271 /*-----------------
6272 Error Test failed
6273 -----------------*/
6274
6275 (*nefPtr)++; /* local counter for error test failures */
6276 (*netfPtr)++; /* global counter for error test failures */
6277
6278 if (*nefPtr == 1) {
6279
6280 /* On first error test failure, keep current order or lower order by one.
6281 Compute new stepsize based on differences of the solution. */
6282
6283 err_knew = (IDA_mem->ida_kk == IDA_mem->ida_knew) ? err_k : err_km1;
6284
6285 IDA_mem->ida_kk = IDA_mem->ida_knew;
6286 IDA_mem->ida_rr = PT9 * SUNRpowerR( TWO * err_knew + PT0001, -ONE/(IDA_mem->ida_kk + 1) );
6287 IDA_mem->ida_rr = SUNMAX(QUARTER, SUNMIN(PT9,IDA_mem->ida_rr));
6288 IDA_mem->ida_hh *= IDA_mem->ida_rr;
6289 return(PREDICT_AGAIN);
6290
6291 } else if (*nefPtr == 2) {
6292
6293 /* On second error test failure, use current order or decrease order by one.
6294 Reduce stepsize by factor of 1/4. */
6295
6296 IDA_mem->ida_kk = IDA_mem->ida_knew;
6297 IDA_mem->ida_rr = QUARTER;
6298 IDA_mem->ida_hh *= IDA_mem->ida_rr;
6299 return(PREDICT_AGAIN);
6300
6301 } else if (*nefPtr < IDA_mem->ida_maxnef) {
6302
6303 /* On third and subsequent error test failures, set order to 1.
6304 Reduce stepsize by factor of 1/4. */
6305 IDA_mem->ida_kk = 1;
6306 IDA_mem->ida_rr = QUARTER;
6307 IDA_mem->ida_hh *= IDA_mem->ida_rr;
6308 return(PREDICT_AGAIN);
6309
6310 } else {
6311
6312 /* Too many error test failures */
6313 return(IDA_ERR_FAIL);
6314
6315 }
6316
6317 }
6318
6319 }
6320
6321 /*
6322 * IDAReset
6323 *
6324 * This routine is called only if we need to predict again at the
6325 * very first step. In such a case, reset phi[1] and psi[0].
6326 */
6327
IDAReset(IDAMem IDA_mem)6328 static void IDAReset(IDAMem IDA_mem)
6329 {
6330 int is;
6331
6332 IDA_mem->ida_psi[0] = IDA_mem->ida_hh;
6333
6334 N_VScale(IDA_mem->ida_rr, IDA_mem->ida_phi[1], IDA_mem->ida_phi[1]);
6335
6336 if (IDA_mem->ida_quadr)
6337 N_VScale(IDA_mem->ida_rr, IDA_mem->ida_phiQ[1], IDA_mem->ida_phiQ[1]);
6338
6339 if (IDA_mem->ida_sensi || IDA_mem->ida_quadr_sensi)
6340 for(is=0; is<IDA_mem->ida_Ns; is++)
6341 IDA_mem->ida_cvals[is] = IDA_mem->ida_rr;
6342
6343 if (IDA_mem->ida_sensi)
6344 (void) N_VScaleVectorArray(IDA_mem->ida_Ns, IDA_mem->ida_cvals,
6345 IDA_mem->ida_phiS[1], IDA_mem->ida_phiS[1]);
6346
6347 if (IDA_mem->ida_quadr_sensi)
6348 (void) N_VScaleVectorArray(IDA_mem->ida_Ns, IDA_mem->ida_cvals,
6349 IDA_mem->ida_phiQS[1], IDA_mem->ida_phiQS[1]);
6350 }
6351
6352 /*
6353 * -----------------------------------------------------------------
6354 * Function called after a successful step
6355 * -----------------------------------------------------------------
6356 */
6357
6358 /*
6359 * IDACompleteStep
6360 *
6361 * This routine completes a successful step. It increments nst,
6362 * saves the stepsize and order used, makes the final selection of
6363 * stepsize and order for the next step, and updates the phi array.
6364 */
6365
IDACompleteStep(IDAMem IDA_mem,realtype err_k,realtype err_km1)6366 static void IDACompleteStep(IDAMem IDA_mem, realtype err_k, realtype err_km1)
6367 {
6368 int i, j, is, kdiff, action;
6369 realtype terr_k, terr_km1, terr_kp1;
6370 realtype err_knew, err_kp1;
6371 realtype enorm, tmp, hnew;
6372 N_Vector tempvQ, *tempvS;
6373
6374 IDA_mem->ida_nst++;
6375 kdiff = IDA_mem->ida_kk - IDA_mem->ida_kused;
6376 IDA_mem->ida_kused = IDA_mem->ida_kk;
6377 IDA_mem->ida_hused = IDA_mem->ida_hh;
6378
6379 if ( (IDA_mem->ida_knew == IDA_mem->ida_kk - 1) ||
6380 (IDA_mem->ida_kk == IDA_mem->ida_maxord) )
6381 IDA_mem->ida_phase = 1;
6382
6383 /* For the first few steps, until either a step fails, or the order is
6384 reduced, or the order reaches its maximum, we raise the order and double
6385 the stepsize. During these steps, phase = 0. Thereafter, phase = 1, and
6386 stepsize and order are set by the usual local error algorithm.
6387
6388 Note that, after the first step, the order is not increased, as not all
6389 of the neccessary information is available yet. */
6390
6391 if (IDA_mem->ida_phase == 0) {
6392
6393 if(IDA_mem->ida_nst > 1) {
6394 IDA_mem->ida_kk++;
6395 hnew = TWO * IDA_mem->ida_hh;
6396 if( (tmp = SUNRabs(hnew) * IDA_mem->ida_hmax_inv) > ONE )
6397 hnew /= tmp;
6398 IDA_mem->ida_hh = hnew;
6399 }
6400
6401 } else {
6402
6403 action = UNSET;
6404
6405 /* Set action = LOWER/MAINTAIN/RAISE to specify order decision */
6406
6407 if (IDA_mem->ida_knew == IDA_mem->ida_kk - 1) {action = LOWER; goto takeaction;}
6408 if (IDA_mem->ida_kk == IDA_mem->ida_maxord) {action = MAINTAIN; goto takeaction;}
6409 if ( (IDA_mem->ida_kk + 1 >= IDA_mem->ida_ns ) ||
6410 (kdiff == 1)) {action = MAINTAIN; goto takeaction;}
6411
6412 /* Estimate the error at order k+1, unless already decided to
6413 reduce order, or already using maximum order, or stepsize has not
6414 been constant, or order was just raised. */
6415
6416 N_VLinearSum(ONE, IDA_mem->ida_ee, -ONE,
6417 IDA_mem->ida_phi[IDA_mem->ida_kk + 1], IDA_mem->ida_tempv1);
6418 enorm = IDAWrmsNorm(IDA_mem, IDA_mem->ida_tempv1, IDA_mem->ida_ewt,
6419 IDA_mem->ida_suppressalg);
6420
6421 if (IDA_mem->ida_errconQ) {
6422 tempvQ = IDA_mem->ida_ypQ;
6423 N_VLinearSum (ONE, IDA_mem->ida_eeQ, -ONE,
6424 IDA_mem->ida_phiQ[IDA_mem->ida_kk+1], tempvQ);
6425 enorm = IDAQuadWrmsNormUpdate(IDA_mem, enorm, tempvQ, IDA_mem->ida_ewtQ);
6426 }
6427
6428 if (IDA_mem->ida_errconS) {
6429 tempvS = IDA_mem->ida_ypS;
6430
6431 (void) N_VLinearSumVectorArray(IDA_mem->ida_Ns,
6432 ONE, IDA_mem->ida_eeS,
6433 -ONE, IDA_mem->ida_phiS[IDA_mem->ida_kk+1],
6434 tempvS);
6435
6436 enorm = IDASensWrmsNormUpdate(IDA_mem, enorm, tempvS,
6437 IDA_mem->ida_ewtS, IDA_mem->ida_suppressalg);
6438 }
6439
6440 if (IDA_mem->ida_errconQS) {
6441 (void) N_VLinearSumVectorArray(IDA_mem->ida_Ns,
6442 ONE, IDA_mem->ida_eeQS,
6443 -ONE, IDA_mem->ida_phiQS[IDA_mem->ida_kk+1],
6444 IDA_mem->ida_tempvQS);
6445
6446 enorm = IDAQuadSensWrmsNormUpdate(IDA_mem, enorm,
6447 IDA_mem->ida_tempvQS, IDA_mem->ida_ewtQS);
6448 }
6449 err_kp1= enorm/(IDA_mem->ida_kk + 2);
6450
6451 /* Choose among orders k-1, k, k+1 using local truncation error norms. */
6452
6453 terr_k = (IDA_mem->ida_kk + 1) * err_k;
6454 terr_kp1 = (IDA_mem->ida_kk + 2) * err_kp1;
6455
6456 if (IDA_mem->ida_kk == 1) {
6457 if (terr_kp1 >= HALF * terr_k) {action = MAINTAIN; goto takeaction;}
6458 else {action = RAISE; goto takeaction;}
6459 } else {
6460 terr_km1 = IDA_mem->ida_kk * err_km1;
6461 if (terr_km1 <= SUNMIN(terr_k, terr_kp1)) {action = LOWER; goto takeaction;}
6462 else if (terr_kp1 >= terr_k) {action = MAINTAIN; goto takeaction;}
6463 else {action = RAISE; goto takeaction;}
6464 }
6465
6466 takeaction:
6467
6468 /* Set the estimated error norm and, on change of order, reset kk. */
6469 if (action == RAISE) { IDA_mem->ida_kk++; err_knew = err_kp1; }
6470 else if (action == LOWER) { IDA_mem->ida_kk--; err_knew = err_km1; }
6471 else { err_knew = err_k; }
6472
6473 /* Compute rr = tentative ratio hnew/hh from error norm estimate.
6474 Reduce hh if rr <= 1, double hh if rr >= 2, else leave hh as is.
6475 If hh is reduced, hnew/hh is restricted to be between .5 and .9. */
6476
6477 hnew = IDA_mem->ida_hh;
6478 IDA_mem->ida_rr = SUNRpowerR( TWO * err_knew + PT0001, -ONE/(IDA_mem->ida_kk + 1) );
6479
6480 if (IDA_mem->ida_rr >= TWO) {
6481 hnew = TWO * IDA_mem->ida_hh;
6482 if( (tmp = SUNRabs(hnew) * IDA_mem->ida_hmax_inv) > ONE )
6483 hnew /= tmp;
6484 } else if (IDA_mem->ida_rr <= ONE ) {
6485 IDA_mem->ida_rr = SUNMAX(HALF, SUNMIN(PT9,IDA_mem->ida_rr));
6486 hnew = IDA_mem->ida_hh * IDA_mem->ida_rr;
6487 }
6488
6489 IDA_mem->ida_hh = hnew;
6490
6491 } /* end of phase if block */
6492
6493 /* Save ee for possible order increase on next step */
6494 if (IDA_mem->ida_kused < IDA_mem->ida_maxord) {
6495 N_VScale(ONE, IDA_mem->ida_ee, IDA_mem->ida_phi[IDA_mem->ida_kused + 1]);
6496
6497 if (IDA_mem->ida_quadr)
6498 N_VScale(ONE, IDA_mem->ida_eeQ, IDA_mem->ida_phiQ[IDA_mem->ida_kused+1]);
6499
6500 if (IDA_mem->ida_sensi || IDA_mem->ida_quadr_sensi)
6501 for (is=0; is<IDA_mem->ida_Ns; is++)
6502 IDA_mem->ida_cvals[is] = ONE;
6503
6504 if (IDA_mem->ida_sensi)
6505 (void) N_VScaleVectorArray(IDA_mem->ida_Ns, IDA_mem->ida_cvals,
6506 IDA_mem->ida_eeS,
6507 IDA_mem->ida_phiS[IDA_mem->ida_kused+1]);
6508
6509 if (IDA_mem->ida_quadr_sensi)
6510 (void) N_VScaleVectorArray(IDA_mem->ida_Ns, IDA_mem->ida_cvals,
6511 IDA_mem->ida_eeQS,
6512 IDA_mem->ida_phiQS[IDA_mem->ida_kused+1]);
6513 }
6514
6515 /* Update phi arrays */
6516
6517 /* To update phi arrays compute X += Z where */
6518 /* X = [ phi[kused], phi[kused-1], phi[kused-2], ... phi[1] ] */
6519 /* Z = [ ee, phi[kused], phi[kused-1], ... phi[0] ] */
6520
6521 IDA_mem->ida_Zvecs[0] = IDA_mem->ida_ee;
6522 IDA_mem->ida_Xvecs[0] = IDA_mem->ida_phi[IDA_mem->ida_kused];
6523 for (j=1; j<=IDA_mem->ida_kused; j++) {
6524 IDA_mem->ida_Zvecs[j] = IDA_mem->ida_phi[IDA_mem->ida_kused-j+1];
6525 IDA_mem->ida_Xvecs[j] = IDA_mem->ida_phi[IDA_mem->ida_kused-j];
6526 }
6527
6528 (void) N_VLinearSumVectorArray(IDA_mem->ida_kused+1,
6529 ONE, IDA_mem->ida_Xvecs,
6530 ONE, IDA_mem->ida_Zvecs,
6531 IDA_mem->ida_Xvecs);
6532
6533 if (IDA_mem->ida_quadr) {
6534
6535 IDA_mem->ida_Zvecs[0] = IDA_mem->ida_eeQ;
6536 IDA_mem->ida_Xvecs[0] = IDA_mem->ida_phiQ[IDA_mem->ida_kused];
6537 for (j=1; j<=IDA_mem->ida_kused; j++) {
6538 IDA_mem->ida_Zvecs[j] = IDA_mem->ida_phiQ[IDA_mem->ida_kused-j+1];
6539 IDA_mem->ida_Xvecs[j] = IDA_mem->ida_phiQ[IDA_mem->ida_kused-j];
6540 }
6541
6542 (void) N_VLinearSumVectorArray(IDA_mem->ida_kused+1,
6543 ONE, IDA_mem->ida_Xvecs,
6544 ONE, IDA_mem->ida_Zvecs,
6545 IDA_mem->ida_Xvecs);
6546 }
6547
6548 if (IDA_mem->ida_sensi) {
6549
6550 i=0;
6551 for (is=0; is<IDA_mem->ida_Ns; is++) {
6552 IDA_mem->ida_Zvecs[i] = IDA_mem->ida_eeS[is];
6553 IDA_mem->ida_Xvecs[i] = IDA_mem->ida_phiS[IDA_mem->ida_kused][is];
6554 i++;
6555 for (j=1; j<=IDA_mem->ida_kused; j++) {
6556 IDA_mem->ida_Zvecs[i] = IDA_mem->ida_phiS[IDA_mem->ida_kused-j+1][is];
6557 IDA_mem->ida_Xvecs[i] = IDA_mem->ida_phiS[IDA_mem->ida_kused-j][is];
6558 i++;
6559 }
6560 }
6561
6562 (void) N_VLinearSumVectorArray(IDA_mem->ida_Ns*(IDA_mem->ida_kused+1),
6563 ONE, IDA_mem->ida_Xvecs,
6564 ONE, IDA_mem->ida_Zvecs,
6565 IDA_mem->ida_Xvecs);
6566 }
6567
6568 if (IDA_mem->ida_quadr_sensi) {
6569
6570 i=0;
6571 for (is=0; is<IDA_mem->ida_Ns; is++) {
6572 IDA_mem->ida_Zvecs[i] = IDA_mem->ida_eeQS[is];
6573 IDA_mem->ida_Xvecs[i] = IDA_mem->ida_phiQS[IDA_mem->ida_kused][is];
6574 i++;
6575 for (j=1; j<=IDA_mem->ida_kused; j++) {
6576 IDA_mem->ida_Zvecs[i] = IDA_mem->ida_phiQS[IDA_mem->ida_kused-j+1][is];
6577 IDA_mem->ida_Xvecs[i] = IDA_mem->ida_phiQS[IDA_mem->ida_kused-j][is];
6578 i++;
6579 }
6580 }
6581
6582 (void) N_VLinearSumVectorArray(IDA_mem->ida_Ns*(IDA_mem->ida_kused+1),
6583 ONE, IDA_mem->ida_Xvecs,
6584 ONE, IDA_mem->ida_Zvecs,
6585 IDA_mem->ida_Xvecs);
6586 }
6587
6588 }
6589
6590 /*
6591 * -----------------------------------------------------------------
6592 * Interpolated output
6593 * -----------------------------------------------------------------
6594 */
6595
6596 /*
6597 * IDAGetSolution
6598 *
6599 * This routine evaluates y(t) and y'(t) as the value and derivative of
6600 * the interpolating polynomial at the independent variable t, and stores
6601 * the results in the vectors yret and ypret. It uses the current
6602 * independent variable value, tn, and the method order last used, kused.
6603 * This function is called by IDASolve with t = tout, t = tn, or t = tstop.
6604 *
6605 * If kused = 0 (no step has been taken), or if t = tn, then the order used
6606 * here is taken to be 1, giving yret = phi[0], ypret = phi[1]/psi[0].
6607 *
6608 * The return values are:
6609 * IDA_SUCCESS if t is legal, or
6610 * IDA_BAD_T if t is not within the interval of the last step taken.
6611 */
6612
IDAGetSolution(void * ida_mem,realtype t,N_Vector yret,N_Vector ypret)6613 int IDAGetSolution(void *ida_mem, realtype t, N_Vector yret, N_Vector ypret)
6614 {
6615 IDAMem IDA_mem;
6616 realtype tfuzz, tp, delt, c, d, gam;
6617 int j, kord, retval;
6618
6619 if (ida_mem == NULL) {
6620 IDAProcessError(NULL, IDA_MEM_NULL, "IDAS", "IDAGetSolution", MSG_NO_MEM);
6621 return (IDA_MEM_NULL);
6622 }
6623 IDA_mem = (IDAMem) ida_mem;
6624
6625 /* Check t for legality. Here tn - hused is t_{n-1}. */
6626
6627 tfuzz = HUNDRED * IDA_mem->ida_uround * (SUNRabs(IDA_mem->ida_tn) + SUNRabs(IDA_mem->ida_hh));
6628 if (IDA_mem->ida_hh < ZERO) tfuzz = - tfuzz;
6629 tp = IDA_mem->ida_tn - IDA_mem->ida_hused - tfuzz;
6630 if ((t - tp)*IDA_mem->ida_hh < ZERO) {
6631 IDAProcessError(IDA_mem, IDA_BAD_T, "IDAS", "IDAGetSolution", MSG_BAD_T, t,
6632 IDA_mem->ida_tn-IDA_mem->ida_hused, IDA_mem->ida_tn);
6633 return(IDA_BAD_T);
6634 }
6635
6636 /* Initialize kord = (kused or 1). */
6637
6638 kord = IDA_mem->ida_kused;
6639 if (IDA_mem->ida_kused == 0) kord = 1;
6640
6641 /* Accumulate multiples of columns phi[j] into yret and ypret. */
6642
6643 delt = t - IDA_mem->ida_tn;
6644 c = ONE; d = ZERO;
6645 gam = delt / IDA_mem->ida_psi[0];
6646
6647 IDA_mem->ida_cvals[0] = c;
6648 for (j=1; j <= kord; j++) {
6649 d = d*gam + c / IDA_mem->ida_psi[j-1];
6650 c = c*gam;
6651 gam = (delt + IDA_mem->ida_psi[j-1]) / IDA_mem->ida_psi[j];
6652
6653 IDA_mem->ida_cvals[j] = c;
6654 IDA_mem->ida_dvals[j-1] = d;
6655 }
6656
6657 retval = N_VLinearCombination(kord+1, IDA_mem->ida_cvals,
6658 IDA_mem->ida_phi, yret);
6659 if (retval != IDA_SUCCESS) return(IDA_VECTOROP_ERR);
6660
6661 retval = N_VLinearCombination(kord, IDA_mem->ida_dvals,
6662 IDA_mem->ida_phi+1, ypret);
6663 if (retval != IDA_SUCCESS) return(IDA_VECTOROP_ERR);
6664
6665 return(IDA_SUCCESS);
6666 }
6667
6668 /*
6669 * -----------------------------------------------------------------
6670 * Norm functions
6671 * -----------------------------------------------------------------
6672 */
6673
6674 /*
6675 * IDAWrmsNorm
6676 *
6677 * Returns the WRMS norm of vector x with weights w.
6678 * If mask = SUNTRUE, the weight vector w is masked by id, i.e.,
6679 * nrm = N_VWrmsNormMask(x,w,id);
6680 * Otherwise,
6681 * nrm = N_VWrmsNorm(x,w);
6682 *
6683 * mask = SUNFALSE when the call is made from the nonlinear solver.
6684 * mask = suppressalg otherwise.
6685 */
6686
IDAWrmsNorm(IDAMem IDA_mem,N_Vector x,N_Vector w,booleantype mask)6687 realtype IDAWrmsNorm(IDAMem IDA_mem, N_Vector x, N_Vector w,
6688 booleantype mask)
6689 {
6690 realtype nrm;
6691
6692 if (mask) nrm = N_VWrmsNormMask(x, w, IDA_mem->ida_id);
6693 else nrm = N_VWrmsNorm(x, w);
6694
6695 return(nrm);
6696 }
6697
6698 /*
6699 * IDASensWrmsNorm
6700 *
6701 * This routine returns the maximum over the weighted root mean
6702 * square norm of xS with weight vectors wS:
6703 *
6704 * max { wrms(xS[0],wS[0]) ... wrms(xS[Ns-1],wS[Ns-1]) }
6705 *
6706 * Called by IDASensUpdateNorm or directly in the IDA_STAGGERED approach
6707 * during the NLS solution and before the error test.
6708 *
6709 * Declared global for use in the computation of IC for sensitivities.
6710 */
6711
IDASensWrmsNorm(IDAMem IDA_mem,N_Vector * xS,N_Vector * wS,booleantype mask)6712 realtype IDASensWrmsNorm(IDAMem IDA_mem, N_Vector *xS, N_Vector *wS,
6713 booleantype mask)
6714 {
6715 int is;
6716 realtype nrm;
6717
6718 if (mask)
6719 (void) N_VWrmsNormMaskVectorArray(IDA_mem->ida_Ns, xS, wS,
6720 IDA_mem->ida_id, IDA_mem->ida_cvals);
6721 else
6722 (void) N_VWrmsNormVectorArray(IDA_mem->ida_Ns, xS, wS,
6723 IDA_mem->ida_cvals);
6724
6725 nrm = IDA_mem->ida_cvals[0];
6726 for (is=1; is<IDA_mem->ida_Ns; is++)
6727 if ( IDA_mem->ida_cvals[is] > nrm ) nrm = IDA_mem->ida_cvals[is];
6728
6729 return (nrm);
6730 }
6731
6732 /*
6733 * IDAQuadSensWrmsNorm
6734 *
6735 * This routine returns the maximum over the weighted root mean
6736 * square norm of xQS with weight vectors wQS:
6737 *
6738 * max { wrms(xQS[0],wQS[0]) ... wrms(xQS[Ns-1],wQS[Ns-1]) }
6739 */
6740
IDAQuadSensWrmsNorm(IDAMem IDA_mem,N_Vector * xQS,N_Vector * wQS)6741 static realtype IDAQuadSensWrmsNorm(IDAMem IDA_mem, N_Vector *xQS, N_Vector *wQS)
6742 {
6743 int is;
6744 realtype nrm;
6745
6746 (void) N_VWrmsNormVectorArray(IDA_mem->ida_Ns, xQS, wQS,
6747 IDA_mem->ida_cvals);
6748
6749 nrm = IDA_mem->ida_cvals[0];
6750 for (is=1; is<IDA_mem->ida_Ns; is++)
6751 if ( IDA_mem->ida_cvals[is] > nrm ) nrm = IDA_mem->ida_cvals[is];
6752
6753 return (nrm);
6754 }
6755
6756 /*
6757 * IDAQuadWrmsNormUpdate
6758 *
6759 * Updates the norm old_nrm to account for all quadratures.
6760 */
6761
IDAQuadWrmsNormUpdate(IDAMem IDA_mem,realtype old_nrm,N_Vector xQ,N_Vector wQ)6762 static realtype IDAQuadWrmsNormUpdate(IDAMem IDA_mem, realtype old_nrm,
6763 N_Vector xQ, N_Vector wQ)
6764 {
6765 realtype qnrm;
6766
6767 qnrm = N_VWrmsNorm(xQ, wQ);
6768 if (old_nrm > qnrm) return(old_nrm);
6769 else return(qnrm);
6770 }
6771
6772 /*
6773 * IDASensWrmsNormUpdate
6774 *
6775 * Updates the norm old_nrm to account for all sensitivities.
6776 *
6777 * This function is declared global since it is used for finding
6778 * IC for sensitivities,
6779 */
6780
IDASensWrmsNormUpdate(IDAMem IDA_mem,realtype old_nrm,N_Vector * xS,N_Vector * wS,booleantype mask)6781 realtype IDASensWrmsNormUpdate(IDAMem IDA_mem, realtype old_nrm,
6782 N_Vector *xS, N_Vector *wS,
6783 booleantype mask)
6784 {
6785 realtype snrm;
6786
6787 snrm = IDASensWrmsNorm(IDA_mem, xS, wS, mask);
6788 if (old_nrm > snrm) return(old_nrm);
6789 else return(snrm);
6790 }
6791
IDAQuadSensWrmsNormUpdate(IDAMem IDA_mem,realtype old_nrm,N_Vector * xQS,N_Vector * wQS)6792 static realtype IDAQuadSensWrmsNormUpdate(IDAMem IDA_mem, realtype old_nrm,
6793 N_Vector *xQS, N_Vector *wQS)
6794 {
6795 realtype qsnrm;
6796
6797 qsnrm = IDAQuadSensWrmsNorm(IDA_mem, xQS, wQS);
6798 if (old_nrm > qsnrm) return(old_nrm);
6799 else return(qsnrm);
6800 }
6801
6802 /*
6803 * -----------------------------------------------------------------
6804 * Functions for rootfinding
6805 * -----------------------------------------------------------------
6806 */
6807
6808 /*
6809 * IDARcheck1
6810 *
6811 * This routine completes the initialization of rootfinding memory
6812 * information, and checks whether g has a zero both at and very near
6813 * the initial point of the IVP.
6814 *
6815 * This routine returns an int equal to:
6816 * IDA_RTFUNC_FAIL < 0 if the g function failed, or
6817 * IDA_SUCCESS = 0 otherwise.
6818 */
6819
IDARcheck1(IDAMem IDA_mem)6820 static int IDARcheck1(IDAMem IDA_mem)
6821 {
6822 int i, retval;
6823 realtype smallh, hratio, tplus;
6824 booleantype zroot;
6825
6826 for (i = 0; i < IDA_mem->ida_nrtfn; i++)
6827 IDA_mem->ida_iroots[i] = 0;
6828 IDA_mem->ida_tlo = IDA_mem->ida_tn;
6829 IDA_mem->ida_ttol = ((SUNRabs(IDA_mem->ida_tn) + SUNRabs(IDA_mem->ida_hh)) *
6830 IDA_mem->ida_uround * HUNDRED);
6831
6832 /* Evaluate g at initial t and check for zero values. */
6833 retval = IDA_mem->ida_gfun(IDA_mem->ida_tlo, IDA_mem->ida_phi[0], IDA_mem->ida_phi[1],
6834 IDA_mem->ida_glo, IDA_mem->ida_user_data);
6835 IDA_mem->ida_nge = 1;
6836 if (retval != 0) return(IDA_RTFUNC_FAIL);
6837
6838 zroot = SUNFALSE;
6839 for (i = 0; i < IDA_mem->ida_nrtfn; i++) {
6840 if (SUNRabs(IDA_mem->ida_glo[i]) == ZERO) {
6841 zroot = SUNTRUE;
6842 IDA_mem->ida_gactive[i] = SUNFALSE;
6843 }
6844 }
6845 if (!zroot) return(IDA_SUCCESS);
6846
6847 /* Some g_i is zero at t0; look at g at t0+(small increment). */
6848 hratio = SUNMAX(IDA_mem->ida_ttol / SUNRabs(IDA_mem->ida_hh), PT1);
6849 smallh = hratio * IDA_mem->ida_hh;
6850 tplus = IDA_mem->ida_tlo + smallh;
6851 N_VLinearSum(ONE, IDA_mem->ida_phi[0], smallh, IDA_mem->ida_phi[1], IDA_mem->ida_yy);
6852 retval = IDA_mem->ida_gfun(tplus, IDA_mem->ida_yy, IDA_mem->ida_phi[1],
6853 IDA_mem->ida_ghi, IDA_mem->ida_user_data);
6854 IDA_mem->ida_nge++;
6855 if (retval != 0) return(IDA_RTFUNC_FAIL);
6856
6857 /* We check now only the components of g which were exactly 0.0 at t0
6858 * to see if we can 'activate' them. */
6859 for (i = 0; i < IDA_mem->ida_nrtfn; i++) {
6860 if (!IDA_mem->ida_gactive[i] && SUNRabs(IDA_mem->ida_ghi[i]) != ZERO) {
6861 IDA_mem->ida_gactive[i] = SUNTRUE;
6862 IDA_mem->ida_glo[i] = IDA_mem->ida_ghi[i];
6863 }
6864 }
6865 return(IDA_SUCCESS);
6866 }
6867
6868 /*
6869 * IDARcheck2
6870 *
6871 * This routine checks for exact zeros of g at the last root found,
6872 * if the last return was a root. It then checks for a close pair of
6873 * zeros (an error condition), and for a new root at a nearby point.
6874 * The array glo = g(tlo) at the left endpoint of the search interval
6875 * is adjusted if necessary to assure that all g_i are nonzero
6876 * there, before returning to do a root search in the interval.
6877 *
6878 * On entry, tlo = tretlast is the last value of tret returned by
6879 * IDASolve. This may be the previous tn, the previous tout value,
6880 * or the last root location.
6881 *
6882 * This routine returns an int equal to:
6883 * IDA_RTFUNC_FAIL < 0 if the g function failed, or
6884 * CLOSERT = 3 if a close pair of zeros was found, or
6885 * RTFOUND = 1 if a new zero of g was found near tlo, or
6886 * IDA_SUCCESS = 0 otherwise.
6887 */
6888
IDARcheck2(IDAMem IDA_mem)6889 static int IDARcheck2(IDAMem IDA_mem)
6890 {
6891 int i, retval;
6892 realtype smallh, hratio, tplus;
6893 booleantype zroot;
6894
6895 if (IDA_mem->ida_irfnd == 0) return(IDA_SUCCESS);
6896
6897 (void) IDAGetSolution(IDA_mem, IDA_mem->ida_tlo, IDA_mem->ida_yy, IDA_mem->ida_yp);
6898 retval = IDA_mem->ida_gfun(IDA_mem->ida_tlo, IDA_mem->ida_yy, IDA_mem->ida_yp,
6899 IDA_mem->ida_glo, IDA_mem->ida_user_data);
6900 IDA_mem->ida_nge++;
6901 if (retval != 0) return(IDA_RTFUNC_FAIL);
6902
6903 zroot = SUNFALSE;
6904 for (i = 0; i < IDA_mem->ida_nrtfn; i++)
6905 IDA_mem->ida_iroots[i] = 0;
6906 for (i = 0; i < IDA_mem->ida_nrtfn; i++) {
6907 if (!IDA_mem->ida_gactive[i]) continue;
6908 if (SUNRabs(IDA_mem->ida_glo[i]) == ZERO) {
6909 zroot = SUNTRUE;
6910 IDA_mem->ida_iroots[i] = 1;
6911 }
6912 }
6913 if (!zroot) return(IDA_SUCCESS);
6914
6915 /* One or more g_i has a zero at tlo. Check g at tlo+smallh. */
6916 IDA_mem->ida_ttol = ((SUNRabs(IDA_mem->ida_tn) + SUNRabs(IDA_mem->ida_hh)) *
6917 IDA_mem->ida_uround * HUNDRED);
6918 smallh = (IDA_mem->ida_hh > ZERO) ? IDA_mem->ida_ttol : -IDA_mem->ida_ttol;
6919 tplus = IDA_mem->ida_tlo + smallh;
6920 if ( (tplus - IDA_mem->ida_tn)*IDA_mem->ida_hh >= ZERO) {
6921 hratio = smallh/IDA_mem->ida_hh;
6922 N_VLinearSum(ONE, IDA_mem->ida_yy,
6923 hratio, IDA_mem->ida_phi[1], IDA_mem->ida_yy);
6924 } else {
6925 (void) IDAGetSolution(IDA_mem, tplus, IDA_mem->ida_yy, IDA_mem->ida_yp);
6926 }
6927 retval = IDA_mem->ida_gfun(tplus, IDA_mem->ida_yy, IDA_mem->ida_yp,
6928 IDA_mem->ida_ghi, IDA_mem->ida_user_data);
6929 IDA_mem->ida_nge++;
6930 if (retval != 0) return(IDA_RTFUNC_FAIL);
6931
6932 /* Check for close roots (error return), for a new zero at tlo+smallh,
6933 and for a g_i that changed from zero to nonzero. */
6934 zroot = SUNFALSE;
6935 for (i = 0; i < IDA_mem->ida_nrtfn; i++) {
6936 if (!IDA_mem->ida_gactive[i]) continue;
6937 if (SUNRabs(IDA_mem->ida_ghi[i]) == ZERO) {
6938 if (IDA_mem->ida_iroots[i] == 1) return(CLOSERT);
6939 zroot = SUNTRUE;
6940 IDA_mem->ida_iroots[i] = 1;
6941 } else {
6942 if (IDA_mem->ida_iroots[i] == 1)
6943 IDA_mem->ida_glo[i] = IDA_mem->ida_ghi[i];
6944 }
6945 }
6946 if (zroot) return(RTFOUND);
6947 return(IDA_SUCCESS);
6948 }
6949
6950 /*
6951 * IDARcheck3
6952 *
6953 * This routine interfaces to IDARootfind to look for a root of g
6954 * between tlo and either tn or tout, whichever comes first.
6955 * Only roots beyond tlo in the direction of integration are sought.
6956 *
6957 * This routine returns an int equal to:
6958 * IDA_RTFUNC_FAIL < 0 if the g function failed, or
6959 * RTFOUND = 1 if a root of g was found, or
6960 * IDA_SUCCESS = 0 otherwise.
6961 */
6962
IDARcheck3(IDAMem IDA_mem)6963 static int IDARcheck3(IDAMem IDA_mem)
6964 {
6965 int i, ier, retval;
6966
6967 /* Set thi = tn or tout, whichever comes first. */
6968 if (IDA_mem->ida_taskc == IDA_ONE_STEP) IDA_mem->ida_thi = IDA_mem->ida_tn;
6969 if (IDA_mem->ida_taskc == IDA_NORMAL) {
6970 IDA_mem->ida_thi = ((IDA_mem->ida_toutc - IDA_mem->ida_tn)*IDA_mem->ida_hh >= ZERO)
6971 ? IDA_mem->ida_tn : IDA_mem->ida_toutc;
6972 }
6973
6974 /* Get y and y' at thi. */
6975 (void) IDAGetSolution(IDA_mem, IDA_mem->ida_thi, IDA_mem->ida_yy, IDA_mem->ida_yp);
6976
6977
6978 /* Set ghi = g(thi) and call IDARootfind to search (tlo,thi) for roots. */
6979 retval = IDA_mem->ida_gfun(IDA_mem->ida_thi, IDA_mem->ida_yy,
6980 IDA_mem->ida_yp, IDA_mem->ida_ghi,
6981 IDA_mem->ida_user_data);
6982 IDA_mem->ida_nge++;
6983 if (retval != 0) return(IDA_RTFUNC_FAIL);
6984
6985 IDA_mem->ida_ttol = ((SUNRabs(IDA_mem->ida_tn) + SUNRabs(IDA_mem->ida_hh)) *
6986 IDA_mem->ida_uround * HUNDRED);
6987 ier = IDARootfind(IDA_mem);
6988 if (ier == IDA_RTFUNC_FAIL) return(IDA_RTFUNC_FAIL);
6989 for(i=0; i<IDA_mem->ida_nrtfn; i++) {
6990 if(!IDA_mem->ida_gactive[i] && IDA_mem->ida_grout[i] != ZERO)
6991 IDA_mem->ida_gactive[i] = SUNTRUE;
6992 }
6993 IDA_mem->ida_tlo = IDA_mem->ida_trout;
6994 for (i = 0; i < IDA_mem->ida_nrtfn; i++)
6995 IDA_mem->ida_glo[i] = IDA_mem->ida_grout[i];
6996
6997 /* If no root found, return IDA_SUCCESS. */
6998 if (ier == IDA_SUCCESS) return(IDA_SUCCESS);
6999
7000 /* If a root was found, interpolate to get y(trout) and return. */
7001 (void) IDAGetSolution(IDA_mem, IDA_mem->ida_trout, IDA_mem->ida_yy, IDA_mem->ida_yp);
7002 return(RTFOUND);
7003 }
7004
7005 /*
7006 * IDARootfind
7007 *
7008 * This routine solves for a root of g(t) between tlo and thi, if
7009 * one exists. Only roots of odd multiplicity (i.e. with a change
7010 * of sign in one of the g_i), or exact zeros, are found.
7011 * Here the sign of tlo - thi is arbitrary, but if multiple roots
7012 * are found, the one closest to tlo is returned.
7013 *
7014 * The method used is the Illinois algorithm, a modified secant method.
7015 * Reference: Kathie L. Hiebert and Lawrence F. Shampine, Implicitly
7016 * Defined Output Points for Solutions of ODEs, Sandia National
7017 * Laboratory Report SAND80-0180, February 1980.
7018 *
7019 * This routine uses the following parameters for communication:
7020 *
7021 * nrtfn = number of functions g_i, or number of components of
7022 * the vector-valued function g(t). Input only.
7023 *
7024 * gfun = user-defined function for g(t). Its form is
7025 * (void) gfun(t, y, yp, gt, user_data)
7026 *
7027 * rootdir = in array specifying the direction of zero-crossings.
7028 * If rootdir[i] > 0, search for roots of g_i only if
7029 * g_i is increasing; if rootdir[i] < 0, search for
7030 * roots of g_i only if g_i is decreasing; otherwise
7031 * always search for roots of g_i.
7032 *
7033 * gactive = array specifying whether a component of g should
7034 * or should not be monitored. gactive[i] is initially
7035 * set to SUNTRUE for all i=0,...,nrtfn-1, but it may be
7036 * reset to SUNFALSE if at the first step g[i] is 0.0
7037 * both at the I.C. and at a small perturbation of them.
7038 * gactive[i] is then set back on SUNTRUE only after the
7039 * corresponding g function moves away from 0.0.
7040 *
7041 * nge = cumulative counter for gfun calls.
7042 *
7043 * ttol = a convergence tolerance for trout. Input only.
7044 * When a root at trout is found, it is located only to
7045 * within a tolerance of ttol. Typically, ttol should
7046 * be set to a value on the order of
7047 * 100 * UROUND * max (SUNRabs(tlo), SUNRabs(thi))
7048 * where UROUND is the unit roundoff of the machine.
7049 *
7050 * tlo, thi = endpoints of the interval in which roots are sought.
7051 * On input, these must be distinct, but tlo - thi may
7052 * be of either sign. The direction of integration is
7053 * assumed to be from tlo to thi. On return, tlo and thi
7054 * are the endpoints of the final relevant interval.
7055 *
7056 * glo, ghi = arrays of length nrtfn containing the vectors g(tlo)
7057 * and g(thi) respectively. Input and output. On input,
7058 * none of the glo[i] should be zero.
7059 *
7060 * trout = root location, if a root was found, or thi if not.
7061 * Output only. If a root was found other than an exact
7062 * zero of g, trout is the endpoint thi of the final
7063 * interval bracketing the root, with size at most ttol.
7064 *
7065 * grout = array of length nrtfn containing g(trout) on return.
7066 *
7067 * iroots = int array of length nrtfn with root information.
7068 * Output only. If a root was found, iroots indicates
7069 * which components g_i have a root at trout. For
7070 * i = 0, ..., nrtfn-1, iroots[i] = 1 if g_i has a root
7071 * and g_i is increasing, iroots[i] = -1 if g_i has a
7072 * root and g_i is decreasing, and iroots[i] = 0 if g_i
7073 * has no roots or g_i varies in the direction opposite
7074 * to that indicated by rootdir[i].
7075 *
7076 * This routine returns an int equal to:
7077 * IDA_RTFUNC_FAIL < 0 if the g function failed, or
7078 * RTFOUND = 1 if a root of g was found, or
7079 * IDA_SUCCESS = 0 otherwise.
7080 *
7081 */
7082
IDARootfind(IDAMem IDA_mem)7083 static int IDARootfind(IDAMem IDA_mem)
7084 {
7085 realtype alph, tmid, gfrac, maxfrac, fracint, fracsub;
7086 int i, retval, imax, side, sideprev;
7087 booleantype zroot, sgnchg;
7088
7089 imax = 0;
7090
7091 /* First check for change in sign in ghi or for a zero in ghi. */
7092 maxfrac = ZERO;
7093 zroot = SUNFALSE;
7094 sgnchg = SUNFALSE;
7095 for (i = 0; i < IDA_mem->ida_nrtfn; i++) {
7096 if(!IDA_mem->ida_gactive[i]) continue;
7097 if (SUNRabs(IDA_mem->ida_ghi[i]) == ZERO) {
7098 if(IDA_mem->ida_rootdir[i] * IDA_mem->ida_glo[i] <= ZERO) {
7099 zroot = SUNTRUE;
7100 }
7101 } else {
7102 if ( (IDA_mem->ida_glo[i] * IDA_mem->ida_ghi[i] < ZERO) &&
7103 (IDA_mem->ida_rootdir[i] * IDA_mem->ida_glo[i] <= ZERO) ) {
7104 gfrac = SUNRabs(IDA_mem->ida_ghi[i] / (IDA_mem->ida_ghi[i] - IDA_mem->ida_glo[i]));
7105 if (gfrac > maxfrac) {
7106 sgnchg = SUNTRUE;
7107 maxfrac = gfrac;
7108 imax = i;
7109 }
7110 }
7111 }
7112 }
7113
7114 /* If no sign change was found, reset trout and grout. Then return
7115 IDA_SUCCESS if no zero was found, or set iroots and return RTFOUND. */
7116 if (!sgnchg) {
7117 IDA_mem->ida_trout = IDA_mem->ida_thi;
7118 for (i = 0; i < IDA_mem->ida_nrtfn; i++)
7119 IDA_mem->ida_grout[i] = IDA_mem->ida_ghi[i];
7120 if (!zroot) return(IDA_SUCCESS);
7121 for (i = 0; i < IDA_mem->ida_nrtfn; i++) {
7122 IDA_mem->ida_iroots[i] = 0;
7123 if(!IDA_mem->ida_gactive[i]) continue;
7124 if ( (SUNRabs(IDA_mem->ida_ghi[i]) == ZERO) &&
7125 (IDA_mem->ida_rootdir[i] * IDA_mem->ida_glo[i] <= ZERO) )
7126 IDA_mem->ida_iroots[i] = IDA_mem->ida_glo[i] > 0 ? -1:1;
7127 }
7128 return(RTFOUND);
7129 }
7130
7131 /* Initialize alph to avoid compiler warning */
7132 alph = ONE;
7133
7134 /* A sign change was found. Loop to locate nearest root. */
7135
7136 side = 0; sideprev = -1;
7137 for(;;) { /* Looping point */
7138
7139 /* If interval size is already less than tolerance ttol, break. */
7140 if (SUNRabs(IDA_mem->ida_thi - IDA_mem->ida_tlo) <= IDA_mem->ida_ttol)
7141 break;
7142
7143 /* Set weight alph.
7144 On the first two passes, set alph = 1. Thereafter, reset alph
7145 according to the side (low vs high) of the subinterval in which
7146 the sign change was found in the previous two passes.
7147 If the sides were opposite, set alph = 1.
7148 If the sides were the same, then double alph (if high side),
7149 or halve alph (if low side).
7150 The next guess tmid is the secant method value if alph = 1, but
7151 is closer to tlo if alph < 1, and closer to thi if alph > 1. */
7152
7153 if (sideprev == side) {
7154 alph = (side == 2) ? alph*TWO : alph*HALF;
7155 } else {
7156 alph = ONE;
7157 }
7158
7159 /* Set next root approximation tmid and get g(tmid).
7160 If tmid is too close to tlo or thi, adjust it inward,
7161 by a fractional distance that is between 0.1 and 0.5. */
7162 tmid = IDA_mem->ida_thi - (IDA_mem->ida_thi - IDA_mem->ida_tlo) *
7163 IDA_mem->ida_ghi[imax] / (IDA_mem->ida_ghi[imax] - alph*IDA_mem->ida_glo[imax]);
7164 if (SUNRabs(tmid - IDA_mem->ida_tlo) < HALF * IDA_mem->ida_ttol) {
7165 fracint = SUNRabs(IDA_mem->ida_thi - IDA_mem->ida_tlo) / IDA_mem->ida_ttol;
7166 fracsub = (fracint > FIVE) ? PT1 : HALF/fracint;
7167 tmid = IDA_mem->ida_tlo + fracsub*(IDA_mem->ida_thi - IDA_mem->ida_tlo);
7168 }
7169 if (SUNRabs(IDA_mem->ida_thi - tmid) < HALF * IDA_mem->ida_ttol) {
7170 fracint = SUNRabs(IDA_mem->ida_thi - IDA_mem->ida_tlo) / IDA_mem->ida_ttol;
7171 fracsub = (fracint > FIVE) ? PT1 : HALF/fracint;
7172 tmid = IDA_mem->ida_thi - fracsub*(IDA_mem->ida_thi - IDA_mem->ida_tlo);
7173 }
7174
7175 (void) IDAGetSolution(IDA_mem, tmid, IDA_mem->ida_yy, IDA_mem->ida_yp);
7176 retval = IDA_mem->ida_gfun(tmid, IDA_mem->ida_yy, IDA_mem->ida_yp,
7177 IDA_mem->ida_grout, IDA_mem->ida_user_data);
7178 IDA_mem->ida_nge++;
7179 if (retval != 0) return(IDA_RTFUNC_FAIL);
7180
7181 /* Check to see in which subinterval g changes sign, and reset imax.
7182 Set side = 1 if sign change is on low side, or 2 if on high side. */
7183 maxfrac = ZERO;
7184 zroot = SUNFALSE;
7185 sgnchg = SUNFALSE;
7186 sideprev = side;
7187 for (i = 0; i < IDA_mem->ida_nrtfn; i++) {
7188 if(!IDA_mem->ida_gactive[i]) continue;
7189 if (SUNRabs(IDA_mem->ida_grout[i]) == ZERO) {
7190 if(IDA_mem->ida_rootdir[i] * IDA_mem->ida_glo[i] <= ZERO)
7191 zroot = SUNTRUE;
7192 } else {
7193 if ( (IDA_mem->ida_glo[i] * IDA_mem->ida_grout[i] < ZERO) &&
7194 (IDA_mem->ida_rootdir[i] * IDA_mem->ida_glo[i] <= ZERO) ) {
7195 gfrac = SUNRabs(IDA_mem->ida_grout[i] /
7196 (IDA_mem->ida_grout[i] - IDA_mem->ida_glo[i]));
7197 if (gfrac > maxfrac) {
7198 sgnchg = SUNTRUE;
7199 maxfrac = gfrac;
7200 imax = i;
7201 }
7202 }
7203 }
7204 }
7205 if (sgnchg) {
7206 /* Sign change found in (tlo,tmid); replace thi with tmid. */
7207 IDA_mem->ida_thi = tmid;
7208 for (i = 0; i < IDA_mem->ida_nrtfn; i++)
7209 IDA_mem->ida_ghi[i] = IDA_mem->ida_grout[i];
7210 side = 1;
7211 /* Stop at root thi if converged; otherwise loop. */
7212 if (SUNRabs(IDA_mem->ida_thi - IDA_mem->ida_tlo) <= IDA_mem->ida_ttol)
7213 break;
7214 continue; /* Return to looping point. */
7215 }
7216
7217 if (zroot) {
7218 /* No sign change in (tlo,tmid), but g = 0 at tmid; return root tmid. */
7219 IDA_mem->ida_thi = tmid;
7220 for (i = 0; i < IDA_mem->ida_nrtfn; i++)
7221 IDA_mem->ida_ghi[i] = IDA_mem->ida_grout[i];
7222 break;
7223 }
7224
7225 /* No sign change in (tlo,tmid), and no zero at tmid.
7226 Sign change must be in (tmid,thi). Replace tlo with tmid. */
7227 IDA_mem->ida_tlo = tmid;
7228 for (i = 0; i < IDA_mem->ida_nrtfn; i++)
7229 IDA_mem->ida_glo[i] = IDA_mem->ida_grout[i];
7230 side = 2;
7231 /* Stop at root thi if converged; otherwise loop back. */
7232 if (SUNRabs(IDA_mem->ida_thi - IDA_mem->ida_tlo) <= IDA_mem->ida_ttol)
7233 break;
7234
7235 } /* End of root-search loop */
7236
7237 /* Reset trout and grout, set iroots, and return RTFOUND. */
7238 IDA_mem->ida_trout = IDA_mem->ida_thi;
7239 for (i = 0; i < IDA_mem->ida_nrtfn; i++) {
7240 IDA_mem->ida_grout[i] = IDA_mem->ida_ghi[i];
7241 IDA_mem->ida_iroots[i] = 0;
7242 if(!IDA_mem->ida_gactive[i]) continue;
7243 if ( (SUNRabs(IDA_mem->ida_ghi[i]) == ZERO) &&
7244 (IDA_mem->ida_rootdir[i] * IDA_mem->ida_glo[i] <= ZERO) )
7245 IDA_mem->ida_iroots[i] = IDA_mem->ida_glo[i] > 0 ? -1:1;
7246 if ( (IDA_mem->ida_glo[i] * IDA_mem->ida_ghi[i] < ZERO) &&
7247 (IDA_mem->ida_rootdir[i] * IDA_mem->ida_glo[i] <= ZERO) )
7248 IDA_mem->ida_iroots[i] = IDA_mem->ida_glo[i] > 0 ? -1:1;
7249 }
7250 return(RTFOUND);
7251 }
7252
7253 /*
7254 * =================================================================
7255 * Internal DQ approximations for sensitivity RHS
7256 * =================================================================
7257 */
7258
7259 #undef user_dataS
7260
7261 /*
7262 * IDASensResDQ
7263 *
7264 * IDASensRhsDQ computes the residuals of the sensitivity equations
7265 * by finite differences. It is of type IDASensResFn.
7266 * Returns 0 if successful, <0 if an unrecoverable failure occurred,
7267 * >0 for a recoverable error.
7268 */
7269
IDASensResDQ(int Ns,realtype t,N_Vector yy,N_Vector yp,N_Vector resval,N_Vector * yyS,N_Vector * ypS,N_Vector * resvalS,void * user_dataS,N_Vector ytemp,N_Vector yptemp,N_Vector restemp)7270 int IDASensResDQ(int Ns, realtype t,
7271 N_Vector yy, N_Vector yp, N_Vector resval,
7272 N_Vector *yyS, N_Vector *ypS, N_Vector *resvalS,
7273 void *user_dataS,
7274 N_Vector ytemp, N_Vector yptemp, N_Vector restemp)
7275 {
7276 int retval, is;
7277
7278 for (is=0; is<Ns; is++) {
7279 retval = IDASensRes1DQ(Ns, t,
7280 yy, yp, resval,
7281 is, yyS[is], ypS[is], resvalS[is],
7282 user_dataS,
7283 ytemp, yptemp, restemp);
7284 if (retval != 0) return(retval);
7285 }
7286 return(0);
7287 }
7288
7289 /*
7290 * IDASensRes1DQ
7291 *
7292 * IDASensRes1DQ computes the residual of the is-th sensitivity
7293 * equation by finite differences.
7294 *
7295 * Returns 0 if successful or the return value of res if res fails
7296 * (<0 if res fails unrecoverably, >0 if res has a recoverable error).
7297 */
7298
IDASensRes1DQ(int Ns,realtype t,N_Vector yy,N_Vector yp,N_Vector resval,int is,N_Vector yyS,N_Vector ypS,N_Vector resvalS,void * user_dataS,N_Vector ytemp,N_Vector yptemp,N_Vector restemp)7299 static int IDASensRes1DQ(int Ns, realtype t,
7300 N_Vector yy, N_Vector yp, N_Vector resval,
7301 int is,
7302 N_Vector yyS, N_Vector ypS, N_Vector resvalS,
7303 void *user_dataS,
7304 N_Vector ytemp, N_Vector yptemp, N_Vector restemp)
7305 {
7306 IDAMem IDA_mem;
7307 int method;
7308 int which;
7309 int retval;
7310 realtype psave, pbari;
7311 realtype del , rdel;
7312 realtype Delp, rDelp, r2Delp;
7313 realtype Dely, rDely, r2Dely;
7314 realtype Del , rDel , r2Del ;
7315 realtype norms, ratio;
7316
7317 /* user_dataS points to IDA_mem */
7318 IDA_mem = (IDAMem) user_dataS;
7319
7320 /* Set base perturbation del */
7321 del = SUNRsqrt(SUNMAX(IDA_mem->ida_rtol, IDA_mem->ida_uround));
7322 rdel = ONE/del;
7323
7324 pbari = IDA_mem->ida_pbar[is];
7325
7326 which = IDA_mem->ida_plist[is];
7327
7328 psave = IDA_mem->ida_p[which];
7329
7330 Delp = pbari * del;
7331 rDelp = ONE/Delp;
7332 norms = N_VWrmsNorm(yyS, IDA_mem->ida_ewt) * pbari;
7333 rDely = SUNMAX(norms, rdel) / pbari;
7334 Dely = ONE/rDely;
7335
7336 if (IDA_mem->ida_DQrhomax == ZERO) {
7337 /* No switching */
7338 method = (IDA_mem->ida_DQtype==IDA_CENTERED) ? CENTERED1 : FORWARD1;
7339 } else {
7340 /* switch between simultaneous/separate DQ */
7341 ratio = Dely * rDelp;
7342 if ( SUNMAX(ONE/ratio, ratio) <= IDA_mem->ida_DQrhomax )
7343 method = (IDA_mem->ida_DQtype==IDA_CENTERED) ? CENTERED1 : FORWARD1;
7344 else
7345 method = (IDA_mem->ida_DQtype==IDA_CENTERED) ? CENTERED2 : FORWARD2;
7346 }
7347
7348 switch (method) {
7349
7350 case CENTERED1:
7351
7352 Del = SUNMIN(Dely, Delp);
7353 r2Del = HALF/Del;
7354
7355 /* Forward perturb y, y' and parameter */
7356 N_VLinearSum(Del, yyS, ONE, yy, ytemp);
7357 N_VLinearSum(Del, ypS, ONE, yp, yptemp);
7358 IDA_mem->ida_p[which] = psave + Del;
7359
7360 /* Save residual in resvalS */
7361 retval = IDA_mem->ida_res(t, ytemp, yptemp, resvalS, IDA_mem->ida_user_data);
7362 IDA_mem->ida_nreS++;
7363 if (retval != 0) return(retval);
7364
7365 /* Backward perturb y, y' and parameter */
7366 N_VLinearSum(-Del, yyS, ONE, yy, ytemp);
7367 N_VLinearSum(-Del, ypS, ONE, yp, yptemp);
7368 IDA_mem->ida_p[which] = psave - Del;
7369
7370 /* Save residual in restemp */
7371 retval = IDA_mem->ida_res(t, ytemp, yptemp, restemp, IDA_mem->ida_user_data);
7372 IDA_mem->ida_nreS++;
7373 if (retval != 0) return(retval);
7374
7375 /* Estimate the residual for the i-th sensitivity equation */
7376 N_VLinearSum(r2Del, resvalS, -r2Del, restemp, resvalS);
7377
7378 break;
7379
7380 case CENTERED2:
7381
7382 r2Delp = HALF/Delp;
7383 r2Dely = HALF/Dely;
7384
7385 /* Forward perturb y and y' */
7386 N_VLinearSum(Dely, yyS, ONE, yy, ytemp);
7387 N_VLinearSum(Dely, ypS, ONE, yp, yptemp);
7388
7389 /* Save residual in resvalS */
7390 retval = IDA_mem->ida_res(t, ytemp, yptemp, resvalS, IDA_mem->ida_user_data);
7391 IDA_mem->ida_nreS++;
7392 if (retval != 0) return(retval);
7393
7394 /* Backward perturb y and y' */
7395 N_VLinearSum(-Dely, yyS, ONE, yy, ytemp);
7396 N_VLinearSum(-Dely, ypS, ONE, yp, yptemp);
7397
7398 /* Save residual in restemp */
7399 retval = IDA_mem->ida_res(t, ytemp, yptemp, restemp, IDA_mem->ida_user_data);
7400 IDA_mem->ida_nreS++;
7401 if (retval != 0) return(retval);
7402
7403 /* Save the first difference quotient in resvalS */
7404 N_VLinearSum(r2Dely, resvalS, -r2Dely, restemp, resvalS);
7405
7406 /* Forward perturb parameter */
7407 IDA_mem->ida_p[which] = psave + Delp;
7408
7409 /* Save residual in ytemp */
7410 retval = IDA_mem->ida_res(t, yy, yp, ytemp, IDA_mem->ida_user_data);
7411 IDA_mem->ida_nreS++;
7412 if (retval != 0) return(retval);
7413
7414 /* Backward perturb parameter */
7415 IDA_mem->ida_p[which] = psave - Delp;
7416
7417 /* Save residual in yptemp */
7418 retval = IDA_mem->ida_res(t, yy, yp, yptemp, IDA_mem->ida_user_data);
7419 IDA_mem->ida_nreS++;
7420 if (retval != 0) return(retval);
7421
7422 /* Save the second difference quotient in restemp */
7423 N_VLinearSum(r2Delp, ytemp, -r2Delp, yptemp, restemp);
7424
7425 /* Add the difference quotients for the sensitivity residual */
7426 N_VLinearSum(ONE, resvalS, ONE, restemp, resvalS);
7427
7428 break;
7429
7430 case FORWARD1:
7431
7432 Del = SUNMIN(Dely, Delp);
7433 rDel = ONE/Del;
7434
7435 /* Forward perturb y, y' and parameter */
7436 N_VLinearSum(Del, yyS, ONE, yy, ytemp);
7437 N_VLinearSum(Del, ypS, ONE, yp, yptemp);
7438 IDA_mem->ida_p[which] = psave + Del;
7439
7440 /* Save residual in resvalS */
7441 retval = IDA_mem->ida_res(t, ytemp, yptemp, resvalS, IDA_mem->ida_user_data);
7442 IDA_mem->ida_nreS++;
7443 if (retval != 0) return(retval);
7444
7445 /* Estimate the residual for the i-th sensitivity equation */
7446 N_VLinearSum(rDel, resvalS, -rDel, resval, resvalS);
7447
7448 break;
7449
7450 case FORWARD2:
7451
7452 /* Forward perturb y and y' */
7453 N_VLinearSum(Dely, yyS, ONE, yy, ytemp);
7454 N_VLinearSum(Dely, ypS, ONE, yp, yptemp);
7455
7456 /* Save residual in resvalS */
7457 retval = IDA_mem->ida_res(t, ytemp, yptemp, resvalS, IDA_mem->ida_user_data);
7458 IDA_mem->ida_nreS++;
7459 if (retval != 0) return(retval);
7460
7461 /* Save the first difference quotient in resvalS */
7462 N_VLinearSum(rDely, resvalS, -rDely, resval, resvalS);
7463
7464 /* Forward perturb parameter */
7465 IDA_mem->ida_p[which] = psave + Delp;
7466
7467 /* Save residual in restemp */
7468 retval = IDA_mem->ida_res(t, yy, yp, restemp, IDA_mem->ida_user_data);
7469 IDA_mem->ida_nreS++;
7470 if (retval != 0) return(retval);
7471
7472 /* Save the second difference quotient in restemp */
7473 N_VLinearSum(rDelp, restemp, -rDelp, resval, restemp);
7474
7475 /* Add the difference quotients for the sensitivity residual */
7476 N_VLinearSum(ONE, resvalS, ONE, restemp, resvalS);
7477
7478 break;
7479
7480 }
7481
7482 /* Restore original value of parameter */
7483 IDA_mem->ida_p[which] = psave;
7484
7485 return(0);
7486
7487 }
7488
7489
7490 /* IDAQuadSensRhsInternalDQ - internal IDAQuadSensRhsFn
7491 *
7492 * IDAQuadSensRhsInternalDQ computes right hand side of all quadrature
7493 * sensitivity equations by finite differences. All work is actually
7494 * done in IDAQuadSensRhs1InternalDQ.
7495 */
7496
IDAQuadSensRhsInternalDQ(int Ns,realtype t,N_Vector yy,N_Vector yp,N_Vector * yyS,N_Vector * ypS,N_Vector rrQ,N_Vector * resvalQS,void * ida_mem,N_Vector yytmp,N_Vector yptmp,N_Vector tmpQS)7497 static int IDAQuadSensRhsInternalDQ(int Ns, realtype t,
7498 N_Vector yy, N_Vector yp,
7499 N_Vector *yyS, N_Vector *ypS,
7500 N_Vector rrQ, N_Vector *resvalQS,
7501 void *ida_mem,
7502 N_Vector yytmp, N_Vector yptmp, N_Vector tmpQS)
7503 {
7504 IDAMem IDA_mem;
7505 int is, retval;
7506
7507 /* cvode_mem is passed here as user data */
7508 IDA_mem = (IDAMem) ida_mem;
7509
7510 for (is=0; is<Ns; is++) {
7511 retval = IDAQuadSensRhs1InternalDQ(IDA_mem, is, t,
7512 yy, yp, yyS[is], ypS[is],
7513 rrQ, resvalQS[is],
7514 yytmp, yptmp, tmpQS);
7515 if (retval!=0) return(retval);
7516 }
7517
7518 return(0);
7519 }
7520
IDAQuadSensRhs1InternalDQ(IDAMem IDA_mem,int is,realtype t,N_Vector yy,N_Vector yp,N_Vector yyS,N_Vector ypS,N_Vector resvalQ,N_Vector resvalQS,N_Vector yytmp,N_Vector yptmp,N_Vector tmpQS)7521 static int IDAQuadSensRhs1InternalDQ(IDAMem IDA_mem, int is, realtype t,
7522 N_Vector yy, N_Vector yp,
7523 N_Vector yyS, N_Vector ypS,
7524 N_Vector resvalQ, N_Vector resvalQS,
7525 N_Vector yytmp, N_Vector yptmp, N_Vector tmpQS)
7526 {
7527 int retval, method;
7528 int nfel = 0, which;
7529 realtype psave, pbari;
7530 realtype del , rdel;
7531 realtype Delp;
7532 realtype Dely, rDely;
7533 realtype Del , r2Del ;
7534 realtype norms;
7535
7536 del = SUNRsqrt(SUNMAX(IDA_mem->ida_rtol, IDA_mem->ida_uround));
7537 rdel = ONE/del;
7538
7539 pbari = IDA_mem->ida_pbar[is];
7540
7541 which = IDA_mem->ida_plist[is];
7542
7543 psave = IDA_mem->ida_p[which];
7544
7545 Delp = pbari * del;
7546 norms = N_VWrmsNorm(yyS, IDA_mem->ida_ewt) * pbari;
7547 rDely = SUNMAX(norms, rdel) / pbari;
7548 Dely = ONE/rDely;
7549
7550 method = (IDA_mem->ida_DQtype==IDA_CENTERED) ? CENTERED1 : FORWARD1;
7551
7552 switch(method) {
7553
7554 case CENTERED1:
7555
7556 Del = SUNMIN(Dely, Delp);
7557 r2Del = HALF/Del;
7558
7559 N_VLinearSum(ONE, yy, Del, yyS, yytmp);
7560 N_VLinearSum(ONE, yp, Del, ypS, yptmp);
7561 IDA_mem->ida_p[which] = psave + Del;
7562
7563 retval = IDA_mem->ida_rhsQ(t, yytmp, yptmp, resvalQS, IDA_mem->ida_user_data);
7564 nfel++;
7565 if (retval != 0) return(retval);
7566
7567 N_VLinearSum(-Del, yyS, ONE, yy, yytmp);
7568 N_VLinearSum(-Del, ypS, ONE, yp, yptmp);
7569
7570 IDA_mem->ida_p[which] = psave - Del;
7571
7572 retval = IDA_mem->ida_rhsQ(t, yytmp, yptmp, tmpQS, IDA_mem->ida_user_data);
7573 nfel++;
7574 if (retval != 0) return(retval);
7575
7576 N_VLinearSum(r2Del, resvalQS, -r2Del, tmpQS, resvalQS);
7577
7578 break;
7579
7580 case FORWARD1:
7581
7582 Del = SUNMIN(Dely, Delp);
7583 rdel = ONE/Del;
7584
7585 N_VLinearSum(ONE, yy, Del, yyS, yytmp);
7586 N_VLinearSum(ONE, yp, Del, ypS, yptmp);
7587 IDA_mem->ida_p[which] = psave + Del;
7588
7589 retval = IDA_mem->ida_rhsQ(t, yytmp, yptmp, resvalQS, IDA_mem->ida_user_data);
7590 nfel++;
7591 if (retval != 0) return(retval);
7592
7593 N_VLinearSum(rdel, resvalQS, -rdel, resvalQ, resvalQS);
7594
7595 break;
7596 }
7597
7598 IDA_mem->ida_p[which] = psave;
7599 /* Increment counter nrQeS */
7600 IDA_mem->ida_nrQeS += nfel;
7601
7602 return(0);
7603 }
7604
7605
7606 /*
7607 * =================================================================
7608 * IDA error message handling functions
7609 * =================================================================
7610 */
7611
7612 /*
7613 * IDAProcessError is a high level error handling function.
7614 * - If ida_mem==NULL it prints the error message to stderr.
7615 * - Otherwise, it sets up and calls the error handling function
7616 * pointed to by ida_ehfun.
7617 */
7618
IDAProcessError(IDAMem IDA_mem,int error_code,const char * module,const char * fname,const char * msgfmt,...)7619 void IDAProcessError(IDAMem IDA_mem,
7620 int error_code, const char *module, const char *fname,
7621 const char *msgfmt, ...)
7622 {
7623 va_list ap;
7624 char msg[256];
7625
7626 /* Initialize the argument pointer variable
7627 (msgfmt is the last required argument to IDAProcessError) */
7628
7629 va_start(ap, msgfmt);
7630
7631 /* Compose the message */
7632
7633 vsprintf(msg, msgfmt, ap);
7634
7635 if (IDA_mem == NULL) { /* We write to stderr */
7636 #ifndef NO_FPRINTF_OUTPUT
7637 STAN_SUNDIALS_FPRINTF(stderr, "\n[%s ERROR] %s\n ", module, fname);
7638 STAN_SUNDIALS_FPRINTF(stderr, "%s\n\n", msg);
7639 #endif
7640
7641 } else { /* We can call ehfun */
7642 IDA_mem->ida_ehfun(error_code, module, fname, msg, IDA_mem->ida_eh_data);
7643 }
7644
7645 /* Finalize argument processing */
7646 va_end(ap);
7647
7648 return;
7649 }
7650
7651 /* IDAErrHandler is the default error handling function.
7652 It sends the error message to the stream pointed to by ida_errfp */
7653
IDAErrHandler(int error_code,const char * module,const char * function,char * msg,void * data)7654 void IDAErrHandler(int error_code, const char *module,
7655 const char *function, char *msg, void *data)
7656 {
7657 IDAMem IDA_mem;
7658 char err_type[10];
7659
7660 /* data points to IDA_mem here */
7661
7662 IDA_mem = (IDAMem) data;
7663
7664 if (error_code == IDA_WARNING)
7665 sprintf(err_type,"WARNING");
7666 else
7667 sprintf(err_type,"ERROR");
7668
7669 #ifndef NO_FPRINTF_OUTPUT
7670 if (IDA_mem->ida_errfp != NULL) {
7671 STAN_SUNDIALS_FPRINTF(IDA_mem->ida_errfp,"\n[%s %s] %s\n",module,err_type,function);
7672 STAN_SUNDIALS_FPRINTF(IDA_mem->ida_errfp," %s\n\n",msg);
7673 }
7674 #endif
7675
7676 return;
7677 }
7678