suf_declare_ASL(ASL *asl, SufDecl *sd, int n)
#endif
{
SufDesc *d, *dnext[4];
SufDecl *sde;
int i, j;
if (!asl)
badasl_ASL(asl, 0, "suf_declare");
asl->i.nsuffixes = 0;
if (n > 0) {
asl->i.nsuffixes = n;
d = (SufDesc*)M1alloc(n*sizeof(SufDesc));
memset(asl->i.nsuff, 0, 4*sizeof(int));
for(i = 0; i < n; i++)
asl->i.nsuff[sd[i].kind & ASL_Sufkind_mask]++;
for(i = 0; i < 4; i++)
if (j = asl->i.nsuff[i])
asl->i.suffixes[i] = d += j;
memset(dnext, 0, 4*sizeof(SufDesc*));
for(sde = sd + n; sd < sde; sd++) {
d = --asl->i.suffixes[i = sd->kind & ASL_Sufkind_mask];
d->next = dnext[i];
dnext[i] = d;
d->sufname = sd->name;
d->table = sd->table;
d->kind = sd->kind & ~ASL_Sufkind_input;
d->nextra = sd->nextra;
d->u.i = 0;
d->u.r = 0;
}
}
}
int *
get_vminv_ASL(ASL *asl)
{
int i, j, n, nv, *vm, *x;
if ((x = asl->i.vminv))
return x;
if (!(vm = asl->i.vmap))
vm = get_vcmap_ASL(asl, ASL_Sufkind_var);
n = asl->i.n_var0 + asl->i.nsufext[ASL_Sufkind_var];
x = (int*)M1alloc(n*sizeof(int));
for(i = 0; i < n; ++i)
x[i] = -1;
nv = n_var;
for(i = 0; i < nv; ++i) {
if ((j = vm[i]) >= 0)
x[j] = i;
}
j = n;
for(i = 0; i < n; ++i) {
if (x[i] < 0)
x[i] = j++;
}
return asl->i.vminv = x;
}
int
jac1dim_ASL(ASL *asl, const char *stub, fint *M, fint *N, fint *NO, fint *NZ,
fint *MXROW, fint *MXCOL, ftnlen stub_len)
{
FILE *nl;
nl = jac_dim_ASL(asl, stub, M, N, NO, NZ, MXROW, MXCOL, stub_len);
if (!nl)
return ASL_readerr_nofile;
X0 = (real *)M1alloc(n_var*sizeof(real));
return fg_read_ASL(asl, nl, ASL_return_read_err);
}
mem_ASL(ASL *asl, unsigned int len)
#endif
{
fint k;
char *memNext;
if (len >= 256)
return M1alloc(len);
#ifdef Double_Align
len = (len + (sizeof(real)-1)) & ~(sizeof(real)-1);
#else
len = (len + (sizeof(int)-1)) & ~(sizeof(int)-1);
#endif
ACQUIRE_DTOA_LOCK(MEM_LOCK);
memNext = asl->i.memNext;
if (memNext + len >= asl->i.memLast) {
memNext = (char *)M1alloc(k = Egulp*Sizeof(expr) + len);
asl->i.memLast = memNext + k;
}
asl->i.memNext = memNext + len;
FREE_DTOA_LOCK(MEM_LOCK);
return memNext;
}
static void
AtReset1(AmplExports *ae, Exitfunc *ef, void *v, ExitCallInfo *eci)
{
Exitcall *ec;
ASL *asl = (ASL*)ae->asl;
if (eci) {
eci->cur = asl->i.arprev;
eci->curp = &asl->i.arprev;
eci->last = asl->i.arlast;
eci->lastp = &asl->i.arlast;
}
if (asl->i.arnext >= asl->i.arlast) {
asl->i.arnext = (Exitcall*)M1alloc(NEFB*sizeof(Exitcall));
asl->i.arlast = asl->i.arnext + NEFB;
}
asl->i.arnext->prev = asl->i.arprev;
asl->i.arprev = ec = asl->i.arnext++;
ec->ef = ef;
ec->v = v;
}
int *
get_vcmap_ASL(ASL *asl, int k)
{
cgrad **cgp;
int i, m, n, *x;
if ((x = (&asl->i.vmap)[k &= 1]))
return x;
m = 0;
if (k == ASL_Sufkind_con && Cgrad)
m = asl->i.n_con0 + asl->i.nsufext[ASL_Sufkind_con];
n = (&asl->i.n_var0)[k] + asl->i.nsufext[k];
cgp = (cgrad**)M1alloc(m * sizeof(cgrad*) + n*sizeof(int));
x = (&asl->i.vmap)[k] = (int*)(cgp + m);
for(i = 0; i < n; ++i)
x[i] = i;
asl->p.Conival = conivalmap;
asl->p.Congrd = congrdmap;
if (m)
memcpy(asl->i.Cgrad0 = cgp, Cgrad, m*sizeof(cgrad*));
return x;
}
void *jampl_init(char *stub) {
ASL_pfgh *asl = (ASL_pfgh*)ASL_alloc(ASL_read_pfgh);
if (!asl) return NULL;
FILE *ampl_file = jac0dim(stub, (fint)strlen(stub));
// Allocate room to store problem data
if (! (asl->i.X0_ = (real *)M1alloc(asl->i.n_var_ * sizeof(real)))) return NULL;
if (! (asl->i.LUv_ = (real *)M1alloc(asl->i.n_var_ * sizeof(real)))) return NULL;
if (! (asl->i.Uvx_ = (real *)M1alloc(asl->i.n_var_ * sizeof(real)))) return NULL;
if (! (asl->i.pi0_ = (real *)M1alloc(asl->i.n_con_ * sizeof(real)))) return NULL;
if (! (asl->i.LUrhs_ = (real *)M1alloc(asl->i.n_con_ * sizeof(real)))) return NULL;
if (! (asl->i.Urhsx_ = (real* )M1alloc(asl->i.n_con_ * sizeof(real)))) return NULL;
// Read in ASL structure
asl->i.want_xpi0_ = 3; // Read primal and dual estimates
pfgh_read(ampl_file , 0); // pfgh_read closes the file.
return (void *)asl;
}
main(int argc, char **argv)
#endif
{
char *stub;
ASL *asl;
FILE *nl;
lprec *lp;
ograd *og;
int ct, i, intmin, *is, j, j0, j1, k, nalt, rc;
short *basis, *lower;
real *LU, *c, lb, objadj, *rshift, *shift, t, ub, *x, *x0, *x1;
char buf[256];
typedef struct { char *msg; int code; } Sol_info;
static Sol_info solinfo[] = {
{ "optimal", 0 },
{ "integer programming failure", 502 },
{ "infeasible", 200 },
{ "unbounded", 300 },
{ "failure", 501 },
{ "bug", 500 }
};
sprintf(lp_solve_version+9, "%.*s", (int)sizeof(lp_solve_version)-10,
PATCHLEVEL);
sprintf(lp_solve_vversion, "%s, driver(20001002)", lp_solve_version);
asl = ASL_alloc(ASL_read_f);
stub = getstub(&argv, &Oinfo);
nl = jac0dim(stub, (fint)strlen(stub));
suf_declare(suftab, sizeof(suftab)/sizeof(SufDecl));
/* set A_vals to get the constraints column-wise */
A_vals = (real *)M1alloc(nzc*sizeof(real));
f_read(nl,0);
lp = make_lp(n_con, 0);
Oinfo.uinfo = (char *)lp;
if (getopts(argv, &Oinfo))
return 1;
i = n_var + n_con + 1;
x = (real*)M1alloc(i*sizeof(real)); /* scratch vector */
memset(x, 0, i*sizeof(real));
x0 = x++;
c = x + n_con;
/* supply objective */
objadj = 0;
if (--nobj >= 0 && nobj < n_obj) {
for(og = Ograd[nobj]; og; og = og->next)
c[og->varno] = og->coef;
if (objtype[nobj])
set_maxim(lp);
objadj = objconst(nobj);
}
/* supply columns and variable bounds */
LU = LUv;
intmin = n_var - (nbv + niv);
j1 = nalt = 0;
rshift = shift = 0;
for(i = 1; i <= n_var; i++, LU += 2) {
lb = LU[0];
ub = LU[1];
j0 = j1;
j1 = A_colstarts[i];
*x0 = *c++; /* cost coefficient */
if (lb <= negInfinity && ub < Infinity) {
/* negate this variable */
nalt++;
lb = -ub;
ub = -LU[0];
for(j = j0; j < j1; j++)
x[A_rownos[j]] = -A_vals[j];
*x0 = -*x0;
add_column(lp, x0);
if (lb)
goto shift_check;
}
else {
for(j = j0; j < j1; j++)
x[A_rownos[j]] = A_vals[j];
add_column(lp, x0);
if (lb <= negInfinity) {
nalt++;
if (i > intmin)
set_int(lp, lp->columns, TRUE);
/* split free variable */
*x0 = -*x0;
for(j = j0; j < j1; j++)
x[A_rownos[j]] *= -1.;
add_column(lp,x0);
}
else if (lb) {
shift_check:
if (lb > 0)
set_lowbo(lp, lp->columns, lb);
else {
if (!rshift) {
rshift = (real*)M1zapalloc(
(n_var+n_con)*sizeof(real));
shift = rshift + n_con - 1;
}
shift[i] = lb;
for(j = j0; j < j1; j++) {
k = A_rownos[j];
rshift[k] += lb*x[k];
}
if (ub < Infinity)
ub -= lb;
objadj += lb**x0;
}
}
if (ub < Infinity)
set_upbo(lp, lp->columns, ub);
}
for(j = j0; j < j1; j++)
x[A_rownos[j]] = 0;
if (i > intmin)
set_int(lp, lp->columns, TRUE);
}
if (objadj) {
/* add a fixed variable to adjust the objective value */
*x0 = objadj;
add_column(lp, x0);
set_lowbo(lp, i, 1.);
set_upbo(lp, i, 1.);
}
/* supply constraint rhs */
LU = LUrhs;
for(i = 1; i <= n_con; i++, LU += 2) {
t = LU[0];
if (t == LU[1])
ct = EQ;
else if (t <= negInfinity) {
t = LU[1];
if (t >= Infinity) {
/* This is possible only with effort: */
/* one must turn presolve off and */
/* explicitly specify a constraint */
/* with infinite bounds. */
fprintf(Stderr,
"Sorry, can't handle free rows.\n");
exit(1);
}
ct = LE;
}
else
ct = GE;
set_constr_type(lp, i, ct);
set_rh(lp, i, rshift ? t - *rshift++ : t);
if (ct == GE && LU[1] < Infinity)
lp->orig_upbo[i] = LU[1] - t;
}
if (prlp)
print_lp(lp);
if (scaling)
auto_scale(lp);
/* Unfortunately, there seems to be no way to suggest */
/* a starting basis to lp_solve; thus we must ignore */
/* any incoming .sstatus values. */
rc = solve(lp);
if (rc < 0 || rc > 5)
rc = 5;
solve_result_num = solinfo[rc].code;
i = sprintf(buf, "%s: %s", Oinfo.bsname, solinfo[rc].msg);
if (rc == OPTIMAL)
i += sprintf(buf+i, ", objective %.*g", obj_prec(),
lp->best_solution[0]);
i += sprintf(buf+i,"\n%d simplex iterations", lp->total_iter);
if (lp->max_level > 1 || lp->total_nodes > 1)
sprintf(buf+i, "\n%d branch & bound nodes: depth %d",
lp->total_nodes, lp->max_level);
/* Prepare to report solution: deal with split free variables. */
x1 = lp->best_solution+lp->rows+1;
if (nalt || shift) {
x = x0;
LU = LUv;
for(i = 0; i < n_var; i++, LU += 2) {
if (LU[0] > negInfinity)
x[i] = *x1++;
else if (LU[1] < Infinity)
x[i] = -*x1++;
else {
x[i] = x1[0] - x1[1];
x1 += 2;
}
if (shift)
x[i] += *++shift;
}
}
else
x = x1;
if (solinfo[rc].code < 500 && !(nbv + niv)) {
/* return .sstatus values */
basis = lp->basis;
lower = lp->lower;
is = M1alloc((n_var + n_con)*sizeof(int));
suf_iput("sstatus", ASL_Sufkind_con, is);
for(i = 0; i < n_con; i++) {
j = *++lower;
*is++ = *++basis ? 1 : j ? 3 : 4;
}
suf_iput("sstatus", ASL_Sufkind_var, is);
LU = LUv;
for(i = 0; i < n_var; i++, LU += 2) {
j0 = *++basis;
j1 = *++lower;
if (LU[0] > negInfinity)
j = j0 ? 1 : j1 ? 3 : 4;
else if (LU[1] < Infinity)
j = j0 ? 1 : j1 ? 4 : 3;
else {
++lower;
j = *++basis || j0;
}
*is++ = j;
}
}
write_sol(buf, x, lp->duals+1, &Oinfo);
/* The following calls would only be needed */
/* if execution were to continue... */
delete_lp(lp);
ASL_free(&asl);
return 0;
}
void mexFunction(int nlhs, mxArray *plhs[], int nrhs, const mxArray *prhs[])
{
//Possible Inputs
char fpath[FLEN];
char msg[FLEN];
char cmd[FLEN]; //user commmand
int sp = 0;
//Outputs
const char *fnames[15] = {"H","f","lb","ub","A","cl","cu","Q","l","qcind","x0","v0","sense","objbias","conlin"};
double *sizes;
//Internal Vars
int ii; size_t i,j,k; //indexing vars
char *what, **whatp; //error message vars
static FILE *nl; //file handle
ASL *asl = cur_ASL; //Current ASL instance
int icmd = ASLCMD_ERROR; //Command Integer
double *sense; //Objective sense
double *objbias; //Objective bias
int obj_lin; //linearity of the objectiuve (see ASL_DEGREE_ defines)
double *con_lin; //linearity of the constraints (see ASL_DEGREE_ defines)
double *isopen; //Is ASL open
bool nlcon = false; //indicates whether any constraint is nonlinear
double *x; //Evaluation point
double *f, *g, *c = NULL; //Return pointers
int nerror; //eval errors
//Sparse Indexing
mwIndex *Ir, *Jc;
double *Pr;
//QP Checking Vars
int nqpz = 0; //number of nzs in quadratic objective
int nqc_con = 0; //number of quadratic constraints
int *QP_ir, *QP_jc; //Pointers used when calling nqpcheck
double *QP_pr;
double *pqi; //pointer to quadratic index vector
ograd *og; //objective gradient structure
//Jacobian Vars
static double *J = NULL; //Memory to store intermediate Jacobian Values when using Dense Mode
static double *J1 = NULL; //Memory to store Jacobian Values
cgrad *cg, **cgp, **cgpe; //constraint gradient structures
int *cs; //Column starts
//Hessian Vars
static double *Hsp = NULL; //Memory to store Hessian Values
static int nhnz; //Number of Hessian nz
double *s, *v; //Sigma, Lambda
int *hcs, *hr; //Hessian column starts, row indexs
double *H, *He, *W;
//Error catching
Jmp_buf err_jmp0;
//If no inputs, just return info
if(nrhs < 1)
{
if (nlhs >= 1)
{
sprintf(msgbuf,"%s %s",__TIME__,__DATE__);
plhs[0] = mxCreateString(msgbuf);
plhs[1] = mxCreateDoubleScalar(OPTI_VER);
}
else
{
printUtilityInfo();
}
return;
}
//Get User Command
icmd = getCommand(prhs[0]);
//Switch Yard for Command
switch(icmd)
{
case ASLCMD_ISOPEN:
isopen = mxGetPr(plhs[0] = mxCreateDoubleMatrix(1, 1, mxREAL));
if(asl)
*isopen = 1;
else
*isopen = 0;
break;
case ASLCMD_OPEN:
//Check for Errors
if(nrhs < 2)
mexErrMsgTxt("Expected two arguments to open a file! [x0,v0,lb,ub,cl,cu,sense,sizes] = asl('open','file path')\n");
if(!mxIsChar(prhs[1]))
mexErrMsgTxt("File path must be a char array!");
//Get String
CHECK(mxGetString(prhs[1], fpath, FLEN) == 0,"error reading file path!");
//Clear any existing objects
if (cur_ASL)
ASL_free(&cur_ASL);
//Set MEX exit function
mexAtExit(mexExit);
//Open file for LP/QP/QCQP checking
asl = ASL_alloc(ASL_read_fg); //allocate for qp read
return_nofile = 1; //return 0 if stub doesn't exist
nl = jac0dim(fpath,(ftnlen)strlen(fpath)); //read in passed file
//Check we got the file
if(!nl) {
sprintf(msgbuf, "Can't open (or error opening) %s\n", fpath);
mexErrMsgTxt(msgbuf);
}
//Allocate Vector Memory
pPROB = mxCreateStructMatrix(1,1,15,fnames);
mxSetField(pPROB,0,fnames[eX0],mxCreateDoubleMatrix(n_var,1, mxREAL));
mxSetField(pPROB,0,fnames[eV0],mxCreateDoubleMatrix(n_con, 1, mxREAL));
mxSetField(pPROB,0,fnames[eLB],mxCreateDoubleMatrix(n_var, 1, mxREAL));
mxSetField(pPROB,0,fnames[eUB],mxCreateDoubleMatrix(n_var, 1, mxREAL));
mxSetField(pPROB,0,fnames[eCL],mxCreateDoubleMatrix(n_con, 1, mxREAL));
mxSetField(pPROB,0,fnames[eCU],mxCreateDoubleMatrix(n_con, 1, mxREAL));
mxSetField(pPROB,0,fnames[eSENSE],mxCreateDoubleMatrix(1, 1, mxREAL));
mxSetField(pPROB,0,fnames[eOBJBIAS],mxCreateDoubleMatrix(1, 1, mxREAL));
mxSetField(pPROB,0,fnames[eCONLIN],mxCreateDoubleMatrix(n_con, 1, mxREAL));
//Get Fields (ASL will fill)
X0 = mxGetPr(mxGetField(pPROB,0,fnames[eX0]));
pi0 = mxGetPr(mxGetField(pPROB,0,fnames[eV0]));
LUv = mxGetPr(mxGetField(pPROB,0,fnames[eLB]));
Uvx = mxGetPr(mxGetField(pPROB,0,fnames[eUB]));
LUrhs = mxGetPr(mxGetField(pPROB,0,fnames[eCL]));
Urhsx = mxGetPr(mxGetField(pPROB,0,fnames[eCU]));
sense = mxGetPr(mxGetField(pPROB,0,fnames[eSENSE]));
objbias = mxGetPr(mxGetField(pPROB,0,fnames[eOBJBIAS]));
con_lin = mxGetPr(mxGetField(pPROB,0,fnames[eCONLIN]));
//Other Output Args
sizes = mxGetPr(pSIZE = mxCreateDoubleMatrix(16, 1, mxREAL));
//Check for complementarity problems
if(n_cc)
mexWarnMsgTxt("Ignoring Complementarity Constraints!");
//Assign asl problem sizes
sizes[0] = (double)n_var; sizes[1] = (double)n_con; sizes[2] = (double)nzc;
sizes[3] = (double)lnc; sizes[4] = (double)nbv; sizes[5] = (double)niv;
sizes[6] = (double)nlc; sizes[7] = (double)nlnc; sizes[8] = (double)nlo;
sizes[9] = (double)nlvb; sizes[10] = (double)nlvc; sizes[11] = (double)nlvo;
sizes[12] = (double)nlvbi; sizes[13] = (double)nlvci; sizes[14] = (double)nlvoi;
sizes[15] = (double)nwv;
//Read In For QP Checking
qp_read(nl,0);
//Assign sense
if(objtype[0] == 1)
*sense = -1; //max
else
*sense = 1; //min
//Determine Objective Linearity
obj_lin = linCheck(asl, 0);
//Determine Constraints Linearity
for(ii = 0; ii < n_con; ii++) {
con_lin[ii] = linCheck(asl, -(ii+1));
//Check if nonlinear or quadratic
if(con_lin[ii] >= ASL_DEGREE_NLIN)
nlcon = true;
else if(con_lin[ii] == ASL_DEGREE_QUAD)
{
//con_lin indicates quadratic constraint, ensure is inequality
if(LUrhs[ii] != Urhsx[ii])
nqc_con++;
else
nlcon = true; //quadratic equalities not currently handled by any explicit QCQP solver (I know of), make nl
}
}
//Check to force to read as nonlinear problem
if(nrhs > 2 && *mxGetPr(prhs[2])==1)
nlcon = true;
//If objective or any constraint is nonlinear, then we have to process as an NLP
if(obj_lin == ASL_DEGREE_NLIN || nlcon) {
//Free the QP read memory
ASL_free(&asl);
//Re-open for full NLP read
asl = ASL_alloc(ASL_read_pfgh); //allocate memory for pfgh read
nl = jac0dim(fpath,(ftnlen)strlen(fpath)); //read passed file (full nl read)
//Allocate Jacobian Memory [note use M1alloc to let ASL clean it up if multiple instances opened]
J = (double*)M1alloc(nzc*sizeof(double)); //Memory to store Jacobian nzs
//Assign memory for saving obj + con x
objx = (double*)M1alloc(n_var*sizeof(double));
conx = (double*)M1alloc(n_var*sizeof(double));
//Read File (f + g + H)
pfgh_read(nl, ASL_findgroups);
//Assign Hessian Memory
nhnz = sphsetup(1, 1, n_con > 0, 0); //one obj, use sigma, optionally use lambda, full hessian
Hsp = (double*)M1alloc(nhnz*sizeof(double)); //memory to store hessian nzs
}
//Otherwise we can process as a LP, QP or QCQP
else {
//Assign objective bias
*objbias = objconst(0);
//Check for quadratic objective
if(obj_lin == ASL_DEGREE_QUAD) {
//Capture Pointers
nqpz = nqpcheck(0, &QP_ir, &QP_jc, &QP_pr); //check objective for qp
//Create QP H
mxSetField(pPROB,0,fnames[eH],mxCreateSparse(n_var,n_var,nqpz,mxREAL));
//Copy in Objective Quadratic Elements (copy-cast where appropriate)
memcpy(mxGetPr(mxGetField(pPROB,0,fnames[eH])),QP_pr,nqpz*sizeof(double));
Jc = mxGetJc(mxGetField(pPROB,0,fnames[eH]));
Ir = mxGetIr(mxGetField(pPROB,0,fnames[eH]));
for(i = 0; i <= n_var; i++)
Jc[i] = (mwIndex)QP_jc[i];
for(i = 0; i < nqpz; i++)
Ir[i] = (mwIndex)QP_ir[i];
}
else //create an empty sparse matrix
mxSetField(pPROB,0,fnames[eH],mxCreateSparse(n_var,n_var,0,mxREAL));
//Create QP f
mxSetField(pPROB,0,fnames[eF],mxCreateDoubleMatrix(n_var,1,mxREAL));
Pr = mxGetPr(mxGetField(pPROB,0,fnames[eF]));
//Copy in Objective Linear Elements
for( og = Ograd[0]; og; og = og->next )
Pr[og->varno] = og->coef;
//Create A (linear constraints)
mxSetField(pPROB,0,fnames[eA],mxCreateSparse(n_con, n_var, nzc, mxREAL));
if(n_con) {
Pr = mxGetPr(mxGetField(pPROB,0,fnames[eA]));
Ir = mxGetIr(mxGetField(pPROB,0,fnames[eA]));;
//Fill in A (will double on quadratic linear sections, but easier to remove once in MATLAB)
for(Jc = mxGetJc(mxGetField(pPROB,0,fnames[eA])), cs = A_colstarts, i = 0; i <= n_var; ++i)
Jc[i] = (mwIndex)cs[i];
cgp = Cgrad;
for(i = 0; i < n_con; i++)
for(cg = *cgp++; cg; cg = cg->next) {
Ir[cg->goff] = (mwIndex)i;
Pr[cg->goff] = cg->coef;
}
}
//Add quadratic constraints if present
if(nqc_con) {
//Allocate a Cell Array to store the quadratic constraint Qs, and vector to store indices
mxSetField(pPROB,0,fnames[eQ],mxCreateCellMatrix(nqc_con,1)); //Q
mxSetField(pPROB,0,fnames[eL],mxCreateDoubleMatrix(n_var, nqc_con,mxREAL)); //l
mxSetField(pPROB,0,fnames[eQCIND],mxCreateDoubleMatrix(nqc_con,1,mxREAL)); //ind
pqi = mxGetPr(mxGetField(pPROB,0,fnames[eQCIND]));
//Fill In Constraints
for(ii=0,j=0;ii<n_con;ii++) {
//Quadratic Constraints
if(con_lin[ii] == ASL_DEGREE_QUAD) {
//Create index
pqi[j] = ii+1; //increment for matlab index
//Capture Pointers
nqpz = nqpcheck(-(ii+1), &QP_ir, &QP_jc, &QP_pr); //check constraint for qp;
if(nqpz <= 0)
mexErrMsgTxt("Error reading quadratic constraints. Assumed constraint was quadratic based on prescan, now appears not?");
//Create QC Q
mxSetCell(mxGetField(pPROB,0,fnames[eQ]),j,mxCreateSparse(n_var,n_var,nqpz,mxREAL));
//Copy in Constraint Quadratic Elements (copy-cast where appropriate)
Pr = mxGetPr(mxGetCell(mxGetField(pPROB,0,fnames[eQ]),j));
Jc = mxGetJc(mxGetCell(mxGetField(pPROB,0,fnames[eQ]),j));
Ir = mxGetIr(mxGetCell(mxGetField(pPROB,0,fnames[eQ]),j));
for(k = 0; k <= n_var; k++)
Jc[k] = (mwIndex)QP_jc[k];
for(k = 0; k < nqpz; k++) {
Ir[k] = (mwIndex)QP_ir[k];
Pr[k] = 0.5*QP_pr[k]; //to QP form
}
//Create QC l (not sure why we can't extract this from Jacobian, values are wrong)
Pr = mxGetPr(mxGetField(pPROB,0,fnames[eL]));
for( cg = Cgrad[ii]; cg; cg = cg->next )
Pr[j*n_var + cg->varno] = cg->coef;
//Increment for next cell / col
j++;
}
}
}
//Put back into function eval mode (just in case)
qp_opify();
}
break;
case ASLCMD_CLOSE:
//Check for Errors
CHECKASL(asl);
//Call Exit Function
mexExit();
break;
case ASLCMD_FUN:
//Check for Errors
CHECKASL(asl);
CHECKNRHS(nrhs,2);
//Get x and check dimensions
x = sizechk(prhs[1],"x",n_var);
//Save x
if(objx) memcpy(objx,x,n_var*sizeof(double));
//Create objective val memory and get it from ASL
SETERRJMP(); what = "objective";
f = mxGetPr(plhs[0] = mxCreateDoubleMatrix(1, 1, mxREAL));
*f = objval(0, x, &nerror);
break;
case ASLCMD_GRAD:
//Check for Errors
CHECKASL(asl);
CHECKNRHS(nrhs,2);
//Get x and check dimensions
x = sizechk(prhs[1],"x",n_var);
//Save x
if(objx) memcpy(objx,x,n_var*sizeof(double));
//Create objective grad memory and get it from ASL
SETERRJMP(); what = "gradient";
g = mxGetPr(plhs[0] = mxCreateDoubleMatrix(1, n_var, mxREAL));
objgrd(0, x, g, &nerror);
break;
case ASLCMD_CON:
//Check for Errors
CHECKASL(asl);
CHECKNRHS(nrhs,2);
//Get x and check dimensions
x = sizechk(prhs[1],"x",n_var);
//Save x
if(conx) memcpy(conx,x,n_var*sizeof(double));
//Create constraint memory and get it from ASL
SETERRJMP(); what = "constraints";
c = mxGetPr(plhs[0] = mxCreateDoubleMatrix(n_con, 1, mxREAL));
if(n_con)
conval(x, c, &nerror);
break;
case ASLCMD_JAC:
//Check for Errors
CHECKASL(asl);
CHECKNRHS(nrhs,2);
//Get x and check dimensions
x = sizechk(prhs[1],"x",n_var);
//Save x
if(conx) memcpy(conx,x,n_var*sizeof(double));
//Create constraint jac memory and get it from ASL
SETERRJMP(); what = "Jacobian";
//Check for sparsity
if(nrhs > 2 && *mxGetPr(prhs[2])) {
sp = 1;
J1 = mxGetPr(plhs[0] = mxCreateSparse(n_con, n_var, nzc, mxREAL));
}
else {
sp = 0;
J1 = mxGetPr(plhs[0] = mxCreateDoubleMatrix(n_con, n_var, mxREAL));
}
//Evaluate if we have constraints
if (n_con) {
//Sparse
if(sp) {
jacval(x, J1, &nerror);
Ir = mxGetIr(plhs[0]);
for(Jc = mxGetJc(plhs[0]), cs = A_colstarts, i = 0; i <= n_var; ++i)
Jc[i] = (mwIndex)cs[i];
cgp = Cgrad;
for(i = 0; i < n_con; i++)
for(cg = *cgp++; cg; cg = cg->next)
Ir[cg->goff] = (mwIndex)i;
}
//Dense
else {
jacval(x, J, &nerror);
cgp = Cgrad;
for(cgpe = cgp + n_con; cgp < cgpe; J1++)
for(cg = *cgp++; cg; cg = cg->next)
J1[n_con*cg->varno] = J[cg->goff];
}
}
break;
case ASLCMD_JACSTR:
//Check for Errors
CHECKASL(asl);
CHECKNRHS(nrhs,1);
//Create constraint jacstr memory and get it from ASL
SETERRJMP(); what = "Jacobian Structure)";
J1 = mxGetPr(plhs[0] = mxCreateSparse(n_con, n_var, nzc, mxREAL));
//Fill In Structure
for(i=0;i<nzc;i++)
J1[i] = 1.0;
for(Jc = mxGetJc(plhs[0]), cs = A_colstarts, i = 0; i <= n_var; ++i)
Jc[i] = (mwIndex)cs[i];
cgp = Cgrad;
Ir = mxGetIr(plhs[0]);
for(i = 0; i < n_con; i++)
for(cg = *cgp++; cg; cg = cg->next)
Ir[cg->goff] = (mwIndex)i;
break;
case ASLCMD_HES:
//Check for Errors
CHECKASL(asl);
CHECKNRHS(nrhs,4); //assume hess(x,sigma,lambda) and optionally sparse
//Check dimensions & get args
x = sizechk(prhs[1],"x",n_var);
s = sizechk(prhs[2],"sigma",1);
v = sizechk(prhs[3],"lambda",n_con);
//Check for sparsity
if(nrhs > 4 && *mxGetPr(prhs[4])) {
sp = 1;
W = mxGetPr(plhs[0] = mxCreateSparse(n_var, n_var, nhnz, mxREAL));
}
else {
sp = 0;
W = mxGetPr(plhs[0] = mxCreateDoubleMatrix(n_var, n_var, mxREAL));
}
//Check if we need to recalculate objective / constraints
if(!comp_x(objx,x,n_var)) {
//Setup Error Catching
SETERRJMP(); what = "Objective for Hessian";
//Re-evaluate Objective
objval(0, x, &nerror);
}
if(!comp_x(conx,x,n_var)){
if(!c)
c = mxGetPr(mxCreateDoubleMatrix(n_con, 1, mxREAL));
//Setup Error Catching
SETERRJMP(); what = "Constraints for Hessian";
//Re-evaluate Constraints
conval(x, c, &nerror);
}
//Setup Error Catching
SETERRJMP(); what = "Hessian";
//Sparse
if(sp) {
//This function returns the full (symmetric) Hessian as setup above
sphes(H = Hsp, 1, s, v);
Ir = mxGetIr(plhs[0]);
Jc = mxGetJc(plhs[0]);
hcs = sputinfo->hcolstarts;
hr = sputinfo->hrownos;
for(i = 0; i <= n_var; i++)
Jc[i] = (mwIndex)hcs[i];
He = H + hcs[n_var];
while(H < He) {
*W++ = *H++;
*Ir++ = (mwIndex)*hr++;
}
}
//Dense
else
fullhes(W, n_var, 1, s, v);
break;
case ASLCMD_HESSTR:
//mexPrintf("CMD: Get Hessian Structure\n");
//Check for Errors
CHECKASL(asl);
CHECKNRHS(nrhs,1);
//Create hessianstr memory and get it from ASL
SETERRJMP(); what = "Hessian Structure";
W = mxGetPr(plhs[0] = mxCreateSparse(n_var, n_var, nhnz, mxREAL));
Ir = mxGetIr(plhs[0]);
Jc = mxGetJc(plhs[0]);
//Get Sparse Info
hcs = sputinfo->hcolstarts;
hr = sputinfo->hrownos;
//Assign col starts
for(i = 0; i <= n_var; i++)
Jc[i] = (mwIndex)hcs[i];
//Assign rows + 1.0 for nz positions
H = Hsp; //Start of nz Hsp elements
He = H + hcs[n_var]; //End of nz Hsp elements
while(H < He) {
*W++ = 1.0;
*Ir++ = (mwIndex)*hr++;
*H++; //increment nz element position
}
break;
case ASLCMD_WRITESOL:
//Check for Errors
CHECKASL(asl);
CHECKNRHS(nrhs,2); //asl('writesol',msg,x)
//Get Input Args
CHECK(mxGetString(prhs[1], msg, FLEN) == 0,"error reading message!");
x = sizechk(prhs[2],"x",n_var);
//Write to solution stub file
write_sol(msg,x,NULL,NULL);
break;
default:
mexExit(); //clean up
mxGetString(prhs[0], cmd, FLEN);
sprintf(msgbuf, "ASL Command Error! Unknown Command: '%s'\n", cmd);
mexErrMsgTxt(msgbuf);
break;
}
}
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;
}
void
mexFunction(int nlhs, mxArray *plhs[], int nrhs, const mxArray *prhs[])
{
FILE *nl;
char *buf1, buf[512], *what, **whatp;
static fint n, nc, nz;
fint i, nerror;
real *J1, *W, *c, *f, *g, *v, *t, *x;
static real *J;
cgrad *cg, **cgp, **cgpe;
static size_t Jsize;
Jmp_buf err_jmp0;
ASL *asl = cur_ASL;
static char ignore_complementarity[] =
"Warning: ignoring %d complementarity conditions.\n";
if (nrhs == 1 && mxIsChar(prhs[0])) {
if (nlhs < 6 || nlhs > 7)
usage();
if (mxGetString(prhs[0], buf1 = buf, sizeof(buf)))
mexErrMsgTxt("Expected 'stub' as argument\n");
at_end();
mexAtExit(at_end);
asl = ASL_alloc(ASL_read_pfgh);
return_nofile = 1;
if (!(nl = jac0dim(buf1,strlen(buf)))) {
sprintf(msgbuf, "Can't open %.*s\n",
sizeof(msgbuf)-20, buf);
mexErrMsgTxt(msgbuf);
}
if (n_obj <= 0)
printf("Warning: objectve == 0\n");
n = n_var;
nc = n_con;
nz = nzc;
J = (real *)M1alloc(nz*sizeof(real));
X0 = mxGetPr(plhs[0] = mxCreateDoubleMatrix(n, 1, mxREAL));
LUv = mxGetPr(plhs[1] = mxCreateDoubleMatrix(n, 1, mxREAL));
Uvx = mxGetPr(plhs[2] = mxCreateDoubleMatrix(n, 1, mxREAL));
pi0 = mxGetPr(plhs[3] = mxCreateDoubleMatrix(nc, 1, mxREAL));
LUrhs = mxGetPr(plhs[4] = mxCreateDoubleMatrix(nc, 1, mxREAL));
Urhsx = mxGetPr(plhs[5] = mxCreateDoubleMatrix(nc, 1, mxREAL));
if (nlhs == 7) {
cvar = (int*)M1alloc(nc*sizeof(int));
plhs[6] = mxCreateDoubleMatrix(nc, 1, mxREAL);
x = mxGetPr(plhs[6]);
}
else if (n_cc)
printf(ignore_complementarity, n_cc);
pfgh_read(nl, ASL_findgroups);
Jsize = nc*n*sizeof(real);
if (nlhs == 7)
for(i = 0; i < nc; i++)
x[i] = cvar[i];
return;
}
if (!asl)
mexErrMsgTxt("amplfunc(\"stub\") has not been called\n");
nerror = -1;
err_jmp1 = &err_jmp0;
what = "(?)";
whatp = &what;
if (nlhs == 2) {
if (nrhs != 2)
usage();
x = sizechk(prhs[0],"x",n);
t = sizechk(prhs[1],"0 or 1", 1);
if (setjmp(err_jmp0.jb)) {
sprintf(msgbuf, "Trouble evaluating %s\n", *whatp);
mexErrMsgTxt(msgbuf);
}
if (t[0] == 0.) {
f = mxGetPr(plhs[0] = mxCreateDoubleMatrix(1, 1, mxREAL));
c = mxGetPr(plhs[1] = mxCreateDoubleMatrix(nc, 1, mxREAL));
what = "f";
*f = objval(0, x, &nerror);
what = "c";
conval(x, c, &nerror);
return;
}
g = mxGetPr(plhs[0] = mxCreateDoubleMatrix(n, 1, mxREAL));
J1 = mxGetPr(plhs[1] = mxCreateDoubleMatrix(nc, n, mxREAL));
what = "g";
objgrd(0, x, g, &nerror);
if (nc) {
memset(J1, 0, Jsize);
what = "J";
jacval(x, J, &nerror);
cgp = Cgrad;
for(cgpe = cgp + nc; cgp < cgpe; J1++)
for(cg = *cgp++; cg; cg = cg->next)
J1[nc*cg->varno] = J[cg->goff];
}
return;
}
if (nlhs == 0 && (nrhs == 3 || nrhs == 4)) {
/* eval2('solution message', x, v): x = primal, v = dual */
/* optional 4th arg = solve_result_num */
if (!mxIsChar(prhs[0]))
usage();
x = sizechk(prhs[1],"x",n);
v = sizechk(prhs[2],"v",nc);
if (mxGetString(prhs[0], buf, sizeof(buf)))
mexErrMsgTxt(
"Expected 'solution message' as first argument\n");
solve_result_num = nrhs == 3 ? -1 /* unknown */
: (int)*sizechk(prhs[3],"solve_result_num",1);
write_sol(buf, x, v, 0);
return;
}
if (nlhs != 1 || nrhs != 1)
usage();
v = sizechk(prhs[0],"v",nc);
W = mxGetPr(plhs[0] = mxCreateDoubleMatrix(n, n, mxREAL));
what = "W";
fullhes(W, n, 0, 0, v);
}
void
mexFunction(int nlhs, mxArray *plhs[], int nrhs, const mxArray *prhs[])
{
ASL_pfgh *asl = (ASL_pfgh*)cur_ASL;
FILE *nl;
Jmp_buf err_jmp0;
cgrad *cg, **cgp;
char *buf1, buf[512], *what, **whatp;
fint *hcs, *hr, i, nerror;
int *cs;
mwIndex *Ir, *Jc;
real *H, *He, *J1, *W, *c, *f, *g, *v, *t, *x;
static fint n, nc, nhnz, nz;
static real *Hsp;
static char ignore_complementarity[] =
"Warning: ignoring %d complementarity conditions.\n";
if (nrhs == 1 && mxIsChar(prhs[0])) {
if (nlhs < 6 || nlhs > 7)
usage();
if (mxGetString(prhs[0], buf1 = buf, sizeof(buf)))
mexErrMsgTxt("Expected 'stub' as argument\n");
at_end();
mexAtExit(at_end);
asl = (ASL_pfgh*)ASL_alloc(ASL_read_pfgh);
return_nofile = 1;
if (!(nl = jac0dim(buf1,strlen(buf)))) {
sprintf(msgbuf, "Can't open %.*s\n",
sizeof(msgbuf)-20, buf);
mexErrMsgTxt(msgbuf);
}
if (n_obj <= 0)
printf("Warning: objectve == 0\n");
n = n_var;
nc = n_con;
nz = nzc;
X0 = mxGetPr(plhs[0] = mxCreateDoubleMatrix(n, 1, mxREAL));
LUv = mxGetPr(plhs[1] = mxCreateDoubleMatrix(n, 1, mxREAL));
Uvx = mxGetPr(plhs[2] = mxCreateDoubleMatrix(n, 1, mxREAL));
pi0 = mxGetPr(plhs[3] = mxCreateDoubleMatrix(nc, 1, mxREAL));
LUrhs = mxGetPr(plhs[4] = mxCreateDoubleMatrix(nc, 1, mxREAL));
Urhsx = mxGetPr(plhs[5] = mxCreateDoubleMatrix(nc, 1, mxREAL));
if (nlhs == 7) {
cvar = (int*)M1alloc(nc*sizeof(int));
plhs[6] = mxCreateDoubleMatrix(nc, 1, mxREAL);
x = mxGetPr(plhs[6]);
}
else if (n_cc)
printf(ignore_complementarity, n_cc);
pfgh_read(nl, ASL_findgroups);
if (nlhs == 7)
for(i = 0; i < nc; i++)
x[i] = cvar[i];
/* Arrange to compute the whole sparese Hessian */
/* of the Lagrangian function (both triangles). */
nhnz = sphsetup(0, 0, nc > 0, 0);
Hsp = (real *)M1alloc(nhnz*sizeof(real));
return;
}
if (!asl)
mexErrMsgTxt("spamfunc(\"stub\") has not been called\n");
nerror = -1;
err_jmp1 = &err_jmp0;
what = "(?)";
whatp = &what;
if (nlhs == 2) {
if (nrhs != 2)
usage();
x = sizechk(prhs[0],"x",n);
t = sizechk(prhs[1],"0 or 1", 1);
if (setjmp(err_jmp0.jb)) {
sprintf(msgbuf, "Trouble evaluating %s\n", *whatp);
mexErrMsgTxt(msgbuf);
}
if (t[0] == 0.) {
f = mxGetPr(plhs[0] = mxCreateDoubleMatrix(1, 1, mxREAL));
c = mxGetPr(plhs[1] = mxCreateDoubleMatrix(nc, 1, mxREAL));
what = "f";
*f = n_obj > 0 ? objval(0, x, &nerror) : 0;
what = "c";
conval(x, c, &nerror);
return;
}
g = mxGetPr(plhs[0] = mxCreateDoubleMatrix(n, 1, mxREAL));
J1 = mxGetPr(plhs[1] = mxCreateSparse(nc, n, nz, mxREAL));
what = "g";
if (n_obj > 0)
objgrd(0, x, g, &nerror);
else
memset(g, 0, n*sizeof(real));
if (nc) {
what = "J";
jacval(x, J1, &nerror);
Ir = mxGetIr(plhs[1]);
/*memcpy(mxGetJc(plhs[1]), A_colstarts, (n+1)*sizeof(int));*/
for(Jc = mxGetJc(plhs[1]), cs = A_colstarts, i = 0; i <= n; ++i)
Jc[i] = cs[i];
cgp = Cgrad;
for(i = 0; i < nc; i++)
for(cg = *cgp++; cg; cg = cg->next)
Ir[cg->goff] = i;
}
return;
}
if (nlhs == 0 && (nrhs == 3 || nrhs == 4)) {
/* eval2('solution message', x, v): x = primal, v = dual */
/* optional 4th arg = solve_result_num */
if (!mxIsChar(prhs[0]))
usage();
x = sizechk(prhs[1],"x",n);
v = sizechk(prhs[2],"v",nc);
if (mxGetString(prhs[0], buf, sizeof(buf)))
mexErrMsgTxt(
"Expected 'solution message' as first argument\n");
solve_result_num = nrhs == 3 ? -1 /* unknown */
: (int)*sizechk(prhs[3],"solve_result_num",1);
write_sol(buf, x, v, 0);
return;
}
if (nlhs != 1 || nrhs != 1)
usage();
v = sizechk(prhs[0],"v",nc);
W = mxGetPr(plhs[0] = mxCreateSparse(n, n, nhnz, mxREAL));
what = "W";
sphes(H = Hsp, 0, 0, v);
/* Expand the Hessian lower triangle into the full Hessian... */
Ir = mxGetIr(plhs[0]);
Jc = mxGetJc(plhs[0]);
hcs = sputinfo->hcolstarts;
hr = sputinfo->hrownos;
for(i = 0; i <= n; i++)
Jc[i] = hcs[i];
He = H + hcs[n];
while(H < He) {
*W++ = *H++;
*Ir++ = *hr++;
}
}
jac0dim_ASL(ASL *asl, char *stub, ftnlen stub_len)
#endif
{
FILE *nl;
int i, k, nlv;
char *s, *se;
const char *opfmt;
EdRead ER, *R;
if (!asl)
badasl_ASL(asl,0,"jac0dim");
fpinit_ASL(); /* get IEEE arithmetic, if possible */
if (stub_len <= 0)
for(i = 0; stub[i]; i++);
else
for(i = stub_len; stub[i-1] == ' ' && i > 0; --i);
filename = (char *)M1alloc(i + 5);
s = stub_end = filename + i;
strncpy(filename, stub, i);
strcpy(s, ".nl");
nl = fopen(filename, "rb");
if (!nl && i > 3 && !strncmp(s-3, ".nl", 3)) {
*s = 0;
stub_end = s - 3;
nl = fopen(filename, "rb");
}
if (!nl) {
if (return_nofile)
return 0;
fflush(stdout);
what_prog();
fprintf(Stderr, "can't open %s\n", filename);
exit(1);
}
R = EdReadInit_ASL(&ER, asl, nl, 0);
R->Line = 0;
s = read_line(R);
binary_nl = 0;
opfmt = "%d";
switch(*s) {
#ifdef DEPRECATED
case 'E': /* deprecated "-oe" format */
{int ncsi = 0;
k = Sscanf(s, "E%d %d %d %d %d %d", &n_var, &n_con,
&n_obj, &maxrownamelen, &maxcolnamelen, &ncsi);
if (k < 5)
badints(R, k, 5);
if (ncsi) {
if (ncsi != 6) {
badread(R);
fprintf(Stderr,
"expected 6th integer to be 0 or 6, not %d\n",
ncsi);
exit(1);
}
s = read_line(R);
k = Sscanf(s, " %d %d %d %d %d %d",
&comb, &comc, &como, &comc1, &como1, &nfunc);
if (k != 6)
badints(R, k, 6);
}
}
break;
#endif
case 'z':
case 'Z':
opfmt = "%hd";
case 'B':
case 'b':
binary_nl = 1;
xscanf = bscanf;
goto have_xscanf;
case 'h':
case 'H':
opfmt = "%hd";
binary_nl = 1;
xscanf = hscanf;
goto have_xscanf;
case 'G':
case 'g':
xscanf = ascanf;
have_xscanf:
if ((k = ampl_options[0] = strtol(++s, &se, 10))) {
if (k > 9) {
fprintf(Stderr,
"ampl_options = %d is too large\n", k);
exit(1);
}
for(i = 1; i <= k && se > s; i++)
ampl_options[i] = strtol(s = se,&se,10);
if (ampl_options[2] == 3)
ampl_vbtol = strtod(s = se, &se);
}
s = read_line(R);
n_eqn = -1;
k = Sscanf(s, " %d %d %d %d %d %d", &n_var, &n_con,
&n_obj, &nranges, &n_eqn, &n_lcon);
if (k < 3)
badints(R,k,3);
nclcon = n_con + n_lcon;
/* formerly read2(R, &nlc, &nlo); */
s = read_line(R);
n_cc = nlcc = ndcc = nzlb = 0;
k = Sscanf(s, " %d %d %d %d %d %d", &nlc, &nlo, &n_cc, &nlcc,
&ndcc, &nzlb);
if (k < 2)
badints(R,k,2);
if ((n_cc += nlcc) > 0 && k < 6)
ndcc = -1; /* indicate unknown */
read2(R, &nlnc, &lnc);
nlvb = -1;
s = read_line(R);
k = Sscanf(s, " %d %d %d", &nlvc, &nlvo, &nlvb);
if (k < 2)
badints(R,k,2);
/* read2(R, &nwv, &nfunc); */
s = read_line(R);
asl->i.flags = 0;
k = Sscanf(s, " %d %d %d %d", &nwv, &nfunc, &i,
&asl->i.flags);
if (k < 2)
badints(R,k,2);
else if (k >= 3 && i != Arith_Kind_ASL && i) {
#ifdef Want_bswap
if (i > 0 && i + Arith_Kind_ASL == 3) {
asl->i.iadjfcn = asl->i.dadjfcn = bswap_ASL;
binary_nl = i << 1;
}
else
#endif
badfmt(R);
}
if (nlvb < 0) /* ampl versions < 19930630 */
read2(R, &nbv, &niv);
else {
s = read_line(R);
k = Sscanf(s, " %d %d %d %d %d", &nbv, &niv,
&nlvbi, &nlvci, &nlvoi);
if (k != 5)
badints(R,k,5);
}
/* formerly read2(R, &nzc, &nzo); */
s = read_line(R);
k = Sscanf(s, " %D %D", &nZc, &nZo);
if (k != 2)
badints(R, k, 2);
nzc = nZc;
nzo = nZo;
read2(R, &maxrownamelen, &maxcolnamelen);
s = read_line(R);
k = Sscanf(s, " %d %d %d %d %d", &comb, &comc, &como,
&comc1, &como1);
if (k != 5)
badints(R,k,5);
}
student_check_ASL(asl);
if (n_con < 0 || n_var <= 0 || n_obj < 0) {
what_prog();
fprintf(Stderr,
"jacdim: got M = %d, N = %d, NO = %d\n", n_con, n_var, n_obj);
exit(1);
}
asl->i.opfmt = opfmt;
asl->i.n_var0 = asl->i.n_var1 = n_var;
asl->i.n_con0 = asl->i.n_con1 = n_con;
if ((nlv = nlvc) < nlvo)
nlv = nlvo;
if (nlv <= 0)
nlv = 1;
x0len = nlv * sizeof(real);
x0kind = ASL_first_x;
n_conjac[0] = 0;
n_conjac[1] = n_con;
c_vars = o_vars = n_var; /* confusion arises otherwise */
return nl;
}
int
prob_adj_ASL(ASL *asl)
{
#undef cde
cde *d, *de;
cde2 *d2, *d2e;
cgrad *cg, **pcg, **pcge;
int flags, k;
#ifndef NO_BOUNDSFILE_OPTION /*{*/
FILE *f;
char *bf, buf[4096], *s, *s1, *se;
int a, i, n1, nr, nv, swap;
real *L, *U, *x;
size_t inc, m, n;
#endif /*}*/
if (n_obj)
adjust_zerograds_ASL(asl, 0);
flags = asl->i.rflags;
asl->i.Cgrad0 = asl->i.Cgrad_;
if ((k = asl->i.nsufext[ASL_Sufkind_con])) {
switch(asl->i.ASLtype) {
case ASL_read_f:
case ASL_read_fg:
d = ((ASL_fg*)asl)->I.con_de_;
goto have_d;
case ASL_read_fgh:
d2 = ((ASL_fgh*)asl)->I.con2_de_;
goto have_d2;
case ASL_read_pfg:
d = ((ASL_pfg*)asl)->I.con_de_;
have_d:
d += n_con;
for(de = d + k; d < de; ++d)
d->e = (expr*)&Zero;
break;
case ASL_read_pfgh:
d2 = ((ASL_pfgh*)asl)->I.con2_de_;
have_d2:
d2 += n_con;
for(d2e = d2 + k; d2 < d2e; ++d2)
d2->e = (expr2*)&Zero;
}
}
if (flags & (ASL_obj_replace_eq | ASL_obj_replace_ineq))
obj_adj_ASL(asl);
if (!A_vals) {
if (flags & ASL_cc_simplify && n_cc)
mpec_adjust_ASL(asl);
if (flags & ASL_rowwise_jac) {
pcg = Cgrad;
pcge = pcg + n_con;
k = 0;
while(pcg < pcge)
for(cg = *pcg++; cg; cg = cg->next)
cg->goff = k++;
}
}
if (n_obj)
zerograd_chk(asl);
#ifndef NO_BOUNDSFILE_OPTION /*{*/
if ((bf = asl->i.boundsfile)) {
if (!(f = fopen(bf, "rb")))
bad_bounds(asl, "Cannot open boundsfile \"%s\".", bf);
m = sizeof(buf);
if ((n = fread(buf, 1, m, f)) < 24
|| strncmp(buf, "Bounds, x; arith ", 17)) {
badmagic:
bad_bounds(asl, "Bad magic in boundsfile \"%s\".", bf);
}
a = (int)strtol(s = buf+17, &se, 10);
if (se <= s || a < 0 || a > 2 || *se >= ' ')
goto badmagic;
if (a == 0 && *se == '\r')
++se;
if (*se++ != '\n')
goto badmagic;
nv = n_var;
L = LUv;
if ((U = Uvx))
inc = 1;
else {
U = L + 1;
inc = 2;
}
if (!(x = X0))
X0 = x = (real*)M1alloc(nv*sizeof(real));
swap = 0;
if (a) {
if (a != Arith_Kind_ASL)
swap = 1;
s = buf + 20;
n1 = *(int*)s;
if (swap)
bswap_ASL(&n1, sizeof(n1));
if (n1 != nv) {
bad_n1:
bad_bounds(asl, "Expected %d bounds triples in boundsfile"
" \"%s\"; got %d.", nv, bf, n1);
}
s += sizeof(int);
se = buf + n;
for(i = 1; i <= nv; ++i) {
if (se-s < 3*sizeof(real)) {
for(s1 = buf; s < se; ++s, ++s1)
*s1 = *s;
m = s1 - buf;
m += n = fread(s1, 1, sizeof(buf) - m, f);
se = buf + m;
if (m < 3*sizeof(real)) {
too_few:
bad_bounds(asl, "%d too few bound triples "
"in boundsfile \"%s\".",
nv - i + 1, bf);
}
s = buf;
}
*L = *(real*)s;
s += sizeof(real);
*x = *(real*)s;
s += sizeof(real);
*U = *(real*)s;
s += sizeof(real);
if (swap) {
bswap_ASL(L, sizeof(real));
bswap_ASL(x, sizeof(real));
bswap_ASL(U, sizeof(real));
}
if (*L > *U || *x < *L || *x > *U) {
bad_triple:
bad_bounds(asl, "bad bound triple %d in bounds file "
"\"%s\":\n\tL = %.g\n\tx = %.g\n\tU = %.g",
i, bf, *L, *x, *U);
}
L += inc;
U += inc;
++x;
}
}
else {
n1 = (int)strtol(se, &s, 10);
if (n1 != nv)
goto bad_n1;
se = buf + n;
for(i = 1; i <= nv; ++i) {
nr = 0;
tryagain:
while(s < se && *s <= ' ')
++s;
s1 = s;
for(k = 0; k < 3 && s1 < se; ++k) {
while(s1 < se && *s1 > ' ')
++s1;
while(s1 < se && *s1 <= ' ')
++s1;
}
if (k < 3) {
if (nr)
goto too_few;
for(s1 = buf; s < se; ++s, ++s1)
*s1 = *s;
m = sizeof(buf) - (s1 - buf);
n = fread(s1, 1, m, f);
se = s1 + n;
s = buf;
nr = 1;
goto tryagain;
}
*L = strtod(s, &s1);
if (s1 <= s || *s1 > ' ') {
badnumber:
while(s1 < se && *s1 > ' ')
++s1;
bad_bounds(asl, "Bound triple %d: bad number \"%.*s\""
" in boundsfile \"%s\".", i,
(int)(s1-s), s, bf);
}
*x = strtod(s = s1, &s1);
if (s1 <= s || *s1 > ' ')
goto badnumber;
*U = strtod(s = s1, &s1);
if (s1 <= s || *s1 > ' ')
goto badnumber;
if (*L > *U || *x < *L || *x > *U)
goto bad_triple;
L += inc;
U += inc;
++x;
s = s1;
}
}
fclose(f);
}
#endif /*}*/
asl->i.err_jmp_ = 0;
asl->i.rd_M1z_bytes = asl->i.tot_M1z_bytes;
return 0;
}
void
mexFunction(int nlhs, Matrix **plhs, int nrhs, Matrix **prhs)
{
FILE *nl;
char *buf1, buf[512], *what;
static fint n, nc, nz;
fint nerror;
real *J1, *W, *c, *f, *g, *v, *t, *x;
static real *J;
cgrad *cg, **cgp;
static size_t Jsize;
Jmp_buf err_jmp0;
ASL_pfgh *asl = (ASL_pfgh*)cur_ASL;
static fint nhnz;
static real *Hsp;
real *H, *He;
int *Ir, *Jc;
fint *hcs, *hr, i;
if (nrhs == 1 && mxIsString(prhs[0])) {
if (nlhs != 6)
usage();
if (mxGetString(prhs[0], buf1 = buf, sizeof(buf)))
mexErrMsgTxt("Expected 'stub' as argument\n");
at_end();
mexAtExit(at_end);
asl = (ASL_pfgh*)ASL_alloc(ASL_read_pfgh);
return_nofile = 1;
if (!(nl = jac0dim(buf1,strlen(buf)))) {
sprintf(msgbuf, "Can't open %.*s\n",
sizeof(msgbuf)-20, buf);
mexErrMsgTxt(msgbuf);
}
if (n_obj <= 0)
printf("Warning: objectve == 0\n");
n = n_var;
nc = n_con;
nz = nzc;
J = (real *)M1alloc(nz*sizeof(real));
X0 = mxGetPr(plhs[0] = mxCreateFull(n, 1, REAL));
LUv = mxGetPr(plhs[1] = mxCreateFull(n, 1, REAL));
Uvx = mxGetPr(plhs[2] = mxCreateFull(n, 1, REAL));
pi0 = mxGetPr(plhs[3] = mxCreateFull(nc, 1, REAL));
LUrhs = mxGetPr(plhs[4] = mxCreateFull(nc, 1, REAL));
Urhsx = mxGetPr(plhs[5] = mxCreateFull(nc, 1, REAL));
pfgh_read(nl, ASL_findgroups);
Jsize = nc*n*sizeof(real);
/* Arrange to compute the whole sparese Hessian */
/* of the Lagrangian function (both triangles). */
nhnz = sphsetup(0, 0, nc > 0, 0);
Hsp = (real *)M1alloc(nhnz*sizeof(real));
return;
}
if (!filename)
mexErrMsgTxt("spamfunc(\"stub\") has not been called\n");
nerror = -1;
err_jmp1 = &err_jmp0;
if (nlhs == 2) {
if (nrhs != 2)
usage();
x = sizechk(prhs[0],"x",n);
t = sizechk(prhs[1],"0 or 1", 1);
if (t[0] == 0.) {
f = mxGetPr(plhs[0] = mxCreateFull(1, 1, REAL));
c = mxGetPr(plhs[1] = mxCreateFull(nc, 1, REAL));
if (setjmp(err_jmp0.jb)) {
sprintf(msgbuf, "Trouble evaluating %s\n",
what);
mexErrMsgTxt(msgbuf);
}
what = "f";
*f = objval(0, x, &nerror);
what = "c";
conval(x, c, &nerror);
return;
}
g = mxGetPr(plhs[0] = mxCreateFull(n, 1, REAL));
J1 = mxGetPr(plhs[1] = mxCreateSparse(nc, n, nz, REAL));
what = "g";
objgrd(0, x, g, &nerror);
if (nc) {
what = "J";
jacval(x, J1, &nerror);
Ir = mxGetIr(plhs[1]);
memcpy(mxGetJc(plhs[1]), A_colstarts, (n+1)*sizeof(int));
cgp = Cgrad;
for(i = 0; i < nc; i++)
for(cg = *cgp++; cg; cg = cg->next)
Ir[cg->goff] = i;
}
return;
}
if (nlhs == 0 && nrhs == 3) {
/* eval2('solution message', x, v): x = primal, v = dual */
if (!mxIsString(prhs[0]))
usage();
x = sizechk(prhs[1],"x",n);
v = sizechk(prhs[2],"v",nc);
if (mxGetString(prhs[0], buf, sizeof(buf)))
mexErrMsgTxt(
"Expected 'solution message' as first argument\n");
write_sol(buf, x, v, 0);
return;
}
if (nlhs != 1 || nrhs != 1)
usage();
v = sizechk(prhs[0],"v",nc);
W = mxGetPr(plhs[0] = mxCreateSparse(n, n, nhnz, REAL));
what = "W";
sphes(H = Hsp, 0, 0, v);
/* Expand the Hessian lower triangle into the full Hessian... */
Ir = mxGetIr(plhs[0]);
Jc = mxGetJc(plhs[0]);
hcs = sputinfo->hcolstarts;
hr = sputinfo->hrownos;
for(i = 0; i <= n; i++)
Jc[i] = hcs[i];
He = H + hcs[n];
while(H < He) {
*W++ = *H++;
*Ir++ = *hr++;
}
}
void
func_add(ASL *asl)
{
AmplExports *ae;
if (need_funcadd) {
if (!i_option_ASL
&& !(i_option_ASL = getenv("ampl_funclibs")))
i_option_ASL = getenv("AMPLFUNC");
if (!AE.PrintF) {
AE.StdIn = stdin;
AE.StdOut = stdout;
AE.StdErr = Stderr;
AE.ASLdate = ASLdate_ASL;
AE.Addfunc = addfunc_ASL;
AE.PrintF = printf;
AE.FprintF = fprintf;
AE.SprintF = sprintf;
AE.SnprintF = snprintf;
AE.VfprintF = vfprintf;
AE.VsprintF = vsprintf;
AE.VsnprintF = vsnprintf;
AE.Strtod = strtod;
AE.AtExit = AtExit;
AE.AtReset = AtReset;
AE.Tempmem = Tempmem;
AE.Add_table_handler = No_table_handler;
AE.Crypto = No_crypto;
AE.Qsortv = qsortv;
AE.Clearerr = clearerr;
AE.Fclose = fclose;
AE.Fdopen = fdopen;
AE.Feof = feof;
AE.Ferror = ferror;
AE.Fflush = fflush;
AE.Fgetc = fgetc;
AE.Fgets = fgets;
AE.Fileno = fileno;
AE.Fopen = fopen;
AE.Fputc = fputc;
AE.Fputs = fputs;
AE.Fread = fread;
AE.Freopen = freopen;
AE.Fscanf = fscanf;
AE.Fseek = fseek;
AE.Ftell = ftell;
AE.Fwrite = fwrite;
AE.Pclose = pclose;
AE.Perror = perror;
AE.Popen = popen;
AE.Puts = puts;
AE.Rewind = rewind;
AE.Scanf = scanf;
AE.Setbuf = setbuf;
AE.Setvbuf = setvbuf;
AE.Sscanf = sscanf;
AE.Tempnam = Tempnam_cast tempnam;
AE.Tmpfile = tmpfile;
AE.Tmpnam = tmpnam;
AE.Ungetc = ungetc;
AE.Getenv = getenv_ASL;
AE.Breakfunc = breakfunc_ASL;
AE.Breakarg = breakarg_ASL;
AE.Addrandinit = addrandinit_ASL;
}
if (AE.asl)
memcpy(ae = (AmplExports*)M1alloc(sizeof(AmplExports)),
&AE, sizeof(AmplExports));
else
ae = &AE;
asl->i.ae = ae;
ae->asl = (Char*)asl;
auxinfo_ASL(ae);
#ifndef CLOSE_AT_RESET
if (nFa > 0) {
/* not the first nl_reader call */
int i = 0;
while(i < nFa)
(*Fa[i++])(ae);
}
else
#endif
funcadd(ae);
need_funcadd = 0;
}
}
void
mpec_adjust_ASL(ASL *asl)
{
MPEC_Adjust *mpa;
cde *cd;
cde2 *cd2;
cgrad **Cgrd, **Cgrd1, **Cgrda, *cg, *cg1, *ncg, **pcg;
char *hx0;
int *cc, *ck, *cv, *ind1, *ind2, *map;
int i, incc, incv, j, k, m, m0, n, n0, n1, n2, nb, ncc, ncc0, nib, nib0;
int nnv, nz, nz0, nznew, v1, v2, v3, v4;
real *Lc, *Lc0, *Lc1, *Lv, *Lv0, *Lv1, *Uc, *Uc0, *Uc1, *Uv, *Uv0, *Uv1;
real a, b, *x;
extern void f_OPVARVAL_ASL(), f2_VARVAL_ASL();
n = n0 = n1 = n_var;
n2 = asl->i.n_var0;
nib = niv + nbv;
nib0 = n - nib; /* offset of first linear integer or binary variable */
m = m0 = n_con;
nz = nz0 = nzc;
cv = cvar;
Cgrd = Cgrad;
Cgrd1 = Cgrd + m;
incc = incv = 1;
Lc0 = LUrhs;
if (!(Uc0 = Urhsx)) {
Uc0 = Lc0 + 1;
incc = 2;
}
Lv0 = LUv;
if (!(Uv0 = Uvx)) {
Uv0 = Lv0 + 1;
incv = 2;
}
ncc = ncc0 = n_cc;
Lc1 = Lc0 + m*incc;
Uc1 = Uc0 + m*incc;
Lv1 = Lv0 + n*incv;
Uv1 = Uv0 + n*incv;
for(i = k = 0; i < m0; ++i)
if ((j = cv[i])) {
++k;
Lc = Lc0 + incc*i;
Uc = Uc0 + incc*i;
nb = (*Lc > negInfinity) + (*Uc < Infinity);
/* nb == 0 or 1 */
if (!nb) {
m += 2;
n += 4;
nz += 6;
++ncc;
}
else {
Lv = Lv0 + incv*(j-1);
if (*Lv != 0.) {
++m;
++n;
nz += 2;
}
/* Even if constraint i has the form v >= 0, */
/* add a new variable v1 >= 0 and change the */
/* constraint to v1 = v - rhs, in case v is */
/* involved in more than one complementarity */
++n;
++nz;
}
}
if (k != ncc0) {
fprintf(Stderr,
"\nERROR: mpec_adjust saw %d rather than %d incoming complementarities.\n",
k, ncc0);
exit(1);
}
n_var = n;
n_con = m;
nnv = n - n0;
if (n_obj)
adjust_zerograds_ASL(asl, nnv);
if (n_conjac[1] >= m0)
n_conjac[1] = m;
nzc = nz;
n_cc = ncc;
nznew = nz - nz0;
ncg = (cgrad*)M1alloc(2*(ncc + ncc0)*sizeof(int) + nznew*sizeof(cgrad)
+ ncc0*sizeof(cgrad*) + sizeof(MPEC_Adjust));
asl->i.mpa = mpa = (MPEC_Adjust*)(ncg + nznew);
Cgrda = mpa->Cgrda = (cgrad**)(mpa + 1);
asl->i.ccind1 = ind1 = (int*)(Cgrda + ncc0);
asl->i.ccind2 = ind2 = ind1 + ncc;
mpa->cc = cc = ind2 + ncc;
mpa->ck = ck = mpa->cce = cc + ncc0;
mpa->m0 = m0;
mpa->n0 = n0 - nib;
mpa->rhs1 = Lc1;
mpa->incc = incc;
mpa->incv = incv;
map = get_vcmap_ASL(asl, ASL_Sufkind_var);
if (n1 < n2) {
j = n2;
k = n2 + asl->i.nsufext[ASL_Sufkind_var];
for(i = n1; i < k; ++i, ++j)
map[i] = j;
}
if (nib) {
/* Three reverse calls move nib values of map up nnv places. */
j = n0 - nib;
reverse(map+j, map + n0 + nnv);
reverse(map+j, map + j + nnv);
reverse(map + j + nnv, map + n0 + nnv);
i = n0 + nnv;
while(--i >= n0) {
j = i - nnv;
Lv0[incv*i] = Lv0[incv*j];
Uv0[incv*i] = Uv0[incv*j];
}
if ((x = X0)) {
i = n0 + nnv;
while(--i >= n0)
x[i] = x[i-nnv];
for(i = n0 - nnv; i < n0; ++i)
x[i] = 0.;
if ((hx0 = havex0)) {
for(i = n0 + nnv; --i >= n0; )
hx0[i] = hx0[i-nnv];
for(i = n0 - nnv;i < n0; ++i)
hx0[i] = 0;
}
}
Lv1 -= j = incv*nib;
Uv1 -= j;
}
else if ((x = X0)) {
memset(x + n0, 0, nnv*sizeof(real));
if ((hx0 = havex0))
memset(hx0 + n0, 0, nnv);
}
#define vset(x,y) *x = y; x += incv;
for(i = 0; i < m0; ++i)
if ((j = cv[i])) {
if (j > nib0)
j += nnv;
*cc++ = i;
pcg = &Cgrd[i];
cg = 0;
while((cg1 = *pcg))
pcg = &(cg = cg1)->next;
*Cgrda++ = cg;
Lc = Lc0 + incv*i;
Uc = Uc0 + incc*i;
Lv = Lv0 + incv*--j;
Uv = Uv0 + incv*j;
a = *Lc;
b = *Uc;
*ck++ = nb = (a > negInfinity) + (b < Infinity);
if (nb == 0) {
/* change L <= v = _svar[j] <= U */
/* and -Infinity <= body <= Infinity into */
/* v1 = v - L >= 0, v2 = U - v >= 0, */
/* v3 - v4 = body, v3 >= 0, v4 >= 0, */
/* v1 complements v3, v2 complements v4 */
*Lc = *Uc = 0.;
*ind1++ = v1 = n1++;
*ind1++ = v2 = n1++;
*ind2++ = v3 = n1++;
*ind2++ = v4 = n1++;
for(k = 0; k < 4; ++k) {
vset(Lv1, 0.);
vset(Uv1, Infinity);
}
ncg[1].varno = n2+3;
ncg[1].coef = 1.;
ncg[1].next = 0;
ncg[0].varno = n2+2;
ncg[0].coef = -1.;
ncg[0].next = &ncg[1];
*pcg = ncg;
ncg += 2;
ncg[1].varno = n2;
ncg[1].coef = -1.;
ncg[1].next = 0;
ncg[0].varno = j;
ncg[0].coef = 1.;
ncg[0].next = &ncg[1];
*Lc1 = *Uc1 = *Lv;
Lc1 += incc;
Uc1 += incc;
*Cgrd1++ = ncg;
ncg += 2;
ncg[1].varno = n2+1;
ncg[1].coef = 1.;
ncg[1].next = 0;
ncg[0].varno = j;
ncg[0].coef = 1.;
ncg[0].next = &ncg[1];
*Lc1 = *Uc1 = *Uv;
Lc1 += incc;
Uc1 += incc;
*Cgrd1++ = ncg;
ncg += 2;
n2 += 4;
}
else {
/*nb == 1*/
v1 = j;
if (*Lv != 0.) {
/* For v = _svar[j], replace */
/* v >= a with v1 = v - a, v1 >= 0, or */
/* v <= b with v1 = b - v, v1 >= 0 */
v1 = n1++;
vset(Lv1, 0.);
vset(Uv1, Infinity);
ncg[1].varno = n2++;
ncg[1].next = 0;
ncg[0].varno = j;
ncg[0].coef = 1.;
ncg[0].next = &ncg[1];
if (*Lv > negInfinity) {
ncg[1].coef = -1.;
*Lc1 = *Uc1 = *Lv;
}
else {
ncg[1].coef = 1.;
*Lc1 = *Uc1 = *Uv;
}
Lc1 += incc;
Uc1 += incc;
*Cgrd1++ = ncg;
ncg += 2;
}
*ind1++ = v1;
*ind2++ = n1++;
ncg->varno = n2++;
ncg->next = 0;
vset(Lv1, 0.);
vset(Uv1, Infinity);
if (*Lv > negInfinity) {
ncg->coef = -1.;
*Uc = *Lc;
}
else {
ncg->coef = 1.;
*Lc = *Uc;
}
*pcg = ncg++;
}
}
#undef vset
if ((map = asl->i.cmap)) {
j = asl->i.n_con0;
Cgrd1 = asl->i.Cgrad0;
for(i = m0; i < m; ++i) {
map[i] = -1;
Cgrd1[j++] = Cgrd[i];
}
}
i = m0;
k = m - m0;
switch(asl->i.ASLtype) {
case ASL_read_pfg:
memset(((ASL_pfg*)asl)->P.cps + m0, 0, k*sizeof(ps_func));
cd = ((ASL_pfg*)asl)->I.con_de_;
goto have_cd;
case ASL_read_f:
case ASL_read_fg:
cd = ((ASL_fg*)asl)->I.con_de_;
have_cd:
while(i < m)
cd[i++].e = (expr*)&ZeroExpr;
break;
case ASL_read_fgh:
cd2 = ((ASL_fgh*)asl)->I.con2_de_;
goto have_cd2;
case ASL_read_pfgh:
memset(((ASL_pfgh*)asl)->P.cps + m0, 0, k*sizeof(ps_func2));
cd2 = ((ASL_pfgh*)asl)->I.con2_de_;
have_cd2:
while(i < m)
cd2[i++].e = (expr2*)&ZeroExpr;
}
}
int
ka_read_ASL(ASL *asl, EdRead *R, int mode, int **kap, size_t **kapZ)
{
int flags, *kai;
size_t i, k, *ka, t;
int j;
unsigned Long u;
k = asl->i.n_var0;
if (!xscanf(R,"%d",&j) || j != k - 1)
return 1;
if ((i = k) < n_var)
i = n_var;
flags = asl->i.rflags;
if (flags & ASL_use_Z) {
*kap = kai = A_colstarts = 0;
if (!(ka = A_colstartsZ))
A_colstartsZ = ka = (size_t*)M1alloc((i+1)*Sizeof(size_t));
*kapZ = ka + 1;
}
else {
*kapZ = ka = A_colstartsZ = 0;
if (!(kai = A_colstarts))
A_colstarts = kai = (int*)M1alloc((i+1)*Sizeof(int));
*kap = kai + 1;
}
if (sizeof(int) == sizeof(size_t)) {
if (!ka)
ka = (size_t*)kai;
*ka++ = 0;
*ka++ = 0; /* sic */
if (mode == 'K') {
t = 0;
while(--k > 0) {
if (!xscanf(R, "%d", &u))
return 1;
*ka++ = t += u;
}
}
else {
while(--k > 0) {
if (!xscanf(R, "%d", &u))
return 1;
*ka++ = u;
}
}
}
else if (flags & ASL_use_Z) {
*ka++ = 0;
*ka++ = 0; /* sic */
if (mode == 'K') {
t = 0;
while(--k > 0) {
if (!xscanf(R, "%d", &u))
return 1;
*ka++ = t += u;
}
}
else {
while(--k > 0) {
if (!xscanf(R, "%d", &u))
return 1;
*ka++ = u;
}
}
}
else {
*kai++ = 0;
*kai++ = 0; /* sic */
if (mode == 'K') {
t = 0;
while(--k > 0) {
if (!xscanf(R, "%d", &u))
return 1;
*kai++ = (int)(t += u);
}
}
else {
while(--k > 0) {
if (!xscanf(R, "%d", &u))
return 1;
*kai++ = (int)u;
}
}
}
return 0;
}
void
flagsave_ASL(ASL *asl, int flags)
{
real t;
ssize_t nc, nv, nz;
t = nZc;
if (t >= 2147483648. /* 2^31 */) {
if (sizeof(size_t) <= 4) {
fprintf(Stderr, "\n*** Problem too large for 32-bit "
"addressing (%.g Jacobian nonzeros).\n", t);
exit(1);
}
else if (!(flags & (ASL_allow_Z | ASL_use_Z))) {
fprintf(Stderr, "\n*** Problem too large (%.g Jacobian nonzeros)\n", t);
exit(1);
}
else if (sizeof(((cgrad*)0)->goff) <= 4)
fprintf(Stderr, "\n*** Problem too large (%.g Jacobian nonzeros) for "
"jacval().\nRecompile ASL with \"#define ASL_big_goff\" "
"added to arith.h.\n", t);
flags |= ASL_use_Z;
}
asl->i.rflags = flags;
if (flags & ASL_cc_simplify && n_cc) {
if (ndcc < 0)
/* supply overestimates */
ndcc = nzlb = n_cc;
asl->i.nsufext[ASL_Sufkind_var] += 3*ndcc + n_cc + nzlb;
asl->i.nsufext[ASL_Sufkind_con] += 2*ndcc + nzlb;
/* use nsufext[ASL_Sufkind_prob] for # of extra Jacobian nonzeros */
asl->i.nsufext[ASL_Sufkind_prob] += 5*ndcc + n_cc + 2*nzlb;
}
nv = n_var + asl->i.nsufext[ASL_Sufkind_var];
nc = n_con + asl->i.nsufext[ASL_Sufkind_con];
nz = nZc + asl->i.nsufext[ASL_Sufkind_prob];
if (!LUv) {
LUv = (real*)M1alloc(2*sizeof(real)*nv);
if (flags & ASL_sep_U_arrays)
Uvx = LUv + nv;
}
if (!LUrhs) {
LUrhs = (real*)M1alloc(2*sizeof(real)*nc);
if (flags & ASL_sep_U_arrays)
Urhsx = LUrhs + nc;
}
if (flags & ASL_sep_U_arrays) {
if (!Uvx)
Uvx = (real*)M1alloc(nv*sizeof(real));
if (!Urhsx)
Urhsx = (real*)M1alloc(nc*sizeof(real));
}
if (flags & ASL_want_A_vals && !A_vals)
A_vals = (real*)M1alloc(nz*sizeof(real));
if (A_vals) {
if (!A_rownos)
A_rownos = (int *)M1alloc(nz*sizeof(int));
}
else if (nc)
asl->i.Cgrad0 = asl->i.Cgrad_ = (cgrad **)M1zapalloc(nc*sizeof(cgrad *));
}
static void
obj_adj1(ASL *asl, int no)
{
Objrep *od, **pod;
cgrad **Cgrd, **Cgrd0, *cg, *cgo, **pcg, **pcge;
efunc_n *op;
expr_n *e;
int co, cv, flags, i, incc, incv, j, k, m, n;
int *Cvar, *cm, *vm, *zg, **zgp;
ograd *og;
ps_func *P;
ps_func2 *P2;
real *Lc, *Lv, *Uc, *Uv, c1, c2, rhs, t;
op = f_OPNUM_ASL;
switch (asl->i.ASLtype) {
case ASL_read_fg:
e = (expr_n*)((ASL_fg*)asl)->I.obj_de_[no].e;
break;
case ASL_read_fgh:
e = (expr_n*)((ASL_fgh*)asl)->I.obj2_de_[no].e;
break;
case ASL_read_pfg:
e = (expr_n*)((ASL_pfg*)asl)->I.obj_de_[no].e;
P = &((ASL_pfg*)asl)->P.ops[no];
if (P->nb || P->ng)
return;
op = (efunc_n*)OPNUM;
break;
case ASL_read_pfgh:
e = (expr_n*)((ASL_pfgh*)asl)->I.obj2_de_[no].e;
P2 = &((ASL_pfgh*)asl)->P.ops[no];
if (P2->nb || P2->ng)
return;
op = (efunc_n*)OPNUM;
break;
default:
fprintf(Stderr, "Bug: surprise ASLtype = %d in obj_adj\n", asl->i.ASLtype);
exit(1);
}
if (e->op != op)
return;
og = Ograd[no];
if (!og || og->next)
return;
cv = og->varno;
if (cv < nlvc)
return;
if (!(c1 = og->coef))
return;
if (Uvx) {
Lv = LUv + cv;
Uv = Uvx + cv;
incv = 1;
}
else {
Lv = LUv + 2*cv;
Uv = Lv + 1;
incv = 2;
}
if (*Lv > negInfinity || *Uv < Infinity)
return;
pcg = Cgrd = Cgrad;
cgo = 0;
for(pcge = pcg + n_con; pcg < pcge; ++pcg) {
for(cg = *pcg; cg; cg = cg->next)
if (cg->varno == cv) {
if (cgo)
return;
cgo = cg;
co = pcg - Cgrd;
for(k = 0, cg = *pcg; cg; cg = cg->next)
++k;
break;
}
}
if (!cgo)
return;
if (n_cc && cvar[co])
return;
if ((c2 = cgo->coef) == 0.)
return;
t = c1 / c2;
j = t < 0.;
if (objtype[no])
j = 1 - j;
if (Urhsx) {
Lc = LUrhs + co;
Uc = Urhsx + co;
incc = 1;
}
else {
Lc = LUrhs + 2*co;
Uc = Lc + 1;
incc = 2;
}
if (j) {
if ((rhs = *Uc) >= Infinity)
return;
}
else {
if ((rhs = *Lc) <= negInfinity)
return;
}
flags = asl->i.rflags;
if (*Lc < *Uc) {
if (!(flags & ASL_obj_replace_ineq))
return;
}
else {
if (!(flags & ASL_obj_replace_eq))
return;
}
if (co < nlc) {
--nlc;
++nlo;
}
nzc -= k;
nzo += k - 1;
pod = asl->i.Or;
od = (Objrep*)M1alloc(sizeof(Objrep)
+ (pod ? 0 : n_obj*sizeof(Objrep*)));
if (!pod) {
pod = asl->i.Or = (Objrep**)(od+1);
for(k = n_obj; --k >= 0; )
pod[k] = 0;
}
pod[no] = od;
od->ico = co;
od->ivo = cv;
od->c0 = e->v;
od->c0a = e->v + t*rhs;
od->c1 = c1;
od->c12 = -t;
od->nxval = -1;
od->f = 0.;
pcg = &Cgrd[co];
while((cg = *pcg) != cgo)
pcg = &cg->next;
*pcg = cgo->next;
if ((cm = asl->i.cmap) && (Cgrd0 = asl->i.Cgrad0))
Cgrd0[cm[co]] = Cgrd[co];
m = --n_con;
if (n_conjac[1] > m)
n_conjac[1] = m;
if (co != m) {
cm = get_vcmap_ASL(asl, ASL_Sufkind_con);
pcg = Cgrd;
Cvar = cvar;
for(i = co; i < m; i = j) {
cm[i] = cm[j = i + 1];
pcg[i] = pcg[j];
if (Cvar)
Cvar[i] = Cvar[j];
}
cm[m] = -1;
}
for(i = co; i < m; ++i) {
*Lc = Lc[incc];
*Uc = Uc[incc];
Lc += incc;
Uc += incc;
}
n = --n_var;
if (cv != n) {
vm = get_vcmap_ASL(asl, ASL_Sufkind_var);
for(i = cv; i < n; ++i)
vm[i] = vm[i+1];
vm[n] = -1;
}
for(i = cv; i < n; ++i) {
*Lv = Lv[incv];
*Uv = Uv[incv];
Lv += incv;
Uv += incv;
}
if ((zgp = zerograds))
for(zg = zgp[no]; *zg >= 0; ++zg)
if (*zg >= cv)
--*zg;
}
