/* glpapi7.c (glp_simplex2) */

/*----------------------------------------------------------------------
-- 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 <float.h>
#include <math.h>
#include <string.h>
#include "glpk.h"
#include "glplib.h"
#include "glpspx.h"

#define error print

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

void glp_init_spx2(struct spx2 *parm)
{     parm->scale = 1;
      parm->initb = 1;
      parm->round = 1;
      parm->tol_bnd = 1e-8;
      parm->tol_dj = 1e-7;
#if 0
      parm->tol_piv = 1e-10;
#else
      parm->tol_piv = 1e-8;
#endif
      return;
}

/*----------------------------------------------------------------------
-- glp_simplex2 - solve LP problem using primal simplex method.
--
-- *Synopsis*
--
-- #include "glpk.h"
-- int glp_simplex2(LPI *lp, struct spx2 *parm);
--
-- *Description*
--
-- The routine glp_simplex2 is an LP problem solver, which is based on
-- the two-phase primal simplex method.
--
-- This routine obtains problem data from a problem object, which the
-- parameter lp points to, solves the problem, and stores the computed
-- solution back to the problem object.
--
-- The parameter parm is a pointer to the parameter block used by the
-- solver. This block may be initialized by the routine glp_init_spx2
-- by standard default values. It is allowed to specify NULL, in which
-- case standard default values are used. If the problem is not very
-- hard, the standard default values fit for most cases.
--
-- Since large-scale problems may take a long time, the solver reports
-- some visual information about current status of the search. This
-- information is sent to stdout once per 100 simplex iterations using
-- the following format:
--
--    nnn:   objval = xxx   infeas = yyy (ddd)
--
-- where nnn is the iteration count, xxx is the current value of the
-- objective function (which is unscaled and has correct sign), yyy is
-- a measure of primal infeasibility (which is the current value of the
-- artificial variable introduced on the phase I), ddd is the number of
-- basic fixed variables.
--
-- Please note that this solver is not perfect. Although it has been
-- successfully tested on a wide set of real LP problems, there are so
-- called hard problems, which can't be resolved by this solver.
--
-- *Returns*
--
-- The routine glp_simplex2 returns one of the following codes:
--
-- 0 - no errors. This case means that the solver has successfully
--     finished solving the problem. (Note, for example, if the problem
--     has no feasible solution, the solver returns zero code);
-- 1 - (reserved for future use);
-- 2 - numerical problems with basis matrix. This case means that the
--     solver is not able to solve the problem. */

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

static int m;
/* number of rows (auxiliary variables) */

static int n;
/* number of columns (structural variables); this number includes an
   extra column reserved for the artificial variable */

static int nz;
/* number of non-zeros in the original constraint matrix (this number
   doesn't include elements in the artificial variable column) */

static int *typx; /* int typx[1+m+n]; */
/* type[0] is not used; type[k] specifies the type of variable x[k]
   (1 <= k <= m+n):
   'F' - free variable:    -inf <  x[k] < +inf
   'L' - lower bound:      l[k] <= x[k] < +inf
   'U' - upper bound:      -inf <  x[k] <= u[k]
   'D' - double bound:     l[k] <= x[k] <= u[k]
   'S' - fixed variable:   l[k]  = x[k]  = u[k] */

static double *lb; /* double lb[1+m+n]; */
/* lb[0] is not used; lb[k] is the lower bound of variable x[k]
    (1 <= k <= m+n); if x[k] has no lower bound, lb[k] is zero */

static double *ub; /* double ub[1+m+n]; */
/* ub[0] is not used; ub[k] is the upper bound of variable x[k]
   (1 <= k <= m+n); if x[k] has no upper bound, ub[k] is zero;
   if x[k] is fixed variable, lb[k] is equal to ub[k] */

/* the following three arrays is a representation of the constraint
   matrix A in column-wise format; the arrays ia and an have m extra
   locations reserved for the column of the artificial variable */

static int *ja; /* int ja[1+n+1]; */
/* ja[0] is not used; ja[j], j = 1, ..., n, is a pointer to the first
   element of the j-th column of the matrix A in the arrays ia and an;
   ja[n+1] is a pointer to the first unused location */

static int *ia; /* int ia[1+nz+m]; */
/* ia[0] is not used; ia[t] is the row index of an element placed in
   t-th location */

static double *an; /* double an[1+nz+m]; */
/* an[0] is not used; an[t] is the numerical value of an element placed
   in t-th location */

static SPXMAT _A, *A = &_A;
/* the constraint matrix A in the procedural format */

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

static double *coef; /* double coef[1+n]; */
/* coef[0] is a constant term of the objective function;
   coef[j], j = 1, ..., n, is a coefficient of the objective function
   at the structural variable x[m+j] = xS[j] */

static double *R, *S; /* double R[1+m], 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 the scaling is not used */

static int *posx; /* int posx[1+m+n]; */
/* posx[0] is not used; posx[k] is the position of the variable x[k]
   (1 <= k <= m+n) in the vector xB of basis variables or in the vector
   xN of non-basis variables:
   posx[k] = +i means that x[k] = xB[i] (1 <= i <= m)
   posx[k] = -j means that x[k] = xN[j] (1 <= j <= n) */

static int *indb; /* int indb[1+m]; */
/* indb[0] is not used; indb[i] = k means that xB[i] = x[k] */

static int *indn; /* int indn[1+n]; */
/* indn[0] is not used; indn[j] = k means that xN[j] = x[k] */

static int *tagn; /* int tagn[1+n]; */
/* tagn[0] is not used; tagn[j] is the status of the non-basis variable
   xN[j] (1 <= j <= n):
   'L' - non-basis variable on its lower bound
   'U' - non-basis variable on its upper bound
   'F' - non-basis free variable
   'S' - non-basis fixed variable */

static SPXBAS *B;
/* some representation of the basis matrix */

static int iter;
/* iteration count; it is increased each time when the current basis is
   replaced by the adjacent one */

static double *cost; /* double cost[1+m+n]; */
/* cost[0] is not used; cost[k], k = 1, ..., m+n, is a coeffcient of
   the working objective function (which is always minimized) at the
   (auxiliary or structural) variable x[k] */

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

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

static double *cbar; /* double cbar[1+n]; */
/* the vector of reduced costs of non-basic variables */

static int *refsp; /* int refsp[1+m+n]; */
/* refsp[0] is not used; refsp[k], k = 1, ..., m+n, is set if the
   variable x[k] belongs to the current reference space, and is clear
   if x[k] doesn't (this array is used in the projected steepest edge
   technique) */

static double *gvec; /* double gvec[1+n]; */
/* the vector gamma (used in the projected steepest edge technique) */

static int q;
/* the number of non-basic variable (xN)q (1 <= q <= n) chosen to enter
   the basis; zero means that the choice is impossible because the basis
   solution is dual feasible */

static double *aq; /* double aq[1+m]; */
/* q-th column of the simplex table A^ = -inv(B)*N */

static int p;
/* the number of basic variable (xB)p (1 <= p <= m) chosen to leave the
   basis; negative number means that the non-basic variable (xN)q should
   go from its current bound to the opposite one; zero means that the
   choice is impossible because (xN)q can infinitely change */

static int tagp;
/* the tag which should be set for the chosen basic variable (xB)p when
   it has left the basis and became non-basic (see tagn) */

static double *zeta; /* double zeta[1+m]; */
/* p-th row of the inverse inv(B) */

static double *ap; /* double ap[1+n]; */
/* p-th row of the simplex table A^ = -inv(B)*N */

static int *rn; /* int rn[1+m]; */
/* working array */

static double *ak; /* double ak[1+m]; */
/* working array */

static double *w; /* double w[1+m]; */
/* working array */

static int debug = 0;
/* debug mode flag */

/*----------------------------------------------------------------------
-- check_parm - check control parameters for correctness.
--
-- This routine checks control parameters specified in the parameter
-- block for correctness. */

static void check_parm(struct spx2 *parm)
{     struct spx2 *p = parm;
      if (!(p->scale == 0 || p->scale == 1 || p->scale == 2))
         fault(prefix "scale = %d; invalid parameter", p->scale);
      if (!(p->initb == 0 || p->initb == 1 || p->initb == 2))
         fault(prefix "initb = %d; invalid parameter", p->initb);
      if (!(p->round == 0 || p->round == 1))
         fault(prefix "round = %d; invalid parameter", p->round);
      if (!(0.0 < p->tol_bnd && p->tol_bnd < 1.0))
         fault(prefix "tol_bnd = %g; invalid parameter", p->tol_bnd);
      if (!(0.0 < p->tol_dj && p->tol_dj < 1.0))
         fault(prefix "tol_dj = %g; invalid parameter", p->tol_dj);
      if (!(0.0 < p->tol_piv && p->tol_piv < 1.0))
         fault(prefix "tol_piv = %g; invalid parameter", p->tol_piv);
      return;
}

/*----------------------------------------------------------------------
-- column - extract column of the constraint matrix.
--
-- This routine extracts elements of the j-th column of the constraint
-- matrix A and stores their row indices and numerical values to the
-- locations rn[1], ..., rn[cnt] and aj[1], ..., aj[cnt], where cnt is
-- the number of elements in the j-th column. */

static int column(void *info, int j, int rn[], double aj[])
{     int beg, cnt;
      insist(info == info);
      insist(1 <= j && j <= n);
      beg = ja[j];
      cnt = ja[j+1] - beg;
      if (cnt > 0)
      {  memcpy(&rn[1], &ia[beg], cnt * sizeof(int));
         memcpy(&aj[1], &an[beg], cnt * sizeof(double));
      }
      return cnt;
}

/*----------------------------------------------------------------------
-- initialize - allocate and initialize common data structures.
--
-- This routine allocates and initializes all data structures related
-- to the simplex method. */

static void initialize(LPI *lp)
{     int i, j, k;
      /* determine problem dimension */
      m = glp_get_num_rows(lp);
      n = glp_get_num_cols(lp);
      nz = glp_get_num_nz(lp);
      if (m == 0) fault(prefix "problem has no rows");
      if (n == 0) fault(prefix "problem has no columns");
      /* one extra column is reserved for the artificial variable */
      n++;
      /* allocate the arrays */
      typx = ucalloc(1+m+n, sizeof(int));
      lb = ucalloc(1+m+n, sizeof(double));
      ub = ucalloc(1+m+n, sizeof(double));
      ja = ucalloc(1+n+1, sizeof(int));
      ia = ucalloc(1+nz+m, sizeof(int));
      an = ucalloc(1+nz+m, sizeof(double));
      coef = ucalloc(1+n, sizeof(double));
      R = ucalloc(1+m, sizeof(double));
      S = ucalloc(1+n, sizeof(double));
      posx = ucalloc(1+m+n, sizeof(int));
      indb = ucalloc(1+m, sizeof(int));
      indn = ucalloc(1+n, sizeof(int));
      tagn = ucalloc(1+n, sizeof(int));
      cost = ucalloc(1+m+n, sizeof(double));
      bbar = ucalloc(1+m, sizeof(double));
      pi = ucalloc(1+m, sizeof(double));
      cbar = ucalloc(1+n, sizeof(double));
      refsp = ucalloc(1+m+n, sizeof(int));
      gvec = ucalloc(1+n, sizeof(double));
      aq = ucalloc(1+m, sizeof(double));
      zeta = ucalloc(1+m, sizeof(double));
      ap = ucalloc(1+n, sizeof(double));
      rn = ucalloc(1+m, sizeof(int));
      ak = ucalloc(1+m, sizeof(double));
      w = ucalloc(1+m, sizeof(double));
      /* obtain types and bounds of rows */
      for (i = 1; i <= m; i++)
         glp_get_row_bnds(lp, i, &typx[i], &lb[i], &ub[i]);
      /* obtain types and bounds of columns */
      for (j = 1; j <= n-1; j++)
         glp_get_col_bnds(lp, j, &typx[m+j], &lb[m+j], &ub[m+j]);
      /* initially the artificial variable is fixed at zero */
      typx[m+n] = 'S';
      lb[m+n] = ub[m+n] = 0.0;
      /* obtain the constraint matrix and build its representation in
         column-wise format */
      {  int *flag = indb, loc = 1, cnt, t;
         double *aj = ak;
         /* clear row flags */
         for (i = 1; i <= m; i++) flag[i] = 0;
         /* scan the constraint matrix */
         for (j = 1; j <= n-1; j++)
         {  /* obtain the j-th column */
            cnt = glp_get_col_coef(lp, j, rn, aj);
            /* store a pointer to the beginning of the j-th column */
            ja[j] = loc;
            /* scan the j-th column */
            for (t = 1; t <= cnt; t++)
            {  /* check for a multiplet */
               if (flag[rn[t]])
                  fault(prefix "constraint matrix has multiplets");
               /* store non-zero element */
               if (aj[t] != 0.0)
               {  ia[loc] = rn[t];
                  an[loc] = aj[t];
                  loc++;
               }
            }
            /* clear row flags */
            for (t = 1; t <= cnt; t++) flag[rn[t]] = 0;
         }
         insist(loc - 1 <= nz);
         /* initially the artificial variable column is empty */
         ja[n] = ja[n+1] = loc;
      }
      /* build procedural representation of the constraint matrix */
      A->m = m;
      A->n = n;
      A->column = column;
      A->info = NULL;
      /* obtain optimization direction */
      dir = glp_get_obj_sense(lp);
      /* obtain coefficients of the objective function */
      for (j = 0; j <= n-1; j++)
         coef[j] = glp_get_obj_coef(lp, j);
      /* coefficient at the artificial variable is zero */
      coef[n] = 0.0;
      /* initialize the scaling matrices */
      for (i = 1; i <= m; i++) R[i] = 1.0;
      for (j = 1; j <= n; j++) S[j] = 1.0;
      /* construct the standard initial basis (all auxiliary variables
         are basic and all structural variables are non-basic; in this
         case B = I and N = -A) */
      for (i = 1; i <= m; i++)
      {  k = i; /* x[k] = xB[i] */
         posx[k] = +i;
         indb[i] =  k;
      }
      for (j = 1; j <= n; j++)
      {  k = m+j; /* x[k] = xN[j] */
         posx[k] = -j;
         indn[j] =  k;
         switch (typx[k])
         {  case 'F':
               tagn[j] = 'F'; break;
            case 'L':
               tagn[j] = 'L'; break;
            case 'U':
               tagn[j] = 'U'; break;
            case 'D':
               tagn[j] = (fabs(lb[k]) <= fabs(ub[k]) ? 'L' : 'U');
               break;
            case 'S':
               tagn[j] = 'S'; break;
            default:
               insist(typx[k] != typx[k]);
         }
      }
      /* build some representation of the basis matrix (which initially
         is the unity matrix) */
      B = spx_create_b(m);
      /* reset iteration count */
      iter = 0;
      return;
}

/*----------------------------------------------------------------------
-- scale_problem - scale the problem.
--
-- This routine computes the scaling matrices R and S, which are then
-- used in order to scale the problem data. */

static void scale_problem(LPI *lp, int scale)
{     int i, j, k, t;
      /* compute the scaling matrices */
      switch (scale)
      {  case 0:
            /* do not scale the problem */
            for (i = 1; i <= m; i++) R[i] = 1.0;
            for (j = 1; j <= n; j++) S[j] = 1.0;
            break;
         case 1:
            /* scale the problem */
            spx_scale_mat(A, 2, R, S);
            break;
         case 2:
            /* scale the problem using scale factors specified in the
               problem object */
            /* obtain row scale factors */
            for (i = 1; i <= m; i++)
            {  R[i] = glp_get_row_fctr(lp, i);
               if (R[i] <= 0.0)
                  fault(prefix "row %d; invalid scale factor", i);
            }
            /* obtain column scale factors */
            for (j = 1; j <= n-1; j++)
            {  S[j] = glp_get_col_fctr(lp, j);
               if (S[j] <= 0.0)
                  fault(prefix "column %d; invalid scale factor", j);
            }
            /* the artificial variable column is not scaled */
            S[n] = 1.0;
            break;
         default:
            insist(scale != scale);
      }
      /* scale bounds of auxiliary variables */
      for (i = 1; i <= m; i++)
      {  k = i;
         lb[k] *= R[i];
         ub[k] *= R[i];
      }
      /* scale bounds of structural variables */
      for (j = 1; j <= n; j++)
      {  k = m + j;
         lb[k] /= S[j];
         ub[k] /= S[j];
      }
      /* scale the constraint matrix */
      for (j = 1; j <= n; j++)
      {  for (t = ja[j]; t <= ja[j+1]-1; t++)
         {  i = ia[t];
            an[t] *= (R[i] * S[j]);
         }
      }
      /* scale the objective coefficients */
      for (j = 1; j <= n; j++) coef[j] *= S[j];
      return;
}

/*----------------------------------------------------------------------
-- build_basis - build an initial basis.
--
-- This routine builds an initial basis and stores the corresponding
-- information to the arrays posx, indb, indn, and tagn. */

static void build_basis(LPI *lp, int initb)
{     int i, j, k, tagx;
      switch (initb)
      {  case 0:
            /* build the standard initial basis */
            for (i = 1; i <= m; i++) indb[i] = i;
            goto set;
         case 1:
            /* build an advanced initial basis */
            spx_ini_basis(A, typx, indb);
set:        /* clear the array posx */
            for (k = 1; k <= m+n; k++) posx[k] = 0;
            /* build the set of basic variables */
            for (i = 1; i <= m; i++)
            {  k = indb[i];
               insist(1 <= k && k <= m+n);
               insist(posx[k] == 0);
               posx[k] = +i;
            }
            /* build the set of non-basic variables */
            j = 0;
            for (k = 1; k <= m+n; k++)
            {  if (posx[k] == 0)
               {  j++;
                  posx[k] = -j;
                  indn[j] = k;
                  switch (typx[k])
                  {  case 'F':
                        tagn[j] = 'F'; break;
                     case 'L':
                        tagn[j] = 'L'; break;
                     case 'U':
                        tagn[j] = 'U'; break;
                     case 'D':
                        tagn[j] =
                           (fabs(lb[k]) <= fabs(ub[k]) ? 'L' : 'U');
                        break;
                     case 'S':
                        tagn[j] = 'S'; break;
                     default:
                        insist(typx[k] != typx[k]);
                  }
               }
            }
            break;
         case 2:
            /* build the basis specified in the problem object */
            i = 0; /* number of basic variables */
            j = 0; /* number of non-basic variables */
            for (k = 1; k <= m+n; k++)
            {  /* obtain status of k-th variable */
               if (k <= m)
                  glp_get_row_soln(lp, k, &tagx, NULL, NULL);
               else if (k < m+n)
                  glp_get_col_soln(lp, k-m, &tagx, NULL, NULL);
               else
               {  /* the artificial variable */
                  insist(typx[k] == 'S');
                  tagx = 'S';
               }
               /* check for compatibility between type and status */
               if (!(tagx == 'B' ||
                  typx[k] == 'F' && tagx == 'F' ||
                  typx[k] == 'L' && tagx == 'L' ||
                  typx[k] == 'U' && tagx == 'U' ||
                  typx[k] == 'D' && tagx == 'L' ||
                  typx[k] == 'D' && tagx == 'U' ||
                  typx[k] == 'S' && tagx == 'S'))
err:              fault(prefix "k = %d; invalid basis information", k);
               /* store basis information */
               if (tagx == 'B')
               {  /* x[k] is basic variable xB[i] */
                  i++;
                  if (i > m) goto err;
                  posx[k] = +i;
                  indb[i] =  k;
               }
               else
               {  /* x[k] is non-basic variable xN[j] */
                  j++;
                  if (j > n) goto err;
                  posx[k] = -j;
                  indn[j] =  k;
                  tagn[j] = tagx;
               }
            }
            insist(i == m && j == n);
            break;
         default:
            insist(initb != initb);
      }
      return;
}

/*----------------------------------------------------------------------
-- check_bbar - check basis solution for primal feasibility.
--
-- This routine checks if the current values of basic variables are
-- within their bounds using the relative tolerance tol.
--
-- If the basis solution is primal feasible, the routine returns zero.
-- Otherwise the routine returns non-zero. */

static int check_bbar(double tol)
{     int i, k;
      for (i = 1; i <= m; i++)
      {  k = indb[i]; /* x[k] = xB[i] */
         if (typx[k] == 'L' || typx[k] == 'D' || typx[k] == 'S')
         {  /* xB[i] has lower bound */
            if ((lb[k] - bbar[i]) / (1.0 + fabs(lb[k])) > tol) return 1;
         }
         if (typx[k] == 'U' || typx[k] == 'D' || typx[k] == 'S')
         {  /* xB[i] has upper bound */
            if ((bbar[i] - ub[k]) / (1.0 + fabs(ub[k])) > tol) return 1;
         }
      }
      return 0;
}

/*----------------------------------------------------------------------
-- choose_col - choose non-basic variable (primal simplex).
--
-- This routine chooses a non-basic variable (xN)q (i.e. a pivot column
-- of the simplex table), which should enter the basis on the next
-- iteration of the primal simplex method. Note that the routine assumes
-- that the working objective function should be minimized.
--
-- If the choice has been made, the routine sets q to the number of the
-- chosen non-basic variable (xN)q, 1 <= q <= n. Otherwise, if the basis
-- solution is dual feasible and therefore the choice can't be made, the
-- routine sets q to zero. */

static void choose_col(double tol)
{     int j, k, t, cnt, try = 0;
      double best, temp, cbar_q;
loop: q = 0, best = 0.0;
      for (j = 1; j <= n; j++)
      {  /* skip column if xN[j] doesn't affect on the obj. func. */
         if (cbar[j] == 0.0) continue;
         switch (tagn[j])
         {  case 'F':
               /* xN[j] can change in any direction */
               if (-tol < cbar[j] && cbar[j] < +tol) continue;
               break;
            case 'L':
               /* xN[j] can increase */
               if (cbar[j] > -tol) continue;
               break;
            case 'U':
               /* xN[j] can decrease */
               if (cbar[j] < +tol) continue;
               break;
            case 'S':
               /* xN[j] can't change */
               continue;
            default:
               insist(tagn[j] != tagn[j]);
         }
         /* xN[j] can improve (decrease) the objective function */
         temp = (cbar[j] * cbar[j]) / gvec[j];
         if (best < temp) q = j, best = temp;
      }
      if (q != 0)
      {  /* xN[q] has been chosen; however, since reduced costs are not
            computed directly using btran, but recomputed recursively,
            cbar[q], if it is close to zero, may have wrong sign due to
            excessive round-off errors; this may involve wrong choice of
            a basic variable xB[p] and cause numerical instability;
            therefore it is reasonable to compute cbar[q] more exactly
            using the known simplex multipliers pi */
         k = indn[q]; /* x[k] = xN[q] */
         cbar_q = cost[k];
         cnt = spx_get_ak(A, k, rn, ak);
         for (t = 1; t <= cnt; t++)
            cbar_q -= pi[rn[t]] * ak[t];
         /* estimate an error in cbar[q] */
         temp = fabs(cbar[q] - cbar_q) / (1.0 + fabs(cbar_q));
         if (temp <= tol)
         {  /* probably cbar[q] is computed quite accurately */
            cbar[q] = cbar_q;
         }
         else if (try == 0)
         {  /* the error is too big */
            /* compute simplex multipliers */
            spx_eval_pi(m, B, indb, cost, pi);
            /* compute reduced costs of non-basic variables */
            spx_eval_cbar(A, indn, cost, pi, cbar, rn, ak);
            /* repeat the choice */
            try = 1;
            goto loop;
         }
      }
      return;
}

/*----------------------------------------------------------------------
-- choose_row - choose basic variable (primal simplex).
--
-- This routine chooses a basic variable (xB)p (i.e. a pivot row of the
-- simplex table), which should leave the basis on the next iteration of
-- the primal simplex method, using Harris' two-pass ratio test.
--
-- If the choice has been made, the routine sets p to the number of the
-- chosen basic variable (xB)p, 1 <= p <= m, and also sets tagp to the
-- tag, which should be set when (xB)p has left the basis; the special
-- case of p < 0 means that the non-basic variable (xN)q should just go
-- from its current bound to the opposite one. Otherwise, if (xN)q can
-- infintely change and therefore the choice can't be made, the routine
-- sets p to zero. */

static void choose_row(double tol, double tol1)
{     int i, k, tag;
      double big, eps, temp, teta;
      /* compute the absolute tolerance eps using the given relative
         tolerance tol */
#if 0
      eps = tol;
#else
      big = 0.0;
      for (i = 1; i <= m; i++)
         if (big < fabs(aq[i])) big = fabs(aq[i]);
      eps = tol * big;
#endif
      /* turn to the case of increasing xN[q] in order to simplify
         program logic */
      if (cbar[q] > 0.0) for (i = 1; i <= m; i++) aq[i] = - aq[i];
      /* initial settings for the first pass */
      k = indn[q]; /* x[k] = xN[q] */
      if (typx[k] == 'D')
         teta = (ub[k] + tol1) - (lb[k] - tol1);
      else
         teta = DBL_MAX;
      /* the first look through the list of basis variables */
      for (i = 1; i <= m; i++)
      {  /* if the coefficient aq[i] is too small, it is assumed that
            xB[i] doesn't depend on xN[q] */
         if (aq[i] == 0.0 || fabs(aq[i]) < eps) continue;
         /* analyze main cases */
         k = indb[i]; /* x[k] = xB[i] */
         if (typx[k] == 'F')
         {  /* xB[i] is free variable */
            continue;
         }
         else if (typx[k] == 'L')
         {  /* xB[i] has lower bound */
            if (aq[i] > 0.0) continue;
lo_1:       temp = ((lb[k] - tol1) - bbar[i]) / aq[i];
         }
         else if (typx[k] == 'U')
         {  /* xB[i] has upper bound */
            if (aq[i] < 0.0) continue;
up_1:       temp = ((ub[k] + tol1) - bbar[i]) / aq[i];
         }
         else if (typx[k] == 'D')
         {  /* xB[i] has both lower and upper bounds */
            if (aq[i] < 0.0) goto lo_1; else goto up_1;
         }
         else if (typx[k] == 'S')
         {  /* xB[i] is fixed variable */
            if (aq[i] < 0.0) goto lo_1; else goto up_1;
         }
         else
            insist(typx[k] != typx[k]);
         /* if xB[i] slightly violates its (relaxed!) bound, temp is
            negative; in this case it is assumed thst xB[i] is exactly
            on its (relaxed!) bound, so temp is replaced by zero */
         if (temp < 0.0) temp = 0.0;
         /* compute maximal allowable change of xN[q] */
         if (teta > temp) teta = temp;
      }
      /* initial settings for the second pass */
      p = 0, tagp = -1, big = 0.0;
      k = indn[q]; /* x[k] = xN[q] */
      if (typx[k] == 'D')
      {  temp = ub[k] - lb[k];
         if (temp <= teta) p = -1, tagp = -1, big = 1.0;
      }
      /* the second look through the list of the basis variable */
      for (i = 1; i <= m; i++)
      {  /* if the coefficient aq[i] is too small, it is assumed that
            xB[i] doesn't depend on xN[q] */
         if (aq[i] == 0.0 || fabs(aq[i]) < eps) continue;
         /* analyze main cases */
         k = indb[i]; /* x[k] = xB[i] */
         if (typx[k] == 'F')
         {  /* xB[i] is free variable */
            continue;
         }
         else if (typx[k] == 'L')
         {  /* xB[i] has lower bound */
            if (aq[i] > 0.0) continue;
lo_2:       temp = (lb[k] - bbar[i]) / aq[i];
            tag = 'L';
         }
         else if (typx[k] == 'U')
         {  /* xB[i] has upper bound */
            if (aq[i] < 0.0) continue;
up_2:       temp = (ub[k] - bbar[i]) / aq[i];
            tag = 'U';
         }
         else if (typx[k] == 'D')
         {  /* xB[i] has both lower and upper bounds */
            if (aq[i] < 0.0) goto lo_2; else goto up_2;
         }
         else if (typx[k] == 'S')
         {  /* xB[i] is fixed variable */
            temp = 0.0;
            tag = 'S';
         }
         else
            insist(typx[k] != typx[k]);
         /* if xB[i] slightly violates its (original!) bound, temp is
            negative; in this case it is assumed that xB[i] is exactly
            on its (original!) bound, so temp is replaced by zero */
         if (temp < 0.0) temp = 0.0;
         /* apply Harris' rule */
         if (temp <= teta && big < fabs(aq[i]))
            p = i, tagp = tag, big = fabs(aq[i]);
      }
      /* restore original signs of the coefficients aq[i] */
      if (cbar[q] > 0.0) for (i = 1; i <= m; i++) aq[i] = - aq[i];
      return;
}

/*----------------------------------------------------------------------
-- update_bbar - update values of basic variables.
--
-- This routine computes values of the basic variables for the adjacent
-- basis. */

static void update_bbar(void)
{     int i, k;
      double new_xBp, d_xNq;
      insist(1 <= q && q <= n);
      if (p < 0)
      {  /* special case: xN[q] goes to the opposite bound */
         k = indn[q]; /* x[k] = xN[q] */
         switch (tagn[q])
         {  case 'L':
               /* xN[q] goes from its lower bound to the upper one */
               d_xNq = ub[k] - lb[k];
               break;
            case 'U':
               /* xN[q] goes from its upper bound to the lower one */
               d_xNq = lb[k] - ub[k];
               break;
            default:
               insist(tagn[q] != tagn[q]);
         }
         /* recompute values of the basic variables */
         for (i = 1; i <= m; i++) bbar[i] += aq[i] * d_xNq;
      }
      else
      {  insist(1 <= p && p <= m);
         /* determine value of xB[p] in the adjacent basis */
         switch (tagp)
         {  case 'F':
               new_xBp = 0.0; break;
            case 'L':
               new_xBp = lb[indb[p]]; break;
            case 'U':
               new_xBp = ub[indb[p]]; break;
            case 'S':
               new_xBp = lb[indb[p]]; break;
            default:
               insist(tagp != tagp);
         }
         /* determine increment of xN[q] in the adjacent basis */
         d_xNq = (new_xBp - bbar[p]) / aq[p];
         /* recompute values of the basic variables */
         for (i = 1; i <= m; i++)
         {  if (i == p)
               bbar[p] = spx_eval_xnj(lb, ub, indn, tagn, q) + d_xNq;
            else
               bbar[i] += aq[i] * d_xNq;
         }
      }
      return;
}

/*----------------------------------------------------------------------
-- update_cbar - update reduced costs of non-basic variables.
--
-- This routine computes simplex multipliers and reduced costs for the
-- adjacent basis. */

static void update_cbar(void)
{     int i, j, k;
      /* compute reduced cost of xN[q] in the adjacent basis */
      insist(1 <= q && q <= n);
      cbar[q] /= ap[q];
      /* recompute simplex multipliers pi = inv(B') * (cB - lambda.B) */
      for (i = 1; i <= m; i++) pi[i] -= zeta[i] * cbar[q];
      /* recompute reduced costs of other non-basic variables */
      for (j = 1; j <= n; j++)
      {  k = indn[j];
         if (j == q) continue;
         if (typx[k] == 'S')
         {  cbar[j] = 1.0;
            continue;
         }
         cbar[j] -= cbar[q] * ap[j];
      }
      return;
}

/*----------------------------------------------------------------------
-- change_basis - change the basis.
--
-- This routine replaces the current basis by the adjacent one and also
-- updates the representation of the basis matrix.
--
-- If the representation of the basis matrix was not updated or if it
-- was updated successfully, the routine returns non-zero. Otherwise, if
-- the representation became inaccurate or too long and therefore should
-- be reinverted, the routine returns non-zero. */

static int change_basis(void)
{     int k, kp, kq, ret;
      if (p < 0)
      {  /* xN[q] goes from the current bound to the opposite one */
         k = indn[q]; /* x[k] = xN[q] */
         insist(typx[k] == 'D');
         insist(tagn[q] == 'L' || tagn[q] == 'U');
         tagn[q] = (tagn[q] == 'L') ? 'U' : 'L';
         /* the basis matrix is not changed */
         ret = 0;
      }
      else
      {  /* xB[p] leaves the basis, xN[q] enters the basis */
         insist(1 <= p && p <= m);
         insist(1 <= q && q <= n);
         kp = indb[p]; kq = indn[q];
         posx[kq] = +p; posx[kp] = -q;
         indb[p] = kq; indn[q] = kp;
         tagn[q] = tagp;
         /* update representation of the basis matrix */
         ret = spx_update_b(B, p);
      }
      /* increase iteration count */
      iter++;
      /* return to the simplex method routine */
      return ret;
}

/*----------------------------------------------------------------------
-- activate - activate the artificial variable.
--
-- This routine introduces the additional artificial variable in order
-- to make the current basis be primal feasible.
--
-- Let the current simplex table is
--
--    xB = A^ * xN,                                                  (1)
--
-- where
--
--    A^ = - inv(B) * N,                                             (2)
--
-- and some basic variables violates their lower or upper bounds. In
-- order to get rid of primal infeasibility appropriate quantities can
-- be added to each right part of the simplex table:
--
--    xB = A^ * xN + av,                                             (3)
--
-- where
--
--    av[i] = (lB)i - bbar[i] + delta[i], if bbar[i] < (lB)i,        (4)
--
--    av[i] = (uB)i - bbar[i] - delta[i], if bbar[i] > (uB)i.        (5)
--
-- and delta[i] > 0 is a non-negative offset intended to avoid primal
-- degeneracy, since after introducing the vector av the basic variable
-- xB[i] will be equal to (lB)i + delta[i] or (uB)i - delta[i].
--
-- Formally (3) is equivalent to introducing an artificial variable
-- xv, which is non-basic with the value 1 and has the column av as its
-- coefficients in the simplex table:
--
--    xB = A^ * xN + av * xv.                                        (6)
--
-- Multiplying both parts of (6) on B and accounting (2) we have:
--
--    B * xB + N * xN - B * av * xv = 0.                             (7)
--
-- We can consider the column (-B * av) as an additional column of the
-- expanded constraint matrix A~ = (I | -A), or, that is the same, the
-- column (B * av) as an additional column of the constraint matrix A,
-- which corresponds to the additional artificial variable xv.
--
-- If xv is non-basic and equal to 1, the considered basis solution is
-- primal feasible and therefore can be used as an initial basis on the
-- phase I. Thus, in order to find a primal feasible basis solution of
-- the original LP problem, which has no artificial variables, we need
-- to nullify xv. Note also that the value of xv, which is in the range
-- [0,1], can be considered as a measure of primal infeasibility. */

static void activate(void)
{     int i, j, k, pos;
      double delta = 100.0, *av = w, *col;
      /* construct the vector av */
      for (i = 1; i <= m; i++)
      {  k = indb[i]; /* x[k] = xB[i] */
         switch (typx[k])
         {  case 'F':
               av[i] = 0.0;
               break;
            case 'L':
               if (bbar[i] >= lb[k])
                  av[i] = 0.0;
               else
                  av[i] = (lb[k] - bbar[i]) + delta;
               break;
            case 'U':
               if (bbar[i] <= ub[k])
                  av[i] = 0.0;
               else
                  av[i] = (ub[k] - bbar[i]) - delta;
               break;
            case 'D':
               if (lb[k] <= bbar[i] && bbar[i] <= ub[k])
                  av[i] = 0.0;
               else
                  av[i] = 0.5 * (lb[k] + ub[k]) - bbar[i];
               break;
            case 'S':
               if (bbar[i] == lb[k])
                  av[i] = 0.0;
               else
                  av[i] = lb[k] - bbar[i];
               break;
            default:
               insist(typx[k] != typx[k]);
         }
      }
      /* compute the column B * av = B[1]*av[1] + ... + B[m]*av[m],
         where B is the current basis matrix */
      col = bbar;
      for (i = 1; i <= m; i++) col[i] = 0.0;
      for (j = 1; j <= m; j++)
      {  int t, cnt;
         double *bj = ak;
         cnt = spx_get_bi(A, indb, j, rn, bj);
         for (t = 1; t <= cnt; t++) col[rn[t]] += bj[t] * av[j];
      }
      /* make the artificial column be the last column of the original
         constraint matrix A (there are m extra locations reserved for
         this purpose) */
      pos = ja[n];
      for (i = 1; i <= m; i++)
      {  if (fabs(col[i]) < DBL_EPSILON) continue;
         ia[pos] = i;
         an[pos] = col[i];
         pos++;
      }
      ja[n+1] = pos;
      /* set bounds of the artificial variable xv = x[m+n] to 0 and 1
         respectively */
      typx[m+n] = 'D';
      lb[m+n] = 0.0;
      ub[m+n] = 1.0;
      /* place the artificial variable on its upper bound in order to
         make the basis solution be primal feasible (it is assumed that
         this variable is currently non-basic) */
      j = -posx[m+n];
      insist(1 <= j && j <= n);
      tagn[j] = 'U';
      return;
}

/*----------------------------------------------------------------------
-- deactivate - deactivate the artificial variable.
--
-- This routine removes the artificial variable from the basis (if it
-- is still in the basis) and fixes it at zero level.
--
-- If no errors occurred, the routine returns zero. Otherwise, if the
-- routine tried to reinvert the basis matrix and this try failed, it
-- returns non-zero. */

static int deactivate(void)
{     int j, ret = 0;
      /* fix the artificial variable xv = x[m+n] at zero */
      typx[m+n] = 'S';
      lb[m+n] = ub[m+n] = 0.0;
      /* if the artificial variable is basic, it should be replaced by
         an appropriate non-basic variable */
      if (posx[m+n] > 0)
      {  double big;
         p = posx[m+n]; /* x[m+n] = xB[p] */
         /* compute p-th row of inv(B) */
         spx_eval_zeta(m, B, p, zeta);
         /* compute p-th row of the simplex table */
         spx_eval_row(A, indn, zeta, ap, rn, ak);
         /* choose a non-basic variable xN[q] with greatest influence
            coefficient in the p-th row */
         q = 0, big = 0.0;
         for (j = 1; j <= n; j++)
            if (big < fabs(ap[j])) q = j, big = fabs(ap[j]);
         insist(q != 0);
         /* compute q-th column of the simplex table; this is needed to
            change the basis */
         spx_eval_col(A, B, indn, q, zeta, 1, rn, ak);
         /* xB[p] leaves the basis, xN[q] enters the basis */
         tagp = 'S';
         if (change_basis())
            if (spx_invert_b(B, A, indb)) ret = 1;
      }
      /* the artificial variable is non-basic and fixed at zero */
      j = -posx[m+n];
      insist(1 <= j && j <= n);
      tagn[j] = 'S';
      /* clear the last column of the constraint matrix A (this column
         corresponds to the artificial variable) */
      ja[n+1] = ja[n];
      return ret;
}

/*----------------------------------------------------------------------
-- check_data - check main data structures for correctness.
--
-- This routine checks main data structures for correctness. In case of
-- error the routine displays an appropriate error message and terminate
-- the program. Intended only for debugging purposes. */

static void check_data(void)
{     int k;
      if (m < 1)
         fault(prefix "invalid number of rows");
      if (n < 1)
         fault(prefix "invalid number of columns");
      for (k = 1; k <= m+n; k++)
      {  switch (typx[k])
         {  case 'F':
               if (!(lb[k] == 0.0 && ub[k] == 0.0))
err1:             fault(prefix "invalid bounds of row/column");
               break;
            case 'L':
               if (ub[k] != 0.0) goto err1;
               break;
            case 'U':
               if (lb[k] != 0.0) goto err1;
               break;
            case 'D':
               break;
            case 'S':
               if (lb[k] != ub[k]) goto err1;
               break;
            default:
               fault(prefix "invalid type of row/column");
         }
      }
      if (!(A->m == m && A->n == n))
         fault(prefix "invalid dimension of constraint matrix");
      for (k = 1; k <= m+n; k++)
      {  if (posx[k] > 0)
         {  int i = +posx[k]; /* xB[i] = x[k] */
            if (!(1 <= i && i <= m && indb[i] == k))
               fault(prefix "invalid position of basic row/column");
         }
         else
         {  int j = -posx[k]; /* xN[j] = x[k] */
            if (!(1 <= j && j <= n && indn[j] == k))
               fault(prefix "invalid position of non-basic row/column");
            switch (typx[k])
            {  case 'F':
                  if (tagn[j] != 'F')
err2:                fault(prefix "invalid tag of non-basic row/column")
                        ;
                  break;
               case 'L':
                  if (tagn[j] != 'L') goto err2;
                  break;
               case 'U':
                  if (tagn[j] != 'U') goto err2;
                  break;
               case 'D':
                  if (!(tagn[j] == 'L' || tagn[j] == 'U')) goto err2;
                  break;
               case 'S':
                  if (tagn[j] != 'S') goto err2;
                  break;
               default:
                  insist(typx[k] != typx[k]);
            }
         }
      }
      return;
}

/*----------------------------------------------------------------------
-- check_prec - check accuracy of bbar, pi, cbar, and gvec.
--
-- This routine computes exact values of bbar, pi, cbar, and gvec,
-- compares them with current values (which are recomputed recursively
-- on each simplex iteration), and prints the corresponding absolute
-- errors. Intended only for debugging purposes. */

static void check_prec(void)
{     int i, j;
      double *exact_bbar, *exact_pi, *exact_cbar, d, dmax;
      check_data();
      exact_bbar = ucalloc(1+m, sizeof(double));
      exact_pi = ucalloc(1+m, sizeof(double));
      exact_cbar = ucalloc(1+n, sizeof(double));
      spx_eval_bbar(A, B, lb, ub, indn, tagn, exact_bbar, rn, ak);
      dmax = 0.0;
      for (i = 1; i <= m; i++)
      {  d = fabs(exact_bbar[i] - bbar[i]);
         if (dmax < d) dmax = d;
      }
      print("bbar: dmax = %g", dmax);
      spx_eval_pi(m, B, indb, cost, exact_pi);
      dmax = 0.0;
      for (i = 1; i <= m; i++)
      {  d = fabs(exact_pi[i] - pi[i]);
         if (dmax < d) dmax = d;
      }
      print("pi:   dmax = %g", dmax);
      spx_eval_cbar(A, indn, cost, exact_pi, exact_cbar, rn,ak);
      dmax = 0.0;
      for (j = 1; j <= n; j++)
      {  if (typx[indn[j]] == 'S') continue;
         d = fabs(exact_cbar[j] - cbar[j]);
         if (dmax < d) dmax = d;
      }
      print("cbar: dmax = %g", dmax);
      dmax = spx_check_gvec(A, B, typx, refsp, indb, indn, gvec);
      print("gvec: dmax = %g", dmax);
      ufree(exact_bbar);
      ufree(exact_pi);
      ufree(exact_cbar);
      return;
}

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

static void display(void)
{     int i, j, defect;
      double objval, infeas;
      /* compute current value of the objective function */
      objval = coef[0];
      for (j = 1; j <= n; j++)
      {  if (posx[m+j] > 0)
            objval += coef[j] * bbar[+posx[m+j]];
         else
            objval += coef[j] * spx_eval_xnj(lb, ub, indn, tagn,
               -posx[m+j]);
      }
      /* determine primal infeasibility, which is the current value of
         the artificial variable */
      if (posx[m+n] > 0)
         infeas = bbar[posx[m+n]];
      else
         infeas = spx_eval_xnj(lb, ub, indn, tagn, -posx[m+n]);
      /* determine defect of the basis solution, which is the number of
         fixed basic variables */
      defect = 0;
      for (i = 1; i <= m; i++)
         if (typx[indb[i]] == 'S') defect++;
      /* display visual information */
      print(" %6d:   objval = %17.9e   infeas = %17.9e (%d)",
         iter, objval, infeas, defect);
      return;
}

/*----------------------------------------------------------------------
-- store_sol - store basis solution.
--
-- This routine stores the final basis solution obtained by the simplex
-- method into the problem object. */

static void store_sol(LPI *lp, struct spx2 *p, int bstat, int status)
{     int i, j, k, tagx;
      double objval, valx, dx;
      /* the artficial variable should be non-basic */
      insist(posx[m+n] < 0);
      /* compute values of basic variables */
      spx_eval_bbar(A, B, lb, ub, indn, tagn, bbar, rn, ak);
      /* build the expanded vector of coefficients of the original
         objective function */
      for (i = 1; i <= m; i++) cost[i] = 0.0;
      for (j = 1; j <= n; j++) cost[m+j] = coef[j];
      /* compute simplex multipliers */
      spx_eval_pi(m, B, indb, cost, pi);
      /* compute reduced costs of non-basic variables */
      spx_eval_cbar(A, indn, cost, pi, cbar, rn, ak);
      /* store unscaled values and reduced costs of variables; compute
         value of the objective function */
      objval = coef[0];
      for (k = 1; k <= m+n-1; k++)
      {  if (posx[k] > 0)
         {  i = +posx[k];
            tagx = 'B';
            valx = bbar[i];
            if (p->round && fabs(valx) < p->tol_bnd) valx = 0.0;
            dx = 0.0;
         }
         else
         {  j = -posx[k];
            tagx = tagn[j];
            valx = spx_eval_xnj(lb, ub, indn, tagn, j);
            dx = cbar[j];
            if (p->round && fabs(dx) < p->tol_dj) dx = 0.0;
         }
         /* unscale and store */
         if (k <= m)
         {  /* row (auxiliary variable) */
            glp_put_row_soln(lp, k, tagx, valx / R[k], dx * R[k]);
         }
         else
         {  /* column (structural variable) */
            glp_put_col_soln(lp, k-m, tagx, valx * S[k-m], dx / S[k-m]);
            objval += coef[k-m] * valx;
         }
      }
      /* store solution information */
      glp_put_soln_info(lp, bstat, status, objval);
      return;
}

/*----------------------------------------------------------------------
-- terminate - free common data structures.
--
-- This routine frees memory allocated to the common data structures. */

static void terminate(void)
{     ufree(typx);
      ufree(lb);
      ufree(ub);
      ufree(ja);
      ufree(ia);
      ufree(an);
      ufree(coef);
      ufree(R);
      ufree(S);
      ufree(posx);
      ufree(indb);
      ufree(indn);
      ufree(tagn);
      spx_delete_b(B);
      ufree(cost);
      ufree(bbar);
      ufree(pi);
      ufree(cbar);
      ufree(refsp);
      ufree(gvec);
      ufree(aq);
      ufree(zeta);
      ufree(ap);
      ufree(rn);
      ufree(ak);
      ufree(w);
      return;
}

/*----------------------------------------------------------------------
-- glp_simplex2 - solve LP problem using primal simplex method.
--
-- This is a main routine, which manages solving LP problem using the
-- two-phase primal simplex method. */

int glp_simplex2(LPI *lp, struct spx2 *parm)
{     struct spx2 my_parm;
      int i, j, k, phase, ret;
      /* reset solution information */
      glp_put_soln_info(lp, 'N', GLP_UNDEF, 0.0);
      /* if parameter block is not specified, use the dummy one */
      if (parm == NULL)
      {  parm = &my_parm;
         glp_init_spx2(parm);
      }
      /* check control parameters for correctness */
      check_parm(parm);
      /* allocate and initialize common data structures */
      initialize(lp);
      /* scale the problem (if required) */
      scale_problem(lp, parm->scale);
      /* build an initial basis */
      build_basis(lp, parm->initb);
      /* check main data structures for correctness */
      check_data();
      /* reinvert the initial basis matrix */
      if (spx_invert_b(B, A, indb))
sing: {  error("Numerical problems with basis matrix");
         error("Sorry, basis recovery procedure not implemented");
         ret = 2;
         goto done;
      }
      /* set the initial reference space */
      spx_reset_gvec(m, n, indn, refsp, gvec);
      /* compute initial values of basic variables */
      spx_eval_bbar(A, B, lb, ub, indn, tagn, bbar, rn, ak);
      /* check for primal feasibility */
      if (check_bbar(parm->tol_bnd))
ph_1: {  /* the basis is primal infeasible; start the phase I */
         phase = 1;
         /* activate the artificial variable (which currently should be
            non-basic and fixed at zero) */
         activate();
         /* compute values of basic variables; due to the artificial
            variable the basis should be now primal feasible */
         spx_eval_bbar(A, B, lb, ub, indn, tagn, bbar, rn, ak);
         /* construct the working objective function for minimizing
            the artificial variable */
         for (k = 1; k <= m+n; k++) cost[k] = 0.0;
         cost[m+n] = 1.0;
      }
      else
ph_2: {  /* the basis is primal feasible; start the phase 2 */
         phase = 2;
         /* the artificial variable should be non-active */
         insist(typx[m+n] == 'S' && posx[m+n] < 0);
         /* use the original objective function for constructing the
            working objective function */
         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];
      }
      /* compute simplex multipliers */
      spx_eval_pi(m, B, indb, cost, pi);
      /* compute reduced costs of non-basic variables */
      spx_eval_cbar(A, indn, cost, pi, cbar, rn, ak);
      /* main loop starts here */
      for (;;)
      {  /* check for primal feasibility */
         if (check_bbar(parm->tol_bnd))
         {  /* the current basis solution became primal infeasible due
               to excessive round-off errors; this incident can happen
               on the phase II as well as on the phase I */
            error("Numerical instability");
            /* deactivate the artificial variable */
            if (deactivate()) goto sing;
            /* reinvert the current basis matrix */
            if (spx_invert_b(B, A, indb)) goto sing;
            /* compute values of basic variables needed to construct
               a new artificial column */
            spx_eval_bbar(A, B, lb, ub, indn, tagn, bbar, rn, ak);
            /* restart the phase I */
            goto ph_1;
         }
         /* the current basis solution is primal feasible */
         if (iter % 100 == 0) display();
         /* we can finish the phase I if the artificial variable has
            left the basis and therefore is on its lower zero bound, or
            if it still basic, but its value is close to zero */
         if (phase == 1)
         {  double infeas;
            /* check the current value of the artificial variable */
            if (posx[m+n] > 0)
               infeas = bbar[posx[m+n]];
            else
               infeas = spx_eval_xnj(lb, ub, indn, tagn, -posx[m+n]);
            if (infeas < 1e-10)
            {  /* deactivate the artificial variable */
               if (deactivate()) goto sing;
               /* compute values of basic variables */
               spx_eval_bbar(A, B, lb, ub, indn, tagn, bbar, rn, ak);
               /* start the phase II */
               goto ph_2;
            }
         }
         /* reset the reference space (if necessary) */
         if (iter % 1000 == 0)
            spx_reset_gvec(m, n, indn, refsp, gvec);
         /* choose non-basic variable xN[q] */
         choose_col(parm->tol_dj);
         if (q == 0)
         {  /* the basis is dual feasible */
            display();
            if (phase == 1)
            {  /* we are still on the phase I */
               print("PROBLEM HAS NO FEASIBLE SOLUTION");
               /* deactivate the artificial variable */
               if (deactivate()) goto sing;
               /* store the final basis solution */
               store_sol(lp, parm, 'N', GLP_NOFEAS);
            }
            else
            {  /* the phase II has been completed */
               print("OPTIMAL SOLUTION FOUND");
               /* store the optimal basis solution */
               store_sol(lp, parm, 'O', GLP_OPT);
            }
            /* terminate the search */
            ret = 0;
            break;
         }
         /* compute q-th (pivot) column of the simplex table */
         spx_eval_col(A, B, indn, q, aq, 1, rn, ak);
         /* choose basic variable xB[p] */
         choose_row(parm->tol_piv, 0.30 * parm->tol_bnd);
         if (p == 0)
         {  /* the problem has unbounded solution */
            display();
            if (phase == 1)
            {  /* this should never be */
               fault(prefix "Program logic error");
            }
            else
            {  print("PROBLEM HAS UNBOUNDED SOLUTION");
               /* store the final basis solution */
               store_sol(lp, parm, 'P', GLP_UNBND);
            }
            /* terminate the search */
            ret = 0;
            break;
         }
         /* compute values of basic variables in the adjacent basis */
         update_bbar();
         /* compute simplex multipliers and reduced costs of non-basic
            variables in the adjacent basis */
         if (p > 0)
         {  insist(1 <= p && p <= m);
            /* compute p-th row of inv(B) */
            spx_eval_zeta(m, B, p, zeta);
            /* compute p-th (pivot) row of the simplex table */
            spx_eval_row(A, indn, zeta, ap, rn, ak);
            /* compute simplex multipliers and reduced costs */
            update_cbar();
            /* update the vector gamma */
            spx_update_gvec(A, B, typx, refsp, indb, indn, p, q, ap, aq,
               gvec, rn, ak, w);
         }
         /* jump to the adjacent basis */
         if (change_basis())
         {  /* reinvert the basis matrix */
            if (spx_invert_b(B, A, indb)) goto sing;
            /* compute values of basic variables */
            spx_eval_bbar(A, B, lb, ub, indn, tagn, bbar, rn, ak);
            /* compute simplex multipliers */
            spx_eval_pi(m, B, indb, cost, pi);
            /* compute reduced costs of non-basic variables */
            spx_eval_cbar(A, indn, cost, pi, cbar, rn, ak);
         }
         /* check accuracy of bbar, pi, cbar, and gvec */
         if (debug) check_prec();
         /* end of main loop */
      }
done: /* free common data structures */
      terminate();
      /* return to the application program */
      return ret;
}

/* eof */
