int is_vpf_null_float( float num )
{
float nan;
nan = (float)quiet_nan(0);
if (memcmp(&nan,&num,sizeof(float))==0) return 1;
return 0;
}
int is_vpf_null_double( double num )
{
double nan;
nan = (double)quiet_nan(0);
if (memcmp(&nan,&num,sizeof(double))==0) return 1;
return 0;
}
int dytest_colPrimals (lpprob_struct *main_lp, lptols_struct *main_lptols,
lpopts_struct *main_lpopts)
/*
This routine checks the values of the primal architectural variables
returned by dy_colPrimals.
For basic variables x<B>, the routine checks
x<B> = inv(B)b - inv(B)Nx<N>
To do this, the routine accumulates the values of the basic variables
during the column scan. When the current column is basic in pos'n i, the
routine calculates dot(beta<i>,b) and adds it to the total. When the current
column is nonbasic, the routine calculates abar<j>x<j> and subtracts it
from the total. Just to make things really annoying, we have to account for
nonbasic bounded slacks due to range constraints tight at their lower bound
(which makes the slack nonbasic at its upper bound).
For a nonbasic variable, the routine checks the value of x<j> against the
bound specified by the status of x<j>.
Parameters:
main_lp: the lp problem structure
main_lptols: the lp tolerance structure
main_lpopts: the lp options structure
Returns: 0 if the values check out, error count otherwise.
*/
{ int i,i_bpos,j,k,m,n ;
flags statj,stati ;
double xj,lbj,ubj,betaidotb ;
consys_struct *sys ;
flags *status,*logstatus ;
double *rhs,*rhslow,*vlb,*vub,*betai,*xB,*abarj ;
contyp_enum *ctyp ;
basisel_struct *basis ;
double *x ;
int berrs,nberrs ;
bool staterr ;
char *rtnnme = "dytest_colPrimals" ;
/*
Do a little initialisation. Mention that we've started.
*/
sys = main_lp->consys ;
m = sys->concnt ;
n = sys->varcnt ;
# ifndef DYLP_NDEBUG
if (main_lpopts->print.soln >= 1)
{ dyio_outfmt(dy_logchn,dy_gtxecho,
"\n%s: checking primal architectural variables using %s (%d x %d).",
rtnnme,sys->nme,m,n) ; }
# endif
/*
Acquire the variable bound and status vectors, the constraint type, rhs,
and rhslow vectors, the basis vector, and the values of the primal
architectural variables. Allocate a vector to accumulate x<B>
*/
x = NULL ;
dy_colPrimals(main_lp,&x) ;
basis = main_lp->basis->el ;
status = main_lp->status ;
ctyp = sys->ctyp ;
rhs = sys->rhs ;
rhslow = sys->rhslow ;
vlb = sys->vlb ;
vub = sys->vub ;
xB = (double *) CALLOC((m+1),sizeof(double)) ;
/*
Now step through the columns checking the values in x. For a variable basic
in pos'n i, add dot(beta<i>,b) to the running total for the basic variable.
For a nonbasic variable, confirm that the value, bound, and status agree.
Then subtract abar<j>x<j> from x<B> if x<j> is at a nonzero bound.
The only nonbasic status code not explicitly listed is SB (superbasic). This
really should never appear. The only legitimate reason is that dylp patched
the basis in primal phase II and then discovered the problem to be unbounded
before the SB variable could be pivoted back into the basis. This is
sufficiently exotic to deserve a message.
*/
berrs = 0 ;
nberrs = 0 ;
betai = NULL ;
abarj = NULL ;
for (j = 1 ; j <= n ; j++)
{ statj = status[j] ;
xj = x[j] ;
if (((int) statj) < 0)
{ k = -((int) statj) ;
i_bpos = basis[k].cndx ;
if (dy_betai(main_lp,i_bpos,&betai) == FALSE)
{ berrs++ ;
errmsg(952,rtnnme,sys->nme,"row",i_bpos,"variable",
consys_nme(sys,'v',j,FALSE,NULL),j) ;
continue ; }
betaidotb = 0 ;
for (i = 1 ; i <= m ; i++)
{ betaidotb += betai[i]*rhs[i] ; }
xB[i_bpos] += betaidotb ; }
else
{ staterr = FALSE ;
lbj = vlb[j] ;
ubj = vub[j] ;
statj = getflg(statj,vstatSTATUS) ;
switch (statj)
{ case vstatNBLB:
{ if (fabs(xj-lbj) > main_lptols->zero)
{ staterr = TRUE ;
betaidotb = lbj ; }
break ; }
case vstatNBUB:
{ if (fabs(xj-ubj) > main_lptols->zero)
{ staterr = TRUE ;
betaidotb = ubj ; }
break ; }
case vstatNBFX:
{ if (fabs(xj-lbj) > main_lptols->zero)
{ staterr = TRUE ;
betaidotb = lbj ; }
break ; }
case vstatNBFR:
{ if (fabs(xj) > main_lptols->zero)
{ staterr = TRUE ;
betaidotb = 0.0 ; }
break ; }
default:
{ staterr = TRUE ;
betaidotb = quiet_nan(42.0L) ;
break ; } }
if (staterr == TRUE)
{ nberrs++ ;
dyio_outfmt(dy_logchn,dy_gtxecho,
"\nERROR: %s col %s (%d) = %g; expected %g;",
dy_prtvstat(statj),consys_nme(sys,'v',j,FALSE,NULL),j,
xj,betaidotb) ;
dyio_outfmt(dy_logchn,dy_gtxecho," error %g, tol %g.",
fabs(xj-betaidotb),main_lptols->zero) ;
continue ; }
if (xj == 0.0) continue ;
if (dy_abarj(main_lp,j,&abarj) == FALSE)
{ nberrs++ ;
errmsg(953,rtnnme,sys->nme,"ftran'd","column",
consys_nme(sys,'v',j,FALSE,NULL),j) ;
continue ; }
for (k = 1 ; k <= m ; k++)
{ xB[k] -= abarj[k]*xj ; } } }
/*
But wait! We're not quite done. We need to account for bounded slacks
associated with range constraints. If the constraint is tight at its lower
bound, the slack is nonbasic at its upper bound.
*/
logstatus = NULL ;
dy_logStatus(main_lp,&logstatus) ;
for (i = 1 ; i <= m ; i++)
{ stati = getflg(logstatus[i],vstatSTATUS) ;
if (ctyp[i] == contypRNG && stati == vstatNBUB)
{ xj = rhs[i]-rhslow[i] ;
if (dy_abarj(main_lp,-i,&abarj) == FALSE)
{ nberrs++ ;
errmsg(953,rtnnme,sys->nme,"ftran'd","column",
consys_nme(sys,'v',n+i,FALSE,NULL),i) ;
continue ; }
for (k = 1 ; k <= m ; k++)
{ xB[k] -= abarj[k]*xj ; } } }
/*
Scan the variables one more time and check the values of the basic variables.
*/
for (j = 1 ; j <= n ; j++)
{ statj = status[j] ;
xj = x[j] ;
if (((int) statj) < 0)
{ k = -((int) statj) ;
i_bpos = basis[k].cndx ;
if (fabs(xj-xB[i_bpos]) > main_lptols->zero)
{ berrs++ ;
dyio_outfmt(dy_logchn,dy_gtxecho,
"\nERROR: basis pos'n %d %s (%d) = %g; expected %g;",
i_bpos,consys_nme(sys,'v',j,FALSE,NULL),j,xj,xB[i_bpos]) ;
dyio_outfmt(dy_logchn,dy_gtxecho," error %g, tol %g.",
fabs(xj-xB[i_bpos]),main_lptols->zero) ; } } }
/*
Free up space and report the result.
*/
if (logstatus != NULL) FREE(logstatus) ;
if (abarj != NULL) FREE(abarj) ;
if (xB != NULL) FREE(xB) ;
if (betai != NULL) FREE(betai) ;
if (x != NULL) FREE(x) ;
if ((berrs+nberrs) != 0)
{ if (berrs != 0)
{ dyio_outfmt(dy_logchn,dy_gtxecho,
"\n%s: found %d errors testing x<B> = inv(B)b.\n",
rtnnme,berrs) ; }
if (nberrs != 0)
{ dyio_outfmt(dy_logchn,dy_gtxecho,
"\n%s: found %d errors testing x<N> against bounds & status.\n",
rtnnme,nberrs) ; } }
else
{ dyio_outfmt(dy_logchn,dy_gtxecho,
"\n%s: pass test of primal architectural variable values.\n",
rtnnme) ; }
return (berrs+nberrs) ; }
bool consys_evalsys (consys_struct *consys, double *p_scm, int *p_gecnt)
/*
This routine evaluates the constraint system given as a parameter,
determining the minimum and maximum coefficients and calculating an
initial value for the geometric mean figure of merit.
The maximum coefficient is defined as amax = max{i,j} |a<ij>|.
The minimum coefficient is defined as amin = min{i,j, a<ij> != 0} |a<ij>|.
The figure of merit is sqrt(amax/amin).
Parameters:
consys: constraint system to be evaluated
scm: (o) sqrt(amax/amin)
gecnt: (o) the number of >= inequalities in the constraint system
Returns: TRUE if the evaluation concludes without error, FALSE otherwise.
A FALSE return is possible only when we're paranoid.
*/
{ int i,gecnt ;
double amax,amin,aij ;
double *rsc,*csc ;
rowhdr_struct *rowi ;
coeff_struct *coeffij ;
# ifdef DYLP_PARANOIA
char *rtnnme = "consys_evalsys" ;
if (consys == NULL)
{ errmsg(2,rtnnme,"consys") ;
return (FALSE) ; }
if (consys->mtx.rows == NULL)
{ errmsg(2,rtnnme,"row header") ;
return (FALSE) ; }
if (consys->mtx.cols == NULL)
{ errmsg(2,rtnnme,"column header") ;
return (FALSE) ; }
if (consys->ctyp == NULL)
{ errmsg(101,rtnnme,consys->nme,"constraint type vector") ;
return (FALSE) ; }
if (p_scm == NULL)
{ errmsg(2,rtnnme,"scm") ;
return (FALSE) ; }
if (p_gecnt == NULL)
{ errmsg(2,rtnnme,"gecnt") ;
return (FALSE) ; }
# endif
*p_scm = quiet_nan(0) ;
*p_gecnt = -1 ;
rsc = consys->rowscale ;
csc = consys->colscale ;
amax = 0.0 ;
amin = consys->inf ;
gecnt = 0 ;
/*
Open a loop and scan the rows of the constraint matrix.
*/
for (i = 1 ; i <= consys->concnt ; i++)
{ rowi = consys->mtx.rows[i] ;
# ifdef DYLP_PARANOIA
if (rowi == NULL)
{ errmsg(103,rtnnme,consys->nme,"row",i) ;
return (FALSE) ; }
if (rowi->ndx != i)
{ errmsg(126,rtnnme,consys->nme,"row",rowi,rowi->ndx,i,rowi) ;
return (FALSE) ; }
if ((rowi->coeffs == NULL && rowi->len != 0) ||
(rowi->coeffs != NULL && rowi->len == 0))
{ errmsg(134,rtnnme,consys->nme,"row",rowi->nme,i,rowi->len,
(rowi->coeffs == NULL)?"null":"non-null") ;
return (FALSE) ; }
# endif
if (consys->ctyp[i] == contypGE)
{ gecnt++ ; }
for (coeffij = rowi->coeffs ; coeffij != NULL ; coeffij = coeffij->rownxt)
{
# ifdef DYLP_PARANOIA
if (coeffij->rowhdr != rowi)
{ errmsg(125,rtnnme,"rowhdr",coeffij,"row",rowi->nme,i) ;
return (FALSE) ; }
if (coeffij->colhdr == NULL)
{ errmsg(125,rtnnme,"colhdr",coeffij,"row",rowi->nme,i) ;
return (FALSE) ; }
if (coeffij->colhdr->ndx <= 0 || coeffij->colhdr->ndx > consys->varcnt)
{ errmsg(102,rtnnme,consys->nme,"column",coeffij->colhdr->ndx,1,
consys->varcnt) ;
return (FALSE) ; }
# endif
aij = coeffij->val ;
if (aij == 0.0) continue ;
aij = fabs(aij) ;
if (rsc != NULL) aij *= rsc[i] ;
if (csc != NULL) aij *= csc[coeffij->colhdr->ndx] ;
if (aij > amax) amax = aij ;
if (aij < amin) amin = aij ; } }
/*
Record the results and return. Allow for 0x0 systems; they happen for (more
or less) legitimate reasons.
*/
if (consys->concnt == 0)
{ *p_gecnt = 0 ;
*p_scm = 1.0 ;
consys->maxaij = 0 ;
consys->minaij = 0 ; }
else
{ *p_gecnt = gecnt ;
*p_scm = sqrt(amax/amin) ;
consys->maxaij = amax ;
consys->minaij = amin ; }
return (TRUE) ; }
int dytest_allDuals (lpprob_struct *main_lp, lptols_struct *main_lptols,
lpopts_struct *main_lpopts)
/*
This routine uses the dual variables returned by dy_rowDuals and
dy_colDuals and checks that yA >= (-c) (row duals only) and y'A' = (-c),
where y' is both row and column duals and A' is A, expanded as needed with
coefficients to add explicit bound constraints for nonbasic architecturals.
As with so many things involving faking dual simplex on the primal
constraint system with implicit bounds, we have to be a bit careful when
working with the duals corresponding to nonbasic primal variables. Consider
a primal variable x<j> NBUB. The reduced cost cbar<j> will be negative at
optimality in dylp's min primal world. This is not correct for the sign
convention of the true dual problem, where all duals are positive, so it's
negated when we ask for the true dual sign convention. But then only a
little thought reveals that we're considering yA + y<j> = (-c), and if y<j>
>= 0 it's clear that yA <= (-c). So we have to invert the sense of that
test when processing a column with an NBUB primal. Since the sign of the
reduced cost for an NBFX variable can go either way, no test is possible
using only the row duals.
Parameters:
main_lp: the lp problem structure
main_lptols: the lp tolerance structure
main_lpopts: the lp options structure
Returns: 0 if yA = c, error count otherwise.
*/
{ int i,j,k,m,n ;
consys_struct *sys ;
double *obj ;
double *y,*cbar ;
double ydotaj,cj,cbarj ;
flags *status ;
flags statj ;
int errcnt ;
char *rtnnme = "dytest_allDuals" ;
/*
Do a little initialisation. Mention that we've started.
*/
sys = main_lp->consys ;
m = sys->concnt ;
n = sys->varcnt ;
obj = sys->obj ;
# ifndef DYLP_NDEBUG
if (main_lpopts->print.soln >= 1)
{ dyio_outfmt(dy_logchn,dy_gtxecho,
"\n%s: checking yA = c using %s (%d x %d).",
rtnnme,sys->nme,m,n) ; }
# endif
/*
Acquire the row and column duals and column status. Go with the sign
convention that matches the true dual problem.
*/
y = NULL ;
dy_rowDuals(main_lp,&y,TRUE) ;
cbar = NULL ;
dy_colDuals(main_lp,&cbar,TRUE) ;
status = NULL ;
dy_colStatus(main_lp,&status) ;
/*
Open a loop to walk the columns. First check that yA >= (-c) for a column
with an NBLB primal variable, yA <= (-c) for a column with an NBUB primal
variable. For an NBFX variable, the dual could go either way, so we can't
check.
*/
errcnt = 0 ;
for (j = 1 ; j <= n ; j++)
{ statj = status[j] ;
cj = -obj[j] ;
ydotaj = consys_dotcol(sys,j,y) ;
if ((flgon(statj,vstatNBLB) && ydotaj-cj < -main_lptols->cost) ||
(flgon(statj,vstatNBUB) && ydotaj-cj > main_lptols->cost))
{ errcnt++ ;
dyio_outfmt(dy_logchn,dy_gtxecho,
"\n ERROR: %s (%d) y dot a<j> = %g; ",
consys_nme(sys,'v',j,FALSE,NULL),j,ydotaj) ;
dyio_outfmt(dy_logchn,dy_gtxecho,"expected %s %g; err %g, tol %g.",
(flgon(statj,vstatNBUB)?"<=":">="),
cj,ydotaj-cj,main_lptols->cost) ; }
/*
Now add any contribution due to an architectural at bound. After this we
should have equality. For an upper bound, we have x<j> <= u<j>.
For a lower bound, it's -x<j> <= -l<j>. For a fixed variable, it's an
equality x<j> = u<j>, so lump NBFX with NBUB.
*/
if (flgon(statj,vstatNONBASIC))
{ cbarj = cbar[j] ;
switch (statj)
{ case vstatNBLB:
{ ydotaj -= cbarj ;
break ; }
case vstatNBUB:
case vstatNBFX:
{ ydotaj += cbarj ;
break ; }
default:
{ errmsg(1,rtnnme,__LINE__) ;
errcnt += 10000 ;
ydotaj = quiet_nan(42.0L) ;
break ; } } }
if (fabs(ydotaj-cj) > main_lptols->cost)
{ errcnt++ ;
dyio_outfmt(dy_logchn,dy_gtxecho,
"\n ERROR: %s (%d) y dot a<j> = %g; ",
consys_nme(sys,'v',j,FALSE,NULL),j,ydotaj) ;
dyio_outfmt(dy_logchn,dy_gtxecho,"expected %g; err %g, tol %g.",
cj,fabs(ydotaj-cj),main_lptols->cost) ; } }
/*
Free up space and report the result.
*/
if (y != NULL) FREE(y) ;
if (cbar != NULL) FREE(cbar) ;
if (status != NULL) FREE(status) ;
if (errcnt != 0)
{ dyio_outfmt(dy_logchn,dy_gtxecho,
"\n%s: found %d errors testing yA = c.\n",
rtnnme,errcnt) ; }
else
{ dyio_outfmt(dy_logchn,dy_gtxecho,"\n%s: pass yA = c.\n",rtnnme) ; }
return (errcnt) ; }
double consys_infnormcol (consys_struct *consys, int colndx)
/*
This routine computes the infinity-norm of a column: MAX{i} |a<i,j>|.
Parameters:
consys: constraint system
colndx: column
Returns: value of the norm, or NaN if the calculation goes awry
*/
{ double norm ;
colhdr_struct *colhdr ;
coeff_struct *coeff ;
# if defined(DYLP_PARANOIA) || !defined(DYLP_NDEBUG)
const char *rtnnme = "consys_infnormcol" ;
# endif
# ifdef DYLP_PARANOIA
if (consys == NULL)
{ errmsg(2,rtnnme,"consys") ;
return (quiet_nan(0)) ; }
if (consys->mtx.cols == NULL)
{ errmsg(101,rtnnme,consys->nme,"column header") ;
return (quiet_nan(0)) ; }
# endif
# ifndef DYLP_NDEBUG
if (colndx <= 0 || colndx > consys->varcnt)
{ errmsg(102,rtnnme,consys->nme,"column",colndx,1,consys->varcnt) ;
return (quiet_nan(0)) ; }
# endif
colhdr = consys->mtx.cols[colndx] ;
# ifdef DYLP_PARANOIA
if (colhdr == NULL)
{ errmsg(103,rtnnme,consys->nme,"column",colndx) ;
return (quiet_nan(0)) ; }
if (colndx != colhdr->ndx)
{ errmsg(126,rtnnme,consys->nme,"column",colhdr,colhdr->ndx,colndx,colhdr) ;
return (quiet_nan(0)) ; }
# endif
norm = 0 ;
for (coeff = colhdr->coeffs ; coeff != NULL ; coeff = coeff->colnxt)
{
# ifdef DYLP_PARANOIA
if (coeff->rowhdr == NULL)
{ errmsg(125,rtnnme,consys->nme,"rowhdr",coeff,"column",
consys_nme(consys,'v',colndx,FALSE,NULL),colndx) ;
return (quiet_nan(0)) ; }
if (coeff->rowhdr->ndx <= 0 || coeff->rowhdr->ndx > consys->varcnt)
{ errmsg(102,rtnnme,consys->nme,"row",coeff->rowhdr->ndx,
1,consys->varcnt) ;
return (quiet_nan(0)) ; }
if (coeff->rowhdr != consys->mtx.rows[coeff->rowhdr->ndx])
{ errmsg(126,rtnnme,consys->nme,"row",coeff->rowhdr,coeff->rowhdr->ndx,
coeff->rowhdr->ndx,consys->mtx.rows[coeff->rowhdr->ndx]) ;
return (quiet_nan(0)) ; }
# endif
norm = maxx(fabs(coeff->val),norm) ; }
return (norm) ; }
double consys_ssqcol (consys_struct *consys, int colndx)
/*
This routine computes the sum of squares of a column: SUM{i} a<i,j>**2.
It's sometimes more useful to have this than the actual 2-norm.
Parameters:
consys: constraint system
colndx: column
Returns: value of the norm, or NaN if the calculation goes awry
*/
{ double norm ;
colhdr_struct *colhdr ;
coeff_struct *coeff ;
# if defined(DYLP_PARANOIA) || !defined(DYLP_NDEBUG)
const char *rtnnme = "consys_ssqcol" ;
# endif
# ifdef DYLP_PARANOIA
if (consys == NULL)
{ errmsg(2,rtnnme,"consys") ;
return (quiet_nan(0)) ; }
if (consys->mtx.cols == NULL)
{ errmsg(101,rtnnme,consys->nme,"column header") ;
return (quiet_nan(0)) ; }
# endif
# ifndef DYLP_NDEBUG
if (colndx <= 0 || colndx > consys->varcnt)
{ errmsg(102,rtnnme,consys->nme,"column",colndx,1,consys->varcnt) ;
return (quiet_nan(0)) ; }
# endif
colhdr = consys->mtx.cols[colndx] ;
# ifdef DYLP_PARANOIA
if (colhdr == NULL)
{ errmsg(103,rtnnme,consys->nme,"column",colndx) ;
return (quiet_nan(0)) ; }
if (colndx != colhdr->ndx)
{ errmsg(126,rtnnme,consys->nme,"column",colhdr,colhdr->ndx,colndx,colhdr) ;
return (quiet_nan(0)) ; }
# endif
norm = 0 ;
for (coeff = colhdr->coeffs ; coeff != NULL ; coeff = coeff->colnxt)
{
# ifdef DYLP_PARANOIA
if (coeff->rowhdr == NULL)
{ errmsg(125,rtnnme,consys->nme,"rowhdr",coeff,"column",
consys_nme(consys,'v',colndx,FALSE,NULL),colndx) ;
return (quiet_nan(0)) ; }
if (coeff->rowhdr->ndx <= 0 || coeff->rowhdr->ndx > consys->varcnt)
{ errmsg(102,rtnnme,consys->nme,"row",coeff->rowhdr->ndx,
1,consys->varcnt) ;
return (quiet_nan(0)) ; }
if (coeff->rowhdr != consys->mtx.rows[coeff->rowhdr->ndx])
{ errmsg(126,rtnnme,consys->nme,"row",coeff->rowhdr,coeff->rowhdr->ndx,
coeff->rowhdr->ndx,consys->mtx.rows[coeff->rowhdr->ndx]) ;
return (quiet_nan(0)) ; }
# endif
norm += coeff->val*coeff->val ; }
return (norm) ; }
double consys_infnormrow (consys_struct *consys, int rowndx)
/*
This routine computes the infinity-norm of a row: MAX{j} |a<i,j>|
Parameters:
consys: constraint system
rowndx: row
Returns: value of the norm, or NaN if the calculation goes awry
*/
{ double norm ;
rowhdr_struct *rowhdr ;
coeff_struct *coeff ;
# if defined(DYLP_PARANOIA) || !defined(DYLP_NDEBUG)
const char *rtnnme = "consys_infnormrow" ;
# endif
/*
The usual paranoia, plus an honest index check.
*/
# ifdef DYLP_PARANOIA
if (consys == NULL)
{ errmsg(2,rtnnme,"consys") ;
return (quiet_nan(0)) ; }
if (consys->mtx.rows == NULL)
{ errmsg(101,rtnnme,consys->nme,"row header") ;
return (quiet_nan(0)) ; }
# endif
# ifndef DYLP_NDEBUG
if (rowndx <= 0 || rowndx > consys->concnt)
{ errmsg(102,rtnnme,consys->nme,"row",rowndx,1,consys->concnt) ;
return (quiet_nan(0)) ; }
# endif
rowhdr = consys->mtx.rows[rowndx] ;
# ifdef DYLP_PARANOIA
if (rowhdr == NULL)
{ errmsg(103,rtnnme,consys->nme,"row",rowndx) ;
return (quiet_nan(0)) ; }
if (rowndx != rowhdr->ndx)
{ errmsg(126,rtnnme,consys->nme,"row",rowhdr,rowhdr->ndx,rowndx,rowhdr) ;
return (quiet_nan(0)) ; }
# endif
norm = 0 ;
for (coeff = rowhdr->coeffs ; coeff != NULL ; coeff = coeff->rownxt)
{
# ifdef DYLP_PARANOIA
if (coeff->colhdr == NULL)
{ errmsg(125,rtnnme,consys->nme,"colhdr",coeff,"row",
consys_nme(consys,'c',rowndx,FALSE,NULL),rowndx) ;
return (quiet_nan(0)) ; }
if (coeff->colhdr->ndx <= 0 || coeff->colhdr->ndx > consys->varcnt)
{ errmsg(102,rtnnme,consys->nme,"column",coeff->colhdr->ndx,
1,consys->varcnt) ;
return (quiet_nan(0)) ; }
if (coeff->colhdr != consys->mtx.cols[coeff->colhdr->ndx])
{ errmsg(126,rtnnme,consys->nme,"column",coeff->colhdr,coeff->colhdr->ndx,
coeff->colhdr->ndx,consys->mtx.cols[coeff->colhdr->ndx]) ;
return (quiet_nan(0)) ; }
# endif
norm = maxx(fabs(coeff->val),norm) ; }
return (norm) ; }
double consys_dotrow (consys_struct *consys, int rowndx, double *vec)
/*
This routine computes the dot product of the specified row with the expanded
vector passed in vec.
Parameters:
consys: constraint system
rowndx: row
vec: vector
Returns: dot product, or NaN if the calculation goes awry.
*/
{ double dotprod ;
rowhdr_struct *rowhdr ;
coeff_struct *coeff ;
# if defined(DYLP_PARANOIA) || !defined(DYLP_NDEBUG)
const char *rtnnme = "consys_dotrow" ;
# endif
# ifdef DYLP_PARANOIA
if (consys == NULL)
{ errmsg(2,rtnnme,"consys") ;
return (quiet_nan(0)) ; }
if (consys->mtx.rows == NULL)
{ errmsg(101,rtnnme,consys->nme,"row header") ;
return (quiet_nan(0)) ; }
# endif
# ifndef DYLP_NDEBUG
if (rowndx <= 0 || rowndx > consys->concnt)
{ errmsg(102,rtnnme,consys->nme,"row",rowndx,1,consys->concnt) ;
return (quiet_nan(0)) ; }
# endif
rowhdr = consys->mtx.rows[rowndx] ;
# ifdef DYLP_PARANOIA
if (rowhdr == NULL)
{ errmsg(103,rtnnme,consys->nme,"row",rowndx) ;
return (quiet_nan(0)) ; }
if (rowndx != rowhdr->ndx)
{ errmsg(126,rtnnme,consys->nme,"row",rowhdr,rowhdr->ndx,rowndx,rowhdr) ;
return (quiet_nan(0)) ; }
if (vec == NULL)
{ errmsg(2,rtnnme,"vec") ;
return (quiet_nan(0)) ; }
# endif
dotprod = 0 ;
for (coeff = rowhdr->coeffs ; coeff != NULL ; coeff = coeff->rownxt)
{
# ifdef DYLP_PARANOIA
if (coeff->colhdr == NULL)
{ errmsg(125,rtnnme,consys->nme,"colhdr",coeff,"row",
consys_nme(consys,'c',rowndx,FALSE,NULL),rowndx) ;
return (quiet_nan(0)) ; }
if (coeff->colhdr->ndx <= 0 || coeff->colhdr->ndx > consys->varcnt)
{ errmsg(102,rtnnme,consys->nme,"column",coeff->colhdr->ndx,
1,consys->varcnt) ;
return (quiet_nan(0)) ; }
if (coeff->colhdr != consys->mtx.cols[coeff->colhdr->ndx])
{ errmsg(126,rtnnme,consys->nme,"column",coeff->colhdr,coeff->colhdr->ndx,
coeff->colhdr->ndx,consys->mtx.cols[coeff->colhdr->ndx]) ;
return (quiet_nan(0)) ; }
# endif
dotprod += coeff->val*vec[coeff->colhdr->ndx] ; }
return (dotprod) ; }
