1 /* hybrj1.f -- translated by f2c (version 20020621).
2 You must link the resulting object file with the libraries:
3 -lf2c -lm (in that order)
4 */
5
6 #include "minpack.h"
7 #include <math.h>
8 #include "minpackP.h"
9
10
11 __minpack_attr__
__minpack_func__(hybrj1)12 void __minpack_func__(hybrj1)(__minpack_decl_fcnder_nn__ const int *n, real *x, real *
13 fvec, real *fjac, const int *ldfjac, const real *tol, int *
14 info, real *wa, const int *lwa)
15 {
16 /* Initialized data */
17
18 const real factor = 100.;
19
20 /* System generated locals */
21 int fjac_dim1, fjac_offset, i__1;
22
23 /* Local variables */
24 int j, lr, mode, nfev, njev;
25 real xtol;
26 int maxfev, nprint;
27
28 /* ********** */
29
30 /* subroutine hybrj1 */
31
32 /* the purpose of hybrj1 is to find a zero of a system of */
33 /* n nonlinear functions in n variables by a modification */
34 /* of the powell hybrid method. this is done by using the */
35 /* more general nonlinear equation solver hybrj. the user */
36 /* must provide a subroutine which calculates the functions */
37 /* and the jacobian. */
38
39 /* the subroutine statement is */
40
41 /* subroutine hybrj1(fcn,n,x,fvec,fjac,ldfjac,tol,info,wa,lwa) */
42
43 /* where */
44
45 /* fcn is the name of the user-supplied subroutine which */
46 /* calculates the functions and the jacobian. fcn must */
47 /* be declared in an external statement in the user */
48 /* calling program, and should be written as follows. */
49
50 /* subroutine fcn(n,x,fvec,fjac,ldfjac,iflag) */
51 /* integer n,ldfjac,iflag */
52 /* double precision x(n),fvec(n),fjac(ldfjac,n) */
53 /* ---------- */
54 /* if iflag = 1 calculate the functions at x and */
55 /* return this vector in fvec. do not alter fjac. */
56 /* if iflag = 2 calculate the jacobian at x and */
57 /* return this matrix in fjac. do not alter fvec. */
58 /* --------- */
59 /* return */
60 /* end */
61
62 /* the value of iflag should not be changed by fcn unless */
63 /* the user wants to terminate execution of hybrj1. */
64 /* in this case set iflag to a negative integer. */
65
66 /* n is a positive integer input variable set to the number */
67 /* of functions and variables. */
68
69 /* x is an array of length n. on input x must contain */
70 /* an initial estimate of the solution vector. on output x */
71 /* contains the final estimate of the solution vector. */
72
73 /* fvec is an output array of length n which contains */
74 /* the functions evaluated at the output x. */
75
76 /* fjac is an output n by n array which contains the */
77 /* orthogonal matrix q produced by the qr factorization */
78 /* of the final approximate jacobian. */
79
80 /* ldfjac is a positive integer input variable not less than n */
81 /* which specifies the leading dimension of the array fjac. */
82
83 /* tol is a nonnegative input variable. termination occurs */
84 /* when the algorithm estimates that the relative error */
85 /* between x and the solution is at most tol. */
86
87 /* info is an integer output variable. if the user has */
88 /* terminated execution, info is set to the (negative) */
89 /* value of iflag. see description of fcn. otherwise, */
90 /* info is set as follows. */
91
92 /* info = 0 improper input parameters. */
93
94 /* info = 1 algorithm estimates that the relative error */
95 /* between x and the solution is at most tol. */
96
97 /* info = 2 number of calls to fcn with iflag = 1 has */
98 /* reached 100*(n+1). */
99
100 /* info = 3 tol is too small. no further improvement in */
101 /* the approximate solution x is possible. */
102
103 /* info = 4 iteration is not making good progress. */
104
105 /* wa is a work array of length lwa. */
106
107 /* lwa is a positive integer input variable not less than */
108 /* (n*(n+13))/2. */
109
110 /* subprograms called */
111
112 /* user-supplied ...... fcn */
113
114 /* minpack-supplied ... hybrj */
115
116 /* argonne national laboratory. minpack project. march 1980. */
117 /* burton s. garbow, kenneth e. hillstrom, jorge j. more */
118
119 /* ********** */
120 /* Parameter adjustments */
121 --fvec;
122 --x;
123 fjac_dim1 = *ldfjac;
124 fjac_offset = 1 + fjac_dim1 * 1;
125 fjac -= fjac_offset;
126 --wa;
127
128 /* Function Body */
129 *info = 0;
130
131 /* check the input parameters for errors. */
132
133 if (*n <= 0 || *ldfjac < *n || *tol < 0. || *lwa < *n * (*n + 13) / 2) {
134 /* goto L20; */
135 return;
136 }
137
138 /* call hybrj. */
139
140 maxfev = (*n + 1) * 100;
141 xtol = *tol;
142 mode = 2;
143 i__1 = *n;
144 for (j = 1; j <= i__1; ++j) {
145 wa[j] = 1.;
146 /* L10: */
147 }
148 nprint = 0;
149 lr = *n * (*n + 1) / 2;
150 __minpack_func__(hybrj)(__minpack_param_fcnder_nn__ n, &x[1], &fvec[1], &fjac[fjac_offset], ldfjac, &xtol, &
151 maxfev, &wa[1], &mode, &factor, &nprint, info, &nfev, &njev, &wa[*
152 n * 6 + 1], &lr, &wa[*n + 1], &wa[(*n << 1) + 1], &wa[*n * 3 + 1],
153 &wa[(*n << 2) + 1], &wa[*n * 5 + 1]);
154 if (*info == 5) {
155 *info = 4;
156 }
157 /* L20: */
158 return;
159
160 /* last card of subroutine hybrj1. */
161
162 } /* hybrj1_ */
163
164