lemon-project-template-glpk

annotate deps/glpk/src/glpmpl04.c @ 9:33de93886c88

find changesets by author, revision, files, or words in the commit message
Import GLPK 4.47
author Alpar Juttner <alpar@cs.elte.hu>
date Sun, 06 Nov 2011 20:59:10 +0100
parents
children
rev   line source
alpar@9 1 /* glpmpl04.c */
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 #define _GLPSTD_ERRNO
alpar@9 26 #define _GLPSTD_STDIO
alpar@9 27 #include "glpmpl.h"
alpar@9 28 #define xfault xerror
alpar@9 29 #define dmp_create_poolx(size) dmp_create_pool()
alpar@9 30
alpar@9 31 /**********************************************************************/
alpar@9 32 /* * * GENERATING AND POSTSOLVING MODEL * * */
alpar@9 33 /**********************************************************************/
alpar@9 34
alpar@9 35 /*----------------------------------------------------------------------
alpar@9 36 -- alloc_content - allocate content arrays for all model objects.
alpar@9 37 --
alpar@9 38 -- This routine allocates content arrays for all existing model objects
alpar@9 39 -- and thereby finalizes creating model.
alpar@9 40 --
alpar@9 41 -- This routine must be called immediately after reading model section,
alpar@9 42 -- i.e. before reading data section or generating model. */
alpar@9 43
alpar@9 44 void alloc_content(MPL *mpl)
alpar@9 45 { STATEMENT *stmt;
alpar@9 46 /* walk through all model statements */
alpar@9 47 for (stmt = mpl->model; stmt != NULL; stmt = stmt->next)
alpar@9 48 { switch (stmt->type)
alpar@9 49 { case A_SET:
alpar@9 50 /* model set */
alpar@9 51 xassert(stmt->u.set->array == NULL);
alpar@9 52 stmt->u.set->array = create_array(mpl, A_ELEMSET,
alpar@9 53 stmt->u.set->dim);
alpar@9 54 break;
alpar@9 55 case A_PARAMETER:
alpar@9 56 /* model parameter */
alpar@9 57 xassert(stmt->u.par->array == NULL);
alpar@9 58 switch (stmt->u.par->type)
alpar@9 59 { case A_NUMERIC:
alpar@9 60 case A_INTEGER:
alpar@9 61 case A_BINARY:
alpar@9 62 stmt->u.par->array = create_array(mpl, A_NUMERIC,
alpar@9 63 stmt->u.par->dim);
alpar@9 64 break;
alpar@9 65 case A_SYMBOLIC:
alpar@9 66 stmt->u.par->array = create_array(mpl, A_SYMBOLIC,
alpar@9 67 stmt->u.par->dim);
alpar@9 68 break;
alpar@9 69 default:
alpar@9 70 xassert(stmt != stmt);
alpar@9 71 }
alpar@9 72 break;
alpar@9 73 case A_VARIABLE:
alpar@9 74 /* model variable */
alpar@9 75 xassert(stmt->u.var->array == NULL);
alpar@9 76 stmt->u.var->array = create_array(mpl, A_ELEMVAR,
alpar@9 77 stmt->u.var->dim);
alpar@9 78 break;
alpar@9 79 case A_CONSTRAINT:
alpar@9 80 /* model constraint/objective */
alpar@9 81 xassert(stmt->u.con->array == NULL);
alpar@9 82 stmt->u.con->array = create_array(mpl, A_ELEMCON,
alpar@9 83 stmt->u.con->dim);
alpar@9 84 break;
alpar@9 85 #if 1 /* 11/II-2008 */
alpar@9 86 case A_TABLE:
alpar@9 87 #endif
alpar@9 88 case A_SOLVE:
alpar@9 89 case A_CHECK:
alpar@9 90 case A_DISPLAY:
alpar@9 91 case A_PRINTF:
alpar@9 92 case A_FOR:
alpar@9 93 /* functional statements have no content array */
alpar@9 94 break;
alpar@9 95 default:
alpar@9 96 xassert(stmt != stmt);
alpar@9 97 }
alpar@9 98 }
alpar@9 99 return;
alpar@9 100 }
alpar@9 101
alpar@9 102 /*----------------------------------------------------------------------
alpar@9 103 -- generate_model - generate model.
alpar@9 104 --
alpar@9 105 -- This routine executes the model statements which precede the solve
alpar@9 106 -- statement. */
alpar@9 107
alpar@9 108 void generate_model(MPL *mpl)
alpar@9 109 { STATEMENT *stmt;
alpar@9 110 xassert(!mpl->flag_p);
alpar@9 111 for (stmt = mpl->model; stmt != NULL; stmt = stmt->next)
alpar@9 112 { execute_statement(mpl, stmt);
alpar@9 113 if (mpl->stmt->type == A_SOLVE) break;
alpar@9 114 }
alpar@9 115 mpl->stmt = stmt;
alpar@9 116 return;
alpar@9 117 }
alpar@9 118
alpar@9 119 /*----------------------------------------------------------------------
alpar@9 120 -- build_problem - build problem instance.
alpar@9 121 --
alpar@9 122 -- This routine builds lists of rows and columns for problem instance,
alpar@9 123 -- which corresponds to the generated model. */
alpar@9 124
alpar@9 125 void build_problem(MPL *mpl)
alpar@9 126 { STATEMENT *stmt;
alpar@9 127 MEMBER *memb;
alpar@9 128 VARIABLE *v;
alpar@9 129 CONSTRAINT *c;
alpar@9 130 FORMULA *t;
alpar@9 131 int i, j;
alpar@9 132 xassert(mpl->m == 0);
alpar@9 133 xassert(mpl->n == 0);
alpar@9 134 xassert(mpl->row == NULL);
alpar@9 135 xassert(mpl->col == NULL);
alpar@9 136 /* check that all elemental variables has zero column numbers */
alpar@9 137 for (stmt = mpl->model; stmt != NULL; stmt = stmt->next)
alpar@9 138 { if (stmt->type == A_VARIABLE)
alpar@9 139 { v = stmt->u.var;
alpar@9 140 for (memb = v->array->head; memb != NULL; memb = memb->next)
alpar@9 141 xassert(memb->value.var->j == 0);
alpar@9 142 }
alpar@9 143 }
alpar@9 144 /* assign row numbers to elemental constraints and objectives */
alpar@9 145 for (stmt = mpl->model; stmt != NULL; stmt = stmt->next)
alpar@9 146 { if (stmt->type == A_CONSTRAINT)
alpar@9 147 { c = stmt->u.con;
alpar@9 148 for (memb = c->array->head; memb != NULL; memb = memb->next)
alpar@9 149 { xassert(memb->value.con->i == 0);
alpar@9 150 memb->value.con->i = ++mpl->m;
alpar@9 151 /* walk through linear form and mark elemental variables,
alpar@9 152 which are referenced at least once */
alpar@9 153 for (t = memb->value.con->form; t != NULL; t = t->next)
alpar@9 154 { xassert(t->var != NULL);
alpar@9 155 t->var->memb->value.var->j = -1;
alpar@9 156 }
alpar@9 157 }
alpar@9 158 }
alpar@9 159 }
alpar@9 160 /* assign column numbers to marked elemental variables */
alpar@9 161 for (stmt = mpl->model; stmt != NULL; stmt = stmt->next)
alpar@9 162 { if (stmt->type == A_VARIABLE)
alpar@9 163 { v = stmt->u.var;
alpar@9 164 for (memb = v->array->head; memb != NULL; memb = memb->next)
alpar@9 165 if (memb->value.var->j != 0) memb->value.var->j =
alpar@9 166 ++mpl->n;
alpar@9 167 }
alpar@9 168 }
alpar@9 169 /* build list of rows */
alpar@9 170 mpl->row = xcalloc(1+mpl->m, sizeof(ELEMCON *));
alpar@9 171 for (i = 1; i <= mpl->m; i++) mpl->row[i] = NULL;
alpar@9 172 for (stmt = mpl->model; stmt != NULL; stmt = stmt->next)
alpar@9 173 { if (stmt->type == A_CONSTRAINT)
alpar@9 174 { c = stmt->u.con;
alpar@9 175 for (memb = c->array->head; memb != NULL; memb = memb->next)
alpar@9 176 { i = memb->value.con->i;
alpar@9 177 xassert(1 <= i && i <= mpl->m);
alpar@9 178 xassert(mpl->row[i] == NULL);
alpar@9 179 mpl->row[i] = memb->value.con;
alpar@9 180 }
alpar@9 181 }
alpar@9 182 }
alpar@9 183 for (i = 1; i <= mpl->m; i++) xassert(mpl->row[i] != NULL);
alpar@9 184 /* build list of columns */
alpar@9 185 mpl->col = xcalloc(1+mpl->n, sizeof(ELEMVAR *));
alpar@9 186 for (j = 1; j <= mpl->n; j++) mpl->col[j] = NULL;
alpar@9 187 for (stmt = mpl->model; stmt != NULL; stmt = stmt->next)
alpar@9 188 { if (stmt->type == A_VARIABLE)
alpar@9 189 { v = stmt->u.var;
alpar@9 190 for (memb = v->array->head; memb != NULL; memb = memb->next)
alpar@9 191 { j = memb->value.var->j;
alpar@9 192 if (j == 0) continue;
alpar@9 193 xassert(1 <= j && j <= mpl->n);
alpar@9 194 xassert(mpl->col[j] == NULL);
alpar@9 195 mpl->col[j] = memb->value.var;
alpar@9 196 }
alpar@9 197 }
alpar@9 198 }
alpar@9 199 for (j = 1; j <= mpl->n; j++) xassert(mpl->col[j] != NULL);
alpar@9 200 return;
alpar@9 201 }
alpar@9 202
alpar@9 203 /*----------------------------------------------------------------------
alpar@9 204 -- postsolve_model - postsolve model.
alpar@9 205 --
alpar@9 206 -- This routine executes the model statements which follow the solve
alpar@9 207 -- statement. */
alpar@9 208
alpar@9 209 void postsolve_model(MPL *mpl)
alpar@9 210 { STATEMENT *stmt;
alpar@9 211 xassert(!mpl->flag_p);
alpar@9 212 mpl->flag_p = 1;
alpar@9 213 for (stmt = mpl->stmt; stmt != NULL; stmt = stmt->next)
alpar@9 214 execute_statement(mpl, stmt);
alpar@9 215 mpl->stmt = NULL;
alpar@9 216 return;
alpar@9 217 }
alpar@9 218
alpar@9 219 /*----------------------------------------------------------------------
alpar@9 220 -- clean_model - clean model content.
alpar@9 221 --
alpar@9 222 -- This routine cleans the model content that assumes deleting all stuff
alpar@9 223 -- dynamically allocated on generating/postsolving phase.
alpar@9 224 --
alpar@9 225 -- Actually cleaning model content is not needed. This function is used
alpar@9 226 -- mainly to be sure that there were no logical errors on using dynamic
alpar@9 227 -- memory pools during the generation phase.
alpar@9 228 --
alpar@9 229 -- NOTE: This routine must not be called if any errors were detected on
alpar@9 230 -- the generation phase. */
alpar@9 231
alpar@9 232 void clean_model(MPL *mpl)
alpar@9 233 { STATEMENT *stmt;
alpar@9 234 for (stmt = mpl->model; stmt != NULL; stmt = stmt->next)
alpar@9 235 clean_statement(mpl, stmt);
alpar@9 236 /* check that all atoms have been returned to their pools */
alpar@9 237 if (dmp_in_use(mpl->strings).lo != 0)
alpar@9 238 error(mpl, "internal logic error: %d string segment(s) were lo"
alpar@9 239 "st", dmp_in_use(mpl->strings).lo);
alpar@9 240 if (dmp_in_use(mpl->symbols).lo != 0)
alpar@9 241 error(mpl, "internal logic error: %d symbol(s) were lost",
alpar@9 242 dmp_in_use(mpl->symbols).lo);
alpar@9 243 if (dmp_in_use(mpl->tuples).lo != 0)
alpar@9 244 error(mpl, "internal logic error: %d n-tuple component(s) were"
alpar@9 245 " lost", dmp_in_use(mpl->tuples).lo);
alpar@9 246 if (dmp_in_use(mpl->arrays).lo != 0)
alpar@9 247 error(mpl, "internal logic error: %d array(s) were lost",
alpar@9 248 dmp_in_use(mpl->arrays).lo);
alpar@9 249 if (dmp_in_use(mpl->members).lo != 0)
alpar@9 250 error(mpl, "internal logic error: %d array member(s) were lost"
alpar@9 251 , dmp_in_use(mpl->members).lo);
alpar@9 252 if (dmp_in_use(mpl->elemvars).lo != 0)
alpar@9 253 error(mpl, "internal logic error: %d elemental variable(s) wer"
alpar@9 254 "e lost", dmp_in_use(mpl->elemvars).lo);
alpar@9 255 if (dmp_in_use(mpl->formulae).lo != 0)
alpar@9 256 error(mpl, "internal logic error: %d linear term(s) were lost",
alpar@9 257 dmp_in_use(mpl->formulae).lo);
alpar@9 258 if (dmp_in_use(mpl->elemcons).lo != 0)
alpar@9 259 error(mpl, "internal logic error: %d elemental constraint(s) w"
alpar@9 260 "ere lost", dmp_in_use(mpl->elemcons).lo);
alpar@9 261 return;
alpar@9 262 }
alpar@9 263
alpar@9 264 /**********************************************************************/
alpar@9 265 /* * * INPUT/OUTPUT * * */
alpar@9 266 /**********************************************************************/
alpar@9 267
alpar@9 268 /*----------------------------------------------------------------------
alpar@9 269 -- open_input - open input text file.
alpar@9 270 --
alpar@9 271 -- This routine opens the input text file for scanning. */
alpar@9 272
alpar@9 273 void open_input(MPL *mpl, char *file)
alpar@9 274 { mpl->line = 0;
alpar@9 275 mpl->c = '\n';
alpar@9 276 mpl->token = 0;
alpar@9 277 mpl->imlen = 0;
alpar@9 278 mpl->image[0] = '\0';
alpar@9 279 mpl->value = 0.0;
alpar@9 280 mpl->b_token = T_EOF;
alpar@9 281 mpl->b_imlen = 0;
alpar@9 282 mpl->b_image[0] = '\0';
alpar@9 283 mpl->b_value = 0.0;
alpar@9 284 mpl->f_dots = 0;
alpar@9 285 mpl->f_scan = 0;
alpar@9 286 mpl->f_token = 0;
alpar@9 287 mpl->f_imlen = 0;
alpar@9 288 mpl->f_image[0] = '\0';
alpar@9 289 mpl->f_value = 0.0;
alpar@9 290 memset(mpl->context, ' ', CONTEXT_SIZE);
alpar@9 291 mpl->c_ptr = 0;
alpar@9 292 xassert(mpl->in_fp == NULL);
alpar@9 293 mpl->in_fp = xfopen(file, "r");
alpar@9 294 if (mpl->in_fp == NULL)
alpar@9 295 error(mpl, "unable to open %s - %s", file, xerrmsg());
alpar@9 296 mpl->in_file = file;
alpar@9 297 /* scan the very first character */
alpar@9 298 get_char(mpl);
alpar@9 299 /* scan the very first token */
alpar@9 300 get_token(mpl);
alpar@9 301 return;
alpar@9 302 }
alpar@9 303
alpar@9 304 /*----------------------------------------------------------------------
alpar@9 305 -- read_char - read next character from input text file.
alpar@9 306 --
alpar@9 307 -- This routine returns a next ASCII character read from the input text
alpar@9 308 -- file. If the end of file has been reached, EOF is returned. */
alpar@9 309
alpar@9 310 int read_char(MPL *mpl)
alpar@9 311 { int c;
alpar@9 312 xassert(mpl->in_fp != NULL);
alpar@9 313 c = xfgetc(mpl->in_fp);
alpar@9 314 if (c < 0)
alpar@9 315 { if (xferror(mpl->in_fp))
alpar@9 316 error(mpl, "read error on %s - %s", mpl->in_file,
alpar@9 317 xerrmsg());
alpar@9 318 c = EOF;
alpar@9 319 }
alpar@9 320 return c;
alpar@9 321 }
alpar@9 322
alpar@9 323 /*----------------------------------------------------------------------
alpar@9 324 -- close_input - close input text file.
alpar@9 325 --
alpar@9 326 -- This routine closes the input text file. */
alpar@9 327
alpar@9 328 void close_input(MPL *mpl)
alpar@9 329 { xassert(mpl->in_fp != NULL);
alpar@9 330 xfclose(mpl->in_fp);
alpar@9 331 mpl->in_fp = NULL;
alpar@9 332 mpl->in_file = NULL;
alpar@9 333 return;
alpar@9 334 }
alpar@9 335
alpar@9 336 /*----------------------------------------------------------------------
alpar@9 337 -- open_output - open output text file.
alpar@9 338 --
alpar@9 339 -- This routine opens the output text file for writing data produced by
alpar@9 340 -- display and printf statements. */
alpar@9 341
alpar@9 342 void open_output(MPL *mpl, char *file)
alpar@9 343 { xassert(mpl->out_fp == NULL);
alpar@9 344 if (file == NULL)
alpar@9 345 { file = "<stdout>";
alpar@9 346 mpl->out_fp = (void *)stdout;
alpar@9 347 }
alpar@9 348 else
alpar@9 349 { mpl->out_fp = xfopen(file, "w");
alpar@9 350 if (mpl->out_fp == NULL)
alpar@9 351 error(mpl, "unable to create %s - %s", file, xerrmsg());
alpar@9 352 }
alpar@9 353 mpl->out_file = xmalloc(strlen(file)+1);
alpar@9 354 strcpy(mpl->out_file, file);
alpar@9 355 return;
alpar@9 356 }
alpar@9 357
alpar@9 358 /*----------------------------------------------------------------------
alpar@9 359 -- write_char - write next character to output text file.
alpar@9 360 --
alpar@9 361 -- This routine writes an ASCII character to the output text file. */
alpar@9 362
alpar@9 363 void write_char(MPL *mpl, int c)
alpar@9 364 { xassert(mpl->out_fp != NULL);
alpar@9 365 if (mpl->out_fp == (void *)stdout)
alpar@9 366 xprintf("%c", c);
alpar@9 367 else
alpar@9 368 xfprintf(mpl->out_fp, "%c", c);
alpar@9 369 return;
alpar@9 370 }
alpar@9 371
alpar@9 372 /*----------------------------------------------------------------------
alpar@9 373 -- write_text - format and write text to output text file.
alpar@9 374 --
alpar@9 375 -- This routine formats a text using the format control string and then
alpar@9 376 -- writes this text to the output text file. */
alpar@9 377
alpar@9 378 void write_text(MPL *mpl, char *fmt, ...)
alpar@9 379 { va_list arg;
alpar@9 380 char buf[OUTBUF_SIZE], *c;
alpar@9 381 va_start(arg, fmt);
alpar@9 382 vsprintf(buf, fmt, arg);
alpar@9 383 xassert(strlen(buf) < sizeof(buf));
alpar@9 384 va_end(arg);
alpar@9 385 for (c = buf; *c != '\0'; c++) write_char(mpl, *c);
alpar@9 386 return;
alpar@9 387 }
alpar@9 388
alpar@9 389 /*----------------------------------------------------------------------
alpar@9 390 -- flush_output - finalize writing data to output text file.
alpar@9 391 --
alpar@9 392 -- This routine finalizes writing data to the output text file. */
alpar@9 393
alpar@9 394 void flush_output(MPL *mpl)
alpar@9 395 { xassert(mpl->out_fp != NULL);
alpar@9 396 if (mpl->out_fp != (void *)stdout)
alpar@9 397 { xfflush(mpl->out_fp);
alpar@9 398 if (xferror(mpl->out_fp))
alpar@9 399 error(mpl, "write error on %s - %s", mpl->out_file,
alpar@9 400 xerrmsg());
alpar@9 401 }
alpar@9 402 return;
alpar@9 403 }
alpar@9 404
alpar@9 405 /**********************************************************************/
alpar@9 406 /* * * SOLVER INTERFACE * * */
alpar@9 407 /**********************************************************************/
alpar@9 408
alpar@9 409 /*----------------------------------------------------------------------
alpar@9 410 -- error - print error message and terminate model processing.
alpar@9 411 --
alpar@9 412 -- This routine formats and prints an error message and then terminates
alpar@9 413 -- model processing. */
alpar@9 414
alpar@9 415 void error(MPL *mpl, char *fmt, ...)
alpar@9 416 { va_list arg;
alpar@9 417 char msg[4095+1];
alpar@9 418 va_start(arg, fmt);
alpar@9 419 vsprintf(msg, fmt, arg);
alpar@9 420 xassert(strlen(msg) < sizeof(msg));
alpar@9 421 va_end(arg);
alpar@9 422 switch (mpl->phase)
alpar@9 423 { case 1:
alpar@9 424 case 2:
alpar@9 425 /* translation phase */
alpar@9 426 xprintf("%s:%d: %s\n",
alpar@9 427 mpl->in_file == NULL ? "(unknown)" : mpl->in_file,
alpar@9 428 mpl->line, msg);
alpar@9 429 print_context(mpl);
alpar@9 430 break;
alpar@9 431 case 3:
alpar@9 432 /* generation/postsolve phase */
alpar@9 433 xprintf("%s:%d: %s\n",
alpar@9 434 mpl->mod_file == NULL ? "(unknown)" : mpl->mod_file,
alpar@9 435 mpl->stmt == NULL ? 0 : mpl->stmt->line, msg);
alpar@9 436 break;
alpar@9 437 default:
alpar@9 438 xassert(mpl != mpl);
alpar@9 439 }
alpar@9 440 mpl->phase = 4;
alpar@9 441 longjmp(mpl->jump, 1);
alpar@9 442 /* no return */
alpar@9 443 }
alpar@9 444
alpar@9 445 /*----------------------------------------------------------------------
alpar@9 446 -- warning - print warning message and continue model processing.
alpar@9 447 --
alpar@9 448 -- This routine formats and prints a warning message and returns to the
alpar@9 449 -- calling program. */
alpar@9 450
alpar@9 451 void warning(MPL *mpl, char *fmt, ...)
alpar@9 452 { va_list arg;
alpar@9 453 char msg[4095+1];
alpar@9 454 va_start(arg, fmt);
alpar@9 455 vsprintf(msg, fmt, arg);
alpar@9 456 xassert(strlen(msg) < sizeof(msg));
alpar@9 457 va_end(arg);
alpar@9 458 switch (mpl->phase)
alpar@9 459 { case 1:
alpar@9 460 case 2:
alpar@9 461 /* translation phase */
alpar@9 462 xprintf("%s:%d: warning: %s\n",
alpar@9 463 mpl->in_file == NULL ? "(unknown)" : mpl->in_file,
alpar@9 464 mpl->line, msg);
alpar@9 465 break;
alpar@9 466 case 3:
alpar@9 467 /* generation/postsolve phase */
alpar@9 468 xprintf("%s:%d: warning: %s\n",
alpar@9 469 mpl->mod_file == NULL ? "(unknown)" : mpl->mod_file,
alpar@9 470 mpl->stmt == NULL ? 0 : mpl->stmt->line, msg);
alpar@9 471 break;
alpar@9 472 default:
alpar@9 473 xassert(mpl != mpl);
alpar@9 474 }
alpar@9 475 return;
alpar@9 476 }
alpar@9 477
alpar@9 478 /*----------------------------------------------------------------------
alpar@9 479 -- mpl_initialize - create and initialize translator database.
alpar@9 480 --
alpar@9 481 -- *Synopsis*
alpar@9 482 --
alpar@9 483 -- #include "glpmpl.h"
alpar@9 484 -- MPL *mpl_initialize(void);
alpar@9 485 --
alpar@9 486 -- *Description*
alpar@9 487 --
alpar@9 488 -- The routine mpl_initialize creates and initializes the database used
alpar@9 489 -- by the GNU MathProg translator.
alpar@9 490 --
alpar@9 491 -- *Returns*
alpar@9 492 --
alpar@9 493 -- The routine returns a pointer to the database created. */
alpar@9 494
alpar@9 495 MPL *mpl_initialize(void)
alpar@9 496 { MPL *mpl;
alpar@9 497 mpl = xmalloc(sizeof(MPL));
alpar@9 498 /* scanning segment */
alpar@9 499 mpl->line = 0;
alpar@9 500 mpl->c = 0;
alpar@9 501 mpl->token = 0;
alpar@9 502 mpl->imlen = 0;
alpar@9 503 mpl->image = xcalloc(MAX_LENGTH+1, sizeof(char));
alpar@9 504 mpl->image[0] = '\0';
alpar@9 505 mpl->value = 0.0;
alpar@9 506 mpl->b_token = 0;
alpar@9 507 mpl->b_imlen = 0;
alpar@9 508 mpl->b_image = xcalloc(MAX_LENGTH+1, sizeof(char));
alpar@9 509 mpl->b_image[0] = '\0';
alpar@9 510 mpl->b_value = 0.0;
alpar@9 511 mpl->f_dots = 0;
alpar@9 512 mpl->f_scan = 0;
alpar@9 513 mpl->f_token = 0;
alpar@9 514 mpl->f_imlen = 0;
alpar@9 515 mpl->f_image = xcalloc(MAX_LENGTH+1, sizeof(char));
alpar@9 516 mpl->f_image[0] = '\0';
alpar@9 517 mpl->f_value = 0.0;
alpar@9 518 mpl->context = xcalloc(CONTEXT_SIZE, sizeof(char));
alpar@9 519 memset(mpl->context, ' ', CONTEXT_SIZE);
alpar@9 520 mpl->c_ptr = 0;
alpar@9 521 mpl->flag_d = 0;
alpar@9 522 /* translating segment */
alpar@9 523 mpl->pool = dmp_create_poolx(0);
alpar@9 524 mpl->tree = avl_create_tree(avl_strcmp, NULL);
alpar@9 525 mpl->model = NULL;
alpar@9 526 mpl->flag_x = 0;
alpar@9 527 mpl->as_within = 0;
alpar@9 528 mpl->as_in = 0;
alpar@9 529 mpl->as_binary = 0;
alpar@9 530 mpl->flag_s = 0;
alpar@9 531 /* common segment */
alpar@9 532 mpl->strings = dmp_create_poolx(sizeof(STRING));
alpar@9 533 mpl->symbols = dmp_create_poolx(sizeof(SYMBOL));
alpar@9 534 mpl->tuples = dmp_create_poolx(sizeof(TUPLE));
alpar@9 535 mpl->arrays = dmp_create_poolx(sizeof(ARRAY));
alpar@9 536 mpl->members = dmp_create_poolx(sizeof(MEMBER));
alpar@9 537 mpl->elemvars = dmp_create_poolx(sizeof(ELEMVAR));
alpar@9 538 mpl->formulae = dmp_create_poolx(sizeof(FORMULA));
alpar@9 539 mpl->elemcons = dmp_create_poolx(sizeof(ELEMCON));
alpar@9 540 mpl->a_list = NULL;
alpar@9 541 mpl->sym_buf = xcalloc(255+1, sizeof(char));
alpar@9 542 mpl->sym_buf[0] = '\0';
alpar@9 543 mpl->tup_buf = xcalloc(255+1, sizeof(char));
alpar@9 544 mpl->tup_buf[0] = '\0';
alpar@9 545 /* generating/postsolving segment */
alpar@9 546 mpl->rand = rng_create_rand();
alpar@9 547 mpl->flag_p = 0;
alpar@9 548 mpl->stmt = NULL;
alpar@9 549 #if 1 /* 11/II-2008 */
alpar@9 550 mpl->dca = NULL;
alpar@9 551 #endif
alpar@9 552 mpl->m = 0;
alpar@9 553 mpl->n = 0;
alpar@9 554 mpl->row = NULL;
alpar@9 555 mpl->col = NULL;
alpar@9 556 /* input/output segment */
alpar@9 557 mpl->in_fp = NULL;
alpar@9 558 mpl->in_file = NULL;
alpar@9 559 mpl->out_fp = NULL;
alpar@9 560 mpl->out_file = NULL;
alpar@9 561 mpl->prt_fp = NULL;
alpar@9 562 mpl->prt_file = NULL;
alpar@9 563 /* solver interface segment */
alpar@9 564 if (setjmp(mpl->jump)) xassert(mpl != mpl);
alpar@9 565 mpl->phase = 0;
alpar@9 566 mpl->mod_file = NULL;
alpar@9 567 mpl->mpl_buf = xcalloc(255+1, sizeof(char));
alpar@9 568 mpl->mpl_buf[0] = '\0';
alpar@9 569 return mpl;
alpar@9 570 }
alpar@9 571
alpar@9 572 /*----------------------------------------------------------------------
alpar@9 573 -- mpl_read_model - read model section and optional data section.
alpar@9 574 --
alpar@9 575 -- *Synopsis*
alpar@9 576 --
alpar@9 577 -- #include "glpmpl.h"
alpar@9 578 -- int mpl_read_model(MPL *mpl, char *file, int skip_data);
alpar@9 579 --
alpar@9 580 -- *Description*
alpar@9 581 --
alpar@9 582 -- The routine mpl_read_model reads model section and optionally data
alpar@9 583 -- section, which may follow the model section, from the text file,
alpar@9 584 -- whose name is the character string file, performs translating model
alpar@9 585 -- statements and data blocks, and stores all the information in the
alpar@9 586 -- translator database.
alpar@9 587 --
alpar@9 588 -- The parameter skip_data is a flag. If the input file contains the
alpar@9 589 -- data section and this flag is set, the data section is not read as
alpar@9 590 -- if there were no data section and a warning message is issued. This
alpar@9 591 -- allows reading the data section from another input file.
alpar@9 592 --
alpar@9 593 -- This routine should be called once after the routine mpl_initialize
alpar@9 594 -- and before other API routines.
alpar@9 595 --
alpar@9 596 -- *Returns*
alpar@9 597 --
alpar@9 598 -- The routine mpl_read_model returns one the following codes:
alpar@9 599 --
alpar@9 600 -- 1 - translation successful. The input text file contains only model
alpar@9 601 -- section. In this case the calling program may call the routine
alpar@9 602 -- mpl_read_data to read data section from another file.
alpar@9 603 -- 2 - translation successful. The input text file contains both model
alpar@9 604 -- and data section.
alpar@9 605 -- 4 - processing failed due to some errors. In this case the calling
alpar@9 606 -- program should call the routine mpl_terminate to terminate model
alpar@9 607 -- processing. */
alpar@9 608
alpar@9 609 int mpl_read_model(MPL *mpl, char *file, int skip_data)
alpar@9 610 { if (mpl->phase != 0)
alpar@9 611 xfault("mpl_read_model: invalid call sequence\n");
alpar@9 612 if (file == NULL)
alpar@9 613 xfault("mpl_read_model: no input filename specified\n");
alpar@9 614 /* set up error handler */
alpar@9 615 if (setjmp(mpl->jump)) goto done;
alpar@9 616 /* translate model section */
alpar@9 617 mpl->phase = 1;
alpar@9 618 xprintf("Reading model section from %s...\n", file);
alpar@9 619 open_input(mpl, file);
alpar@9 620 model_section(mpl);
alpar@9 621 if (mpl->model == NULL)
alpar@9 622 error(mpl, "empty model section not allowed");
alpar@9 623 /* save name of the input text file containing model section for
alpar@9 624 error diagnostics during the generation phase */
alpar@9 625 mpl->mod_file = xcalloc(strlen(file)+1, sizeof(char));
alpar@9 626 strcpy(mpl->mod_file, mpl->in_file);
alpar@9 627 /* allocate content arrays for all model objects */
alpar@9 628 alloc_content(mpl);
alpar@9 629 /* optional data section may begin with the keyword 'data' */
alpar@9 630 if (is_keyword(mpl, "data"))
alpar@9 631 { if (skip_data)
alpar@9 632 { warning(mpl, "data section ignored");
alpar@9 633 goto skip;
alpar@9 634 }
alpar@9 635 mpl->flag_d = 1;
alpar@9 636 get_token(mpl /* data */);
alpar@9 637 if (mpl->token != T_SEMICOLON)
alpar@9 638 error(mpl, "semicolon missing where expected");
alpar@9 639 get_token(mpl /* ; */);
alpar@9 640 /* translate data section */
alpar@9 641 mpl->phase = 2;
alpar@9 642 xprintf("Reading data section from %s...\n", file);
alpar@9 643 data_section(mpl);
alpar@9 644 }
alpar@9 645 /* process end statement */
alpar@9 646 end_statement(mpl);
alpar@9 647 skip: xprintf("%d line%s were read\n",
alpar@9 648 mpl->line, mpl->line == 1 ? "" : "s");
alpar@9 649 close_input(mpl);
alpar@9 650 done: /* return to the calling program */
alpar@9 651 return mpl->phase;
alpar@9 652 }
alpar@9 653
alpar@9 654 /*----------------------------------------------------------------------
alpar@9 655 -- mpl_read_data - read data section.
alpar@9 656 --
alpar@9 657 -- *Synopsis*
alpar@9 658 --
alpar@9 659 -- #include "glpmpl.h"
alpar@9 660 -- int mpl_read_data(MPL *mpl, char *file);
alpar@9 661 --
alpar@9 662 -- *Description*
alpar@9 663 --
alpar@9 664 -- The routine mpl_read_data reads data section from the text file,
alpar@9 665 -- whose name is the character string file, performs translating data
alpar@9 666 -- blocks, and stores the data read in the translator database.
alpar@9 667 --
alpar@9 668 -- If this routine is used, it should be called once after the routine
alpar@9 669 -- mpl_read_model and if the latter returned the code 1.
alpar@9 670 --
alpar@9 671 -- *Returns*
alpar@9 672 --
alpar@9 673 -- The routine mpl_read_data returns one of the following codes:
alpar@9 674 --
alpar@9 675 -- 2 - data section has been successfully processed.
alpar@9 676 -- 4 - processing failed due to some errors. In this case the calling
alpar@9 677 -- program should call the routine mpl_terminate to terminate model
alpar@9 678 -- processing. */
alpar@9 679
alpar@9 680 int mpl_read_data(MPL *mpl, char *file)
alpar@9 681 #if 0 /* 02/X-2008 */
alpar@9 682 { if (mpl->phase != 1)
alpar@9 683 #else
alpar@9 684 { if (!(mpl->phase == 1 || mpl->phase == 2))
alpar@9 685 #endif
alpar@9 686 xfault("mpl_read_data: invalid call sequence\n");
alpar@9 687 if (file == NULL)
alpar@9 688 xfault("mpl_read_data: no input filename specified\n");
alpar@9 689 /* set up error handler */
alpar@9 690 if (setjmp(mpl->jump)) goto done;
alpar@9 691 /* process data section */
alpar@9 692 mpl->phase = 2;
alpar@9 693 xprintf("Reading data section from %s...\n", file);
alpar@9 694 mpl->flag_d = 1;
alpar@9 695 open_input(mpl, file);
alpar@9 696 /* in this case the keyword 'data' is optional */
alpar@9 697 if (is_literal(mpl, "data"))
alpar@9 698 { get_token(mpl /* data */);
alpar@9 699 if (mpl->token != T_SEMICOLON)
alpar@9 700 error(mpl, "semicolon missing where expected");
alpar@9 701 get_token(mpl /* ; */);
alpar@9 702 }
alpar@9 703 data_section(mpl);
alpar@9 704 /* process end statement */
alpar@9 705 end_statement(mpl);
alpar@9 706 xprintf("%d line%s were read\n",
alpar@9 707 mpl->line, mpl->line == 1 ? "" : "s");
alpar@9 708 close_input(mpl);
alpar@9 709 done: /* return to the calling program */
alpar@9 710 return mpl->phase;
alpar@9 711 }
alpar@9 712
alpar@9 713 /*----------------------------------------------------------------------
alpar@9 714 -- mpl_generate - generate model.
alpar@9 715 --
alpar@9 716 -- *Synopsis*
alpar@9 717 --
alpar@9 718 -- #include "glpmpl.h"
alpar@9 719 -- int mpl_generate(MPL *mpl, char *file);
alpar@9 720 --
alpar@9 721 -- *Description*
alpar@9 722 --
alpar@9 723 -- The routine mpl_generate generates the model using its description
alpar@9 724 -- stored in the translator database. This phase means generating all
alpar@9 725 -- variables, constraints, and objectives, executing check and display
alpar@9 726 -- statements, which precede the solve statement (if it is presented),
alpar@9 727 -- and building the problem instance.
alpar@9 728 --
alpar@9 729 -- The character string file specifies the name of output text file, to
alpar@9 730 -- which output produced by display statements should be written. It is
alpar@9 731 -- allowed to specify NULL, in which case the output goes to stdout via
alpar@9 732 -- the routine print.
alpar@9 733 --
alpar@9 734 -- This routine should be called once after the routine mpl_read_model
alpar@9 735 -- or mpl_read_data and if one of the latters returned the code 2.
alpar@9 736 --
alpar@9 737 -- *Returns*
alpar@9 738 --
alpar@9 739 -- The routine mpl_generate returns one of the following codes:
alpar@9 740 --
alpar@9 741 -- 3 - model has been successfully generated. In this case the calling
alpar@9 742 -- program may call other api routines to obtain components of the
alpar@9 743 -- problem instance from the translator database.
alpar@9 744 -- 4 - processing failed due to some errors. In this case the calling
alpar@9 745 -- program should call the routine mpl_terminate to terminate model
alpar@9 746 -- processing. */
alpar@9 747
alpar@9 748 int mpl_generate(MPL *mpl, char *file)
alpar@9 749 { if (!(mpl->phase == 1 || mpl->phase == 2))
alpar@9 750 xfault("mpl_generate: invalid call sequence\n");
alpar@9 751 /* set up error handler */
alpar@9 752 if (setjmp(mpl->jump)) goto done;
alpar@9 753 /* generate model */
alpar@9 754 mpl->phase = 3;
alpar@9 755 open_output(mpl, file);
alpar@9 756 generate_model(mpl);
alpar@9 757 flush_output(mpl);
alpar@9 758 /* build problem instance */
alpar@9 759 build_problem(mpl);
alpar@9 760 /* generation phase has been finished */
alpar@9 761 xprintf("Model has been successfully generated\n");
alpar@9 762 done: /* return to the calling program */
alpar@9 763 return mpl->phase;
alpar@9 764 }
alpar@9 765
alpar@9 766 /*----------------------------------------------------------------------
alpar@9 767 -- mpl_get_prob_name - obtain problem (model) name.
alpar@9 768 --
alpar@9 769 -- *Synopsis*
alpar@9 770 --
alpar@9 771 -- #include "glpmpl.h"
alpar@9 772 -- char *mpl_get_prob_name(MPL *mpl);
alpar@9 773 --
alpar@9 774 -- *Returns*
alpar@9 775 --
alpar@9 776 -- The routine mpl_get_prob_name returns a pointer to internal buffer,
alpar@9 777 -- which contains symbolic name of the problem (model).
alpar@9 778 --
alpar@9 779 -- *Note*
alpar@9 780 --
alpar@9 781 -- Currently MathProg has no feature to assign a symbolic name to the
alpar@9 782 -- model. Therefore the routine mpl_get_prob_name tries to construct
alpar@9 783 -- such name using the name of input text file containing model section,
alpar@9 784 -- although this is not a good idea (due to portability problems). */
alpar@9 785
alpar@9 786 char *mpl_get_prob_name(MPL *mpl)
alpar@9 787 { char *name = mpl->mpl_buf;
alpar@9 788 char *file = mpl->mod_file;
alpar@9 789 int k;
alpar@9 790 if (mpl->phase != 3)
alpar@9 791 xfault("mpl_get_prob_name: invalid call sequence\n");
alpar@9 792 for (;;)
alpar@9 793 { if (strchr(file, '/') != NULL)
alpar@9 794 file = strchr(file, '/') + 1;
alpar@9 795 else if (strchr(file, '\\') != NULL)
alpar@9 796 file = strchr(file, '\\') + 1;
alpar@9 797 else if (strchr(file, ':') != NULL)
alpar@9 798 file = strchr(file, ':') + 1;
alpar@9 799 else
alpar@9 800 break;
alpar@9 801 }
alpar@9 802 for (k = 0; ; k++)
alpar@9 803 { if (k == 255) break;
alpar@9 804 if (!(isalnum((unsigned char)*file) || *file == '_')) break;
alpar@9 805 name[k] = *file++;
alpar@9 806 }
alpar@9 807 if (k == 0)
alpar@9 808 strcpy(name, "Unknown");
alpar@9 809 else
alpar@9 810 name[k] = '\0';
alpar@9 811 xassert(strlen(name) <= 255);
alpar@9 812 return name;
alpar@9 813 }
alpar@9 814
alpar@9 815 /*----------------------------------------------------------------------
alpar@9 816 -- mpl_get_num_rows - determine number of rows.
alpar@9 817 --
alpar@9 818 -- *Synopsis*
alpar@9 819 --
alpar@9 820 -- #include "glpmpl.h"
alpar@9 821 -- int mpl_get_num_rows(MPL *mpl);
alpar@9 822 --
alpar@9 823 -- *Returns*
alpar@9 824 --
alpar@9 825 -- The routine mpl_get_num_rows returns total number of rows in the
alpar@9 826 -- problem, where each row is an individual constraint or objective. */
alpar@9 827
alpar@9 828 int mpl_get_num_rows(MPL *mpl)
alpar@9 829 { if (mpl->phase != 3)
alpar@9 830 xfault("mpl_get_num_rows: invalid call sequence\n");
alpar@9 831 return mpl->m;
alpar@9 832 }
alpar@9 833
alpar@9 834 /*----------------------------------------------------------------------
alpar@9 835 -- mpl_get_num_cols - determine number of columns.
alpar@9 836 --
alpar@9 837 -- *Synopsis*
alpar@9 838 --
alpar@9 839 -- #include "glpmpl.h"
alpar@9 840 -- int mpl_get_num_cols(MPL *mpl);
alpar@9 841 --
alpar@9 842 -- *Returns*
alpar@9 843 --
alpar@9 844 -- The routine mpl_get_num_cols returns total number of columns in the
alpar@9 845 -- problem, where each column is an individual variable. */
alpar@9 846
alpar@9 847 int mpl_get_num_cols(MPL *mpl)
alpar@9 848 { if (mpl->phase != 3)
alpar@9 849 xfault("mpl_get_num_cols: invalid call sequence\n");
alpar@9 850 return mpl->n;
alpar@9 851 }
alpar@9 852
alpar@9 853 /*----------------------------------------------------------------------
alpar@9 854 -- mpl_get_row_name - obtain row name.
alpar@9 855 --
alpar@9 856 -- *Synopsis*
alpar@9 857 --
alpar@9 858 -- #include "glpmpl.h"
alpar@9 859 -- char *mpl_get_row_name(MPL *mpl, int i);
alpar@9 860 --
alpar@9 861 -- *Returns*
alpar@9 862 --
alpar@9 863 -- The routine mpl_get_row_name returns a pointer to internal buffer,
alpar@9 864 -- which contains symbolic name of i-th row of the problem. */
alpar@9 865
alpar@9 866 char *mpl_get_row_name(MPL *mpl, int i)
alpar@9 867 { char *name = mpl->mpl_buf, *t;
alpar@9 868 int len;
alpar@9 869 if (mpl->phase != 3)
alpar@9 870 xfault("mpl_get_row_name: invalid call sequence\n");
alpar@9 871 if (!(1 <= i && i <= mpl->m))
alpar@9 872 xfault("mpl_get_row_name: i = %d; row number out of range\n",
alpar@9 873 i);
alpar@9 874 strcpy(name, mpl->row[i]->con->name);
alpar@9 875 len = strlen(name);
alpar@9 876 xassert(len <= 255);
alpar@9 877 t = format_tuple(mpl, '[', mpl->row[i]->memb->tuple);
alpar@9 878 while (*t)
alpar@9 879 { if (len == 255) break;
alpar@9 880 name[len++] = *t++;
alpar@9 881 }
alpar@9 882 name[len] = '\0';
alpar@9 883 if (len == 255) strcpy(name+252, "...");
alpar@9 884 xassert(strlen(name) <= 255);
alpar@9 885 return name;
alpar@9 886 }
alpar@9 887
alpar@9 888 /*----------------------------------------------------------------------
alpar@9 889 -- mpl_get_row_kind - determine row kind.
alpar@9 890 --
alpar@9 891 -- *Synopsis*
alpar@9 892 --
alpar@9 893 -- #include "glpmpl.h"
alpar@9 894 -- int mpl_get_row_kind(MPL *mpl, int i);
alpar@9 895 --
alpar@9 896 -- *Returns*
alpar@9 897 --
alpar@9 898 -- The routine mpl_get_row_kind returns the kind of i-th row, which can
alpar@9 899 -- be one of the following:
alpar@9 900 --
alpar@9 901 -- MPL_ST - non-free (constraint) row;
alpar@9 902 -- MPL_MIN - free (objective) row to be minimized;
alpar@9 903 -- MPL_MAX - free (objective) row to be maximized. */
alpar@9 904
alpar@9 905 int mpl_get_row_kind(MPL *mpl, int i)
alpar@9 906 { int kind;
alpar@9 907 if (mpl->phase != 3)
alpar@9 908 xfault("mpl_get_row_kind: invalid call sequence\n");
alpar@9 909 if (!(1 <= i && i <= mpl->m))
alpar@9 910 xfault("mpl_get_row_kind: i = %d; row number out of range\n",
alpar@9 911 i);
alpar@9 912 switch (mpl->row[i]->con->type)
alpar@9 913 { case A_CONSTRAINT:
alpar@9 914 kind = MPL_ST; break;
alpar@9 915 case A_MINIMIZE:
alpar@9 916 kind = MPL_MIN; break;
alpar@9 917 case A_MAXIMIZE:
alpar@9 918 kind = MPL_MAX; break;
alpar@9 919 default:
alpar@9 920 xassert(mpl != mpl);
alpar@9 921 }
alpar@9 922 return kind;
alpar@9 923 }
alpar@9 924
alpar@9 925 /*----------------------------------------------------------------------
alpar@9 926 -- mpl_get_row_bnds - obtain row bounds.
alpar@9 927 --
alpar@9 928 -- *Synopsis*
alpar@9 929 --
alpar@9 930 -- #include "glpmpl.h"
alpar@9 931 -- int mpl_get_row_bnds(MPL *mpl, int i, double *lb, double *ub);
alpar@9 932 --
alpar@9 933 -- *Description*
alpar@9 934 --
alpar@9 935 -- The routine mpl_get_row_bnds stores lower and upper bounds of i-th
alpar@9 936 -- row of the problem to the locations, which the parameters lb and ub
alpar@9 937 -- point to, respectively. Besides the routine returns the type of the
alpar@9 938 -- i-th row.
alpar@9 939 --
alpar@9 940 -- If some of the parameters lb and ub is NULL, the corresponding bound
alpar@9 941 -- value is not stored.
alpar@9 942 --
alpar@9 943 -- Types and bounds have the following meaning:
alpar@9 944 --
alpar@9 945 -- Type Bounds Note
alpar@9 946 -- -----------------------------------------------------------
alpar@9 947 -- MPL_FR -inf < f(x) < +inf Free linear form
alpar@9 948 -- MPL_LO lb <= f(x) < +inf Inequality f(x) >= lb
alpar@9 949 -- MPL_UP -inf < f(x) <= ub Inequality f(x) <= ub
alpar@9 950 -- MPL_DB lb <= f(x) <= ub Inequality lb <= f(x) <= ub
alpar@9 951 -- MPL_FX f(x) = lb Equality f(x) = lb
alpar@9 952 --
alpar@9 953 -- where f(x) is the corresponding linear form of the i-th row.
alpar@9 954 --
alpar@9 955 -- If the row has no lower bound, *lb is set to zero; if the row has
alpar@9 956 -- no upper bound, *ub is set to zero; and if the row is of fixed type,
alpar@9 957 -- both *lb and *ub are set to the same value.
alpar@9 958 --
alpar@9 959 -- *Returns*
alpar@9 960 --
alpar@9 961 -- The routine returns the type of the i-th row as it is stated in the
alpar@9 962 -- table above. */
alpar@9 963
alpar@9 964 int mpl_get_row_bnds(MPL *mpl, int i, double *_lb, double *_ub)
alpar@9 965 { ELEMCON *con;
alpar@9 966 int type;
alpar@9 967 double lb, ub;
alpar@9 968 if (mpl->phase != 3)
alpar@9 969 xfault("mpl_get_row_bnds: invalid call sequence\n");
alpar@9 970 if (!(1 <= i && i <= mpl->m))
alpar@9 971 xfault("mpl_get_row_bnds: i = %d; row number out of range\n",
alpar@9 972 i);
alpar@9 973 con = mpl->row[i];
alpar@9 974 #if 0 /* 21/VII-2006 */
alpar@9 975 if (con->con->lbnd == NULL && con->con->ubnd == NULL)
alpar@9 976 type = MPL_FR, lb = ub = 0.0;
alpar@9 977 else if (con->con->ubnd == NULL)
alpar@9 978 type = MPL_LO, lb = con->lbnd, ub = 0.0;
alpar@9 979 else if (con->con->lbnd == NULL)
alpar@9 980 type = MPL_UP, lb = 0.0, ub = con->ubnd;
alpar@9 981 else if (con->con->lbnd != con->con->ubnd)
alpar@9 982 type = MPL_DB, lb = con->lbnd, ub = con->ubnd;
alpar@9 983 else
alpar@9 984 type = MPL_FX, lb = ub = con->lbnd;
alpar@9 985 #else
alpar@9 986 lb = (con->con->lbnd == NULL ? -DBL_MAX : con->lbnd);
alpar@9 987 ub = (con->con->ubnd == NULL ? +DBL_MAX : con->ubnd);
alpar@9 988 if (lb == -DBL_MAX && ub == +DBL_MAX)
alpar@9 989 type = MPL_FR, lb = ub = 0.0;
alpar@9 990 else if (ub == +DBL_MAX)
alpar@9 991 type = MPL_LO, ub = 0.0;
alpar@9 992 else if (lb == -DBL_MAX)
alpar@9 993 type = MPL_UP, lb = 0.0;
alpar@9 994 else if (con->con->lbnd != con->con->ubnd)
alpar@9 995 type = MPL_DB;
alpar@9 996 else
alpar@9 997 type = MPL_FX;
alpar@9 998 #endif
alpar@9 999 if (_lb != NULL) *_lb = lb;
alpar@9 1000 if (_ub != NULL) *_ub = ub;
alpar@9 1001 return type;
alpar@9 1002 }
alpar@9 1003
alpar@9 1004 /*----------------------------------------------------------------------
alpar@9 1005 -- mpl_get_mat_row - obtain row of the constraint matrix.
alpar@9 1006 --
alpar@9 1007 -- *Synopsis*
alpar@9 1008 --
alpar@9 1009 -- #include "glpmpl.h"
alpar@9 1010 -- int mpl_get_mat_row(MPL *mpl, int i, int ndx[], double val[]);
alpar@9 1011 --
alpar@9 1012 -- *Description*
alpar@9 1013 --
alpar@9 1014 -- The routine mpl_get_mat_row stores column indices and numeric values
alpar@9 1015 -- of constraint coefficients for the i-th row to locations ndx[1], ...,
alpar@9 1016 -- ndx[len] and val[1], ..., val[len], respectively, where 0 <= len <= n
alpar@9 1017 -- is number of (structural) non-zero constraint coefficients, and n is
alpar@9 1018 -- number of columns in the problem.
alpar@9 1019 --
alpar@9 1020 -- If the parameter ndx is NULL, column indices are not stored. If the
alpar@9 1021 -- parameter val is NULL, numeric values are not stored.
alpar@9 1022 --
alpar@9 1023 -- Note that free rows may have constant terms, which are not part of
alpar@9 1024 -- the constraint matrix and therefore not reported by this routine. The
alpar@9 1025 -- constant term of a particular row can be obtained, if necessary, via
alpar@9 1026 -- the routine mpl_get_row_c0.
alpar@9 1027 --
alpar@9 1028 -- *Returns*
alpar@9 1029 --
alpar@9 1030 -- The routine mpl_get_mat_row returns len, which is length of i-th row
alpar@9 1031 -- of the constraint matrix (i.e. number of non-zero coefficients). */
alpar@9 1032
alpar@9 1033 int mpl_get_mat_row(MPL *mpl, int i, int ndx[], double val[])
alpar@9 1034 { FORMULA *term;
alpar@9 1035 int len = 0;
alpar@9 1036 if (mpl->phase != 3)
alpar@9 1037 xfault("mpl_get_mat_row: invalid call sequence\n");
alpar@9 1038 if (!(1 <= i && i <= mpl->m))
alpar@9 1039 xfault("mpl_get_mat_row: i = %d; row number out of range\n",
alpar@9 1040 i);
alpar@9 1041 for (term = mpl->row[i]->form; term != NULL; term = term->next)
alpar@9 1042 { xassert(term->var != NULL);
alpar@9 1043 len++;
alpar@9 1044 xassert(len <= mpl->n);
alpar@9 1045 if (ndx != NULL) ndx[len] = term->var->j;
alpar@9 1046 if (val != NULL) val[len] = term->coef;
alpar@9 1047 }
alpar@9 1048 return len;
alpar@9 1049 }
alpar@9 1050
alpar@9 1051 /*----------------------------------------------------------------------
alpar@9 1052 -- mpl_get_row_c0 - obtain constant term of free row.
alpar@9 1053 --
alpar@9 1054 -- *Synopsis*
alpar@9 1055 --
alpar@9 1056 -- #include "glpmpl.h"
alpar@9 1057 -- double mpl_get_row_c0(MPL *mpl, int i);
alpar@9 1058 --
alpar@9 1059 -- *Returns*
alpar@9 1060 --
alpar@9 1061 -- The routine mpl_get_row_c0 returns numeric value of constant term of
alpar@9 1062 -- i-th row.
alpar@9 1063 --
alpar@9 1064 -- Note that only free rows may have non-zero constant terms. Therefore
alpar@9 1065 -- if i-th row is not free, the routine returns zero. */
alpar@9 1066
alpar@9 1067 double mpl_get_row_c0(MPL *mpl, int i)
alpar@9 1068 { ELEMCON *con;
alpar@9 1069 double c0;
alpar@9 1070 if (mpl->phase != 3)
alpar@9 1071 xfault("mpl_get_row_c0: invalid call sequence\n");
alpar@9 1072 if (!(1 <= i && i <= mpl->m))
alpar@9 1073 xfault("mpl_get_row_c0: i = %d; row number out of range\n",
alpar@9 1074 i);
alpar@9 1075 con = mpl->row[i];
alpar@9 1076 if (con->con->lbnd == NULL && con->con->ubnd == NULL)
alpar@9 1077 c0 = - con->lbnd;
alpar@9 1078 else
alpar@9 1079 c0 = 0.0;
alpar@9 1080 return c0;
alpar@9 1081 }
alpar@9 1082
alpar@9 1083 /*----------------------------------------------------------------------
alpar@9 1084 -- mpl_get_col_name - obtain column name.
alpar@9 1085 --
alpar@9 1086 -- *Synopsis*
alpar@9 1087 --
alpar@9 1088 -- #include "glpmpl.h"
alpar@9 1089 -- char *mpl_get_col_name(MPL *mpl, int j);
alpar@9 1090 --
alpar@9 1091 -- *Returns*
alpar@9 1092 --
alpar@9 1093 -- The routine mpl_get_col_name returns a pointer to internal buffer,
alpar@9 1094 -- which contains symbolic name of j-th column of the problem. */
alpar@9 1095
alpar@9 1096 char *mpl_get_col_name(MPL *mpl, int j)
alpar@9 1097 { char *name = mpl->mpl_buf, *t;
alpar@9 1098 int len;
alpar@9 1099 if (mpl->phase != 3)
alpar@9 1100 xfault("mpl_get_col_name: invalid call sequence\n");
alpar@9 1101 if (!(1 <= j && j <= mpl->n))
alpar@9 1102 xfault("mpl_get_col_name: j = %d; column number out of range\n"
alpar@9 1103 , j);
alpar@9 1104 strcpy(name, mpl->col[j]->var->name);
alpar@9 1105 len = strlen(name);
alpar@9 1106 xassert(len <= 255);
alpar@9 1107 t = format_tuple(mpl, '[', mpl->col[j]->memb->tuple);
alpar@9 1108 while (*t)
alpar@9 1109 { if (len == 255) break;
alpar@9 1110 name[len++] = *t++;
alpar@9 1111 }
alpar@9 1112 name[len] = '\0';
alpar@9 1113 if (len == 255) strcpy(name+252, "...");
alpar@9 1114 xassert(strlen(name) <= 255);
alpar@9 1115 return name;
alpar@9 1116 }
alpar@9 1117
alpar@9 1118 /*----------------------------------------------------------------------
alpar@9 1119 -- mpl_get_col_kind - determine column kind.
alpar@9 1120 --
alpar@9 1121 -- *Synopsis*
alpar@9 1122 --
alpar@9 1123 -- #include "glpmpl.h"
alpar@9 1124 -- int mpl_get_col_kind(MPL *mpl, int j);
alpar@9 1125 --
alpar@9 1126 -- *Returns*
alpar@9 1127 --
alpar@9 1128 -- The routine mpl_get_col_kind returns the kind of j-th column, which
alpar@9 1129 -- can be one of the following:
alpar@9 1130 --
alpar@9 1131 -- MPL_NUM - continuous variable;
alpar@9 1132 -- MPL_INT - integer variable;
alpar@9 1133 -- MPL_BIN - binary variable.
alpar@9 1134 --
alpar@9 1135 -- Note that column kinds are defined independently on type and bounds
alpar@9 1136 -- (reported by the routine mpl_get_col_bnds) of corresponding columns.
alpar@9 1137 -- This means, in particular, that bounds of an integer column may be
alpar@9 1138 -- fractional, or a binary column may have lower and upper bounds that
alpar@9 1139 -- are not 0 and 1 (or it may have no lower/upper bound at all). */
alpar@9 1140
alpar@9 1141 int mpl_get_col_kind(MPL *mpl, int j)
alpar@9 1142 { int kind;
alpar@9 1143 if (mpl->phase != 3)
alpar@9 1144 xfault("mpl_get_col_kind: invalid call sequence\n");
alpar@9 1145 if (!(1 <= j && j <= mpl->n))
alpar@9 1146 xfault("mpl_get_col_kind: j = %d; column number out of range\n"
alpar@9 1147 , j);
alpar@9 1148 switch (mpl->col[j]->var->type)
alpar@9 1149 { case A_NUMERIC:
alpar@9 1150 kind = MPL_NUM; break;
alpar@9 1151 case A_INTEGER:
alpar@9 1152 kind = MPL_INT; break;
alpar@9 1153 case A_BINARY:
alpar@9 1154 kind = MPL_BIN; break;
alpar@9 1155 default:
alpar@9 1156 xassert(mpl != mpl);
alpar@9 1157 }
alpar@9 1158 return kind;
alpar@9 1159 }
alpar@9 1160
alpar@9 1161 /*----------------------------------------------------------------------
alpar@9 1162 -- mpl_get_col_bnds - obtain column bounds.
alpar@9 1163 --
alpar@9 1164 -- *Synopsis*
alpar@9 1165 --
alpar@9 1166 -- #include "glpmpl.h"
alpar@9 1167 -- int mpl_get_col_bnds(MPL *mpl, int j, double *lb, double *ub);
alpar@9 1168 --
alpar@9 1169 -- *Description*
alpar@9 1170 --
alpar@9 1171 -- The routine mpl_get_col_bnds stores lower and upper bound of j-th
alpar@9 1172 -- column of the problem to the locations, which the parameters lb and
alpar@9 1173 -- ub point to, respectively. Besides the routine returns the type of
alpar@9 1174 -- the j-th column.
alpar@9 1175 --
alpar@9 1176 -- If some of the parameters lb and ub is NULL, the corresponding bound
alpar@9 1177 -- value is not stored.
alpar@9 1178 --
alpar@9 1179 -- Types and bounds have the following meaning:
alpar@9 1180 --
alpar@9 1181 -- Type Bounds Note
alpar@9 1182 -- ------------------------------------------------------
alpar@9 1183 -- MPL_FR -inf < x < +inf Free (unbounded) variable
alpar@9 1184 -- MPL_LO lb <= x < +inf Variable with lower bound
alpar@9 1185 -- MPL_UP -inf < x <= ub Variable with upper bound
alpar@9 1186 -- MPL_DB lb <= x <= ub Double-bounded variable
alpar@9 1187 -- MPL_FX x = lb Fixed variable
alpar@9 1188 --
alpar@9 1189 -- where x is individual variable corresponding to the j-th column.
alpar@9 1190 --
alpar@9 1191 -- If the column has no lower bound, *lb is set to zero; if the column
alpar@9 1192 -- has no upper bound, *ub is set to zero; and if the column is of fixed
alpar@9 1193 -- type, both *lb and *ub are set to the same value.
alpar@9 1194 --
alpar@9 1195 -- *Returns*
alpar@9 1196 --
alpar@9 1197 -- The routine returns the type of the j-th column as it is stated in
alpar@9 1198 -- the table above. */
alpar@9 1199
alpar@9 1200 int mpl_get_col_bnds(MPL *mpl, int j, double *_lb, double *_ub)
alpar@9 1201 { ELEMVAR *var;
alpar@9 1202 int type;
alpar@9 1203 double lb, ub;
alpar@9 1204 if (mpl->phase != 3)
alpar@9 1205 xfault("mpl_get_col_bnds: invalid call sequence\n");
alpar@9 1206 if (!(1 <= j && j <= mpl->n))
alpar@9 1207 xfault("mpl_get_col_bnds: j = %d; column number out of range\n"
alpar@9 1208 , j);
alpar@9 1209 var = mpl->col[j];
alpar@9 1210 #if 0 /* 21/VII-2006 */
alpar@9 1211 if (var->var->lbnd == NULL && var->var->ubnd == NULL)
alpar@9 1212 type = MPL_FR, lb = ub = 0.0;
alpar@9 1213 else if (var->var->ubnd == NULL)
alpar@9 1214 type = MPL_LO, lb = var->lbnd, ub = 0.0;
alpar@9 1215 else if (var->var->lbnd == NULL)
alpar@9 1216 type = MPL_UP, lb = 0.0, ub = var->ubnd;
alpar@9 1217 else if (var->var->lbnd != var->var->ubnd)
alpar@9 1218 type = MPL_DB, lb = var->lbnd, ub = var->ubnd;
alpar@9 1219 else
alpar@9 1220 type = MPL_FX, lb = ub = var->lbnd;
alpar@9 1221 #else
alpar@9 1222 lb = (var->var->lbnd == NULL ? -DBL_MAX : var->lbnd);
alpar@9 1223 ub = (var->var->ubnd == NULL ? +DBL_MAX : var->ubnd);
alpar@9 1224 if (lb == -DBL_MAX && ub == +DBL_MAX)
alpar@9 1225 type = MPL_FR, lb = ub = 0.0;
alpar@9 1226 else if (ub == +DBL_MAX)
alpar@9 1227 type = MPL_LO, ub = 0.0;
alpar@9 1228 else if (lb == -DBL_MAX)
alpar@9 1229 type = MPL_UP, lb = 0.0;
alpar@9 1230 else if (var->var->lbnd != var->var->ubnd)
alpar@9 1231 type = MPL_DB;
alpar@9 1232 else
alpar@9 1233 type = MPL_FX;
alpar@9 1234 #endif
alpar@9 1235 if (_lb != NULL) *_lb = lb;
alpar@9 1236 if (_ub != NULL) *_ub = ub;
alpar@9 1237 return type;
alpar@9 1238 }
alpar@9 1239
alpar@9 1240 /*----------------------------------------------------------------------
alpar@9 1241 -- mpl_has_solve_stmt - check if model has solve statement.
alpar@9 1242 --
alpar@9 1243 -- *Synopsis*
alpar@9 1244 --
alpar@9 1245 -- #include "glpmpl.h"
alpar@9 1246 -- int mpl_has_solve_stmt(MPL *mpl);
alpar@9 1247 --
alpar@9 1248 -- *Returns*
alpar@9 1249 --
alpar@9 1250 -- If the model has the solve statement, the routine returns non-zero,
alpar@9 1251 -- otherwise zero is returned. */
alpar@9 1252
alpar@9 1253 int mpl_has_solve_stmt(MPL *mpl)
alpar@9 1254 { if (mpl->phase != 3)
alpar@9 1255 xfault("mpl_has_solve_stmt: invalid call sequence\n");
alpar@9 1256 return mpl->flag_s;
alpar@9 1257 }
alpar@9 1258
alpar@9 1259 #if 1 /* 15/V-2010 */
alpar@9 1260 void mpl_put_row_soln(MPL *mpl, int i, int stat, double prim,
alpar@9 1261 double dual)
alpar@9 1262 { /* store row (constraint/objective) solution components */
alpar@9 1263 xassert(mpl->phase == 3);
alpar@9 1264 xassert(1 <= i && i <= mpl->m);
alpar@9 1265 mpl->row[i]->stat = stat;
alpar@9 1266 mpl->row[i]->prim = prim;
alpar@9 1267 mpl->row[i]->dual = dual;
alpar@9 1268 return;
alpar@9 1269 }
alpar@9 1270 #endif
alpar@9 1271
alpar@9 1272 #if 1 /* 15/V-2010 */
alpar@9 1273 void mpl_put_col_soln(MPL *mpl, int j, int stat, double prim,
alpar@9 1274 double dual)
alpar@9 1275 { /* store column (variable) solution components */
alpar@9 1276 xassert(mpl->phase == 3);
alpar@9 1277 xassert(1 <= j && j <= mpl->n);
alpar@9 1278 mpl->col[j]->stat = stat;
alpar@9 1279 mpl->col[j]->prim = prim;
alpar@9 1280 mpl->col[j]->dual = dual;
alpar@9 1281 return;
alpar@9 1282 }
alpar@9 1283 #endif
alpar@9 1284
alpar@9 1285 #if 0 /* 15/V-2010 */
alpar@9 1286 /*----------------------------------------------------------------------
alpar@9 1287 -- mpl_put_col_value - store column value.
alpar@9 1288 --
alpar@9 1289 -- *Synopsis*
alpar@9 1290 --
alpar@9 1291 -- #include "glpmpl.h"
alpar@9 1292 -- void mpl_put_col_value(MPL *mpl, int j, double val);
alpar@9 1293 --
alpar@9 1294 -- *Description*
alpar@9 1295 --
alpar@9 1296 -- The routine mpl_put_col_value stores numeric value of j-th column
alpar@9 1297 -- into the translator database. It is assumed that the column value is
alpar@9 1298 -- provided by the solver. */
alpar@9 1299
alpar@9 1300 void mpl_put_col_value(MPL *mpl, int j, double val)
alpar@9 1301 { if (mpl->phase != 3)
alpar@9 1302 xfault("mpl_put_col_value: invalid call sequence\n");
alpar@9 1303 if (!(1 <= j && j <= mpl->n))
alpar@9 1304 xfault(
alpar@9 1305 "mpl_put_col_value: j = %d; column number out of range\n", j);
alpar@9 1306 mpl->col[j]->prim = val;
alpar@9 1307 return;
alpar@9 1308 }
alpar@9 1309 #endif
alpar@9 1310
alpar@9 1311 /*----------------------------------------------------------------------
alpar@9 1312 -- mpl_postsolve - postsolve model.
alpar@9 1313 --
alpar@9 1314 -- *Synopsis*
alpar@9 1315 --
alpar@9 1316 -- #include "glpmpl.h"
alpar@9 1317 -- int mpl_postsolve(MPL *mpl);
alpar@9 1318 --
alpar@9 1319 -- *Description*
alpar@9 1320 --
alpar@9 1321 -- The routine mpl_postsolve performs postsolving of the model using
alpar@9 1322 -- its description stored in the translator database. This phase means
alpar@9 1323 -- executing statements, which follow the solve statement.
alpar@9 1324 --
alpar@9 1325 -- If this routine is used, it should be called once after the routine
alpar@9 1326 -- mpl_generate and if the latter returned the code 3.
alpar@9 1327 --
alpar@9 1328 -- *Returns*
alpar@9 1329 --
alpar@9 1330 -- The routine mpl_postsolve returns one of the following codes:
alpar@9 1331 --
alpar@9 1332 -- 3 - model has been successfully postsolved.
alpar@9 1333 -- 4 - processing failed due to some errors. In this case the calling
alpar@9 1334 -- program should call the routine mpl_terminate to terminate model
alpar@9 1335 -- processing. */
alpar@9 1336
alpar@9 1337 int mpl_postsolve(MPL *mpl)
alpar@9 1338 { if (!(mpl->phase == 3 && !mpl->flag_p))
alpar@9 1339 xfault("mpl_postsolve: invalid call sequence\n");
alpar@9 1340 /* set up error handler */
alpar@9 1341 if (setjmp(mpl->jump)) goto done;
alpar@9 1342 /* perform postsolving */
alpar@9 1343 postsolve_model(mpl);
alpar@9 1344 flush_output(mpl);
alpar@9 1345 /* postsolving phase has been finished */
alpar@9 1346 xprintf("Model has been successfully processed\n");
alpar@9 1347 done: /* return to the calling program */
alpar@9 1348 return mpl->phase;
alpar@9 1349 }
alpar@9 1350
alpar@9 1351 /*----------------------------------------------------------------------
alpar@9 1352 -- mpl_terminate - free all resources used by translator.
alpar@9 1353 --
alpar@9 1354 -- *Synopsis*
alpar@9 1355 --
alpar@9 1356 -- #include "glpmpl.h"
alpar@9 1357 -- void mpl_terminate(MPL *mpl);
alpar@9 1358 --
alpar@9 1359 -- *Description*
alpar@9 1360 --
alpar@9 1361 -- The routine mpl_terminate frees all the resources used by the GNU
alpar@9 1362 -- MathProg translator. */
alpar@9 1363
alpar@9 1364 void mpl_terminate(MPL *mpl)
alpar@9 1365 { if (setjmp(mpl->jump)) xassert(mpl != mpl);
alpar@9 1366 switch (mpl->phase)
alpar@9 1367 { case 0:
alpar@9 1368 case 1:
alpar@9 1369 case 2:
alpar@9 1370 case 3:
alpar@9 1371 /* there were no errors; clean the model content */
alpar@9 1372 clean_model(mpl);
alpar@9 1373 xassert(mpl->a_list == NULL);
alpar@9 1374 #if 1 /* 11/II-2008 */
alpar@9 1375 xassert(mpl->dca == NULL);
alpar@9 1376 #endif
alpar@9 1377 break;
alpar@9 1378 case 4:
alpar@9 1379 /* model processing has been finished due to error; delete
alpar@9 1380 search trees, which may be created for some arrays */
alpar@9 1381 { ARRAY *a;
alpar@9 1382 for (a = mpl->a_list; a != NULL; a = a->next)
alpar@9 1383 if (a->tree != NULL) avl_delete_tree(a->tree);
alpar@9 1384 }
alpar@9 1385 #if 1 /* 11/II-2008 */
alpar@9 1386 free_dca(mpl);
alpar@9 1387 #endif
alpar@9 1388 break;
alpar@9 1389 default:
alpar@9 1390 xassert(mpl != mpl);
alpar@9 1391 }
alpar@9 1392 /* delete the translator database */
alpar@9 1393 xfree(mpl->image);
alpar@9 1394 xfree(mpl->b_image);
alpar@9 1395 xfree(mpl->f_image);
alpar@9 1396 xfree(mpl->context);
alpar@9 1397 dmp_delete_pool(mpl->pool);
alpar@9 1398 avl_delete_tree(mpl->tree);
alpar@9 1399 dmp_delete_pool(mpl->strings);
alpar@9 1400 dmp_delete_pool(mpl->symbols);
alpar@9 1401 dmp_delete_pool(mpl->tuples);
alpar@9 1402 dmp_delete_pool(mpl->arrays);
alpar@9 1403 dmp_delete_pool(mpl->members);
alpar@9 1404 dmp_delete_pool(mpl->elemvars);
alpar@9 1405 dmp_delete_pool(mpl->formulae);
alpar@9 1406 dmp_delete_pool(mpl->elemcons);
alpar@9 1407 xfree(mpl->sym_buf);
alpar@9 1408 xfree(mpl->tup_buf);
alpar@9 1409 rng_delete_rand(mpl->rand);
alpar@9 1410 if (mpl->row != NULL) xfree(mpl->row);
alpar@9 1411 if (mpl->col != NULL) xfree(mpl->col);
alpar@9 1412 if (mpl->in_fp != NULL) xfclose(mpl->in_fp);
alpar@9 1413 if (mpl->out_fp != NULL && mpl->out_fp != (void *)stdout)
alpar@9 1414 xfclose(mpl->out_fp);
alpar@9 1415 if (mpl->out_file != NULL) xfree(mpl->out_file);
alpar@9 1416 if (mpl->prt_fp != NULL) xfclose(mpl->prt_fp);
alpar@9 1417 if (mpl->prt_file != NULL) xfree(mpl->prt_file);
alpar@9 1418 if (mpl->mod_file != NULL) xfree(mpl->mod_file);
alpar@9 1419 xfree(mpl->mpl_buf);
alpar@9 1420 xfree(mpl);
alpar@9 1421 return;
alpar@9 1422 }
alpar@9 1423
alpar@9 1424 /* eof */