static void
INchk(ASL *asl, const char *who, int i, int ix)
{
ASL_CHECK(asl, ASL_read_fg, who);
if (i < 0 || i >= ix) {
fprintf(Stderr, "%s: got I = %d; expected 0 <= I < %d\n",
who, i, ix);
exit(1);
}
}
INchk(ASL *asl, char *who, int i, int ix)
#endif
{
ASL_CHECK(asl, ASL_read_fgh, who);
if (i < 0 || i >= ix) {
fprintf(Stderr, "%s: got I = %d; expected 0 <= I < %d\n",
who, i, ix);
exit(1);
}
}
void
hvpinit_ASL(ASL *a, int ndhmax, int nobj, real *ow, real *y)
{
ASL_pfgh *asl;
Ihinfo *ihi;
range *r;
real *h, *s, *si;
int i, ihc, n1;
linarg **lap, **lap1, **lape;
expr_v *v;
ASL_CHECK(a, ASL_read_pfgh, "xvpinit");
asl = (ASL_pfgh*)a;
xpsg_check_ASL(asl, nobj, ow, y);
asl->P.nhvprod = 0;
if (!asl->P.hes_setup_called)
(*asl->p.Hesset)(a, 1, 0, nlo, 0, nlc);
ihc = 0;
if (ndhmax > asl->P.ihdmax)
ndhmax = asl->P.ihdmax;
if ((asl->P.ndhmax = ndhmax) <= 0)
goto done;
if (!(ihi = asl->P.ihi1) || ndhmax < asl->P.ihdmin)
return;
if (nobj < 0 || nobj >= n_obj)
nobj = -1;
s = asl->P.dOscratch;
for(ihc = 0; ihi->ihd <= ndhmax; ihi = ihi->next) {
ihc = ihi->ihd;
ihi->hest = h = (real *)new_mblk(ihi->k);
for(r = ihi->r; r; r = r->rlist.prev) {
r->hest = h;
if ((n1 = r->n) < r->nv) {
si = s;
lape = lap = r->lap;
for(i = 0; i < n1; i++) {
*si = 1.;
pshv_prod(r, nobj, ow, y);
*si++ = 0;
lape++;
lap1 = lap;
do {
v = (*lap1++)->v;
*h++ = v->aO;
}
while(lap1 < lape);
}
}
else
h = bigUmult(asl, h, r, nobj, ow, y);
}
}
done:
asl->P.ihdcur = ihc;
}
static void
NNOBJ_chk(ASL *asl, int i, const char *who)
{
ASL_CHECK(asl, ASL_read_fg, who);
if (i < 0 || i >= n_obj) {
fprintf(Stderr,
"objval: got NOBJ = %d; expected 0 <= NOBJ < %d\n",
i, n_obj);
exit(1);
}
}
mnnzchk_ASL(ASL *asl, fint *M, fint *N, fint *NZ, char *who1)
#endif
{
int n;
if (!asl || (n = asl->i.ASLtype) < ASL_read_fg || n > ASL_read_pfgh)
badasl_ASL(asl, ASL_read_fg, who1);
ASL_CHECK(asl, n, who1);
if (*M != n_con || *N != c_vars || *NZ != nzjac) {
what_prog();
fprintf(Stderr,
"%s: got M = %ld, N = %ld, NZ = %ld\nexpected M = %d, N = %d, NZ = %d\n",
who1, (long)*M, (long)*N, *NZ, n_con, c_vars, nzjac);
exit(1);
}
}
void
mnnzchk_ASL(ASL *asl, fint *M, fint *N, size_t NZ, const char *who1)
{
int n;
if (!asl)
goto bad;
n = asl->i.ASLtype;
if (n < ASL_read_fg || n > ASL_read_pfgh)
goto bad;
ASL_CHECK(asl, n, who1);
if (*M == n_con && *N == c_vars && NZ == nzjac)
return;
what_prog();
fprintf(Stderr,
"%s: got M = %ld, N = %ld, NZ = %ld\nexpected M = %d, N = %d, NZ = %d\n",
who1, (long)*M, (long)*N, NZ, n_con, c_vars, nzjac);
exit(1);
bad:
badasl_ASL(asl, ASL_read_fg, who1);
}
int
indicator_constrs_ASL(ASL *asl, void *v, Add_Indicator add_indic, int errinfo[2])
{
LCADJ_Info lci;
cde *logc;
int i, n, nlogc, rc;
real chunk1[Gulp];
static char who[] = "indicator_constrs_ASL";
ASL_CHECK(asl, ASL_read_fg, who);
if (!(nlogc = n_lcon))
return 0;
memset(&lci, 0, sizeof(lci));
lci.v = v;
lci.tfree0 = chunk1;
n = n_var;
lci.s = (ograd**)Malloc(n*(sizeof(int) + sizeof(ograd*)));
lci.z = (int*)(lci.s + n);
memset(lci.s, 0, n*sizeof(ograd*));
lci.n1lc = (sizeof(Lconstr) + sizeof(real) - 1) / sizeof(real);
lci.n1og = (sizeof(ograd) + sizeof(real) - 1) / sizeof(real);
lci.asl = asl;
lci.nlv[1] = i = nlvb;
lci.nlv[0] = i - nlvbi;
lci.nlv[3] = i = nlvc;
lci.nlv[2] = i - nlvci;
if (nlvo > nlvc)
i = nlvo;
lci.nlv[5] = i;
lci.nlv[4] = i - nlvoi;
lci.errinfo = errinfo;
lci.add_indic = add_indic;
logc = ((ASL_fg*)asl)->I.lcon_de_;
for(i = rc = 0; i < nlogc; ++i)
if ((rc = add_indicator(i, &lci, logc[i].e)))
break;
if (lci.tchunks)
chunkfree(&lci);
free(lci.s);
return rc;
}
void
x1known_ASL(ASL *asl, real *X, fint *nerror)
{
Jmp_buf err_jmp0;
int ij;
ASL_CHECK(asl, ASL_read_fg, "x1known");
if (asl->i.xknown_ignore)
return;
if (nerror && *nerror >= 0) {
err_jmp = &err_jmp0;
ij = __builtin_setjmp(err_jmp0.jb);
if (ij) {
*nerror = err_jmp0.err;
goto done;
}
}
errno = 0; /* in case f77 set errno opening files */
x0_check_ASL((ASL_fg*)asl, X);
asl->i.x_known = 1;
done:
err_jmp = 0;
}
int
xp2known_ASL(ASL* asl, real *X, fint *nerror)
{
Jmp_buf err_jmp0;
int ij, rc;
ASL_CHECK(asl, ASL_read_pfgh, "xp2known");
rc = 1;
if (asl->i.xknown_ignore)
goto ret;
if (nerror && *nerror >= 0) {
err_jmp = &err_jmp0;
ij = setjmp(err_jmp0.jb);
if ((*nerror = ij))
goto done;
}
errno = 0; /* in case f77 set errno opening files */
rc = xp_check_ASL((ASL_pfgh*)asl, X);
asl->i.x_known = 1;
done:
err_jmp = 0;
ret:
return rc;
}
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;
}
int
fg_write_ASL(ASL *a, const char *stub, NewVCO *nu, int flags)
{
ASL_fg *asl = (ASL_fg*)a;
FILE *nl;
Pf *pf;
Staticfgw S;
SufDesc *sd, *sd0;
cexp *ce, *cee;
char buf[256], *nbuf, *ts;
const char *eol, *name, *obase, *s;
efunc *rops[N_OPS];
expr_v *v;
func_info *fi;
int ak, c, i, j, *ip, *ipe, n, nnc, nne, nno, nnr, nnv, nnzc, nnzo;
int nx, oblen, rflag;
linpart *L, *Le;
real *r, *re, t;
static NewVCO nu0;
ASL_CHECK(a, ASL_read_fg, "fg_write");
if ((comc1 && !c_cexp1st) || (como1 && !o_cexp1st))
return ASL_writeerr_badcexp1st;
nnc = nne = nno = nnr = nnv = nnzc = nnzo = 0;
if (!nu || (nu->nnv == 0 && nu->nnc == 0 && nu->nno == 0))
nu = &nu0;
else {
nnc = nu->nnc;
nno = nu->nno;
nnv = nu->nnv;
if ((nnv <= 0
|| nnc < 0
|| nno < 0
|| nnc + nno <= 0
|| nnc > 0) && !nu->LUnc)
return ASL_writeerr_badNewVCO;
if (LUcheck(nnv, nu->LUnv, nu->Unv, 0, 0))
return ASL_writeerr_badNewVCO;
n = n_var + nnv;
if (nnc) {
if (LUcheck(nnc, nu->LUnc, nu->Unc, &nnr, &nne))
return ASL_writeerr_badNewVCO;
if (ogcheck(n, nnc, nu->newc, &nnzc))
return ASL_writeerr_badNewVCO;
}
if (nno) {
if (ogcheck(n, nno, nu->newo, &nnzo))
return ASL_writeerr_badNewVCO;
if ((s = nu->ot))
for(i = 0; i < nno; i++)
if (s[i] & ~1)
return ASL_writeerr_badNewVCO;
if ((r = nu->oc))
for(re = r + nno; r < re; r++) {
if ((t = *r) <= negInfinity
|| t >= Infinity
|| t != t)
return ASL_writeerr_badNewVCO;
}
}
}
S.r_ops_ = rops;
for(i = 0; i < N_OPS; i++)
rops[i] = (efunc*)(unsigned long)i;
s = name = obase = stub;
while(*s)
switch(*s++) {
case '/':
case '\\':
obase = s;
}
c = s - stub;
nbuf = 0;
oblen = s - obase;
if (c <= 3 || strcmp(s - 3, ".nl")) {
ts = buf;
if (c + 4 > sizeof(buf))
ts = nbuf = (char*)Malloc(c+4);
memcpy(ts, stub, c);
strcpy(ts+c, ".nl");
name = ts;
}
else
oblen -= 3;
nl = fopen(name, "wb");
if (nbuf)
free(nbuf);
if (!nl)
return ASL_writeerr_openfail;
i = setjmp(S.wjb);
if (i) {
fclose(nl);
return ASL_writeerr_badrops;
}
if (flags & ASL_write_ASCII) {
ak = 0;
c = 'g';
pf = aprintf;
}
else {
ak = Arith_Kind_ASL;
c = 'b';
pf = bprintf;
}
S.nl_ = nl;
S.pf_ = pf;
eol = (char*)(flags & ASL_write_CR ? "\r\n" : "\n");
fprintf(nl, "%c%d", c, n = ampl_options[0]);
for(i = 1; i <= n; i++)
fprintf(nl, " %d", ampl_options[i]);
if (ampl_options[2] == 3)
fprintf(nl, " %.g", ampl_vbtol);
fprintf(nl, "\t# problem %.*s%s", oblen, obase, eol);
fprintf(nl, " %d %d %d %d", n_var + nnv, n_con + nnc,
n_obj + nno, nranges + nnr);
s = "";
if ((n = n_eqn + nne) >= 0) {
fprintf(nl, " %d", n);
s = ", eqns";
}
fprintf(nl, "\t# vars, constraints, objectives, ranges%s%s", s, eol);
if (n_cc | nlcc)
fprintf(nl, " %d %d %d %d%s%s", nlc, nlo, n_cc, nlcc,
"\t# nonlinear constrs, objs; ccons: lin, nonlin", eol);
else
fprintf(nl, " %d %d\t# nonlinear constraints, objectives%s",
nlc, nlo, eol);
fprintf(nl, " %d %d\t# network constraints: nonlinear, linear%s",
nlnc, lnc, eol);
fprintf(nl, " %d %d %d%s%s", nlvc, nlvo, nlvb,
"\t# nonlinear vars in constraints, objectives, both", eol);
s = "";
fprintf(nl, " %d %d", nwv, nfunc);
if (ak | asl->i.flags) {
fprintf(nl, " %d %d", ak, asl->i.flags);
s = "; arith, flags";
}
fprintf(nl, "\t# linear network variables; functions%s%s", s, eol);
fprintf(nl, " %d %d %d %d %d%s%s", nbv, niv, nlvbi, nlvci, nlvoi,
"\t# discrete variables: binary, integer, nonlinear (b,c,o)",
eol);
fprintf(nl, " %d %d\t# nonzeros in Jacobian, gradients%s",
nzc + nnzc, nzo + nnzo, eol);
fprintf(nl, " 0 0\t# max name lengths: constraints, variables%s", eol);
fprintf(nl, " %d %d %d %d %d\t# common exprs: b,c,o,c1,o1%s",
comb, comc, como, comc1, como1, eol);
for(i = 0; i < nfunc; i++) {
fi = funcs[i];
fi->findex = i; /* for eput */
(*pf)(nl, "F%d %d %d %s\n", i, fi->ftype, fi->nargs, fi->name);
}
for(i = 0; i < 4; i++) {
if (!(sd = asl->i.suffixes[i]))
continue;
nx = (&asl->i.n_var_)[i];
for(sd = sd0 = reverse(sd); sd; sd = sd->next) {
n = rflag = 0;
if (sd->kind & ASL_Sufkind_real) {
rflag = ASL_Sufkind_real;
r = sd->u.r;
re = r + nx;
while(r < re)
if (*r++)
n++;
}
else {
ip = sd->u.i;
ipe = ip + nx;
while(ip < ipe)
if (*ip++)
n++;
}
if (!n)
continue;
(*pf)(nl, "S%d %d %s\n", i | rflag, n, sd->sufname);
j = 0;
if (rflag) {
r = sd->u.r;
for(; j < nx; j++)
if (r[j])
(*pf)(nl, "%d %g\n", j, r[j]);
}
else {
ip = sd->u.i;
for(; j < nx; j++)
if (ip[j])
(*pf)(nl, "%d %d\n", j, ip[j]);
}
}
reverse(sd0);
}
ce = cexps;
n = n_var + nnv;
S.v = var_e;
for(cee = ce + comb + comc + como; ce < cee; ce++) {
(*pf)(nl, "V%d %d %d\n", n++, ce->nlin, 0);
L = ce->L;
for(Le = L + ce->nlin; L < Le; L++) {
v = (expr_v*)((char*)L->v.rp - offset_of(expr_v,v));
(*pf)(nl, "%d %g\n", (int)(v - S.v), L->fac);
}
eput(&S, ce->e);
}
S.cexps1_ = asl->I.cexps1_;
S.nv0 = n_var;
S.com1off = S.nv0 + comb + comc + como;
coput(&S, 'C', con_de, n_con, c_cexp1st, 0, 0, nnc, 0, 0);
coput(&S, 'O', obj_de, n_obj, o_cexp1st, objtype, n_con,
nno, nu->oc, nu->ot);
iguess(pf, nl, 'd', pi0, havepi0, n_con, nnc, nu->d0);
iguess(pf, nl, 'x', X0, havex0, n_var, nnv, nu->x0);
br(pf, nl, 'r', LUrhs, Urhsx, n_con);
br(pf, nl, 0, nu->LUnc, nu->Unc, nnc);
br(pf, nl, 'b', LUv, Uvx, n_var);
br(pf, nl, 0, nu->LUnv, nu->Unv, nnv);
if (A_vals)
k1put(pf, nl, A_colstarts, A_vals, A_rownos, n_con, n_var,
nnv, nnc, nu->newc);
else
k2put(pf, nl, Cgrad, n_con, n_var, 1, nnv, nnc, nu->newc);
Gput(pf, nl, 'G', 0, n_obj, Ograd);
Gput(pf, nl, 'G', n_obj, nno, nu->newo);
fclose(nl);
return 0;
}
int
degree_ASL(ASL *a, int co, void **pv)
{
ASL_fg *asl;
Dhelp h;
Objrep *od, **pod;
cde *c;
cgrad *cg;
int *cm, i, ncom, rv;
ograd *og;
ASL_CHECK(a, ASL_read_fg, "degree");
asl = (ASL_fg*)a;
if (co >= n_obj || co < -n_con)
return -1;
h.nv = n_var;
h.vare = var_e;
h.vk = 0;
h.nc0 = ncom0;
if ((ncom = h.nc0 + ncom1)) {
h.c0 = cexps;
h.c1 = cexps1;
if (!pv || !(h.vk = *(int**)pv)) {
h.vk = (int*)Malloc(ncom*sizeof(int));
for(i = 0; i < ncom; ++i)
h.vk[i] = -2;
if (pv)
*pv = h.vk;
}
}
od = 0;
if (co >= 0) {
if ((pod = asl->i.Or) && (od = pod[co])) {
co = od->ico;
goto use_Cgrad;
}
c = obj_de + co;
og = Ograd[co];
cg = 0;
}
else {
co = -1 - co;
if ((cm = asl->i.cmap))
co = cm[co];
use_Cgrad:
c = con_de + co;
cg = Cgrad[co];
og = 0;
}
rv = kind(c->e, &h);
if (h.vk && !pv)
free(h.vk);
if (rv > 3)
rv = 3;
else if (rv == 0) {
while(og) {
if (og->coef) {
rv = 1;
goto ret;
}
og = og->next;
}
while(cg) {
if (cg->coef) {
rv = 1;
goto ret;
}
cg = cg->next;
}
}
ret:
return rv;
}