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