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 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; }
real obj2val_ASL(ASL *a, int i, real *X, fint *nerror) { ASL_fgh *asl; Jmp_buf err_jmp0; cde *d; expr *e1; int ij, j1, kv, *vmi; ograd *gr, **gr0; real f, *vscale; NNOBJ_chk(a, i, "obj2val"); asl = (ASL_fgh*)a; if (nerror && *nerror >= 0) { err_jmp = &err_jmp0; ij = setjmp(err_jmp0.jb); if ((*nerror = ij)) { f = 0.; goto done; } } want_deriv = want_derivs; errno = 0; /* in case f77 set errno opening files */ x2_check(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, combc, ncom0); x0kind |= ASL_have_objcom; } d = obj_de + i; if (d->n_com1) com1eval(asl, d->com11, d->n_com1); gr0 = Ograd + i; e1 = d->e; f = (*e1->op)(e1 C_ASL); asl->i.noxval[i] = asl->i.nxval; kv = 0; vmi = 0; if ((vscale = asl->i.vscale)) kv = 2; if (asl->i.vmap) { vmi = get_vminv_ASL(a); ++kv; } gr = *gr0; 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; } done: err_jmp = 0; return f; }