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