COIN-OR::LEMON - Graph Library

source: glpk-cmake/src/glpmps.c @ 1:c445c931472f

Last change on this file since 1:c445c931472f was 1:c445c931472f, checked in by Alpar Juttner <alpar@…>, 14 years ago

Import glpk-4.45

  • Generated files and doc/notes are removed
File size: 45.7 KB
Line 
1/* glpmps.c (MPS format routines) */
2
3/***********************************************************************
4*  This code is part of GLPK (GNU Linear Programming Kit).
5*
6*  Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008,
7*  2009, 2010 Andrew Makhorin, Department for Applied Informatics,
8*  Moscow Aviation Institute, Moscow, Russia. All rights reserved.
9*  E-mail: <mao@gnu.org>.
10*
11*  GLPK is free software: you can redistribute it and/or modify it
12*  under the terms of the GNU General Public License as published by
13*  the Free Software Foundation, either version 3 of the License, or
14*  (at your option) any later version.
15*
16*  GLPK is distributed in the hope that it will be useful, but WITHOUT
17*  ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
18*  or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public
19*  License for more details.
20*
21*  You should have received a copy of the GNU General Public License
22*  along with GLPK. If not, see <http://www.gnu.org/licenses/>.
23***********************************************************************/
24
25#include "glpapi.h"
26
27/***********************************************************************
28*  NAME
29*
30*  glp_init_mpscp - initialize MPS format control parameters
31*
32*  SYNOPSIS
33*
34*  void glp_init_mpscp(glp_mpscp *parm);
35*
36*  DESCRIPTION
37*
38*  The routine glp_init_mpscp initializes control parameters, which are
39*  used by the MPS input/output routines glp_read_mps and glp_write_mps,
40*  with default values.
41*
42*  Default values of the control parameters are stored in the glp_mpscp
43*  structure, which the parameter parm points to. */
44
45void glp_init_mpscp(glp_mpscp *parm)
46{     parm->blank = '\0';
47      parm->obj_name = NULL;
48      parm->tol_mps = 1e-12;
49      return;
50}
51
52static void check_parm(const char *func, const glp_mpscp *parm)
53{     /* check control parameters */
54      if (!(0x00 <= parm->blank && parm->blank <= 0xFF) ||
55          !(parm->blank == '\0' || isprint(parm->blank)))
56         xerror("%s: blank = 0x%02X; invalid parameter\n",
57            func, parm->blank);
58      if (!(parm->obj_name == NULL || strlen(parm->obj_name) <= 255))
59         xerror("%s: obj_name = \"%.12s...\"; parameter too long\n",
60            func, parm->obj_name);
61      if (!(0.0 <= parm->tol_mps && parm->tol_mps < 1.0))
62         xerror("%s: tol_mps = %g; invalid parameter\n",
63            func, parm->tol_mps);
64      return;
65}
66
67/***********************************************************************
68*  NAME
69*
70*  glp_read_mps - read problem data in MPS format
71*
72*  SYNOPSIS
73*
74*  int glp_read_mps(glp_prob *P, int fmt, const glp_mpscp *parm,
75*     const char *fname);
76*
77*  DESCRIPTION
78*
79*  The routine glp_read_mps reads problem data in MPS format from a
80*  text file.
81*
82*  The parameter fmt specifies the version of MPS format:
83*
84*  GLP_MPS_DECK - fixed (ancient) MPS format;
85*  GLP_MPS_FILE - free (modern) MPS format.
86*
87*  The parameter parm is a pointer to the structure glp_mpscp, which
88*  specifies control parameters used by the routine. If parm is NULL,
89*  the routine uses default settings.
90*
91*  The character string fname specifies a name of the text file to be
92*  read.
93*
94*  Note that before reading data the current content of the problem
95*  object is completely erased with the routine glp_erase_prob.
96*
97*  RETURNS
98*
99*  If the operation was successful, the routine glp_read_mps returns
100*  zero. Otherwise, it prints an error message and returns non-zero. */
101
102struct csa
103{     /* common storage area */
104      glp_prob *P;
105      /* pointer to problem object */
106      int deck;
107      /* MPS format (0 - free, 1 - fixed) */
108      const glp_mpscp *parm;
109      /* pointer to control parameters */
110      const char *fname;
111      /* name of input MPS file */
112      XFILE *fp;
113      /* stream assigned to input MPS file */
114      jmp_buf jump;
115      /* label for go to in case of error */
116      int recno;
117      /* current record (card) number */
118      int recpos;
119      /* current record (card) position */
120      int c;
121      /* current character */
122      int fldno;
123      /* current field number */
124      char field[255+1];
125      /* current field content */
126      int w80;
127      /* warning 'record must not be longer than 80 chars' issued */
128      int wef;
129      /* warning 'extra fields detected beyond field 6' issued */
130      int obj_row;
131      /* objective row number */
132      void *work1, *work2, *work3;
133      /* working arrays */
134};
135
136static void error(struct csa *csa, const char *fmt, ...)
137{     /* print error message and terminate processing */
138      va_list arg;
139      xprintf("%s:%d: ", csa->fname, csa->recno);
140      va_start(arg, fmt);
141      xvprintf(fmt, arg);
142      va_end(arg);
143      longjmp(csa->jump, 1);
144      /* no return */
145}
146
147static void warning(struct csa *csa, const char *fmt, ...)
148{     /* print warning message and continue processing */
149      va_list arg;
150      xprintf("%s:%d: warning: ", csa->fname, csa->recno);
151      va_start(arg, fmt);
152      xvprintf(fmt, arg);
153      va_end(arg);
154      return;
155}
156
157static 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++;
163read: 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)
188badc:       error(csa, "in fixed MPS format white-space character 0x%02"
189               "X is not allowed\n", c);
190         c = ' ';
191      }
192      else if (iscntrl(c))
193         error(csa, "invalid control character 0x%02X\n", c);
194      if (csa->deck && csa->recpos == 81 && c != '\n' && csa->w80 < 1)
195      {  warning(csa, "in fixed MPS format record must not be longer th"
196            "an 80 characters\n");
197         csa->w80++;
198      }
199      csa->c = c;
200      return;
201}
202
203static 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;
208loop: /* read the very first character of the next record */
209      xassert(csa->c == '\n');
210      read_char(csa);
211      if (csa->c == ' ' || csa->c == '\n')
212      {  /* data record */
213         ret = 0;
214      }
215      else if (csa->c == '*')
216      {  /* comment record */
217         while (csa->c != '\n')
218            read_char(csa);
219         goto loop;
220      }
221      else
222      {  /* indicator record */
223         int len = 0;
224         while (csa->c != ' ' && csa->c != '\n' && len < 12)
225         {  csa->field[len++] = (char)csa->c;
226            read_char(csa);
227         }
228         csa->field[len] = '\0';
229         if (!(strcmp(csa->field, "NAME")    == 0 ||
230               strcmp(csa->field, "ROWS")    == 0 ||
231               strcmp(csa->field, "COLUMNS") == 0 ||
232               strcmp(csa->field, "RHS")     == 0 ||
233               strcmp(csa->field, "RANGES")  == 0 ||
234               strcmp(csa->field, "BOUNDS")  == 0 ||
235               strcmp(csa->field, "ENDATA")  == 0))
236            error(csa, "invalid indicator record\n");
237         if (!name)
238         {  while (csa->c != '\n')
239               read_char(csa);
240         }
241         ret = 1;
242      }
243      return ret;
244}
245
246static void read_field(struct csa *csa)
247{     /* read next field of the current data record */
248      csa->fldno++;
249      if (csa->deck)
250      {  /* fixed MPS format */
251         int beg, end, pos;
252         /* determine predefined field positions */
253         if (csa->fldno == 1)
254            beg = 2, end = 3;
255         else if (csa->fldno == 2)
256            beg = 5, end = 12;
257         else if (csa->fldno == 3)
258            beg = 15, end = 22;
259         else if (csa->fldno == 4)
260            beg = 25, end = 36;
261         else if (csa->fldno == 5)
262            beg = 40, end = 47;
263         else if (csa->fldno == 6)
264            beg = 50, end = 61;
265         else
266            xassert(csa != csa);
267         /* skip blanks preceding the current field */
268         if (csa->c != '\n')
269         {  pos = csa->recpos;
270            while (csa->recpos < beg)
271            {  if (csa->c == ' ')
272                  ;
273               else if (csa->c == '\n')
274                  break;
275               else
276                  error(csa, "in fixed MPS format positions %d-%d must "
277                     "be blank\n", pos, beg-1);
278               read_char(csa);
279            }
280         }
281         /* skip possible comment beginning in the field 3 or 5 */
282         if ((csa->fldno == 3 || csa->fldno == 5) && csa->c == '$')
283         {  while (csa->c != '\n')
284               read_char(csa);
285         }
286         /* read the current field */
287         for (pos = beg; pos <= end; pos++)
288         {  if (csa->c == '\n') break;
289            csa->field[pos-beg] = (char)csa->c;
290            read_char(csa);
291         }
292         csa->field[pos-beg] = '\0';
293         strtrim(csa->field);
294         /* skip blanks following the last field */
295         if (csa->fldno == 6 && csa->c != '\n')
296         {  while (csa->recpos <= 72)
297            {  if (csa->c == ' ')
298                  ;
299               else if (csa->c == '\n')
300                  break;
301               else
302                  error(csa, "in fixed MPS format positions 62-72 must "
303                     "be blank\n");
304               read_char(csa);
305            }
306            while (csa->c != '\n')
307               read_char(csa);
308         }
309      }
310      else
311      {  /* free MPS format */
312         int len;
313         /* skip blanks preceding the current field */
314         while (csa->c == ' ')
315            read_char(csa);
316         /* skip possible comment */
317         if (csa->c == '$')
318         {  while (csa->c != '\n')
319               read_char(csa);
320         }
321         /* read the current field */
322         len = 0;
323         while (!(csa->c == ' ' || csa->c == '\n'))
324         {  if (len == 255)
325               error(csa, "length of field %d exceeds 255 characters\n",
326                  csa->fldno++);
327            csa->field[len++] = (char)csa->c;
328            read_char(csa);
329         }
330         csa->field[len] = '\0';
331         /* skip anything following the last field (any extra fields
332            are considered to be comments) */
333         if (csa->fldno == 6)
334         {  while (csa->c == ' ')
335               read_char(csa);
336            if (csa->c != '$' && csa->c != '\n' && csa->wef < 1)
337            {  warning(csa, "some extra field(s) detected beyond field "
338                  "6; field(s) ignored\n");
339               csa->wef++;
340            }
341            while (csa->c != '\n')
342               read_char(csa);
343         }
344      }
345      return;
346}
347
348static void patch_name(struct csa *csa, char *name)
349{     /* process embedded blanks in symbolic name */
350      int blank = csa->parm->blank;
351      if (blank == '\0')
352      {  /* remove emedded blanks */
353         strspx(name);
354      }
355      else
356      {  /* replace embedded blanks by specified character */
357         for (; *name != '\0'; name++)
358            if (*name == ' ') *name = (char)blank;
359      }
360      return;
361}
362
363static double read_number(struct csa *csa)
364{     /* read next field and convert it to floating-point number */
365      double x;
366      char *s;
367      /* read next field */
368      read_field(csa);
369      xassert(csa->fldno == 4 || csa->fldno == 6);
370      if (csa->field[0] == '\0')
371         error(csa, "missing numeric value in field %d\n", csa->fldno);
372      /* skip initial spaces of the field */
373      for (s = csa->field; *s == ' '; s++);
374      /* perform conversion */
375      if (str2num(s, &x) != 0)
376         error(csa, "cannot convert `%s' to floating-point number\n",
377            s);
378      return x;
379}
380
381static void skip_field(struct csa *csa)
382{     /* read and skip next field (assumed to be blank) */
383      read_field(csa);
384      if (csa->field[0] != '\0')
385         error(csa, "field %d must be blank\n", csa->fldno);
386      return;
387}
388
389static void read_name(struct csa *csa)
390{     /* read NAME indicator record */
391      if (!(indicator(csa, 1) && strcmp(csa->field, "NAME") == 0))
392         error(csa, "missing NAME indicator record\n");
393      /* this indicator record looks like a data record; simulate that
394         fields 1 and 2 were read */
395      csa->fldno = 2;
396      /* field 3: model name */
397      read_field(csa), patch_name(csa, csa->field);
398      if (csa->field[0] == '\0')
399         warning(csa, "missing model name in field 3\n");
400      else
401         glp_set_prob_name(csa->P, csa->field);
402      /* skip anything following field 3 */
403      while (csa->c != '\n')
404         read_char(csa);
405      return;
406}
407
408static void read_rows(struct csa *csa)
409{     /* read ROWS section */
410      int i, type;
411loop: 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;
441done: return;
442}
443
444static 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;
456loop: 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;
550done: /* store the last column */
551      if (j != 0)
552         glp_set_mat_col(csa->P, j, len, ind, val);
553      /* free working arrays */
554      xfree(ind);
555      xfree(val);
556      xfree(flag);
557      csa->work1 = csa->work2 = csa->work3 = NULL;
558      return;
559}
560
561static 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;
571loop: 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
594blnk: {  /* 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;
635done: /* free working array */
636      xfree(flag);
637      csa->work3 = NULL;
638      return;
639}
640
641static 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;
651loop: 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
674blnk: {  /* 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;
727done: /* free working array */
728      xfree(flag);
729      csa->work3 = NULL;
730      return;
731}
732
733static 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;
744loop: 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
784blnk: {  /* 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;
868done: /* free working array */
869      xfree(flag);
870      csa->work3 = NULL;
871      return;
872}
873
874int 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;
1007done: if (csa->fp != NULL) xfclose(csa->fp);
1008      if (csa->work1 != NULL) xfree(csa->work1);
1009      if (csa->work2 != NULL) xfree(csa->work2);
1010      if (csa->work3 != NULL) xfree(csa->work3);
1011      if (ret != 0) glp_erase_prob(P);
1012      return ret;
1013}
1014
1015/***********************************************************************
1016*  NAME
1017*
1018*  glp_write_mps - write problem data in MPS format
1019*
1020*  SYNOPSIS
1021*
1022*  int glp_write_mps(glp_prob *P, int fmt, const glp_mpscp *parm,
1023*     const char *fname);
1024*
1025*  DESCRIPTION
1026*
1027*  The routine glp_write_mps writes problem data in MPS format to a
1028*  text file.
1029*
1030*  The parameter fmt specifies the version of MPS format:
1031*
1032*  GLP_MPS_DECK - fixed (ancient) MPS format;
1033*  GLP_MPS_FILE - free (modern) MPS format.
1034*
1035*  The parameter parm is a pointer to the structure glp_mpscp, which
1036*  specifies control parameters used by the routine. If parm is NULL,
1037*  the routine uses default settings.
1038*
1039*  The character string fname specifies a name of the text file to be
1040*  written.
1041*
1042*  RETURNS
1043*
1044*  If the operation was successful, the routine glp_read_mps returns
1045*  zero. Otherwise, it prints an error message and returns non-zero. */
1046
1047#define csa csa1
1048
1049struct csa
1050{     /* common storage area */
1051      glp_prob *P;
1052      /* pointer to problem object */
1053      int deck;
1054      /* MPS format (0 - free, 1 - fixed) */
1055      const glp_mpscp *parm;
1056      /* pointer to control parameters */
1057      char field[255+1];
1058      /* field buffer */
1059};
1060
1061static char *mps_name(struct csa *csa)
1062{     /* make problem name */
1063      char *f;
1064      if (csa->P->name == NULL)
1065         csa->field[0] = '\0';
1066      else if (csa->deck)
1067      {  strncpy(csa->field, csa->P->name, 8);
1068         csa->field[8] = '\0';
1069      }
1070      else
1071         strcpy(csa->field, csa->P->name);
1072      for (f = csa->field; *f != '\0'; f++)
1073         if (*f == ' ') *f = '_';
1074      return csa->field;
1075}
1076
1077static char *row_name(struct csa *csa, int i)
1078{     /* make i-th row name */
1079      char *f;
1080      xassert(0 <= i && i <= csa->P->m);
1081      if (i == 0 || csa->P->row[i]->name == NULL ||
1082          csa->deck && strlen(csa->P->row[i]->name) > 8)
1083         sprintf(csa->field, "R%07d", i);
1084      else
1085      {  strcpy(csa->field, csa->P->row[i]->name);
1086         for (f = csa->field; *f != '\0'; f++)
1087            if (*f == ' ') *f = '_';
1088      }
1089      return csa->field;
1090}
1091
1092static char *col_name(struct csa *csa, int j)
1093{     /* make j-th column name */
1094      char *f;
1095      xassert(1 <= j && j <= csa->P->n);
1096      if (csa->P->col[j]->name == NULL ||
1097          csa->deck && strlen(csa->P->col[j]->name) > 8)
1098         sprintf(csa->field, "C%07d", j);
1099      else
1100      {  strcpy(csa->field, csa->P->col[j]->name);
1101         for (f = csa->field; *f != '\0'; f++)
1102            if (*f == ' ') *f = '_';
1103      }
1104      return csa->field;
1105}
1106
1107static char *mps_numb(struct csa *csa, double val)
1108{     /* format floating-point number */
1109      int dig;
1110      char *exp;
1111      for (dig = 12; dig >= 6; dig--)
1112      {  if (val != 0.0 && fabs(val) < 0.002)
1113            sprintf(csa->field, "%.*E", dig-1, val);
1114         else
1115            sprintf(csa->field, "%.*G", dig, val);
1116         exp = strchr(csa->field, 'E');
1117         if (exp != NULL)
1118            sprintf(exp+1, "%d", atoi(exp+1));
1119         if (strlen(csa->field) <= 12) break;
1120      }
1121      xassert(strlen(csa->field) <= 12);
1122      return csa->field;
1123}
1124
1125int 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++;
1341bnds: /* 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      }
1386endt: /* 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;
1397done: if (fp != NULL) xfclose(fp);
1398      return ret;
1399}
1400
1401/* eof */
Note: See TracBrowser for help on using the repository browser.