/* glpfhv.c */

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

/*----------------------------------------------------------------------
-- fhv_create - create FHV-factorization.
--
-- *Synopsis*
--
-- #include "glpfhv.h"
-- FHV *fhv_create(int m, int max_upd);
--
-- *Description*
--
-- The routine fhv_create creates FHV-factorization data structure for
-- the basis matrix of order m.
--
-- The parameter max_upd specifies maximal number of updates of the
-- factorization. (This parameter defines maximal number of factors of
-- the matrix H, since each update of the factorization for an adjacent
-- basis matrix gives one factor of the matrix H.) The value 100 may be
-- recommended in most cases.
--
-- Being created the factorization initially corresponds to the unity
-- basis matrix (F = H = V = P = Q = I, so B = I).
--
-- *Returns*
--
-- The routine returns a pointer to the created FHV-factorization data
-- structure that corresponds to the unity basis matrix. */

FHV *fhv_create(int m, int max_upd)
{     FHV *fhv;
      int i, j, k;
      if (m < 1)
         fault("fhv_create: m = %d; invalid parameter", m);
      if (max_upd < 0)
         fault("fhv_create: max_upd = %d; invalid parameter", max_upd);
      fhv = umalloc(sizeof(FHV));
      fhv->m = m;
      fhv->valid = 1;
      /* matrix F in row-like format (initially F = I) */
      fhv->fr_nfs = 0;
      fhv->fr_ndx = ucalloc(1+m, sizeof(int));
      fhv->fr_ptr = ucalloc(1+m, sizeof(int));
      fhv->fr_cnt = ucalloc(1+m, sizeof(int));
      /* matrix F in column-like format (initially F = I) */
      fhv->fc_nfs = 0;
      fhv->fc_ndx = ucalloc(1+m, sizeof(int));
      fhv->fc_ptr = ucalloc(1+m, sizeof(int));
      fhv->fc_cnt = ucalloc(1+m, sizeof(int));
      /* matrix H in row-like format (initially H = I) */
      fhv->hr_size = max_upd;
      fhv->hr_nfs = 0;
      fhv->hr_ndx = ucalloc(1+fhv->hr_size, sizeof(int));
      fhv->hr_ptr = ucalloc(1+fhv->hr_size, sizeof(int));
      fhv->hr_cnt = ucalloc(1+fhv->hr_size, sizeof(int));
      /* matrix V in row-wise format (initially V = I) */
      fhv->vr_ptr = ucalloc(1+m, sizeof(int));
      fhv->vr_cnt = ucalloc(1+m, sizeof(int));
      fhv->vr_cap = ucalloc(1+m, sizeof(int));
      fhv->vr_piv = ucalloc(1+m, sizeof(double));
      for (i = 1; i <= m; i++)
      {  fhv->vr_ptr[i] = 1;
         fhv->vr_cnt[i] = 0;
         fhv->vr_cap[i] = 0;
         fhv->vr_piv[i] = 1.0;
      }
      /* matrix V in column-wise format (initially V = I) */
      fhv->vc_ptr = ucalloc(1+m, sizeof(int));
      fhv->vc_cnt = ucalloc(1+m, sizeof(int));
      fhv->vc_cap = ucalloc(1+m, sizeof(int));
      for (j = 1; j <= m; j++)
      {  fhv->vc_ptr[j] = 1;
         fhv->vc_cnt[j] = 0;
         fhv->vc_cap[j] = 0;
      }
      /* permutation matrices P and Q (initially P = Q = I) */
      fhv->pp_row = ucalloc(1+m, sizeof(int));
      fhv->pp_col = ucalloc(1+m, sizeof(int));
      fhv->qq_row = ucalloc(1+m, sizeof(int));
      fhv->qq_col = ucalloc(1+m, sizeof(int));
      for (k = 1; k <= m; k++)
      {  fhv->pp_row[k] = k;
         fhv->pp_col[k] = k;
         fhv->qq_row[k] = k;
         fhv->qq_col[k] = k;
      }
      /* sparse vector area (initially all locations are free) */
      fhv->sv_size = 10 * (m + 10);
      fhv->sv_beg = 1;
      fhv->sv_end = fhv->sv_size + 1;
      fhv->sv_ndx = ucalloc(1+fhv->sv_size, sizeof(int));
      fhv->sv_val = ucalloc(1+fhv->sv_size, sizeof(double));
      /* since all row and columns of the matrix V are initially empty,
         the order 1, ..., m, m+1, ..., m+m is used */
      fhv->sv_head = 1;
      fhv->sv_tail = m+m;
      fhv->sv_prev = ucalloc(1+m+m, sizeof(int));
      fhv->sv_next = ucalloc(1+m+m, sizeof(int));
      for (k = 1; k <= m+m; k++)
      {  fhv->sv_prev[k] = k-1;
         fhv->sv_next[k] = k+1;
      }
      fhv->sv_next[m+m] = 0;
      /* lists of active rows and columns */
      fhv->rs_head = ucalloc(1+m, sizeof(int));
      fhv->rs_prev = ucalloc(1+m, sizeof(int));
      fhv->rs_next = ucalloc(1+m, sizeof(int));
      fhv->rs_max = ucalloc(1+m, sizeof(double));
      fhv->cs_head = ucalloc(1+m, sizeof(int));
      fhv->cs_prev = ucalloc(1+m, sizeof(int));
      fhv->cs_next = ucalloc(1+m, sizeof(int));
      /* partially transformed column */
      fhv->cc_cnt = -1;
      fhv->cc_ndx = ucalloc(1+m, sizeof(int));
      fhv->cc_val = ucalloc(1+m, sizeof(double));
      /* working arrays */
      fhv->flag = ucalloc(1+m, sizeof(int));
      fhv->work = ucalloc(1+m, sizeof(double));
      /* default values of control parameters */
      fhv->eps_tol = 1e-15;
      fhv->piv_tol = 0.03;
      fhv->max_gro = 1e+12;
      fhv->upd_tol = 1e-10;
      fhv->new_sva = 0;
      /* statistics */
      fhv->nnz_b = m;
      fhv->nnz_f = 0;
      fhv->nnz_h = 0;
      fhv->nnz_v = 0;
      fhv->max_b = 1.0;
      fhv->big_v = 1.0;
      fhv->rank = m;
      /* return to the simplex method routine */
      return fhv;
}

/*----------------------------------------------------------------------
-- initialize - initialize FHV-factorization data structures.
--
-- This routine prepares data structures for subsequent computing the
-- factorization of the given basis matrix B, which is specified by the
-- formal routine column.
--
-- On exit V = B and F = H = P = Q = I.
--
-- If no error occured, the routine returns zero. Otherwise, in case of
-- overflow of the sparse vector area, the routine returns non-zero. */

static int initialize(FHV *fhv,
      int (*column)(void *info, int j, int rn[], double bj[]),
      void *info)
{     int m = fhv->m;
      int *vr_ptr = fhv->vr_ptr;
      int *vr_cnt = fhv->vr_cnt;
      int *vr_cap = fhv->vr_cap;
      int *vc_ptr = fhv->vc_ptr;
      int *vc_cnt = fhv->vc_cnt;
      int *vc_cap = fhv->vc_cap;
      int *pp_row = fhv->pp_row;
      int *pp_col = fhv->pp_col;
      int *qq_row = fhv->qq_row;
      int *qq_col = fhv->qq_col;
      int *sv_ndx = fhv->sv_ndx;
      double *sv_val = fhv->sv_val;
      int *sv_prev = fhv->sv_prev;
      int *sv_next = fhv->sv_next;
      int *rs_head = fhv->rs_head;
      int *rs_prev = fhv->rs_prev;
      int *rs_next = fhv->rs_next;
      double *rs_max = fhv->rs_max;
      int *cs_head = fhv->cs_head;
      int *cs_prev = fhv->cs_prev;
      int *cs_next = fhv->cs_next;
      int *cc_ndx = fhv->cc_ndx;
      double *cc_val = fhv->cc_val;
      int *flag = fhv->flag;
      double *work = fhv->work;
      double eps_tol = fhv->eps_tol;
      int ret = 0;
      int cnt, i, i_ptr, j, j_beg, j_end, k, sv_beg, sv_end;
      double val;
      /* set F = I */
      fhv->fr_nfs = fhv->fc_nfs = 0;
      /* set H = I */
      fhv->hr_nfs = 0;
      /* free all locations of the sparse vector area */
      sv_beg = 1;
      sv_end = fhv->sv_size + 1;
      /* clear row counts of the matrix V */
      for (i = 1; i <= m; i++) vr_cnt[i] = 0;
      for (i = 1; i <= m; i++) vr_cap[i] = 0;
      /* clear the working array */
      for (i = 1; i <= m; i++) flag[i] = 0;
      /* build the matrix V = B in column-wise format; count non-zeros
         in rows of this matrix */
      for (j = 1; j <= m; j++)
      {  /* call the user-supplied routine to obtain row indices and
            numerical values of elements of j-th column of the given
            basis matrix */
         cnt = column(info, j, cc_ndx, cc_val);
         if (!(0 <= cnt && cnt <= m))
            fault("fhv_decomp: invalid column count");
         /* check for free locations */
         if (sv_end - sv_beg < cnt)
         {  /* overflow of the sparse vector area */
            ret = 1;
            goto done;
         }
         /* set pointer of the j-th column */
         vc_ptr[j] = sv_beg;
         /* walk through elements of the j-th column */
         for (k = 1; k <= cnt; k++)
         {  /* get and check row index */
            i = cc_ndx[k];
            if (!(1 <= i && i <= m))
               fault("fhv_decomp: invalid row index");
            /* check for duplicate elements */
            if (flag[i])
               fault("fhv_decomp: duplicate elements detected");
            /* remember element position */
            flag[i] = 1;
            /* skip tiny element */
            if (fabs(cc_val[k]) < eps_tol) continue;
            /* increase count of the i-th row */
            vr_cap[i]++;
            /* store element in the j-th column */
            sv_ndx[sv_beg] = i;
            sv_val[sv_beg] = cc_val[k];
            sv_beg++;
         }
         /* set count of the j-th column */
         vc_cnt[j] = vc_cap[j] = sv_beg - vc_ptr[j];
         /* clear element positions */
         for (k = 1; k <= cnt; k++) flag[cc_ndx[k]] = 0;
      }
      /* allocate rows of the matrix V = B */
      for (i = 1; i <= m; i++)
      {  /* get count of the i-th row */
         cnt = vr_cap[i];
         /* check for free locations */
         if (sv_end - sv_beg < cnt)
         {  /* overflow of the sparse vector area */
            ret = 1;
            goto done;
         }
         /* set pointer of the i-th row */
         vr_ptr[i] = sv_beg;
         /* reserve locations for the i-th row */
         sv_beg += cnt;
         /* clear the largest value of the i-th row */
         rs_max[i] = 0.0;
      }
      /* build the matrix V = B in row-wise format using this matrix in
         column-wise format; compute largest absolute values of elements
         in each row */
      for (j = 1; j <= m; j++)
      {  /* walk through elements of the j-th column */
         j_beg = vc_ptr[j];
         j_end = j_beg + vc_cnt[j] - 1;
         for (k = j_beg; k <= j_end; k++)
         {  /* get row index and element value */
            i = sv_ndx[k];
            val = sv_val[k];
            /* store element in the i-th row */
            i_ptr = vr_ptr[i] + vr_cnt[i];
            sv_ndx[i_ptr] = j;
            sv_val[i_ptr] = val;
            /* increase count of the i-th row */
            vr_cnt[i]++;
            /* compute the largest value of the i-th row */
            if (rs_max[i] < fabs(val)) rs_max[i] = fabs(val);
         }
      }
      /* set P = Q = I */
      for (k = 1; k <= m; k++) pp_row[k] = k;
      for (k = 1; k <= m; k++) pp_col[k] = k;
      for (k = 1; k <= m; k++) qq_row[k] = k;
      for (k = 1; k <= m; k++) qq_col[k] = k;
      /* set sva partitioning pointers */
      fhv->sv_beg = sv_beg;
      fhv->sv_end = sv_end;
      /* the current physical order of rows and columns of the matrix V
         is m+1, ..., m+m, 1, ..., m (at first columns, then rows) */
      fhv->sv_head = m+1;
      fhv->sv_tail = m;
      for (i = 1; i <= m; i++)
      {  sv_prev[i] = i-1;
         sv_next[i] = i+1;
      }
      sv_prev[1] = m+m;
      sv_next[m] = 0;
      for (j = 1; j <= m; j++)
      {  sv_prev[m+j] = m+j-1;
         sv_next[m+j] = m+j+1;
      }
      sv_prev[m+1] = 0;
      sv_next[m+m] = 1;
      /* initially the active submatrix is the whole matrix V = B */
      /* build linked lists of active rows */
      for (cnt = 0; cnt <= m; cnt++) rs_head[cnt] = 0;
      for (i = 1; i <= m; i++)
      {  cnt = vr_cnt[i];
         rs_prev[i] = 0;
         rs_next[i] = rs_head[cnt];
         if (rs_next[i] != 0) rs_prev[rs_next[i]] = i;
         rs_head[cnt] = i;
      }
      /* build linked lists of active columns */
      for (cnt = 0; cnt <= m; cnt++) cs_head[cnt] = 0;
      for (j = 1; j <= m; j++)
      {  cnt = vc_cnt[j];
         cs_prev[j] = 0;
         cs_next[j] = cs_head[cnt];
         if (cs_next[j] != 0) cs_prev[cs_next[j]] = j;
         cs_head[cnt] = j;
      }
      /* the partially transformed column is not prepared yet */
      fhv->cc_cnt = -1;
      /* clear working arrays */
      for (k = 1; k <= m; k++) flag[k] = 0;
      for (k = 1; k <= m; k++) work[k] = 0.0;
      /* initialize some statistics */
      fhv->nnz_b = 0;
      fhv->max_b = 0.0;
      for (i = 1; i <= m; i++)
      {  fhv->nnz_b += vr_cnt[i];
         if (fhv->max_b < rs_max[i]) fhv->max_b = rs_max[i];
      }
      fhv->nnz_f = 0;
      fhv->nnz_h = 0;
      fhv->nnz_v = 0;
      fhv->big_v = fhv->max_b;
      fhv->rank = 0;
done: /* return to the factorizing routine */
      return ret;
}

/*----------------------------------------------------------------------
-- defragment - defragment the sparse vector area.
--
-- This routine defragments the sparse vector area in order to move all
-- unused locations from the left part (which contains rows and columns
-- of the matrix V) to the middle part (which contains free locations).
-- To do that the routine relocates elements of rows and columns of the
-- matrix V toward the beginning of the left part.
--
-- Note that this "garbage collection" involves changing row and column
-- pointers of the matrix V. */

static void defragment(FHV *fhv)
{     int m = fhv->m;
      int *vr_ptr = fhv->vr_ptr;
      int *vr_cnt = fhv->vr_cnt;
      int *vr_cap = fhv->vr_cap;
      int *vc_ptr = fhv->vc_ptr;
      int *vc_cnt = fhv->vc_cnt;
      int *vc_cap = fhv->vc_cap;
      int *sv_ndx = fhv->sv_ndx;
      double *sv_val = fhv->sv_val;
      int *sv_next = fhv->sv_next;
      int sv_beg = 1;
      int i, j, k;
      /* skip rows and columns, which doesn't need to be relocated */
      for (k = fhv->sv_head; k != 0; k = sv_next[k])
      {  if (k <= m)
         {  /* i-th row of the matrix V */
            i = k;
            if (vr_ptr[i] != sv_beg) break;
            vr_cap[i] = vr_cnt[i];
            sv_beg += vr_cap[i];
         }
         else
         {  /* j-th column of the matrix V */
            j = k - m;
            if (vc_ptr[j] != sv_beg) break;
            vc_cap[j] = vc_cnt[j];
            sv_beg += vc_cap[j];
         }
      }
      /* relocate other rows and columns in order to gather all unused
         locations in one continuous extent */
      for (k = k; k != 0; k = sv_next[k])
      {  if (k <= m)
         {  /* i-th row of the matrix V */
            i = k;
            memmove(&sv_ndx[sv_beg], &sv_ndx[vr_ptr[i]],
               vr_cnt[i] * sizeof(int));
            memmove(&sv_val[sv_beg], &sv_val[vr_ptr[i]],
               vr_cnt[i] * sizeof(double));
            vr_ptr[i] = sv_beg;
            vr_cap[i] = vr_cnt[i];
            sv_beg += vr_cap[i];
         }
         else
         {  /* j-th column of the matrix V */
            j = k - m;
            memmove(&sv_ndx[sv_beg], &sv_ndx[vc_ptr[j]],
               vc_cnt[j] * sizeof(int));
            memmove(&sv_val[sv_beg], &sv_val[vc_ptr[j]],
               vc_cnt[j] * sizeof(double));
            vc_ptr[j] = sv_beg;
            vc_cap[j] = vc_cnt[j];
            sv_beg += vc_cap[j];
         }
      }
      /* set new pointer to the beginning of the free part */
      fhv->sv_beg = sv_beg;
      return;
}

/*----------------------------------------------------------------------
-- enlarge_row - enlarge capacity of the specified row.
--
-- This routine enlarges capacity of the i-th row of the matrix V to
-- cap locations (it is assumed that its current capacity is less than
-- cap). In order to do that the routine relocates elements of the i-th
-- row to the end of the left part (which contains rows and columns of
-- the matrix V) and then expands the left part allocating cap free
-- locations from the free part. If current number of free locations is
-- less than cap, the routine defragments the sparse vector area.
--
-- Due to "garbage collection" this operation may involve changing row
-- and column pointers of the matrix V.
--
-- If no error occured, the routine returns zero. Otherwise, in case of
-- overflow of the sparse vector area, the routine returns non-zero. */

static int enlarge_row(FHV *fhv, int i, int cap)
{     int m = fhv->m;
      int *vr_ptr = fhv->vr_ptr;
      int *vr_cnt = fhv->vr_cnt;
      int *vr_cap = fhv->vr_cap;
      int *vc_cap = fhv->vc_cap;
      int *sv_ndx = fhv->sv_ndx;
      double *sv_val = fhv->sv_val;
      int *sv_prev = fhv->sv_prev;
      int *sv_next = fhv->sv_next;
      int ret = 0;
      int cur, k, kk;
      /* if there are less than cap free locations, defragment sva */
      if (fhv->sv_end - fhv->sv_beg < cap)
      {  defragment(fhv);
         if (fhv->sv_end - fhv->sv_beg < cap)
         {  ret = 1;
            goto done;
         }
      }
      /* save current capacity of the i-th row */
      cur = vr_cap[i];
      /* copy existing elements to the beginning of the free part */
      memmove(&sv_ndx[fhv->sv_beg], &sv_ndx[vr_ptr[i]],
         vr_cnt[i] * sizeof(int));
      memmove(&sv_val[fhv->sv_beg], &sv_val[vr_ptr[i]],
         vr_cnt[i] * sizeof(double));
      /* set new pointer and new capacity of the i-th row */
      vr_ptr[i] = fhv->sv_beg;
      vr_cap[i] = cap;
      /* set new pointer to the beginning of the free part */
      fhv->sv_beg += cap;
      /* now the i-th row begins in rightmost location among other rows
         and columns of the matrix V, so its node should be moved to the
         end of the row/column linked list */
      k = i;
      /* remove the i-th row node from the linked list */
      if (sv_prev[k] == 0)
         fhv->sv_head = sv_next[k];
      else
      {  /* capacity of the previous row/column can be increased at the
            expense of old locations of the i-th row */
         kk = sv_prev[k];
         if (kk <= m) vr_cap[kk] += cur; else vc_cap[kk-m] += cur;
         sv_next[sv_prev[k]] = sv_next[k];
      }
      if (sv_next[k] == 0)
         fhv->sv_tail = sv_prev[k];
      else
         sv_prev[sv_next[k]] = sv_prev[k];
      /* insert the i-th row node to the end of the linked list */
      sv_prev[k] = fhv->sv_tail;
      sv_next[k] = 0;
      if (sv_prev[k] == 0)
         fhv->sv_head = k;
      else
         sv_next[sv_prev[k]] = k;
      fhv->sv_tail = k;
done: return ret;
}

/*----------------------------------------------------------------------
-- enlarge_col - enlarge capacity of the specified column.
--
-- This routine enlarges capacity of the j-th column of the matrix V to
-- cap locations (it is assumed that its current capacity is less than
-- cap). In order to do that the routine relocates elements of the j-th
-- column to the end of the left part (which contains rows and columns
-- of the matrix V) and then expands the left part allocating cap free
-- locations from the free part. If current number of free locations is
-- less than cap, the routine defragments the sparse vector area.
--
-- Due to "garbage collection" this operation may involve changing row
-- and column pointers of the matrix V.
--
-- If no error occured, the routine returns zero. Otherwise, in case of
-- overflow of the sparse vector area, the routine returns non-zero. */

static int enlarge_col(FHV *fhv, int j, int cap)
{     int m = fhv->m;
      int *vr_cap = fhv->vr_cap;
      int *vc_ptr = fhv->vc_ptr;
      int *vc_cnt = fhv->vc_cnt;
      int *vc_cap = fhv->vc_cap;
      int *sv_ndx = fhv->sv_ndx;
      double *sv_val = fhv->sv_val;
      int *sv_prev = fhv->sv_prev;
      int *sv_next = fhv->sv_next;
      int ret = 0;
      int cur, k, kk;
      /* if there are less than cap free locations, defragment sva */
      if (fhv->sv_end - fhv->sv_beg < cap)
      {  defragment(fhv);
         if (fhv->sv_end - fhv->sv_beg < cap)
         {  ret = 1;
            goto done;
         }
      }
      /* save current capacity of the j-th column */
      cur = vc_cap[j];
      /* copy existing elements to the beginning of the free part */
      memmove(&sv_ndx[fhv->sv_beg], &sv_ndx[vc_ptr[j]],
         vc_cnt[j] * sizeof(int));
      memmove(&sv_val[fhv->sv_beg], &sv_val[vc_ptr[j]],
         vc_cnt[j] * sizeof(double));
      /* set new pointer and new capacity of the j-th column */
      vc_ptr[j] = fhv->sv_beg;
      vc_cap[j] = cap;
      /* set new pointer to the beginning of the free part */
      fhv->sv_beg += cap;
      /* now the j-th column begins in rightmost location among other
         rows and columns of the matrix V, so its node should be moved
         to the end of the row/column linked list */
      k = m + j;
      /* remove the j-th column node from the linked list */
      if (sv_prev[k] == 0)
         fhv->sv_head = sv_next[k];
      else
      {  /* capacity of the previous row/column can be increased at the
            expense of old locations of the j-th column */
         kk = sv_prev[k];
         if (kk <= m) vr_cap[kk] += cur; else vc_cap[kk-m] += cur;
         sv_next[sv_prev[k]] = sv_next[k];
      }
      if (sv_next[k] == 0)
         fhv->sv_tail = sv_prev[k];
      else
         sv_prev[sv_next[k]] = sv_prev[k];
      /* insert the j-th column node to the end of the linked list */
      sv_prev[k] = fhv->sv_tail;
      sv_next[k] = 0;
      if (sv_prev[k] == 0)
         fhv->sv_head = k;
      else
         sv_next[sv_prev[k]] = k;
      fhv->sv_tail = k;
done: return ret;
}

/*----------------------------------------------------------------------
-- find_pivot - choose pivot element.
--
-- This routine chooses a pivot element v[p,q] in the active submatrix
-- of the matrix V.
--
-- It is assumed that on entry the matrix U = P*V*Q is the following:
--
--       1       k         m
--    1  x x x x x x x x x x
--       . x x x x x x x x x
--       . . x x x x x x x x
--       . . . x x x x x x x
--    k  . . . . * * * * * *
--       . . . . * * * * * *
--       . . . . * * * * * *
--       . . . . * * * * * *
--       . . . . * * * * * *
--    m  . . . . * * * * * *
--
-- where rows and columns with numbers k, k+1, ..., m form the active
-- submatrix (elements of which are marked by '*').
--
-- Since the matrix U = P*V*Q is not stored, the routine works with the
-- matrix V. It is assumed that the row-wise representation corresponds
-- to the matrix V, but the column-wise representation corresponds to
-- the active submatrix of the matrix V, i.e. elements of the matrix V,
-- which doesn't belong to the active submatrix, are missing from the
-- column linked lists. It is also assumed that each active row of the
-- matrix V is in the set R[cnt], where cnt is number of non-zeros in
-- the row, and each active column of the matrix V is in the set C[cnt],
-- where cnt is number of non-zeros in the column (in the latter case
-- only elements of the active submatrix are counted; such elements are
-- marked by '*' on the figure above).
--
-- For the reason of numerical stability the routine uses so called
-- threshold pivoting proposed by J.Reid. It is assumed that an element
-- v[i,j] can be selected as a pivot candidate if it is not very small
-- (in absolute value) among other elements in the same row, i.e. if it
-- satisfies to the stability condition |v[i,j]| >= tol * max|v[i,*]|,
-- where 0 < tol < 1 is the given tolerance.
--
-- In order to keep sparsity of the matrix V the routine uses Markowitz
-- strategy, trying to choose such element v[p,q], which satisfies to
-- the stability condition (see above) and has smallest Markowitz cost
-- (nr[p]-1) * (nc[q]-1), where nr[p] and nc[q] are numbers of non-zero
-- elements, respectively, in the p-th row and in the q-th column of the
-- active submatrix.
--
-- In order to reduce the search, i.e. not to walk through all elements
-- of the active submatrix, the routine uses the technique proposed by
-- I.Duff. This technique is based on using the sets R[cnt] and C[cnt]
-- of active rows and columns.
--
-- If the pivot element v[p,q] has been chosen, the routine stores its
-- indices to the locations *p and *q and returns zero. Otherwise, if
-- the active submatrix is empty, due to which the pivot element can't
-- be chosen, the routine returns non-zero. */

static int find_pivot(FHV *fhv, int *_p, int *_q)
{     int m = fhv->m;
      int *vr_ptr = fhv->vr_ptr;
      int *vr_cnt = fhv->vr_cnt;
      int *vc_ptr = fhv->vc_ptr;
      int *vc_cnt = fhv->vc_cnt;
      int *sv_ndx = fhv->sv_ndx;
      double *sv_val = fhv->sv_val;
      int *rs_head = fhv->rs_head;
      double *rs_max = fhv->rs_max;
      int *cs_head = fhv->cs_head;
      int *cs_prev = fhv->cs_prev;
      int *cs_next = fhv->cs_next;
      double piv_tol = fhv->piv_tol;
      int p = 0, q = 0;
      int cnt, cost, i, i_beg, i_end, i_ptr, j, j_beg, j_end, j_ptr;
      double big, temp;
      /* if in the active submatrix there is a column that has only one
         non-zero element (column singleton), choose this element as the
         pivot */
      if (cs_head[1] != 0)
      {  q = cs_head[1];
         insist(vc_cnt[q] == 1);
         p = sv_ndx[vc_ptr[q]];
         goto done;
      }
      /* if in the active submatrix there is a row that has only one
         non-zero element (row singleton), choose this element as the
         pivot */
      if (rs_head[1] != 0)
      {  p = rs_head[1];
         insist(vr_cnt[p] == 1);
         q = sv_ndx[vr_ptr[p]];
         goto done;
      }
      /* walk through other non-empty active rows and columns */
      for (cnt = 2; cnt <= m; cnt++)
      {  /* consider active columns that have cnt non-zeros */
         while (cs_head[cnt] != 0)
         {  /* the j-th column has cnt non-zeros */
            j = cs_head[cnt];
            j_beg = vc_ptr[j];
            j_end = j_beg + vc_cnt[j] - 1;
            /* find an element in the j-th column, which is placed in
               the row with minimal number of non-zeros and satisfies to
               the stability condition (such element may not exist) */
            cost = m + 1;
            for (j_ptr = j_beg; j_ptr <= j_end; j_ptr++)
            {  /* get row index */
               i = sv_ndx[j_ptr];
               i_beg = vr_ptr[i];
               i_end = i_beg + vr_cnt[i] - 1;
               /* get the largest of absolute values of elements in the
                  i-th row */
               big = rs_max[i];
               if (big < 0.0)
               {  /* the largest value is unknown; determine it */
                  for (i_ptr = i_beg; i_ptr <= i_end; i_ptr++)
                  {  temp = fabs(sv_val[i_ptr]);
                     if (big < temp) big = temp;
                  }
                  rs_max[i] = big;
                  /* estimate the largest of absolute values of elements
                     that appear in the active submatrix of the matrix V
                     during all the elimination process */
                  if (fhv->big_v < big) fhv->big_v = big;
               }
               /* find v[i,j] in the i-th row */
               for (i_ptr = vr_ptr[i]; sv_ndx[i_ptr] != j; i_ptr++);
               insist(i_ptr <= i_end);
               /* check if v[i,j] can be chosen */
               temp = piv_tol * big;
               if (vr_cnt[i] < cost && fabs(sv_val[i_ptr]) >= temp)
               {  p = i;
                  q = j;
                  cost = vr_cnt[i];
                  if (cost <= cnt) break;
               }
            }
            /* if the element has been chosen, it fits to be pivot */
            if (p != 0 && q != 0) goto done;
            /* the j-th column has no appropriate elements; Uwe Suhl
               suggests to remove such columns from the active set in
               order not to consider them in the future */
            cs_head[cnt] = cs_next[j];
            if (cs_next[j] != 0) cs_prev[cs_next[j]] = 0;
            /* the following assignment is used to avoid an error when
               the routine eliminate will try to remove the j-th column
               from the active set */
            cs_prev[j] = cs_next[j] = j;
         }
         /* no choice has been made using columns with cnt non-zeros;
            therefore try to consider an arbitrary active row that has
            cnt non-zeros */
         if (rs_head[cnt] != 0)
         {  /* the i-th row has cnt non-zeros */
            i = rs_head[cnt];
            i_beg = vr_ptr[i];
            i_end = i_beg + vr_cnt[i] - 1;
            /* get the largest of absolute values of elements in the
               i-th row */
            big = rs_max[i];
            if (big < 0.0)
            {  /* the largest value is unknown; determine it */
               for (i_ptr = i_beg; i_ptr <= i_end; i_ptr++)
               {  temp = fabs(sv_val[i_ptr]);
                  if (big < temp) big = temp;
               }
               rs_max[i] = big;
               /* estimate the largest of absolute values of elements
                  that appear in the active submatrix of the matrix V
                  during all the elimination process */
               if (fhv->big_v < big) fhv->big_v = big;
            }
            /* find an element in the i-th row, which is placed in the
               column with minimal number of non-zeros and satisfies to
               the stability condition (such element always exists) */
            cost = m + 1;
            temp = piv_tol * big;
            for (i_ptr = i_beg; i_ptr <= i_end; i_ptr++)
            {  /* get column index */
               j = sv_ndx[i_ptr];
               /* check if v[i,j] can be chosen */
               if (vc_cnt[j] < cost && fabs(sv_val[i_ptr]) >= temp)
               {  p = i;
                  q = j;
                  cost = vc_cnt[j];
                  if (cost <= cnt) break;
               }
            }
            /* the chosen element fits to be pivot */
            insist(p != 0 && q != 0);
            goto done;
         }
      }
done: /* return to the factorizing routine */
      *_p = p;
      *_q = q;
      return (p != 0 && q != 0) ? 0 : 1;
}

/*----------------------------------------------------------------------
-- eliminate() - perform gaussian elimination.
--
-- This routine performs elementary gaussian transformations in order
-- to eliminate subdiagonal elements in the k-th column of the matrix
-- U = P*V*Q using the pivot element u[k,k], where k is the number of
-- the current elimination step.
--
-- The parameters p and q are, respectively, row and column indices of
-- the element v[p,q], which corresponds to the element u[k,k].
--
-- Each time when the routine applies the elementary transformation to
-- non-pivot row of the matrix V, it stores the corresponding element
-- to the current column-like factor of the matrix F in order to keep
-- the main equality B = F*V (the matrix H is unity matrix and not used
-- during all factorization process).
--
-- It is assumed that on entry the matrix U is the following:
--
--       1       k         m
--    1  x x x x x x x x x x
--       . x x x x x x x x x
--       . . x x x x x x x x
--       . . . x x x x x x x
--    k  . . . . * * * * * *
--       . . . . # * * * * *
--       . . . . # * * * * *
--       . . . . # * * * * *
--       . . . . # * * * * *
--    m  . . . . # * * * * *
--
-- where rows and columns with numbers k, k+1, ..., m form the active
-- submatrix (eliminated elements are marked by '#', other elements of
-- the active submatrix are marked by '*').
--
-- Actually all operations are performed on the matrix V. Should note
-- that the row-wise representation corresponds to the matrix V, but the
-- column-wise representation corresponds to the active submatrix of the
-- matrix V, i.e. elements of the matrix V, which doesn't belong to the
-- active submatrix, are missing from the column linked lists. Note also
-- that numerical values of elements are not stored in the column-wise
-- representation, only row indices are stored.
--
-- Let u[k,k] = v[p,q] be the pivot. In order to eliminate subdiagonal
-- elements u[i',k] = v[i,q], i' = k+1, k+2, ..., m, the routine applies
-- the following elementary gaussian transformations:
--
--    (i-th row of V) := (i-th row of V) - f[i] * (p-th row of V),   (*)
--
-- where f[i] = v[i,q] / v[p,q] is gaussian multiplier.
--
-- Additionally, in order to keep the main equality B = F*V, each time
-- when the routine applies the transformation (*) to the matrix V, it
-- also adds f[i] as a new element to the current column-like factor of
-- the matrix F, which (factor) corresponds to the p-th (pivot) row.
--
-- If no error occured, the routine returns zero. Otherwise, in case of
-- overflow of the sparse vector area, the routine returns non-zero. */

static int eliminate(FHV *fhv, int p, int q)
{     int m = fhv->m;
      int *fc_ndx = fhv->fc_ndx;
      int *fc_ptr = fhv->fc_ptr;
      int *fc_cnt = fhv->fc_cnt;
      int *vr_ptr = fhv->vr_ptr;
      int *vr_cnt = fhv->vr_cnt;
      int *vr_cap = fhv->vr_cap;
      double *vr_piv = fhv->vr_piv;
      int *vc_ptr = fhv->vc_ptr;
      int *vc_cnt = fhv->vc_cnt;
      int *vc_cap = fhv->vc_cap;
      int *sv_ndx = fhv->sv_ndx;
      double *sv_val = fhv->sv_val;
      int *rs_head = fhv->rs_head;
      int *rs_prev = fhv->rs_prev;
      int *rs_next = fhv->rs_next;
      double *rs_max = fhv->rs_max;
      int *cs_head = fhv->cs_head;
      int *cs_prev = fhv->cs_prev;
      int *cs_next = fhv->cs_next;
      int *cc_ndx = fhv->cc_ndx;
      int *flag = fhv->flag;
      double *work = fhv->work;
      double eps_tol = fhv->eps_tol;
      int ret = 0;
      int cnt, fill, i, i_beg, i_end, i_ptr, j, j_beg, j_end, j_ptr, k,
         p_beg, p_end, p_ptr, q_beg, q_end, q_ptr;
      double f, val, vpq;
      insist(1 <= p && p <= m);
      insist(1 <= q && q <= m);
      /* remove the p-th (pivot) row from the active set; this row will
         not return there */
      if (rs_prev[p] == 0)
         rs_head[vr_cnt[p]] = rs_next[p];
      else
         rs_next[rs_prev[p]] = rs_next[p];
      if (rs_next[p] == 0)
         ;
      else
         rs_prev[rs_next[p]] = rs_prev[p];
      /* remove the q-th (pivot) column from the active set; this column
         will not return there */
      if (cs_prev[q] == 0)
         cs_head[vc_cnt[q]] = cs_next[q];
      else
         cs_next[cs_prev[q]] = cs_next[q];
      if (cs_next[q] == 0)
         ;
      else
         cs_prev[cs_next[q]] = cs_prev[q];
      /* find the pivot v[p,q] = u[k,k] in the p-th row */
      p_beg = vr_ptr[p];
      p_end = p_beg + vr_cnt[p] - 1;
      for (p_ptr = p_beg; sv_ndx[p_ptr] != q; p_ptr++) /* nop */;
      insist(p_ptr <= p_end);
      /* store value of the pivot */
      vr_piv[p] = vpq = sv_val[p_ptr];
      /* remove the pivot from the p-th row */
      sv_ndx[p_ptr] = sv_ndx[p_end];
      sv_val[p_ptr] = sv_val[p_end];
      vr_cnt[p]--;
      p_end--;
      /* find the pivot v[p,q] = u[k,k] in the q-th column */
      q_beg = vc_ptr[q];
      q_end = q_beg + vc_cnt[q] - 1;
      for (q_ptr = q_beg; sv_ndx[q_ptr] != p; q_ptr++) /* nop */;
      insist(q_ptr <= q_end);
      /* remove the pivot from the q-th column */
      sv_ndx[q_ptr] = sv_ndx[q_end];
      vc_cnt[q]--;
      q_end--;
      /* walk through the p-th (pivot) row, which doesn't contain the
         pivot v[p,q] already, and do the following... */
      for (p_ptr = p_beg; p_ptr <= p_end; p_ptr++)
      {  /* get column index of v[p,j] */
         j = sv_ndx[p_ptr];
         /* store v[p,j] to the working array */
         flag[j] = 1;
         work[j] = sv_val[p_ptr];
         /* remove the j-th column from the active set; this column will
            return there later with new column count */
         if (cs_prev[j] == 0)
            cs_head[vc_cnt[j]] = cs_next[j];
         else
            cs_next[cs_prev[j]] = cs_next[j];
         if (cs_next[j] == 0)
            ;
         else
            cs_prev[cs_next[j]] = cs_prev[j];
         /* find v[p,j] in the j-th column */
         j_beg = vc_ptr[j];
         j_end = j_beg + vc_cnt[j] - 1;
         for (j_ptr = j_beg; sv_ndx[j_ptr] != p; j_ptr++) /* nop */;
         insist(j_ptr <= j_end);
         /* since v[p,j] leaves the active submatrix, remove it from the
            j-th column; however, v[p,j] is kept in the p-th row */
         sv_ndx[j_ptr] = sv_ndx[j_end];
         vc_cnt[j]--;
      }
      /* create the next column-like factor of the matrix F; this factor
         corresponds to the p-th (pivot) row */
      fhv->fc_nfs++;
      fc_ndx[fhv->fc_nfs] = p;
      /* fc_ptr[] will be set later */
      fc_cnt[fhv->fc_nfs] = 0;
      /* walk through the q-th (pivot) column, which doesn't contain the
         pivot v[p,q] already, and perform gaussian elimination */
      while (q_beg <= q_end)
      {  /* get row index of v[i,q] */
         i = sv_ndx[q_beg];
         /* remove the i-th row from the active set; later this row will
            return there with new row count */
         if (rs_prev[i] == 0)
            rs_head[vr_cnt[i]] = rs_next[i];
         else
            rs_next[rs_prev[i]] = rs_next[i];
         if (rs_next[i] == 0)
            ;
         else
            rs_prev[rs_next[i]] = rs_prev[i];
         /* find v[i,q] in the i-th row */
         i_beg = vr_ptr[i];
         i_end = i_beg + vr_cnt[i] - 1;
         for (i_ptr = i_beg; sv_ndx[i_ptr] != q; i_ptr++) /* nop */;
         insist(i_ptr <= i_end);
         /* compute gaussian multiplier f = v[i,q] / v[p,q] */
         f = sv_val[i_ptr] / vpq;
         /* since v[i,q] has to be eliminated, remove it from the i-th
            row */
         sv_ndx[i_ptr] = sv_ndx[i_end];
         sv_val[i_ptr] = sv_val[i_end];
         vr_cnt[i]--;
         i_end--;
         /* and from the q-th column */
         sv_ndx[q_beg] = sv_ndx[q_end];
         vc_cnt[q]--;
         q_end--;
         /* perform gaussian transformation:
            (i-th row) := (i-th row) - f * (p-th row)
            note that now the p-th row, which is in the working array,
            doesn't contain the pivot v[p,q], and the i-th row doesn't
            contain the eliminated element v[i,q] */
         /* walk through the i-th row and transform existing elements */
         fill = vr_cnt[p];
         for (i_ptr = i_beg; i_ptr <= i_end; i_ptr++)
         {  /* get column index of v[i,j] */
            j = sv_ndx[i_ptr];
            /* v[i,j] := v[i,j] - f * v[p,j] */
            if (flag[j])
            {  /* v[p,j] != 0 */
               sv_val[i_ptr] -= f * work[j];
               flag[j] = 0;
               fill--; /* since both v[i,j] and v[p,j] exist */
               /* if new v[i,j] is closer to zero, remove it from the
                  active submatrix */
               if (fabs(sv_val[i_ptr]) < eps_tol)
               {  /* remove v[i,j] from the i-th row */
                  sv_ndx[i_ptr] = sv_ndx[i_end];
                  sv_val[i_ptr] = sv_val[i_end];
                  vr_cnt[i]--;
                  i_ptr--;
                  i_end--;
                  /* find v[i,j] in the j-th column */
                  j_beg = vc_ptr[j];
                  j_end = j_beg + vc_cnt[j] - 1;
                  for (j_ptr = j_beg; sv_ndx[j_ptr] != i; j_ptr++);
                  insist(j_ptr <= j_end);
                  /* remove v[i,j] from the j-th column */
                  sv_ndx[j_ptr] = sv_ndx[j_end];
                  vc_cnt[j]--;
               }
            }
         }
         /* now flag is the pattern of the set v[p,*] \ v[i,*], and fill
            is number of non-zeros in this set; therefore up to fill new
            non-zeros may appear in the i-th row */
         if (vr_cnt[i] + fill > vr_cap[i])
         {  /* enlarge the i-th row */
            if (enlarge_row(fhv, i, vr_cnt[i] + fill))
            {  /* overflow of the sparse vector area */
               ret = 1;
               goto done;
            }
            /* defragmentation may change row and column pointers of the
               matrix V */
            p_beg = vr_ptr[p];
            p_end = p_beg + vr_cnt[p] - 1;
            q_beg = vc_ptr[q];
            q_end = q_beg + vc_cnt[q] - 1;
         }
         /* walk through the p-th (pivot) row and create new elements
            of the i-th row that appear due to fill-in; column indices
            of these new elements are accumulated in the array cc_ndx */
         cnt = 0;
         for (p_ptr = p_beg; p_ptr <= p_end; p_ptr++)
         {  /* get column index of v[p,j], which may cause fill-in */
            j = sv_ndx[p_ptr];
            if (flag[j])
            {  /* compute new non-zero v[i,j] = 0.0 - f * v[p,j] */
               val = - f * work[j];
               if (fabs(val) < eps_tol)
                  /* if v[i,j] is closer to zero, ignore it */;
               else
               {  /* add v[i,j] to the i-th row */
                  i_ptr = vr_ptr[i] + vr_cnt[i];
                  sv_ndx[i_ptr] = j;
                  sv_val[i_ptr] = val;
                  vr_cnt[i]++;
                  /* remember column index of v[i,j] */
                  cc_ndx[++cnt] = j;
               }
            }
            else
            {  /* there is no fill-in, because v[i,j] already exists in
                  the i-th row; restore flag of v[p,j], which was reset
                  above */
               flag[j] = 1;
            }
         }
         /* add new non-zeros v[i,j] to the corresponding columns */
         for (k = 1; k <= cnt; k++)
         {  /* get column index of new non-zero v[i,j] */
            j = cc_ndx[k];
            /* one free location is needed in the j-th column */
            if (vc_cnt[j] + 1 > vc_cap[j])
            {  /* enlarge the j-th column */
               if (enlarge_col(fhv, j, vc_cnt[j] + 10))
               {  /* overflow of the sparse vector area */
                  ret = 1;
                  goto done;
               }
               /* defragmentation may change row and column pointers of
                  the matrix V */
               p_beg = vr_ptr[p];
               p_end = p_beg + vr_cnt[p] - 1;
               q_beg = vc_ptr[q];
               q_end = q_beg + vc_cnt[q] - 1;
            }
            /* add new non-zero v[i,j] to the j-th column */
            j_ptr = vc_ptr[j] + vc_cnt[j];
            sv_ndx[j_ptr] = i;
            vc_cnt[j]++;
         }
         /* now the i-th row has been completely transformed, therefore
            it can return to the active set with new row count */
         rs_prev[i] = 0;
         rs_next[i] = rs_head[vr_cnt[i]];
         if (rs_next[i] != 0) rs_prev[rs_next[i]] = i;
         rs_head[vr_cnt[i]] = i;
         /* the largest of absolute values of elements in the i-th row
            is currently unknown */
         rs_max[i] = -1.0;
         /* at least one free location is needed to add new element to
            the non-trivial column of the current column-like factor of
            the matrix F */
         if (fhv->sv_end - fhv->sv_beg < 1)
         {  /* there are no free locations; defragment sva */
            defragment(fhv);
            if (fhv->sv_end - fhv->sv_beg < 1)
            {  /* overflow of the sparse vector area */
               ret = 1;
               goto done;
            }
            /* defragmentation may change row and column pointers of the
               matrix V */
            p_beg = vr_ptr[p];
            p_end = p_beg + vr_cnt[p] - 1;
            q_beg = vc_ptr[q];
            q_end = q_beg + vc_cnt[q] - 1;
         }
         /* store new element (gaussian multiplier that corresponds to
            the i-th row) in the current column-like factor */
         fhv->sv_end--;
         sv_ndx[fhv->sv_end] = i;
         sv_val[fhv->sv_end] = f;
         fc_cnt[fhv->fc_nfs]++;
         /* end of elimination loop */
      }
      /* now the q-th (pivot) column (of the active submatrix) should be
         empty */
      insist(vc_cnt[q] == 0);
      /* set pointer to the current column-like factor of the matrix F
         (if no elements were added to this factor, it is unity matrix
         and therefore can be discarded) */
      if (fc_cnt[fhv->fc_nfs] == 0)
         fhv->fc_nfs--;
      else
         fc_ptr[fhv->fc_nfs] = fhv->sv_end;
      /* walk through the p-th (pivot) row and do the following... */
      for (p_ptr = p_beg; p_ptr <= p_end; p_ptr++)
      {  /* get column index of v[p,j] */
         j = sv_ndx[p_ptr];
         /* erase v[p,j] from the working array */
         flag[j] = 0;
         work[j] = 0.0;
         /* the j-th column has been completely transformed, therefore
            it can return to the active set with new column count */
         cs_prev[j] = 0;
         cs_next[j] = cs_head[vc_cnt[j]];
         if (cs_next[j] != 0) cs_prev[cs_next[j]] = j;
         cs_head[vc_cnt[j]] = j;
      }
done: /* return to the factorizing routine */
      return ret;
}

/*----------------------------------------------------------------------
-- build_vc - build the matrix V in column-wise format.
--
-- This routine builds the column-wise representation of the matrix V
-- using its row-wise representation.
--
-- If no error occured, the routine returns zero. Otherwise, in case of
-- overflow of the sparse vector area, the routine returns non-zero. */

static int build_vc(FHV *fhv)
{     int m = fhv->m;
      int *vr_ptr = fhv->vr_ptr;
      int *vr_cnt = fhv->vr_cnt;
      int *vc_ptr = fhv->vc_ptr;
      int *vc_cnt = fhv->vc_cnt;
      int *vc_cap = fhv->vc_cap;
      int *sv_ndx = fhv->sv_ndx;
      double *sv_val = fhv->sv_val;
      int ret = 0;
      int i, i_beg, i_end, i_ptr, j, j_ptr, k;
      /* all columns of the matrix V should be empty (as the result of
         gaussian elimination) */
      for (j = 1; j <= m; j++) insist(vc_cnt[j] == 0);
      /* and capacity of all the columns should be zero (as the result
         of defragmentation) */
      for (j = 1; j <= m; j++) insist(vc_cap[j] == 0);
      /* remove column nodes from the addressing list, because pointers
         of these columns will be changed */
      for (k = m+1; k <= m+m; k++)
      {  if (fhv->sv_prev[k] == 0)
            fhv->sv_head = fhv->sv_next[k];
         else
            fhv->sv_next[fhv->sv_prev[k]] = fhv->sv_next[k];
         if (fhv->sv_next[k] == 0)
            fhv->sv_tail = fhv->sv_prev[k];
         else
            fhv->sv_prev[fhv->sv_next[k]] = fhv->sv_prev[k];
      }
      /* count non-zeros in columns of the matrix V; count total number
         of non-zeros in this matrix */
      fhv->nnz_v = 0;
      for (i = 1; i <= m; i++)
      {  /* walk through elements of the i-th row and count non-zeros
            in the corresponding columns */
         i_beg = vr_ptr[i];
         i_end = i_beg + vr_cnt[i] - 1;
         for (i_ptr = i_beg; i_ptr <= i_end; i_ptr++)
            vc_cap[sv_ndx[i_ptr]]++;
         /* increase count of non-zeros in the matrix V */
         fhv->nnz_v += vr_cnt[i];
      }
      /* check for free locations */
      if (fhv->sv_end - fhv->sv_beg < fhv->nnz_v)
      {  /* overflow of the sparse vector area */
         ret = 1;
         goto done;
      }
      /* allocate columns of the matrix V */
      for (j = 1; j <= m; j++)
      {  /* set pointer to the j-th column */
         vc_ptr[j] = fhv->sv_beg;
         /* reserve locations for the j-th column */
         fhv->sv_beg += vc_cap[j];
      }
      /* build the matrix V in column-wise format using this matrix in
         row-wise format */
      for (i = 1; i <= m; i++)
      {  /* walk through elements of the i-th row */
         i_beg = vr_ptr[i];
         i_end = i_beg + vr_cnt[i] - 1;
         for (i_ptr = i_beg; i_ptr <= i_end; i_ptr++)
         {  /* get column index */
            j = sv_ndx[i_ptr];
            /* store element in the j-th column */
            j_ptr = vc_ptr[j] + vc_cnt[j];
            sv_ndx[j_ptr] = i;
            sv_val[j_ptr] = sv_val[i_ptr];
            /* increase count of the j-th column */
            vc_cnt[j]++;
         }
      }
      /* now columns are placed in the sparse vector area behind rows
         in the order m+1, m+2, ..., m+m; so insert column nodes in the
         addressing list using this order */
      for (k = m+1; k <= m+m; k++)
      {  fhv->sv_prev[k] = k-1;
         fhv->sv_next[k] = k+1;
      }
      fhv->sv_prev[m+1] = fhv->sv_tail;
      fhv->sv_next[fhv->sv_tail] = m+1;
      fhv->sv_next[m+m] = 0;
      fhv->sv_tail = m+m;
done: /* return to the factorizing routine */
      return ret;
}

/*----------------------------------------------------------------------
-- build_fr - build the matrix F in row-like format.
--
-- This routine builds the row-like representation of the matrix F using
-- its column-like representation.
--
-- If no error occured, the routine returns zero. Otherwise, in case of
-- overflow of the sparse vector area, the routine returns non-zero. */

static int build_fr(FHV *fhv)
{     int m = fhv->m;
      int *fr_ndx = fhv->fr_ndx;
      int *fr_ptr = fhv->fr_ptr;
      int *fr_cnt = fhv->fr_cnt;
      int fc_nfs = fhv->fc_nfs;
      int *fc_ptr = fhv->fc_ptr;
      int *fc_ndx = fhv->fc_ndx;
      int *fc_cnt = fhv->fc_cnt;
      int *pp_row = fhv->pp_row;
      int *pp_col = fhv->pp_col;
      int *sv_ndx = fhv->sv_ndx;
      double *sv_val = fhv->sv_val;
      int ret = 0;
      int j_beg, j_end, j_ptr, k, kk, ptr;
      /* determine numbers of non-trivial rows in row-like factors */
      for (k = 1; k <= m; k++) fr_ndx[k] = pp_row[k];
      /* clear counts of row-like factors */
      for (k = 1; k <= m; k++) fr_cnt[k] = 0;
      /* count non-zeros in row-like factors, count total number of
         non-zeros in the matrix F */
      fhv->nnz_f = 0;
      for (k = 1; k <= fc_nfs; k++)
      {  /* walk through elements in non-trivial column of the k-th
            column-like factor and count non-zeros in non-trivial rows
            of the corresponding row-like factors */
         j_beg = fc_ptr[k];
         j_end = j_beg + fc_cnt[k] - 1;
         for (j_ptr = j_beg; j_ptr <= j_end; j_ptr++)
            fr_cnt[pp_col[sv_ndx[j_ptr]]]++;
         /* increase count of non-zeros in the matrix F */
         fhv->nnz_f += fc_cnt[k];
      }
      /* check for free locations */
      if (fhv->sv_end - fhv->sv_beg < fhv->nnz_f)
      {  /* overflow of the sparse vector area */
         ret = 1;
         goto done;
      }
      /* allocate row-like factors of the matrix F */
      for (k = 1; k <= m; k++)
      {  /* set pointer to the end of the k-th row-like factor; later
            this pointer will be set to the beginning of the factor */
         fr_ptr[k] = fhv->sv_end;
         /* reserve locations for the k-th row-like factor */
         fhv->sv_end -= fr_cnt[k];
      }
      /* build row-like factors of the matrix F using its column-like
         factors */
      for (k = 1; k <= fc_nfs; k++)
      {  /* walk through elements in non-trivial column of the k-th
            column-like factor */
         j_beg = fc_ptr[k];
         j_end = j_beg + fc_cnt[k] - 1;
         for (j_ptr = j_beg; j_ptr <= j_end; j_ptr++)
         {  /* decrease pointer of the corresponding row-like factor
               and store the current element in non-trivial row of this
               factor */
            ptr = --fr_ptr[pp_col[sv_ndx[j_ptr]]];
            sv_ndx[ptr] = fc_ndx[k];
            sv_val[ptr] = sv_val[j_ptr];
         }
      }
      /* remove row-like factors, which have no elements, because such
         factors are unity matrices */
      kk = 0;
      for (k = 1; k <= m; k++)
      {  if (fr_cnt[k] != 0)
         {  kk++;
            fr_ndx[kk] = fr_ndx[k];
            fr_ptr[kk] = fr_ptr[k];
            fr_cnt[kk] = fr_cnt[k];
         }
      }
      /* store final number of row-like factors of the matrix F */
      fhv->fr_nfs = kk;
done: /* return to the factorizing routine */
      return ret;
}

/*----------------------------------------------------------------------
-- fhv_decomp - compute FHV-factorization for given basis matrix.
--
-- *Synopsis*
--
-- #include "glpfhv.h"
-- int fhv_decomp(FHV *fhv,
--    int (*column)(void *info, int j, int rn[], double bj[]),
--    void *info);
--
-- *Description*
--
-- The routine fhv_decomp computes FHV-factorization of the given basis
-- matrix B (i.e. it reinverts the basis matrix).
--
-- The given basis matrix B is specified by the formal routine column.
-- In order to obtain j-th column, j = 1, 2, ..., m, of the matrix B the
-- routine fhv_decomp calls the routine column with the parameter j. In
-- response the routine column should store row indices and numerical
-- values of non-zero elements of the j-th column of the basis matrix to
-- locations rn[1], ..., rn[cnt] and bj[1], ..., bj[cnt] respectively,
-- where cnt is the number of non-zeros in the j-th column, which should
-- be returned on exit. Neither zero nor duplicate elements are allowed.
-- The parameter info is a transit pointer, which may be passed to the
-- routine column. Note that the routine column may be called more than
-- once for the same column number.
--
-- *Returns*
--
-- The routine fhv_decomp returns one of the following codes:
--
-- 0 - no errors;
-- 1 - the given basis matrix is singular (on some elimination step all
--     elements of the active submatrix are zeros, due to that the pivot
--     can't be chosen);
-- 2 - the given basis matrix is ill-conditioned (on some elimination
--     step too intensive growth of elements of the active submatrix has
--     been detected).
--
-- *Repairing the basis*
--
-- In case of non-zero return code the factorization becomes invalid.
-- It should not be used in other operations until the cause of failure
-- has been eliminated and the factorization has been recomputed again
-- using the routine fhv_decomp.
--
-- In order to "repair" the basis the simplex method routine can replace
-- linearly dependent columns of B that correspond to columns of the
-- matrix U with numbers rank+1, rank+2, ..., m, where rank is estimated
-- rank of B (stored by the routine fhv_decomp to the member fhv->rank),
-- by appropriate unity columns of logical variables.
--
-- The correspondence between columns of B and U is the same as between
-- columns of V and U. Thus, linearly dependent columns of the matrix B
-- have numbers qq_col[rank+1], qq_col[rank+2], ..., qq_col[m], where
-- qq_col is the column-wise representation of the permutation matrix Q.
-- Being replaced j-th column of the matrix U should be unity vector,
-- i.e. all elements in this column should be zero, except the diagonal
-- element u[j,j], whish should be one. However, j-th row of the matrix
-- U corresponds to row of the matrix V (and therefore of the matrix B)
-- with number pp_row[j], where pp_row is the row-wise representation of
-- the permutation matrix P. So the column that replaces j-th linearly
-- column of the matrix U should be column of the unity matrix with the
-- number pp_row[j].
--
-- Therefore, a code that repairs the basis may look like follows:
--
--    for (j = rank+1; j <= m; j++)
--    {  replace the column qq_col[j] of the basis matrix B by the
--       column pp_row[j] of the unity matrix, i.e. by the column of
--       the corresponding logical variable;
--    }
--
-- where rank, pp_row, and qq_col are members of the structure FHV.
--
-- If the matrix B is well scaled, the return code 2 may also mean that
-- the threshold pivoting tolerance piv_tol should be increased. */

int fhv_decomp(FHV *fhv,
      int (*column)(void *info, int j, int rn[], double bj[]),
      void *info)
{     int m = fhv->m;
      int *pp_row = fhv->pp_row;
      int *pp_col = fhv->pp_col;
      int *qq_row = fhv->qq_row;
      int *qq_col = fhv->qq_col;
      double max_gro = fhv->max_gro;
      int ret = 0;
      int i, j, k, p, q, t;
      /* the factorization is temporarily not valid */
      fhv->valid = 0;
      /* the partially transformed column is not valid */
      fhv->cc_cnt = -1;
more: /* re-allocate the sparse vector area (if necessary) */
      if (fhv->new_sva > 0)
      {  ufree(fhv->sv_ndx);
         ufree(fhv->sv_val);
         fhv->sv_size = fhv->new_sva;
         fhv->sv_ndx = ucalloc(1+fhv->sv_size, sizeof(int));
         fhv->sv_val = ucalloc(1+fhv->sv_size, sizeof(double));
         fhv->new_sva = 0;
      }
      /* initialize FVH-factorization data structures */
      if (initialize(fhv, column, info))
      {  /* overflow of the sparse vector area */
         fhv->new_sva = fhv->sv_size + fhv->sv_size;
         goto more;
      }
      /* main elimination loop */
      for (k = 1; k <= m; k++)
      {  /* choose pivot element v[p,q] */
         if (find_pivot(fhv, &p, &q))
         {  /* the pivot can't be chosen, because the active submatrix
               is zero */
            fhv->rank = k - 1;
            ret = 1;
            goto done;
         }
         /* let v[p,q] correspond to u[i',j']; permute k-th and i'-th
            rows and k-th and j'-th columns of the matrix U = P*V*Q to
            move the element u[i',j'] to the position u[k,k] */
         i = pp_col[p];
         j = qq_row[q];
         insist(k <= i && i <= m && k <= j && j <= m);
         /* permute k-th and i-th rows of the matrix U */
         t = pp_row[k];
         pp_row[i] = t; pp_col[t] = i;
         pp_row[k] = p; pp_col[p] = k;
         /* permute k-th and j-th columns of the matrix U */
         t = qq_col[k];
         qq_col[j] = t; qq_row[t] = j;
         qq_col[k] = q; qq_row[q] = k;
         /* perform gaussian elimination using v[p,q] = u[k,k] as the
            pivot */
         if (eliminate(fhv, p, q))
         {  /* overflow of the sparse vector area */
            fhv->new_sva = fhv->sv_size + fhv->sv_size;
            goto more;
         }
         /* check relative growth of elements of the matrix V */
         if (fhv->big_v / fhv->max_b > max_gro)
         {  /* the growth is too intensive, therefore the basis matrix
               is probably ill-conditioned */
            fhv->rank = k - 1;
            ret = 2;
            goto done;
         }
      }
      /* now the matrix U = P*V*Q is upper triangular, the matrix V has
         been built in row-wise format, and the matrix F has been built
         in column-like format */
      /* defragment the sparse vector area in order to merge all free
         locations in one continous extent */
      defragment(fhv);
      /* build the matrix V in column-wise format */
      if (build_vc(fhv))
      {  /* overflow of the sparse vector area */
         fhv->new_sva = fhv->sv_size + fhv->sv_size;
         goto more;
      }
      /* build the matrix F in row-like format */
      if (build_fr(fhv))
      {  /* overflow of the sparse vector area */
         fhv->new_sva = fhv->sv_size + fhv->sv_size;
         goto more;
      }
      /* the factorization has been successfully computed */
      fhv->valid = 1;
      fhv->rank = m;
      /* if there are few free locations in the sparse vector area, try
         to increase its size in the future */
      t = 4 * (m + fhv->nnz_v) + 2 * fhv->nnz_f;
      if (fhv->sv_size < t)
      {  fhv->new_sva = fhv->sv_size;
         while (fhv->new_sva < t) fhv->new_sva += fhv->new_sva;
      }
done: /* return to the simplex method routine */
      return ret;
}

/*----------------------------------------------------------------------
-- fhv_ftran - perform FTRAN using FHV-factorization.
--
-- *Synopsis*
--
-- #include "glpfhv.h"
-- void fhv_ftran(FHV *fhv, double z[], int save);
--
-- *Description*
--
-- The routine fhv_ftran performs forward transformation (FTRAN) of the
-- given vector using FHV-factorization of the basis matrix.
--
-- In order to perform FTRAN the routine solves the system B*z' = z,
-- where B is the basis matrix, z' is vector of unknowns (transformed
-- vector that should be computed), z is vector of right-hand sides
-- (input vector that should be transformed).
--
-- On entry the array z should contain components of the vector z in
-- locations z[1], z[2], ..., z[m], where m is the order of the basis
-- matrix. On exit this array will contain components of the vector z'
-- in the same locations.
--
-- The parameter save is a flag. If this flag is set, it means that the
-- input vector z is a column of the non-basic variable, which has been
-- chosen to enter the basis. In this case the routine fhv_ftran saves
-- this column (after partial transformation) in order that the routine
-- fhv_update could update (recompute) the factorization for an adjacent
-- basis using this partially transformed column. The simplex method
-- routine should call the routine fhv_ftran with the save flag set at
-- least once before a subsequent call to the routine fhv_update. */

void fhv_ftran(FHV *fhv, double z[], int save)
{     /* B = F*H*V, therefore inv(B) = inv(V)*inv(H)*inv(F) */
      int m = fhv->m;
      int *fc_ndx = fhv->fc_ndx;
      int *fc_ptr = fhv->fc_ptr;
      int *fc_cnt = fhv->fc_cnt;
      int *hr_ndx = fhv->hr_ndx;
      int *hr_ptr = fhv->hr_ptr;
      int *hr_cnt = fhv->hr_cnt;
      int *vc_ptr = fhv->vc_ptr;
      int *vc_cnt = fhv->vc_cnt;
      double *vr_piv = fhv->vr_piv;
      int *pp_row = fhv->pp_row;
      int *qq_col = fhv->qq_col;
      int *sv_ndx = fhv->sv_ndx;
      double *sv_val = fhv->sv_val;
      int *cc_ndx = fhv->cc_ndx;
      double *cc_val = fhv->cc_val;
      double *rhs = fhv->work;
      double eps_tol = fhv->eps_tol;
      int i, j, k, p, q, beg, end, ptr, cnt, nfs;
      double temp;
      if (!fhv->valid)
         fault("fhv_ftran: factorization is currently invalid");
      /* compute z := inv(F)*z using F in column-like format */
      nfs = fhv->fc_nfs;
      for (k = 1; k <= nfs; k++)
      {  /* get number of non-trivial column of the factor FC[k] */
         j = fc_ndx[k];
         /* compute z := inv(FC[k])*z */
         temp = z[j];
         if (temp == 0.0) continue;
         beg = fc_ptr[k];
         end = beg + fc_cnt[k] - 1;
         for (ptr = beg; ptr <= end; ptr++)
            z[sv_ndx[ptr]] -= sv_val[ptr] * temp;
      }
      /* compute z := inv(H)*z */
      nfs = fhv->hr_nfs;
      for (k = 1; k <= nfs; k++)
      {  /* get number of non-trivial row of the factor HR[k] */
         i = hr_ndx[k];
         /* compute z := inv(HR[k])*z */
         beg = hr_ptr[k];
         end = beg + hr_cnt[k] - 1;
         for (ptr = beg; ptr <= end; ptr++)
            z[i] -= sv_val[ptr] * z[sv_ndx[ptr]];
      }
      /* save partially transformed column (if required) */
      if (save)
      {  cnt = 0;
         for (i = 1; i <= m; i++)
         {  temp = z[i];
            if (fabs(temp) < eps_tol) continue;
            cnt++;
            cc_ndx[cnt] = i;
            cc_val[cnt] = temp;
         }
         fhv->cc_cnt = cnt;
      }
      /* compute z := inv(V)*z using V in column-wise format, where
         U = P*V*Q is upper triangular */
      for (i = 1; i <= m; i++) rhs[i] = z[i];
      for (i = 1; i <= m; i++) z[i] = 0.0;
      for (k = m; k >= 1; k--)
      {  /* v[p,q] = u[k,k] */
         p = pp_row[k], q = qq_col[k];
         /* compute the next component z[q] = rhs[p] / v[p,q] */
         temp = rhs[p];
         if (temp == 0.0) continue;
         z[q] = (temp /= vr_piv[p]);
         /* substitute z[q] into other equations */
         beg = vc_ptr[q];
         end = beg + vc_cnt[q] - 1;
         for (ptr = beg; ptr <= end; ptr++)
            rhs[sv_ndx[ptr]] -= sv_val[ptr] * temp;
      }
      /* return to the simplex method routine */
      return;
}

/*----------------------------------------------------------------------
-- fhv_btran - perform BTRAN using FHV-factorization.
--
-- *Synopsis*
--
-- #include "glpfhv.h"
-- void fhv_btran(FHV *fhv, double z[]);
--
-- *Description*
--
-- The routine fhv_btran performs backward transformation (BTRAN) of the
-- given vector using FHV-factorization of the basis matrix.
--
-- In order to perform BTRAN the routine solves the system BT*z' = z,
-- where BT is a matrix transposed to the basis matrix B, z' is vector
-- of unknowns (transformed vector that should be computed), z is vector
-- of right-hand sides (input vector that should be transformed).
--
-- On entry the array z should contain components of the vector z in
-- locations z[1], z[2], ..., z[m], where m is the order of the basis
-- matrix. On exit this array will contain components of the vector z'
-- in the same locations. */

void fhv_btran(FHV *fhv, double z[])
{     /* B = F*H*V, therefore inv(BT) = inv(FT)*inv(HT)*inv(VT) */
      int m = fhv->m;
      int *fr_ndx = fhv->fr_ndx;
      int *fr_ptr = fhv->fr_ptr;
      int *fr_cnt = fhv->fr_cnt;
      int *hr_ndx = fhv->hr_ndx;
      int *hr_ptr = fhv->hr_ptr;
      int *hr_cnt = fhv->hr_cnt;
      int *vr_ptr = fhv->vr_ptr;
      int *vr_cnt = fhv->vr_cnt;
      double *vr_piv = fhv->vr_piv;
      int *pp_row = fhv->pp_row;
      int *qq_col = fhv->qq_col;
      int *sv_ndx = fhv->sv_ndx;
      double *sv_val = fhv->sv_val;
      double *rhs = fhv->work;
      int i, k, p, q, beg, end, ptr, nfs;
      double temp;
      if (!fhv->valid)
         fault("fhv_btran: factorization is currently invalid");
      /* compute z := inv(VT)*z using V in row-wise format, where
         U = P*V*Q is upper triangular */
      for (i = 1; i <= m; i++) rhs[i] = z[i];
      for (i = 1; i <= m; i++) z[i] = 0.0;
      for (k = 1; k <= m; k++)
      {  /* v[p,q] = u[k,k] */
         p = pp_row[k], q = qq_col[k];
         /* compute the next component z[p] = rhs[q] / v[p,q] */
         temp = rhs[q];
         if (temp == 0.0) continue;
         z[p] = (temp /= vr_piv[p]);
         /* substitute z[p] into other equations */
         beg = vr_ptr[p];
         end = beg + vr_cnt[p] - 1;
         for (ptr = beg; ptr <= end; ptr++)
            rhs[sv_ndx[ptr]] -= sv_val[ptr] * temp;
      }
      /* compute z := inv(HT)*z */
      nfs = fhv->hr_nfs;
      for (k = nfs; k >= 1; k--)
      {  /* get number of non-trivial row of the factor HR[k] */
         i = hr_ndx[k];
         /* compute z := inv(HRT[k])*z */
         temp = z[i];
         if (temp == 0.0) continue;
         beg = hr_ptr[k];
         end = beg + hr_cnt[k] - 1;
         for (ptr = beg; ptr <= end; ptr++)
            z[sv_ndx[ptr]] -= sv_val[ptr] * temp;
      }
      /* compute z := inv(FT)*z using F in row-like format */
      nfs = fhv->fr_nfs;
      for (k = nfs; k >= 1; k--)
      {  /* get number of non-trivial row of the factor FR[k] */
         i = fr_ndx[k];
         /* compute z := inv(FRT[k])*z */
         temp = z[i];
         if (temp == 0.0) continue;
         beg = fr_ptr[k];
         end = beg + fr_cnt[k] - 1;
         for (ptr = beg; ptr <= end; ptr++)
            z[sv_ndx[ptr]] -= sv_val[ptr] * temp;
      }
      /* return to the simplex method routine */
      return;
}

/*----------------------------------------------------------------------
-- fhv_update - update FHV-factorization for adjacent basis matrix.
--
-- *Synopsis*
--
-- #include "glpfhv.h"
-- int fhv_update(FHV *fhv, int j);
--
-- *Description*
--
-- The routine fhv_update recomputes FHV-factorization, which on entry
-- corresponds to the current basis matrix B, in order that the new
-- factorization would correspond to the adjacent basis matrix B' that
-- differs from B in the j-th column.
--
-- The new j-th column of the basis matrix is passed implicitly to the
-- routine fhv_update. It is assumed that this column was saved before
-- by the routine fhv_ftran (see above).
--
-- *Returns*
--
-- The routine fhv_update returns one of the following codes:
--
-- 0 - no errors;
-- 1 - the adjacent basis matrix is structurally singular, since after
--     changing the j-th column of the matrix V by the new column (see
--     the algorithm below) the case k1 > k2 occured;
-- 2 - the factorization is inaccurate, since after transforming the
--     k2-th row of the matrix U = P*V*Q, the diagonal element u[k2,k2]
--     is zero or close to zero;
-- 3 - maximal number of updates is reached;
-- 4 - overflow of the sparse vector area.
--
-- In case of non-zero return code the factorization becomes invalid.
-- It should not be used until it has been recomputed using the routine
-- fhv_decomp.
--
-- *Algorithm*
--
-- The routine fhv_update is based on the transformation proposed by
-- Forrest and Tomlin.
--
-- Let the j-th column of the basis matrix B have been replaced by new
-- column B[j]. In order to keep the equality B = F*H*V the j-th column
-- of the matrix V should be replaced by the column inv(F*H)*B[j]. The
-- latter is partially transformed column, which the routine fhv_ftran
-- saves on performing forward transformation of B[j].
--
-- From the point of view of the matrix U = P*V*Q, replacement of the
-- j-th column of the matrix V involves replacement of the k1-th column
-- of the matrix U, where k1 is determined by the permutation matrix Q.
-- Thus, the matrix U loses its upper triangular form and becomes the
-- following:
--
--        1   k1       k2   m
--    1   x x * x x x x x x x
--        . x * x x x x x x x
--    k1  . . * x x x x x x x
--        . . * x x x x x x x
--        . . * . x x x x x x
--        . . * . . x x x x x
--        . . * . . . x x x x
--    k2  . . * . . . . x x x
--        . . . . . . . . x x
--    m   . . . . . . . . . x
--
-- where row index k2 corresponds to the lowest non-zero element of the
-- k1-th column.
--
-- Then the routine shifts rows and columns k1+1, k1+2, ..., k2 of the
-- matrix U by one position to the left and upwards and moves k1-th row
-- and k1-th column to the position k2. As the result of such symmetric
-- permutations the matrix U becomes the following:
--
--        1   k1       k2   m
--    1   x x x x x x x * x x
--        . x x x x x x * x x
--    k1  . . x x x x x * x x
--        . . . x x x x * x x
--        . . . . x x x * x x
--        . . . . . x x * x x
--        . . . . . . x * x x
--    k2  . . x x x x x * x x
--        . . . . . . . . x x
--    m   . . . . . . . . . x
--
-- Now the routine performs gaussian elimination in order to eliminate
-- the elements u[k2,k1], u[k2,k1+1], ..., u[k2,k2-1] using the diagonal
-- elements u[k1,k1], u[k1+1,k1+1], ..., u[k2-1,k2-1] as pivots in the
-- same way as described in comments to the routine fhv_decomp. Should
-- note that actually all operations are performed on the matrix V, not
-- on the matrix U. During the elimination process the routine permutes
-- neither rows nor columns, therefore only the k2-th row of the matrix
-- U is changed.
--
-- In order to keep the equality B = F*H*V, each time when the routine
-- applies elementary gaussian transformation to the transformed row of
-- the matrix V (that corresponds to the k2-th row of the matrix U), it
-- also adds a new element (gaussian multiplier) to the current row-like
-- factor of the matrix H, which (factor) corresponds to the transformed
-- row. */

int fhv_update(FHV *fhv, int j)
{     int m = fhv->m;
      int *hr_ndx = fhv->hr_ndx;
      int *hr_ptr = fhv->hr_ptr;
      int *hr_cnt = fhv->hr_cnt;
      int *vr_ptr = fhv->vr_ptr;
      int *vr_cnt = fhv->vr_cnt;
      int *vr_cap = fhv->vr_cap;
      double *vr_piv = fhv->vr_piv;
      int *vc_ptr = fhv->vc_ptr;
      int *vc_cnt = fhv->vc_cnt;
      int *vc_cap = fhv->vc_cap;
      int *pp_row = fhv->pp_row;
      int *pp_col = fhv->pp_col;
      int *qq_row = fhv->qq_row;
      int *qq_col = fhv->qq_col;
      int *sv_ndx = fhv->sv_ndx;
      double *sv_val = fhv->sv_val;
      int cc_cnt = fhv->cc_cnt;
      int *cc_ndx = fhv->cc_ndx;
      double *cc_val = fhv->cc_val;
      double *work = fhv->work;
      double eps_tol = fhv->eps_tol;
      double upd_tol = fhv->upd_tol;
      int ret = 0;
      int i, i_beg, i_end, i_ptr, j_beg, j_end, j_ptr, k, k1, k2, p, q,
         p_beg, p_end, p_ptr, ptr;
      double f, temp;
      if (!fhv->valid)
         fault("fhv_update: factorization is currently invalid");
      if (cc_cnt < 0)
         fault("fhv_update: column is undefined");
      if (!(1 <= j && j <= m))
         fault("fhv_update: invalid column number");
      /* check if new factor of the matrix H can be added */
      if (fhv->hr_nfs == fhv->hr_size)
      {  /* maximal number of updates has been reached */
         fhv->valid = 0;
         ret = 3;
         goto done;
      }
      /* remove elements of the j-th column from the matrix V */
      j_beg = vc_ptr[j];
      j_end = j_beg + vc_cnt[j] - 1;
      for (j_ptr = j_beg; j_ptr <= j_end; j_ptr++)
      {  /* get row index of v[i,j] */
         i = sv_ndx[j_ptr];
         /* find v[i,j] in the i-th row */
         i_beg = vr_ptr[i];
         i_end = i_beg + vr_cnt[i] - 1;
         for (i_ptr = i_beg; sv_ndx[i_ptr] != j; i_ptr++) /* nop */;
         insist(i_ptr <= i_end);
         /* remove v[i,j] from the i-th row */
         sv_ndx[i_ptr] = sv_ndx[i_end];
         sv_val[i_ptr] = sv_val[i_end];
         vr_cnt[i]--;
      }
      /* now the j-th column of the matrix V is empty */
      fhv->nnz_v -= vc_cnt[j];
      vc_cnt[j] = 0;
      /* add elements of the new j-th column to the matrix V; determine
         indices k1 and k2 */
      k1 = qq_row[j];
      k2 = 0;
      for (ptr = 1; ptr <= cc_cnt; ptr++)
      {  /* get row index of v[i,j] */
         i = cc_ndx[ptr];
         /* at least one unused location is needed in the i-th row */
         if (vr_cnt[i] + 1 > vr_cap[i])
         {  if (enlarge_row(fhv, i, vr_cnt[i] + 10))
            {  /* overflow of the sparse vector area */
               fhv->valid = 0;
               fhv->new_sva = fhv->sv_size + fhv->sv_size;
               ret = 4;
               goto done;
            }
         }
         /* add v[i,j] to the i-th row */
         i_ptr = vr_ptr[i] + vr_cnt[i];
         sv_ndx[i_ptr] = j;
         sv_val[i_ptr] = cc_val[ptr];
         vr_cnt[i]++;
         /* adjust the index k2 */
         if (k2 < pp_col[i]) k2 = pp_col[i];
      }
      /* capacity of the j-th column (which is currently empty) should
         be not less than cc_cnt locations */
      if (vc_cap[j] < cc_cnt)
      {  if (enlarge_col(fhv, j, cc_cnt))
         {  /* overflow of the sparse vector area */
            fhv->valid = 0;
            fhv->new_sva = fhv->sv_size + fhv->sv_size;
            ret = 4;
            goto done;
         }
      }
      /* add elements of the new j-th column to the column list */
      j_ptr = vc_ptr[j];
      memmove(&sv_ndx[j_ptr], &cc_ndx[1], cc_cnt * sizeof(int));
      memmove(&sv_val[j_ptr], &cc_val[1], cc_cnt * sizeof(double));
      vc_cnt[j] = cc_cnt;
      fhv->nnz_v += cc_cnt;
      /* k1 > k2 means that the diagonal element u[k2,k2] is zero and
         therefore the adjacent basis matrix is structurally singular */
      if (k1 > k2)
      {  fhv->valid = 0;
         ret = 1;
         goto done;
      }
      /* perform implicit symmetric permutations of rows and columns of
         the matrix U */
      i = pp_row[k1], j = qq_col[k1];
      for (k = k1; k < k2; k++)
      {  pp_row[k] = pp_row[k+1], pp_col[pp_row[k]] = k;
         qq_col[k] = qq_col[k+1], qq_row[qq_col[k]] = k;
      }
      pp_row[k2] = i, pp_col[i] = k2;
      qq_col[k2] = j, qq_row[j] = k2;
      /* note that now the i-th row of the matrix V is the k2-th row of
         the matrix U; since no pivoting is used, only this row will be
         transformed */
      /* copy elements of the i-th row of the matrix V to the working
         array and remove these elements from the matrix V */
      for (j = 1; j <= m; j++) work[j] = 0.0;
      i_beg = vr_ptr[i];
      i_end = i_beg + vr_cnt[i] - 1;
      for (i_ptr = i_beg; i_ptr <= i_end; i_ptr++)
      {  /* get column index of v[i,j] */
         j = sv_ndx[i_ptr];
         /* store v[i,j] to the working array */
         work[j] = sv_val[i_ptr];
         /* find v[i,j] in the j-th column */
         j_beg = vc_ptr[j];
         j_end = j_beg + vc_cnt[j] - 1;
         for (j_ptr = j_beg; sv_ndx[j_ptr] != i; j_ptr++) /* nop */;
         insist(j_ptr <= j_end);
         /* remove v[i,j] from the j-th column */
         sv_ndx[j_ptr] = sv_ndx[j_end];
         sv_val[j_ptr] = sv_val[j_end];
         vc_cnt[j]--;
      }
      /* now the i-th row of the matrix V is empty */
      fhv->nnz_v -= vr_cnt[i];
      vr_cnt[i] = 0;
      /* create the next row-like factor of the matrix H; this factor
         corresponds to the i-th (transformed) row */
      fhv->hr_nfs++;
      hr_ndx[fhv->hr_nfs] = i;
      /* hr_ptr[] will be set later */
      hr_cnt[fhv->hr_nfs] = 0;
      /* up to (k2 - k1) free locations are needed to add new elements
         to the non-trivial row of the row-like factor */
      if (fhv->sv_end - fhv->sv_beg < k2 - k1)
      {  defragment(fhv);
         if (fhv->sv_end - fhv->sv_beg < k2 - k1)
         {  /* overflow of the sparse vector area */
            fhv->valid = 0;
            fhv->new_sva = fhv->sv_size + fhv->sv_size;
            ret = 4;
            goto done;
         }
      }
      /* eliminate subdiagonal elements of the matrix U */
      for (k = k1; k < k2; k++)
      {  /* v[p,q] = u[k,k] */
         p = pp_row[k], q = qq_col[k];
         /* this is the cruical point, where even tiny non-zeros should
            not be dropped */
         if (work[q] == 0.0) continue;
         /* compute gaussian multiplier f = v[i,q] / v[p,q] */
         f = work[q] / vr_piv[p];
         /* perform gaussian transformation:
            (i-th row) := (i-th row) - f * (p-th row)
            in order to eliminate v[i,q] = u[k2,k] */
         p_beg = vr_ptr[p];
         p_end = p_beg + vr_cnt[p] - 1;
         for (p_ptr = p_beg; p_ptr <= p_end; p_ptr++)
            work[sv_ndx[p_ptr]] -= f * sv_val[p_ptr];
         /* store new element (gaussian multiplier that corresponds to
            the p-th row) in the current row-like factor */
         fhv->sv_end--;
         sv_ndx[fhv->sv_end] = p;
         sv_val[fhv->sv_end] = f;
         hr_cnt[fhv->hr_nfs]++;
      }
      /* set pointer to the current row-like factor of the matrix H
         (if no elements were added to this factor, it is unity matrix
         and therefore can be discarded) */
      if (hr_cnt[fhv->hr_nfs] == 0)
         fhv->hr_nfs--;
      else
      {  hr_ptr[fhv->hr_nfs] = fhv->sv_end;
         fhv->nnz_h += hr_cnt[fhv->hr_nfs];
      }
      /* store new pivot that corresponds to u[k2,k2] */
      vr_piv[i] = work[qq_col[k2]];
      /* check if u[k2,k2] is closer to zero */
      if (fabs(vr_piv[i]) < upd_tol)
      {  /* the factorization should be considered as inaccurate (this
            mainly happens due to excessive round-off errors) */
         fhv->valid = 0;
         ret = 2;
         goto done;
      }
      /* new elements of the i-th row of the matrix V (which correspond
         to non-diagonal elements u[k2,k2+1], ..., u[k2,m] of the matrix
         U = P*V*Q) are contained in the working array; add them to the
         matrix V */
      cc_cnt = 0;
      for (k = k2+1; k <= m; k++)
      {  /* get column index and value of v[i,j] = u[k2,k] */
         j = qq_col[k];
         temp = work[j];
         /* if v[i,j] is close to zero, skip it */
         if (fabs(temp) < eps_tol) continue;
         /* at least one unused location is needed in the j-th column */
         if (vc_cnt[j] + 1 > vc_cap[j])
         {  if (enlarge_col(fhv, j, vc_cnt[j] + 10))
            {  /* overflow of the sparse vector area */
               fhv->valid = 0;
               fhv->new_sva = fhv->sv_size + fhv->sv_size;
               ret = 4;
               goto done;
            }
         }
         /* add v[i,j] to the j-th column */
         j_ptr = vc_ptr[j] + vc_cnt[j];
         sv_ndx[j_ptr] = i;
         sv_val[j_ptr] = temp;
         vc_cnt[j]++;
         /* also store v[i,j] to the auxiliary array */
         cc_cnt++;
         cc_ndx[cc_cnt] = j;
         cc_val[cc_cnt] = temp;
      }
      /* capacity of the i-th row (which is currently empty) should be
         not less than cc_cnt locations */
      if (vr_cap[i] < cc_cnt)
      {  if (enlarge_row(fhv, i, cc_cnt))
         {  /* overflow of the sparse vector area */
            fhv->valid = 0;
            fhv->new_sva = fhv->sv_size + fhv->sv_size;
            ret = 4;
            goto done;
         }
      }
      /* add new elements of the i-th row to the row list */
      i_ptr = vr_ptr[i];
      memmove(&sv_ndx[i_ptr], &cc_ndx[1], cc_cnt * sizeof(int));
      memmove(&sv_val[i_ptr], &cc_val[1], cc_cnt * sizeof(double));
      vr_cnt[i] = cc_cnt;
      fhv->nnz_v += cc_cnt;
      /* the factorization has been successfully updated */
      fhv->cc_cnt = -1;
done: /* return to the simplex method routine */
      return ret;
}

/*----------------------------------------------------------------------
-- fhv_delete - delete FHV factorization.
--
-- *Synopsis*
--
-- #include "glpfhv.h"
-- void fhv_delete(FHV *fhv);
--
-- *Description*
--
-- The routine fhv_delete deletes FHV-factorization specified by the
-- parameter fhv, freeing all the memory allocated to this object. */

void fhv_delete(FHV *fhv)
{     ufree(fhv->fr_ndx);
      ufree(fhv->fr_ptr);
      ufree(fhv->fr_cnt);
      ufree(fhv->fc_ndx);
      ufree(fhv->fc_ptr);
      ufree(fhv->fc_cnt);
      ufree(fhv->hr_ndx);
      ufree(fhv->hr_ptr);
      ufree(fhv->hr_cnt);
      ufree(fhv->vr_ptr);
      ufree(fhv->vr_cnt);
      ufree(fhv->vr_cap);
      ufree(fhv->vr_piv);
      ufree(fhv->vc_ptr);
      ufree(fhv->vc_cnt);
      ufree(fhv->vc_cap);
      ufree(fhv->pp_row);
      ufree(fhv->pp_col);
      ufree(fhv->qq_row);
      ufree(fhv->qq_col);
      ufree(fhv->sv_ndx);
      ufree(fhv->sv_val);
      ufree(fhv->sv_prev);
      ufree(fhv->sv_next);
      ufree(fhv->rs_head);
      ufree(fhv->rs_prev);
      ufree(fhv->rs_next);
      ufree(fhv->rs_max);
      ufree(fhv->cs_head);
      ufree(fhv->cs_prev);
      ufree(fhv->cs_next);
      ufree(fhv->cc_ndx);
      ufree(fhv->cc_val);
      ufree(fhv->flag);
      ufree(fhv->work);
      ufree(fhv);
      return;
}

/* eof */
