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