1 /****************************************************************
2 Copyright (C) 1997, 1999, 2000 Lucent Technologies
3 All Rights Reserved
4
5 Permission to use, copy, modify, and distribute this software and
6 its documentation for any purpose and without fee is hereby
7 granted, provided that the above copyright notice appear in all
8 copies and that both that the copyright notice and this
9 permission notice and warranty disclaimer appear in supporting
10 documentation, and that the name of Lucent or any of its entities
11 not be used in advertising or publicity pertaining to
12 distribution of the software without specific, written prior
13 permission.
14
15 LUCENT DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE,
16 INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS.
17 IN NO EVENT SHALL LUCENT OR ANY OF ITS ENTITIES BE LIABLE FOR ANY
18 SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
19 WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER
20 IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION,
21 ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF
22 THIS SOFTWARE.
23 ****************************************************************/
24
25 #include "getstub.h"
26
27 typedef struct
28 SufHead {
29 char sufid[8];
30 fint kind;
31 fint n;
32 fint namelen;
33 fint tablen;
34 } SufHead;
35
36 #ifdef __cplusplus
37 extern "C" {
38 #endif
39
40 typedef char *(*Name) ANSI((ASL*,int));
41
42 #ifdef __cplusplus
43 }
44 #endif
45
46 static void
47 #ifdef KR_headers
getsufhead(asl,d,sh,np,zp)48 getsufhead(asl, d, sh, np, zp) ASL *asl; SufDesc *d; SufHead *sh; int *np, **zp;
49 #else
50 getsufhead(ASL *asl, SufDesc *d, SufHead *sh, int *np, int **zp)
51 #endif
52 {
53 int i, *ip, *ipe, n, nz;
54 real *rp, *rpe;
55
56 memcpy(sh->sufid, "\nSuffix\n", 8);
57 sh->kind = d->kind &
58 (ASL_Sufkind_mask | ASL_Sufkind_real | ASL_Sufkind_iodcl);
59 *np = n = (&asl->i.n_var_)[i = d->kind & ASL_Sufkind_mask];
60 *zp = i < 2 ? asl->i.z[i] : 0;
61 nz = 0;
62 if (d->kind & ASL_Sufkind_real) {
63 rp = d->u.r;
64 rpe = rp + n;
65 while(rp < rpe)
66 if (*rp++)
67 nz++;
68 }
69 else {
70 ip = d->u.i;
71 ipe = ip + n;
72 while(ip < ipe)
73 if (*ip++)
74 nz++;
75 }
76 sh->n = nz;
77 sh->namelen = strlen(d->sufname) + 1;
78 sh->tablen = 0;
79 if (d->table)
80 sh->tablen = strlen(d->table) + 1;
81 }
82
83 static long
84 #ifdef KR_headers
tablines(s)85 tablines(s) char *s;
86 #else
87 tablines(char *s)
88 #endif
89 {
90 long n;
91 if (!s)
92 return 0;
93 n = 1;
94 while(*s)
95 if (*s++ == '\n')
96 n++;
97 return n;
98 }
99
100 static void
101 #ifdef KR_headers
showsol(asl,x,n,n0,z,name,what,pfix)102 showsol(asl, x, n, n0, z, name, what, pfix)
103 ASL *asl; real *x; int n, n0, *z; Name name; char *what, *pfix;
104 #else
105 showsol(ASL *asl, real *x, int n, int n0, int *z, Name name, char *what, char *pfix)
106 #endif
107 {
108 int i, j, k, k0;
109
110 if (!x || n <= 0)
111 return;
112 k0 = k = strlen(what);
113 for(i = 0; i < n0; i++)
114 if ((j = z ? z[i] : i) >= 0
115 && (j = strlen((*name)(asl,j))) > k)
116 k = j;
117 k += 2;
118 printf("\n%s%*s%svalue\n", what, k-k0, "", pfix);
119 for(i = 0; i < n0; i++)
120 if ((j = z ? z[i] : i) >= 0)
121 printf("%-*s%.g\n", k, (*name)(asl,j), x[i]);
122 }
123
124 static real *
125 #ifdef KR_headers
scale(x,s,yp,n)126 scale(x, s, yp, n) real *x, *s, **yp; int n;
127 #else
128 scale(real *x, real *s, real **yp, int n)
129 #endif
130 {
131 real *xe, *y, *y0;
132
133 y0 = y = *yp;
134 xe = x + n;
135 while(x < xe)
136 *y++ = *s++ * *x++;
137 *yp = y;
138 return y0;
139 }
140
141 static real*
142 #ifdef KR_headers
copy(n,x,yp,z)143 copy(n, x, yp, z) int n, *z; real *x, **yp;
144 #else
145 copy(int n, real *x, real **yp, int *z)
146 #endif
147 {
148 int j;
149 real *y, *y0;
150
151 y = y0 = *yp;
152 while(--n >= 0)
153 *y++ = (j = *z++) >= 0 ? x[j] : 0.;
154 *yp = y;
155 return y0;
156 }
157
158 static void
159 #ifdef KR_headers
equ_adjust1(ip,LU,U,n)160 equ_adjust1(ip, LU, U, n) int *ip; real *LU; real *U; int n;
161 #else
162 equ_adjust1(int *ip, real *LU, real *U, int n)
163 #endif
164 {
165 int i = 0;
166 if (U) {
167 for(; i < n; i++)
168 if (LU[i] == U[i] && (ip[i] == 3 || ip[i] == 4))
169 ip[i] = 5;
170 }
171 else if (LU)
172 for(; i < n; i++, LU += 2)
173 if (LU[0] == LU[1] && (ip[i] == 3 || ip[i] == 4))
174 ip[i] = 5;
175 }
176
177 void
178 #ifdef KR_headers
equ_adjust_ASL(asl,cstat,rstat)179 equ_adjust_ASL(asl, cstat, rstat) ASL *asl; int *cstat; int *rstat;
180 #else
181 equ_adjust_ASL(ASL *asl, int *cstat, int *rstat)
182 #endif
183 {
184 if (cstat)
185 equ_adjust1(cstat, LUv, Uvx, n_var);
186 if (rstat)
187 equ_adjust1(rstat, LUrhs, Urhsx, n_con);
188 }
189
190 static long
191 #ifdef KR_headers
AMPL_version_ASL(asl)192 AMPL_version_ASL(asl) ASL *asl;
193 #else
194 AMPL_version_ASL(ASL *asl)
195 #endif
196 {
197 char *s;
198 if (ampl_options[0] >= 5)
199 return ampl_options[5];
200 if (!(s = getenv("version")))
201 return 0;
202 for(;;) {
203 switch(*s++) {
204 case 0: return 0;
205 case 'V': if (!strncmp(s,"ersion ", 7))
206 goto break2;
207 }
208 }
209 break2:
210 return strtol(s+7,0,10);
211 }
212
213 int
214 #ifdef KR_headers
write_solfx_ASL(asl,msg,x,y,oi,fw_d,fw_i,fw_s,solfname)215 write_solfx_ASL(asl, msg, x, y, oi, fw_d, fw_i, fw_s, solfname)
216 ASL *asl; char *msg, *solfname; double *x, *y; Option_Info *oi; Fwrite fw_d, fw_i, fw_s;
217 #else
218 write_solfx_ASL(ASL *asl, char *msg, double *x, double *y, Option_Info *oi, Fwrite fw_d, Fwrite fw_i, Fwrite fw_s, const char *solfname)
219 #endif
220 {
221 FILE *f;
222 int N, binary, i, i1, *ip, j, k, n, nlneed, rv, tail, wantsol, *zz;
223 char *bsmsg, buf[80], *s, *s1, *s2;
224 static char *wkind[] = {"w", "wb"};
225 ftnlen L[6];
226 fint J[2], m, z[4];
227 size_t nn;
228 real *rp, *y1, *xycopy;
229 SufDesc *d;
230 SufHead sh;
231
232 if (!asl || asl->i.ASLtype < 1 || asl->i.ASLtype > 5)
233 badasl_ASL(asl,0,"write_sol");
234
235 rv = 0;
236 bsmsg = 0;
237 if ((nlneed = need_nl) > 0) {
238 if (oi && oi->bsname && (i = nlneed-2) > 0
239 && amplflag
240 && !strncmp(msg,oi->bsname,i)
241 && !strncmp(msg+i,": ",2)
242 && AMPL_version_ASL(asl) >= 20020401L) {
243 bsmsg = Malloc(nlneed + strlen(msg) + 1);
244 memset(bsmsg, '\b', nlneed);
245 strcpy(bsmsg+nlneed, msg);
246 msg = bsmsg;
247 nlneed = 0;
248 }
249 }
250 xycopy = 0;
251 if ((wantsol = oi ? oi->wantsol : 1) || amplflag) {
252 k = 0;
253 if (x) {
254 if (asl->i.vscale)
255 k = n_var;
256 if (asl->i.z[0])
257 k += asl->i.n_var0;
258 }
259 if (y) {
260 if (asl->i.cscale)
261 k += n_con;
262 if (asl->i.z[1])
263 k += asl->i.n_con0;
264 }
265 if (k)
266 y1 = xycopy = (real*)Malloc(k*sizeof(real));
267 if (x) {
268 if (asl->i.vscale)
269 x = scale(x, asl->i.vscale, &y1, n_var);
270 if (asl->i.z[0])
271 x = copy(asl->i.n_var0, x, &y1, asl->i.z[0]);
272 }
273 z[0] = m = asl->i.n_con0;
274 if (!y)
275 m = 0;
276 else {
277 if (asl->i.cscale)
278 y = scale(y, asl->i.cscale, &y1, n_con);
279 if (asl->i.z[1])
280 y = copy(asl->i.n_con0, y, &y1, asl->i.z[1]);
281 }
282 }
283 if (!amplflag && !(wantsol & 1))
284 goto write_done;
285 tail = 0;
286 if (obj_no || solve_code != -1)
287 tail = 1;
288 else {
289 for(i1 = 0; i1 < 4; i1++)
290 for(d = asl->i.suffixes[i1]; d; d = d->next)
291 if (d->kind & ASL_Sufkind_output
292 && (d->kind & ASL_Sufkind_real
293 ? (int*)d->u.r : d->u.i)) {
294 tail = 1;
295 goto break2;
296 }
297 }
298 break2:
299 binary = binary_nl & 1;
300 if (!solfname) {
301 strcpy(stub_end, ".sol");
302 solfname = filename;
303 }
304 f = fopen(solfname, wkind[binary]);
305 if (!f) {
306 fprintf(Stderr, "can't open %s\n", solfname);
307 rv = 1;
308 goto ret;
309 }
310 z[1] = m;
311 z[2] = n = asl->i.n_var0;
312 if (!x)
313 n = 0;
314 z[3] = n;
315 k = (int)ampl_options[0];
316 if (binary) {
317 L[0] = 6;
318 L[1] = strlen(msg);
319 L[2] = 0;
320 L[3] = (ampl_options[0] + 5)*sizeof(fint) + 7;
321 L[4] = m*sizeof(double);
322 L[5] = n*sizeof(double);
323 (*fw_i)(L, sizeof(ftnlen), 1, f);
324 fwrite("binary", 6, 1, f);
325 (*fw_i)(L, sizeof(ftnlen), 2, f);
326 if (L[1]) {
327 fwrite(msg, L[1], 1, f);
328 (*fw_i)(L+1, sizeof(ftnlen), 2, f);
329 }
330 if (k) {
331 (*fw_i)(L+2, sizeof(ftnlen), 2, f);
332 fwrite("Options",7,1,f);
333 nn = (size_t)ampl_options[0]+1;
334 if (ampl_options[2] == 3)
335 ampl_options[0] += 2;
336 (*fw_i)(ampl_options, sizeof(fint), nn, f);
337 (*fw_i)(z, sizeof(fint), 4, f);
338 if (ampl_options[2] == 3)
339 (*fw_d)(&l_vbtol, sizeof(real), 1, f);
340 (*fw_i)(L+3, sizeof(ftnlen), 2, f);
341 }
342 else {
343 (*fw_i)(L+2, sizeof(ftnlen), 1, f);
344 (*fw_i)(L+4, sizeof(ftnlen), 1, f);
345 }
346 if (y)
347 (*fw_d)(y, sizeof(double), m, f);
348 (*fw_i)(L+4, sizeof(ftnlen), 2, f);
349 if (x)
350 (*fw_d)(x, sizeof(double), n, f);
351 (*fw_i)(L+5, sizeof(ftnlen), 1, f);
352 if (tail)
353 switch(asl->i.flags & 1) {
354 case 0:
355 if (obj_no) {
356 L[0] = L[2] = sizeof(fint);
357 L[1] = obj_no;
358 (*fw_i)(L, sizeof(fint), 3, f);
359 }
360 break;
361 case 1:
362 L[0] = L[3] = 2*sizeof(fint);
363 L[1] = obj_no;
364 L[2] = solve_code;
365 (*fw_i)(L, sizeof(fint), 4, f);
366 for(i1 = 0; i1 < 4; i1++)
367 for(d = asl->i.suffixes[i1]; d; d = d->next)
368 if (d->kind & ASL_Sufkind_output
369 && (d->kind & ASL_Sufkind_real
370 ? (int*)d->u.r : d->u.i)) {
371 getsufhead(asl, d, &sh, &N, &zz);
372 L[0] = sizeof(sh) + sh.namelen + sh.tablen
373 + sh.n*(sizeof(int) +
374 (d->kind & ASL_Sufkind_real
375 ? sizeof(real) : sizeof(int)));
376 (*fw_i)(L, sizeof(fint), 1, f);
377 (*fw_s)(&sh, sizeof(sh), 1, f);
378 fwrite(d->sufname, sh.namelen, 1, f);
379 if (sh.tablen)
380 fwrite(d->table, sh.tablen, 1, f);
381 i = j = 0;
382 if (d->kind & ASL_Sufkind_real)
383 for(rp = d->u.r; i < N; i++) {
384 if (rp[i]) {
385 if (zz) {
386 while(zz[j] < i)
387 j++;
388 J[0] = j;
389 }
390 else
391 J[0] = i;
392 (*fw_i)(J, sizeof(fint), 1, f);
393 (*fw_d)(rp+i,sizeof(real),1,f);
394 }
395 }
396 else
397 for(ip = d->u.i; i < N; i++) {
398 if (J[1] = ip[i]) {
399 if (zz) {
400 while(zz[j] < i)
401 j++;
402 J[0] = j;
403 }
404 else
405 J[0] = i;
406 (*fw_i)(J, sizeof(fint), 2, f);
407 }
408 }
409 (*fw_i)(L, sizeof(fint), 1, f);
410 }
411 }
412 }
413 else {
414 if (*(s = msg)) {
415 for(s2 = s + strlen(s); s2 > s && s2[-1] == '\n'; --s2);
416 while (s < s2) {
417 for(s1 = s; *s1 != '\n' && ++s1 < s2;);
418 fprintf(f, s == s1 ? " \n" : "%.*s\n",s1-s,s);
419 s = s1 + 1;
420 }
421 }
422 fprintf(f, "\n");
423 if (k = (int)ampl_options[0]) {
424 if (ampl_options[2] == 3)
425 ampl_options[0] += 2;
426 fprintf(f, "Options\n");
427 for(i = 0; i <= k; i++)
428 fprintf(f,"%ld\n",(long)ampl_options[i]);
429 fprintf(f,"%ld\n%ld\n%ld\n%ld\n",
430 (long)z[0],(long)z[1],(long)z[2],(long)z[3]);
431 if (ampl_options[2] == 3) {
432 g_fmtp(buf, ampl_vbtol, 0);
433 fprintf(f, "%s\n", buf);
434 }
435 }
436 y1 = y;
437 while(--m >= 0) {
438 g_fmtp(buf, *y1++, 0);
439 fprintf(f,"%s\n", buf);
440 }
441 y1 = x;
442 while(--n >= 0) {
443 g_fmtp(buf, *y1++, 0);
444 fprintf(f, "%s\n", buf);
445 }
446 if (tail)
447 switch(asl->i.flags & 1) {
448 case 0:
449 if (obj_no)
450 fprintf(f, "objno %d\n", obj_no);
451 break;
452 case 1:
453 fprintf(f, "objno %d %d\n", obj_no, solve_code);
454 for(i1 = 0; i1 < 4; i1++)
455 for(d = asl->i.suffixes[i1]; d; d = d->next)
456 if (d->kind & ASL_Sufkind_output
457 && (d->kind & ASL_Sufkind_real
458 ? (int*)d->u.r : d->u.i)) {
459 getsufhead(asl, d, &sh, &N, &zz);
460 fprintf(f, "suffix %ld %ld %ld %ld %ld\n%s\n",
461 (long)sh.kind, (long)sh.n,
462 (long)sh.namelen, (long)sh.tablen,
463 tablines(d->table), d->sufname);
464 if (sh.tablen)
465 fprintf(f, "%s\n", d->table);
466 i = j = 0;
467 if (d->kind & ASL_Sufkind_real)
468 for(rp = d->u.r; i < N; i++) {
469 if (rp[i]) {
470 if (zz)
471 while(zz[j] < i)
472 j++;
473 else
474 j = i;
475 fprintf(f, "%d %.g\n",
476 j, rp[i]);
477 }
478 }
479 else
480 for(ip = d->u.i; i < N; i++) {
481 if (ip[i]) {
482 if (zz)
483 while(zz[j] < i)
484 j++;
485 else
486 j = i;
487 fprintf(f, "%d %d\n",
488 j, ip[i]);
489 }
490 }
491 }
492 }
493 }
494 fclose(f);
495 write_done:
496 if (i = nlneed)
497 if (i > sizeof(buf)-1 || i < 0)
498 printf("\n");
499 else {
500 buf[i] = 0;
501 do buf[--i] = '\b';
502 while(i > 0);
503 printf(buf);
504 }
505 if (!amplflag) {
506 if (!(wantsol & 8))
507 printf("%s\n", msg);
508 if (wantsol & 2)
509 showsol(asl, x, n_var, asl->i.n_var0, asl->i.z[0],
510 var_name_ASL, "variable", "");
511 if (wantsol & 4)
512 showsol(asl, y, n_con, asl->i.n_con0, asl->i.z[1],
513 con_name_ASL, "constraint", "dual ");
514 }
515 ret:
516 if (xycopy)
517 free(xycopy);
518 if (bsmsg)
519 free(bsmsg);
520 return rv;
521 }
522
523 void
524 #ifdef KR_headers
write_sol_ASL(asl,msg,x,y,oi)525 write_sol_ASL(asl, msg, x, y, oi)
526 ASL *asl; char *msg; double *x, *y; Option_Info *oi;
527 #else
528 write_sol_ASL(ASL *asl, char *msg, double *x, double *y, Option_Info *oi)
529 #endif
530 {
531 if (write_solfx_ASL(asl, msg, x, y, oi, fwrite, fwrite, fwrite, 0))
532 exit(2);
533 }
534
535 int
536 #ifdef KR_headers
write_solf_ASL(asl,msg,x,y,oi,fname)537 write_solf_ASL(asl, msg, x, y, oi, fname)
538 ASL *asl; char *msg, *fname; double *x, *y; Option_Info *oi;
539 #else
540 write_solf_ASL(ASL *asl, char *msg, double *x, double *y, Option_Info *oi, const char *fname)
541 #endif
542 {
543 return write_solfx_ASL(asl, msg, x, y, oi, fwrite, fwrite, fwrite, fname);
544 }
545
546 /* Affected by ASL update of 20020503 */
547