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