lemon-project-template-glpk
view deps/glpk/src/glpmps.c @ 9:33de93886c88
Import GLPK 4.47
| author | Alpar Juttner <alpar@cs.elte.hu> |
|---|---|
| date | Sun, 06 Nov 2011 20:59:10 +0100 |
| parents | |
| children |
line source
1 /* glpmps.c (MPS format routines) */
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 ***********************************************************************/
25 #include "glpapi.h"
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. */
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 }
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 }
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. */
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 };
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 }
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 }
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 }
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 }
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 }
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 }
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 }
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 }
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 }
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 }
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 }
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 }
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 }
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 }
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 }
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. */
1047 #define csa csa1
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 };
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 }
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 }
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 }
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 }
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 }
1401 /* eof */