src/glpmpl04.c
changeset 1 c445c931472f
     1.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
     1.2 +++ b/src/glpmpl04.c	Mon Dec 06 13:09:21 2010 +0100
     1.3 @@ -0,0 +1,1424 @@
     1.4 +/* glpmpl04.c */
     1.5 +
     1.6 +/***********************************************************************
     1.7 +*  This code is part of GLPK (GNU Linear Programming Kit).
     1.8 +*
     1.9 +*  Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008,
    1.10 +*  2009, 2010 Andrew Makhorin, Department for Applied Informatics,
    1.11 +*  Moscow Aviation Institute, Moscow, Russia. All rights reserved.
    1.12 +*  E-mail: <mao@gnu.org>.
    1.13 +*
    1.14 +*  GLPK is free software: you can redistribute it and/or modify it
    1.15 +*  under the terms of the GNU General Public License as published by
    1.16 +*  the Free Software Foundation, either version 3 of the License, or
    1.17 +*  (at your option) any later version.
    1.18 +*
    1.19 +*  GLPK is distributed in the hope that it will be useful, but WITHOUT
    1.20 +*  ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
    1.21 +*  or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public
    1.22 +*  License for more details.
    1.23 +*
    1.24 +*  You should have received a copy of the GNU General Public License
    1.25 +*  along with GLPK. If not, see <http://www.gnu.org/licenses/>.
    1.26 +***********************************************************************/
    1.27 +
    1.28 +#define _GLPSTD_ERRNO
    1.29 +#define _GLPSTD_STDIO
    1.30 +#include "glpmpl.h"
    1.31 +#define xfault xerror
    1.32 +#define dmp_create_poolx(size) dmp_create_pool()
    1.33 +
    1.34 +/**********************************************************************/
    1.35 +/* * *              GENERATING AND POSTSOLVING MODEL              * * */
    1.36 +/**********************************************************************/
    1.37 +
    1.38 +/*----------------------------------------------------------------------
    1.39 +-- alloc_content - allocate content arrays for all model objects.
    1.40 +--
    1.41 +-- This routine allocates content arrays for all existing model objects
    1.42 +-- and thereby finalizes creating model.
    1.43 +--
    1.44 +-- This routine must be called immediately after reading model section,
    1.45 +-- i.e. before reading data section or generating model. */
    1.46 +
    1.47 +void alloc_content(MPL *mpl)
    1.48 +{     STATEMENT *stmt;
    1.49 +      /* walk through all model statements */
    1.50 +      for (stmt = mpl->model; stmt != NULL; stmt = stmt->next)
    1.51 +      {  switch (stmt->type)
    1.52 +         {  case A_SET:
    1.53 +               /* model set */
    1.54 +               xassert(stmt->u.set->array == NULL);
    1.55 +               stmt->u.set->array = create_array(mpl, A_ELEMSET,
    1.56 +                  stmt->u.set->dim);
    1.57 +               break;
    1.58 +            case A_PARAMETER:
    1.59 +               /* model parameter */
    1.60 +               xassert(stmt->u.par->array == NULL);
    1.61 +               switch (stmt->u.par->type)
    1.62 +               {  case A_NUMERIC:
    1.63 +                  case A_INTEGER:
    1.64 +                  case A_BINARY:
    1.65 +                     stmt->u.par->array = create_array(mpl, A_NUMERIC,
    1.66 +                        stmt->u.par->dim);
    1.67 +                     break;
    1.68 +                  case A_SYMBOLIC:
    1.69 +                     stmt->u.par->array = create_array(mpl, A_SYMBOLIC,
    1.70 +                        stmt->u.par->dim);
    1.71 +                     break;
    1.72 +                  default:
    1.73 +                     xassert(stmt != stmt);
    1.74 +               }
    1.75 +               break;
    1.76 +            case A_VARIABLE:
    1.77 +               /* model variable */
    1.78 +               xassert(stmt->u.var->array == NULL);
    1.79 +               stmt->u.var->array = create_array(mpl, A_ELEMVAR,
    1.80 +                  stmt->u.var->dim);
    1.81 +               break;
    1.82 +            case A_CONSTRAINT:
    1.83 +               /* model constraint/objective */
    1.84 +               xassert(stmt->u.con->array == NULL);
    1.85 +               stmt->u.con->array = create_array(mpl, A_ELEMCON,
    1.86 +                  stmt->u.con->dim);
    1.87 +               break;
    1.88 +#if 1 /* 11/II-2008 */
    1.89 +            case A_TABLE:
    1.90 +#endif
    1.91 +            case A_SOLVE:
    1.92 +            case A_CHECK:
    1.93 +            case A_DISPLAY:
    1.94 +            case A_PRINTF:
    1.95 +            case A_FOR:
    1.96 +               /* functional statements have no content array */
    1.97 +               break;
    1.98 +            default:
    1.99 +               xassert(stmt != stmt);
   1.100 +         }
   1.101 +      }
   1.102 +      return;
   1.103 +}
   1.104 +
   1.105 +/*----------------------------------------------------------------------
   1.106 +-- generate_model - generate model.
   1.107 +--
   1.108 +-- This routine executes the model statements which precede the solve
   1.109 +-- statement. */
   1.110 +
   1.111 +void generate_model(MPL *mpl)
   1.112 +{     STATEMENT *stmt;
   1.113 +      xassert(!mpl->flag_p);
   1.114 +      for (stmt = mpl->model; stmt != NULL; stmt = stmt->next)
   1.115 +      {  execute_statement(mpl, stmt);
   1.116 +         if (mpl->stmt->type == A_SOLVE) break;
   1.117 +      }
   1.118 +      mpl->stmt = stmt;
   1.119 +      return;
   1.120 +}
   1.121 +
   1.122 +/*----------------------------------------------------------------------
   1.123 +-- build_problem - build problem instance.
   1.124 +--
   1.125 +-- This routine builds lists of rows and columns for problem instance,
   1.126 +-- which corresponds to the generated model. */
   1.127 +
   1.128 +void build_problem(MPL *mpl)
   1.129 +{     STATEMENT *stmt;
   1.130 +      MEMBER *memb;
   1.131 +      VARIABLE *v;
   1.132 +      CONSTRAINT *c;
   1.133 +      FORMULA *t;
   1.134 +      int i, j;
   1.135 +      xassert(mpl->m == 0);
   1.136 +      xassert(mpl->n == 0);
   1.137 +      xassert(mpl->row == NULL);
   1.138 +      xassert(mpl->col == NULL);
   1.139 +      /* check that all elemental variables has zero column numbers */
   1.140 +      for (stmt = mpl->model; stmt != NULL; stmt = stmt->next)
   1.141 +      {  if (stmt->type == A_VARIABLE)
   1.142 +         {  v = stmt->u.var;
   1.143 +            for (memb = v->array->head; memb != NULL; memb = memb->next)
   1.144 +               xassert(memb->value.var->j == 0);
   1.145 +         }
   1.146 +      }
   1.147 +      /* assign row numbers to elemental constraints and objectives */
   1.148 +      for (stmt = mpl->model; stmt != NULL; stmt = stmt->next)
   1.149 +      {  if (stmt->type == A_CONSTRAINT)
   1.150 +         {  c = stmt->u.con;
   1.151 +            for (memb = c->array->head; memb != NULL; memb = memb->next)
   1.152 +            {  xassert(memb->value.con->i == 0);
   1.153 +               memb->value.con->i = ++mpl->m;
   1.154 +               /* walk through linear form and mark elemental variables,
   1.155 +                  which are referenced at least once */
   1.156 +               for (t = memb->value.con->form; t != NULL; t = t->next)
   1.157 +               {  xassert(t->var != NULL);
   1.158 +                  t->var->memb->value.var->j = -1;
   1.159 +               }
   1.160 +            }
   1.161 +         }
   1.162 +      }
   1.163 +      /* assign column numbers to marked elemental variables */
   1.164 +      for (stmt = mpl->model; stmt != NULL; stmt = stmt->next)
   1.165 +      {  if (stmt->type == A_VARIABLE)
   1.166 +         {  v = stmt->u.var;
   1.167 +            for (memb = v->array->head; memb != NULL; memb = memb->next)
   1.168 +               if (memb->value.var->j != 0) memb->value.var->j =
   1.169 +                  ++mpl->n;
   1.170 +         }
   1.171 +      }
   1.172 +      /* build list of rows */
   1.173 +      mpl->row = xcalloc(1+mpl->m, sizeof(ELEMCON *));
   1.174 +      for (i = 1; i <= mpl->m; i++) mpl->row[i] = NULL;
   1.175 +      for (stmt = mpl->model; stmt != NULL; stmt = stmt->next)
   1.176 +      {  if (stmt->type == A_CONSTRAINT)
   1.177 +         {  c = stmt->u.con;
   1.178 +            for (memb = c->array->head; memb != NULL; memb = memb->next)
   1.179 +            {  i = memb->value.con->i;
   1.180 +               xassert(1 <= i && i <= mpl->m);
   1.181 +               xassert(mpl->row[i] == NULL);
   1.182 +               mpl->row[i] = memb->value.con;
   1.183 +            }
   1.184 +         }
   1.185 +      }
   1.186 +      for (i = 1; i <= mpl->m; i++) xassert(mpl->row[i] != NULL);
   1.187 +      /* build list of columns */
   1.188 +      mpl->col = xcalloc(1+mpl->n, sizeof(ELEMVAR *));
   1.189 +      for (j = 1; j <= mpl->n; j++) mpl->col[j] = NULL;
   1.190 +      for (stmt = mpl->model; stmt != NULL; stmt = stmt->next)
   1.191 +      {  if (stmt->type == A_VARIABLE)
   1.192 +         {  v = stmt->u.var;
   1.193 +            for (memb = v->array->head; memb != NULL; memb = memb->next)
   1.194 +            {  j = memb->value.var->j;
   1.195 +               if (j == 0) continue;
   1.196 +               xassert(1 <= j && j <= mpl->n);
   1.197 +               xassert(mpl->col[j] == NULL);
   1.198 +               mpl->col[j] = memb->value.var;
   1.199 +            }
   1.200 +         }
   1.201 +      }
   1.202 +      for (j = 1; j <= mpl->n; j++) xassert(mpl->col[j] != NULL);
   1.203 +      return;
   1.204 +}
   1.205 +
   1.206 +/*----------------------------------------------------------------------
   1.207 +-- postsolve_model - postsolve model.
   1.208 +--
   1.209 +-- This routine executes the model statements which follow the solve
   1.210 +-- statement. */
   1.211 +
   1.212 +void postsolve_model(MPL *mpl)
   1.213 +{     STATEMENT *stmt;
   1.214 +      xassert(!mpl->flag_p);
   1.215 +      mpl->flag_p = 1;
   1.216 +      for (stmt = mpl->stmt; stmt != NULL; stmt = stmt->next)
   1.217 +         execute_statement(mpl, stmt);
   1.218 +      mpl->stmt = NULL;
   1.219 +      return;
   1.220 +}
   1.221 +
   1.222 +/*----------------------------------------------------------------------
   1.223 +-- clean_model - clean model content.
   1.224 +--
   1.225 +-- This routine cleans the model content that assumes deleting all stuff
   1.226 +-- dynamically allocated on generating/postsolving phase.
   1.227 +--
   1.228 +-- Actually cleaning model content is not needed. This function is used
   1.229 +-- mainly to be sure that there were no logical errors on using dynamic
   1.230 +-- memory pools during the generation phase.
   1.231 +--
   1.232 +-- NOTE: This routine must not be called if any errors were detected on
   1.233 +--       the generation phase. */
   1.234 +
   1.235 +void clean_model(MPL *mpl)
   1.236 +{     STATEMENT *stmt;
   1.237 +      for (stmt = mpl->model; stmt != NULL; stmt = stmt->next)
   1.238 +         clean_statement(mpl, stmt);
   1.239 +      /* check that all atoms have been returned to their pools */
   1.240 +      if (dmp_in_use(mpl->strings).lo != 0)
   1.241 +         error(mpl, "internal logic error: %d string segment(s) were lo"
   1.242 +            "st", dmp_in_use(mpl->strings).lo);
   1.243 +      if (dmp_in_use(mpl->symbols).lo != 0)
   1.244 +         error(mpl, "internal logic error: %d symbol(s) were lost",
   1.245 +            dmp_in_use(mpl->symbols).lo);
   1.246 +      if (dmp_in_use(mpl->tuples).lo != 0)
   1.247 +         error(mpl, "internal logic error: %d n-tuple component(s) were"
   1.248 +            " lost", dmp_in_use(mpl->tuples).lo);
   1.249 +      if (dmp_in_use(mpl->arrays).lo != 0)
   1.250 +         error(mpl, "internal logic error: %d array(s) were lost",
   1.251 +            dmp_in_use(mpl->arrays).lo);
   1.252 +      if (dmp_in_use(mpl->members).lo != 0)
   1.253 +         error(mpl, "internal logic error: %d array member(s) were lost"
   1.254 +            , dmp_in_use(mpl->members).lo);
   1.255 +      if (dmp_in_use(mpl->elemvars).lo != 0)
   1.256 +         error(mpl, "internal logic error: %d elemental variable(s) wer"
   1.257 +            "e lost", dmp_in_use(mpl->elemvars).lo);
   1.258 +      if (dmp_in_use(mpl->formulae).lo != 0)
   1.259 +         error(mpl, "internal logic error: %d linear term(s) were lost",
   1.260 +            dmp_in_use(mpl->formulae).lo);
   1.261 +      if (dmp_in_use(mpl->elemcons).lo != 0)
   1.262 +         error(mpl, "internal logic error: %d elemental constraint(s) w"
   1.263 +            "ere lost", dmp_in_use(mpl->elemcons).lo);
   1.264 +      return;
   1.265 +}
   1.266 +
   1.267 +/**********************************************************************/
   1.268 +/* * *                        INPUT/OUTPUT                        * * */
   1.269 +/**********************************************************************/
   1.270 +
   1.271 +/*----------------------------------------------------------------------
   1.272 +-- open_input - open input text file.
   1.273 +--
   1.274 +-- This routine opens the input text file for scanning. */
   1.275 +
   1.276 +void open_input(MPL *mpl, char *file)
   1.277 +{     mpl->line = 0;
   1.278 +      mpl->c = '\n';
   1.279 +      mpl->token = 0;
   1.280 +      mpl->imlen = 0;
   1.281 +      mpl->image[0] = '\0';
   1.282 +      mpl->value = 0.0;
   1.283 +      mpl->b_token = T_EOF;
   1.284 +      mpl->b_imlen = 0;
   1.285 +      mpl->b_image[0] = '\0';
   1.286 +      mpl->b_value = 0.0;
   1.287 +      mpl->f_dots = 0;
   1.288 +      mpl->f_scan = 0;
   1.289 +      mpl->f_token = 0;
   1.290 +      mpl->f_imlen = 0;
   1.291 +      mpl->f_image[0] = '\0';
   1.292 +      mpl->f_value = 0.0;
   1.293 +      memset(mpl->context, ' ', CONTEXT_SIZE);
   1.294 +      mpl->c_ptr = 0;
   1.295 +      xassert(mpl->in_fp == NULL);
   1.296 +      mpl->in_fp = xfopen(file, "r");
   1.297 +      if (mpl->in_fp == NULL)
   1.298 +         error(mpl, "unable to open %s - %s", file, xerrmsg());
   1.299 +      mpl->in_file = file;
   1.300 +      /* scan the very first character */
   1.301 +      get_char(mpl);
   1.302 +      /* scan the very first token */
   1.303 +      get_token(mpl);
   1.304 +      return;
   1.305 +}
   1.306 +
   1.307 +/*----------------------------------------------------------------------
   1.308 +-- read_char - read next character from input text file.
   1.309 +--
   1.310 +-- This routine returns a next ASCII character read from the input text
   1.311 +-- file. If the end of file has been reached, EOF is returned. */
   1.312 +
   1.313 +int read_char(MPL *mpl)
   1.314 +{     int c;
   1.315 +      xassert(mpl->in_fp != NULL);
   1.316 +      c = xfgetc(mpl->in_fp);
   1.317 +      if (c < 0)
   1.318 +      {  if (xferror(mpl->in_fp))
   1.319 +            error(mpl, "read error on %s - %s", mpl->in_file,
   1.320 +               xerrmsg());
   1.321 +         c = EOF;
   1.322 +      }
   1.323 +      return c;
   1.324 +}
   1.325 +
   1.326 +/*----------------------------------------------------------------------
   1.327 +-- close_input - close input text file.
   1.328 +--
   1.329 +-- This routine closes the input text file. */
   1.330 +
   1.331 +void close_input(MPL *mpl)
   1.332 +{     xassert(mpl->in_fp != NULL);
   1.333 +      xfclose(mpl->in_fp);
   1.334 +      mpl->in_fp = NULL;
   1.335 +      mpl->in_file = NULL;
   1.336 +      return;
   1.337 +}
   1.338 +
   1.339 +/*----------------------------------------------------------------------
   1.340 +-- open_output - open output text file.
   1.341 +--
   1.342 +-- This routine opens the output text file for writing data produced by
   1.343 +-- display and printf statements. */
   1.344 +
   1.345 +void open_output(MPL *mpl, char *file)
   1.346 +{     xassert(mpl->out_fp == NULL);
   1.347 +      if (file == NULL)
   1.348 +      {  file = "<stdout>";
   1.349 +         mpl->out_fp = (void *)stdout;
   1.350 +      }
   1.351 +      else
   1.352 +      {  mpl->out_fp = xfopen(file, "w");
   1.353 +         if (mpl->out_fp == NULL)
   1.354 +            error(mpl, "unable to create %s - %s", file, xerrmsg());
   1.355 +      }
   1.356 +      mpl->out_file = xmalloc(strlen(file)+1);
   1.357 +      strcpy(mpl->out_file, file);
   1.358 +      return;
   1.359 +}
   1.360 +
   1.361 +/*----------------------------------------------------------------------
   1.362 +-- write_char - write next character to output text file.
   1.363 +--
   1.364 +-- This routine writes an ASCII character to the output text file. */
   1.365 +
   1.366 +void write_char(MPL *mpl, int c)
   1.367 +{     xassert(mpl->out_fp != NULL);
   1.368 +      if (mpl->out_fp == (void *)stdout)
   1.369 +         xprintf("%c", c);
   1.370 +      else
   1.371 +         xfprintf(mpl->out_fp, "%c", c);
   1.372 +      return;
   1.373 +}
   1.374 +
   1.375 +/*----------------------------------------------------------------------
   1.376 +-- write_text - format and write text to output text file.
   1.377 +--
   1.378 +-- This routine formats a text using the format control string and then
   1.379 +-- writes this text to the output text file. */
   1.380 +
   1.381 +void write_text(MPL *mpl, char *fmt, ...)
   1.382 +{     va_list arg;
   1.383 +      char buf[OUTBUF_SIZE], *c;
   1.384 +      va_start(arg, fmt);
   1.385 +      vsprintf(buf, fmt, arg);
   1.386 +      xassert(strlen(buf) < sizeof(buf));
   1.387 +      va_end(arg);
   1.388 +      for (c = buf; *c != '\0'; c++) write_char(mpl, *c);
   1.389 +      return;
   1.390 +}
   1.391 +
   1.392 +/*----------------------------------------------------------------------
   1.393 +-- flush_output - finalize writing data to output text file.
   1.394 +--
   1.395 +-- This routine finalizes writing data to the output text file. */
   1.396 +
   1.397 +void flush_output(MPL *mpl)
   1.398 +{     xassert(mpl->out_fp != NULL);
   1.399 +      if (mpl->out_fp != (void *)stdout)
   1.400 +      {  xfflush(mpl->out_fp);
   1.401 +         if (xferror(mpl->out_fp))
   1.402 +            error(mpl, "write error on %s - %s", mpl->out_file,
   1.403 +               xerrmsg());
   1.404 +      }
   1.405 +      return;
   1.406 +}
   1.407 +
   1.408 +/**********************************************************************/
   1.409 +/* * *                      SOLVER INTERFACE                      * * */
   1.410 +/**********************************************************************/
   1.411 +
   1.412 +/*----------------------------------------------------------------------
   1.413 +-- error - print error message and terminate model processing.
   1.414 +--
   1.415 +-- This routine formats and prints an error message and then terminates
   1.416 +-- model processing. */
   1.417 +
   1.418 +void error(MPL *mpl, char *fmt, ...)
   1.419 +{     va_list arg;
   1.420 +      char msg[4095+1];
   1.421 +      va_start(arg, fmt);
   1.422 +      vsprintf(msg, fmt, arg);
   1.423 +      xassert(strlen(msg) < sizeof(msg));
   1.424 +      va_end(arg);
   1.425 +      switch (mpl->phase)
   1.426 +      {  case 1:
   1.427 +         case 2:
   1.428 +            /* translation phase */
   1.429 +            xprintf("%s:%d: %s\n",
   1.430 +               mpl->in_file == NULL ? "(unknown)" : mpl->in_file,
   1.431 +               mpl->line, msg);
   1.432 +            print_context(mpl);
   1.433 +            break;
   1.434 +         case 3:
   1.435 +            /* generation/postsolve phase */
   1.436 +            xprintf("%s:%d: %s\n",
   1.437 +               mpl->mod_file == NULL ? "(unknown)" : mpl->mod_file,
   1.438 +               mpl->stmt == NULL ? 0 : mpl->stmt->line, msg);
   1.439 +            break;
   1.440 +         default:
   1.441 +            xassert(mpl != mpl);
   1.442 +      }
   1.443 +      mpl->phase = 4;
   1.444 +      longjmp(mpl->jump, 1);
   1.445 +      /* no return */
   1.446 +}
   1.447 +
   1.448 +/*----------------------------------------------------------------------
   1.449 +-- warning - print warning message and continue model processing.
   1.450 +--
   1.451 +-- This routine formats and prints a warning message and returns to the
   1.452 +-- calling program. */
   1.453 +
   1.454 +void warning(MPL *mpl, char *fmt, ...)
   1.455 +{     va_list arg;
   1.456 +      char msg[4095+1];
   1.457 +      va_start(arg, fmt);
   1.458 +      vsprintf(msg, fmt, arg);
   1.459 +      xassert(strlen(msg) < sizeof(msg));
   1.460 +      va_end(arg);
   1.461 +      switch (mpl->phase)
   1.462 +      {  case 1:
   1.463 +         case 2:
   1.464 +            /* translation phase */
   1.465 +            xprintf("%s:%d: warning: %s\n",
   1.466 +               mpl->in_file == NULL ? "(unknown)" : mpl->in_file,
   1.467 +               mpl->line, msg);
   1.468 +            break;
   1.469 +         case 3:
   1.470 +            /* generation/postsolve phase */
   1.471 +            xprintf("%s:%d: warning: %s\n",
   1.472 +               mpl->mod_file == NULL ? "(unknown)" : mpl->mod_file,
   1.473 +               mpl->stmt == NULL ? 0 : mpl->stmt->line, msg);
   1.474 +            break;
   1.475 +         default:
   1.476 +            xassert(mpl != mpl);
   1.477 +      }
   1.478 +      return;
   1.479 +}
   1.480 +
   1.481 +/*----------------------------------------------------------------------
   1.482 +-- mpl_initialize - create and initialize translator database.
   1.483 +--
   1.484 +-- *Synopsis*
   1.485 +--
   1.486 +-- #include "glpmpl.h"
   1.487 +-- MPL *mpl_initialize(void);
   1.488 +--
   1.489 +-- *Description*
   1.490 +--
   1.491 +-- The routine mpl_initialize creates and initializes the database used
   1.492 +-- by the GNU MathProg translator.
   1.493 +--
   1.494 +-- *Returns*
   1.495 +--
   1.496 +-- The routine returns a pointer to the database created. */
   1.497 +
   1.498 +MPL *mpl_initialize(void)
   1.499 +{     MPL *mpl;
   1.500 +      mpl = xmalloc(sizeof(MPL));
   1.501 +      /* scanning segment */
   1.502 +      mpl->line = 0;
   1.503 +      mpl->c = 0;
   1.504 +      mpl->token = 0;
   1.505 +      mpl->imlen = 0;
   1.506 +      mpl->image = xcalloc(MAX_LENGTH+1, sizeof(char));
   1.507 +      mpl->image[0] = '\0';
   1.508 +      mpl->value = 0.0;
   1.509 +      mpl->b_token = 0;
   1.510 +      mpl->b_imlen = 0;
   1.511 +      mpl->b_image = xcalloc(MAX_LENGTH+1, sizeof(char));
   1.512 +      mpl->b_image[0] = '\0';
   1.513 +      mpl->b_value = 0.0;
   1.514 +      mpl->f_dots = 0;
   1.515 +      mpl->f_scan = 0;
   1.516 +      mpl->f_token = 0;
   1.517 +      mpl->f_imlen = 0;
   1.518 +      mpl->f_image = xcalloc(MAX_LENGTH+1, sizeof(char));
   1.519 +      mpl->f_image[0] = '\0';
   1.520 +      mpl->f_value = 0.0;
   1.521 +      mpl->context = xcalloc(CONTEXT_SIZE, sizeof(char));
   1.522 +      memset(mpl->context, ' ', CONTEXT_SIZE);
   1.523 +      mpl->c_ptr = 0;
   1.524 +      mpl->flag_d = 0;
   1.525 +      /* translating segment */
   1.526 +      mpl->pool = dmp_create_poolx(0);
   1.527 +      mpl->tree = avl_create_tree(avl_strcmp, NULL);
   1.528 +      mpl->model = NULL;
   1.529 +      mpl->flag_x = 0;
   1.530 +      mpl->as_within = 0;
   1.531 +      mpl->as_in = 0;
   1.532 +      mpl->as_binary = 0;
   1.533 +      mpl->flag_s = 0;
   1.534 +      /* common segment */
   1.535 +      mpl->strings = dmp_create_poolx(sizeof(STRING));
   1.536 +      mpl->symbols = dmp_create_poolx(sizeof(SYMBOL));
   1.537 +      mpl->tuples = dmp_create_poolx(sizeof(TUPLE));
   1.538 +      mpl->arrays = dmp_create_poolx(sizeof(ARRAY));
   1.539 +      mpl->members = dmp_create_poolx(sizeof(MEMBER));
   1.540 +      mpl->elemvars = dmp_create_poolx(sizeof(ELEMVAR));
   1.541 +      mpl->formulae = dmp_create_poolx(sizeof(FORMULA));
   1.542 +      mpl->elemcons = dmp_create_poolx(sizeof(ELEMCON));
   1.543 +      mpl->a_list = NULL;
   1.544 +      mpl->sym_buf = xcalloc(255+1, sizeof(char));
   1.545 +      mpl->sym_buf[0] = '\0';
   1.546 +      mpl->tup_buf = xcalloc(255+1, sizeof(char));
   1.547 +      mpl->tup_buf[0] = '\0';
   1.548 +      /* generating/postsolving segment */
   1.549 +      mpl->rand = rng_create_rand();
   1.550 +      mpl->flag_p = 0;
   1.551 +      mpl->stmt = NULL;
   1.552 +#if 1 /* 11/II-2008 */
   1.553 +      mpl->dca = NULL;
   1.554 +#endif
   1.555 +      mpl->m = 0;
   1.556 +      mpl->n = 0;
   1.557 +      mpl->row = NULL;
   1.558 +      mpl->col = NULL;
   1.559 +      /* input/output segment */
   1.560 +      mpl->in_fp = NULL;
   1.561 +      mpl->in_file = NULL;
   1.562 +      mpl->out_fp = NULL;
   1.563 +      mpl->out_file = NULL;
   1.564 +      mpl->prt_fp = NULL;
   1.565 +      mpl->prt_file = NULL;
   1.566 +      /* solver interface segment */
   1.567 +      if (setjmp(mpl->jump)) xassert(mpl != mpl);
   1.568 +      mpl->phase = 0;
   1.569 +      mpl->mod_file = NULL;
   1.570 +      mpl->mpl_buf = xcalloc(255+1, sizeof(char));
   1.571 +      mpl->mpl_buf[0] = '\0';
   1.572 +      return mpl;
   1.573 +}
   1.574 +
   1.575 +/*----------------------------------------------------------------------
   1.576 +-- mpl_read_model - read model section and optional data section.
   1.577 +--
   1.578 +-- *Synopsis*
   1.579 +--
   1.580 +-- #include "glpmpl.h"
   1.581 +-- int mpl_read_model(MPL *mpl, char *file, int skip_data);
   1.582 +--
   1.583 +-- *Description*
   1.584 +--
   1.585 +-- The routine mpl_read_model reads model section and optionally data
   1.586 +-- section, which may follow the model section, from the text file,
   1.587 +-- whose name is the character string file, performs translating model
   1.588 +-- statements and data blocks, and stores all the information in the
   1.589 +-- translator database.
   1.590 +--
   1.591 +-- The parameter skip_data is a flag. If the input file contains the
   1.592 +-- data section and this flag is set, the data section is not read as
   1.593 +-- if there were no data section and a warning message is issued. This
   1.594 +-- allows reading the data section from another input file.
   1.595 +--
   1.596 +-- This routine should be called once after the routine mpl_initialize
   1.597 +-- and before other API routines.
   1.598 +--
   1.599 +-- *Returns*
   1.600 +--
   1.601 +-- The routine mpl_read_model returns one the following codes:
   1.602 +--
   1.603 +-- 1 - translation successful. The input text file contains only model
   1.604 +--     section. In this case the calling program may call the routine
   1.605 +--     mpl_read_data to read data section from another file.
   1.606 +-- 2 - translation successful. The input text file contains both model
   1.607 +--     and data section.
   1.608 +-- 4 - processing failed due to some errors. In this case the calling
   1.609 +--     program should call the routine mpl_terminate to terminate model
   1.610 +--     processing. */
   1.611 +
   1.612 +int mpl_read_model(MPL *mpl, char *file, int skip_data)
   1.613 +{     if (mpl->phase != 0)
   1.614 +         xfault("mpl_read_model: invalid call sequence\n");
   1.615 +      if (file == NULL)
   1.616 +         xfault("mpl_read_model: no input filename specified\n");
   1.617 +      /* set up error handler */
   1.618 +      if (setjmp(mpl->jump)) goto done;
   1.619 +      /* translate model section */
   1.620 +      mpl->phase = 1;
   1.621 +      xprintf("Reading model section from %s...\n", file);
   1.622 +      open_input(mpl, file);
   1.623 +      model_section(mpl);
   1.624 +      if (mpl->model == NULL)
   1.625 +         error(mpl, "empty model section not allowed");
   1.626 +      /* save name of the input text file containing model section for
   1.627 +         error diagnostics during the generation phase */
   1.628 +      mpl->mod_file = xcalloc(strlen(file)+1, sizeof(char));
   1.629 +      strcpy(mpl->mod_file, mpl->in_file);
   1.630 +      /* allocate content arrays for all model objects */
   1.631 +      alloc_content(mpl);
   1.632 +      /* optional data section may begin with the keyword 'data' */
   1.633 +      if (is_keyword(mpl, "data"))
   1.634 +      {  if (skip_data)
   1.635 +         {  warning(mpl, "data section ignored");
   1.636 +            goto skip;
   1.637 +         }
   1.638 +         mpl->flag_d = 1;
   1.639 +         get_token(mpl /* data */);
   1.640 +         if (mpl->token != T_SEMICOLON)
   1.641 +            error(mpl, "semicolon missing where expected");
   1.642 +         get_token(mpl /* ; */);
   1.643 +         /* translate data section */
   1.644 +         mpl->phase = 2;
   1.645 +         xprintf("Reading data section from %s...\n", file);
   1.646 +         data_section(mpl);
   1.647 +      }
   1.648 +      /* process end statement */
   1.649 +      end_statement(mpl);
   1.650 +skip: xprintf("%d line%s were read\n",
   1.651 +         mpl->line, mpl->line == 1 ? "" : "s");
   1.652 +      close_input(mpl);
   1.653 +done: /* return to the calling program */
   1.654 +      return mpl->phase;
   1.655 +}
   1.656 +
   1.657 +/*----------------------------------------------------------------------
   1.658 +-- mpl_read_data - read data section.
   1.659 +--
   1.660 +-- *Synopsis*
   1.661 +--
   1.662 +-- #include "glpmpl.h"
   1.663 +-- int mpl_read_data(MPL *mpl, char *file);
   1.664 +--
   1.665 +-- *Description*
   1.666 +--
   1.667 +-- The routine mpl_read_data reads data section from the text file,
   1.668 +-- whose name is the character string file, performs translating data
   1.669 +-- blocks, and stores the data read in the translator database.
   1.670 +--
   1.671 +-- If this routine is used, it should be called once after the routine
   1.672 +-- mpl_read_model and if the latter returned the code 1.
   1.673 +--
   1.674 +-- *Returns*
   1.675 +--
   1.676 +-- The routine mpl_read_data returns one of the following codes:
   1.677 +--
   1.678 +-- 2 - data section has been successfully processed.
   1.679 +-- 4 - processing failed due to some errors. In this case the calling
   1.680 +--     program should call the routine mpl_terminate to terminate model
   1.681 +--     processing. */
   1.682 +
   1.683 +int mpl_read_data(MPL *mpl, char *file)
   1.684 +#if 0 /* 02/X-2008 */
   1.685 +{     if (mpl->phase != 1)
   1.686 +#else
   1.687 +{     if (!(mpl->phase == 1 || mpl->phase == 2))
   1.688 +#endif
   1.689 +         xfault("mpl_read_data: invalid call sequence\n");
   1.690 +      if (file == NULL)
   1.691 +         xfault("mpl_read_data: no input filename specified\n");
   1.692 +      /* set up error handler */
   1.693 +      if (setjmp(mpl->jump)) goto done;
   1.694 +      /* process data section */
   1.695 +      mpl->phase = 2;
   1.696 +      xprintf("Reading data section from %s...\n", file);
   1.697 +      mpl->flag_d = 1;
   1.698 +      open_input(mpl, file);
   1.699 +      /* in this case the keyword 'data' is optional */
   1.700 +      if (is_literal(mpl, "data"))
   1.701 +      {  get_token(mpl /* data */);
   1.702 +         if (mpl->token != T_SEMICOLON)
   1.703 +            error(mpl, "semicolon missing where expected");
   1.704 +         get_token(mpl /* ; */);
   1.705 +      }
   1.706 +      data_section(mpl);
   1.707 +      /* process end statement */
   1.708 +      end_statement(mpl);
   1.709 +      xprintf("%d line%s were read\n",
   1.710 +         mpl->line, mpl->line == 1 ? "" : "s");
   1.711 +      close_input(mpl);
   1.712 +done: /* return to the calling program */
   1.713 +      return mpl->phase;
   1.714 +}
   1.715 +
   1.716 +/*----------------------------------------------------------------------
   1.717 +-- mpl_generate - generate model.
   1.718 +--
   1.719 +-- *Synopsis*
   1.720 +--
   1.721 +-- #include "glpmpl.h"
   1.722 +-- int mpl_generate(MPL *mpl, char *file);
   1.723 +--
   1.724 +-- *Description*
   1.725 +--
   1.726 +-- The routine mpl_generate generates the model using its description
   1.727 +-- stored in the translator database. This phase means generating all
   1.728 +-- variables, constraints, and objectives, executing check and display
   1.729 +-- statements, which precede the solve statement (if it is presented),
   1.730 +-- and building the problem instance.
   1.731 +--
   1.732 +-- The character string file specifies the name of output text file, to
   1.733 +-- which output produced by display statements should be written. It is
   1.734 +-- allowed to specify NULL, in which case the output goes to stdout via
   1.735 +-- the routine print.
   1.736 +--
   1.737 +-- This routine should be called once after the routine mpl_read_model
   1.738 +-- or mpl_read_data and if one of the latters returned the code 2.
   1.739 +--
   1.740 +-- *Returns*
   1.741 +--
   1.742 +-- The routine mpl_generate returns one of the following codes:
   1.743 +--
   1.744 +-- 3 - model has been successfully generated. In this case the calling
   1.745 +--     program may call other api routines to obtain components of the
   1.746 +--     problem instance from the translator database.
   1.747 +-- 4 - processing failed due to some errors. In this case the calling
   1.748 +--     program should call the routine mpl_terminate to terminate model
   1.749 +--     processing. */
   1.750 +
   1.751 +int mpl_generate(MPL *mpl, char *file)
   1.752 +{     if (!(mpl->phase == 1 || mpl->phase == 2))
   1.753 +         xfault("mpl_generate: invalid call sequence\n");
   1.754 +      /* set up error handler */
   1.755 +      if (setjmp(mpl->jump)) goto done;
   1.756 +      /* generate model */
   1.757 +      mpl->phase = 3;
   1.758 +      open_output(mpl, file);
   1.759 +      generate_model(mpl);
   1.760 +      flush_output(mpl);
   1.761 +      /* build problem instance */
   1.762 +      build_problem(mpl);
   1.763 +      /* generation phase has been finished */
   1.764 +      xprintf("Model has been successfully generated\n");
   1.765 +done: /* return to the calling program */
   1.766 +      return mpl->phase;
   1.767 +}
   1.768 +
   1.769 +/*----------------------------------------------------------------------
   1.770 +-- mpl_get_prob_name - obtain problem (model) name.
   1.771 +--
   1.772 +-- *Synopsis*
   1.773 +--
   1.774 +-- #include "glpmpl.h"
   1.775 +-- char *mpl_get_prob_name(MPL *mpl);
   1.776 +--
   1.777 +-- *Returns*
   1.778 +--
   1.779 +-- The routine mpl_get_prob_name returns a pointer to internal buffer,
   1.780 +-- which contains symbolic name of the problem (model).
   1.781 +--
   1.782 +-- *Note*
   1.783 +--
   1.784 +-- Currently MathProg has no feature to assign a symbolic name to the
   1.785 +-- model. Therefore the routine mpl_get_prob_name tries to construct
   1.786 +-- such name using the name of input text file containing model section,
   1.787 +-- although this is not a good idea (due to portability problems). */
   1.788 +
   1.789 +char *mpl_get_prob_name(MPL *mpl)
   1.790 +{     char *name = mpl->mpl_buf;
   1.791 +      char *file = mpl->mod_file;
   1.792 +      int k;
   1.793 +      if (mpl->phase != 3)
   1.794 +         xfault("mpl_get_prob_name: invalid call sequence\n");
   1.795 +      for (;;)
   1.796 +      {  if (strchr(file, '/') != NULL)
   1.797 +            file = strchr(file, '/') + 1;
   1.798 +         else if (strchr(file, '\\') != NULL)
   1.799 +            file = strchr(file, '\\') + 1;
   1.800 +         else if (strchr(file, ':') != NULL)
   1.801 +            file = strchr(file, ':') + 1;
   1.802 +         else
   1.803 +            break;
   1.804 +      }
   1.805 +      for (k = 0; ; k++)
   1.806 +      {  if (k == 255) break;
   1.807 +         if (!(isalnum((unsigned char)*file) || *file == '_')) break;
   1.808 +         name[k] = *file++;
   1.809 +      }
   1.810 +      if (k == 0)
   1.811 +         strcpy(name, "Unknown");
   1.812 +      else
   1.813 +         name[k] = '\0';
   1.814 +      xassert(strlen(name) <= 255);
   1.815 +      return name;
   1.816 +}
   1.817 +
   1.818 +/*----------------------------------------------------------------------
   1.819 +-- mpl_get_num_rows - determine number of rows.
   1.820 +--
   1.821 +-- *Synopsis*
   1.822 +--
   1.823 +-- #include "glpmpl.h"
   1.824 +-- int mpl_get_num_rows(MPL *mpl);
   1.825 +--
   1.826 +-- *Returns*
   1.827 +--
   1.828 +-- The routine mpl_get_num_rows returns total number of rows in the
   1.829 +-- problem, where each row is an individual constraint or objective. */
   1.830 +
   1.831 +int mpl_get_num_rows(MPL *mpl)
   1.832 +{     if (mpl->phase != 3)
   1.833 +         xfault("mpl_get_num_rows: invalid call sequence\n");
   1.834 +      return mpl->m;
   1.835 +}
   1.836 +
   1.837 +/*----------------------------------------------------------------------
   1.838 +-- mpl_get_num_cols - determine number of columns.
   1.839 +--
   1.840 +-- *Synopsis*
   1.841 +--
   1.842 +-- #include "glpmpl.h"
   1.843 +-- int mpl_get_num_cols(MPL *mpl);
   1.844 +--
   1.845 +-- *Returns*
   1.846 +--
   1.847 +-- The routine mpl_get_num_cols returns total number of columns in the
   1.848 +-- problem, where each column is an individual variable. */
   1.849 +
   1.850 +int mpl_get_num_cols(MPL *mpl)
   1.851 +{     if (mpl->phase != 3)
   1.852 +         xfault("mpl_get_num_cols: invalid call sequence\n");
   1.853 +      return mpl->n;
   1.854 +}
   1.855 +
   1.856 +/*----------------------------------------------------------------------
   1.857 +-- mpl_get_row_name - obtain row name.
   1.858 +--
   1.859 +-- *Synopsis*
   1.860 +--
   1.861 +-- #include "glpmpl.h"
   1.862 +-- char *mpl_get_row_name(MPL *mpl, int i);
   1.863 +--
   1.864 +-- *Returns*
   1.865 +--
   1.866 +-- The routine mpl_get_row_name returns a pointer to internal buffer,
   1.867 +-- which contains symbolic name of i-th row of the problem. */
   1.868 +
   1.869 +char *mpl_get_row_name(MPL *mpl, int i)
   1.870 +{     char *name = mpl->mpl_buf, *t;
   1.871 +      int len;
   1.872 +      if (mpl->phase != 3)
   1.873 +         xfault("mpl_get_row_name: invalid call sequence\n");
   1.874 +      if (!(1 <= i && i <= mpl->m))
   1.875 +         xfault("mpl_get_row_name: i = %d; row number out of range\n",
   1.876 +            i);
   1.877 +      strcpy(name, mpl->row[i]->con->name);
   1.878 +      len = strlen(name);
   1.879 +      xassert(len <= 255);
   1.880 +      t = format_tuple(mpl, '[', mpl->row[i]->memb->tuple);
   1.881 +      while (*t)
   1.882 +      {  if (len == 255) break;
   1.883 +         name[len++] = *t++;
   1.884 +      }
   1.885 +      name[len] = '\0';
   1.886 +      if (len == 255) strcpy(name+252, "...");
   1.887 +      xassert(strlen(name) <= 255);
   1.888 +      return name;
   1.889 +}
   1.890 +
   1.891 +/*----------------------------------------------------------------------
   1.892 +-- mpl_get_row_kind - determine row kind.
   1.893 +--
   1.894 +-- *Synopsis*
   1.895 +--
   1.896 +-- #include "glpmpl.h"
   1.897 +-- int mpl_get_row_kind(MPL *mpl, int i);
   1.898 +--
   1.899 +-- *Returns*
   1.900 +--
   1.901 +-- The routine mpl_get_row_kind returns the kind of i-th row, which can
   1.902 +-- be one of the following:
   1.903 +--
   1.904 +-- MPL_ST  - non-free (constraint) row;
   1.905 +-- MPL_MIN - free (objective) row to be minimized;
   1.906 +-- MPL_MAX - free (objective) row to be maximized. */
   1.907 +
   1.908 +int mpl_get_row_kind(MPL *mpl, int i)
   1.909 +{     int kind;
   1.910 +      if (mpl->phase != 3)
   1.911 +         xfault("mpl_get_row_kind: invalid call sequence\n");
   1.912 +      if (!(1 <= i && i <= mpl->m))
   1.913 +         xfault("mpl_get_row_kind: i = %d; row number out of range\n",
   1.914 +            i);
   1.915 +      switch (mpl->row[i]->con->type)
   1.916 +      {  case A_CONSTRAINT:
   1.917 +            kind = MPL_ST; break;
   1.918 +         case A_MINIMIZE:
   1.919 +            kind = MPL_MIN; break;
   1.920 +         case A_MAXIMIZE:
   1.921 +            kind = MPL_MAX; break;
   1.922 +         default:
   1.923 +            xassert(mpl != mpl);
   1.924 +      }
   1.925 +      return kind;
   1.926 +}
   1.927 +
   1.928 +/*----------------------------------------------------------------------
   1.929 +-- mpl_get_row_bnds - obtain row bounds.
   1.930 +--
   1.931 +-- *Synopsis*
   1.932 +--
   1.933 +-- #include "glpmpl.h"
   1.934 +-- int mpl_get_row_bnds(MPL *mpl, int i, double *lb, double *ub);
   1.935 +--
   1.936 +-- *Description*
   1.937 +--
   1.938 +-- The routine mpl_get_row_bnds stores lower and upper bounds of i-th
   1.939 +-- row of the problem to the locations, which the parameters lb and ub
   1.940 +-- point to, respectively. Besides the routine returns the type of the
   1.941 +-- i-th row.
   1.942 +--
   1.943 +-- If some of the parameters lb and ub is NULL, the corresponding bound
   1.944 +-- value is not stored.
   1.945 +--
   1.946 +-- Types and bounds have the following meaning:
   1.947 +--
   1.948 +--     Type           Bounds          Note
   1.949 +--    -----------------------------------------------------------
   1.950 +--    MPL_FR   -inf <  f(x) <  +inf   Free linear form
   1.951 +--    MPL_LO     lb <= f(x) <  +inf   Inequality f(x) >= lb
   1.952 +--    MPL_UP   -inf <  f(x) <=  ub    Inequality f(x) <= ub
   1.953 +--    MPL_DB     lb <= f(x) <=  ub    Inequality lb <= f(x) <= ub
   1.954 +--    MPL_FX           f(x)  =  lb    Equality f(x) = lb
   1.955 +--
   1.956 +-- where f(x) is the corresponding linear form of the i-th row.
   1.957 +--
   1.958 +-- If the row has no lower bound, *lb is set to zero; if the row has
   1.959 +-- no upper bound, *ub is set to zero; and if the row is of fixed type,
   1.960 +-- both *lb and *ub are set to the same value.
   1.961 +--
   1.962 +-- *Returns*
   1.963 +--
   1.964 +-- The routine returns the type of the i-th row as it is stated in the
   1.965 +-- table above. */
   1.966 +
   1.967 +int mpl_get_row_bnds(MPL *mpl, int i, double *_lb, double *_ub)
   1.968 +{     ELEMCON *con;
   1.969 +      int type;
   1.970 +      double lb, ub;
   1.971 +      if (mpl->phase != 3)
   1.972 +         xfault("mpl_get_row_bnds: invalid call sequence\n");
   1.973 +      if (!(1 <= i && i <= mpl->m))
   1.974 +         xfault("mpl_get_row_bnds: i = %d; row number out of range\n",
   1.975 +            i);
   1.976 +      con = mpl->row[i];
   1.977 +#if 0 /* 21/VII-2006 */
   1.978 +      if (con->con->lbnd == NULL && con->con->ubnd == NULL)
   1.979 +         type = MPL_FR, lb = ub = 0.0;
   1.980 +      else if (con->con->ubnd == NULL)
   1.981 +         type = MPL_LO, lb = con->lbnd, ub = 0.0;
   1.982 +      else if (con->con->lbnd == NULL)
   1.983 +         type = MPL_UP, lb = 0.0, ub = con->ubnd;
   1.984 +      else if (con->con->lbnd != con->con->ubnd)
   1.985 +         type = MPL_DB, lb = con->lbnd, ub = con->ubnd;
   1.986 +      else
   1.987 +         type = MPL_FX, lb = ub = con->lbnd;
   1.988 +#else
   1.989 +      lb = (con->con->lbnd == NULL ? -DBL_MAX : con->lbnd);
   1.990 +      ub = (con->con->ubnd == NULL ? +DBL_MAX : con->ubnd);
   1.991 +      if (lb == -DBL_MAX && ub == +DBL_MAX)
   1.992 +         type = MPL_FR, lb = ub = 0.0;
   1.993 +      else if (ub == +DBL_MAX)
   1.994 +         type = MPL_LO, ub = 0.0;
   1.995 +      else if (lb == -DBL_MAX)
   1.996 +         type = MPL_UP, lb = 0.0;
   1.997 +      else if (con->con->lbnd != con->con->ubnd)
   1.998 +         type = MPL_DB;
   1.999 +      else
  1.1000 +         type = MPL_FX;
  1.1001 +#endif
  1.1002 +      if (_lb != NULL) *_lb = lb;
  1.1003 +      if (_ub != NULL) *_ub = ub;
  1.1004 +      return type;
  1.1005 +}
  1.1006 +
  1.1007 +/*----------------------------------------------------------------------
  1.1008 +-- mpl_get_mat_row - obtain row of the constraint matrix.
  1.1009 +--
  1.1010 +-- *Synopsis*
  1.1011 +--
  1.1012 +-- #include "glpmpl.h"
  1.1013 +-- int mpl_get_mat_row(MPL *mpl, int i, int ndx[], double val[]);
  1.1014 +--
  1.1015 +-- *Description*
  1.1016 +--
  1.1017 +-- The routine mpl_get_mat_row stores column indices and numeric values
  1.1018 +-- of constraint coefficients for the i-th row to locations ndx[1], ...,
  1.1019 +-- ndx[len] and val[1], ..., val[len], respectively, where 0 <= len <= n
  1.1020 +-- is number of (structural) non-zero constraint coefficients, and n is
  1.1021 +-- number of columns in the problem.
  1.1022 +--
  1.1023 +-- If the parameter ndx is NULL, column indices are not stored. If the
  1.1024 +-- parameter val is NULL, numeric values are not stored.
  1.1025 +--
  1.1026 +-- Note that free rows may have constant terms, which are not part of
  1.1027 +-- the constraint matrix and therefore not reported by this routine. The
  1.1028 +-- constant term of a particular row can be obtained, if necessary, via
  1.1029 +-- the routine mpl_get_row_c0.
  1.1030 +--
  1.1031 +-- *Returns*
  1.1032 +--
  1.1033 +-- The routine mpl_get_mat_row returns len, which is length of i-th row
  1.1034 +-- of the constraint matrix (i.e. number of non-zero coefficients). */
  1.1035 +
  1.1036 +int mpl_get_mat_row(MPL *mpl, int i, int ndx[], double val[])
  1.1037 +{     FORMULA *term;
  1.1038 +      int len = 0;
  1.1039 +      if (mpl->phase != 3)
  1.1040 +         xfault("mpl_get_mat_row: invalid call sequence\n");
  1.1041 +      if (!(1 <= i && i <= mpl->m))
  1.1042 +         xfault("mpl_get_mat_row: i = %d; row number out of range\n",
  1.1043 +            i);
  1.1044 +      for (term = mpl->row[i]->form; term != NULL; term = term->next)
  1.1045 +      {  xassert(term->var != NULL);
  1.1046 +         len++;
  1.1047 +         xassert(len <= mpl->n);
  1.1048 +         if (ndx != NULL) ndx[len] = term->var->j;
  1.1049 +         if (val != NULL) val[len] = term->coef;
  1.1050 +      }
  1.1051 +      return len;
  1.1052 +}
  1.1053 +
  1.1054 +/*----------------------------------------------------------------------
  1.1055 +-- mpl_get_row_c0 - obtain constant term of free row.
  1.1056 +--
  1.1057 +-- *Synopsis*
  1.1058 +--
  1.1059 +-- #include "glpmpl.h"
  1.1060 +-- double mpl_get_row_c0(MPL *mpl, int i);
  1.1061 +--
  1.1062 +-- *Returns*
  1.1063 +--
  1.1064 +-- The routine mpl_get_row_c0 returns numeric value of constant term of
  1.1065 +-- i-th row.
  1.1066 +--
  1.1067 +-- Note that only free rows may have non-zero constant terms. Therefore
  1.1068 +-- if i-th row is not free, the routine returns zero. */
  1.1069 +
  1.1070 +double mpl_get_row_c0(MPL *mpl, int i)
  1.1071 +{     ELEMCON *con;
  1.1072 +      double c0;
  1.1073 +      if (mpl->phase != 3)
  1.1074 +         xfault("mpl_get_row_c0: invalid call sequence\n");
  1.1075 +      if (!(1 <= i && i <= mpl->m))
  1.1076 +         xfault("mpl_get_row_c0: i = %d; row number out of range\n",
  1.1077 +            i);
  1.1078 +      con = mpl->row[i];
  1.1079 +      if (con->con->lbnd == NULL && con->con->ubnd == NULL)
  1.1080 +         c0 = - con->lbnd;
  1.1081 +      else
  1.1082 +         c0 = 0.0;
  1.1083 +      return c0;
  1.1084 +}
  1.1085 +
  1.1086 +/*----------------------------------------------------------------------
  1.1087 +-- mpl_get_col_name - obtain column name.
  1.1088 +--
  1.1089 +-- *Synopsis*
  1.1090 +--
  1.1091 +-- #include "glpmpl.h"
  1.1092 +-- char *mpl_get_col_name(MPL *mpl, int j);
  1.1093 +--
  1.1094 +-- *Returns*
  1.1095 +--
  1.1096 +-- The routine mpl_get_col_name returns a pointer to internal buffer,
  1.1097 +-- which contains symbolic name of j-th column of the problem. */
  1.1098 +
  1.1099 +char *mpl_get_col_name(MPL *mpl, int j)
  1.1100 +{     char *name = mpl->mpl_buf, *t;
  1.1101 +      int len;
  1.1102 +      if (mpl->phase != 3)
  1.1103 +         xfault("mpl_get_col_name: invalid call sequence\n");
  1.1104 +      if (!(1 <= j && j <= mpl->n))
  1.1105 +         xfault("mpl_get_col_name: j = %d; column number out of range\n"
  1.1106 +            , j);
  1.1107 +      strcpy(name, mpl->col[j]->var->name);
  1.1108 +      len = strlen(name);
  1.1109 +      xassert(len <= 255);
  1.1110 +      t = format_tuple(mpl, '[', mpl->col[j]->memb->tuple);
  1.1111 +      while (*t)
  1.1112 +      {  if (len == 255) break;
  1.1113 +         name[len++] = *t++;
  1.1114 +      }
  1.1115 +      name[len] = '\0';
  1.1116 +      if (len == 255) strcpy(name+252, "...");
  1.1117 +      xassert(strlen(name) <= 255);
  1.1118 +      return name;
  1.1119 +}
  1.1120 +
  1.1121 +/*----------------------------------------------------------------------
  1.1122 +-- mpl_get_col_kind - determine column kind.
  1.1123 +--
  1.1124 +-- *Synopsis*
  1.1125 +--
  1.1126 +-- #include "glpmpl.h"
  1.1127 +-- int mpl_get_col_kind(MPL *mpl, int j);
  1.1128 +--
  1.1129 +-- *Returns*
  1.1130 +--
  1.1131 +-- The routine mpl_get_col_kind returns the kind of j-th column, which
  1.1132 +-- can be one of the following:
  1.1133 +--
  1.1134 +-- MPL_NUM - continuous variable;
  1.1135 +-- MPL_INT - integer variable;
  1.1136 +-- MPL_BIN - binary variable.
  1.1137 +--
  1.1138 +-- Note that column kinds are defined independently on type and bounds
  1.1139 +-- (reported by the routine mpl_get_col_bnds) of corresponding columns.
  1.1140 +-- This means, in particular, that bounds of an integer column may be
  1.1141 +-- fractional, or a binary column may have lower and upper bounds that
  1.1142 +-- are not 0 and 1 (or it may have no lower/upper bound at all). */
  1.1143 +
  1.1144 +int mpl_get_col_kind(MPL *mpl, int j)
  1.1145 +{     int kind;
  1.1146 +      if (mpl->phase != 3)
  1.1147 +         xfault("mpl_get_col_kind: invalid call sequence\n");
  1.1148 +      if (!(1 <= j && j <= mpl->n))
  1.1149 +         xfault("mpl_get_col_kind: j = %d; column number out of range\n"
  1.1150 +            , j);
  1.1151 +      switch (mpl->col[j]->var->type)
  1.1152 +      {  case A_NUMERIC:
  1.1153 +            kind = MPL_NUM; break;
  1.1154 +         case A_INTEGER:
  1.1155 +            kind = MPL_INT; break;
  1.1156 +         case A_BINARY:
  1.1157 +            kind = MPL_BIN; break;
  1.1158 +         default:
  1.1159 +            xassert(mpl != mpl);
  1.1160 +      }
  1.1161 +      return kind;
  1.1162 +}
  1.1163 +
  1.1164 +/*----------------------------------------------------------------------
  1.1165 +-- mpl_get_col_bnds - obtain column bounds.
  1.1166 +--
  1.1167 +-- *Synopsis*
  1.1168 +--
  1.1169 +-- #include "glpmpl.h"
  1.1170 +-- int mpl_get_col_bnds(MPL *mpl, int j, double *lb, double *ub);
  1.1171 +--
  1.1172 +-- *Description*
  1.1173 +--
  1.1174 +-- The routine mpl_get_col_bnds stores lower and upper bound of j-th
  1.1175 +-- column of the problem to the locations, which the parameters lb and
  1.1176 +-- ub point to, respectively. Besides the routine returns the type of
  1.1177 +-- the j-th column.
  1.1178 +--
  1.1179 +-- If some of the parameters lb and ub is NULL, the corresponding bound
  1.1180 +-- value is not stored.
  1.1181 +--
  1.1182 +-- Types and bounds have the following meaning:
  1.1183 +--
  1.1184 +--     Type         Bounds         Note
  1.1185 +--    ------------------------------------------------------
  1.1186 +--    MPL_FR   -inf <  x <  +inf   Free (unbounded) variable
  1.1187 +--    MPL_LO     lb <= x <  +inf   Variable with lower bound
  1.1188 +--    MPL_UP   -inf <  x <=  ub    Variable with upper bound
  1.1189 +--    MPL_DB     lb <= x <=  ub    Double-bounded variable
  1.1190 +--    MPL_FX           x  =  lb    Fixed variable
  1.1191 +--
  1.1192 +-- where x is individual variable corresponding to the j-th column.
  1.1193 +--
  1.1194 +-- If the column has no lower bound, *lb is set to zero; if the column
  1.1195 +-- has no upper bound, *ub is set to zero; and if the column is of fixed
  1.1196 +-- type, both *lb and *ub are set to the same value.
  1.1197 +--
  1.1198 +-- *Returns*
  1.1199 +--
  1.1200 +-- The routine returns the type of the j-th column as it is stated in
  1.1201 +-- the table above. */
  1.1202 +
  1.1203 +int mpl_get_col_bnds(MPL *mpl, int j, double *_lb, double *_ub)
  1.1204 +{     ELEMVAR *var;
  1.1205 +      int type;
  1.1206 +      double lb, ub;
  1.1207 +      if (mpl->phase != 3)
  1.1208 +         xfault("mpl_get_col_bnds: invalid call sequence\n");
  1.1209 +      if (!(1 <= j && j <= mpl->n))
  1.1210 +         xfault("mpl_get_col_bnds: j = %d; column number out of range\n"
  1.1211 +            , j);
  1.1212 +      var = mpl->col[j];
  1.1213 +#if 0 /* 21/VII-2006 */
  1.1214 +      if (var->var->lbnd == NULL && var->var->ubnd == NULL)
  1.1215 +         type = MPL_FR, lb = ub = 0.0;
  1.1216 +      else if (var->var->ubnd == NULL)
  1.1217 +         type = MPL_LO, lb = var->lbnd, ub = 0.0;
  1.1218 +      else if (var->var->lbnd == NULL)
  1.1219 +         type = MPL_UP, lb = 0.0, ub = var->ubnd;
  1.1220 +      else if (var->var->lbnd != var->var->ubnd)
  1.1221 +         type = MPL_DB, lb = var->lbnd, ub = var->ubnd;
  1.1222 +      else
  1.1223 +         type = MPL_FX, lb = ub = var->lbnd;
  1.1224 +#else
  1.1225 +      lb = (var->var->lbnd == NULL ? -DBL_MAX : var->lbnd);
  1.1226 +      ub = (var->var->ubnd == NULL ? +DBL_MAX : var->ubnd);
  1.1227 +      if (lb == -DBL_MAX && ub == +DBL_MAX)
  1.1228 +         type = MPL_FR, lb = ub = 0.0;
  1.1229 +      else if (ub == +DBL_MAX)
  1.1230 +         type = MPL_LO, ub = 0.0;
  1.1231 +      else if (lb == -DBL_MAX)
  1.1232 +         type = MPL_UP, lb = 0.0;
  1.1233 +      else if (var->var->lbnd != var->var->ubnd)
  1.1234 +         type = MPL_DB;
  1.1235 +      else
  1.1236 +         type = MPL_FX;
  1.1237 +#endif
  1.1238 +      if (_lb != NULL) *_lb = lb;
  1.1239 +      if (_ub != NULL) *_ub = ub;
  1.1240 +      return type;
  1.1241 +}
  1.1242 +
  1.1243 +/*----------------------------------------------------------------------
  1.1244 +-- mpl_has_solve_stmt - check if model has solve statement.
  1.1245 +--
  1.1246 +-- *Synopsis*
  1.1247 +--
  1.1248 +-- #include "glpmpl.h"
  1.1249 +-- int mpl_has_solve_stmt(MPL *mpl);
  1.1250 +--
  1.1251 +-- *Returns*
  1.1252 +--
  1.1253 +-- If the model has the solve statement, the routine returns non-zero,
  1.1254 +-- otherwise zero is returned. */
  1.1255 +
  1.1256 +int mpl_has_solve_stmt(MPL *mpl)
  1.1257 +{     if (mpl->phase != 3)
  1.1258 +         xfault("mpl_has_solve_stmt: invalid call sequence\n");
  1.1259 +      return mpl->flag_s;
  1.1260 +}
  1.1261 +
  1.1262 +#if 1 /* 15/V-2010 */
  1.1263 +void mpl_put_row_soln(MPL *mpl, int i, int stat, double prim,
  1.1264 +      double dual)
  1.1265 +{     /* store row (constraint/objective) solution components */
  1.1266 +      xassert(mpl->phase == 3);
  1.1267 +      xassert(1 <= i && i <= mpl->m);
  1.1268 +      mpl->row[i]->stat = stat;
  1.1269 +      mpl->row[i]->prim = prim;
  1.1270 +      mpl->row[i]->dual = dual;
  1.1271 +      return;
  1.1272 +}
  1.1273 +#endif
  1.1274 +
  1.1275 +#if 1 /* 15/V-2010 */
  1.1276 +void mpl_put_col_soln(MPL *mpl, int j, int stat, double prim,
  1.1277 +      double dual)
  1.1278 +{     /* store column (variable) solution components */
  1.1279 +      xassert(mpl->phase == 3);
  1.1280 +      xassert(1 <= j && j <= mpl->n);
  1.1281 +      mpl->col[j]->stat = stat;
  1.1282 +      mpl->col[j]->prim = prim;
  1.1283 +      mpl->col[j]->dual = dual;
  1.1284 +      return;
  1.1285 +}
  1.1286 +#endif
  1.1287 +
  1.1288 +#if 0 /* 15/V-2010 */
  1.1289 +/*----------------------------------------------------------------------
  1.1290 +-- mpl_put_col_value - store column value.
  1.1291 +--
  1.1292 +-- *Synopsis*
  1.1293 +--
  1.1294 +-- #include "glpmpl.h"
  1.1295 +-- void mpl_put_col_value(MPL *mpl, int j, double val);
  1.1296 +--
  1.1297 +-- *Description*
  1.1298 +--
  1.1299 +-- The routine mpl_put_col_value stores numeric value of j-th column
  1.1300 +-- into the translator database. It is assumed that the column value is
  1.1301 +-- provided by the solver. */
  1.1302 +
  1.1303 +void mpl_put_col_value(MPL *mpl, int j, double val)
  1.1304 +{     if (mpl->phase != 3)
  1.1305 +         xfault("mpl_put_col_value: invalid call sequence\n");
  1.1306 +      if (!(1 <= j && j <= mpl->n))
  1.1307 +         xfault(
  1.1308 +         "mpl_put_col_value: j = %d; column number out of range\n", j);
  1.1309 +      mpl->col[j]->prim = val;
  1.1310 +      return;
  1.1311 +}
  1.1312 +#endif
  1.1313 +
  1.1314 +/*----------------------------------------------------------------------
  1.1315 +-- mpl_postsolve - postsolve model.
  1.1316 +--
  1.1317 +-- *Synopsis*
  1.1318 +--
  1.1319 +-- #include "glpmpl.h"
  1.1320 +-- int mpl_postsolve(MPL *mpl);
  1.1321 +--
  1.1322 +-- *Description*
  1.1323 +--
  1.1324 +-- The routine mpl_postsolve performs postsolving of the model using
  1.1325 +-- its description stored in the translator database. This phase means
  1.1326 +-- executing statements, which follow the solve statement.
  1.1327 +--
  1.1328 +-- If this routine is used, it should be called once after the routine
  1.1329 +-- mpl_generate and if the latter returned the code 3.
  1.1330 +--
  1.1331 +-- *Returns*
  1.1332 +--
  1.1333 +-- The routine mpl_postsolve returns one of the following codes:
  1.1334 +--
  1.1335 +-- 3 - model has been successfully postsolved.
  1.1336 +-- 4 - processing failed due to some errors. In this case the calling
  1.1337 +--     program should call the routine mpl_terminate to terminate model
  1.1338 +--     processing. */
  1.1339 +
  1.1340 +int mpl_postsolve(MPL *mpl)
  1.1341 +{     if (!(mpl->phase == 3 && !mpl->flag_p))
  1.1342 +         xfault("mpl_postsolve: invalid call sequence\n");
  1.1343 +      /* set up error handler */
  1.1344 +      if (setjmp(mpl->jump)) goto done;
  1.1345 +      /* perform postsolving */
  1.1346 +      postsolve_model(mpl);
  1.1347 +      flush_output(mpl);
  1.1348 +      /* postsolving phase has been finished */
  1.1349 +      xprintf("Model has been successfully processed\n");
  1.1350 +done: /* return to the calling program */
  1.1351 +      return mpl->phase;
  1.1352 +}
  1.1353 +
  1.1354 +/*----------------------------------------------------------------------
  1.1355 +-- mpl_terminate - free all resources used by translator.
  1.1356 +--
  1.1357 +-- *Synopsis*
  1.1358 +--
  1.1359 +-- #include "glpmpl.h"
  1.1360 +-- void mpl_terminate(MPL *mpl);
  1.1361 +--
  1.1362 +-- *Description*
  1.1363 +--
  1.1364 +-- The routine mpl_terminate frees all the resources used by the GNU
  1.1365 +-- MathProg translator. */
  1.1366 +
  1.1367 +void mpl_terminate(MPL *mpl)
  1.1368 +{     if (setjmp(mpl->jump)) xassert(mpl != mpl);
  1.1369 +      switch (mpl->phase)
  1.1370 +      {  case 0:
  1.1371 +         case 1:
  1.1372 +         case 2:
  1.1373 +         case 3:
  1.1374 +            /* there were no errors; clean the model content */
  1.1375 +            clean_model(mpl);
  1.1376 +            xassert(mpl->a_list == NULL);
  1.1377 +#if 1 /* 11/II-2008 */
  1.1378 +            xassert(mpl->dca == NULL);
  1.1379 +#endif
  1.1380 +            break;
  1.1381 +         case 4:
  1.1382 +            /* model processing has been finished due to error; delete
  1.1383 +               search trees, which may be created for some arrays */
  1.1384 +            {  ARRAY *a;
  1.1385 +               for (a = mpl->a_list; a != NULL; a = a->next)
  1.1386 +                  if (a->tree != NULL) avl_delete_tree(a->tree);
  1.1387 +            }
  1.1388 +#if 1 /* 11/II-2008 */
  1.1389 +            free_dca(mpl);
  1.1390 +#endif
  1.1391 +            break;
  1.1392 +         default:
  1.1393 +            xassert(mpl != mpl);
  1.1394 +      }
  1.1395 +      /* delete the translator database */
  1.1396 +      xfree(mpl->image);
  1.1397 +      xfree(mpl->b_image);
  1.1398 +      xfree(mpl->f_image);
  1.1399 +      xfree(mpl->context);
  1.1400 +      dmp_delete_pool(mpl->pool);
  1.1401 +      avl_delete_tree(mpl->tree);
  1.1402 +      dmp_delete_pool(mpl->strings);
  1.1403 +      dmp_delete_pool(mpl->symbols);
  1.1404 +      dmp_delete_pool(mpl->tuples);
  1.1405 +      dmp_delete_pool(mpl->arrays);
  1.1406 +      dmp_delete_pool(mpl->members);
  1.1407 +      dmp_delete_pool(mpl->elemvars);
  1.1408 +      dmp_delete_pool(mpl->formulae);
  1.1409 +      dmp_delete_pool(mpl->elemcons);
  1.1410 +      xfree(mpl->sym_buf);
  1.1411 +      xfree(mpl->tup_buf);
  1.1412 +      rng_delete_rand(mpl->rand);
  1.1413 +      if (mpl->row != NULL) xfree(mpl->row);
  1.1414 +      if (mpl->col != NULL) xfree(mpl->col);
  1.1415 +      if (mpl->in_fp != NULL) xfclose(mpl->in_fp);
  1.1416 +      if (mpl->out_fp != NULL && mpl->out_fp != (void *)stdout)
  1.1417 +         xfclose(mpl->out_fp);
  1.1418 +      if (mpl->out_file != NULL) xfree(mpl->out_file);
  1.1419 +      if (mpl->prt_fp != NULL) xfclose(mpl->prt_fp);
  1.1420 +      if (mpl->prt_file != NULL) xfree(mpl->prt_file);
  1.1421 +      if (mpl->mod_file != NULL) xfree(mpl->mod_file);
  1.1422 +      xfree(mpl->mpl_buf);
  1.1423 +      xfree(mpl);
  1.1424 +      return;
  1.1425 +}
  1.1426 +
  1.1427 +/* eof */