lcon2val_ASL(ASL *a, int i, real *X, fint *nerror)
#endif
{
real f;
INchk(a, "lcon2val", i, a->i.n_lcon_);
f = c2ival((ASL_fgh*)a, i + a->i.n_con0, X, nerror);
return f != 0.;
}
int
lcon1val(ASL *a, int i, real *X, fint *nerror)
{
real f;
INchk(a, "lcon1ival", i, a->i.n_lcon_);
f = cival((ASL_fg*)a, i + a->i.n_con0, X, nerror);
return f != 0.;
}
real
con1ival(ASL *a, int i, real *X, fint *nerror)
{
int *cm;
INchk(a, "con1ival", i, a->i.n_con_);
if ((cm = a->i.cmap))
i = cm[i];
return Conival1((ASL_fg*)a, i, X, nerror);
}
void
con1grd_nomap_ASL(ASL *a, int i, real *X, real *G, fint *nerror)
{
ASL_fg *asl;
static char who[] = "con1grd_nomap";
INchk(a, who, i, a->i.n_con0);
asl = (ASL_fg*)a;
if (!want_derivs)
No_derivs_ASL(who);
Congrd1(asl, i, X, G, nerror);
}
void
con1grd_ASL(ASL *a, int i, real *X, real *G, fint *nerror)
{
ASL_fg *asl;
int *cm;
static char who[] = "con1grd";
INchk(a, who, i, a->i.n_con_);
asl = (ASL_fg*)a;
if (!want_derivs)
No_derivs_ASL(who);
if ((cm = a->i.cmap))
i = cm[i];
Congrd1(asl, i, X, G, nerror);
}
real
con2ival_ASL(ASL *a, int i, real *X, fint *nerror)
{
ASL_fgh *asl;
cgrad *gr;
int j1, kv, *vmi;
real f, *vscale;
INchk(a, "con2ival", i, a->i.n_con0);
asl = (ASL_fgh*)a;
f = c2ival(asl, i, X, nerror);
kv = 0;
vmi = 0;
if ((vscale = asl->i.vscale))
kv = 2;
if (asl->i.vmap) {
vmi = get_vminv_ASL(a);
++kv;
}
gr = asl->i.Cgrad0[i];
switch(kv) {
case 3:
for(; gr; gr = gr->next) {
j1 = vmi[gr->varno];
f += X[j1] * vscale[j1] * gr->coef;
}
break;
case 2:
for(; gr; gr = gr->next) {
j1 = gr->varno;
f += X[j1] * vscale[j1] * gr->coef;
}
break;
case 1:
for(; gr; gr = gr->next)
f += X[vmi[gr->varno]] * gr->coef;
break;
case 0:
for(; gr; gr = gr->next)
f += X[gr->varno] * gr->coef;
}
return f;
}
con2ival_ASL(ASL *a, int i, real *X, fint *nerror)
#endif
{
ASL_fgh *asl;
cgrad *gr, **gr0;
expr_v *V;
real f;
INchk(a, "con2ival", i, a->i.n_con_);
f = c2ival(asl = (ASL_fgh*)a, i, X, nerror);
gr0 = Cgrad + i;
gr = *gr0;
if (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];
if (asl->i.cscale)
f *= asl->i.cscale[i];
return f;
}
con2grd_ASL(ASL *a, int i, real *X, real *G, fint *nerror)
#endif
{
cde *d;
cgrad *gr, **gr0;
real *Adjoints, *vscale;
Jmp_buf err_jmp0;
int i0, ij, L, xksave;
ASL_fgh *asl;
real scale;
static char who[] = "con2grd";
INchk(a, who, i, a->i.n_con_);
asl = (ASL_fgh*)a;
if (!want_derivs)
No_derivs_ASL(who);
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)
x2_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;
con2ival_ASL(a,i,X,nerror);
asl->i.x_known = xksave;
if (nerror && *nerror)
return;
}
if (!(x0kind & ASL_have_funnel)) {
if (f_b)
funnelset(asl, f_b);
if (f_c)
funnelset(asl, f_c);
x0kind |= ASL_have_funnel;
}
Adjoints = adjoints;
d = con_de + i;
gr0 = Cgrad + i;
scale = asl->i.cscale ? asl->i.cscale[i] : 1.;
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 (vscale = asl->i.vscale)
for(gr = *gr0; gr; gr = gr->next) {
L = gr->varno;
Adjoints[L] *= vscale[L];
}
gr = *gr0;
i0 = 0;
switch(asl->i.congrd_mode) {
case 1:
for(; gr; gr = gr->next)
G[i0++] = scale * Adjoints[gr->varno];
break;
case 2:
for(; gr; gr = gr->next)
G[gr->goff] = scale * Adjoints[gr->varno];
break;
default:
for(; gr; gr = gr->next) {
i = gr->varno;
while(i0 < i)
G[i0++] = 0;
G[i] = scale * Adjoints[i];
i0 = i + 1;
}
i = n_var;
while(i0 < i)
G[i0++] = 0;
}
err_jmp = 0;
}
void
con2grd_ASL(ASL *a, int i, real *X, real *G, fint *nerror)
{
ASL_fgh *asl;
Jmp_buf err_jmp0;
cde *d;
cgrad *gr, *gr1;
int i0, ij, j, *vmi, xksave;
real *Adjoints, *vscale;
size_t L;
static char who[] = "con2grd";
INchk(a, who, i, a->i.n_con0);
asl = (ASL_fgh*)a;
if (!want_derivs)
No_derivs_ASL(who);
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)
x2_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;
con2ival_ASL(a,i,X,nerror);
asl->i.x_known = xksave;
if (nerror && *nerror)
return;
}
if (asl->i.Derrs)
deriv_errchk_ASL(a, nerror, i, 1);
if (!(x0kind & ASL_have_funnel)) {
if (f_b)
funnelset(asl, f_b);
if (f_c)
funnelset(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(a);
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;
}
real
con1ival_nomap_ASL(ASL *a, int i, real *X, fint *nerror)
{
INchk(a, "con1ival_nomap", i, a->i.n_con0);
return Conival1((ASL_fg*)a, i, X, nerror);
}