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) ; }