1 /*
2 * -----------------------------------------------------------------
3 * $Revision: 1.8 $
4 * $Date: 2010/12/01 22:43:33 $
5 * -----------------------------------------------------------------
6 * Programmer(s): Allan Taylor, Alan Hindmarsh, Radu Serban, and
7 * Aaron Collier @ LLNL
8 * -----------------------------------------------------------------
9 * Copyright (c) 2002, The Regents of the University of California.
10 * Produced at the Lawrence Livermore National Laboratory.
11 * All rights reserved.
12 * For details, see the LICENSE file.
13 * -----------------------------------------------------------------
14 * This is the implementation file for the optional input and output
15 * functions for the KINSOL solver.
16 * -----------------------------------------------------------------
17 */
18
19 #include <stdio.h>
20 #include <stdlib.h>
21
22 #include "kinsol_impl.h"
23 #include <sundials/sundials_types.h>
24 #include <sundials/sundials_math.h>
25
26 #define ZERO RCONST(0.0)
27 #define POINT1 RCONST(0.1)
28 #define ONETHIRD RCONST(0.3333333333333333)
29 #define HALF RCONST(0.5)
30 #define TWOTHIRDS RCONST(0.6666666666666667)
31 #define POINT9 RCONST(0.9)
32 #define ONE RCONST(1.0)
33 #define TWO RCONST(2.0)
34 #define TWOPT5 RCONST(2.5)
35
36 #define liw (kin_mem->kin_liw)
37 #define lrw (kin_mem->kin_lrw)
38 #define liw1 (kin_mem->kin_liw1)
39 #define lrw1 (kin_mem->kin_lrw1)
40
41 /*
42 * =================================================================
43 * KINSOL optional input functions
44 * =================================================================
45 */
46
47 /*
48 * -----------------------------------------------------------------
49 * KINSetErrHandlerFn
50 * -----------------------------------------------------------------
51 */
52
KINSetErrHandlerFn(void * kinmem,KINErrHandlerFn ehfun,void * eh_data)53 int KINSetErrHandlerFn(void *kinmem, KINErrHandlerFn ehfun, void *eh_data)
54 {
55 KINMem kin_mem;
56
57 if (kinmem == NULL)
58 {
59 KINProcessError(NULL, KIN_MEM_NULL, "KINSOL", "KINSetErrHandlerFn", MSG_NO_MEM);
60 return(KIN_MEM_NULL);
61 }
62
63 kin_mem = (KINMem) kinmem;
64
65 kin_mem->kin_ehfun = ehfun;
66 kin_mem->kin_eh_data = eh_data;
67
68 return(KIN_SUCCESS);
69 }
70
71 /*
72 * -----------------------------------------------------------------
73 * Function : KINSetErrFile
74 * -----------------------------------------------------------------
75 */
76
KINSetErrFile(void * kinmem,FILE * errfp)77 int KINSetErrFile(void *kinmem, FILE *errfp)
78 {
79 KINMem kin_mem;
80
81 if (kinmem == NULL)
82 {
83 KINProcessError(NULL, KIN_MEM_NULL, "KINSOL", "KINSetErrFile", MSG_NO_MEM);
84 return(KIN_MEM_NULL);
85 }
86
87 kin_mem = (KINMem) kinmem;
88 kin_mem->kin_errfp = errfp;
89
90 return(KIN_SUCCESS);
91 }
92
93 #define errfp (kin_mem->kin_errfp)
94
95 /*
96 * -----------------------------------------------------------------
97 * Function : KINSetPrintLevel
98 * -----------------------------------------------------------------
99 */
100
KINSetPrintLevel(void * kinmem,int printfl)101 int KINSetPrintLevel(void *kinmem, int printfl)
102 {
103 KINMem kin_mem;
104
105 if (kinmem == NULL)
106 {
107 KINProcessError(NULL, KIN_MEM_NULL, "KINSOL", "KINSetPrintLevel", MSG_NO_MEM);
108 return(KIN_MEM_NULL);
109 }
110
111 kin_mem = (KINMem) kinmem;
112
113 if ((printfl < 0) || (printfl > 3))
114 {
115 KINProcessError(NULL, KIN_ILL_INPUT, "KINSOL", "KINSetPrintLevel", MSG_BAD_PRINTFL);
116 return(KIN_ILL_INPUT);
117 }
118
119 kin_mem->kin_printfl = printfl;
120
121 return(KIN_SUCCESS);
122 }
123
124 /*
125 * -----------------------------------------------------------------
126 * KINSetInfoHandlerFn
127 * -----------------------------------------------------------------
128 */
129
KINSetInfoHandlerFn(void * kinmem,KINInfoHandlerFn ihfun,void * ih_data)130 int KINSetInfoHandlerFn(void *kinmem, KINInfoHandlerFn ihfun, void *ih_data)
131 {
132 KINMem kin_mem;
133
134 if (kinmem == NULL)
135 {
136 KINProcessError(NULL, KIN_MEM_NULL, "KINSOL", "KINSetInfoHandlerFn", MSG_NO_MEM);
137 return(KIN_MEM_NULL);
138 }
139
140 kin_mem = (KINMem) kinmem;
141
142 kin_mem->kin_ihfun = ihfun;
143 kin_mem->kin_ih_data = ih_data;
144
145 return(KIN_SUCCESS);
146 }
147
148
149 /*
150 * -----------------------------------------------------------------
151 * Function : KINSetInfoFile
152 * -----------------------------------------------------------------
153 */
154
KINSetInfoFile(void * kinmem,FILE * infofp)155 int KINSetInfoFile(void *kinmem, FILE *infofp)
156 {
157 KINMem kin_mem;
158
159 if (kinmem == NULL)
160 {
161 KINProcessError(NULL, KIN_MEM_NULL, "KINSOL", "KINSetInfoFile", MSG_NO_MEM);
162 return(KIN_MEM_NULL);
163 }
164
165 kin_mem = (KINMem) kinmem;
166 kin_mem->kin_infofp = infofp;
167
168 return(KIN_SUCCESS);
169 }
170
171 /*
172 * -----------------------------------------------------------------
173 * Function : KINSetUserData
174 * -----------------------------------------------------------------
175 */
176
KINSetUserData(void * kinmem,void * user_data)177 int KINSetUserData(void *kinmem, void *user_data)
178 {
179 KINMem kin_mem;
180
181 if (kinmem == NULL)
182 {
183 KINProcessError(NULL, KIN_MEM_NULL, "KINSOL", "KINSetUserData", MSG_NO_MEM);
184 return(KIN_MEM_NULL);
185 }
186
187 kin_mem = (KINMem) kinmem;
188 kin_mem->kin_user_data = user_data;
189
190 return(KIN_SUCCESS);
191 }
192
193 /*
194 * -----------------------------------------------------------------
195 * Function : KINSetNumMaxIters
196 * -----------------------------------------------------------------
197 */
198
KINSetNumMaxIters(void * kinmem,long int mxiter)199 int KINSetNumMaxIters(void *kinmem, long int mxiter)
200 {
201 KINMem kin_mem;
202
203 if (kinmem == NULL)
204 {
205 KINProcessError(NULL, KIN_MEM_NULL, "KINSOL", "KINSetNumMaxIters", MSG_NO_MEM);
206 return(KIN_MEM_NULL);
207 }
208
209 kin_mem = (KINMem) kinmem;
210
211 if (mxiter < 0)
212 {
213 KINProcessError(NULL, KIN_ILL_INPUT, "KINSOL", "KINSetNumMaxIters", MSG_BAD_MXITER);
214 return(KIN_ILL_INPUT);
215 }
216
217 if (mxiter == 0)
218 {
219 kin_mem->kin_mxiter = MXITER_DEFAULT;
220 }
221 else
222 {
223 kin_mem->kin_mxiter = mxiter;
224 }
225
226 return(KIN_SUCCESS);
227 }
228
229 /*
230 * -----------------------------------------------------------------
231 * Function : KINSetNoInitSetup
232 * -----------------------------------------------------------------
233 */
234
KINSetNoInitSetup(void * kinmem,booleantype noInitSetup)235 int KINSetNoInitSetup(void *kinmem, booleantype noInitSetup)
236 {
237 KINMem kin_mem;
238
239 if (kinmem == NULL)
240 {
241 KINProcessError(NULL, KIN_MEM_NULL, "KINSOL", "KINSetNoInitSetup", MSG_NO_MEM);
242 return(KIN_MEM_NULL);
243 }
244
245 kin_mem = (KINMem) kinmem;
246 kin_mem->kin_noInitSetup = noInitSetup;
247
248 return(KIN_SUCCESS);
249 }
250
251 /*
252 * -----------------------------------------------------------------
253 * Function : KINSetNoResMon
254 * -----------------------------------------------------------------
255 */
256
KINSetNoResMon(void * kinmem,booleantype noResMon)257 int KINSetNoResMon(void *kinmem, booleantype noResMon)
258 {
259 KINMem kin_mem;
260
261 if (kinmem == NULL)
262 {
263 KINProcessError(NULL, KIN_MEM_NULL, "KINSOL", "KINSetNoResMon", MSG_NO_MEM);
264 return(KIN_MEM_NULL);
265 }
266
267 kin_mem = (KINMem) kinmem;
268 kin_mem->kin_noResMon = noResMon;
269
270 return(KIN_SUCCESS);
271 }
272
273 /*
274 * -----------------------------------------------------------------
275 * Function : KINSetMaxSetupCalls
276 * -----------------------------------------------------------------
277 */
278
KINSetMaxSetupCalls(void * kinmem,long int msbset)279 int KINSetMaxSetupCalls(void *kinmem, long int msbset)
280 {
281 KINMem kin_mem;
282
283 if (kinmem == NULL)
284 {
285 KINProcessError(NULL, KIN_MEM_NULL, "KINSOL", "KINSetMaxSetupCalls", MSG_NO_MEM);
286 return(KIN_MEM_NULL);
287 }
288
289 kin_mem = (KINMem) kinmem;
290
291 if (msbset < 0)
292 {
293 KINProcessError(NULL, KIN_ILL_INPUT, "KINSOL", "KINSetMaxSetupCalls", MSG_BAD_MSBSET);
294 return(KIN_ILL_INPUT);
295 }
296
297 if (msbset == 0)
298 {
299 kin_mem->kin_msbset = MSBSET_DEFAULT;
300 }
301 else
302 {
303 kin_mem->kin_msbset = msbset;
304 }
305
306 return(KIN_SUCCESS);
307 }
308
309 /*
310 * -----------------------------------------------------------------
311 * Function : KINSetMaxSubSetupCalls
312 * -----------------------------------------------------------------
313 */
314
KINSetMaxSubSetupCalls(void * kinmem,long int msbsetsub)315 int KINSetMaxSubSetupCalls(void *kinmem, long int msbsetsub)
316 {
317 KINMem kin_mem;
318
319 if (kinmem == NULL)
320 {
321 KINProcessError(NULL, KIN_MEM_NULL, "KINSOL", "KINSetMaxSubSetupCalls", MSG_NO_MEM);
322 return(KIN_MEM_NULL);
323 }
324
325 kin_mem = (KINMem) kinmem;
326
327 if (msbsetsub < 0)
328 {
329 KINProcessError(NULL, KIN_ILL_INPUT, "KINSOL", "KINSetMaxSubSetupCalls", MSG_BAD_MSBSETSUB);
330 return(KIN_ILL_INPUT);
331 }
332
333 if (msbsetsub == 0)
334 {
335 kin_mem->kin_msbset_sub = MSBSET_SUB_DEFAULT;
336 }
337 else
338 {
339 kin_mem->kin_msbset_sub = msbsetsub;
340 }
341
342 return(KIN_SUCCESS);
343 }
344
345 /*
346 * -----------------------------------------------------------------
347 * Function : KINSetEtaForm
348 * -----------------------------------------------------------------
349 */
350
KINSetEtaForm(void * kinmem,int etachoice)351 int KINSetEtaForm(void *kinmem, int etachoice)
352 {
353 KINMem kin_mem;
354
355 if (kinmem == NULL)
356 {
357 KINProcessError(NULL, KIN_MEM_NULL, "KINSOL", "KINSetEtaForm", MSG_NO_MEM);
358 return(KIN_MEM_NULL);
359 }
360
361 kin_mem = (KINMem) kinmem;
362
363 if ((etachoice != KIN_ETACONSTANT) &&
364 (etachoice != KIN_ETACHOICE1) &&
365 (etachoice != KIN_ETACHOICE2))
366 {
367 KINProcessError(NULL, KIN_ILL_INPUT, "KINSOL", "KINSetEtaForm", MSG_BAD_ETACHOICE);
368 return(KIN_ILL_INPUT);
369 }
370
371 kin_mem->kin_etaflag = etachoice;
372
373 return(KIN_SUCCESS);
374 }
375
376 /*
377 * -----------------------------------------------------------------
378 * Function : KINSetEtaConstValue
379 * -----------------------------------------------------------------
380 */
381
KINSetEtaConstValue(void * kinmem,realtype eta)382 int KINSetEtaConstValue(void *kinmem, realtype eta)
383 {
384 KINMem kin_mem;
385
386 if (kinmem == NULL)
387 {
388 KINProcessError(NULL, KIN_MEM_NULL, "KINSOL", "KINSetEtaConstValue", MSG_NO_MEM);
389 return(KIN_MEM_NULL);
390 }
391
392 kin_mem = (KINMem) kinmem;
393
394 if ((eta < ZERO) || (eta > ONE))
395 {
396 KINProcessError(NULL, KIN_ILL_INPUT, "KINSOL", "KINSetEtaConstValue", MSG_BAD_ETACONST);
397 return(KIN_ILL_INPUT);
398 }
399
400 if (eta == ZERO)
401 {
402 kin_mem->kin_eta = POINT1;
403 }
404 else
405 {
406 kin_mem->kin_eta = eta;
407 }
408
409 return(KIN_SUCCESS);
410 }
411
412 /*
413 * -----------------------------------------------------------------
414 * Function : KINSetEtaParams
415 * -----------------------------------------------------------------
416 */
417
KINSetEtaParams(void * kinmem,realtype egamma,realtype ealpha)418 int KINSetEtaParams(void *kinmem, realtype egamma, realtype ealpha)
419 {
420 KINMem kin_mem;
421
422 if (kinmem == NULL)
423 {
424 KINProcessError(NULL, KIN_MEM_NULL, "KINSOL", "KINSetEtaParams", MSG_NO_MEM);
425 return(KIN_MEM_NULL);
426 }
427
428 kin_mem = (KINMem) kinmem;
429
430 if ((ealpha <= ONE) || (ealpha > TWO))
431 if (ealpha != ZERO)
432 {
433 KINProcessError(NULL, KIN_ILL_INPUT, "KINSOL", "KINSetEtaParams", MSG_BAD_ALPHA);
434 return(KIN_ILL_INPUT);
435 }
436
437 if (ealpha == ZERO)
438 {
439 kin_mem->kin_eta_alpha = TWO;
440 }
441 else
442 {
443 kin_mem->kin_eta_alpha = ealpha;
444 }
445
446 if ((egamma <= ZERO) || (egamma > ONE))
447 if (egamma != ZERO)
448 {
449 KINProcessError(NULL, KIN_ILL_INPUT, "KINSOL", "KINSetEtaParams", MSG_BAD_GAMMA);
450 return(KIN_ILL_INPUT);
451 }
452
453 if (egamma == ZERO)
454 {
455 kin_mem->kin_eta_gamma = POINT9;
456 }
457 else
458 {
459 kin_mem->kin_eta_gamma = egamma;
460 }
461
462 return(KIN_SUCCESS);
463 }
464
465 /*
466 * -----------------------------------------------------------------
467 * Function : KINSetResMonParams
468 * -----------------------------------------------------------------
469 */
470
KINSetResMonParams(void * kinmem,realtype omegamin,realtype omegamax)471 int KINSetResMonParams(void *kinmem, realtype omegamin, realtype omegamax)
472 {
473 KINMem kin_mem;
474
475 if (kinmem == NULL)
476 {
477 KINProcessError(NULL, KIN_MEM_NULL, "KINSOL", "KINSetResMonParams", MSG_NO_MEM);
478 return(KIN_MEM_NULL);
479 }
480
481 kin_mem = (KINMem) kinmem;
482
483 /* check omegamin */
484
485 if (omegamin < ZERO)
486 {
487 KINProcessError(NULL, KIN_ILL_INPUT, "KINSOL", "KINSetResMonParams", MSG_BAD_OMEGA);
488 return(KIN_ILL_INPUT);
489 }
490
491 if (omegamin == ZERO)
492 {
493 kin_mem->kin_omega_min = OMEGA_MIN;
494 }
495 else
496 {
497 kin_mem->kin_omega_min = omegamin;
498 }
499
500 /* check omegamax */
501
502 if (omegamax < ZERO)
503 {
504 KINProcessError(NULL, KIN_ILL_INPUT, "KINSOL", "KINSetResMonParams", MSG_BAD_OMEGA);
505 return(KIN_ILL_INPUT);
506 }
507
508 if (omegamax == ZERO)
509 {
510
511 if (kin_mem->kin_omega_min > OMEGA_MAX)
512 {
513 KINProcessError(NULL, KIN_ILL_INPUT, "KINSOL", "KINSetResMonParams", MSG_BAD_OMEGA);
514 return(KIN_ILL_INPUT);
515 }
516 else
517 {
518 kin_mem->kin_omega_max = OMEGA_MAX;
519 }
520
521 }
522 else
523 {
524
525 if (kin_mem->kin_omega_min > omegamax)
526 {
527 KINProcessError(NULL, KIN_ILL_INPUT, "KINSOL", "KINSetResMonParams", MSG_BAD_OMEGA);
528 return(KIN_ILL_INPUT);
529 }
530 else
531 {
532 kin_mem->kin_omega_max = omegamax;
533 }
534
535 }
536
537 return(KIN_SUCCESS);
538 }
539
540 /*
541 * -----------------------------------------------------------------
542 * Function : KINSetResMonConstValue
543 * -----------------------------------------------------------------
544 */
545
KINSetResMonConstValue(void * kinmem,realtype omegaconst)546 int KINSetResMonConstValue(void *kinmem, realtype omegaconst)
547 {
548 KINMem kin_mem;
549
550 if (kinmem == NULL)
551 {
552 KINProcessError(NULL, KIN_MEM_NULL, "KINSOL", "KINSetResMonConstValue", MSG_NO_MEM);
553 return(KIN_MEM_NULL);
554 }
555
556 kin_mem = (KINMem) kinmem;
557
558 /* check omegaconst */
559
560 if (omegaconst < ZERO)
561 {
562 KINProcessError(NULL, KIN_ILL_INPUT, "KINSOL", "KINSetResMonConstValue", MSG_BAD_OMEGA);
563 return(KIN_ILL_INPUT);
564 }
565
566 /* Load omega value. A value of 0 will force using omega_min and omega_max */
567 kin_mem->kin_omega = omegaconst;
568
569 return(KIN_SUCCESS);
570 }
571
572 /*
573 * -----------------------------------------------------------------
574 * Function : KINSetNoMinEps
575 * -----------------------------------------------------------------
576 */
577
KINSetNoMinEps(void * kinmem,booleantype noMinEps)578 int KINSetNoMinEps(void *kinmem, booleantype noMinEps)
579 {
580 KINMem kin_mem;
581
582 if (kinmem == NULL)
583 {
584 KINProcessError(NULL, KIN_MEM_NULL, "KINSOL", "KINSetNoMinEps", MSG_NO_MEM);
585 return(KIN_MEM_NULL);
586 }
587
588 kin_mem = (KINMem) kinmem;
589 kin_mem->kin_noMinEps = noMinEps;
590
591 return(KIN_SUCCESS);
592 }
593
594 /*
595 * -----------------------------------------------------------------
596 * Function : KINSetMaxNewtonStep
597 * -----------------------------------------------------------------
598 */
599
KINSetMaxNewtonStep(void * kinmem,realtype mxnewtstep)600 int KINSetMaxNewtonStep(void *kinmem, realtype mxnewtstep)
601 {
602 KINMem kin_mem;
603
604 if (kinmem == NULL)
605 {
606 KINProcessError(NULL, KIN_MEM_NULL, "KINSOL", "KINSetMaxNewtonStep", MSG_NO_MEM);
607 return(KIN_MEM_NULL);
608 }
609
610 kin_mem = (KINMem) kinmem;
611
612 if (mxnewtstep < ZERO)
613 {
614 KINProcessError(NULL, KIN_ILL_INPUT, "KINSOL", "KINSetMaxNewtonStep", MSG_BAD_MXNEWTSTEP);
615 return(KIN_ILL_INPUT);
616 }
617
618 /* Note: passing a value of 0.0 will use the default
619 value (computed in KINSolinit) */
620
621 kin_mem->kin_mxnewtstep = mxnewtstep;
622
623 return(KIN_SUCCESS);
624 }
625
626 /*
627 * -----------------------------------------------------------------
628 * Function : KINSetMaxBetaFails
629 * -----------------------------------------------------------------
630 */
631
KINSetMaxBetaFails(void * kinmem,long int mxnbcf)632 int KINSetMaxBetaFails(void *kinmem, long int mxnbcf)
633 {
634 KINMem kin_mem;
635
636 if (kinmem == NULL)
637 {
638 KINProcessError(NULL, KIN_MEM_NULL, "KINSOL", "KINSetMaxBetaFails", MSG_NO_MEM);
639 return(KIN_MEM_NULL);
640 }
641
642 kin_mem = (KINMem) kinmem;
643
644 if (mxnbcf < 0)
645 {
646 KINProcessError(NULL, KIN_ILL_INPUT, "KINSOL", "KINSetMaxBetaFails", MSG_BAD_MXNBCF);
647 return(KIN_ILL_INPUT);
648 }
649
650 if (mxnbcf == 0)
651 {
652 kin_mem->kin_mxnbcf = MXNBCF_DEFAULT;
653 }
654 else
655 {
656 kin_mem->kin_mxnbcf = mxnbcf;
657 }
658
659 return(KIN_SUCCESS);
660
661 }
662
663 /*
664 * -----------------------------------------------------------------
665 * Function : KINSetRelErrFunc
666 * -----------------------------------------------------------------
667 */
668
KINSetRelErrFunc(void * kinmem,realtype relfunc)669 int KINSetRelErrFunc(void *kinmem, realtype relfunc)
670 {
671 KINMem kin_mem;
672 realtype uround;
673
674 if (kinmem == NULL)
675 {
676 KINProcessError(NULL, KIN_MEM_NULL, "KINSOL", "KINSetRelErrFunc", MSG_NO_MEM);
677 return(KIN_MEM_NULL);
678 }
679
680 kin_mem = (KINMem) kinmem;
681
682 if (relfunc < ZERO)
683 {
684 KINProcessError(NULL, KIN_ILL_INPUT, "KINSOL", "KINSetRelErrFunc", MSG_BAD_RELFUNC);
685 return(KIN_ILL_INPUT);
686 }
687
688 if (relfunc == ZERO)
689 {
690 uround = kin_mem->kin_uround;
691 kin_mem->kin_sqrt_relfunc = RSqrt(uround);
692 }
693 else
694 {
695 kin_mem->kin_sqrt_relfunc = RSqrt(relfunc);
696 }
697
698 return(KIN_SUCCESS);
699 }
700
701 /*
702 * -----------------------------------------------------------------
703 * Function : KINSetFuncNormTol
704 * -----------------------------------------------------------------
705 */
706
KINSetFuncNormTol(void * kinmem,realtype fnormtol)707 int KINSetFuncNormTol(void *kinmem, realtype fnormtol)
708 {
709 KINMem kin_mem;
710 realtype uround;
711
712 if (kinmem == NULL)
713 {
714 KINProcessError(NULL, KIN_MEM_NULL, "KINSOL", "KINSetFuncNormTol", MSG_NO_MEM);
715 return(KIN_MEM_NULL);
716 }
717
718 kin_mem = (KINMem) kinmem;
719
720 if (fnormtol < ZERO)
721 {
722 KINProcessError(NULL, KIN_ILL_INPUT, "KINSOL", "KINSetFuncNormTol", MSG_BAD_FNORMTOL);
723 return(KIN_ILL_INPUT);
724 }
725
726 if (fnormtol == ZERO)
727 {
728 uround = kin_mem->kin_uround;
729 kin_mem->kin_fnormtol = RPowerR(uround, ONETHIRD);
730 }
731 else
732 {
733 kin_mem->kin_fnormtol = fnormtol;
734 }
735
736 return(KIN_SUCCESS);
737 }
738
739 /*
740 * -----------------------------------------------------------------
741 * Function : KINSetScaledStepTol
742 * -----------------------------------------------------------------
743 */
744
KINSetScaledStepTol(void * kinmem,realtype scsteptol)745 int KINSetScaledStepTol(void *kinmem, realtype scsteptol)
746 {
747 KINMem kin_mem;
748 realtype uround;
749
750 if (kinmem == NULL)
751 {
752 KINProcessError(NULL, KIN_MEM_NULL, "KINSOL", "KINSetScaledStepTol", MSG_NO_MEM);
753 return(KIN_MEM_NULL);
754 }
755
756 kin_mem = (KINMem) kinmem;
757
758 if (scsteptol < ZERO)
759 {
760 KINProcessError(NULL, KIN_ILL_INPUT, "KINSOL", "KINSetScaledStepTol", MSG_BAD_SCSTEPTOL);
761 return(KIN_ILL_INPUT);
762 }
763
764 if (scsteptol == ZERO)
765 {
766 uround = kin_mem->kin_uround;
767 kin_mem->kin_scsteptol = RPowerR(uround, TWOTHIRDS);
768 }
769 else
770 {
771 kin_mem->kin_scsteptol = scsteptol;
772 }
773
774 return(KIN_SUCCESS);
775 }
776
777 /*
778 * -----------------------------------------------------------------
779 * Function : KINSetConstraints
780 * -----------------------------------------------------------------
781 */
782
KINSetConstraints(void * kinmem,N_Vector constraints)783 int KINSetConstraints(void *kinmem, N_Vector constraints)
784 {
785 KINMem kin_mem;
786 realtype temptest;
787
788 if (kinmem == NULL)
789 {
790 KINProcessError(NULL, KIN_MEM_NULL, "KINSOL", "KINSetConstraints", MSG_NO_MEM);
791 return(KIN_MEM_NULL);
792 }
793
794 kin_mem = (KINMem) kinmem;
795
796 if (constraints == NULL)
797 {
798 if (kin_mem->kin_constraintsSet)
799 {
800 N_VDestroy(kin_mem->kin_constraints);
801 lrw -= lrw1;
802 liw -= liw1;
803 }
804 kin_mem->kin_constraintsSet = FALSE;
805 return(KIN_SUCCESS);
806 }
807
808 /* Check the constraints vector */
809
810 temptest = N_VMaxNorm(constraints);
811 if (temptest > TWOPT5)
812 {
813 KINProcessError(NULL, KIN_ILL_INPUT, "KINSOL", "KINSetConstraints", MSG_BAD_CONSTRAINTS);
814 return(KIN_ILL_INPUT);
815 }
816
817 if (!kin_mem->kin_constraintsSet)
818 {
819 kin_mem->kin_constraints = N_VClone(constraints);
820 lrw += lrw1;
821 liw += liw1;
822 kin_mem->kin_constraintsSet = TRUE;
823 }
824
825 /* Load the constraint vector */
826
827 N_VScale(ONE, constraints, kin_mem->kin_constraints);
828
829 return(KIN_SUCCESS);
830 }
831
832 /*
833 * -----------------------------------------------------------------
834 * Function : KINSetSysFunc
835 * -----------------------------------------------------------------
836 */
837
KINSetSysFunc(void * kinmem,KINSysFn func)838 int KINSetSysFunc(void *kinmem, KINSysFn func)
839 {
840 KINMem kin_mem;
841
842 if (kinmem == NULL)
843 {
844 KINProcessError(NULL, KIN_MEM_NULL, "KINSOL", "KINSetSysFunc", MSG_NO_MEM);
845 return(KIN_MEM_NULL);
846 }
847
848 kin_mem = (KINMem) kinmem;
849
850 if (func == NULL)
851 {
852 KINProcessError(NULL, KIN_ILL_INPUT, "KINSOL", "KINSetSysFunc", MSG_FUNC_NULL);
853 return(KIN_ILL_INPUT);
854 }
855
856 kin_mem->kin_func = func;
857
858 return(KIN_SUCCESS);
859 }
860
861 /*
862 * =================================================================
863 * Readability constants
864 * =================================================================
865 */
866
867 #define nni (kin_mem->kin_nni)
868 #define nfe (kin_mem->kin_nfe)
869 #define nbcf (kin_mem->kin_nbcf)
870 #define nbktrk (kin_mem->kin_nbktrk)
871 #define stepl (kin_mem->kin_stepl)
872 #define fnorm (kin_mem->kin_fnorm)
873 #define liw (kin_mem->kin_liw)
874 #define lrw (kin_mem->kin_lrw)
875
876 /*
877 * =================================================================
878 * KINSOL optional input functions
879 * =================================================================
880 */
881
882 /*
883 * -----------------------------------------------------------------
884 * Function : KINGetWorkSpace
885 * -----------------------------------------------------------------
886 */
887
KINGetWorkSpace(void * kinmem,long int * lenrw,long int * leniw)888 int KINGetWorkSpace(void *kinmem, long int *lenrw, long int *leniw)
889 {
890 KINMem kin_mem;
891
892 if (kinmem == NULL)
893 {
894 KINProcessError(NULL, KIN_MEM_NULL, "KINSOL", "KINGetWorkSpace", MSG_NO_MEM);
895 return(KIN_MEM_NULL);
896 }
897
898 kin_mem = (KINMem) kinmem;
899
900 *lenrw = lrw;
901 *leniw = liw;
902
903 return(KIN_SUCCESS);
904 }
905
906 /*
907 * -----------------------------------------------------------------
908 * Function : KINGetNumNonlinSolvIters
909 * -----------------------------------------------------------------
910 */
911
KINGetNumNonlinSolvIters(void * kinmem,long int * nniters)912 int KINGetNumNonlinSolvIters(void *kinmem, long int *nniters)
913 {
914 KINMem kin_mem;
915
916 if (kinmem == NULL)
917 {
918 KINProcessError(NULL, KIN_MEM_NULL, "KINSOL", "KINGetNumNonlinSolvIters", MSG_NO_MEM);
919 return(KIN_MEM_NULL);
920 }
921
922 kin_mem = (KINMem) kinmem;
923 *nniters = nni;
924
925 return(KIN_SUCCESS);
926 }
927
928 /*
929 * -----------------------------------------------------------------
930 * Function : KINGetNumFuncEvals
931 * -----------------------------------------------------------------
932 */
933
KINGetNumFuncEvals(void * kinmem,long int * nfevals)934 int KINGetNumFuncEvals(void *kinmem, long int *nfevals)
935 {
936 KINMem kin_mem;
937
938 if (kinmem == NULL)
939 {
940 KINProcessError(NULL, KIN_MEM_NULL, "KINSOL", "KINGetNumFuncEvals", MSG_NO_MEM);
941 return(KIN_MEM_NULL);
942 }
943
944 kin_mem = (KINMem) kinmem;
945 *nfevals = nfe;
946
947 return(KIN_SUCCESS);
948 }
949
950 /*
951 * -----------------------------------------------------------------
952 * Function : KINGetNumBetaCondFails
953 * -----------------------------------------------------------------
954 */
955
KINGetNumBetaCondFails(void * kinmem,long int * nbcfails)956 int KINGetNumBetaCondFails(void *kinmem, long int *nbcfails)
957 {
958 KINMem kin_mem;
959
960 if (kinmem == NULL)
961 {
962 KINProcessError(NULL, KIN_MEM_NULL, "KINSOL", "KINGetNumBetaCondFails", MSG_NO_MEM);
963 return(KIN_MEM_NULL);
964 }
965
966 kin_mem = (KINMem) kinmem;
967 *nbcfails = nbcf;
968
969 return(KIN_SUCCESS);
970 }
971
972 /*
973 * -----------------------------------------------------------------
974 * Function : KINGetNumBacktrackOps
975 * -----------------------------------------------------------------
976 */
977
KINGetNumBacktrackOps(void * kinmem,long int * nbacktr)978 int KINGetNumBacktrackOps(void *kinmem, long int *nbacktr)
979 {
980 KINMem kin_mem;
981
982 if (kinmem == NULL)
983 {
984 KINProcessError(NULL, KIN_MEM_NULL, "KINSOL", "KINGetNumBacktrackOps", MSG_NO_MEM);
985 return(KIN_MEM_NULL);
986 }
987
988 kin_mem = (KINMem) kinmem;
989 *nbacktr = nbktrk;
990
991 return(KIN_SUCCESS);
992 }
993
994 /*
995 * -----------------------------------------------------------------
996 * Function : KINGetFuncNorm
997 * -----------------------------------------------------------------
998 */
999
KINGetFuncNorm(void * kinmem,realtype * funcnorm)1000 int KINGetFuncNorm(void *kinmem, realtype *funcnorm)
1001 {
1002 KINMem kin_mem;
1003
1004 if (kinmem == NULL)
1005 {
1006 KINProcessError(NULL, KIN_MEM_NULL, "KINSOL", "KINGetFuncNorm", MSG_NO_MEM);
1007 return(KIN_MEM_NULL);
1008 }
1009
1010 kin_mem = (KINMem) kinmem;
1011 *funcnorm = fnorm;
1012
1013 return(KIN_SUCCESS);
1014 }
1015
1016 /*
1017 * -----------------------------------------------------------------
1018 * Function : KINGetStepLength
1019 * -----------------------------------------------------------------
1020 */
1021
KINGetStepLength(void * kinmem,realtype * steplength)1022 int KINGetStepLength(void *kinmem, realtype *steplength)
1023 {
1024 KINMem kin_mem;
1025
1026 if (kinmem == NULL)
1027 {
1028 KINProcessError(NULL, KIN_MEM_NULL, "KINSOL", "KINGetStepLength", MSG_NO_MEM);
1029 return(KIN_MEM_NULL);
1030 }
1031
1032 kin_mem = (KINMem) kinmem;
1033 *steplength = stepl;
1034
1035 return(KIN_SUCCESS);
1036 }
1037
1038 /*
1039 * -----------------------------------------------------------------
1040 * Function : KINGetReturnFlagName
1041 * -----------------------------------------------------------------
1042 */
1043
KINGetReturnFlagName(long int flag)1044 char *KINGetReturnFlagName(long int flag)
1045 {
1046 char *name;
1047
1048 name = (char *)malloc(24 * sizeof(char));
1049
1050 switch (flag)
1051 {
1052 case KIN_SUCCESS:
1053 sprintf(name, "KIN_SUCCESS");
1054 break;
1055 case KIN_INITIAL_GUESS_OK:
1056 sprintf(name, "KIN_INITIAL_GUESS_OK");
1057 break;
1058 case KIN_STEP_LT_STPTOL:
1059 sprintf(name, "KIN_STEP_LT_STPTOL");
1060 break;
1061 case KIN_WARNING:
1062 sprintf(name, "KIN_WARNING");
1063 break;
1064 case KIN_MEM_NULL:
1065 sprintf(name, "KIN_MEM_NULL");
1066 break;
1067 case KIN_ILL_INPUT:
1068 sprintf(name, "KIN_ILL_INPUT");
1069 break;
1070 case KIN_NO_MALLOC:
1071 sprintf(name, "KIN_NO_MALLOC");
1072 break;
1073 case KIN_MEM_FAIL:
1074 sprintf(name, "KIN_MEM_FAIL");
1075 break;
1076 case KIN_LINESEARCH_NONCONV:
1077 sprintf(name, "KIN_LINESEARCH_NONCONV");
1078 break;
1079 case KIN_MAXITER_REACHED:
1080 sprintf(name, "KIN_MAXITER_REACHED");
1081 break;
1082 case KIN_MXNEWT_5X_EXCEEDED:
1083 sprintf(name, "KIN_MXNEWT_5X_EXCEEDED");
1084 break;
1085 case KIN_LINESEARCH_BCFAIL:
1086 sprintf(name, "KIN_LINESEARCH_BCFAIL");
1087 break;
1088 case KIN_LINSOLV_NO_RECOVERY:
1089 sprintf(name, "KIN_LINSOLV_NO_RECOVERY");
1090 break;
1091 case KIN_LINIT_FAIL:
1092 sprintf(name, "KIN_LINIT_FAIL");
1093 break;
1094 case KIN_LSETUP_FAIL:
1095 sprintf(name, "KIN_LSETUP_FAIL");
1096 break;
1097 case KIN_LSOLVE_FAIL:
1098 sprintf(name, "KIN_LSOLVE_FAIL");
1099 break;
1100 default:
1101 sprintf(name, "NONE");
1102 }
1103
1104 return(name);
1105 }
1106