GE_API int GE_CALLCONV
gefunc (int *icntr, double *x_in, double *f, double *d, msgcb_t msgcb)
{
int findex, i, j;
if (icntr[I_Mode] == DOINIT) {
MSGCB (LOGFILE | STAFILE,"");
MSGCB (LOGFILE | STAFILE,"--- GEFUNC in er3c_cb.c is being initialized.");
/* Test the equation count and return 2 if bogus */
if (NEQ != icntr[I_Neq]
|| NVAR != icntr[I_Nvar]
|| NZ != icntr[I_Nz]) {
MSGCB (LOGFILE | STAFILE, "--- Model has the wrong size.");
return 2;
}
/* these should probably be checked for i/o errors, but are not */
for (findex = 0, i = 0; i < N; i++) {
for (j = i+1; j < N; j++) {
f2i[findex] = i;
f2j[findex] = j;
findex++;
}
}
return 0;
} /* initialization mode */
else if ( icntr[I_Mode] == DOTERM ) {
/* nothing to do in this external module */
return 0;
} /* termination mode */
else if ( icntr[I_Mode] == DOEVAL ) {
double *x, *y, *area, *slack;
double *dx, *dy, *darea, *dslack;
/*
* x[j=0..N) = x_in[j]
* y[j=0..N) = x_in[j+N]
* area[j=0..N) = x_in[j+2*N]
* slack[j=0..NMAP) = x_in[j+3*N]
* and similarly for dx, dy, darea, dslack
*/
/* first set up the variable mapping */
x = x_in;
y = x_in+N;
area = x_in+2*N;
slack = x_in+3*N;
findex = icntr[I_Eqno] - 1;
if (findex < 0 || findex >= NMAP + N) { /* bogus findex */
MSGCB (STAFILE | LOGFILE," ** Eqno has unexpected value.");
return 2;
}
else if (findex < NMAP) { /* maxdist equation */
i = f2i[findex];
j = f2j[findex];
if (icntr[I_Dofunc]) {
*f = SQR(x[i]-x[j]) + SQR(y[i]-y[j])
+ slack[findex] - 1;
}
if (icntr[I_Dodrv]) {
/* The derivative w.r.t. x(i) must be returned in d(i).
* Only nonzero values have to be defined. */
dx = d;
dy = d+N;
dslack = d+3*N;
dx[i] = 2 * (x[i]-x[j]);
dx[j] = -dx[i];
dy[i] = 2 * (y[i]-y[j]);
dy[j] = -dy[i];
dslack[findex] = 1;
}
} /* maxdist equation */
else { /* areadef equation */
int iplus;
i = findex - NMAP;
iplus = (i + 1) % N;
if (icntr[I_Dofunc]) {
*f = area[i]
- 0.5 * (x[i]*y[iplus] - y[i]*x[iplus]);
}
if (icntr[I_Dodrv]) {
/* The derivative w.r.t. x(i) must be returned in d(i).
* Only nonzero values have to be defined. */
dx = d;
dy = d+N;
darea = d+2*N;
darea[i] = 1;
/* **ERROR** The following derivative should be defined but we have
removed the line. Note that the error messages may appear
strange. The value of d(i) could be inherited from the
previous equation that defined d(i).
dx[i] = -.5 * y[iplus]; */
dx[iplus] = .5 * y[i];
dy[i] = .5 * x[iplus];
dy[iplus] = -.5 * x[i];
/* **ERROR** An extra derivative is being defined:
This cannot be seen found because the interface only
transfers derivatives that are consistent with the
sparsety pattern defined in GAMS. */
dy[iplus+1] = -.5 * x[i];
}
} /* areadef equation */
return 0;
} /* function and derivative evaluation mode */
else { /* unexpected mode value */
MSGCB (STAFILE | LOGFILE, " ** Mode not defined.");
return 2;
}
} /* gefunc */
GE_API int GE_CALLCONV
gefunc (int *icntr, double *x, double *func, double *d, msgcb_t msgcb)
{
assert(GFCP && "No GlobalFrictionContactProblem has been set!");
#if defined(SOME_DEBUG_STUFF)
char msgBuf[256];
#endif
double t, dtdh;
double t1, dt1dh;
double t2, dt2dh;
double h, cv, dfdh, dfdcv, f;
if (icntr[I_Mode] == DOINIT) {
/*
* Initialization Mode:
* Write a "finger print" to the status file so errors in the DLL
* can be detected more easily. This should be done before anything
* can go wrong. Also write a line to the log just to show it.
*/
MSGCB (LOGFILE | STAFILE,"");
MSGCB (LOGFILE | STAFILE,"--- GEFUNC in ex4xc_cb.c is being initialized.");
/* Test the equation count and return 2 if bogus */
if (icntr[I_Neq] != 1) {
MSGCB (LOGFILE | STAFILE,
"--- Model has the wrong number of external equations.");
return BOGUS_EXTEQ;
}
if (2 != icntr[I_Nz]) {
MSGCB (LOGFILE | STAFILE,
"--- The external equation should be fully dense.");
return BOGUS_EXTEQ;
}
if (2 != icntr[I_Nvar]) {
MSGCB (LOGFILE | STAFILE,
"--- The external equation should have 2 variables.");
return BOGUS_EXTEQ;
}
/* Define number of constant derivatives */
icntr[I_ConstDeriv] = 1;
/* Form */
NM_setup(GFCP->H);
return 0;
} /* initialization mode */
else if ( icntr[I_Mode] == DOCONSTDERIV ) {
assert(0 && "Why are we here? icntr[I_Mode] == DOCONSTDERIV ");
}
else if ( icntr[I_Mode] == DOTERM ) {
/* Termination mode: free allocated storage */
return 0;
} /* termination mode */
else if ( icntr[I_Mode] == DOEVAL ) {
/*
* Function index: there is only one equation here,
* but we check the equation number just to show the principle.
*/
if (icntr[I_Eqno] != 1) {
MSGCB (STAFILE | LOGFILE," ** Eqno has unexpected value.");
return BOGUS_EXTEQ;
}
NumericsMatrix Mlu = ((GFC3D_Gams*) GFCP->env)->Mlu;
double* rhs = ((GFC3D_Gams*) GFCP->env)->rhs;
/* set rhs = Hr + f */
cblas_dcopy(n, func, 1, rhs, 1);
/* solve Mv = Hr + f = rhs */
/* get our values from the array passed in, just to be neat */
h = x[0];
cv = x[1];
#if defined(SOME_DEBUG_STUFF)
sprintf (msgBuf, " dh = %g, dcv = %g, f = %f",
dfdh, dfdcv, f);
MSGCB (STAFILE | LOGFILE, msgBuf);
#endif
if (icntr[I_Dofunc]) {
*func = f;
}
if (icntr[I_Dodrv]) {
assert(0 && "Computing derivative is not implemented yet ...!");
}
return 0;
} /* Function and Derivative Evaluation Mode */
else {
MSGCB (STAFILE | LOGFILE, " ** Mode not defined.");
return 2;
}
} /* gefunc */
GE_API int GE_CALLCONV
gefunc( int *icntr, double *x, double *f, double *d, msgcb_t msgcb)
{
/*
Declare local arrays to hold the model data.
*/
int i, j, findex, dofnc, dodrv, neq, nvar, nz, rc=0;
if ( icntr[I_Mode] == DOINIT ) {
/*
Initialization Mode:
Write a "finger print" to the status file so errors in the DLL
can be detected more easily. This should be done before anything
can go wrong. Also write a line to the log just to show it.
*/
MSGCB (LOGFILE | STAFILE,"");
MSGCB (LOGFILE | STAFILE,"--- GEFUNC in ex1xc_cb.c is being initialized.");
/* Test the sizes and return 0 if OK */
neq = 1;
nvar = ni+1;
nz = ni+1;
if ( neq != icntr[I_Neq] || nvar != icntr[I_Nvar] || nz != icntr[I_Nz] ) {
MSGCB (LOGFILE,"--- Model has the wrong size.");
rc = 2;
}
else {
/*
Define the model data using statements similar to those in GAMS.
Note that any changes in the GAMS model must be changed here also,
so syncronization can be a problem with this methodology.
*/
for (i = 0; i < ni; i++) {
x0[i] = (i+1); /* ??? */
for (j = 0; j < ni; j++)
q[i][j] = pow(0.5,(double)abs(i-j));
}
/* EXTRA:
* Define capabilities:
* We can return constant derivatives and there is 1 such derivative
* We can return Hessian times Vector
*/
icntr[I_ConstDeriv] = 1;
icntr[I_HVProd] = 1;
}
return rc;
}
else if ( icntr[I_Mode] == DOTERM ) {
/*
Termination mode: Do nothing
*/
return rc;
}
else if ( icntr[I_Mode] == DOEVAL ) {
/*
Function and Derivative Evaluation Mode
*/
findex = icntr[I_Eqno];
dofnc = icntr[I_Dofunc];
dodrv = icntr[I_Dodrv];
/*
Function index: there is only one so we do not have to test fIndex,
but we do it just to show the principle.
*/
if ( findex == 1 ) {
if ( dofnc ) {
/*
Function value is needed. Note that the linear term corresponding
to -Z must be included.
*/
*f = -x[ni];
for (i = 0; i < ni; i++)
for (j = 0; j < ni; j++)
*f += (x[i]-x0[i]) * q[i][j] * (x[j]-x0[j]);
}
/*
The vector of derivatives is needed. The derivative with respect
to variable x(i) must be returned in d(i). The derivatives of the
linear terms, here -Z, must be defined each time.
*/
if ( dodrv ) {
d[ni] = -1.0;
for (i = 0; i < ni; i++) {
d[i] = 0;
for (j = 0; j < ni; j++ )
d[i] = d[i] + q[i][j] * ( x[j]-x0[j] );
d[i] = d[i] * 2.0;
}
}
}
else {
/*
If findex is different from 1, then something is wrong and we
return 2.
*/
MSGCB (STAFILE | LOGFILE," ** fIndex has unexpected value.");
rc = 2;
}
return rc;
}
else if ( icntr[I_Mode] == DOCONSTDERIV ) {
/*
* Return the constant derivatives and ignore the varying ones (and
* any that do not belong to the sparsity pattern).
*/
if (1 == icntr[I_Eqno]) {
d[ni] = -1.0; /* 1 constant derivative with value -1 */
rc = 0;
}
else {
MSGCB (STAFILE | LOGFILE," ** fIndex has unexpected value.");
rc = 2;
}
return rc;
}
else if ( icntr[I_Mode] == DOHVPROD ) {
/*
* Return d = Hessian * v = 2 * Q * v,
* where v is stored at the end of x.
* assumes d is initialized at 0
*/
if (1 == icntr[I_Eqno]) {
double *v = x + (ni+1);
for (j = 0; j < ni; j++) {
for (i = 0; i < ni; i++) {
d[i] += q[i][j] * v[j];
}
}
for (i = 0; i < ni; i++) {
d[i] *= 2;
}
rc = 0;
}
else {
MSGCB (STAFILE | LOGFILE," ** fIndex has unexpected value.");
rc = 2;
}
return rc;
}
else {
MSGCB (STAFILE | LOGFILE," ** Mode not defined.");
rc = 2;
return rc;
}
}
GE_API int GE_CALLCONV
gefunc( int *icntr, double *x, double *f, double *d, msgcb_t msgcb)
{
int i, c; /* equation indices */
int j, doFunc, doDeriv, neq, nvar, nz, rc=0;
double u, v, X, t, *uvec;
char msg[256];
neq = NI+NC;
if (DOINIT == icntr[I_Mode]) {
/*
* Initialization Mode:
* Write a "finger print" to the status and log files so errors in the DLL
* can be detected more easily. This should be done before anything
* can go wrong.
*/
MSGCB (STAFILE, "");
MSGCB (STAFILE, "**** GEFUNC in exmcp5c.c is being initialized.");
MSGCB (LOGFILE, "--- GEFUNC in exmcp5c.c is being initialized.");
/* Test the sizes and return 0 if OK */
nvar = 2*NI+NC;
nz = 2*NI + NC*(1 + NI);
if (neq != icntr[I_Neq] || nvar != icntr[I_Nvar] || nz != icntr[I_Nz]) {
MSGCB (LOGFILE, "--- Model has the wrong size.");
rc = 2;
}
else {
/* no initialization necessary */
}
return rc;
}
else if (DOTERM == icntr[I_Mode]) {
/* Termination mode: Do nothing */
return rc;
}
else if (DOEVAL == icntr[I_Mode]) {
/* Function and Derivative Evaluation Mode */
i = icntr[I_Eqno] - 1; /* make it 0-based */
doFunc = icntr[I_Dofunc];
doDeriv = icntr[I_Dodrv];
if (i < 0 || i >= neq) {
/* out of range: return 2 */
sprintf (msg, " ** equation index has unexpected value: got %d,"
" should be in [1,%d]", icntr[I_Eqno], neq);
MSGCB (STAFILE | LOGFILE, msg);
return 2;
}
if (i < NI) {
/* row of ev: ev(i) = exp(v(i)) - u(i) */
u = x[i];
v = x[NI+i];
t = exp(v);
if (doFunc) {
*f = t - u;
}
if (doDeriv) {
d[i] = -1;
d[NI+i] = t;
}
}
else {
/* row of ex(c) = X(c)**1.75 - 0.2*sum{i, u(i)} */
c = i - NI;
X = x[2*NI+c];
uvec = x;
t = log(X);
if (doFunc) {
*f = 0;
for (j = 0; j < NI; j++)
*f += uvec[j];
*f = exp(1.75*t) - 0.2 * (*f);
}
if (doDeriv) {
for (j = 0; j < NI; j++)
d[j] = -0.2;
d[2*NI+c] = 1.75 * exp(0.75*t);
}
}
return rc;
}
else {
MSGCB (STAFILE | LOGFILE, " ** Mode not defined.");
rc = 2;
}
return rc;
} /* gefunc */
int
gefuncX (int icntr[], double x[], double *f, double d[],
void *msgcb, void *usrmem, int cbtype)
{
/*
Declare local arrays to hold the model data.
*/
int i, j, findex, dofnc, dodrv, neq, nvar, nz, rc=0;
if ( icntr[I_Mode] == DOINIT ) {
/*
Initialization Mode:
Write a "finger print" to the status file so errors in the DLL
can be detected more easily. This should be done before anything
can go wrong. Also write a line to the log just to show it.
*/
MSGCB (LOGFILE | STAFILE,"");
MSGCB (LOGFILE | STAFILE,"--- GEFUNC in ex1c_cb.c is being initialized.");
/* Test the sizes and return 0 if OK */
neq = 1;
nvar = NI+1;
nz = NI+1;
if ( neq != icntr[I_Neq] || nvar != icntr[I_Nvar] || nz != icntr[I_Nz] ) {
MSGCB (LOGFILE,"--- Model has the wrong size.");
rc = 2;
}
else {
/*
Define the model data using statements similar to those in GAMS.
Note that any changes in the GAMS model must be changed here also,
so syncronization can be a problem with this methodology.
*/
for (i = 0; i < NI; i++) {
x0[i] = (i+1); /* ??? */
for (j = 0; j < NI; j++)
q[i][j] = pow(0.5,(double)abs(i-j));
}
}
return rc;
}
else if ( icntr[I_Mode] == DOTERM ) {
/*
Termination mode: Do nothing
*/
return rc;
}
else if ( icntr[I_Mode] == DOEVAL ) {
/*
Function and Derivative Evaluation Mode
*/
findex = icntr[I_Eqno];
dofnc = icntr[I_Dofunc];
dodrv = icntr[I_Dodrv];
/*
Function index: there is only one so we do not have to test fIndex,
but we do it just to show the principle.
*/
if ( findex == 1 ) {
if ( dofnc ) {
/*
Function value is needed. Note that the linear term corresponding
to -Z must be included.
*/
*f = -x[NI];
for (i = 0; i < NI; i++)
for (j = 0; j < NI; j++)
*f += (x[i]-x0[i]) * q[i][j] * (x[j]-x0[j]);
}
/*
The vector of derivatives is needed. The derivative with respect
to variable x(i) must be returned in d(i). The derivatives of the
linear terms, here -Z, must be defined each time.
*/
if ( dodrv ) {
d[NI] = -1.0;
for (i = 0; i < NI; i++) {
d[i] = 0;
for (j = 0; j < NI; j++ )
d[i] = d[i] + q[i][j] * ( x[j]-x0[j] );
d[i] = d[i] * 2.0;
}
}
}
else {
/*
If findex is different from 1, then something is wrong and we
return 2.
*/
MSGCB (STAFILE | LOGFILE," ** fIndex has unexpected value.");
rc = 2;
}
return rc;
}
else {
MSGCB (STAFILE | LOGFILE," ** Mode not defined.");
rc = 2;
return rc;
}
}
