static ograd *
sortq(ograd *og0, ograd **q)
{
ograd *og, **q1;
int n;
for(q1 = q, og = og0; og; og = og->next)
*q1++ = og;
if ((n = q1 - q) > 1) {
qsortv(q, n, sizeof(ograd *), comp, NULL);
og0 = 0;
do {
og = *--q1;
og->next = og0;
og0 = og;
} while(q1 > q);
}
return og0;
}
Fints
mqpcheck_ASL(ASL *a, int co, fint **rowqp, Fint **colqp, real **delsqp)
{
typedef struct dispatch {
struct dispatch *next;
fint i, j, jend;
} dispatch;
ASL_fg *asl;
Fint *colq, *colq1, nelq;
Objrep *od, **pod;
Static SS, *S;
cde *c;
cgrad *cg, **cgp, **cgq, *cq;
dispatch *cd, *cd0, **cdisp, **cdisp0, *cdnext, **cdp;
dyad *d, *d1, **q, **q1, **q2, **qe;
expr *e;
expr_n *en;
fint *rowq, *rowq0, *rowq1, *s, *z;
fint ftn, i, icol, j, ncom, nv, nz, nz1;
int arrays, *cm, co0, pass, *vmi;
ograd *og, *og1, *og2, **ogp;
real *L, *U, *delsq, *delsq0, *delsq1, objadj, t, *x;
term *T;
ASL_CHECK(a, ASL_read_fg, "nqpcheck");
asl = (ASL_fg*)a;
if (co >= n_obj || co < -n_con)
return -3L;
od = 0;
co0 = co;
if (co >= 0) {
if ((pod = asl->i.Or) && (od = pod[co])) {
co = od->ico;
goto use_Cgrad;
}
else {
c = obj_de + co;
ogp = Ograd + co;
cgp = 0;
}
}
else {
co = -1 - co;
if ((cm = asl->i.cmap))
co = cm[co];
use_Cgrad:
c = con_de + co;
cgp = Cgrad;
cgp += co;
ogp = 0;
}
e = c->e;
if (e->op == f_OPNUM)
return 0;
memset(S = &SS, 0, sizeof(Static));
SS.asl = asl;
if (asl->i.vmap && !asl->i.vminv)
/* keep vminv from being lost in free_blocks(S) below */
get_vminv_ASL(a);
M1state1 = asl->i.Mbnext;
M1state2 = asl->i.Mblast;
nv = n_var;
s_x = x = (double *)Malloc(nv*(sizeof(double)+2*sizeof(fint)));
s_z = z = (fint *)(x + nv);
s_s = s = z + nv;
memset(s, 0, nv*sizeof(fint));
ftn = Fortran;
SS.nvinc = nv - asl->i.n_var0 + asl->i.nsufext[ASL_Sufkind_var];
delsq = delsq0 = delsq1 = 0; /* silence buggy "not-initialized" warning */
colq = colq1 = 0; /* ditto */
rowq = rowq0 = rowq1 = 0; /* ditto */
cd0 = 0; /* ditto */
cdisp = cdisp0 = 0; /* ditto */
if ((ncom = ncom0 + ncom1)) {
cterms = (term **)Malloc(ncom*sizeof(term*));
memset(cterms, 0, ncom*sizeof(term*));
}
arrays = 1;
if (rowqp)
*rowqp = 0;
else
arrays = 0;
if (colqp)
*colqp = 0;
else
arrays = 0;
if (delsqp)
*delsqp = 0;
else
arrays = 0;
zerodiv = 0;
if (!(T = ewalk(S, e)) || zerodiv) {
free_blocks(S);
free(x);
return T ? -2L : -1L;
}
if (cterms)
cterm_free(S, cterms + ncom);
if (od) {
cgq = &od->cg;
for(i = 0, cg = *cgp; cg; cg = cg->next) {
if (cg->coef != 0.)
++i;
}
if (i) {
cq = Malloc(i*sizeof(cgrad));
for(cg = *cgp; cg; cg = cg->next) {
*cgq = cq;
cgq = &cq->next;
*cq = *cg;
++cq;
}
}
*cgq = 0;
}
q = (dyad **)Malloc(nv*sizeof(dyad *));
qe = q + nv;
objadj = dsort(S, T, (ograd **)q, cgp, ogp, arrays);
nelq = nz = nz1 = 0;
/* In pass 0, we the count nonzeros in the lower triangle. */
/* In pass 1, we compute the lower triangle and use column dispatch */
/* (via the cdisp array) to copy the strict lower triangle to the */
/* strict upper triangle. This ensures symmetry. */
for(pass = 0; pass < 2; pass++) {
if (pass) {
nelq += nelq - nz1;
if (!nelq || !arrays)
break;
free(q);
delsq1 = delsq = (double *)Malloc(nelq*sizeof(real));
rowq1 = rowq = (fint *)Malloc(nelq*sizeof(fint));
colq1 = colq = (Fint *)Malloc((nv+2)*sizeof(Fint));
nelq = ftn;
delsq0 = delsq - ftn;
rowq0 = rowq - ftn;
q = (dyad **)Malloc(nv*(sizeof(dyad*)
+ sizeof(dispatch *)
+ sizeof(dispatch)));
qe = q + nv;
cdisp = (dispatch**) qe;
cdisp0 = cdisp - ftn;
memset(cdisp, 0, nv*sizeof(dispatch*));
cd0 = (dispatch *)(cdisp + nv);
}
memset(q, 0, nv*sizeof(dyad *));
for(d = T->Q; d; d = d->next) {
og = d->Rq;
og1 = d->Lq;
i = og->varno;
while(og1 && og1->varno < i)
og1 = og1->next;
if (og1) {
q1 = q + i;
*q1 = new_dyad(S, *q1, og, og1, 0);
}
og1 = d->Lq;
i = og1->varno;
while(og && og->varno < i)
og = og->next;
if (og) {
q1 = q + i;
*q1 = new_dyad(S, *q1, og1, og, 0);
}
}
vmi = asl->i.vmap ? get_vminv_ASL((ASL*)asl) : 0;
for(icol = 0, q1 = q; q1 < qe; ++icol, ++q1) {
if (pass) {
*colq++ = nelq;
for(cd = cdisp[icol]; cd; cd = cdnext) {
cdnext = cd->next;
s[i = cd->i]++;
x[z[nz++] = i] = delsq0[cd->j++];
if (cd->j < cd->jend) {
cdp = cdisp0 + rowq0[cd->j];
cd->next = *cdp;
*cdp = cd;
}
}
}
if ((d = *q1))
do {
og = d->Lq;
og1 = d->Rq;
t = og->coef;
for(; og1; og1 = og1->next) {
if (!s[i = og1->varno]++)
x[z[nz++] = i] =
t*og1->coef;
else
x[i] += t*og1->coef;
}
if ((og1 = og->next)) {
og2 = d->Rq;
while (og2->varno < og1->varno)
if (!(og2 = og2->next)) {
while((og1 = og->next))
og = og1;
break;
}
d->Rq = og2;
}
d1 = d->next;
if ((og = og->next)) {
i = og->varno;
if (pass) {
og1 = d->Rq;
while(og1->varno < i)
if (!(og1 = og1->next))
goto d_del;
d->Rq = og1;
}
d->Lq = og;
q2 = q + i;
d->next = *q2;
*q2 = d;
}
else {
d_del:
free_dyad(S, d);
}
}
while((d = d1));
if (nz) {
if (pass) {
if (nz > 1)
qsortv(z, nz, sizeof(fint), lcmp, NULL);
for(i = nz1 = 0; i < nz; i++) {
if ((t = x[j = z[i]])) {
*delsq++ = t;
if (vmi)
j = vmi[j];
*rowq++ = j + ftn;
nelq++;
z[nz1++] = j;
}
s[j] = 0;
}
for(i = 0; i < nz1; i++)
if ((j = z[i]) > icol && x[j]) {
cd0->i = icol;
cd0->j = colq[-1] + i;
cd0->jend = nelq;
cdp = cdisp + j;
cd0->next = *cdp;
*cdp = cd0++;
break;
}
nz = 0;
}
else {
while(nz > 0) {
s[i = z[--nz]] = 0;
if (x[i]) {
++nelq;
if (i == icol)
++nz1;
}
}
}
}
}
}
free(q);
free_blocks(S);
free(x);
if (od && od->cg)
M1record(od->cg);
if (nelq) {
if (arrays) {
/* allow one more for obj. adjustment */
*colq = colq[1] = nelq;
*rowqp = rowq1;
*colqp = colq1;
*delsqp = delsq1;
}
nelq -= ftn;
}
if (arrays) {
en = (expr_n *)mem(sizeof(expr_n));
en->op = f_OPNUM_ASL;
if (od) {
od->opify = qp_opify_ASL;
if ((t = od->c12) != 1.)
for(i = 0; i < nelq; ++i)
delsq1[i] *= t;
objadj = t*objadj + od->c0a;
for(i = 0, cg = *cgp; cg; cg = cg->next)
++i;
ogp = Ograd + co0;
og2 = i ? (ograd*)M1alloc(i*sizeof(ograd)) : 0;
for(cg = *cgp; cg; cg = cg->next) {
*ogp = og = og2++;
ogp = &og->next;
og->varno = cg->varno;
og->coef = t*cg->coef;
}
*ogp = 0;
c = obj_de + co0;
}
else if (cgp && objadj != 0.) {
if (Urhsx) {
L = LUrhs + co;
U = Urhsx + co;
}
else {
L = LUrhs + 2*co;
U = L + 1;
}
if (*L > negInfinity)
*L -= objadj;
if (*U < Infinity)
*U -= objadj;
objadj = 0;
}
en->v = objadj;
c->e = (expr *)en;
}
return nelq;
}
ssize_t
mqpcheckv_ASL(ASL *a, int co, QPinfo **QPIp, void **vp)
{
ASL_fg *asl;
AVL_Node *NQ, *NQ0;
AVL_Tree *AQ;
Memblock *mb;
QPinfo *qpi;
Objrep *od, **pod;
Static *S;
cde *c;
cgrad *cg, **cgp, **cgq, *cq;
dispatch *cd, *cd0, **cdisp, **cdisp0, *cdnext, **cdp;
dyad *d, *d1, **q, **q1, **q2;
expr *e;
expr_n *en;
int *cm, *colno, *qm, *rowq, *rowq0, *rowq1, *s, *vmi, *w, *z;
int arrays, co0, ftn, i, icol, icolf, j, ncol, ncom, nv, nva, nz, nz1, pass;
ograd *og, *og1, *og2, **ogp;
real *L, *U, *delsq, *delsq0, *delsq1, objadj, t, *x;
size_t *colq, *colq1, nelq, nelq0;
term *T;
ASL_CHECK(a, ASL_read_fg, "nqpcheck");
asl = (ASL_fg*)a;
if (co >= n_obj || co < -n_con)
return -3L;
colno = 0;
od = 0;
co0 = co;
if (co >= 0) {
if ((pod = asl->i.Or) && (od = pod[co])) {
co = od->ico;
goto use_Cgrad;
}
else {
c = obj_de + co;
ogp = Ograd + co;
cgp = 0;
}
}
else {
co = -1 - co;
if ((cm = asl->i.cmap))
co = cm[co];
use_Cgrad:
c = con_de + co;
cgp = Cgrad;
cgp += co;
ogp = 0;
}
e = c->e;
if (e->op == f_OPNUM)
return 0;
if (asl->i.vmap && !asl->i.vminv)
get_vminv_ASL(a);
nv = n_var;
ncom = ncom0 + ncom1;
if (!(S = *(Static**)vp)) {
i = asl->i.n_var0 + asl->i.nsufext[0];
if ((nva = nv) < i)
nva = i;
x = (double *)Malloc(nva*(sizeof(double)
+sizeof(dyad*)
+sizeof(ograd*)
+sizeof(dispatch*)
+sizeof(dispatch)
+3*sizeof(int))
+ sizeof(Memblock)
+ sizeof(Static));
mb = (Memblock*)(x + nva);
mb->prev = mb->next = 0;
S = (Static*)(mb + 1);
*vp = (void*)S;
memset(S, 0, sizeof(Static));
S->mb0 = S->mblast = mb;
s_x = x;
S->asl = asl;
s_q = q = (dyad**)(S+1);
S->oq = (ograd**)(q + nva);
S->cdisp = cdisp = (dispatch**)(S->oq + nva);
S->cd0 = cd0 = (dispatch*)(cdisp + nva);
s_z = z = (int*)(cd0 + nva);
s_s = s = z + nva;
S->w = (int*)(s + nva);
memset(s, 0, nva*sizeof(int));
memset(cdisp, 0, nva*sizeof(dispatch*));
memset(q, 0, nva*sizeof(dyad *));
memset(S->w, 0, nva*sizeof(int));
if (ncom) {
cterms = (term **)Malloc(ncom*(sizeof(term*)+sizeof(int)));
memset(cterms, 0, ncom*sizeof(term*));
S->zct = (int*)(cterms + ncom);
}
S->AQ = AVL_Tree_alloc2(0, vcomp, mymalloc, 0);
}
else {
q = s_q;
x = s_x;
z = s_z;
s = s_s;
cdisp = S->cdisp;
cd0 = S->cd0;
}
S->mb = mb = S->mb0;
S->v = &mb->x[0];
S->ve = &mb->x[Memblock_gulp];
w = S->w;
freedyad = 0;
freeog = 0;
freeterm = 0;
AQ = S->AQ;
ftn = Fortran;
cdisp0 = cdisp - ftn;
S->nvinc = nv - asl->i.n_var0 + asl->i.nsufext[ASL_Sufkind_var];
delsq = delsq0 = delsq1 = 0; /* silence buggy "not-initialized" warning */
colq = colq1 = 0; /* ditto */
rowq = rowq0 = rowq1 = 0; /* ditto */
arrays = 0;
if (QPIp) {
*QPIp = 0;
arrays = 1;
}
zerodiv = 0;
if (!(T = ewalk(S, e)) || zerodiv)
return T ? -2L : -1L;
if (S->nzct)
cterm_free(S);
if (od) {
cgq = &od->cg;
for(i = 0, cg = *cgp; cg; cg = cg->next) {
if (cg->coef != 0.)
++i;
}
if (i) {
cq = M1alloc(i*sizeof(cgrad));
for(cg = *cgp; cg; cg = cg->next) {
*cgq = cq;
cgq = &cq->next;
*cq = *cg;
++cq;
}
}
*cgq = 0;
}
objadj = dsort(S, T, S->oq, cgp, ogp, arrays);
icolf = nelq = ncol = nz = nz1 = 0;
qpi = 0;
/* In pass 0, we the count nonzeros in the lower triangle. */
/* In pass 1, we compute the lower triangle and use column dispatch */
/* (via the cdisp array) to copy the strict lower triangle to the */
/* strict upper triangle. This ensures symmetry. */
for(pass = 0; pass < 2; pass++) {
if (pass) {
if (!nelq)
break;
nelq += nelq - nz1; /* nz1 = number of diagonal elements */
if (!arrays) {
for(qm = (int*)AVL_first(AQ, &NQ); qm; ) {
*qm = 0;
NQ0 = NQ;
qm = (int*) AVL_next(&NQ);
AVL_delnode(AQ, &NQ0);
}
break;
}
qpi = *QPIp = (QPinfo*)Malloc(sizeof(QPinfo)
+ nelq*(sizeof(real) + sizeof(int))
+ ncol*sizeof(int)
+ (ncol + 1)*sizeof(size_t));
qpi->delsq = delsq = delsq1 = (double *)(qpi+1);
qpi->colbeg = colq = (size_t *)(delsq + nelq);
qpi->rowno = rowq = (int *)(colq + ncol + 1);
qpi->colno = colno = rowq + nelq;
qpi->nc = ncol;
qpi->nz = nelq;
nelq = ftn;
delsq0 = delsq - ftn;
rowq0 = rowq - ftn;
}
for(d = T->Q; d; d = d->next) {
og = d->Rq;
og1 = d->Lq;
i = og->varno;
while(og1 && og1->varno < i)
og1 = og1->next;
if (og1) {
q1 = q + i;
if (!w[i]) {
w[i] = 1;
AVL_vinsert(AQ, 0, (Element*)&w[i], 0);
}
*q1 = new_dyad(S, *q1, og, og1, 0);
}
og1 = d->Lq;
i = og1->varno;
while(og && og->varno < i)
og = og->next;
if (og) {
q1 = q + i;
if (!w[i]) {
w[i] = 1;
AVL_vinsert(AQ, 0, (Element*)&w[i], 0);
}
*q1 = new_dyad(S, *q1, og1, og, 0);
}
}
vmi = asl->i.vmap ? get_vminv_ASL((ASL*)asl) : 0;
for(qm = (int*)AVL_first(AQ, &NQ); qm; ) {
NQ0 = NQ;
icol = qm - w;
nelq0 = nelq;
if (pass) {
*qm = 0;
icolf = icol + ftn;
if ((cd = cdisp[icol])) {
cdisp[icol] = 0;
do {
cdnext = cd->next;
s[i = cd->i]++;
x[z[nz++] = i] = delsq0[cd->j++];
if (cd->j < cd->jend) {
cdp = cdisp0 + rowq0[cd->j];
cd->next = *cdp;
*cdp = cd;
}
} while((cd = cdnext));
}
}
if ((d = q[icol])) {
q[icol] = 0;
do {
og = d->Lq;
og1 = d->Rq;
t = og->coef;
for(; og1; og1 = og1->next) {
if (!s[i = og1->varno]++)
x[z[nz++] = i] =
t*og1->coef;
else
x[i] += t*og1->coef;
}
if ((og1 = og->next)) {
og2 = d->Rq;
while (og2->varno < og1->varno)
if (!(og2 = og2->next)) {
while((og1 = og->next))
og = og1;
goto get_d1;
}
d->Rq = og2;
}
get_d1:
d1 = d->next;
if ((og = og->next)) {
i = og->varno;
if (pass) {
og1 = d->Rq;
while(og1->varno < i)
if (!(og1 = og1->next))
goto d_del;
d->Rq = og1;
}
d->Lq = og;
q2 = q + i;
if (!w[i]) {
w[i] = 1;
AVL_vinsert(AQ, 0, (Element*)&w[i], 0);
}
d->next = *q2;
*q2 = d;
}
else {
d_del:
free_dyad(S, d);
}
}
while((d = d1));
}
if (nz) {
if (pass) {
if (nz > 1)
qsortv(z, nz, sizeof(int), lcmp, NULL);
for(i = nz1 = 0; i < nz; i++) {
if ((t = x[j = z[i]])) {
*delsq++ = t;
if (vmi)
j = vmi[j];
*rowq++ = j + ftn;
nelq++;
z[nz1++] = j;
}
s[j] = 0;
}
if (nelq > nelq0) {
*colq++ = nelq0;
*colno++ = icolf;
}
for(i = 0; i < nz1; i++)
if ((j = z[i]) > icol) {
cd0->i = icol;
cd0->j = nelq0 + i;
cd0->jend = nelq;
cdp = cdisp + j;
cd0->next = *cdp;
*cdp = cd0++;
break;
}
nz = 0;
}
else {
while(nz > 0) {
s[i = z[--nz]] = 0;
if (x[i]) {
++nelq;
if (i == icol)
++nz1;
else {
if (!w[i])
AVL_vinsert(AQ, 0, (Element*)&w[i], 0);
w[i] = 2;
}
}
}
if (nelq > nelq0 || w[icol] == 2)
++ncol;
}
}
else if (!pass && w[icol] == 2)
++ncol;
qm = (int*) AVL_next(&NQ);
if (pass)
AVL_delnode(AQ, &NQ0);
}
}
if (colq)
*colq = nelq;
if (arrays) {
if (nelq)
nelq -= ftn;
en = (expr_n *)mem(sizeof(expr_n));
en->op = f_OPNUM_ASL;
if (od) {
od->opify = qp_opify_ASL;
if ((t = od->c12) != 1.)
for(i = 0; i < nelq; ++i)
delsq1[i] *= t;
objadj = t*objadj + od->c0a;
for(i = 0, cg = *cgp; cg; cg = cg->next)
++i;
ogp = Ograd + co0;
og2 = i ? (ograd*)M1alloc(i*sizeof(ograd)) : 0;
for(cg = *cgp; cg; cg = cg->next) {
*ogp = og = og2++;
ogp = &og->next;
og->varno = cg->varno;
og->coef = t*cg->coef;
}
*ogp = 0;
c = obj_de + co0;
}
else if (cgp && objadj != 0.) {
if (Urhsx) {
L = LUrhs + co;
U = Urhsx + co;
}
else {
L = LUrhs + 2*co;
U = L + 1;
}
if (*L > negInfinity)
*L -= objadj;
if (*U < Infinity)
*U -= objadj;
objadj = 0.;
}
en->v = objadj;
c->e = (expr *)en;
}
return nelq;
}
static int
lincheck(LCADJ_Info *lci, expr *e, Lconstr ***pplc)
{
Lconstr *lc;
expr *e1, *e2, **ep1, **ep2;
int i, j, k, m, *y, *z;
ograd *freeog, *og, *og1, *og1e, *og2, **s;
real *LU, rhs, *x;
top:
switch(Intcast e->op) {
case OPAND:
if ((k = lincheck(lci, e->L.e, pplc)))
return k;
e = e->R.e;
goto top;
case ANDLIST:
ep1 = e->L.ep;
for(ep2 = e->R.ep; ep1 < ep2; ep1++)
if ((k = lincheck(lci, *ep1, pplc)))
return k;
return 0;
case GE: k = 2; break;
case LE: k = 3; break;
case EQ: k = 5; break;
default: return 1;
}
e1 = e->L.e;
e2 = e->R.e;
if ((Intcast e1->op) == OPNUM) {
rhs = ((expr_n*)e1)->v;
e1 = e2;
if (k != 5)
k = 5 - k;
}
else if ((Intcast e2->op) != OPNUM)
return 1;
else
rhs = ((expr_n*)e2)->v;
if (!(og1 = linform(lci,e1,&og1e)))
return 1;
s = lci->s;
z = lci->z;
m = 0;
freeog = lci->freeog;
while((og = og1)) {
og1 = og->next;
if ((i = og->varno) < 0)
rhs -= og->coef;
else if (!(og2 = s[i])) {
s[i] = og;
z[m++] = i;
continue;
}
else
og2->coef += og->coef;
og->next = freeog;
freeog = og;
}
if (m > 1)
qsortv(z, m, sizeof(int), intcomp, 0);
x = tmem(lci, m*(sizeof(real) + sizeof(int)) + sizeof(Lconstr));
**pplc = lc = (Lconstr*)(x + m);
y = (int*)(lc + 1);
lc->next = 0;
*pplc = &lc->next;
lc->x = x;
lc->z = y;
lc->nx = m;
LU = lc->LU;
for(i = 0; i < m; i++) {
y[i] = j = z[i];
og = s[j];
s[j] = 0;
x[i] = og->coef;
og->next = freeog;
freeog = og;
}
lci->freeog = freeog;
LU[0] = LU[1] = rhs;
switch(k) {
case 2:
LU[1] = Infinity;
break;
case 3:
LU[0] = negInfinity;
}
return 0;
}
