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