mathlib-minpack.c
1 //! @file mathlib-minpack.c
2 //
3 //! @section copyright
4 //
5 // This file is part of VIF - vintage fortran compiler.
6 // Copyright 2020-2025 J. Marcel van der Veer <algol68g@xs4all.nl>.
7 //
8 //! @section license
9 //
10 // This program is free software; you can redistribute it and/or modify it
11 // under the terms of the gnu general public license as published by the
12 // free software foundation; either version 3 of the license, or
13 // (at your option) any later version.
14 //
15 // This program is distributed in the hope that it will be useful, but
16 // without any warranty; without even the implied warranty of merchantability
17 // or fitness for a particular purpose. See the GNU general public license for
18 // more details. you should have received a copy of the GNU general public
19 // license along with this program. If not, see <http://www.gnu.org/licenses/>.
20 //
21 //! @Synopsis
22 //
23 //! 23 subprograms from MINPACK
24
25 // Compiled from Fortran source code by VIF.
26 // Selected subprograms are:
27 //
28 // CHKDER ENORM HYBRD HYBRJ1 LMDER1 LMDIF1 LMSTR QFORM QRSOLV R1UPDT
29 // DOGLEG FDJAC1 HYBRD1 LMDER LMDIF LMPAR LMSTR1 QRFAC R1MPYQ RWUPDT
30 // DPMPAR FDJAC2 HYBRJ
31
32 // Minpack includes software for solving nonlinear equations and
33 // nonlinear least squares problems. Five algorithmic paths each include
34 // a core subroutine and an easy-to-use driver. The algorithms proceed
35 // either from an analytic specification of the Jacobian matrix or
36 // directly from the problem functions. The paths include facilities for
37 // systems of equations with a banded Jacobian matrix, for least squares
38 // problems with a large amount of data, and for checking the consistency
39 // of the Jacobian matrix with the functions.
40 //
41 // This directory contains the double-precision versions.
42 //
43 // Origonal authors are Jorge More, Burt Garbow, and Ken Hillstrom.
44 //
45 // This version of MINPACK is adapted for VIF.
46 // Adaptations are trivial, concerning choosing alternative names for
47 // variable names that coincided with intrinsic functions.
48 //
49 // Source: netlib.org/minpack/
50
51 // The license for MINPACK Fortran source code is:
52 //
53 // Minpack Copyright Notice (1999) University of Chicago. All rights reserved
54 //
55 // Redistribution and use in source and binary forms, with or
56 // without modification, are permitted provided that the
57 // following conditions are met:
58 //
59 // 1. Redistributions of source code must retain the above
60 // copyright notice, this list of conditions and the following
61 // disclaimer.
62 //
63 // 2. Redistributions in binary form must reproduce the above
64 // copyright notice, this list of conditions and the following
65 // disclaimer in the documentation and/or other materials
66 // provided with the distribution.
67 //
68 // 3. The end-user documentation included with the
69 // redistribution, if any, must include the following
70 // acknowledgment:
71 //
72 // "This product includes software developed by the
73 // University of Chicago, as Operator of Argonne National
74 // Laboratory.
75 //
76 // Alternately, this acknowledgment may appear in the software
77 // itself, if and wherever such third-party acknowledgments
78 // normally appear.
79 //
80 // 4. WARRANTY DISCLAIMER. THE SOFTWARE IS SUPPLIED "AS IS"
81 // WITHOUT WARRANTY OF ANY KIND. THE COPYRIGHT HOLDER, THE
82 // UNITED STATES, THE UNITED STATES DEPARTMENT OF ENERGY, AND
83 // THEIR EMPLOYEES: (1) DISCLAIM ANY WARRANTIES, EXPRESS OR
84 // IMPLIED, INCLUDING BUT NOT LIMITED TO ANY IMPLIED WARRANTIES
85 // OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE, TITLE
86 // OR NON-INFRINGEMENT, (2) DO NOT ASSUME ANY LEGAL LIABILITY
87 // OR RESPONSIBILITY FOR THE ACCURACY, COMPLETENESS, OR
88 // USEFULNESS OF THE SOFTWARE, (3) DO NOT REPRESENT THAT USE OF
89 // THE SOFTWARE WOULD NOT INFRINGE PRIVATELY OWNED RIGHTS, (4)
90 // DO NOT WARRANT THAT THE SOFTWARE WILL FUNCTION
91 // UNINTERRUPTED, THAT IT IS ERROR-FREE OR THAT ANY ERRORS WILL
92 // BE CORRECTED.
93 //
94 // 5. LIMITATION OF LIABILITY. IN NO EVENT WILL THE COPYRIGHT
95 // HOLDER, THE UNITED STATES, THE UNITED STATES DEPARTMENT OF
96 // ENERGY, OR THEIR EMPLOYEES: BE LIABLE FOR ANY INDIRECT,
97 // INCIDENTAL, CONSEQUENTIAL, SPECIAL OR PUNITIVE DAMAGES OF
98 // ANY KIND OR NATURE, INCLUDING BUT NOT LIMITED TO LOSS OF
99 // PROFITS OR LOSS OF DATA, FOR ANY REASON WHATSOEVER, WHETHER
100 // SUCH LIABILITY IS ASSERTED ON THE BASIS OF CONTRACT, TORT
101 // (INCLUDING NEGLIGENCE OR STRICT LIABILITY), OR OTHERWISE,
102 // EVEN IF ANY OF SAID PARTIES HAS BEEN WARNED OF THE
103 // POSSIBILITY OF SUCH LOSS OR DAMAGES.
104 //
105 //
106
107 /*
108 Generated by VIF - experimental VIntage Fortran compiler.
109 VIF release 1.2.17
110 */
111 #if defined (__GNUC__)
112 #pragma GCC diagnostic ignored "-Wimplicit-function-declaration"
113 #pragma GCC diagnostic ignored "-Wincompatible-pointer-types"
114 #if (__GNUC__ >= 14)
115 #pragma GCC diagnostic ignored "-Wdeclaration-missing-parameter-type"
116 #pragma GCC diagnostic ignored "-Wimplicit-int"
117 #pragma GCC diagnostic ignored "-Wint-conversion"
118 #pragma GCC diagnostic ignored "-Wreturn-mismatch"
119 #endif
120 #else
121 #error VIF requires GCC
122 #endif
127 static CALLS __calls[__ncalls] = {
128 {"chkder", 0}, // subroutine
129 {"dogleg", 0}, // subroutine
130 {"dpmpar", 0}, // real*8 function
131 {"enorm", 0}, // real*8 function
132 {"fdjac1", 0}, // subroutine
133 {"fdjac2", 0}, // subroutine
134 {"hybrd1", 0}, // subroutine
135 {"hybrd", 0}, // subroutine
136 {"hybrj1", 0}, // subroutine
137 {"hybrj", 0}, // subroutine
138 {"lmder1", 0}, // subroutine
139 {"lmder", 0}, // subroutine
140 {"lmdif1", 0}, // subroutine
141 {"lmdif", 0}, // subroutine
142 {"lmpar", 0}, // subroutine
143 {"lmstr1", 0}, // subroutine
144 {"lmstr", 0}, // subroutine
145 {"qform", 0}, // subroutine
146 {"qrfac", 0}, // subroutine
147 {"qrsolv", 0}, // subroutine
148 {"r1mpyq", 0}, // subroutine
149 {"r1updt", 0}, // subroutine
150 {"rwupdt", 0}, // subroutine
151 {NULL, 0}
152 };
153
155 ldfjac_, real_8 _p_ xp_, real_8 _p_ fvecp_, int_4 _p_ mode_, real_8 _p_ err_);
157 delta_, real_8 _p_ x_, real_8 _p_ wa1_, real_8 _p_ wa2_);
161 ldfjac_, int_4 _p_ iflag_, int_4 _p_ ml_, int_4 _p_ mu_, real_8 _p_ epsfcn_, real_8 _p_ wa1_, real_8 _p_ wa2_);
163 , int_4 _p_ ldfjac_, int_4 _p_ iflag_, real_8 _p_ epsfcn_, real_8 _p_ wa_);
165 info_, real_8 _p_ wa_, int_4 _p_ lwa_);
167 maxfev_, int_4 _p_ ml_, int_4 _p_ mu_, real_8 _p_ epsfcn_, real_8 _p_ diag_, int_4 _p_ mode_, real_8 _p_ factor_, int_4
168 _p_ nprint_, int_4 _p_ info_, int_4 _p_ nfev_, real_8 _p_ fjac_, int_4 _p_ ldfjac_, real_8 _p_ r_, int_4 _p_ lr_,
169 real_8 _p_ qtf_, real_8 _p_ wa1_, real_8 _p_ wa2_, real_8 _p_ wa3_, real_8 _p_ wa4_);
171 ldfjac_, real_8 _p_ tol_, int_4 _p_ info_, real_8 _p_ wa_, int_4 _p_ lwa_);
173 ldfjac_, real_8 _p_ xtol_, int_4 _p_ maxfev_, real_8 _p_ diag_, int_4 _p_ mode_, real_8 _p_ factor_, int_4 _p_ nprint_,
174 int_4 _p_ info_, int_4 _p_ nfev_, int_4 _p_ njev_, real_8 _p_ r_, int_4 _p_ lr_, real_8 _p_ qtf_, real_8 _p_ wa1_,
175 real_8 _p_ wa2_, real_8 _p_ wa3_, real_8 _p_ wa4_);
177 fjac_, int_4 _p_ ldfjac_, real_8 _p_ tol_, int_4 _p_ info_, int_4 _p_ ipvt_, real_8 _p_ wa_, int_4 _p_ lwa_);
179 int_4 _p_ ldfjac_, real_8 _p_ ftol_, real_8 _p_ xtol_, real_8 _p_ gtol_, int_4 _p_ maxfev_, real_8 _p_ diag_, int_4 _p_
180 mode_, real_8 _p_ factor_, int_4 _p_ nprint_, int_4 _p_ info_, int_4 _p_ nfev_, int_4 _p_ njev_, int_4 _p_ ipvt_,
181 real_8 _p_ qtf_, real_8 _p_ wa1_, real_8 _p_ wa2_, real_8 _p_ wa3_, real_8 _p_ wa4_);
183 , int_4 _p_ info_, int_4 _p_ iwa_, real_8 _p_ wa_, int_4 _p_ lwa_);
185 real_8 _p_ xtol_, real_8 _p_ gtol_, int_4 _p_ maxfev_, real_8 _p_ epsfcn_, real_8 _p_ diag_, int_4 _p_ mode_, real_8
186 _p_ factor_, int_4 _p_ nprint_, int_4 _p_ info_, int_4 _p_ nfev_, real_8 _p_ fjac_, int_4 _p_ ldfjac_, int_4 _p_ ipvt_,
187 real_8 _p_ qtf_, real_8 _p_ wa1_, real_8 _p_ wa2_, real_8 _p_ wa3_, real_8 _p_ wa4_);
189 , real_8 _p_ delta_, real_8 _p_ par_, real_8 _p_ x_, real_8 _p_ sdiag_, real_8 _p_ wa1_, real_8 _p_ wa2_);
191 fjac_, int_4 _p_ ldfjac_, real_8 _p_ tol_, int_4 _p_ info_, int_4 _p_ ipvt_, real_8 _p_ wa_, int_4 _p_ lwa_);
193 int_4 _p_ ldfjac_, real_8 _p_ ftol_, real_8 _p_ xtol_, real_8 _p_ gtol_, int_4 _p_ maxfev_, real_8 _p_ diag_, int_4 _p_
194 mode_, real_8 _p_ factor_, int_4 _p_ nprint_, int_4 _p_ info_, int_4 _p_ nfev_, int_4 _p_ njev_, int_4 _p_ ipvt_,
195 real_8 _p_ qtf_, real_8 _p_ wa1_, real_8 _p_ wa2_, real_8 _p_ wa3_, real_8 _p_ wa4_);
198 ipvt_, int_4 _p_ lipvt_, real_8 _p_ rdiag_, real_8 _p_ acnorm_, real_8 _p_ wa_);
200 qtb_, real_8 _p_ x_, real_8 _p_ sdiag_, real_8 _p_ wa_);
203 _p_ w_, logical_4 _p_ sing_);
205 real_8 _p_ cost_, real_8 _p_ sint_);
206 int_4 _chkder (int_4 _p_ m_, int_4 _p_ n_, real_8 _p_ x_, real_8 _p_ fvec_, real_8 _p_ fjac_, int_4 _p_ ldfjac_, real_8
207 _p_ xp_, real_8 _p_ fvecp_, int_4 _p_ mode_, real_8 _p_ err_)
208 { // ** body not listed **
279 }
280
281 int_4 _dogleg (int_4 _p_ n_, real_8 _p_ r_, int_4 _p_ lr_, real_8 _p_ diag_, real_8 _p_ qtb_, real_8 _p_ delta_, real_8
282 _p_ x_, real_8 _p_ wa1_, real_8 _p_ wa2_)
283 { // ** body not listed **
391 }
392
393 real_8 _dpmpar (int_4 _p_ i_)
394 { // ** body not listed **
415 }
416
417 real_8 _enorm (int_4 _p_ n_, real_8 _p_ x_)
418 { // ** body not listed **
515 }
516
517 int_4 _fdjac1 (int_4 (*_fcn)(), int_4 _p_ n_, real_8 _p_ x_, real_8 _p_ fvec_, real_8 _p_ fjac_, int_4 _p_ ldfjac_,
518 int_4 _p_ iflag_, int_4 _p_ ml_, int_4 _p_ mu_, real_8 _p_ epsfcn_, real_8 _p_ wa1_, real_8 _p_ wa2_)
519 { // ** body not listed **
590 }
591
592 int_4 _fdjac2 (int_4 (*_fcn)(), int_4 _p_ m_, int_4 _p_ n_, real_8 _p_ x_, real_8 _p_ fvec_, real_8 _p_ fjac_, int_4
593 _p_ ldfjac_, int_4 _p_ iflag_, real_8 _p_ epsfcn_, real_8 _p_ wa_)
594 { // ** body not listed **
630 }
631
632 int_4 _hybrd1 (real_4 (*_fcn)(), int_4 _p_ n_, real_8 _p_ x_, real_8 _p_ fvec_, real_8 _p_ tol_, int_4 _p_ info_,
633 real_8 _p_ wa_, int_4 _p_ lwa_)
634 { // ** body not listed **
684 }
685
686 int_4 _hybrd (int_4 (*_fcn)(), int_4 _p_ n_, real_8 _p_ x_, real_8 _p_ fvec_, real_8 _p_ xtol_, int_4 _p_ maxfev_,
687 int_4 _p_ ml_, int_4 _p_ mu_, real_8 _p_ epsfcn_, real_8 _p_ diag_, int_4 _p_ mode_, real_8 _p_ factor_, int_4 _p_
688 nprint_, int_4 _p_ info_, int_4 _p_ nfev_, real_8 _p_ fjac_, int_4 _p_ ldfjac_, real_8 _p_ r_, int_4 _p_ lr_, real_8
689 _p_ qtf_, real_8 _p_ wa1_, real_8 _p_ wa2_, real_8 _p_ wa3_, real_8 _p_ wa4_)
690 { // ** body not listed **
979 }
980 int_4 _hybrj1 (real_4 (*_fcn)(), int_4 _p_ n_, real_8 _p_ x_, real_8 _p_ fvec_, real_8 _p_ fjac_, int_4 _p_ ldfjac_,
981 real_8 _p_ tol_, int_4 _p_ info_, real_8 _p_ wa_, int_4 _p_ lwa_)
982 { // ** body not listed **
1028 }
1029
1030 int_4 _hybrj (int_4 (*_fcn)(), int_4 _p_ n_, real_8 _p_ x_, real_8 _p_ fvec_, real_8 _p_ fjac_, int_4 _p_ ldfjac_,
1031 real_8 _p_ xtol_, int_4 _p_ maxfev_, real_8 _p_ diag_, int_4 _p_ mode_, real_8 _p_ factor_, int_4 _p_ nprint_, int_4
1032 _p_ info_, int_4 _p_ nfev_, int_4 _p_ njev_, real_8 _p_ r_, int_4 _p_ lr_, real_8 _p_ qtf_, real_8 _p_ wa1_, real_8 _p_
1033 wa2_, real_8 _p_ wa3_, real_8 _p_ wa4_)
1034 { // ** body not listed **
1323 }
1324 int_4 _lmder1 (real_4 (*_fcn)(), int_4 _p_ m_, int_4 _p_ n_, real_8 _p_ x_, real_8 _p_ fvec_, real_8 _p_ fjac_, int_4
1325 _p_ ldfjac_, real_8 _p_ tol_, int_4 _p_ info_, int_4 _p_ ipvt_, real_8 _p_ wa_, int_4 _p_ lwa_)
1326 { // ** body not listed **
1365 }
1366
1367 int_4 _lmder (int_4 (*_fcn)(), int_4 _p_ m_, int_4 _p_ n_, real_8 _p_ x_, real_8 _p_ fvec_, real_8 _p_ fjac_, int_4 _p_
1368 ldfjac_, real_8 _p_ ftol_, real_8 _p_ xtol_, real_8 _p_ gtol_, int_4 _p_ maxfev_, real_8 _p_ diag_, int_4 _p_ mode_,
1369 real_8 _p_ factor_, int_4 _p_ nprint_, int_4 _p_ info_, int_4 _p_ nfev_, int_4 _p_ njev_, int_4 _p_ ipvt_, real_8 _p_
1370 qtf_, real_8 _p_ wa1_, real_8 _p_ wa2_, real_8 _p_ wa3_, real_8 _p_ wa4_)
1371 { // ** body not listed **
1652 }
1653
1654 int_4 _lmdif1 (real_4 (*_fcn)(), int_4 _p_ m_, int_4 _p_ n_, real_8 _p_ x_, real_8 _p_ fvec_, real_8 _p_ tol_, int_4
1655 _p_ info_, int_4 _p_ iwa_, real_8 _p_ wa_, int_4 _p_ lwa_)
1656 { // ** body not listed **
1697 }
1698
1699 int_4 _lmdif (int_4 (*_fcn)(), int_4 _p_ m_, int_4 _p_ n_, real_8 _p_ x_, real_8 _p_ fvec_, real_8 _p_ ftol_, real_8
1700 _p_ xtol_, real_8 _p_ gtol_, int_4 _p_ maxfev_, real_8 _p_ epsfcn_, real_8 _p_ diag_, int_4 _p_ mode_, real_8 _p_
1701 factor_, int_4 _p_ nprint_, int_4 _p_ info_, int_4 _p_ nfev_, real_8 _p_ fjac_, int_4 _p_ ldfjac_, int_4 _p_ ipvt_,
1702 real_8 _p_ qtf_, real_8 _p_ wa1_, real_8 _p_ wa2_, real_8 _p_ wa3_, real_8 _p_ wa4_)
1703 { // ** body not listed **
1983 }
1984
1985 int_4 _lmpar (int_4 _p_ n_, real_8 _p_ r_, int_4 _p_ ldr_, int_4 _p_ ipvt_, real_8 _p_ diag_, real_8 _p_ qtb_, real_8
1986 _p_ delta_, real_8 _p_ par_, real_8 _p_ x_, real_8 _p_ sdiag_, real_8 _p_ wa1_, real_8 _p_ wa2_)
1987 { // ** body not listed **
2145 }
2146
2147 int_4 _lmstr1 (real_4 (*_fcn)(), int_4 _p_ m_, int_4 _p_ n_, real_8 _p_ x_, real_8 _p_ fvec_, real_8 _p_ fjac_, int_4
2148 _p_ ldfjac_, real_8 _p_ tol_, int_4 _p_ info_, int_4 _p_ ipvt_, real_8 _p_ wa_, int_4 _p_ lwa_)
2149 { // ** body not listed **
2188 }
2189
2190 int_4 _lmstr (int_4 (*_fcn)(), int_4 _p_ m_, int_4 _p_ n_, real_8 _p_ x_, real_8 _p_ fvec_, real_8 _p_ fjac_, int_4 _p_
2191 ldfjac_, real_8 _p_ ftol_, real_8 _p_ xtol_, real_8 _p_ gtol_, int_4 _p_ maxfev_, real_8 _p_ diag_, int_4 _p_ mode_,
2192 real_8 _p_ factor_, int_4 _p_ nprint_, int_4 _p_ info_, int_4 _p_ nfev_, int_4 _p_ njev_, int_4 _p_ ipvt_, real_8 _p_
2193 qtf_, real_8 _p_ wa1_, real_8 _p_ wa2_, real_8 _p_ wa3_, real_8 _p_ wa4_)
2194 { // ** body not listed **
2495 }
2496
2497 int_4 _qform (int_4 _p_ m_, int_4 _p_ n_, real_8 _p_ q_, int_4 _p_ ldq_, real_8 _p_ wa_)
2498 { // ** body not listed **
2564 }
2565
2566 int_4 _qrfac (int_4 _p_ m_, int_4 _p_ n_, real_8 _p_ a_, int_4 _p_ lda_, logical_4 _p_ pivot_, int_4 _p_ ipvt_, int_4
2567 _p_ lipvt_, real_8 _p_ rdiag_, real_8 _p_ acnorm_, real_8 _p_ wa_)
2568 { // ** body not listed **
2670 }
2671
2672 int_4 _qrsolv (int_4 _p_ n_, real_8 _p_ r_, int_4 _p_ ldr_, int_4 _p_ ipvt_, real_8 _p_ diag_, real_8 _p_ qtb_, real_8
2673 _p_ x_, real_8 _p_ sdiag_, real_8 _p_ wa_)
2674 { // ** body not listed **
2783 }
2784
2785 int_4 _r1mpyq (int_4 _p_ m_, int_4 _p_ n_, real_8 _p_ a_, int_4 _p_ lda_, real_8 _p_ v_, real_8 _p_ w_)
2786 { // ** body not listed **
2849 }
2850
2851 int_4 _r1updt (int_4 _p_ m_, int_4 _p_ n_, real_8 _p_ s_, int_4 _p_ ls_, real_8 _p_ u_, real_8 _p_ v_, real_8 _p_ w_,
2852 logical_4 _p_ sing_)
2853 { // ** body not listed **
2983 }
2984
2985 int_4 _rwupdt (int_4 _p_ n_, real_8 _p_ r_, int_4 _p_ ldr_, real_8 _p_ w_, real_8 _p_ b_, real_8 _p_ alpha_, real_8 _p_
2986 cost_, real_8 _p_ sint_)
2987 { // ** body not listed **
3054 }
3055
|
© 2002-2025 J.M. van der Veer (jmvdveer@xs4all.nl)
|
