lemon-project-template-glpk
comparison deps/glpk/src/glpmps.c @ 11:4fc6ad2fb8a6
Test GLPK in src/main.cc
author | Alpar Juttner <alpar@cs.elte.hu> |
---|---|
date | Sun, 06 Nov 2011 21:43:29 +0100 |
parents | |
children |
comparison
equal
deleted
inserted
replaced
-1:000000000000 | 0:540834934ea0 |
---|---|
1 /* glpmps.c (MPS format routines) */ | |
2 | |
3 /*********************************************************************** | |
4 * This code is part of GLPK (GNU Linear Programming Kit). | |
5 * | |
6 * Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, | |
7 * 2009, 2010, 2011 Andrew Makhorin, Department for Applied Informatics, | |
8 * Moscow Aviation Institute, Moscow, Russia. All rights reserved. | |
9 * E-mail: <mao@gnu.org>. | |
10 * | |
11 * GLPK is free software: you can redistribute it and/or modify it | |
12 * under the terms of the GNU General Public License as published by | |
13 * the Free Software Foundation, either version 3 of the License, or | |
14 * (at your option) any later version. | |
15 * | |
16 * GLPK is distributed in the hope that it will be useful, but WITHOUT | |
17 * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY | |
18 * or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public | |
19 * License for more details. | |
20 * | |
21 * You should have received a copy of the GNU General Public License | |
22 * along with GLPK. If not, see <http://www.gnu.org/licenses/>. | |
23 ***********************************************************************/ | |
24 | |
25 #include "glpapi.h" | |
26 | |
27 /*********************************************************************** | |
28 * NAME | |
29 * | |
30 * glp_init_mpscp - initialize MPS format control parameters | |
31 * | |
32 * SYNOPSIS | |
33 * | |
34 * void glp_init_mpscp(glp_mpscp *parm); | |
35 * | |
36 * DESCRIPTION | |
37 * | |
38 * The routine glp_init_mpscp initializes control parameters, which are | |
39 * used by the MPS input/output routines glp_read_mps and glp_write_mps, | |
40 * with default values. | |
41 * | |
42 * Default values of the control parameters are stored in the glp_mpscp | |
43 * structure, which the parameter parm points to. */ | |
44 | |
45 void glp_init_mpscp(glp_mpscp *parm) | |
46 { parm->blank = '\0'; | |
47 parm->obj_name = NULL; | |
48 parm->tol_mps = 1e-12; | |
49 return; | |
50 } | |
51 | |
52 static void check_parm(const char *func, const glp_mpscp *parm) | |
53 { /* check control parameters */ | |
54 if (!(0x00 <= parm->blank && parm->blank <= 0xFF) || | |
55 !(parm->blank == '\0' || isprint(parm->blank))) | |
56 xerror("%s: blank = 0x%02X; invalid parameter\n", | |
57 func, parm->blank); | |
58 if (!(parm->obj_name == NULL || strlen(parm->obj_name) <= 255)) | |
59 xerror("%s: obj_name = \"%.12s...\"; parameter too long\n", | |
60 func, parm->obj_name); | |
61 if (!(0.0 <= parm->tol_mps && parm->tol_mps < 1.0)) | |
62 xerror("%s: tol_mps = %g; invalid parameter\n", | |
63 func, parm->tol_mps); | |
64 return; | |
65 } | |
66 | |
67 /*********************************************************************** | |
68 * NAME | |
69 * | |
70 * glp_read_mps - read problem data in MPS format | |
71 * | |
72 * SYNOPSIS | |
73 * | |
74 * int glp_read_mps(glp_prob *P, int fmt, const glp_mpscp *parm, | |
75 * const char *fname); | |
76 * | |
77 * DESCRIPTION | |
78 * | |
79 * The routine glp_read_mps reads problem data in MPS format from a | |
80 * text file. | |
81 * | |
82 * The parameter fmt specifies the version of MPS format: | |
83 * | |
84 * GLP_MPS_DECK - fixed (ancient) MPS format; | |
85 * GLP_MPS_FILE - free (modern) MPS format. | |
86 * | |
87 * The parameter parm is a pointer to the structure glp_mpscp, which | |
88 * specifies control parameters used by the routine. If parm is NULL, | |
89 * the routine uses default settings. | |
90 * | |
91 * The character string fname specifies a name of the text file to be | |
92 * read. | |
93 * | |
94 * Note that before reading data the current content of the problem | |
95 * object is completely erased with the routine glp_erase_prob. | |
96 * | |
97 * RETURNS | |
98 * | |
99 * If the operation was successful, the routine glp_read_mps returns | |
100 * zero. Otherwise, it prints an error message and returns non-zero. */ | |
101 | |
102 struct csa | |
103 { /* common storage area */ | |
104 glp_prob *P; | |
105 /* pointer to problem object */ | |
106 int deck; | |
107 /* MPS format (0 - free, 1 - fixed) */ | |
108 const glp_mpscp *parm; | |
109 /* pointer to control parameters */ | |
110 const char *fname; | |
111 /* name of input MPS file */ | |
112 XFILE *fp; | |
113 /* stream assigned to input MPS file */ | |
114 jmp_buf jump; | |
115 /* label for go to in case of error */ | |
116 int recno; | |
117 /* current record (card) number */ | |
118 int recpos; | |
119 /* current record (card) position */ | |
120 int c; | |
121 /* current character */ | |
122 int fldno; | |
123 /* current field number */ | |
124 char field[255+1]; | |
125 /* current field content */ | |
126 int w80; | |
127 /* warning 'record must not be longer than 80 chars' issued */ | |
128 int wef; | |
129 /* warning 'extra fields detected beyond field 6' issued */ | |
130 int obj_row; | |
131 /* objective row number */ | |
132 void *work1, *work2, *work3; | |
133 /* working arrays */ | |
134 }; | |
135 | |
136 static void error(struct csa *csa, const char *fmt, ...) | |
137 { /* print error message and terminate processing */ | |
138 va_list arg; | |
139 xprintf("%s:%d: ", csa->fname, csa->recno); | |
140 va_start(arg, fmt); | |
141 xvprintf(fmt, arg); | |
142 va_end(arg); | |
143 longjmp(csa->jump, 1); | |
144 /* no return */ | |
145 } | |
146 | |
147 static void warning(struct csa *csa, const char *fmt, ...) | |
148 { /* print warning message and continue processing */ | |
149 va_list arg; | |
150 xprintf("%s:%d: warning: ", csa->fname, csa->recno); | |
151 va_start(arg, fmt); | |
152 xvprintf(fmt, arg); | |
153 va_end(arg); | |
154 return; | |
155 } | |
156 | |
157 static void read_char(struct csa *csa) | |
158 { /* read next character */ | |
159 int c; | |
160 if (csa->c == '\n') | |
161 csa->recno++, csa->recpos = 0; | |
162 csa->recpos++; | |
163 read: c = xfgetc(csa->fp); | |
164 if (c < 0) | |
165 { if (xferror(csa->fp)) | |
166 error(csa, "read error - %s\n", xerrmsg()); | |
167 else if (csa->c == '\n') | |
168 error(csa, "unexpected end of file\n"); | |
169 else | |
170 { warning(csa, "missing final end of line\n"); | |
171 c = '\n'; | |
172 } | |
173 } | |
174 else if (c == '\n') | |
175 ; | |
176 else if (csa->c == '\r') | |
177 { c = '\r'; | |
178 goto badc; | |
179 } | |
180 else if (csa->deck && c == '\r') | |
181 { csa->c = '\r'; | |
182 goto read; | |
183 } | |
184 else if (c == ' ') | |
185 ; | |
186 else if (isspace(c)) | |
187 { if (csa->deck) | |
188 badc: error(csa, "in fixed MPS format white-space character 0x%02" | |
189 "X is not allowed\n", c); | |
190 c = ' '; | |
191 } | |
192 else if (iscntrl(c)) | |
193 error(csa, "invalid control character 0x%02X\n", c); | |
194 if (csa->deck && csa->recpos == 81 && c != '\n' && csa->w80 < 1) | |
195 { warning(csa, "in fixed MPS format record must not be longer th" | |
196 "an 80 characters\n"); | |
197 csa->w80++; | |
198 } | |
199 csa->c = c; | |
200 return; | |
201 } | |
202 | |
203 static int indicator(struct csa *csa, int name) | |
204 { /* skip comment records and read possible indicator record */ | |
205 int ret; | |
206 /* reset current field number */ | |
207 csa->fldno = 0; | |
208 loop: /* read the very first character of the next record */ | |
209 xassert(csa->c == '\n'); | |
210 read_char(csa); | |
211 if (csa->c == ' ' || csa->c == '\n') | |
212 { /* data record */ | |
213 ret = 0; | |
214 } | |
215 else if (csa->c == '*') | |
216 { /* comment record */ | |
217 while (csa->c != '\n') | |
218 read_char(csa); | |
219 goto loop; | |
220 } | |
221 else | |
222 { /* indicator record */ | |
223 int len = 0; | |
224 while (csa->c != ' ' && csa->c != '\n' && len < 12) | |
225 { csa->field[len++] = (char)csa->c; | |
226 read_char(csa); | |
227 } | |
228 csa->field[len] = '\0'; | |
229 if (!(strcmp(csa->field, "NAME") == 0 || | |
230 strcmp(csa->field, "ROWS") == 0 || | |
231 strcmp(csa->field, "COLUMNS") == 0 || | |
232 strcmp(csa->field, "RHS") == 0 || | |
233 strcmp(csa->field, "RANGES") == 0 || | |
234 strcmp(csa->field, "BOUNDS") == 0 || | |
235 strcmp(csa->field, "ENDATA") == 0)) | |
236 error(csa, "invalid indicator record\n"); | |
237 if (!name) | |
238 { while (csa->c != '\n') | |
239 read_char(csa); | |
240 } | |
241 ret = 1; | |
242 } | |
243 return ret; | |
244 } | |
245 | |
246 static void read_field(struct csa *csa) | |
247 { /* read next field of the current data record */ | |
248 csa->fldno++; | |
249 if (csa->deck) | |
250 { /* fixed MPS format */ | |
251 int beg, end, pos; | |
252 /* determine predefined field positions */ | |
253 if (csa->fldno == 1) | |
254 beg = 2, end = 3; | |
255 else if (csa->fldno == 2) | |
256 beg = 5, end = 12; | |
257 else if (csa->fldno == 3) | |
258 beg = 15, end = 22; | |
259 else if (csa->fldno == 4) | |
260 beg = 25, end = 36; | |
261 else if (csa->fldno == 5) | |
262 beg = 40, end = 47; | |
263 else if (csa->fldno == 6) | |
264 beg = 50, end = 61; | |
265 else | |
266 xassert(csa != csa); | |
267 /* skip blanks preceding the current field */ | |
268 if (csa->c != '\n') | |
269 { pos = csa->recpos; | |
270 while (csa->recpos < beg) | |
271 { if (csa->c == ' ') | |
272 ; | |
273 else if (csa->c == '\n') | |
274 break; | |
275 else | |
276 error(csa, "in fixed MPS format positions %d-%d must " | |
277 "be blank\n", pos, beg-1); | |
278 read_char(csa); | |
279 } | |
280 } | |
281 /* skip possible comment beginning in the field 3 or 5 */ | |
282 if ((csa->fldno == 3 || csa->fldno == 5) && csa->c == '$') | |
283 { while (csa->c != '\n') | |
284 read_char(csa); | |
285 } | |
286 /* read the current field */ | |
287 for (pos = beg; pos <= end; pos++) | |
288 { if (csa->c == '\n') break; | |
289 csa->field[pos-beg] = (char)csa->c; | |
290 read_char(csa); | |
291 } | |
292 csa->field[pos-beg] = '\0'; | |
293 strtrim(csa->field); | |
294 /* skip blanks following the last field */ | |
295 if (csa->fldno == 6 && csa->c != '\n') | |
296 { while (csa->recpos <= 72) | |
297 { if (csa->c == ' ') | |
298 ; | |
299 else if (csa->c == '\n') | |
300 break; | |
301 else | |
302 error(csa, "in fixed MPS format positions 62-72 must " | |
303 "be blank\n"); | |
304 read_char(csa); | |
305 } | |
306 while (csa->c != '\n') | |
307 read_char(csa); | |
308 } | |
309 } | |
310 else | |
311 { /* free MPS format */ | |
312 int len; | |
313 /* skip blanks preceding the current field */ | |
314 while (csa->c == ' ') | |
315 read_char(csa); | |
316 /* skip possible comment */ | |
317 if (csa->c == '$') | |
318 { while (csa->c != '\n') | |
319 read_char(csa); | |
320 } | |
321 /* read the current field */ | |
322 len = 0; | |
323 while (!(csa->c == ' ' || csa->c == '\n')) | |
324 { if (len == 255) | |
325 error(csa, "length of field %d exceeds 255 characters\n", | |
326 csa->fldno++); | |
327 csa->field[len++] = (char)csa->c; | |
328 read_char(csa); | |
329 } | |
330 csa->field[len] = '\0'; | |
331 /* skip anything following the last field (any extra fields | |
332 are considered to be comments) */ | |
333 if (csa->fldno == 6) | |
334 { while (csa->c == ' ') | |
335 read_char(csa); | |
336 if (csa->c != '$' && csa->c != '\n' && csa->wef < 1) | |
337 { warning(csa, "some extra field(s) detected beyond field " | |
338 "6; field(s) ignored\n"); | |
339 csa->wef++; | |
340 } | |
341 while (csa->c != '\n') | |
342 read_char(csa); | |
343 } | |
344 } | |
345 return; | |
346 } | |
347 | |
348 static void patch_name(struct csa *csa, char *name) | |
349 { /* process embedded blanks in symbolic name */ | |
350 int blank = csa->parm->blank; | |
351 if (blank == '\0') | |
352 { /* remove emedded blanks */ | |
353 strspx(name); | |
354 } | |
355 else | |
356 { /* replace embedded blanks by specified character */ | |
357 for (; *name != '\0'; name++) | |
358 if (*name == ' ') *name = (char)blank; | |
359 } | |
360 return; | |
361 } | |
362 | |
363 static double read_number(struct csa *csa) | |
364 { /* read next field and convert it to floating-point number */ | |
365 double x; | |
366 char *s; | |
367 /* read next field */ | |
368 read_field(csa); | |
369 xassert(csa->fldno == 4 || csa->fldno == 6); | |
370 if (csa->field[0] == '\0') | |
371 error(csa, "missing numeric value in field %d\n", csa->fldno); | |
372 /* skip initial spaces of the field */ | |
373 for (s = csa->field; *s == ' '; s++); | |
374 /* perform conversion */ | |
375 if (str2num(s, &x) != 0) | |
376 error(csa, "cannot convert `%s' to floating-point number\n", | |
377 s); | |
378 return x; | |
379 } | |
380 | |
381 static void skip_field(struct csa *csa) | |
382 { /* read and skip next field (assumed to be blank) */ | |
383 read_field(csa); | |
384 if (csa->field[0] != '\0') | |
385 error(csa, "field %d must be blank\n", csa->fldno); | |
386 return; | |
387 } | |
388 | |
389 static void read_name(struct csa *csa) | |
390 { /* read NAME indicator record */ | |
391 if (!(indicator(csa, 1) && strcmp(csa->field, "NAME") == 0)) | |
392 error(csa, "missing NAME indicator record\n"); | |
393 /* this indicator record looks like a data record; simulate that | |
394 fields 1 and 2 were read */ | |
395 csa->fldno = 2; | |
396 /* field 3: model name */ | |
397 read_field(csa), patch_name(csa, csa->field); | |
398 if (csa->field[0] == '\0') | |
399 warning(csa, "missing model name in field 3\n"); | |
400 else | |
401 glp_set_prob_name(csa->P, csa->field); | |
402 /* skip anything following field 3 */ | |
403 while (csa->c != '\n') | |
404 read_char(csa); | |
405 return; | |
406 } | |
407 | |
408 static void read_rows(struct csa *csa) | |
409 { /* read ROWS section */ | |
410 int i, type; | |
411 loop: if (indicator(csa, 0)) goto done; | |
412 /* field 1: row type */ | |
413 read_field(csa), strspx(csa->field); | |
414 if (strcmp(csa->field, "N") == 0) | |
415 type = GLP_FR; | |
416 else if (strcmp(csa->field, "G") == 0) | |
417 type = GLP_LO; | |
418 else if (strcmp(csa->field, "L") == 0) | |
419 type = GLP_UP; | |
420 else if (strcmp(csa->field, "E") == 0) | |
421 type = GLP_FX; | |
422 else if (csa->field[0] == '\0') | |
423 error(csa, "missing row type in field 1\n"); | |
424 else | |
425 error(csa, "invalid row type in field 1\n"); | |
426 /* field 2: row name */ | |
427 read_field(csa), patch_name(csa, csa->field); | |
428 if (csa->field[0] == '\0') | |
429 error(csa, "missing row name in field 2\n"); | |
430 if (glp_find_row(csa->P, csa->field) != 0) | |
431 error(csa, "row `%s' multiply specified\n", csa->field); | |
432 i = glp_add_rows(csa->P, 1); | |
433 glp_set_row_name(csa->P, i, csa->field); | |
434 glp_set_row_bnds(csa->P, i, type, 0.0, 0.0); | |
435 /* fields 3, 4, 5, and 6 must be blank */ | |
436 skip_field(csa); | |
437 skip_field(csa); | |
438 skip_field(csa); | |
439 skip_field(csa); | |
440 goto loop; | |
441 done: return; | |
442 } | |
443 | |
444 static void read_columns(struct csa *csa) | |
445 { /* read COLUMNS section */ | |
446 int i, j, f, len, kind = GLP_CV, *ind; | |
447 double aij, *val; | |
448 char name[255+1], *flag; | |
449 /* allocate working arrays */ | |
450 csa->work1 = ind = xcalloc(1+csa->P->m, sizeof(int)); | |
451 csa->work2 = val = xcalloc(1+csa->P->m, sizeof(double)); | |
452 csa->work3 = flag = xcalloc(1+csa->P->m, sizeof(char)); | |
453 memset(&flag[1], 0, csa->P->m); | |
454 /* no current column exists */ | |
455 j = 0, len = 0; | |
456 loop: if (indicator(csa, 0)) goto done; | |
457 /* field 1 must be blank */ | |
458 if (csa->deck) | |
459 { read_field(csa); | |
460 if (csa->field[0] != '\0') | |
461 error(csa, "field 1 must be blank\n"); | |
462 } | |
463 else | |
464 csa->fldno++; | |
465 /* field 2: column or kind name */ | |
466 read_field(csa), patch_name(csa, csa->field); | |
467 strcpy(name, csa->field); | |
468 /* field 3: row name or keyword 'MARKER' */ | |
469 read_field(csa), patch_name(csa, csa->field); | |
470 if (strcmp(csa->field, "'MARKER'") == 0) | |
471 { /* process kind data record */ | |
472 /* field 4 must be blank */ | |
473 if (csa->deck) | |
474 { read_field(csa); | |
475 if (csa->field[0] != '\0') | |
476 error(csa, "field 4 must be blank\n"); | |
477 } | |
478 else | |
479 csa->fldno++; | |
480 /* field 5: keyword 'INTORG' or 'INTEND' */ | |
481 read_field(csa), patch_name(csa, csa->field); | |
482 if (strcmp(csa->field, "'INTORG'") == 0) | |
483 kind = GLP_IV; | |
484 else if (strcmp(csa->field, "'INTEND'") == 0) | |
485 kind = GLP_CV; | |
486 else if (csa->field[0] == '\0') | |
487 error(csa, "missing keyword in field 5\n"); | |
488 else | |
489 error(csa, "invalid keyword in field 5\n"); | |
490 /* field 6 must be blank */ | |
491 skip_field(csa); | |
492 goto loop; | |
493 } | |
494 /* process column name specified in field 2 */ | |
495 if (name[0] == '\0') | |
496 { /* the same column as in previous data record */ | |
497 if (j == 0) | |
498 error(csa, "missing column name in field 2\n"); | |
499 } | |
500 else if (j != 0 && strcmp(name, csa->P->col[j]->name) == 0) | |
501 { /* the same column as in previous data record */ | |
502 xassert(j != 0); | |
503 } | |
504 else | |
505 { /* store the current column */ | |
506 if (j != 0) | |
507 { glp_set_mat_col(csa->P, j, len, ind, val); | |
508 while (len > 0) flag[ind[len--]] = 0; | |
509 } | |
510 /* create new column */ | |
511 if (glp_find_col(csa->P, name) != 0) | |
512 error(csa, "column `%s' multiply specified\n", name); | |
513 j = glp_add_cols(csa->P, 1); | |
514 glp_set_col_name(csa->P, j, name); | |
515 glp_set_col_kind(csa->P, j, kind); | |
516 if (kind == GLP_CV) | |
517 glp_set_col_bnds(csa->P, j, GLP_LO, 0.0, 0.0); | |
518 else if (kind == GLP_IV) | |
519 glp_set_col_bnds(csa->P, j, GLP_DB, 0.0, 1.0); | |
520 else | |
521 xassert(kind != kind); | |
522 } | |
523 /* process fields 3-4 and 5-6 */ | |
524 for (f = 3; f <= 5; f += 2) | |
525 { /* field 3 or 5: row name */ | |
526 if (f == 3) | |
527 { if (csa->field[0] == '\0') | |
528 error(csa, "missing row name in field 3\n"); | |
529 } | |
530 else | |
531 { read_field(csa), patch_name(csa, csa->field); | |
532 if (csa->field[0] == '\0') | |
533 { /* if field 5 is blank, field 6 also must be blank */ | |
534 skip_field(csa); | |
535 continue; | |
536 } | |
537 } | |
538 i = glp_find_row(csa->P, csa->field); | |
539 if (i == 0) | |
540 error(csa, "row `%s' not found\n", csa->field); | |
541 if (flag[i]) | |
542 error(csa, "duplicate coefficient in row `%s'\n", | |
543 csa->field); | |
544 /* field 4 or 6: coefficient value */ | |
545 aij = read_number(csa); | |
546 if (fabs(aij) < csa->parm->tol_mps) aij = 0.0; | |
547 len++, ind[len] = i, val[len] = aij, flag[i] = 1; | |
548 } | |
549 goto loop; | |
550 done: /* store the last column */ | |
551 if (j != 0) | |
552 glp_set_mat_col(csa->P, j, len, ind, val); | |
553 /* free working arrays */ | |
554 xfree(ind); | |
555 xfree(val); | |
556 xfree(flag); | |
557 csa->work1 = csa->work2 = csa->work3 = NULL; | |
558 return; | |
559 } | |
560 | |
561 static void read_rhs(struct csa *csa) | |
562 { /* read RHS section */ | |
563 int i, f, v, type; | |
564 double rhs; | |
565 char name[255+1], *flag; | |
566 /* allocate working array */ | |
567 csa->work3 = flag = xcalloc(1+csa->P->m, sizeof(char)); | |
568 memset(&flag[1], 0, csa->P->m); | |
569 /* no current RHS vector exists */ | |
570 v = 0; | |
571 loop: if (indicator(csa, 0)) goto done; | |
572 /* field 1 must be blank */ | |
573 if (csa->deck) | |
574 { read_field(csa); | |
575 if (csa->field[0] != '\0') | |
576 error(csa, "field 1 must be blank\n"); | |
577 } | |
578 else | |
579 csa->fldno++; | |
580 /* field 2: RHS vector name */ | |
581 read_field(csa), patch_name(csa, csa->field); | |
582 if (csa->field[0] == '\0') | |
583 { /* the same RHS vector as in previous data record */ | |
584 if (v == 0) | |
585 { warning(csa, "missing RHS vector name in field 2\n"); | |
586 goto blnk; | |
587 } | |
588 } | |
589 else if (v != 0 && strcmp(csa->field, name) == 0) | |
590 { /* the same RHS vector as in previous data record */ | |
591 xassert(v != 0); | |
592 } | |
593 else | |
594 blnk: { /* new RHS vector */ | |
595 if (v != 0) | |
596 error(csa, "multiple RHS vectors not supported\n"); | |
597 v++; | |
598 strcpy(name, csa->field); | |
599 } | |
600 /* process fields 3-4 and 5-6 */ | |
601 for (f = 3; f <= 5; f += 2) | |
602 { /* field 3 or 5: row name */ | |
603 read_field(csa), patch_name(csa, csa->field); | |
604 if (csa->field[0] == '\0') | |
605 { if (f == 3) | |
606 error(csa, "missing row name in field 3\n"); | |
607 else | |
608 { /* if field 5 is blank, field 6 also must be blank */ | |
609 skip_field(csa); | |
610 continue; | |
611 } | |
612 } | |
613 i = glp_find_row(csa->P, csa->field); | |
614 if (i == 0) | |
615 error(csa, "row `%s' not found\n", csa->field); | |
616 if (flag[i]) | |
617 error(csa, "duplicate right-hand side for row `%s'\n", | |
618 csa->field); | |
619 /* field 4 or 6: right-hand side value */ | |
620 rhs = read_number(csa); | |
621 if (fabs(rhs) < csa->parm->tol_mps) rhs = 0.0; | |
622 type = csa->P->row[i]->type; | |
623 if (type == GLP_FR) | |
624 { if (i == csa->obj_row) | |
625 glp_set_obj_coef(csa->P, 0, rhs); | |
626 else if (rhs != 0.0) | |
627 warning(csa, "non-zero right-hand side for free row `%s'" | |
628 " ignored\n", csa->P->row[i]->name); | |
629 } | |
630 else | |
631 glp_set_row_bnds(csa->P, i, type, rhs, rhs); | |
632 flag[i] = 1; | |
633 } | |
634 goto loop; | |
635 done: /* free working array */ | |
636 xfree(flag); | |
637 csa->work3 = NULL; | |
638 return; | |
639 } | |
640 | |
641 static void read_ranges(struct csa *csa) | |
642 { /* read RANGES section */ | |
643 int i, f, v, type; | |
644 double rhs, rng; | |
645 char name[255+1], *flag; | |
646 /* allocate working array */ | |
647 csa->work3 = flag = xcalloc(1+csa->P->m, sizeof(char)); | |
648 memset(&flag[1], 0, csa->P->m); | |
649 /* no current RANGES vector exists */ | |
650 v = 0; | |
651 loop: if (indicator(csa, 0)) goto done; | |
652 /* field 1 must be blank */ | |
653 if (csa->deck) | |
654 { read_field(csa); | |
655 if (csa->field[0] != '\0') | |
656 error(csa, "field 1 must be blank\n"); | |
657 } | |
658 else | |
659 csa->fldno++; | |
660 /* field 2: RANGES vector name */ | |
661 read_field(csa), patch_name(csa, csa->field); | |
662 if (csa->field[0] == '\0') | |
663 { /* the same RANGES vector as in previous data record */ | |
664 if (v == 0) | |
665 { warning(csa, "missing RANGES vector name in field 2\n"); | |
666 goto blnk; | |
667 } | |
668 } | |
669 else if (v != 0 && strcmp(csa->field, name) == 0) | |
670 { /* the same RANGES vector as in previous data record */ | |
671 xassert(v != 0); | |
672 } | |
673 else | |
674 blnk: { /* new RANGES vector */ | |
675 if (v != 0) | |
676 error(csa, "multiple RANGES vectors not supported\n"); | |
677 v++; | |
678 strcpy(name, csa->field); | |
679 } | |
680 /* process fields 3-4 and 5-6 */ | |
681 for (f = 3; f <= 5; f += 2) | |
682 { /* field 3 or 5: row name */ | |
683 read_field(csa), patch_name(csa, csa->field); | |
684 if (csa->field[0] == '\0') | |
685 { if (f == 3) | |
686 error(csa, "missing row name in field 3\n"); | |
687 else | |
688 { /* if field 5 is blank, field 6 also must be blank */ | |
689 skip_field(csa); | |
690 continue; | |
691 } | |
692 } | |
693 i = glp_find_row(csa->P, csa->field); | |
694 if (i == 0) | |
695 error(csa, "row `%s' not found\n", csa->field); | |
696 if (flag[i]) | |
697 error(csa, "duplicate range for row `%s'\n", csa->field); | |
698 /* field 4 or 6: range value */ | |
699 rng = read_number(csa); | |
700 if (fabs(rng) < csa->parm->tol_mps) rng = 0.0; | |
701 type = csa->P->row[i]->type; | |
702 if (type == GLP_FR) | |
703 warning(csa, "range for free row `%s' ignored\n", | |
704 csa->P->row[i]->name); | |
705 else if (type == GLP_LO) | |
706 { rhs = csa->P->row[i]->lb; | |
707 glp_set_row_bnds(csa->P, i, rhs == 0.0 ? GLP_FX : GLP_DB, | |
708 rhs, rhs + fabs(rng)); | |
709 } | |
710 else if (type == GLP_UP) | |
711 { rhs = csa->P->row[i]->ub; | |
712 glp_set_row_bnds(csa->P, i, rhs == 0.0 ? GLP_FX : GLP_DB, | |
713 rhs - fabs(rng), rhs); | |
714 } | |
715 else if (type == GLP_FX) | |
716 { rhs = csa->P->row[i]->lb; | |
717 if (rng > 0.0) | |
718 glp_set_row_bnds(csa->P, i, GLP_DB, rhs, rhs + rng); | |
719 else if (rng < 0.0) | |
720 glp_set_row_bnds(csa->P, i, GLP_DB, rhs + rng, rhs); | |
721 } | |
722 else | |
723 xassert(type != type); | |
724 flag[i] = 1; | |
725 } | |
726 goto loop; | |
727 done: /* free working array */ | |
728 xfree(flag); | |
729 csa->work3 = NULL; | |
730 return; | |
731 } | |
732 | |
733 static void read_bounds(struct csa *csa) | |
734 { /* read BOUNDS section */ | |
735 GLPCOL *col; | |
736 int j, v, mask, data; | |
737 double bnd, lb, ub; | |
738 char type[2+1], name[255+1], *flag; | |
739 /* allocate working array */ | |
740 csa->work3 = flag = xcalloc(1+csa->P->n, sizeof(char)); | |
741 memset(&flag[1], 0, csa->P->n); | |
742 /* no current BOUNDS vector exists */ | |
743 v = 0; | |
744 loop: if (indicator(csa, 0)) goto done; | |
745 /* field 1: bound type */ | |
746 read_field(csa); | |
747 if (strcmp(csa->field, "LO") == 0) | |
748 mask = 0x01, data = 1; | |
749 else if (strcmp(csa->field, "UP") == 0) | |
750 mask = 0x10, data = 1; | |
751 else if (strcmp(csa->field, "FX") == 0) | |
752 mask = 0x11, data = 1; | |
753 else if (strcmp(csa->field, "FR") == 0) | |
754 mask = 0x11, data = 0; | |
755 else if (strcmp(csa->field, "MI") == 0) | |
756 mask = 0x01, data = 0; | |
757 else if (strcmp(csa->field, "PL") == 0) | |
758 mask = 0x10, data = 0; | |
759 else if (strcmp(csa->field, "LI") == 0) | |
760 mask = 0x01, data = 1; | |
761 else if (strcmp(csa->field, "UI") == 0) | |
762 mask = 0x10, data = 1; | |
763 else if (strcmp(csa->field, "BV") == 0) | |
764 mask = 0x11, data = 0; | |
765 else if (csa->field[0] == '\0') | |
766 error(csa, "missing bound type in field 1\n"); | |
767 else | |
768 error(csa, "invalid bound type in field 1\n"); | |
769 strcpy(type, csa->field); | |
770 /* field 2: BOUNDS vector name */ | |
771 read_field(csa), patch_name(csa, csa->field); | |
772 if (csa->field[0] == '\0') | |
773 { /* the same BOUNDS vector as in previous data record */ | |
774 if (v == 0) | |
775 { warning(csa, "missing BOUNDS vector name in field 2\n"); | |
776 goto blnk; | |
777 } | |
778 } | |
779 else if (v != 0 && strcmp(csa->field, name) == 0) | |
780 { /* the same BOUNDS vector as in previous data record */ | |
781 xassert(v != 0); | |
782 } | |
783 else | |
784 blnk: { /* new BOUNDS vector */ | |
785 if (v != 0) | |
786 error(csa, "multiple BOUNDS vectors not supported\n"); | |
787 v++; | |
788 strcpy(name, csa->field); | |
789 } | |
790 /* field 3: column name */ | |
791 read_field(csa), patch_name(csa, csa->field); | |
792 if (csa->field[0] == '\0') | |
793 error(csa, "missing column name in field 3\n"); | |
794 j = glp_find_col(csa->P, csa->field); | |
795 if (j == 0) | |
796 error(csa, "column `%s' not found\n", csa->field); | |
797 if ((flag[j] & mask) == 0x01) | |
798 error(csa, "duplicate lower bound for column `%s'\n", | |
799 csa->field); | |
800 if ((flag[j] & mask) == 0x10) | |
801 error(csa, "duplicate upper bound for column `%s'\n", | |
802 csa->field); | |
803 xassert((flag[j] & mask) == 0x00); | |
804 /* field 4: bound value */ | |
805 if (data) | |
806 { bnd = read_number(csa); | |
807 if (fabs(bnd) < csa->parm->tol_mps) bnd = 0.0; | |
808 } | |
809 else | |
810 read_field(csa), bnd = 0.0; | |
811 /* get current column bounds */ | |
812 col = csa->P->col[j]; | |
813 if (col->type == GLP_FR) | |
814 lb = -DBL_MAX, ub = +DBL_MAX; | |
815 else if (col->type == GLP_LO) | |
816 lb = col->lb, ub = +DBL_MAX; | |
817 else if (col->type == GLP_UP) | |
818 lb = -DBL_MAX, ub = col->ub; | |
819 else if (col->type == GLP_DB) | |
820 lb = col->lb, ub = col->ub; | |
821 else if (col->type == GLP_FX) | |
822 lb = ub = col->lb; | |
823 else | |
824 xassert(col != col); | |
825 /* change column bounds */ | |
826 if (strcmp(type, "LO") == 0) | |
827 lb = bnd; | |
828 else if (strcmp(type, "UP") == 0) | |
829 ub = bnd; | |
830 else if (strcmp(type, "FX") == 0) | |
831 lb = ub = bnd; | |
832 else if (strcmp(type, "FR") == 0) | |
833 lb = -DBL_MAX, ub = +DBL_MAX; | |
834 else if (strcmp(type, "MI") == 0) | |
835 lb = -DBL_MAX; | |
836 else if (strcmp(type, "PL") == 0) | |
837 ub = +DBL_MAX; | |
838 else if (strcmp(type, "LI") == 0) | |
839 { glp_set_col_kind(csa->P, j, GLP_IV); | |
840 lb = ceil(bnd); | |
841 } | |
842 else if (strcmp(type, "UI") == 0) | |
843 { glp_set_col_kind(csa->P, j, GLP_IV); | |
844 ub = floor(bnd); | |
845 } | |
846 else if (strcmp(type, "BV") == 0) | |
847 { glp_set_col_kind(csa->P, j, GLP_IV); | |
848 lb = 0.0, ub = 1.0; | |
849 } | |
850 else | |
851 xassert(type != type); | |
852 /* set new column bounds */ | |
853 if (lb == -DBL_MAX && ub == +DBL_MAX) | |
854 glp_set_col_bnds(csa->P, j, GLP_FR, lb, ub); | |
855 else if (ub == +DBL_MAX) | |
856 glp_set_col_bnds(csa->P, j, GLP_LO, lb, ub); | |
857 else if (lb == -DBL_MAX) | |
858 glp_set_col_bnds(csa->P, j, GLP_UP, lb, ub); | |
859 else if (lb != ub) | |
860 glp_set_col_bnds(csa->P, j, GLP_DB, lb, ub); | |
861 else | |
862 glp_set_col_bnds(csa->P, j, GLP_FX, lb, ub); | |
863 flag[j] |= (char)mask; | |
864 /* fields 5 and 6 must be blank */ | |
865 skip_field(csa); | |
866 skip_field(csa); | |
867 goto loop; | |
868 done: /* free working array */ | |
869 xfree(flag); | |
870 csa->work3 = NULL; | |
871 return; | |
872 } | |
873 | |
874 int glp_read_mps(glp_prob *P, int fmt, const glp_mpscp *parm, | |
875 const char *fname) | |
876 { /* read problem data in MPS format */ | |
877 glp_mpscp _parm; | |
878 struct csa _csa, *csa = &_csa; | |
879 int ret; | |
880 xprintf("Reading problem data from `%s'...\n", fname); | |
881 if (!(fmt == GLP_MPS_DECK || fmt == GLP_MPS_FILE)) | |
882 xerror("glp_read_mps: fmt = %d; invalid parameter\n", fmt); | |
883 if (parm == NULL) | |
884 glp_init_mpscp(&_parm), parm = &_parm; | |
885 /* check control parameters */ | |
886 check_parm("glp_read_mps", parm); | |
887 /* initialize common storage area */ | |
888 csa->P = P; | |
889 csa->deck = (fmt == GLP_MPS_DECK); | |
890 csa->parm = parm; | |
891 csa->fname = fname; | |
892 csa->fp = NULL; | |
893 if (setjmp(csa->jump)) | |
894 { ret = 1; | |
895 goto done; | |
896 } | |
897 csa->recno = csa->recpos = 0; | |
898 csa->c = '\n'; | |
899 csa->fldno = 0; | |
900 csa->field[0] = '\0'; | |
901 csa->w80 = csa->wef = 0; | |
902 csa->obj_row = 0; | |
903 csa->work1 = csa->work2 = csa->work3 = NULL; | |
904 /* erase problem object */ | |
905 glp_erase_prob(P); | |
906 glp_create_index(P); | |
907 /* open input MPS file */ | |
908 csa->fp = xfopen(fname, "r"); | |
909 if (csa->fp == NULL) | |
910 { xprintf("Unable to open `%s' - %s\n", fname, xerrmsg()); | |
911 ret = 1; | |
912 goto done; | |
913 } | |
914 /* read NAME indicator record */ | |
915 read_name(csa); | |
916 if (P->name != NULL) | |
917 xprintf("Problem: %s\n", P->name); | |
918 /* read ROWS section */ | |
919 if (!(indicator(csa, 0) && strcmp(csa->field, "ROWS") == 0)) | |
920 error(csa, "missing ROWS indicator record\n"); | |
921 read_rows(csa); | |
922 /* determine objective row */ | |
923 if (parm->obj_name == NULL || parm->obj_name[0] == '\0') | |
924 { /* use the first row of N type */ | |
925 int i; | |
926 for (i = 1; i <= P->m; i++) | |
927 { if (P->row[i]->type == GLP_FR) | |
928 { csa->obj_row = i; | |
929 break; | |
930 } | |
931 } | |
932 if (csa->obj_row == 0) | |
933 warning(csa, "unable to determine objective row\n"); | |
934 } | |
935 else | |
936 { /* use a row with specified name */ | |
937 int i; | |
938 for (i = 1; i <= P->m; i++) | |
939 { xassert(P->row[i]->name != NULL); | |
940 if (strcmp(parm->obj_name, P->row[i]->name) == 0) | |
941 { csa->obj_row = i; | |
942 break; | |
943 } | |
944 } | |
945 if (csa->obj_row == 0) | |
946 error(csa, "objective row `%s' not found\n", | |
947 parm->obj_name); | |
948 } | |
949 if (csa->obj_row != 0) | |
950 { glp_set_obj_name(P, P->row[csa->obj_row]->name); | |
951 xprintf("Objective: %s\n", P->obj); | |
952 } | |
953 /* read COLUMNS section */ | |
954 if (strcmp(csa->field, "COLUMNS") != 0) | |
955 error(csa, "missing COLUMNS indicator record\n"); | |
956 read_columns(csa); | |
957 /* set objective coefficients */ | |
958 if (csa->obj_row != 0) | |
959 { GLPAIJ *aij; | |
960 for (aij = P->row[csa->obj_row]->ptr; aij != NULL; aij = | |
961 aij->r_next) glp_set_obj_coef(P, aij->col->j, aij->val); | |
962 } | |
963 /* read optional RHS section */ | |
964 if (strcmp(csa->field, "RHS") == 0) | |
965 read_rhs(csa); | |
966 /* read optional RANGES section */ | |
967 if (strcmp(csa->field, "RANGES") == 0) | |
968 read_ranges(csa); | |
969 /* read optional BOUNDS section */ | |
970 if (strcmp(csa->field, "BOUNDS") == 0) | |
971 read_bounds(csa); | |
972 /* read ENDATA indicator record */ | |
973 if (strcmp(csa->field, "ENDATA") != 0) | |
974 error(csa, "invalid use of %s indicator record\n", | |
975 csa->field); | |
976 /* print some statistics */ | |
977 xprintf("%d row%s, %d column%s, %d non-zero%s\n", | |
978 P->m, P->m == 1 ? "" : "s", P->n, P->n == 1 ? "" : "s", | |
979 P->nnz, P->nnz == 1 ? "" : "s"); | |
980 if (glp_get_num_int(P) > 0) | |
981 { int ni = glp_get_num_int(P); | |
982 int nb = glp_get_num_bin(P); | |
983 if (ni == 1) | |
984 { if (nb == 0) | |
985 xprintf("One variable is integer\n"); | |
986 else | |
987 xprintf("One variable is binary\n"); | |
988 } | |
989 else | |
990 { xprintf("%d integer variables, ", ni); | |
991 if (nb == 0) | |
992 xprintf("none"); | |
993 else if (nb == 1) | |
994 xprintf("one"); | |
995 else if (nb == ni) | |
996 xprintf("all"); | |
997 else | |
998 xprintf("%d", nb); | |
999 xprintf(" of which %s binary\n", nb == 1 ? "is" : "are"); | |
1000 } | |
1001 } | |
1002 xprintf("%d records were read\n", csa->recno); | |
1003 /* problem data has been successfully read */ | |
1004 glp_delete_index(P); | |
1005 glp_sort_matrix(P); | |
1006 ret = 0; | |
1007 done: if (csa->fp != NULL) xfclose(csa->fp); | |
1008 if (csa->work1 != NULL) xfree(csa->work1); | |
1009 if (csa->work2 != NULL) xfree(csa->work2); | |
1010 if (csa->work3 != NULL) xfree(csa->work3); | |
1011 if (ret != 0) glp_erase_prob(P); | |
1012 return ret; | |
1013 } | |
1014 | |
1015 /*********************************************************************** | |
1016 * NAME | |
1017 * | |
1018 * glp_write_mps - write problem data in MPS format | |
1019 * | |
1020 * SYNOPSIS | |
1021 * | |
1022 * int glp_write_mps(glp_prob *P, int fmt, const glp_mpscp *parm, | |
1023 * const char *fname); | |
1024 * | |
1025 * DESCRIPTION | |
1026 * | |
1027 * The routine glp_write_mps writes problem data in MPS format to a | |
1028 * text file. | |
1029 * | |
1030 * The parameter fmt specifies the version of MPS format: | |
1031 * | |
1032 * GLP_MPS_DECK - fixed (ancient) MPS format; | |
1033 * GLP_MPS_FILE - free (modern) MPS format. | |
1034 * | |
1035 * The parameter parm is a pointer to the structure glp_mpscp, which | |
1036 * specifies control parameters used by the routine. If parm is NULL, | |
1037 * the routine uses default settings. | |
1038 * | |
1039 * The character string fname specifies a name of the text file to be | |
1040 * written. | |
1041 * | |
1042 * RETURNS | |
1043 * | |
1044 * If the operation was successful, the routine glp_read_mps returns | |
1045 * zero. Otherwise, it prints an error message and returns non-zero. */ | |
1046 | |
1047 #define csa csa1 | |
1048 | |
1049 struct csa | |
1050 { /* common storage area */ | |
1051 glp_prob *P; | |
1052 /* pointer to problem object */ | |
1053 int deck; | |
1054 /* MPS format (0 - free, 1 - fixed) */ | |
1055 const glp_mpscp *parm; | |
1056 /* pointer to control parameters */ | |
1057 char field[255+1]; | |
1058 /* field buffer */ | |
1059 }; | |
1060 | |
1061 static char *mps_name(struct csa *csa) | |
1062 { /* make problem name */ | |
1063 char *f; | |
1064 if (csa->P->name == NULL) | |
1065 csa->field[0] = '\0'; | |
1066 else if (csa->deck) | |
1067 { strncpy(csa->field, csa->P->name, 8); | |
1068 csa->field[8] = '\0'; | |
1069 } | |
1070 else | |
1071 strcpy(csa->field, csa->P->name); | |
1072 for (f = csa->field; *f != '\0'; f++) | |
1073 if (*f == ' ') *f = '_'; | |
1074 return csa->field; | |
1075 } | |
1076 | |
1077 static char *row_name(struct csa *csa, int i) | |
1078 { /* make i-th row name */ | |
1079 char *f; | |
1080 xassert(0 <= i && i <= csa->P->m); | |
1081 if (i == 0 || csa->P->row[i]->name == NULL || | |
1082 csa->deck && strlen(csa->P->row[i]->name) > 8) | |
1083 sprintf(csa->field, "R%07d", i); | |
1084 else | |
1085 { strcpy(csa->field, csa->P->row[i]->name); | |
1086 for (f = csa->field; *f != '\0'; f++) | |
1087 if (*f == ' ') *f = '_'; | |
1088 } | |
1089 return csa->field; | |
1090 } | |
1091 | |
1092 static char *col_name(struct csa *csa, int j) | |
1093 { /* make j-th column name */ | |
1094 char *f; | |
1095 xassert(1 <= j && j <= csa->P->n); | |
1096 if (csa->P->col[j]->name == NULL || | |
1097 csa->deck && strlen(csa->P->col[j]->name) > 8) | |
1098 sprintf(csa->field, "C%07d", j); | |
1099 else | |
1100 { strcpy(csa->field, csa->P->col[j]->name); | |
1101 for (f = csa->field; *f != '\0'; f++) | |
1102 if (*f == ' ') *f = '_'; | |
1103 } | |
1104 return csa->field; | |
1105 } | |
1106 | |
1107 static char *mps_numb(struct csa *csa, double val) | |
1108 { /* format floating-point number */ | |
1109 int dig; | |
1110 char *exp; | |
1111 for (dig = 12; dig >= 6; dig--) | |
1112 { if (val != 0.0 && fabs(val) < 0.002) | |
1113 sprintf(csa->field, "%.*E", dig-1, val); | |
1114 else | |
1115 sprintf(csa->field, "%.*G", dig, val); | |
1116 exp = strchr(csa->field, 'E'); | |
1117 if (exp != NULL) | |
1118 sprintf(exp+1, "%d", atoi(exp+1)); | |
1119 if (strlen(csa->field) <= 12) break; | |
1120 } | |
1121 xassert(strlen(csa->field) <= 12); | |
1122 return csa->field; | |
1123 } | |
1124 | |
1125 int glp_write_mps(glp_prob *P, int fmt, const glp_mpscp *parm, | |
1126 const char *fname) | |
1127 { /* write problem data in MPS format */ | |
1128 glp_mpscp _parm; | |
1129 struct csa _csa, *csa = &_csa; | |
1130 XFILE *fp; | |
1131 int out_obj, one_col = 0, empty = 0; | |
1132 int i, j, recno, marker, count, gap, ret; | |
1133 xprintf("Writing problem data to `%s'...\n", fname); | |
1134 if (!(fmt == GLP_MPS_DECK || fmt == GLP_MPS_FILE)) | |
1135 xerror("glp_write_mps: fmt = %d; invalid parameter\n", fmt); | |
1136 if (parm == NULL) | |
1137 glp_init_mpscp(&_parm), parm = &_parm; | |
1138 /* check control parameters */ | |
1139 check_parm("glp_write_mps", parm); | |
1140 /* initialize common storage area */ | |
1141 csa->P = P; | |
1142 csa->deck = (fmt == GLP_MPS_DECK); | |
1143 csa->parm = parm; | |
1144 /* create output MPS file */ | |
1145 fp = xfopen(fname, "w"), recno = 0; | |
1146 if (fp == NULL) | |
1147 { xprintf("Unable to create `%s' - %s\n", fname, xerrmsg()); | |
1148 ret = 1; | |
1149 goto done; | |
1150 } | |
1151 /* write comment records */ | |
1152 xfprintf(fp, "* %-*s%s\n", P->name == NULL ? 1 : 12, "Problem:", | |
1153 P->name == NULL ? "" : P->name), recno++; | |
1154 xfprintf(fp, "* %-12s%s\n", "Class:", glp_get_num_int(P) == 0 ? | |
1155 "LP" : "MIP"), recno++; | |
1156 xfprintf(fp, "* %-12s%d\n", "Rows:", P->m), recno++; | |
1157 if (glp_get_num_int(P) == 0) | |
1158 xfprintf(fp, "* %-12s%d\n", "Columns:", P->n), recno++; | |
1159 else | |
1160 xfprintf(fp, "* %-12s%d (%d integer, %d binary)\n", | |
1161 "Columns:", P->n, glp_get_num_int(P), glp_get_num_bin(P)), | |
1162 recno++; | |
1163 xfprintf(fp, "* %-12s%d\n", "Non-zeros:", P->nnz), recno++; | |
1164 xfprintf(fp, "* %-12s%s\n", "Format:", csa->deck ? "Fixed MPS" : | |
1165 "Free MPS"), recno++; | |
1166 xfprintf(fp, "*\n", recno++); | |
1167 /* write NAME indicator record */ | |
1168 xfprintf(fp, "NAME%*s%s\n", | |
1169 P->name == NULL ? 0 : csa->deck ? 10 : 1, "", mps_name(csa)), | |
1170 recno++; | |
1171 #if 1 | |
1172 /* determine whether to write the objective row */ | |
1173 out_obj = 1; | |
1174 for (i = 1; i <= P->m; i++) | |
1175 { if (P->row[i]->type == GLP_FR) | |
1176 { out_obj = 0; | |
1177 break; | |
1178 } | |
1179 } | |
1180 #endif | |
1181 /* write ROWS section */ | |
1182 xfprintf(fp, "ROWS\n"), recno++; | |
1183 for (i = (out_obj ? 0 : 1); i <= P->m; i++) | |
1184 { int type; | |
1185 type = (i == 0 ? GLP_FR : P->row[i]->type); | |
1186 if (type == GLP_FR) | |
1187 type = 'N'; | |
1188 else if (type == GLP_LO) | |
1189 type = 'G'; | |
1190 else if (type == GLP_UP) | |
1191 type = 'L'; | |
1192 else if (type == GLP_DB || type == GLP_FX) | |
1193 type = 'E'; | |
1194 else | |
1195 xassert(type != type); | |
1196 xfprintf(fp, " %c%*s%s\n", type, csa->deck ? 2 : 1, "", | |
1197 row_name(csa, i)), recno++; | |
1198 } | |
1199 /* write COLUMNS section */ | |
1200 xfprintf(fp, "COLUMNS\n"), recno++; | |
1201 marker = 0; | |
1202 for (j = 1; j <= P->n; j++) | |
1203 { GLPAIJ cj, *aij; | |
1204 int kind; | |
1205 kind = P->col[j]->kind; | |
1206 if (kind == GLP_CV) | |
1207 { if (marker % 2 == 1) | |
1208 { /* close current integer block */ | |
1209 marker++; | |
1210 xfprintf(fp, "%*sM%07d%*s'MARKER'%*s'INTEND'\n", | |
1211 csa->deck ? 4 : 1, "", marker, csa->deck ? 2 : 1, "", | |
1212 csa->deck ? 17 : 1, ""), recno++; | |
1213 } | |
1214 } | |
1215 else if (kind == GLP_IV) | |
1216 { if (marker % 2 == 0) | |
1217 { /* open new integer block */ | |
1218 marker++; | |
1219 xfprintf(fp, "%*sM%07d%*s'MARKER'%*s'INTORG'\n", | |
1220 csa->deck ? 4 : 1, "", marker, csa->deck ? 2 : 1, "", | |
1221 csa->deck ? 17 : 1, ""), recno++; | |
1222 } | |
1223 } | |
1224 else | |
1225 xassert(kind != kind); | |
1226 if (out_obj && P->col[j]->coef != 0.0) | |
1227 { /* make fake objective coefficient */ | |
1228 aij = &cj; | |
1229 aij->row = NULL; | |
1230 aij->val = P->col[j]->coef; | |
1231 aij->c_next = P->col[j]->ptr; | |
1232 } | |
1233 else | |
1234 aij = P->col[j]->ptr; | |
1235 #if 1 /* FIXME */ | |
1236 if (aij == NULL) | |
1237 { /* empty column */ | |
1238 empty++; | |
1239 xfprintf(fp, "%*s%-*s", csa->deck ? 4 : 1, "", | |
1240 csa->deck ? 8 : 1, col_name(csa, j)); | |
1241 /* we need a row */ | |
1242 xassert(P->m > 0); | |
1243 xfprintf(fp, "%*s%-*s", | |
1244 csa->deck ? 2 : 1, "", csa->deck ? 8 : 1, | |
1245 row_name(csa, 1)); | |
1246 xfprintf(fp, "%*s0%*s$ empty column\n", | |
1247 csa->deck ? 13 : 1, "", csa->deck ? 3 : 1, ""), recno++; | |
1248 } | |
1249 #endif | |
1250 count = 0; | |
1251 for (aij = aij; aij != NULL; aij = aij->c_next) | |
1252 { if (one_col || count % 2 == 0) | |
1253 xfprintf(fp, "%*s%-*s", csa->deck ? 4 : 1, "", | |
1254 csa->deck ? 8 : 1, col_name(csa, j)); | |
1255 gap = (one_col || count % 2 == 0 ? 2 : 3); | |
1256 xfprintf(fp, "%*s%-*s", | |
1257 csa->deck ? gap : 1, "", csa->deck ? 8 : 1, | |
1258 row_name(csa, aij->row == NULL ? 0 : aij->row->i)); | |
1259 xfprintf(fp, "%*s%*s", | |
1260 csa->deck ? 2 : 1, "", csa->deck ? 12 : 1, | |
1261 mps_numb(csa, aij->val)), count++; | |
1262 if (one_col || count % 2 == 0) | |
1263 xfprintf(fp, "\n"), recno++; | |
1264 } | |
1265 if (!(one_col || count % 2 == 0)) | |
1266 xfprintf(fp, "\n"), recno++; | |
1267 } | |
1268 if (marker % 2 == 1) | |
1269 { /* close last integer block */ | |
1270 marker++; | |
1271 xfprintf(fp, "%*sM%07d%*s'MARKER'%*s'INTEND'\n", | |
1272 csa->deck ? 4 : 1, "", marker, csa->deck ? 2 : 1, "", | |
1273 csa->deck ? 17 : 1, ""), recno++; | |
1274 } | |
1275 #if 1 | |
1276 if (empty > 0) | |
1277 xprintf("Warning: problem has %d empty column(s)\n", empty); | |
1278 #endif | |
1279 /* write RHS section */ | |
1280 xfprintf(fp, "RHS\n"), recno++; | |
1281 count = 0; | |
1282 for (i = (out_obj ? 0 : 1); i <= P->m; i++) | |
1283 { int type; | |
1284 double rhs; | |
1285 if (i == 0) | |
1286 rhs = P->c0; | |
1287 else | |
1288 { type = P->row[i]->type; | |
1289 if (type == GLP_FR) | |
1290 rhs = 0.0; | |
1291 else if (type == GLP_LO) | |
1292 rhs = P->row[i]->lb; | |
1293 else if (type == GLP_UP) | |
1294 rhs = P->row[i]->ub; | |
1295 else if (type == GLP_DB || type == GLP_FX) | |
1296 rhs = P->row[i]->lb; | |
1297 else | |
1298 xassert(type != type); | |
1299 } | |
1300 if (rhs != 0.0) | |
1301 { if (one_col || count % 2 == 0) | |
1302 xfprintf(fp, "%*s%-*s", csa->deck ? 4 : 1, "", | |
1303 csa->deck ? 8 : 1, "RHS1"); | |
1304 gap = (one_col || count % 2 == 0 ? 2 : 3); | |
1305 xfprintf(fp, "%*s%-*s", | |
1306 csa->deck ? gap : 1, "", csa->deck ? 8 : 1, | |
1307 row_name(csa, i)); | |
1308 xfprintf(fp, "%*s%*s", | |
1309 csa->deck ? 2 : 1, "", csa->deck ? 12 : 1, | |
1310 mps_numb(csa, rhs)), count++; | |
1311 if (one_col || count % 2 == 0) | |
1312 xfprintf(fp, "\n"), recno++; | |
1313 } | |
1314 } | |
1315 if (!(one_col || count % 2 == 0)) | |
1316 xfprintf(fp, "\n"), recno++; | |
1317 /* write RANGES section */ | |
1318 for (i = P->m; i >= 1; i--) | |
1319 if (P->row[i]->type == GLP_DB) break; | |
1320 if (i == 0) goto bnds; | |
1321 xfprintf(fp, "RANGES\n"), recno++; | |
1322 count = 0; | |
1323 for (i = 1; i <= P->m; i++) | |
1324 { if (P->row[i]->type == GLP_DB) | |
1325 { if (one_col || count % 2 == 0) | |
1326 xfprintf(fp, "%*s%-*s", csa->deck ? 4 : 1, "", | |
1327 csa->deck ? 8 : 1, "RNG1"); | |
1328 gap = (one_col || count % 2 == 0 ? 2 : 3); | |
1329 xfprintf(fp, "%*s%-*s", | |
1330 csa->deck ? gap : 1, "", csa->deck ? 8 : 1, | |
1331 row_name(csa, i)); | |
1332 xfprintf(fp, "%*s%*s", | |
1333 csa->deck ? 2 : 1, "", csa->deck ? 12 : 1, | |
1334 mps_numb(csa, P->row[i]->ub - P->row[i]->lb)), count++; | |
1335 if (one_col || count % 2 == 0) | |
1336 xfprintf(fp, "\n"), recno++; | |
1337 } | |
1338 } | |
1339 if (!(one_col || count % 2 == 0)) | |
1340 xfprintf(fp, "\n"), recno++; | |
1341 bnds: /* write BOUNDS section */ | |
1342 for (j = P->n; j >= 1; j--) | |
1343 if (!(P->col[j]->type == GLP_LO && P->col[j]->lb == 0.0)) | |
1344 break; | |
1345 if (j == 0) goto endt; | |
1346 xfprintf(fp, "BOUNDS\n"), recno++; | |
1347 for (j = 1; j <= P->n; j++) | |
1348 { int type, data[2]; | |
1349 double bnd[2]; | |
1350 char *spec[2]; | |
1351 spec[0] = spec[1] = NULL; | |
1352 type = P->col[j]->type; | |
1353 if (type == GLP_FR) | |
1354 spec[0] = "FR", data[0] = 0; | |
1355 else if (type == GLP_LO) | |
1356 { if (P->col[j]->lb != 0.0) | |
1357 spec[0] = "LO", data[0] = 1, bnd[0] = P->col[j]->lb; | |
1358 if (P->col[j]->kind == GLP_IV) | |
1359 spec[1] = "PL", data[1] = 0; | |
1360 } | |
1361 else if (type == GLP_UP) | |
1362 { spec[0] = "MI", data[0] = 0; | |
1363 spec[1] = "UP", data[1] = 1, bnd[1] = P->col[j]->ub; | |
1364 } | |
1365 else if (type == GLP_DB) | |
1366 { if (P->col[j]->lb != 0.0) | |
1367 spec[0] = "LO", data[0] = 1, bnd[0] = P->col[j]->lb; | |
1368 spec[1] = "UP", data[1] = 1, bnd[1] = P->col[j]->ub; | |
1369 } | |
1370 else if (type == GLP_FX) | |
1371 spec[0] = "FX", data[0] = 1, bnd[0] = P->col[j]->lb; | |
1372 else | |
1373 xassert(type != type); | |
1374 for (i = 0; i <= 1; i++) | |
1375 { if (spec[i] != NULL) | |
1376 { xfprintf(fp, " %s %-*s%*s%-*s", spec[i], | |
1377 csa->deck ? 8 : 1, "BND1", csa->deck ? 2 : 1, "", | |
1378 csa->deck ? 8 : 1, col_name(csa, j)); | |
1379 if (data[i]) | |
1380 xfprintf(fp, "%*s%*s", csa->deck ? 2 : 1, "", | |
1381 csa->deck ? 12 : 1, mps_numb(csa, bnd[i])); | |
1382 xfprintf(fp, "\n"), recno++; | |
1383 } | |
1384 } | |
1385 } | |
1386 endt: /* write ENDATA indicator record */ | |
1387 xfprintf(fp, "ENDATA\n"), recno++; | |
1388 xfflush(fp); | |
1389 if (xferror(fp)) | |
1390 { xprintf("Write error on `%s' - %s\n", fname, xerrmsg()); | |
1391 ret = 1; | |
1392 goto done; | |
1393 } | |
1394 /* problem data has been successfully written */ | |
1395 xprintf("%d records were written\n", recno); | |
1396 ret = 0; | |
1397 done: if (fp != NULL) xfclose(fp); | |
1398 return ret; | |
1399 } | |
1400 | |
1401 /* eof */ |