real
obj1val_ASL(ASL *a, int i, real *X, fint *nerror)
{
ASL_fg *asl;
Jmp_buf err_jmp0;
cde *d;
expr *e1;
expr_v *V;
int ij;
ograd *gr;
real f;
NNOBJ_chk(a, i, "obj1val");
asl = (ASL_fg*)a;
if (nerror && *nerror >= 0) {
err_jmp = &err_jmp0;
ij = __builtin_setjmp(err_jmp0.jb);
if (ij) {
*nerror = err_jmp0.err;
f = 0.;
goto done;
}
}
want_deriv = want_derivs;
errno = 0; /* in case f77 set errno opening files */
if (!asl->i.x_known)
x0_check_ASL(asl,X);
if (!asl->i.noxval)
asl->i.noxval = (int*)M1zapalloc(n_obj*sizeof(int));
co_index = -(i + 1);
if (!(x0kind & ASL_have_objcom)) {
if (ncom0 > combc)
comeval_ASL(asl, combc, ncom0);
if (comc1 < ncom1)
com1eval_ASL(asl, comc1, ncom1);
x0kind |= ASL_have_objcom;
}
d = obj_de + i;
gr = Ograd[i];
e1 = d->e;
f = (*e1->op)(e1 C_ASL);
asl->i.noxval[i] = asl->i.nxval;
if (asl->i.vmap || asl->i.vscale)
for(V = var_e; gr; gr = gr->next)
f += gr->coef * V[gr->varno].v;
else
for(; gr; gr = gr->next)
f += gr->coef * X[gr->varno];
done:
err_jmp = 0;
return f;
}
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;
}
static real
cival(ASL_fg *asl, int i, real *X, fint *nerror)
{
Jmp_buf err_jmp0;
expr *e;
int ij, nc;
real f;
if (nerror && *nerror >= 0) {
err_jmp = &err_jmp0;
ij = setjmp(err_jmp0.jb);
if ((*nerror = ij))
return 0.;
}
want_deriv = want_derivs;
errno = 0; /* in case f77 set errno opening files */
if (!asl->i.x_known)
x0_check_ASL(asl,X);
if (!asl->i.ncxval)
asl->i.ncxval = (int*)M1zapalloc(nclcon*sizeof(int));
if (!(x0kind & ASL_have_concom)) {
if (comb < combc)
comeval_ASL(asl, comb, combc);
if (comc1)
com1eval_ASL(asl, 0,comc1);
x0kind |= ASL_have_concom;
}
asl->i.ncxval[i] = asl->i.nxval;
co_index = i;
if (i >= (nc = asl->i.n_con0))
e = lcon_de[i-nc].e;
else
e = con_de[i].e;
f = (*e->op)(e C_ASL);
err_jmp = 0;
return f;
}
void
obj1grd_ASL(ASL *a, int i, real *X, real *G, fint *nerror)
{
ASL_fg *asl;
Jmp_buf err_jmp0;
cde *d;
fint ne0;
int ij, j, *vmi, xksave, *z;
ograd *gr, **gr0;
real *Adjoints, *vscale;
size_t L;
static char who[] = "obj1grd";
NNOBJ_chk(a, i, who);
asl = (ASL_fg*)a;
if (!want_derivs)
No_derivs_ASL(who);
ne0 = -1;
if (nerror && (ne0 = *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 */
if (!asl->i.x_known)
x0_check_ASL(asl,X);
if (!asl->i.noxval || asl->i.noxval[i] != asl->i.nxval) {
xksave = asl->i.x_known;
asl->i.x_known = 1;
obj1val_ASL(a, i, X, nerror);
asl->i.x_known = xksave;
if (ne0 >= 0 && *nerror)
goto done;
}
if (asl->i.Derrs)
deriv_errchk_ASL(a, nerror, -(i+1), 1);
if (f_b)
funnelset_ASL(asl, f_b);
if (f_o)
funnelset_ASL(asl, f_o);
Adjoints = adjoints;
d = obj_de + i;
gr0 = Ograd + i;
for(gr = *gr0; gr; gr = gr->next)
Adjoints[gr->varno] = gr->coef;
if ((L = d->zaplen)) {
memset(adjoints_nv1, 0, L);
derprop(d->d);
}
if (zerograds) { /* sparse gradients */
z = zerograds[i];
while((i = *z++) >= 0)
G[i] = 0;
}
gr = *gr0;
vmi = 0;
if (asl->i.vmap)
vmi = get_vminv_ASL(a);
if ((vscale = asl->i.vscale)) {
if (vmi)
for(; gr; gr = gr->next) {
j = vmi[i = gr->varno];
G[j] = Adjoints[i] * vscale[j];
}
else
for(; gr; gr = gr->next) {
i = gr->varno;
G[i] = Adjoints[i] * vscale[i];
}
}
else if (vmi)
for(; gr; gr = gr->next) {
i = gr->varno;
G[vmi[i]] = Adjoints[i];
}
else
for(; gr; gr = gr->next) {
i = gr->varno;
G[i] = Adjoints[i];
}
done:
err_jmp = 0;
}
void
Congrd1(ASL_fg *asl, int i, real *X, real *G, fint *nerror)
{
Jmp_buf err_jmp0;
cde *d;
cgrad *gr, *gr1;
int i0, ij, j, *vmi, xksave;
real *Adjoints, *vscale;
size_t L;
if (nerror && *nerror >= 0) {
err_jmp = &err_jmp0;
ij = setjmp(err_jmp0.jb);
if ((*nerror = ij))
return;
}
errno = 0; /* in case f77 set errno opening files */
if (!asl->i.x_known)
x0_check_ASL(asl,X);
if ((!asl->i.ncxval || asl->i.ncxval[i] != asl->i.nxval)
&& (!(x0kind & ASL_have_conval)
|| i < n_conjac[0] || i >= n_conjac[1])) {
xksave = asl->i.x_known;
asl->i.x_known = 1;
con1ival((ASL*)asl,i,X,nerror);
asl->i.x_known = xksave;
if (nerror && *nerror)
return;
}
if (asl->i.Derrs)
deriv_errchk_ASL((ASL*)asl, nerror, i, 1);
if (!(x0kind & ASL_have_funnel)) {
if (f_b)
funnelset_ASL(asl, f_b);
if (f_c)
funnelset_ASL(asl, f_c);
x0kind |= ASL_have_funnel;
}
Adjoints = adjoints;
d = &con_de[i];
gr1 = asl->i.Cgrad0[i];
for(gr = gr1; gr; gr = gr->next)
Adjoints[gr->varno] = gr->coef;
if ((L = d->zaplen)) {
memset(adjoints_nv1, 0, L);
derprop(d->d);
}
vmi = 0;
if (asl->i.vmap)
vmi = get_vminv_ASL((ASL*)asl);
if ((vscale = asl->i.vscale)) {
if (vmi)
for(gr = gr1; gr; gr = gr->next) {
i0 = gr->varno;
Adjoints[i0] *= vscale[vmi[i0]];
}
else
for(gr = gr1; gr; gr = gr->next) {
i0 = gr->varno;
Adjoints[i0] *= vscale[i0];
}
}
gr = gr1;
i0 = 0;
switch(asl->i.congrd_mode) {
case 1:
for(; gr; gr = gr->next)
G[i0++] = Adjoints[gr->varno];
break;
case 2:
for(; gr; gr = gr->next)
G[gr->goff] = Adjoints[gr->varno];
break;
default:
if (vmi) {
for(; gr; gr = gr->next) {
i = vmi[j = gr->varno];
while(i0 < i)
G[i0++] = 0;
G[i] = Adjoints[j];
i0 = i + 1;
}
}
else
for(; gr; gr = gr->next) {
i = gr->varno;
while(i0 < i)
G[i0++] = 0;
G[i] = Adjoints[i];
i0 = i + 1;
}
i = n_var;
while(i0 < i)
G[i0++] = 0;
}
err_jmp = 0;
}