Mercurial > octave-nkf

comparison liboctave/NPSOL.cc @ 255:98246fedc941

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
[project @ 1993-12-08 22:55:41 by jwe]
author jwe
date Wed, 08 Dec 1993 22:55:52 +0000
parents 780cbbc57b7c
children 6027a905fc06
comparison
equal deleted inserted replaced
254:c9894e8d5f04 255:98246fedc941
36 extern "C" 36 extern "C"
37 { 37 {
38 int F77_FCN (npoptn) (char *, long); 38 int F77_FCN (npoptn) (char *, long);
39 39
40 int F77_FCN (npsol) (int *, int *, int *, int *, int *, int *, 40 int F77_FCN (npsol) (int *, int *, int *, int *, int *, int *,
41 double *, double *, double *, int (*)(), 41 double *, double *, double *,
42 int (*)(), int *, int *, int *, double *, 42 int (*)(int*, int*, int*, int*, int*, double*,
43 double*, double*, int*),
44 int (*)(int*, int*, double*, double*, double*, int*),
45 int *, int *, int *, double *,
43 double *, double *, double *, double *, 46 double *, double *, double *, double *,
44 double *, double *, int *, int *, double *, 47 double *, double *, int *, int *, double *,
45 int *); 48 int *);
46 } 49 }
50
51 // XXX FIXME XXX -- would be nice to not have to have this global
52 // variable.
53 // Nonzero means an error occurred in the calculation of the objective
54 // function, and the user wants us to quit.
55 int npsol_objective_error = 0;
47 56
48 static objective_fcn user_phi; 57 static objective_fcn user_phi;
49 static gradient_fcn user_grad; 58 static gradient_fcn user_grad;
50 static nonlinear_fcn user_g; 59 static nonlinear_fcn user_g;
51 static jacobian_fcn user_jac; 60 static jacobian_fcn user_jac;
55 double *objgrd, int *nstate) 64 double *objgrd, int *nstate)
56 { 65 {
57 int nn = *n; 66 int nn = *n;
58 Vector tmp_x (nn); 67 Vector tmp_x (nn);
59 68
69 npsol_objective_error = 0;
70
60 for (int i = 0; i < nn; i++) 71 for (int i = 0; i < nn; i++)
61 tmp_x.elem (i) = xx[i]; 72 tmp_x.elem (i) = xx[i];
62 73
63 if (*mode == 0 || *mode == 2) 74 if (*mode == 0 || *mode == 2)
64 { 75 {
65 double value = (*user_phi) (tmp_x); 76 double value = (*user_phi) (tmp_x);
77
78 if (npsol_objective_error)
79 {
80 *mode = -1;
81 return 0;
82 }
83
66 #if defined (sun) && defined (__GNUC__) 84 #if defined (sun) && defined (__GNUC__)
67 assign_double (objf, value); 85 assign_double (objf, value);
68 #else 86 #else
69 *objf = value; 87 *objf = value;
70 #endif 88 #endif
74 { 92 {
75 Vector tmp_grad (nn); 93 Vector tmp_grad (nn);
76 94
77 tmp_grad = (*user_grad) (tmp_x); 95 tmp_grad = (*user_grad) (tmp_x);
78 96
79 for (i = 0; i < nn; i++) 97 if (tmp_grad.length () == 0)
80 objgrd[i] = tmp_grad.elem (i); 98 *mode = -1;
99 else
100 {
101 for (i = 0; i < nn; i++)
102 objgrd[i] = tmp_grad.elem (i);
103 }
81 } 104 }
82 105
83 return 0; 106 return 0;
84 } 107 }
85 108
94 for (int i = 0; i < nn; i++) 117 for (int i = 0; i < nn; i++)
95 tmp_x.elem (i) = xx[i]; 118 tmp_x.elem (i) = xx[i];
96 119
97 tmp_c = (*user_g) (tmp_x); 120 tmp_c = (*user_g) (tmp_x);
98 121
99 for (i = 0; i < nncnln; i++) 122 if (tmp_c.length () == 0)
100 cons[i] = tmp_c.elem (i); 123 {
124 *mode = -1;
125 return 0;
126 }
127 else
128 {
129 for (i = 0; i < nncnln; i++)
130 cons[i] = tmp_c.elem (i);
131 }
101 132
102 if (user_jac != NULL) 133 if (user_jac != NULL)
103 { 134 {
104 Matrix tmp_jac (nncnln, nn); 135 Matrix tmp_jac (nncnln, nn);
105 136
106 tmp_jac = (*user_jac) (tmp_x); 137 tmp_jac = (*user_jac) (tmp_x);
107 138
108 int ld = *nrowj; 139 if (tmp_jac.rows () == 0 || tmp_jac.columns () == 0)
109 for (int j = 0; j < nn; j++) 140 *mode = -1;
110 for (i = 0; i < nncnln; i++) 141 else
111 cjac[i+j*ld] = tmp_jac (i, j); 142 {
143 int ld = *nrowj;
144 for (int j = 0; j < nn; j++)
145 for (i = 0; i < nncnln; i++)
146 cjac[i+j*ld] = tmp_jac (i, j);
147 }
112 } 148 }
113 149
114 return 0; 150 return 0;
115 } 151 }
116 152