dyret_enum dy_pivot (int xipos, double abarij, double maxabarj)
/*
This routine handles a single pivot. It first checks that the pivot element
satisfies a stability test, then calls inv_update to pivot the basis. We
can still run into trouble, however, if the pivot results in a singular or
near-singular basis.
NOTE: There is an implicit argument here that's not immediately obvious.
inv_update gets the entering column from a cached result set with the
most recent call to inv_ftran(*,1) (dy_ftran(*,true), if you prefer).
The underlying assumption is that this is readily available from when
we ftran'd the entering column to find the leaving variable.
Parameters:
xipos: the basis position of the entering variable
abarij: the pivot element (only the absolute value is used)
maxabarj: for a primal pivot, max{i} |abar<i,j>|,
for a dual pivot, max{j} |abar<i,j>|
Returns:
dyrOK: the pivot was accomplished without incident (inv_update)
dyrMADPIV: the pivot element abar<i,j> was rejected as numerically
unstable (dy_chkpiv)
dyrSINGULAR: the pivot attempt resulted in a structurally singular basis
(i.e., some diagonal element is zero) (inv_update)
dyrNUMERIC: the pivot attempt resulted in a numerically singular (unstable)
basis (i.e, some diagonal element is too small compared to
other elements in the associated row and column) (inv_update)
dyrBSPACE: glpinv/glpluf ran out of space for the basis representation
(inv_update)
dyrFATAL: internal confusion
*/
{ int retval ;
double ratio ;
dyret_enum retcode ;
const char *rtnnme = "dy_pivot" ;
/*
Check that the pivot element meets the current criterion for numerical
stability. Arguably this should have been checked by the caller, but that's
no excuse for not doing it now.
*/
ratio = dy_chkpiv(abarij,maxabarj) ;
if (ratio < 1.0)
{
# ifndef DYLP_NDEBUG
if (dy_opts->print.basis >= 3)
{ dyio_outfmt(dy_logchn,dy_gtxecho,
"\n %s(%d) pivot aborted; est. pivot stability %g.",
dy_prtlpphase(dy_lp->phase,TRUE),
dy_lp->tot.iters,rtnnme,ratio) ; }
# endif
return (dyrMADPIV) ; }
/*
Make the call to inv_update, then recode the result.
*/
retval = inv_update(luf_basis,xipos) ;
# ifndef DYLP_NDEBUG
if ((retval == 0 && dy_opts->print.basis >= 5) ||
(retval > 0 && dy_opts->print.basis >= 3))
{ dyio_outfmt(dy_logchn,dy_gtxecho,
"\n %s(%d) estimated pivot stability %g; ",
dy_prtlpphase(dy_lp->phase,TRUE),dy_lp->tot.iters,ratio) ;
dyio_outfmt(dy_logchn,dy_gtxecho,"measured pivot stability %g.",
luf_basis->min_vrratio) ; }
# endif
switch (retval)
{ case 0:
{ retcode = dyrOK ;
break ; }
case 1:
{ retcode = dyrSINGULAR ;
# ifndef DYLP_NDEBUG
if (dy_opts->print.basis >= 2)
{ dyio_outfmt(dy_logchn,dy_gtxecho,
"\n %s(%d) singular basis (structural) after pivot.",
dy_prtlpphase(dy_lp->phase,TRUE),dy_lp->tot.iters) ; }
# endif
break ; }
case 2:
{ retcode = dyrNUMERIC ;
# ifndef DYLP_NDEBUG
if (dy_opts->print.basis >= 2)
{ dyio_outfmt(dy_logchn,dy_gtxecho,
"\n %s(%d) singular basis (numeric) after pivot.",
dy_prtlpphase(dy_lp->phase,TRUE),dy_lp->tot.iters) ; }
# endif
break ; }
case 3:
case 4:
{ retcode = dyrBSPACE ;
# ifndef DYLP_NDEBUG
if (dy_opts->print.basis >= 2)
{ dyio_outfmt(dy_logchn,dy_gtxecho,"\n %s(%d) out of space (%s)",
dy_prtlpphase(dy_lp->phase,TRUE),dy_lp->tot.iters,
(retval == 3)?"eta matrix limit":"sparse vector area") ; }
# endif
break ; }
default:
{ errmsg(1,rtnnme,__LINE__) ;
retcode = dyrFATAL ;
break ; } }
return (retcode) ; }
dyret_enum dy_addtopivrej (int j, dyret_enum why,
double abarij, double maxabarij)
/*
This routine adds x<j> to the rejected pivot list by adding an entry to
pivrejlst and adding the NOPIVOT qualifier to x<j>'s status.
If necessary, it expands the size of the list.
Parameter:
j: the variable x<j>
why: the reason it's going on the pivot reject list; one of
dyrSINGULAR or dyrMADPIV
abarij: (why == dyrMADPIV) the pivot element
maxabarij: (why == dyrMADPIV) the maximum pivot element in the pivot
column (primal) or row (dual).
Returns: dyrOK if the entry is added without error, dyrFATAL if we can't
get more space, or if a paranoid check fails.
*/
{ int n,ndx,newsze ;
double ratio ;
const char *rtnnme = "dy_addtopivrej" ;
# ifndef DYLP_NDEBUG
int saveprint ;
saveprint = dy_opts->print.pivoting ;
dy_opts->print.pivoting = 0 ;
# endif
/*
We don't actually need the pivot ratio until further down, but it's handy
to do it here where we can easily suppress the internal print, then restore
the print level.
*/
ratio = dy_chkpiv(abarij,maxabarij) ;
n = dy_sys->varcnt ;
# ifndef DYLP_NDEBUG
dy_opts->print.pivoting = saveprint ;
# endif
# ifdef DYLP_PARANOIA
if (j < 1 || j > n)
{ errmsg(102,rtnnme,dy_sys->nme,"variable",j,1,n) ;
return (dyrFATAL) ; }
if (!(why == dyrSINGULAR || why == dyrMADPIV))
{ errmsg(1,rtnnme,__LINE__) ;
return (dyrFATAL) ; }
# endif
# ifndef DYLP_NDEBUG
/*
The default case in this switch is needed to suppress GCC warnings --- it
doesn't grok the paranoid check.
*/
if (dy_opts->print.pivreject >= 2)
{ dyio_outfmt(dy_logchn,dy_gtxecho,
"\n marking %s (%d) ineligible for pivoting ",
consys_nme(dy_sys,'v',j,TRUE,NULL),j) ;
switch (why)
{ case dyrSINGULAR:
{ dyio_outfmt(dy_logchn,dy_gtxecho,"(%s).",dy_prtdyret(why)) ;
break ; }
case dyrMADPIV:
{ dyio_outfmt(dy_logchn,dy_gtxecho,"(%s = %g).",dy_prtdyret(why),ratio) ;
break ; }
default:
{ errmsg(1,rtnnme,__LINE__) ;
return (dyrFATAL) ; } } }
# endif
/*
Flag the culprit --- the extent of externally visible activity. Then make
the entry in the pivot reject list. Check for adequate list length and
expand if necessary.
*/
setflg(dy_status[j],vstatNOPIVOT) ;
ndx = pivrej_ctl.cnt++ ;
if (ndx >= pivrej_ctl.sze)
{ newsze = minn(2*pivrej_ctl.sze,n+1) ;
# ifndef DYLP_NDEBUG
if (dy_opts->print.pivreject >= 3)
{ dyio_outfmt(dy_logchn,dy_gtxecho,
"\n%s: expanding pivot reject list from %d to %d entries.",
rtnnme,pivrej_ctl.sze,newsze) ; }
# endif
pivrejlst =
(pivrej_struct *) REALLOC(pivrejlst,newsze*sizeof(pivrej_struct)) ;
if (pivrejlst == NULL)
{ errmsg(337,rtnnme,dy_sys->nme,pivrej_ctl.sze,newsze) ;
return (dyrFATAL) ; }
pivrej_ctl.sze = newsze ; }
pivrejlst[ndx].ndx = j ;
pivrejlst[ndx].iter = dy_lp->basis.pivs ;
pivrejlst[ndx].why = why ;
switch (why)
{ case dyrSINGULAR:
{ pivrej_ctl.sing++ ;
break ; }
case dyrMADPIV:
{ pivrej_ctl.mad++ ;
ratio = dy_chkpiv(abarij,maxabarij) ;
pivrejlst[ndx].ratio = ratio*dy_tols->pivot ;
break ; }
default:
{ errmsg(1,rtnnme,__LINE__) ;
return (dyrFATAL) ; } }
# ifdef DYLP_STATISTICS
if (dy_stats != NULL)
{ switch (why)
{ case dyrSINGULAR:
{ dy_stats->pivrej.sing++ ;
break ; }
case dyrMADPIV:
{ dy_stats->pivrej.mad++ ;
break ; }
default:
{ errmsg(1,rtnnme,__LINE__) ;
return (dyrFATAL) ; } }
if (pivrej_ctl.cnt > dy_stats->pivrej.max)
{ dy_stats->pivrej.max = pivrej_ctl.cnt ; } }
# endif
return (dyrOK) ; }
