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