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