glpk-cmake: src/glpmps.c@4c8956a7bdf4

     1 /* glpmps.c (MPS format routines) */

     3 /***********************************************************************

     4 *  This code is part of GLPK (GNU Linear Programming Kit).

5 *

     6 *  Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008,

     7 *  2009, 2010 Andrew Makhorin, Department for Applied Informatics,

     8 *  Moscow Aviation Institute, Moscow, Russia. All rights reserved.

     9 *  E-mail: <mao@gnu.org>.

    10 *

    11 *  GLPK is free software: you can redistribute it and/or modify it

    12 *  under the terms of the GNU General Public License as published by

    13 *  the Free Software Foundation, either version 3 of the License, or

    14 *  (at your option) any later version.

    15 *

    16 *  GLPK is distributed in the hope that it will be useful, but WITHOUT

    17 *  ANY WARRANTY; without even the implied warranty of MERCHANTABILITY

    18 *  or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public

    19 *  License for more details.

    20 *

    21 *  You should have received a copy of the GNU General Public License

    22 *  along with GLPK. If not, see <http://www.gnu.org/licenses/>.

    23 ***********************************************************************/

    25 #include "glpapi.h"

    27 /***********************************************************************

    28 *  NAME

    29 *

    30 *  glp_init_mpscp - initialize MPS format control parameters

    31 *

    32 *  SYNOPSIS

    33 *

    34 *  void glp_init_mpscp(glp_mpscp *parm);

    35 *

    36 *  DESCRIPTION

    37 *

    38 *  The routine glp_init_mpscp initializes control parameters, which are

    39 *  used by the MPS input/output routines glp_read_mps and glp_write_mps,

    40 *  with default values.

    41 *

    42 *  Default values of the control parameters are stored in the glp_mpscp

    43 *  structure, which the parameter parm points to. */

    45 void glp_init_mpscp(glp_mpscp *parm)

    46 {     parm->blank = '\0';

    47       parm->obj_name = NULL;

    48       parm->tol_mps = 1e-12;

    49       return;

    50 }

    52 static void check_parm(const char *func, const glp_mpscp *parm)

    53 {     /* check control parameters */

    54       if (!(0x00 <= parm->blank && parm->blank <= 0xFF) ||

    55           !(parm->blank == '\0' || isprint(parm->blank)))

    56          xerror("%s: blank = 0x%02X; invalid parameter\n",

    57             func, parm->blank);

    58       if (!(parm->obj_name == NULL || strlen(parm->obj_name) <= 255))

    59          xerror("%s: obj_name = \"%.12s...\"; parameter too long\n",

    60             func, parm->obj_name);

    61       if (!(0.0 <= parm->tol_mps && parm->tol_mps < 1.0))

    62          xerror("%s: tol_mps = %g; invalid parameter\n",

    63             func, parm->tol_mps);

    64       return;

    65 }

    67 /***********************************************************************

    68 *  NAME

    69 *

    70 *  glp_read_mps - read problem data in MPS format

    71 *

    72 *  SYNOPSIS

    73 *

    74 *  int glp_read_mps(glp_prob *P, int fmt, const glp_mpscp *parm,

    75 *     const char *fname);

    76 *

    77 *  DESCRIPTION

    78 *

    79 *  The routine glp_read_mps reads problem data in MPS format from a

    80 *  text file.

    81 *

    82 *  The parameter fmt specifies the version of MPS format:

    83 *

    84 *  GLP_MPS_DECK - fixed (ancient) MPS format;

    85 *  GLP_MPS_FILE - free (modern) MPS format.

    86 *

    87 *  The parameter parm is a pointer to the structure glp_mpscp, which

    88 *  specifies control parameters used by the routine. If parm is NULL,

    89 *  the routine uses default settings.

    90 *

    91 *  The character string fname specifies a name of the text file to be

    92 *  read.

    93 *

    94 *  Note that before reading data the current content of the problem

    95 *  object is completely erased with the routine glp_erase_prob.

    96 *

    97 *  RETURNS

    98 *

    99 *  If the operation was successful, the routine glp_read_mps returns

   100 *  zero. Otherwise, it prints an error message and returns non-zero. */

   102 struct csa

   103 {     /* common storage area */

   104       glp_prob *P;

   105       /* pointer to problem object */

   106       int deck;

   107       /* MPS format (0 - free, 1 - fixed) */

   108       const glp_mpscp *parm;

   109       /* pointer to control parameters */

   110       const char *fname;

   111       /* name of input MPS file */

   112       XFILE *fp;

   113       /* stream assigned to input MPS file */

   114       jmp_buf jump;

   115       /* label for go to in case of error */

   116       int recno;

   117       /* current record (card) number */

   118       int recpos;

   119       /* current record (card) position */

   120       int c;

   121       /* current character */

   122       int fldno;

   123       /* current field number */

   124       char field[255+1];

   125       /* current field content */

   126       int w80;

   127       /* warning 'record must not be longer than 80 chars' issued */

   128       int wef;

   129       /* warning 'extra fields detected beyond field 6' issued */

   130       int obj_row;

   131       /* objective row number */

   132       void *work1, *work2, *work3;

   133       /* working arrays */

   134 };

   136 static void error(struct csa *csa, const char *fmt, ...)

   137 {     /* print error message and terminate processing */

   138       va_list arg;

   139       xprintf("%s:%d: ", csa->fname, csa->recno);

   140       va_start(arg, fmt);

   141       xvprintf(fmt, arg);

   142       va_end(arg);

   143       longjmp(csa->jump, 1);

   144       /* no return */

   145 }

   147 static void warning(struct csa *csa, const char *fmt, ...)

   148 {     /* print warning message and continue processing */

   149       va_list arg;

   150       xprintf("%s:%d: warning: ", csa->fname, csa->recno);

   151       va_start(arg, fmt);

   152       xvprintf(fmt, arg);

   153       va_end(arg);

   154       return;

   155 }

   157 static void read_char(struct csa *csa)

   158 {     /* read next character */

   159       int c;

   160       if (csa->c == '\n')

   161          csa->recno++, csa->recpos = 0;

   162       csa->recpos++;

   163 read: c = xfgetc(csa->fp);

   164       if (c < 0)

   165       {  if (xferror(csa->fp))

   166             error(csa, "read error - %s\n", xerrmsg());

   167          else if (csa->c == '\n')

   168             error(csa, "unexpected end of file\n");

   169          else

   170          {  warning(csa, "missing final end of line\n");

   171             c = '\n';

   172          }

   173       }

   174       else if (c == '\n')

   175          ;

   176       else if (csa->c == '\r')

   177       {  c = '\r';

   178          goto badc;

   179       }

   180       else if (csa->deck && c == '\r')

   181       {  csa->c = '\r';

   182          goto read;

   183       }

   184       else if (c == ' ')

   185          ;

   186       else if (isspace(c))

   187       {  if (csa->deck)

   188 badc:       error(csa, "in fixed MPS format white-space character 0x%02"

   189                "X is not allowed\n", c);

   190          c = ' ';

   191       }

   192       else if (iscntrl(c))

   193          error(csa, "invalid control character 0x%02X\n", c);

   194       if (csa->deck && csa->recpos == 81 && c != '\n' && csa->w80 < 1)

   195       {  warning(csa, "in fixed MPS format record must not be longer th"

   196             "an 80 characters\n");

   197          csa->w80++;

   198       }

   199       csa->c = c;

   200       return;

   201 }

   203 static int indicator(struct csa *csa, int name)

   204 {     /* skip comment records and read possible indicator record */

   205       int ret;

   206       /* reset current field number */

   207       csa->fldno = 0;

   208 loop: /* read the very first character of the next record */

   209       xassert(csa->c == '\n');

   210       read_char(csa);

   211       if (csa->c == ' ' || csa->c == '\n')

   212       {  /* data record */

   213          ret = 0;

   214       }

   215       else if (csa->c == '*')

   216       {  /* comment record */

   217          while (csa->c != '\n')

   218             read_char(csa);

   219          goto loop;

   220       }

   221       else

   222       {  /* indicator record */

   223          int len = 0;

   224          while (csa->c != ' ' && csa->c != '\n' && len < 12)

   225          {  csa->field[len++] = (char)csa->c;

   226             read_char(csa);

   227          }

   228          csa->field[len] = '\0';

   229          if (!(strcmp(csa->field, "NAME")    == 0 ||

   230                strcmp(csa->field, "ROWS")    == 0 ||

   231                strcmp(csa->field, "COLUMNS") == 0 ||

   232                strcmp(csa->field, "RHS")     == 0 ||

   233                strcmp(csa->field, "RANGES")  == 0 ||

   234                strcmp(csa->field, "BOUNDS")  == 0 ||

   235                strcmp(csa->field, "ENDATA")  == 0))

   236             error(csa, "invalid indicator record\n");

   237          if (!name)

   238          {  while (csa->c != '\n')

   239                read_char(csa);

   240          }

   241          ret = 1;

   242       }

   243       return ret;

   244 }

   246 static void read_field(struct csa *csa)

   247 {     /* read next field of the current data record */

   248       csa->fldno++;

   249       if (csa->deck)

   250       {  /* fixed MPS format */

   251          int beg, end, pos;

   252          /* determine predefined field positions */

   253          if (csa->fldno == 1)

   254             beg = 2, end = 3;

   255          else if (csa->fldno == 2)

   256             beg = 5, end = 12;

   257          else if (csa->fldno == 3)

   258             beg = 15, end = 22;

   259          else if (csa->fldno == 4)

   260             beg = 25, end = 36;

   261          else if (csa->fldno == 5)

   262             beg = 40, end = 47;

   263          else if (csa->fldno == 6)

   264             beg = 50, end = 61;

   265          else

   266             xassert(csa != csa);

   267          /* skip blanks preceding the current field */

   268          if (csa->c != '\n')

   269          {  pos = csa->recpos;

   270             while (csa->recpos < beg)

   271             {  if (csa->c == ' ')

   272                   ;

   273                else if (csa->c == '\n')

   274                   break;

   275                else

   276                   error(csa, "in fixed MPS format positions %d-%d must "

   277                      "be blank\n", pos, beg-1);

   278                read_char(csa);

   279             }

   280          }

   281          /* skip possible comment beginning in the field 3 or 5 */

   282          if ((csa->fldno == 3 || csa->fldno == 5) && csa->c == '$')

   283          {  while (csa->c != '\n')

   284                read_char(csa);

   285          }

   286          /* read the current field */

   287          for (pos = beg; pos <= end; pos++)

   288          {  if (csa->c == '\n') break;

   289             csa->field[pos-beg] = (char)csa->c;

   290             read_char(csa);

   291          }

   292          csa->field[pos-beg] = '\0';

   293          strtrim(csa->field);

   294          /* skip blanks following the last field */

   295          if (csa->fldno == 6 && csa->c != '\n')

   296          {  while (csa->recpos <= 72)

   297             {  if (csa->c == ' ')

   298                   ;

   299                else if (csa->c == '\n')

   300                   break;

   301                else

   302                   error(csa, "in fixed MPS format positions 62-72 must "

   303                      "be blank\n");

   304                read_char(csa);

   305             }

   306             while (csa->c != '\n')

   307                read_char(csa);

   308          }

   309       }

   310       else

   311       {  /* free MPS format */

   312          int len;

   313          /* skip blanks preceding the current field */

   314          while (csa->c == ' ')

   315             read_char(csa);

   316          /* skip possible comment */

   317          if (csa->c == '$')

   318          {  while (csa->c != '\n')

   319                read_char(csa);

   320          }

   321          /* read the current field */

   322          len = 0;

   323          while (!(csa->c == ' ' || csa->c == '\n'))

   324          {  if (len == 255)

   325                error(csa, "length of field %d exceeds 255 characters\n",

   326                   csa->fldno++);

   327             csa->field[len++] = (char)csa->c;

   328             read_char(csa);

   329          }

   330          csa->field[len] = '\0';

   331          /* skip anything following the last field (any extra fields

   332             are considered to be comments) */

   333          if (csa->fldno == 6)

   334          {  while (csa->c == ' ')

   335                read_char(csa);

   336             if (csa->c != '$' && csa->c != '\n' && csa->wef < 1)

   337             {  warning(csa, "some extra field(s) detected beyond field "

   338                   "6; field(s) ignored\n");

   339                csa->wef++;

   340             }

   341             while (csa->c != '\n')

   342                read_char(csa);

   343          }

   344       }

   345       return;

   346 }

   348 static void patch_name(struct csa *csa, char *name)

   349 {     /* process embedded blanks in symbolic name */

   350       int blank = csa->parm->blank;

   351       if (blank == '\0')

   352       {  /* remove emedded blanks */

   353          strspx(name);

   354       }

   355       else

   356       {  /* replace embedded blanks by specified character */

   357          for (; *name != '\0'; name++)

   358             if (*name == ' ') *name = (char)blank;

   359       }

   360       return;

   361 }

   363 static double read_number(struct csa *csa)

   364 {     /* read next field and convert it to floating-point number */

   365       double x;

   366       char *s;

   367       /* read next field */

   368       read_field(csa);

   369       xassert(csa->fldno == 4 || csa->fldno == 6);

   370       if (csa->field[0] == '\0')

   371          error(csa, "missing numeric value in field %d\n", csa->fldno);

   372       /* skip initial spaces of the field */

   373       for (s = csa->field; *s == ' '; s++);

   374       /* perform conversion */

   375       if (str2num(s, &x) != 0)

   376          error(csa, "cannot convert `%s' to floating-point number\n",

   377             s);

   378       return x;

   379 }

   381 static void skip_field(struct csa *csa)

   382 {     /* read and skip next field (assumed to be blank) */

   383       read_field(csa);

   384       if (csa->field[0] != '\0')

   385          error(csa, "field %d must be blank\n", csa->fldno);

   386       return;

   387 }

   389 static void read_name(struct csa *csa)

   390 {     /* read NAME indicator record */

   391       if (!(indicator(csa, 1) && strcmp(csa->field, "NAME") == 0))

   392          error(csa, "missing NAME indicator record\n");

   393       /* this indicator record looks like a data record; simulate that

   394          fields 1 and 2 were read */

   395       csa->fldno = 2;

   396       /* field 3: model name */

   397       read_field(csa), patch_name(csa, csa->field);

   398       if (csa->field[0] == '\0')

   399          warning(csa, "missing model name in field 3\n");

   400       else

   401          glp_set_prob_name(csa->P, csa->field);

   402       /* skip anything following field 3 */

   403       while (csa->c != '\n')

   404          read_char(csa);

   405       return;

   406 }

   408 static void read_rows(struct csa *csa)

   409 {     /* read ROWS section */

   410       int i, type;

   411 loop: if (indicator(csa, 0)) goto done;

   412       /* field 1: row type */

   413       read_field(csa), strspx(csa->field);

   414       if (strcmp(csa->field, "N") == 0)

   415          type = GLP_FR;

   416       else if (strcmp(csa->field, "G") == 0)

   417          type = GLP_LO;

   418       else if (strcmp(csa->field, "L") == 0)

   419          type = GLP_UP;

   420       else if (strcmp(csa->field, "E") == 0)

   421          type = GLP_FX;

   422       else if (csa->field[0] == '\0')

   423          error(csa, "missing row type in field 1\n");

   424       else

   425          error(csa, "invalid row type in field 1\n");

   426       /* field 2: row name */

   427       read_field(csa), patch_name(csa, csa->field);

   428       if (csa->field[0] == '\0')

   429          error(csa, "missing row name in field 2\n");

   430       if (glp_find_row(csa->P, csa->field) != 0)

   431          error(csa, "row `%s' multiply specified\n", csa->field);

   432       i = glp_add_rows(csa->P, 1);

   433       glp_set_row_name(csa->P, i, csa->field);

   434       glp_set_row_bnds(csa->P, i, type, 0.0, 0.0);

   435       /* fields 3, 4, 5, and 6 must be blank */

   436       skip_field(csa);

   437       skip_field(csa);

   438       skip_field(csa);

   439       skip_field(csa);

   440       goto loop;

   441 done: return;

   442 }

   444 static void read_columns(struct csa *csa)

   445 {     /* read COLUMNS section */

   446       int i, j, f, len, kind = GLP_CV, *ind;

   447       double aij, *val;

   448       char name[255+1], *flag;

   449       /* allocate working arrays */

   450       csa->work1 = ind = xcalloc(1+csa->P->m, sizeof(int));

   451       csa->work2 = val = xcalloc(1+csa->P->m, sizeof(double));

   452       csa->work3 = flag = xcalloc(1+csa->P->m, sizeof(char));

   453       memset(&flag[1], 0, csa->P->m);

   454       /* no current column exists */

   455       j = 0, len = 0;

   456 loop: if (indicator(csa, 0)) goto done;

   457       /* field 1 must be blank */

   458       if (csa->deck)

   459       {  read_field(csa);

   460          if (csa->field[0] != '\0')

   461             error(csa, "field 1 must be blank\n");

   462       }

   463       else

   464          csa->fldno++;

   465       /* field 2: column or kind name */

   466       read_field(csa), patch_name(csa, csa->field);

   467       strcpy(name, csa->field);

   468       /* field 3: row name or keyword 'MARKER' */

   469       read_field(csa), patch_name(csa, csa->field);

   470       if (strcmp(csa->field, "'MARKER'") == 0)

   471       {  /* process kind data record */

   472          /* field 4 must be blank */

   473          if (csa->deck)

   474          {  read_field(csa);

   475             if (csa->field[0] != '\0')

   476                error(csa, "field 4 must be blank\n");

   477          }

   478          else

   479             csa->fldno++;

   480          /* field 5: keyword 'INTORG' or 'INTEND' */

   481          read_field(csa), patch_name(csa, csa->field);

   482          if (strcmp(csa->field, "'INTORG'") == 0)

   483             kind = GLP_IV;

   484          else if (strcmp(csa->field, "'INTEND'") == 0)

   485             kind = GLP_CV;

   486          else if (csa->field[0] == '\0')

   487             error(csa, "missing keyword in field 5\n");

   488          else

   489             error(csa, "invalid keyword in field 5\n");

   490          /* field 6 must be blank */

   491          skip_field(csa);

   492          goto loop;

   493       }

   494       /* process column name specified in field 2 */

   495       if (name[0] == '\0')

   496       {  /* the same column as in previous data record */

   497          if (j == 0)

   498             error(csa, "missing column name in field 2\n");

   499       }

   500       else if (j != 0 && strcmp(name, csa->P->col[j]->name) == 0)

   501       {  /* the same column as in previous data record */

   502          xassert(j != 0);

   503       }

   504       else

   505       {  /* store the current column */

   506          if (j != 0)

   507          {  glp_set_mat_col(csa->P, j, len, ind, val);

   508             while (len > 0) flag[ind[len--]] = 0;

   509          }

   510          /* create new column */

   511          if (glp_find_col(csa->P, name) != 0)

   512             error(csa, "column `%s' multiply specified\n", name);

   513          j = glp_add_cols(csa->P, 1);

   514          glp_set_col_name(csa->P, j, name);

   515          glp_set_col_kind(csa->P, j, kind);

   516          if (kind == GLP_CV)

   517             glp_set_col_bnds(csa->P, j, GLP_LO, 0.0, 0.0);

   518          else if (kind == GLP_IV)

   519             glp_set_col_bnds(csa->P, j, GLP_DB, 0.0, 1.0);

   520          else

   521             xassert(kind != kind);

   522       }

   523       /* process fields 3-4 and 5-6 */

   524       for (f = 3; f <= 5; f += 2)

   525       {  /* field 3 or 5: row name */

   526          if (f == 3)

   527          {  if (csa->field[0] == '\0')

   528                error(csa, "missing row name in field 3\n");

   529          }

   530          else

   531          {  read_field(csa), patch_name(csa, csa->field);

   532             if (csa->field[0] == '\0')

   533             {  /* if field 5 is blank, field 6 also must be blank */

   534                skip_field(csa);

   535                continue;

   536             }

   537          }

   538          i = glp_find_row(csa->P, csa->field);

   539          if (i == 0)

   540             error(csa, "row `%s' not found\n", csa->field);

   541          if (flag[i])

   542             error(csa, "duplicate coefficient in row `%s'\n",

   543                csa->field);

   544          /* field 4 or 6: coefficient value */

   545          aij = read_number(csa);

   546          if (fabs(aij) < csa->parm->tol_mps) aij = 0.0;

   547          len++, ind[len] = i, val[len] = aij, flag[i] = 1;

   548       }

   549       goto loop;

   550 done: /* store the last column */

   551       if (j != 0)

   552          glp_set_mat_col(csa->P, j, len, ind, val);

   553       /* free working arrays */

   554       xfree(ind);

   555       xfree(val);

   556       xfree(flag);

   557       csa->work1 = csa->work2 = csa->work3 = NULL;

   558       return;

   559 }

   561 static void read_rhs(struct csa *csa)

   562 {     /* read RHS section */

   563       int i, f, v, type;

   564       double rhs;

   565       char name[255+1], *flag;

   566       /* allocate working array */

   567       csa->work3 = flag = xcalloc(1+csa->P->m, sizeof(char));

   568       memset(&flag[1], 0, csa->P->m);

   569       /* no current RHS vector exists */

   570       v = 0;

   571 loop: if (indicator(csa, 0)) goto done;

   572       /* field 1 must be blank */

   573       if (csa->deck)

   574       {  read_field(csa);

   575          if (csa->field[0] != '\0')

   576             error(csa, "field 1 must be blank\n");

   577       }

   578       else

   579          csa->fldno++;

   580       /* field 2: RHS vector name */

   581       read_field(csa), patch_name(csa, csa->field);

   582       if (csa->field[0] == '\0')

   583       {  /* the same RHS vector as in previous data record */

   584          if (v == 0)

   585          {  warning(csa, "missing RHS vector name in field 2\n");

   586             goto blnk;

   587          }

   588       }

   589       else if (v != 0 && strcmp(csa->field, name) == 0)

   590       {  /* the same RHS vector as in previous data record */

   591          xassert(v != 0);

   592       }

   593       else

   594 blnk: {  /* new RHS vector */

   595          if (v != 0)

   596             error(csa, "multiple RHS vectors not supported\n");

   597          v++;

   598          strcpy(name, csa->field);

   599       }

   600       /* process fields 3-4 and 5-6 */

   601       for (f = 3; f <= 5; f += 2)

   602       {  /* field 3 or 5: row name */

   603          read_field(csa), patch_name(csa, csa->field);

   604          if (csa->field[0] == '\0')

   605          {  if (f == 3)

   606                error(csa, "missing row name in field 3\n");

   607             else

   608             {  /* if field 5 is blank, field 6 also must be blank */

   609                skip_field(csa);

   610                continue;

   611             }

   612          }

   613          i = glp_find_row(csa->P, csa->field);

   614          if (i == 0)

   615             error(csa, "row `%s' not found\n", csa->field);

   616          if (flag[i])

   617             error(csa, "duplicate right-hand side for row `%s'\n",

   618                csa->field);

   619          /* field 4 or 6: right-hand side value */

   620          rhs = read_number(csa);

   621          if (fabs(rhs) < csa->parm->tol_mps) rhs = 0.0;

   622          type = csa->P->row[i]->type;

   623          if (type == GLP_FR)

   624          {  if (i == csa->obj_row)

   625                glp_set_obj_coef(csa->P, 0, rhs);

   626             else if (rhs != 0.0)

   627                warning(csa, "non-zero right-hand side for free row `%s'"

   628                   " ignored\n", csa->P->row[i]->name);

   629          }

   630          else

   631             glp_set_row_bnds(csa->P, i, type, rhs, rhs);

   632          flag[i] = 1;

   633       }

   634       goto loop;

   635 done: /* free working array */

   636       xfree(flag);

   637       csa->work3 = NULL;

   638       return;

   639 }

   641 static void read_ranges(struct csa *csa)

   642 {     /* read RANGES section */

   643       int i, f, v, type;

   644       double rhs, rng;

   645       char name[255+1], *flag;

   646       /* allocate working array */

   647       csa->work3 = flag = xcalloc(1+csa->P->m, sizeof(char));

   648       memset(&flag[1], 0, csa->P->m);

   649       /* no current RANGES vector exists */

   650       v = 0;

   651 loop: if (indicator(csa, 0)) goto done;

   652       /* field 1 must be blank */

   653       if (csa->deck)

   654       {  read_field(csa);

   655          if (csa->field[0] != '\0')

   656             error(csa, "field 1 must be blank\n");

   657       }

   658       else

   659          csa->fldno++;

   660       /* field 2: RANGES vector name */

   661       read_field(csa), patch_name(csa, csa->field);

   662       if (csa->field[0] == '\0')

   663       {  /* the same RANGES vector as in previous data record */

   664          if (v == 0)

   665          {  warning(csa, "missing RANGES vector name in field 2\n");

   666             goto blnk;

   667          }

   668       }

   669       else if (v != 0 && strcmp(csa->field, name) == 0)

   670       {  /* the same RANGES vector as in previous data record */

   671          xassert(v != 0);

   672       }

   673       else

   674 blnk: {  /* new RANGES vector */

   675          if (v != 0)

   676             error(csa, "multiple RANGES vectors not supported\n");

   677          v++;

   678          strcpy(name, csa->field);

   679       }

   680       /* process fields 3-4 and 5-6 */

   681       for (f = 3; f <= 5; f += 2)

   682       {  /* field 3 or 5: row name */

   683          read_field(csa), patch_name(csa, csa->field);

   684          if (csa->field[0] == '\0')

   685          {  if (f == 3)

   686                error(csa, "missing row name in field 3\n");

   687             else

   688             {  /* if field 5 is blank, field 6 also must be blank */

   689                skip_field(csa);

   690                continue;

   691             }

   692          }

   693          i = glp_find_row(csa->P, csa->field);

   694          if (i == 0)

   695             error(csa, "row `%s' not found\n", csa->field);

   696          if (flag[i])

   697             error(csa, "duplicate range for row `%s'\n", csa->field);

   698          /* field 4 or 6: range value */

   699          rng = read_number(csa);

   700          if (fabs(rng) < csa->parm->tol_mps) rng = 0.0;

   701          type = csa->P->row[i]->type;

   702          if (type == GLP_FR)

   703             warning(csa, "range for free row `%s' ignored\n",

   704                csa->P->row[i]->name);

   705          else if (type == GLP_LO)

   706          {  rhs = csa->P->row[i]->lb;

   707             glp_set_row_bnds(csa->P, i, rhs == 0.0 ? GLP_FX : GLP_DB,

   708                rhs, rhs + fabs(rng));

   709          }

   710          else if (type == GLP_UP)

   711          {  rhs = csa->P->row[i]->ub;

   712             glp_set_row_bnds(csa->P, i, rhs == 0.0 ? GLP_FX : GLP_DB,

   713                rhs - fabs(rng), rhs);

   714          }

   715          else if (type == GLP_FX)

   716          {  rhs = csa->P->row[i]->lb;

   717             if (rng > 0.0)

   718                glp_set_row_bnds(csa->P, i, GLP_DB, rhs, rhs + rng);

   719             else if (rng < 0.0)

   720                glp_set_row_bnds(csa->P, i, GLP_DB, rhs + rng, rhs);

   721          }

   722          else

   723             xassert(type != type);

   724          flag[i] = 1;

   725       }

   726       goto loop;

   727 done: /* free working array */

   728       xfree(flag);

   729       csa->work3 = NULL;

   730       return;

   731 }

   733 static void read_bounds(struct csa *csa)

   734 {     /* read BOUNDS section */

   735       GLPCOL *col;

   736       int j, v, mask, data;

   737       double bnd, lb, ub;

   738       char type[2+1], name[255+1], *flag;

   739       /* allocate working array */

   740       csa->work3 = flag = xcalloc(1+csa->P->n, sizeof(char));

   741       memset(&flag[1], 0, csa->P->n);

   742       /* no current BOUNDS vector exists */

   743       v = 0;

   744 loop: if (indicator(csa, 0)) goto done;

   745       /* field 1: bound type */

   746       read_field(csa);

   747       if (strcmp(csa->field, "LO") == 0)

   748          mask = 0x01, data = 1;

   749       else if (strcmp(csa->field, "UP") == 0)

   750          mask = 0x10, data = 1;

   751       else if (strcmp(csa->field, "FX") == 0)

   752          mask = 0x11, data = 1;

   753       else if (strcmp(csa->field, "FR") == 0)

   754          mask = 0x11, data = 0;

   755       else if (strcmp(csa->field, "MI") == 0)

   756          mask = 0x01, data = 0;

   757       else if (strcmp(csa->field, "PL") == 0)

   758          mask = 0x10, data = 0;

   759       else if (strcmp(csa->field, "LI") == 0)

   760          mask = 0x01, data = 1;

   761       else if (strcmp(csa->field, "UI") == 0)

   762          mask = 0x10, data = 1;

   763       else if (strcmp(csa->field, "BV") == 0)

   764          mask = 0x11, data = 0;

   765       else if (csa->field[0] == '\0')

   766          error(csa, "missing bound type in field 1\n");

   767       else

   768          error(csa, "invalid bound type in field 1\n");

   769       strcpy(type, csa->field);

   770       /* field 2: BOUNDS vector name */

   771       read_field(csa), patch_name(csa, csa->field);

   772       if (csa->field[0] == '\0')

   773       {  /* the same BOUNDS vector as in previous data record */

   774          if (v == 0)

   775          {  warning(csa, "missing BOUNDS vector name in field 2\n");

   776             goto blnk;

   777          }

   778       }

   779       else if (v != 0 && strcmp(csa->field, name) == 0)

   780       {  /* the same BOUNDS vector as in previous data record */

   781          xassert(v != 0);

   782       }

   783       else

   784 blnk: {  /* new BOUNDS vector */

   785          if (v != 0)

   786             error(csa, "multiple BOUNDS vectors not supported\n");

   787          v++;

   788          strcpy(name, csa->field);

   789       }

   790       /* field 3: column name */

   791       read_field(csa), patch_name(csa, csa->field);

   792       if (csa->field[0] == '\0')

   793          error(csa, "missing column name in field 3\n");

   794       j = glp_find_col(csa->P, csa->field);

   795       if (j == 0)

   796          error(csa, "column `%s' not found\n", csa->field);

   797       if ((flag[j] & mask) == 0x01)

   798          error(csa, "duplicate lower bound for column `%s'\n",

   799             csa->field);

   800       if ((flag[j] & mask) == 0x10)

   801          error(csa, "duplicate upper bound for column `%s'\n",

   802             csa->field);

   803       xassert((flag[j] & mask) == 0x00);

   804       /* field 4: bound value */

   805       if (data)

   806       {  bnd = read_number(csa);

   807          if (fabs(bnd) < csa->parm->tol_mps) bnd = 0.0;

   808       }

   809       else

   810          read_field(csa), bnd = 0.0;

   811       /* get current column bounds */

   812       col = csa->P->col[j];

   813       if (col->type == GLP_FR)

   814          lb = -DBL_MAX, ub = +DBL_MAX;

   815       else if (col->type == GLP_LO)

   816          lb = col->lb, ub = +DBL_MAX;

   817       else if (col->type == GLP_UP)

   818          lb = -DBL_MAX, ub = col->ub;

   819       else if (col->type == GLP_DB)

   820          lb = col->lb, ub = col->ub;

   821       else if (col->type == GLP_FX)

   822          lb = ub = col->lb;

   823       else

   824          xassert(col != col);

   825       /* change column bounds */

   826       if (strcmp(type, "LO") == 0)

   827          lb = bnd;

   828       else if (strcmp(type, "UP") == 0)

   829          ub = bnd;

   830       else if (strcmp(type, "FX") == 0)

   831          lb = ub = bnd;

   832       else if (strcmp(type, "FR") == 0)

   833          lb = -DBL_MAX, ub = +DBL_MAX;

   834       else if (strcmp(type, "MI") == 0)

   835          lb = -DBL_MAX;

   836       else if (strcmp(type, "PL") == 0)

   837          ub = +DBL_MAX;

   838       else if (strcmp(type, "LI") == 0)

   839       {  glp_set_col_kind(csa->P, j, GLP_IV);

   840          lb = ceil(bnd);

   841       }

   842       else if (strcmp(type, "UI") == 0)

   843       {  glp_set_col_kind(csa->P, j, GLP_IV);

   844          ub = floor(bnd);

   845       }

   846       else if (strcmp(type, "BV") == 0)

   847       {  glp_set_col_kind(csa->P, j, GLP_IV);

   848          lb = 0.0, ub = 1.0;

   849       }

   850       else

   851          xassert(type != type);

   852       /* set new column bounds */

   853       if (lb == -DBL_MAX && ub == +DBL_MAX)

   854          glp_set_col_bnds(csa->P, j, GLP_FR, lb, ub);

   855       else if (ub == +DBL_MAX)

   856          glp_set_col_bnds(csa->P, j, GLP_LO, lb, ub);

   857       else if (lb == -DBL_MAX)

   858          glp_set_col_bnds(csa->P, j, GLP_UP, lb, ub);

   859       else if (lb != ub)

   860          glp_set_col_bnds(csa->P, j, GLP_DB, lb, ub);

   861       else

   862          glp_set_col_bnds(csa->P, j, GLP_FX, lb, ub);

   863       flag[j] |= (char)mask;

   864       /* fields 5 and 6 must be blank */

   865       skip_field(csa);

   866       skip_field(csa);

   867       goto loop;

   868 done: /* free working array */

   869       xfree(flag);

   870       csa->work3 = NULL;

   871       return;

   872 }

   874 int glp_read_mps(glp_prob *P, int fmt, const glp_mpscp *parm,

   875       const char *fname)

   876 {     /* read problem data in MPS format */

   877       glp_mpscp _parm;

   878       struct csa _csa, *csa = &_csa;

   879       int ret;

   880       xprintf("Reading problem data from `%s'...\n", fname);

   881       if (!(fmt == GLP_MPS_DECK || fmt == GLP_MPS_FILE))

   882          xerror("glp_read_mps: fmt = %d; invalid parameter\n", fmt);

   883       if (parm == NULL)

   884          glp_init_mpscp(&_parm), parm = &_parm;

   885       /* check control parameters */

   886       check_parm("glp_read_mps", parm);

   887       /* initialize common storage area */

   888       csa->P = P;

   889       csa->deck = (fmt == GLP_MPS_DECK);

   890       csa->parm = parm;

   891       csa->fname = fname;

   892       csa->fp = NULL;

   893       if (setjmp(csa->jump))

   894       {  ret = 1;

   895          goto done;

   896       }

   897       csa->recno = csa->recpos = 0;

   898       csa->c = '\n';

   899       csa->fldno = 0;

   900       csa->field[0] = '\0';

   901       csa->w80 = csa->wef = 0;

   902       csa->obj_row = 0;

   903       csa->work1 = csa->work2 = csa->work3 = NULL;

   904       /* erase problem object */

   905       glp_erase_prob(P);

   906       glp_create_index(P);

   907       /* open input MPS file */

   908       csa->fp = xfopen(fname, "r");

   909       if (csa->fp == NULL)

   910       {  xprintf("Unable to open `%s' - %s\n", fname, xerrmsg());

   911          ret = 1;

   912          goto done;

   913       }

   914       /* read NAME indicator record */

   915       read_name(csa);

   916       if (P->name != NULL)

   917          xprintf("Problem: %s\n", P->name);

   918       /* read ROWS section */

   919       if (!(indicator(csa, 0) && strcmp(csa->field, "ROWS") == 0))

   920          error(csa, "missing ROWS indicator record\n");

   921       read_rows(csa);

   922       /* determine objective row */

   923       if (parm->obj_name == NULL || parm->obj_name[0] == '\0')

   924       {  /* use the first row of N type */

   925          int i;

   926          for (i = 1; i <= P->m; i++)

   927          {  if (P->row[i]->type == GLP_FR)

   928             {  csa->obj_row = i;

   929                break;

   930             }

   931          }

   932          if (csa->obj_row == 0)

   933             warning(csa, "unable to determine objective row\n");

   934       }

   935       else

   936       {  /* use a row with specified name */

   937          int i;

   938          for (i = 1; i <= P->m; i++)

   939          {  xassert(P->row[i]->name != NULL);

   940             if (strcmp(parm->obj_name, P->row[i]->name) == 0)

   941             {  csa->obj_row = i;

   942                break;

   943             }

   944          }

   945          if (csa->obj_row == 0)

   946             error(csa, "objective row `%s' not found\n",

   947                parm->obj_name);

   948       }

   949       if (csa->obj_row != 0)

   950       {  glp_set_obj_name(P, P->row[csa->obj_row]->name);

   951          xprintf("Objective: %s\n", P->obj);

   952       }

   953       /* read COLUMNS section */

   954       if (strcmp(csa->field, "COLUMNS") != 0)

   955          error(csa, "missing COLUMNS indicator record\n");

   956       read_columns(csa);

   957       /* set objective coefficients */

   958       if (csa->obj_row != 0)

   959       {  GLPAIJ *aij;

   960          for (aij = P->row[csa->obj_row]->ptr; aij != NULL; aij =

   961             aij->r_next) glp_set_obj_coef(P, aij->col->j, aij->val);

   962       }

   963       /* read optional RHS section */

   964       if (strcmp(csa->field, "RHS") == 0)

   965          read_rhs(csa);

   966       /* read optional RANGES section */

   967       if (strcmp(csa->field, "RANGES") == 0)

   968          read_ranges(csa);

   969       /* read optional BOUNDS section */

   970       if (strcmp(csa->field, "BOUNDS") == 0)

   971          read_bounds(csa);

   972       /* read ENDATA indicator record */

   973       if (strcmp(csa->field, "ENDATA") != 0)

   974          error(csa, "invalid use of %s indicator record\n",

   975             csa->field);

   976       /* print some statistics */

   977       xprintf("%d row%s, %d column%s, %d non-zero%s\n",

   978          P->m, P->m == 1 ? "" : "s", P->n, P->n == 1 ? "" : "s",

   979          P->nnz, P->nnz == 1 ? "" : "s");

   980       if (glp_get_num_int(P) > 0)

   981       {  int ni = glp_get_num_int(P);

   982          int nb = glp_get_num_bin(P);

   983          if (ni == 1)

   984          {  if (nb == 0)

   985                xprintf("One variable is integer\n");

   986             else

   987                xprintf("One variable is binary\n");

   988          }

   989          else

   990          {  xprintf("%d integer variables, ", ni);

   991             if (nb == 0)

   992                xprintf("none");

   993             else if (nb == 1)

   994                xprintf("one");

   995             else if (nb == ni)

   996                xprintf("all");

   997             else

   998                xprintf("%d", nb);

   999             xprintf(" of which %s binary\n", nb == 1 ? "is" : "are");

  1000          }

  1001       }

  1002       xprintf("%d records were read\n", csa->recno);

  1003       /* problem data has been successfully read */

  1004       glp_delete_index(P);

  1005       glp_sort_matrix(P);

  1006       ret = 0;

  1007 done: if (csa->fp != NULL) xfclose(csa->fp);

  1008       if (csa->work1 != NULL) xfree(csa->work1);

  1009       if (csa->work2 != NULL) xfree(csa->work2);

  1010       if (csa->work3 != NULL) xfree(csa->work3);

  1011       if (ret != 0) glp_erase_prob(P);

  1012       return ret;

  1013 }

  1015 /***********************************************************************

  1016 *  NAME

  1017 *

  1018 *  glp_write_mps - write problem data in MPS format

  1019 *

  1020 *  SYNOPSIS

  1021 *

  1022 *  int glp_write_mps(glp_prob *P, int fmt, const glp_mpscp *parm,

  1023 *     const char *fname);

  1024 *

  1025 *  DESCRIPTION

  1026 *

  1027 *  The routine glp_write_mps writes problem data in MPS format to a

  1028 *  text file.

  1029 *

  1030 *  The parameter fmt specifies the version of MPS format:

  1031 *

  1032 *  GLP_MPS_DECK - fixed (ancient) MPS format;

  1033 *  GLP_MPS_FILE - free (modern) MPS format.

  1034 *

  1035 *  The parameter parm is a pointer to the structure glp_mpscp, which

  1036 *  specifies control parameters used by the routine. If parm is NULL,

  1037 *  the routine uses default settings.

  1038 *

  1039 *  The character string fname specifies a name of the text file to be

  1040 *  written.

  1041 *

  1042 *  RETURNS

  1043 *

  1044 *  If the operation was successful, the routine glp_read_mps returns

  1045 *  zero. Otherwise, it prints an error message and returns non-zero. */

  1047 #define csa csa1

  1049 struct csa

  1050 {     /* common storage area */

  1051       glp_prob *P;

  1052       /* pointer to problem object */

  1053       int deck;

  1054       /* MPS format (0 - free, 1 - fixed) */

  1055       const glp_mpscp *parm;

  1056       /* pointer to control parameters */

  1057       char field[255+1];

  1058       /* field buffer */

  1059 };

  1061 static char *mps_name(struct csa *csa)

  1062 {     /* make problem name */

  1063       char *f;

  1064       if (csa->P->name == NULL)

  1065          csa->field[0] = '\0';

  1066       else if (csa->deck)

  1067       {  strncpy(csa->field, csa->P->name, 8);

  1068          csa->field[8] = '\0';

  1069       }

  1070       else

  1071          strcpy(csa->field, csa->P->name);

  1072       for (f = csa->field; *f != '\0'; f++)

  1073          if (*f == ' ') *f = '_';

  1074       return csa->field;

  1075 }

  1077 static char *row_name(struct csa *csa, int i)

  1078 {     /* make i-th row name */

  1079       char *f;

  1080       xassert(0 <= i && i <= csa->P->m);

  1081       if (i == 0 || csa->P->row[i]->name == NULL ||

  1082           csa->deck && strlen(csa->P->row[i]->name) > 8)

  1083          sprintf(csa->field, "R%07d", i);

  1084       else

  1085       {  strcpy(csa->field, csa->P->row[i]->name);

  1086          for (f = csa->field; *f != '\0'; f++)

  1087             if (*f == ' ') *f = '_';

  1088       }

  1089       return csa->field;

  1090 }

  1092 static char *col_name(struct csa *csa, int j)

  1093 {     /* make j-th column name */

  1094       char *f;

  1095       xassert(1 <= j && j <= csa->P->n);

  1096       if (csa->P->col[j]->name == NULL ||

  1097           csa->deck && strlen(csa->P->col[j]->name) > 8)

  1098          sprintf(csa->field, "C%07d", j);

  1099       else

  1100       {  strcpy(csa->field, csa->P->col[j]->name);

  1101          for (f = csa->field; *f != '\0'; f++)

  1102             if (*f == ' ') *f = '_';

  1103       }

  1104       return csa->field;

  1105 }

  1107 static char *mps_numb(struct csa *csa, double val)

  1108 {     /* format floating-point number */

  1109       int dig;

  1110       char *exp;

  1111       for (dig = 12; dig >= 6; dig--)

  1112       {  if (val != 0.0 && fabs(val) < 0.002)

  1113             sprintf(csa->field, "%.*E", dig-1, val);

  1114          else

  1115             sprintf(csa->field, "%.*G", dig, val);

  1116          exp = strchr(csa->field, 'E');

  1117          if (exp != NULL)

  1118             sprintf(exp+1, "%d", atoi(exp+1));

  1119          if (strlen(csa->field) <= 12) break;

  1120       }

  1121       xassert(strlen(csa->field) <= 12);

  1122       return csa->field;

  1123 }

  1125 int glp_write_mps(glp_prob *P, int fmt, const glp_mpscp *parm,

  1126       const char *fname)

  1127 {     /* write problem data in MPS format */

  1128       glp_mpscp _parm;

  1129       struct csa _csa, *csa = &_csa;

  1130       XFILE *fp;

  1131       int out_obj, one_col = 0, empty = 0;

  1132       int i, j, recno, marker, count, gap, ret;

  1133       xprintf("Writing problem data to `%s'...\n", fname);

  1134       if (!(fmt == GLP_MPS_DECK || fmt == GLP_MPS_FILE))

  1135          xerror("glp_write_mps: fmt = %d; invalid parameter\n", fmt);

  1136       if (parm == NULL)

  1137          glp_init_mpscp(&_parm), parm = &_parm;

  1138       /* check control parameters */

  1139       check_parm("glp_write_mps", parm);

  1140       /* initialize common storage area */

  1141       csa->P = P;

  1142       csa->deck = (fmt == GLP_MPS_DECK);

  1143       csa->parm = parm;

  1144       /* create output MPS file */

  1145       fp = xfopen(fname, "w"), recno = 0;

  1146       if (fp == NULL)

  1147       {  xprintf("Unable to create `%s' - %s\n", fname, xerrmsg());

  1148          ret = 1;

  1149          goto done;

  1150       }

  1151       /* write comment records */

  1152       xfprintf(fp, "* %-*s%s\n", P->name == NULL ? 1 : 12, "Problem:",

  1153          P->name == NULL ? "" : P->name), recno++;

  1154       xfprintf(fp, "* %-12s%s\n", "Class:", glp_get_num_int(P) == 0 ?

  1155          "LP" : "MIP"), recno++;

  1156       xfprintf(fp, "* %-12s%d\n", "Rows:", P->m), recno++;

  1157       if (glp_get_num_int(P) == 0)

  1158          xfprintf(fp, "* %-12s%d\n", "Columns:", P->n), recno++;

  1159       else

  1160          xfprintf(fp, "* %-12s%d (%d integer, %d binary)\n",

  1161             "Columns:", P->n, glp_get_num_int(P), glp_get_num_bin(P)),

  1162             recno++;

  1163       xfprintf(fp, "* %-12s%d\n", "Non-zeros:", P->nnz), recno++;

  1164       xfprintf(fp, "* %-12s%s\n", "Format:", csa->deck ? "Fixed MPS" :

  1165          "Free MPS"), recno++;

  1166       xfprintf(fp, "*\n", recno++);

  1167       /* write NAME indicator record */

  1168       xfprintf(fp, "NAME%*s%s\n",

  1169          P->name == NULL ? 0 : csa->deck ? 10 : 1, "", mps_name(csa)),

  1170          recno++;

  1171 #if 1

  1172       /* determine whether to write the objective row */

  1173       out_obj = 1;

  1174       for (i = 1; i <= P->m; i++)

  1175       {  if (P->row[i]->type == GLP_FR)

  1176          {  out_obj = 0;

  1177             break;

  1178          }

  1179       }

  1180 #endif

  1181       /* write ROWS section */

  1182       xfprintf(fp, "ROWS\n"), recno++;

  1183       for (i = (out_obj ? 0 : 1); i <= P->m; i++)

  1184       {  int type;

  1185          type = (i == 0 ? GLP_FR : P->row[i]->type);

  1186          if (type == GLP_FR)

  1187             type = 'N';

  1188          else if (type == GLP_LO)

  1189             type = 'G';

  1190          else if (type == GLP_UP)

  1191             type = 'L';

  1192          else if (type == GLP_DB || type == GLP_FX)

  1193             type = 'E';

  1194          else

  1195             xassert(type != type);

  1196          xfprintf(fp, " %c%*s%s\n", type, csa->deck ? 2 : 1, "",

  1197             row_name(csa, i)), recno++;

  1198       }

  1199       /* write COLUMNS section */

  1200       xfprintf(fp, "COLUMNS\n"), recno++;

  1201       marker = 0;

  1202       for (j = 1; j <= P->n; j++)

  1203       {  GLPAIJ cj, *aij;

  1204          int kind;

  1205          kind = P->col[j]->kind;

  1206          if (kind == GLP_CV)

  1207          {  if (marker % 2 == 1)

  1208             {  /* close current integer block */

  1209                marker++;

  1210                xfprintf(fp, "%*sM%07d%*s'MARKER'%*s'INTEND'\n",

  1211                   csa->deck ? 4 : 1, "", marker, csa->deck ? 2 : 1, "",

  1212                   csa->deck ? 17 : 1, ""), recno++;

  1213             }

  1214          }

  1215          else if (kind == GLP_IV)

  1216          {  if (marker % 2 == 0)

  1217             {  /* open new integer block */

  1218                marker++;

  1219                xfprintf(fp, "%*sM%07d%*s'MARKER'%*s'INTORG'\n",

  1220                   csa->deck ? 4 : 1, "", marker, csa->deck ? 2 : 1, "",

  1221                   csa->deck ? 17 : 1, ""), recno++;

  1222             }

  1223          }

  1224          else

  1225             xassert(kind != kind);

  1226          if (out_obj && P->col[j]->coef != 0.0)

  1227          {  /* make fake objective coefficient */

  1228             aij = &cj;

  1229             aij->row = NULL;

  1230             aij->val = P->col[j]->coef;

  1231             aij->c_next = P->col[j]->ptr;

  1232          }

  1233          else

  1234             aij = P->col[j]->ptr;

  1235 #if 1 /* FIXME */

  1236          if (aij == NULL)

  1237          {  /* empty column */

  1238             empty++;

  1239             xfprintf(fp, "%*s%-*s", csa->deck ? 4 : 1, "",

  1240                csa->deck ? 8 : 1, col_name(csa, j));

  1241             /* we need a row */

  1242             xassert(P->m > 0);

  1243             xfprintf(fp, "%*s%-*s",

  1244                csa->deck ? 2 : 1, "", csa->deck ? 8 : 1,

  1245                row_name(csa, 1));

  1246             xfprintf(fp, "%*s0%*s$ empty column\n",

  1247                csa->deck ? 13 : 1, "", csa->deck ? 3 : 1, ""), recno++;

  1248          }

  1249 #endif

  1250          count = 0;

  1251          for (aij = aij; aij != NULL; aij = aij->c_next)

  1252          {  if (one_col || count % 2 == 0)

  1253                xfprintf(fp, "%*s%-*s", csa->deck ? 4 : 1, "",

  1254                   csa->deck ? 8 : 1, col_name(csa, j));

  1255             gap = (one_col || count % 2 == 0 ? 2 : 3);

  1256             xfprintf(fp, "%*s%-*s",

  1257                csa->deck ? gap : 1, "", csa->deck ? 8 : 1,

  1258                row_name(csa, aij->row == NULL ? 0 : aij->row->i));

  1259             xfprintf(fp, "%*s%*s",

  1260                csa->deck ? 2 : 1, "", csa->deck ? 12 : 1,

  1261                mps_numb(csa, aij->val)), count++;

  1262             if (one_col || count % 2 == 0)

  1263                xfprintf(fp, "\n"), recno++;

  1264          }

  1265          if (!(one_col || count % 2 == 0))

  1266             xfprintf(fp, "\n"), recno++;

  1267       }

  1268       if (marker % 2 == 1)

  1269       {  /* close last integer block */

  1270          marker++;

  1271          xfprintf(fp, "%*sM%07d%*s'MARKER'%*s'INTEND'\n",

  1272             csa->deck ? 4 : 1, "", marker, csa->deck ? 2 : 1, "",

  1273             csa->deck ? 17 : 1, ""), recno++;

  1274       }

  1275 #if 1

  1276       if (empty > 0)

  1277          xprintf("Warning: problem has %d empty column(s)\n", empty);

  1278 #endif

  1279       /* write RHS section */

  1280       xfprintf(fp, "RHS\n"), recno++;

  1281       count = 0;

  1282       for (i = (out_obj ? 0 : 1); i <= P->m; i++)

  1283       {  int type;

  1284          double rhs;

  1285          if (i == 0)

  1286             rhs = P->c0;

  1287          else

  1288          {  type = P->row[i]->type;

  1289             if (type == GLP_FR)

  1290                rhs = 0.0;

  1291             else if (type == GLP_LO)

  1292                rhs = P->row[i]->lb;

  1293             else if (type == GLP_UP)

  1294                rhs = P->row[i]->ub;

  1295             else if (type == GLP_DB || type == GLP_FX)

  1296                rhs = P->row[i]->lb;

  1297             else

  1298                xassert(type != type);

  1299          }

  1300          if (rhs != 0.0)

  1301          {  if (one_col || count % 2 == 0)

  1302                xfprintf(fp, "%*s%-*s", csa->deck ? 4 : 1, "",

  1303                   csa->deck ? 8 : 1, "RHS1");

  1304             gap = (one_col || count % 2 == 0 ? 2 : 3);

  1305             xfprintf(fp, "%*s%-*s",

  1306                csa->deck ? gap : 1, "", csa->deck ? 8 : 1,

  1307                row_name(csa, i));

  1308             xfprintf(fp, "%*s%*s",

  1309                csa->deck ? 2 : 1, "", csa->deck ? 12 : 1,

  1310                mps_numb(csa, rhs)), count++;

  1311             if (one_col || count % 2 == 0)

  1312                xfprintf(fp, "\n"), recno++;

  1313          }

  1314       }

  1315       if (!(one_col || count % 2 == 0))

  1316          xfprintf(fp, "\n"), recno++;

  1317       /* write RANGES section */

  1318       for (i = P->m; i >= 1; i--)

  1319          if (P->row[i]->type == GLP_DB) break;

  1320       if (i == 0) goto bnds;

  1321       xfprintf(fp, "RANGES\n"), recno++;

  1322       count = 0;

  1323       for (i = 1; i <= P->m; i++)

  1324       {  if (P->row[i]->type == GLP_DB)

  1325          {  if (one_col || count % 2 == 0)

  1326                xfprintf(fp, "%*s%-*s", csa->deck ? 4 : 1, "",

  1327                   csa->deck ? 8 : 1, "RNG1");

  1328             gap = (one_col || count % 2 == 0 ? 2 : 3);

  1329             xfprintf(fp, "%*s%-*s",

  1330                csa->deck ? gap : 1, "", csa->deck ? 8 : 1,

  1331                row_name(csa, i));

  1332             xfprintf(fp, "%*s%*s",

  1333                csa->deck ? 2 : 1, "", csa->deck ? 12 : 1,

  1334                mps_numb(csa, P->row[i]->ub - P->row[i]->lb)), count++;

  1335             if (one_col || count % 2 == 0)

  1336                xfprintf(fp, "\n"), recno++;

  1337          }

  1338       }

  1339       if (!(one_col || count % 2 == 0))

  1340          xfprintf(fp, "\n"), recno++;

  1341 bnds: /* write BOUNDS section */

  1342       for (j = P->n; j >= 1; j--)

  1343          if (!(P->col[j]->type == GLP_LO && P->col[j]->lb == 0.0))

  1344             break;

  1345       if (j == 0) goto endt;

  1346       xfprintf(fp, "BOUNDS\n"), recno++;

  1347       for (j = 1; j <= P->n; j++)

  1348       {  int type, data[2];

  1349          double bnd[2];

  1350          char *spec[2];

  1351          spec[0] = spec[1] = NULL;

  1352          type = P->col[j]->type;

  1353          if (type == GLP_FR)

  1354             spec[0] = "FR", data[0] = 0;

  1355          else if (type == GLP_LO)

  1356          {  if (P->col[j]->lb != 0.0)

  1357                spec[0] = "LO", data[0] = 1, bnd[0] = P->col[j]->lb;

  1358             if (P->col[j]->kind == GLP_IV)

  1359                spec[1] = "PL", data[1] = 0;

  1360          }

  1361          else if (type == GLP_UP)

  1362          {  spec[0] = "MI", data[0] = 0;

  1363             spec[1] = "UP", data[1] = 1, bnd[1] = P->col[j]->ub;

  1364          }

  1365          else if (type == GLP_DB)

  1366          {  if (P->col[j]->lb != 0.0)

  1367                spec[0] = "LO", data[0] = 1, bnd[0] = P->col[j]->lb;

  1368             spec[1] = "UP", data[1] = 1, bnd[1] = P->col[j]->ub;

  1369          }

  1370          else if (type == GLP_FX)

  1371             spec[0] = "FX", data[0] = 1, bnd[0] = P->col[j]->lb;

  1372          else

  1373             xassert(type != type);

  1374          for (i = 0; i <= 1; i++)

  1375          {  if (spec[i] != NULL)

  1376             {  xfprintf(fp, " %s %-*s%*s%-*s", spec[i],

  1377                   csa->deck ? 8 : 1, "BND1", csa->deck ? 2 : 1, "",

  1378                   csa->deck ? 8 : 1, col_name(csa, j));

  1379                if (data[i])

  1380                   xfprintf(fp, "%*s%*s", csa->deck ? 2 : 1, "",

  1381                      csa->deck ? 12 : 1, mps_numb(csa, bnd[i]));

  1382                xfprintf(fp, "\n"), recno++;

  1383             }

  1384          }

  1385       }

  1386 endt: /* write ENDATA indicator record */

  1387       xfprintf(fp, "ENDATA\n"), recno++;

  1388       xfflush(fp);

  1389       if (xferror(fp))

  1390       {  xprintf("Write error on `%s' - %s\n", fname, xerrmsg());

  1391          ret = 1;

  1392          goto done;

  1393       }

  1394       /* problem data has been successfully written */

  1395       xprintf("%d records were written\n", recno);

  1396       ret = 0;

  1397 done: if (fp != NULL) xfclose(fp);

  1398       return ret;

  1399 }

  1401 /* eof */

author	Alpar Juttner <alpar@cs.elte.hu>
	Sun, 05 Dec 2010 17:35:23 +0100
changeset 2	4c8956a7bdf4
permissions	-rw-r--r--