/* glpapi5.c (glp_simplex1) */

/*----------------------------------------------------------------------
-- Copyright (C) 2000, 2001, 2002 Andrew Makhorin <mao@mai2.rcnet.ru>,
--               Department for Applied Informatics, Moscow Aviation
--               Institute, Moscow, Russia. All rights reserved.
--
-- This file is a part of GLPK (GNU Linear Programming Kit).
--
-- GLPK is free software; you can redistribute it and/or modify it
-- under the terms of the GNU General Public License as published by
-- the Free Software Foundation; either version 2, or (at your option)
-- any later version.
--
-- GLPK is distributed in the hope that it will be useful, but WITHOUT
-- ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public
-- License for more details.
--
-- You should have received a copy of the GNU General Public License
-- along with GLPK; see the file COPYING. If not, write to the Free
-- Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
-- 02111-1307, USA.
----------------------------------------------------------------------*/

#include <ctype.h>
#include <float.h>
#include <limits.h>
#include <math.h>
#include <time.h>
#include "glpk.h"
#include "glprsm.h"

#define error print

/*----------------------------------------------------------------------
-- glp_init_spx1 - initialize parameter block by default values.
--
-- *Synopsis*
--
-- #include "glpk.h"
-- void glp_init_spx1(struct spx1 *parm);
--
-- *Description*
--
-- The routine glp_init_spx1 initializes parameter block passed to the
-- routine glp_simplex1. */

void glp_init_spx1(struct spx1 *parm)
{     parm->scale = 0;
      parm->initb = 0;
      parm->feas = 0;
      parm->dual = 1;
      parm->steep = 1;
      parm->relax = 1;
      parm->round = 1;
      parm->tol_bnd = 1e-8;
      parm->tol_dj = 1e-7;
      parm->tol_piv = 1e-10;
      parm->max_iter = INT_MAX;
      parm->max_time = DBL_MAX;
      parm->obj_min = -DBL_MAX;
      parm->obj_max = +DBL_MAX;
      parm->quiet = 0;
      parm->delay = 0.0;
      parm->freq = 1.0;
      parm->iter_used = 0;
      parm->time_used = 0.0;
      return;
}

/*----------------------------------------------------------------------
-- glp_simplex1 - comprehensive driver to the simplex method.
--
-- *Synopsis*
--
-- #include "glpk.h"
-- int glp_simplex1(LPI *lp, struct spx1 *parm);
--
-- *Description*
--
-- The routine glp_simplex1 is a comprehensive driver to the routines
-- which implement components of the revised simplex method for linear
-- programming.
--
-- The parameter lp is a pointer to the problem instance, which should
-- be solved.
--
-- The parameter parm is a pointer to the block of control parameters
-- passed to the driver. This block may be initialized by the routine
-- glp_init_spx1 by standard default values. It is allowed to specify
-- NULL, in which case standard default values are used.
--
-- *Returns*
--
-- The routine glp_simplex1 returns one of the following codes:
--
--  0 - no errors;
-- -1 - iteration limit exceeded;
-- -2 - time limit exceeded;
-- -3 - objective lower limit reached;
-- -4 - objective upper limit reached;
-- +1 - invalid control parameter;
-- +2 - invalid initial basis;
-- +3 - numerical problems with basis matrix.
--
-- In case of negative return codes there is no error, but the solver
-- can't finish the search because of some limitation and therefore the
-- most recently obtained solution is reported. */

#define prefix "glp_simplex1: "
/* prefix used in messages */

static struct spx1 *parm;
/* control parameters block */

static int m;
/* number of rows = number of auxiliary variables */

static int n;
/* number of columns = number of structural variables */

static RSM *rsm;
/* simplex method common block (sootwetstwuet mas[tabirowannoj zada`e)*/

static double *coef; /* double coef[0:n]; */
/* vector of scaled coefficients of the objective function from the
   original problem (including the constant term in coef[0]) */

static int dir;
/* optimization direction:
   '-' - minimization
   '+' - maximization */

static double *R; /* double R[1:m]; */
static double *S; /* double S[1:n]; */
/* diagonal scaling matrices; the constraint matrix for the scaling
   problem is R*A*S, where A is the original constraint matrix; these
   matrices are unity matrices if scaling is not used */

static double *dvec; /* double dvec[1:m]; */
/* the vector delta (used for the dual steepest edge technique) */

static double *gvec; /* double gvec[1:n]; */
/* the vector gamma (used for the primal steepest edge technique) */

static int phase;
/* phase number:
   1 - searching for feasible solution (phase I)
   2 - searching for optimal solution (phase II) */

static int meth;
/* meth currently used:
   'P' - primal simplex
   'D' - dual simplex */

static double *bbar; /* double bbar[1:m]; */
/* vector of values of basic variables */

static double *cost; /* double cost[1:m+n]; */
/* expanded vector of coefficients of the working objective function
   (this function is always minimized) */

static double *pi; /* double pi[1:m]; */
/* vector of simplex multipliers */

static double *cbar;
/* vector of reduced costs of non-basic variables */

static clock_t t_start;
/* the time at which the solver starts */

static clock_t t_last;
/* the time at which visual information was most recently displayed */

/*----------------------------------------------------------------------
-- check_parm - check control parameters for correctness.
--
-- This routine checks control parameters specified in the parameter
-- block for correctness and returns one of the following codes:
--
-- 0 - no errors;
-- 1 - some control parameter has invalid value. */

static int check_parm(void)
{     struct spx1 *p = parm;
      if (!(p->scale == 0 || p->scale == 1))
      {  error(prefix "scale = %d; invalid parameter", p->scale);
         return 1;
      }
      if (!(p->initb == 0 || p->initb == 1))
      {  error(prefix "initb = %d; invalid parameter", p->initb);
         return 1;
      }
      if (!(p->feas == 0 || p->feas == 1))
      {  error(prefix "feas = %d; invalid parameter", p->feas);
         return 1;
      }
      if (!(p->dual == 0 || p->dual == 1))
      {  error(prefix "dual = %d; invalid parameter", p->dual);
         return 1;
      }
      if (!(p->steep == 0 || p->steep == 1))
      {  error(prefix "steep = %d; invalid parameter", p->steep);
         return 1;
      }
      if (!(p->relax == 0 || p->relax == 1))
      {  error(prefix "relax = %d; invalid parameter", p->relax);
         return 1;
      }
      if (!(p->round == 0 || p->round == 1))
      {  error(prefix "round = %d; invalid parameter", p->round);
         return 1;
      }
      if (!(0.0 < p->tol_bnd && p->tol_bnd < 1.0))
      {  error(prefix "tol_bnd = %g; invalid parameter", p->tol_bnd);
         return 1;
      }
      if (!(0.0 < p->tol_dj && p->tol_dj < 1.0))
      {  error(prefix "tol_dj = %g; invalid parameter", p->tol_dj);
         return 1;
      }
      if (!(0.0 < p->tol_piv && p->tol_piv < 1.0))
      {  error(prefix "tol_piv = %g; invalid parameter", p->tol_piv);
         return 1;
      }
      if (p->max_iter < 0)
      {  error(prefix "max_iter = %d; invalid parameter", p->max_iter);
         return 1;
      }
      if (p->max_time < 0.0)
      {  error(prefix "max_time = %g; invalid parameter", p->max_time);
         return 1;
      }
      insist(p->obj_min == p->obj_min);
      insist(p->obj_max == p->obj_max);
      if (!(p->quiet == 0 || p->quiet == 1))
      {  error(prefix "quiet = %d; invalid parameter", p->quiet);
         return 1;
      }
      if (p->delay < 0.0)
      {  error(prefix "delay = %g; invalid parameter", p->delay);
         return 1;
      }
      if (p->freq < 0.0)
      {  error(prefix "freq = %g; invalid parameter", p->freq);
         return 1;
      }
      p->iter_used = 0;
      p->time_used = 0.0;
      return 0;
}

/*----------------------------------------------------------------------
-- initialize - initialize simplex method environment.
--
-- This routine creates and initializes all data structures related to
-- the simplex meth for linear programming. */

static void initialize(LPI *lp)
{     int i, j;
      /* determine problem dimension */
      m = glp_get_num_rows(lp);
      n = glp_get_num_cols(lp);
      if (m == 0) fault(prefix "problem has no rows");
      if (n == 0) fault(prefix "problem has no columns");
      /* create RSM */
      rsm = create_rsm(lp);
      /* obtain coefficients of the objective function (including the
         constant term) */
      coef = ucalloc(1+n, sizeof(double));
      for (j = 0; j <= n; j++) coef[j] = glp_get_obj_coef(lp, j);
      /* determine optimization direction */
      dir = glp_get_obj_sense(lp);
      /* create and initialize scaling matrices */
      R = ucalloc(1+m, sizeof(double));
      for (i = 1; i <= m; i++) R[i] = 1.0;
      S = ucalloc(1+n, sizeof(double));
      for (j = 1; j <= n; j++) S[j] = 1.0;
      /* create and initialize the vectors delta and gamma needed for
         steepest edge pricing (if required) */
      dvec = gvec = NULL;
      if (parm->steep)
      {  dvec = ucalloc(1+m, sizeof(double));
         for (i = 1; i <= m; i++) dvec[i] = 1.0;
         gvec = ucalloc(1+n, sizeof(double));
         for (j = 1; j <= n; j++) gvec[j] = 1.0;
      }
      /* reset phase indicator */
      phase = 0;
      /* reset meth indicator */
      meth = 0;
      /* allocate additional working arrays */
      bbar = ucalloc(1+m, sizeof(double));
      cost = ucalloc(1+m+n, sizeof(double));
      pi = ucalloc(1+m, sizeof(double));
      cbar = ucalloc(1+n, sizeof(double));
      /* initialize stop-watch */
      t_start = clock();
      t_last = 0;
      /* return to the driver routine */
      return;
}

/*----------------------------------------------------------------------
-- scale_problem - scale the problem.
--
-- This routine obtains row and column scale factors from the problem
-- object and constructs the scaling matrices R and S. Then the routine
-- uses the scaling matrices in order to scale the problem data in the
-- RSM block (the problem object is not changed). */

static void scale_problem(LPI *lp)
{     int i, j;
      /* obtain row scale factors */
      for (i = 1; i <= m; i++)
      {  R[i] = glp_get_row_fctr(lp, i);
         insist(R[i] > 0.0);
      }
      /* obtain column scale factors */
      for (j = 1; j <= n; j++)
      {  S[j] = glp_get_col_fctr(lp, j);
         insist(S[j] > 0.0);
      }
      /* scale bounds of variables of constraint coefficients */
      scale_rsm(rsm, R, S);
      /* scale the vector of objective coefficients */
      for (j = 1; j <= n; j++) coef[j] *= S[j];
      return;
}

/*----------------------------------------------------------------------
-- check_basis - determine status of the initial basis.
--
-- This routine analyzes the initial basis and set indicators that show
-- its status as follows:
--
--                Basis status               bstat     status
--    ------------------------------------   -----   ----------
--    Neither primal nor dual feasible        'N'    GLP_INFEAS
--    Primal feasible, but dual infeasible    'P'    GLP_FEAS
--    Primal infeasible, but dual feasible    'D'    GLP_INFEAS
--    Primal and dual feasible (optimal)      'O'    GLP_OPT
--
-- It is assumed that the basis matrix has been reinverted. */

static void check_basis(int *bstat, int *status)
{     int prim, dual, i, j;
      /* check for primal feasibility */
      eval_bbar(rsm, bbar);
      prim = (check_bbar(rsm, bbar, parm->tol_bnd) ? 0 : 1);
      /* check for dual feasibility */
      for (i = 1; i <= m; i++) cost[i] = 0.0;
      for (j = 1; j <= n; j++)
         cost[m+j] = (dir == '-' ? +1.0 : -1.0) * coef[j];
      eval_pi(rsm, cost, pi);
      eval_cbar(rsm, cost, pi, cbar);
      dual = (check_cbar(rsm, cost, cbar, parm->tol_dj) ? 0 : 1);
      /* set basis status indicators */
      if (prim)
      {  if (dual)
            *bstat = 'O', *status = GLP_OPT;
         else
            *bstat = 'P', *status = GLP_FEAS;
      }
      else
      {  if (dual)
            *bstat = 'D', *status = GLP_INFEAS;
         else
            *bstat = 'N', *status = GLP_INFEAS;
      }
      return;
}

/*----------------------------------------------------------------------
-- store_soln - store current basis solution.
--
-- This routine computes components of the current basis solution and
-- stores them to the problem object.
--
-- The parameters bstat and status should specify status of the current
-- basis (see comments to the routine check_basis). */

static void store_soln(LPI *lp, int bstat, int status)
{     int i, j, k;
      double obj;
      /* compute current values of basic variables */
      eval_bbar(rsm, bbar);
      /* build the expanded vector of objective coefficients */
      for (i = 1; i <= m; i++) cost[i] = 0.0;
      for (j = 1; j <= n; j++) cost[m+j] = coef[j];
      /* compute simplex multipliers */
      eval_pi(rsm, cost, pi);
      /* compute reduced costs of non-basic variables */
      eval_cbar(rsm, cost, pi, cbar);
      /* unscale and store primal and dual values of all variables;
         also compute the objective function */
      obj = coef[0];
      for (k = 1; k <= m+n; k++)
      {  int tagx;
         double valx, dx;
         if (rsm->posx[k] > 0)
         {  i = +rsm->posx[k]; /* xB[i] = x[k] */
            tagx = 'B';
            valx = bbar[i];
            if (parm->round && fabs(valx) < parm->tol_bnd) valx = 0.0;
            dx = 0.0;
         }
         else
         {  j = -rsm->posx[k]; /* xN[j] = x[k] */
            tagx = rsm->tagn[j];
            valx = eval_xn(rsm, j);
            dx = cbar[j];
            if (parm->round && fabs(dx) < parm->tol_dj) dx = 0.0;
         }
         if (k <= m)
         {  /* x[k] is auxiliary variable */
            glp_put_row_soln(lp, k, tagx, valx / R[k], dx * R[k]);
         }
         else
         {  /* x[k] is structural variable */
            obj += coef[k-m] * valx;
            glp_put_col_soln(lp, k-m, tagx, valx * S[k-m], dx / S[k-m]);
         }
      }
      /* store main solution information */
      glp_put_soln_info(lp, bstat, status, obj);
      return;
}

/*----------------------------------------------------------------------
-- display - display visual information.
--
-- This routine displays visual information which includes iteration
-- number, value of the objective function, sum of infeasibilities, and
-- defect of the basis solution (number of fixed basic variables). */

static void display(void)
{     int i, j, k, def, c;
      double obj, sum;
      /* compute current values of basic variables */
      eval_bbar(rsm, bbar);
      /* compute current value of the objective function */
      obj = coef[0];
      for (j = 1; j <= n; j++)
      {  double xj;
         k = m+j;
         if (rsm->posx[k] > 0)
            xj = bbar[+rsm->posx[k]];
         else
            xj = eval_xn(rsm, -rsm->posx[k]);
         obj += coef[j] * xj;
      }
      /* compute sum of infeasibilities */
      sum = 0.0;
      for (i = 1; i <= m; i++)
      {  k = rsm->indb[i]; /* x[k] = xB[i] */
         if (rsm->type[k] == 'L' ||
             rsm->type[k] == 'D' ||
             rsm->type[k] == 'S')
         {  /* x[k] is basic variable and has lower bound */
            if (bbar[i] < rsm->lb[k]) sum += (rsm->lb[k] - bbar[i]);
         }
         if (rsm->type[k] == 'U' ||
             rsm->type[k] == 'D' ||
             rsm->type[k] == 'S')
         {  /* x[k] is basic variable and has upper bound */
            if (bbar[i] > rsm->ub[k]) sum += (bbar[i] - rsm->ub[k]);
         }
      }
      /* determine defect of the basis solution (which is a number of
         fixed basic variables) */
      def = 0;
      for (i = 1; i <= m; i++)
      {  k = rsm->indb[i]; /* x[k] = xB[i] */
         if (rsm->type[k] == 'S') def++;
      }
      /* set phase/method indicating character */
      switch (phase)
      {  case 1:
            switch (meth)
            {  case 'P': c = ' '; break;
               case 'D': c = 'd'; break;
               default:  insist(meth != meth);
            }
            break;
         case 2:
            switch (meth)
            {  case 'P': c = '*'; break;
               case 'D': c = 'D'; break;
               default:  insist(meth != meth);
            }
            break;
         default:
            insist(phase != phase);
      }
      /* display visual information */
      print("%c%6d:   objval = %17.9e   infsum = %17.9e (%d)",
         c, rsm->iter, obj, sum, def);
      return;
}

/*----------------------------------------------------------------------
-- monit - monitoring routine.
--
-- This routine is called by the simplex method routines every time
-- before the next iteration. It displays some visual information and
-- performs necessary checks used to terminate the search.
--
-- If this routine tells the solver to stop the search, it reports the
-- reason via the indicator why (see below). */

static int why;
/* this indicator explains why the monitoring routine told the solver
   to terminate the search:
   0 - n/a
   1 - iteration limit exceeded
   2 - time limit exceeded
   3 - the objective function is less than obj_min and continues to be
       decreasing (on the phase II only)
   4 - the objective function is greater than obj_max and continues to
       be increasing (on the phase II only) */

static int monit(void)
{     int t_curr = clock();
      double elap, intv;
      /* determine how many seconds gone since the solver started */
      elap = (double)(t_curr - t_start) / (double)CLOCKS_PER_SEC;
      /* determine how many seconds gone since the last output */
      intv = (double)(t_curr - t_last) / (double)CLOCKS_PER_SEC;
      /* display visual information if at least delay seconds have gone
         since the solver started and if at least freq seconds have gone
         since the last output */
      if (elap >= parm->delay && (t_last == 0 || intv >= parm->freq))
      {  display();
         t_last = t_curr;
      }
      /* reset the explanation indicator */
      why = 0;
      /* check if iteration limit exceeded */
      if (rsm->iter >= parm->max_iter)
      {  why = 1;
         goto done;
      }
      /* check if time limit exceeded */
      if (elap >= parm->max_time)
      {  why = 2;
         goto done;
      }
      /* check if the objective function left the allowable range and
         is moving away from it (only for the phase II) */
      if (!(parm->obj_min == -DBL_MAX && parm->obj_max == +DBL_MAX) &&
            phase == 2)
      {  int j, k;
         double obj;
         /* compute current values of basic variables */
         eval_bbar(rsm, bbar);
         /* compute current value of the objective function */
         obj = coef[0];
         for (j = 1; j <= n; j++)
         {  double xj;
            k = m+j;
            if (rsm->posx[k] > 0)
               xj = bbar[+rsm->posx[k]];
            else
               xj = eval_xn(rsm, -rsm->posx[k]);
            obj += coef[j] * xj;
         }
         switch (meth)
         {  case 'P':
               /* the primal simplex method is being used */
               switch (dir)
               {  case '-':
                     /* in case of minimization the objective function
                        can only decrease */
                     if (obj < parm->obj_min) why = 3;
                     break;
                  case '+':
                     /* in case of maximization the objective function
                        can only increase */
                     if (obj > parm->obj_max) why = 4;
                     break;
               }
               break;
            case 'D':
               /* the dual simplex method is being used */
               switch (dir)
               {  case '-':
                     /* in case of minimization the objective function
                        can only increase */
                     if (obj > parm->obj_max) why = 4;
                     break;
                  case '+':
                     /* in case of maximization the objective function
                        can only decrease */
                     if (obj < parm->obj_min) why = 3;
                     break;
               }
               break;
         }
      }
      /* bring the return code to the calling routine */
done: return why;
}

/*----------------------------------------------------------------------
-- feas_by_prim - find feasible solution using primal simplex.
--
-- This routine searches for primal feasible solution of the problem
-- using the method of implicit artificial variables based on the primal
-- simplex method.
--
-- The routine returns one of the following codes:
--
-- 0 - primal feasible solution found;
-- 1 - problem has no (primal) feasible solution;
-- 2 - numerical stability lost (the current basis solution of some
--     auxiliary LP problem became infeasible due to round-off errors);
-- 3 - numerical problems with basis matrix (the current basis matrix
--     became singular or ill-conditioned due to unsuccessful choice of
--     the pivot element on the last simplex iteration);
-- 4 - iteration limit exceeded;
-- 5 - time limit exceeded. */

static int feas_by_prim(void)
{     int ret;
      insist(phase == 1);
      meth = 'P';
      ret = rsm_feas(rsm, monit, parm->tol_bnd, parm->tol_dj,
         parm->tol_piv, gvec, parm->relax);
      if (ret == 4)
      {  /* premature termination due to the monitoring routine */
         switch (why)
         {  case 1:
               ret = 4; break;
            case 2:
               ret = 5; break;
            default:
               insist(why != why);
         }
      }
      return ret;
}

/*----------------------------------------------------------------------
-- feas_by_dual - find feasible solution using dual simplex.
--
-- This routine searches for primal feasible solution of the problem
-- using the dual simplex method and artificial objective function that
-- makes the current basis dual feasible.
--
-- 0 - primal feasible solution found;
-- 1 - problem has no (primal) feasible solution;
-- 2 - numerical stability lost (the current basis solution of some
--     auxiliary LP problem became infeasible due to round-off errors);
-- 3 - numerical problems with basis matrix (the current basis matrix
--     became singular or ill-conditioned due to unsuccessful choice of
--     the pivot element on the last simplex iteration);
-- 4 - iteration limit exceeded;
-- 5 - time limit exceeded. */

static int feas_by_dual(void)
{     int j, k, ret;
      /* construct artificial objective function that makes the current
         basis dual feasible */
      for (k = 1; k <= m+n; k++) cost[k] = 0.0;
      for (j = 1; j <= n; j++)
      {  k = rsm->indn[j]; /* x[k] = xN[j] */
         switch (rsm->tagn[j])
         {  case 'F': cost[k] =  0.0; break;
            case 'L': cost[k] = +1.0; break;
            case 'U': cost[k] = -1.0; break;
            case 'S': cost[k] =  0.0; break;
            default:  insist(rsm->tagn[j] != rsm->tagn[j]);
         }
      }
      /* apply the dual simplex method */
      insist(phase == 1);
      meth = 'D';
      ret = rsm_dual(rsm, monit, cost, 0.30 * parm->tol_bnd,
         parm->tol_dj, parm->tol_piv, dvec, parm->relax);
      if (ret == 4)
      {  /* premature termination due to the monitoring routine */
         switch (why)
         {  case 1:
               ret = 4; break;
            case 2:
               ret = 5; break;
            default:
               insist(why != why);
         }
      }
      return ret;
}

/*----------------------------------------------------------------------
-- opt_by_prim - find optimal solution using primal simplex.
--
-- This routine searches for optimal solution of the problem using the
-- primal simplex method. It is assumed that on entry the current basis
-- is primal feasible.
--
-- The routine returns one of the following codes:
--
-- 0 - optimal solution found;
-- 1 - problem has unbounded solution;
-- 2 - numerical stability lost (the current basis solution of some
--     auxiliary LP problem became infeasible due to round-off errors);
-- 3 - numerical problems with basis matrix (the current basis matrix
--     became singular or ill-conditioned due to unsuccessful choice of
--     the pivot element on the last simplex iteration);
-- 4 - iteration limit exceeded;
-- 5 - time limit exceeded;
-- 6 - the objective function is less than obj_min and continues to be
--     decreasing (in case of minimization);
-- 7 - the objective function is greater than obj_max and continues to
--     be increasing (in case of maximization). */

static int opt_by_prim(void)
{     int i, j, ret;
      /* construct the working objective function (this function is
         always minimized) */
      for (i = 1; i <= m; i++) cost[i] = 0.0;
      for (j = 1; j <= n; j++)
         cost[m+j] = (dir == '-' ? +1.0 : -1.0) * coef[j];
      /* apply the primal simplex method */
      insist(phase == 2);
      meth = 'P';
      ret = rsm_primal(rsm, monit, cost, parm->tol_bnd, parm->tol_dj,
         parm->tol_piv, gvec, parm->relax);
      if (ret == 4)
      {  /* premature termination due to the monitoring routine */
         switch (why)
         {  case 1:
               ret = 4; break;
            case 2:
               ret = 5; break;
            case 3:
               ret = 6; break;
            case 4:
               ret = 7; break;
            default:
               insist(why != why);
         }
      }
      return ret;
}

/*----------------------------------------------------------------------
-- opt_by_dual - find optimial solution using dual simplex.
--
-- This routine searches for optimal solution of the problem using the
-- dual simplex method. It is assumed that on entry the current basis
-- is dual feasible.
--
-- The routine returns one of the following codes:
--
-- 0 - optimal solution found;
-- 1 - problem has no (primal) feasible solution;
-- 2 - numerical stability lost (the current basis solution of some
--     auxiliary LP problem became infeasible due to round-off errors);
-- 3 - numerical problems with basis matrix (the current basis matrix
--     became singular or ill-conditioned due to unsuccessful choice of
--     the pivot element on the last simplex iteration);
-- 4 - iteration limit exceeded;
-- 5 - time limit exceeded;
-- 6 - the objective function is less than obj_min and continues to be
--     decreasing (in case of maximization);
-- 7 - the objective function is greater than obj_max and continues to
--     be increasing (in case of minimization). */

static int opt_by_dual(void)
{     /* poisk optimalxnogo re[eniq using dual simplex */
      int i, j, ret;
      /* construct the working objective function (this function is
         always minimized) */
      for (i = 1; i <= m; i++) cost[i] = 0.0;
      for (j = 1; j <= n; j++)
         cost[m+j] = (dir == '-' ? +1.0 : -1.0) * coef[j];
      /* apply the dual simplex method */
      insist(phase == 2);
      meth = 'D';
      ret = rsm_dual(rsm, monit, cost, parm->tol_bnd, parm->tol_dj,
         parm->tol_piv, dvec, parm->relax);
      if (ret == 4)
      {  /* premature termination due to the monitoring routine */
         switch (why)
         {  case 1:
               ret = 4; break;
            case 2:
               ret = 5; break;
            case 3:
               ret = 6; break;
            case 4:
               ret = 7; break;
            default:
               insist(why != why);
         }
      }
      return ret;
}

/*----------------------------------------------------------------------
-- terminate - terminate simplex method environment.
--
-- This routine frees all the memory allocated to the simplex method
-- data structures. */

static void terminate(void)
{     delete_rsm(rsm);
      ufree(coef);
      ufree(R);
      ufree(S);
      if (dvec != NULL) ufree(dvec);
      if (gvec != NULL) ufree(gvec);
      ufree(bbar);
      ufree(cost);
      ufree(pi);
      ufree(cbar);
      return;
}

/*----------------------------------------------------------------------
-- glp_simplex1 - simplex method driver routine.
--
-- This routine is a driver to the simplex method. Description of this
-- routine is given on the top of this file. */

int glp_simplex1(LPI *lp, struct spx1 *_parm)
{     struct spx1 parm_;
      int bstat, status, ret;
      /* if parameter block is not specified, create the dummy one */
      if (_parm == NULL)
      {  _parm = &parm_;
         glp_init_spx1(_parm);
      }
      /* check control parameters for correctness */
      parm = _parm;
      if (check_parm())
      {  glp_put_soln_info(lp, '?', GLP_UNDEF, 0.0);
         return +1;
      }
      /* initialize simplex method environment */
      initialize(lp);
      /* scale the problem (if required) */
      if (parm->scale) scale_problem(lp);
      /* build the initial basis as specified in the problem object
         (if required) */
      if (parm->initb)
      {  ret = build_basis(rsm, lp);
         switch (ret)
         {  case 0:
               /* no errors */
               break;
            case 1:
               error(prefix "type of some row/column is not compatible "
                  "with its status");
               ret = +2;
               goto done;
            case 2:
               error(prefix "initial basis has invalid structure");
               ret = +2;
               goto done;
            case 3:
               error(prefix "unable to invert initial basis matrix");
               ret = +2;
               goto done;
            default:
               insist(ret != ret);
         }
      }
      /* determine status of the initial basis */
      check_basis(&bstat, &status);
      /* store solution that corresponds to the initial basis */
      store_soln(lp, bstat, status);
      /* if no iterations are allowed, then all done */
      if (parm->max_iter == 0)
      {  ret = -1;
         goto done;
      }
      /* if no time is allowed, then all done */
      if (parm->max_time == 0.0)
      {  ret = -2;
         goto done;
      }
      /* choose a variant of the simplex method depending on status of
         the initial basis */
      switch (bstat)
      {  case 'N':
            /* basis is neither dual nor primal feasible */
            if (!parm->feas)
            {  /* start phase I using the primal simplex */
               goto phase_1_by_primal;
            }
            else
            {  /* start phase I using the dual simplex */
               goto phase_1_by_dual;
            }
         case 'P':
            /* basis is primal feasible but dual infeasible */
            /* start phase II using the primal simplex */
            goto phase_2_by_primal;
         case 'D':
            /* basis is primal infeasible but dual feasible */
            if (parm->dual)
            {  /* start phase II using the dual simplex */
               goto phase_2_by_dual;
            }
            else if (!parm->feas)
            {  /* start phase I using the primal simplex */
               goto phase_1_by_primal;
            }
            else
            {  /* start phase I using the dual simplex */
               goto phase_1_by_dual;
            }
         case 'O':
            /* basis is optimal; nothing to search for */
            ret = 0;
            goto done;
         default:
            insist(bstat != bstat);
      }
      /* it may happen that due to excessive round-off errors the basis
         becomes primal (dual) infeasible and the primal (dual) simplex
         method fails; in this case the search restarts from the phase I
         using the primal simplex method */
recover_basis:
      print("Numerical instability; recovering...");
      /* reinvert the current basis matrix (as a rule this helps to
         improve accuracy of the representation) */
      if (invert_b(rsm))
singular_basis:
      {  error("Numerical problems with basis matrix");
         error("Sorry, basis repairing procedure not implemented");
         ret = +3;
         goto done;
      }
      /* reset the vectors delta and gamma */
      if (dvec != NULL)
      {  int i;
         for (i = 1; i <= m; i++) dvec[i] = 1.0;
      }
      if (gvec != NULL)
      {  int j;
         for (j = 1; j <= n; j++) gvec[j] = 1.0;
      }
      /* find feasible solution using the primal simplex method */
phase_1_by_primal:
      phase = 1;
      if (!parm->quiet)
         print("Searching for feasible solution (primal simplex)...");
      ret = feas_by_prim();
      /* analyze return code */
      switch (ret)
      {  case 0:
            /* primal feasible solution found */
            if (!parm->quiet) display();
            store_soln(lp, 'P', GLP_FEAS);
            goto phase_2_by_primal;
         case 1:
            /* problem has no (primal) feasible solution */
            if (!parm->quiet) display();
            store_soln(lp, 'N', GLP_NOFEAS);
            if (!parm->quiet)
               print("PROBLEM HAS NO FEASIBLE SOLUTION");
            ret = 0;
            goto done;
         case 2:
            /* numerical stability lost */
            goto recover_basis;
         case 3:
            /* numerical problems with basis matrix */
            goto singular_basis;
         case 4:
            /* iteration limit exceeded */
            if (!parm->quiet) display();
            store_soln(lp, 'N', GLP_INFEAS);
            if (!parm->quiet)
               print("ITERATION LIMIT EXCEEDED; SEARCH TERMINATED");
            ret = -1;
            goto done;
         case 5:
            /* time limit exceeded */
            if (!parm->quiet) display();
            store_soln(lp, 'N', GLP_INFEAS);
            if (!parm->quiet)
               print("TIME LIMIT EXCEEDED; SEARCH TERMINATED");
            ret = -2;
            goto done;
         default:
            insist(ret != ret);
      }
      /* find feasible solution using the dual simplex method */
phase_1_by_dual:
      phase = 1;
      if (!parm->quiet)
         print("Searching for feasible solution (dual simplex)...");
      ret = feas_by_dual();
      /* analyze return code */
      switch (ret)
      {  case 0:
            /* primal feasible solution found */
            if (!parm->quiet) display();
            store_soln(lp, 'P', GLP_FEAS);
            goto phase_2_by_primal;
         case 1:
            /* problem has no (primal) feasible solution */
            if (!parm->quiet) display();
            store_soln(lp, 'N', GLP_NOFEAS);
            if (!parm->quiet)
               print("PROBLEM HAS NO FEASIBLE SOLUTION");
            ret = 0;
            goto done;
         case 2:
            /* numerical stability lost */
            goto recover_basis;
         case 3:
            /* numerical problems with basis matrix */
            goto singular_basis;
         case 4:
            /* iteration limit exceeded */
            if (!parm->quiet) display();
            store_soln(lp, 'N', GLP_INFEAS);
            if (!parm->quiet)
               print("ITERATION LIMIT EXCEEDED; SEARCH TERMINATED");
            ret = -1;
            goto done;
         case 5:
            /* time limit exceeded */
            if (!parm->quiet) display();
            store_soln(lp, 'N', GLP_INFEAS);
            if (!parm->quiet)
               print("TIME LIMIT EXCEEDED; SEARCH TERMINATED");
            ret = -2;
            goto done;
         default:
            insist(ret != ret);
      }
      /* find optimal solution using the primal simplex method */
phase_2_by_primal:
      phase = 2;
      if (!parm->quiet)
         print("Searching for optimal solution (primal simplex)...");
      ret = opt_by_prim();
      /* analyze return code */
      switch (ret)
      {  case 0:
            /* optimal solution found */
            if (!parm->quiet) display();
            store_soln(lp, 'O', GLP_OPT);
            if (!parm->quiet)
               print("OPTIMAL SOLUTION FOUND");
            ret = 0;
            goto done;
         case 1:
            /* problem has unbounded solution */
            if (!parm->quiet) display();
            store_soln(lp, 'P', GLP_UNBND);
            if (!parm->quiet)
               print("PROBLEM HAS UNBOUNDED SOLUTION");
            ret = 0;
            goto done;
         case 2:
            /* numerical stability lost */
            goto recover_basis;
         case 3:
            /* numerical problems with basis matrix */
            goto singular_basis;
         case 4:
            /* iteration limit exceeded */
            if (!parm->quiet) display();
            store_soln(lp, 'P', GLP_FEAS);
            if (!parm->quiet)
               print("ITERATION LIMIT EXCEEDED; SEARCH TERMINATED");
            ret = -1;
            goto done;
         case 5:
            /* time limit exceeded */
            if (!parm->quiet) display();
            store_soln(lp, 'P', GLP_FEAS);
            if (!parm->quiet)
               print("TIME LIMIT EXCEEDED; SEARCH TERMINATED");
            ret = -2;
            goto done;
         case 6:
            /* the objective function is less than obj_min */
            if (!parm->quiet) display();
            store_soln(lp, 'P', GLP_FEAS);
            if (!parm->quiet)
               print("OBJECTIVE LOWER LIMIT; SEARCH TERMINATED");
            ret = -3;
            goto done;
         case 7:
            /* the objective function is greater than obj_max */
            if (!parm->quiet) display();
            store_soln(lp, 'P', GLP_FEAS);
            if (!parm->quiet)
               print("OBJECTIVE UPPER LIMIT; SEARCH TERMINATED");
            ret = -4;
            goto done;
         default:
            insist(ret != ret);
      }
      /* find optimal solution using the dual simplex method */
phase_2_by_dual:
      phase = 2;
      if (!parm->quiet)
         print("Searching for optimal solution (dual simplex)...");
      ret = opt_by_dual();
      /* analyze return code */
      switch (ret)
      {  case 0:
            /* optimal solution found */
            if (!parm->quiet) display();
            store_soln(lp, 'O', GLP_OPT);
            if (!parm->quiet)
               print("OPTIMAL SOLUTION FOUND");
            ret = 0;
            goto done;
         case 1:
            /* problem has no (primal) feasible solution */
            if (!parm->quiet) display();
            store_soln(lp, 'D', GLP_NOFEAS);
            if (!parm->quiet)
               print("PROBLEM HAS NO FEASIBLE SOLUTION");
            ret = 0;
            goto done;
         case 2:
            /* numerical stability lost */
            goto recover_basis;
         case 3:
            /* numerical problems with basis matrix */
            goto singular_basis;
         case 4:
            /* iteration limit exceeded */
            if (!parm->quiet) display();
            store_soln(lp, 'D', GLP_INFEAS);
            if (!parm->quiet)
               print("ITERATION LIMIT EXCEEDED; SEARCH TERMINATED");
            ret = -1;
            goto done;
         case 5:
            /* time limit exceeded */
            if (!parm->quiet) display();
            store_soln(lp, 'D', GLP_INFEAS);
            if (!parm->quiet)
               print("TIME LIMIT EXCEEDED; SEARCH TERMINATED");
            ret = -2;
            goto done;
         case 6:
            /* the objective function is less than obj_min */
            if (!parm->quiet) display();
            store_soln(lp, 'D', GLP_INFEAS);
            if (!parm->quiet)
               print("OBJECTIVE LOWER LIMIT; SEARCH TERMINATED");
            ret = -3;
            goto done;
         case 7:
            /* the objective function is greater than obj_max */
            if (!parm->quiet) display();
            store_soln(lp, 'D', GLP_INFEAS);
            if (!parm->quiet)
               print("OBJECTIVE UPPER LIMIT; SEARCH TERMINATED");
            ret = -4;
            goto done;
         default:
            insist(ret != ret);
      }
done: /* terminate simplex method environment */
      terminate();
      /* if an error occured, the solution is undefined */
      if (ret > 0) glp_put_soln_info(lp, '?', GLP_UNDEF, 0.0);
      /* report some statistics */
      parm->iter_used = rsm->iter;
      parm->time_used =
         (double)(clock() - t_start) / (double)CLOCKS_PER_SEC;
      /* return to the application program */
      return ret;
}

/* eof */
