lemon-project-template-glpk

annotate deps/glpk/src/glpmps.c @ 11:4fc6ad2fb8a6

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