[1] | 1 | /* glpmps.c (MPS format routines) */ |
---|
| 2 | |
---|
| 3 | /*********************************************************************** |
---|
| 4 | * This code is part of GLPK (GNU Linear Programming Kit). |
---|
| 5 | * |
---|
| 6 | * Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, |
---|
| 7 | * 2009, 2010 Andrew Makhorin, Department for Applied Informatics, |
---|
| 8 | * Moscow Aviation Institute, Moscow, Russia. All rights reserved. |
---|
| 9 | * E-mail: <mao@gnu.org>. |
---|
| 10 | * |
---|
| 11 | * GLPK is free software: you can redistribute it and/or modify it |
---|
| 12 | * under the terms of the GNU General Public License as published by |
---|
| 13 | * the Free Software Foundation, either version 3 of the License, or |
---|
| 14 | * (at your option) any later version. |
---|
| 15 | * |
---|
| 16 | * GLPK is distributed in the hope that it will be useful, but WITHOUT |
---|
| 17 | * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY |
---|
| 18 | * or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public |
---|
| 19 | * License for more details. |
---|
| 20 | * |
---|
| 21 | * You should have received a copy of the GNU General Public License |
---|
| 22 | * along with GLPK. If not, see <http://www.gnu.org/licenses/>. |
---|
| 23 | ***********************************************************************/ |
---|
| 24 | |
---|
| 25 | #include "glpapi.h" |
---|
| 26 | |
---|
| 27 | /*********************************************************************** |
---|
| 28 | * NAME |
---|
| 29 | * |
---|
| 30 | * glp_init_mpscp - initialize MPS format control parameters |
---|
| 31 | * |
---|
| 32 | * SYNOPSIS |
---|
| 33 | * |
---|
| 34 | * void glp_init_mpscp(glp_mpscp *parm); |
---|
| 35 | * |
---|
| 36 | * DESCRIPTION |
---|
| 37 | * |
---|
| 38 | * The routine glp_init_mpscp initializes control parameters, which are |
---|
| 39 | * used by the MPS input/output routines glp_read_mps and glp_write_mps, |
---|
| 40 | * with default values. |
---|
| 41 | * |
---|
| 42 | * Default values of the control parameters are stored in the glp_mpscp |
---|
| 43 | * structure, which the parameter parm points to. */ |
---|
| 44 | |
---|
| 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 | } |
---|
| 51 | |
---|
| 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 | } |
---|
| 66 | |
---|
| 67 | /*********************************************************************** |
---|
| 68 | * NAME |
---|
| 69 | * |
---|
| 70 | * glp_read_mps - read problem data in MPS format |
---|
| 71 | * |
---|
| 72 | * SYNOPSIS |
---|
| 73 | * |
---|
| 74 | * int glp_read_mps(glp_prob *P, int fmt, const glp_mpscp *parm, |
---|
| 75 | * const char *fname); |
---|
| 76 | * |
---|
| 77 | * DESCRIPTION |
---|
| 78 | * |
---|
| 79 | * The routine glp_read_mps reads problem data in MPS format from a |
---|
| 80 | * text file. |
---|
| 81 | * |
---|
| 82 | * The parameter fmt specifies the version of MPS format: |
---|
| 83 | * |
---|
| 84 | * GLP_MPS_DECK - fixed (ancient) MPS format; |
---|
| 85 | * GLP_MPS_FILE - free (modern) MPS format. |
---|
| 86 | * |
---|
| 87 | * The parameter parm is a pointer to the structure glp_mpscp, which |
---|
| 88 | * specifies control parameters used by the routine. If parm is NULL, |
---|
| 89 | * the routine uses default settings. |
---|
| 90 | * |
---|
| 91 | * The character string fname specifies a name of the text file to be |
---|
| 92 | * read. |
---|
| 93 | * |
---|
| 94 | * Note that before reading data the current content of the problem |
---|
| 95 | * object is completely erased with the routine glp_erase_prob. |
---|
| 96 | * |
---|
| 97 | * RETURNS |
---|
| 98 | * |
---|
| 99 | * If the operation was successful, the routine glp_read_mps returns |
---|
| 100 | * zero. Otherwise, it prints an error message and returns non-zero. */ |
---|
| 101 | |
---|
| 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 | }; |
---|
| 135 | |
---|
| 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 | } |
---|
| 146 | |
---|
| 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 | } |
---|
| 156 | |
---|
| 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 | } |
---|
| 202 | |
---|
| 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 | } |
---|
| 245 | |
---|
| 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 | } |
---|
| 347 | |
---|
| 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 | } |
---|
| 362 | |
---|
| 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 | } |
---|
| 380 | |
---|
| 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 | } |
---|
| 388 | |
---|
| 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 | } |
---|
| 407 | |
---|
| 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 | } |
---|
| 443 | |
---|
| 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 | } |
---|
| 560 | |
---|
| 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 | } |
---|
| 640 | |
---|
| 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 | } |
---|
| 732 | |
---|
| 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 | } |
---|
| 873 | |
---|
| 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 | } |
---|
| 1014 | |
---|
| 1015 | /*********************************************************************** |
---|
| 1016 | * NAME |
---|
| 1017 | * |
---|
| 1018 | * glp_write_mps - write problem data in MPS format |
---|
| 1019 | * |
---|
| 1020 | * SYNOPSIS |
---|
| 1021 | * |
---|
| 1022 | * int glp_write_mps(glp_prob *P, int fmt, const glp_mpscp *parm, |
---|
| 1023 | * const char *fname); |
---|
| 1024 | * |
---|
| 1025 | * DESCRIPTION |
---|
| 1026 | * |
---|
| 1027 | * The routine glp_write_mps writes problem data in MPS format to a |
---|
| 1028 | * text file. |
---|
| 1029 | * |
---|
| 1030 | * The parameter fmt specifies the version of MPS format: |
---|
| 1031 | * |
---|
| 1032 | * GLP_MPS_DECK - fixed (ancient) MPS format; |
---|
| 1033 | * GLP_MPS_FILE - free (modern) MPS format. |
---|
| 1034 | * |
---|
| 1035 | * The parameter parm is a pointer to the structure glp_mpscp, which |
---|
| 1036 | * specifies control parameters used by the routine. If parm is NULL, |
---|
| 1037 | * the routine uses default settings. |
---|
| 1038 | * |
---|
| 1039 | * The character string fname specifies a name of the text file to be |
---|
| 1040 | * written. |
---|
| 1041 | * |
---|
| 1042 | * RETURNS |
---|
| 1043 | * |
---|
| 1044 | * If the operation was successful, the routine glp_read_mps returns |
---|
| 1045 | * zero. Otherwise, it prints an error message and returns non-zero. */ |
---|
| 1046 | |
---|
| 1047 | #define csa csa1 |
---|
| 1048 | |
---|
| 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 | }; |
---|
| 1060 | |
---|
| 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 | } |
---|
| 1076 | |
---|
| 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 | } |
---|
| 1091 | |
---|
| 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 | } |
---|
| 1106 | |
---|
| 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 | } |
---|
| 1124 | |
---|
| 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 | } |
---|
| 1400 | |
---|
| 1401 | /* eof */ |
---|