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