/* E04NE_A1W_F C++ Header Example Program.
*
* Copyright 2020 Numerical Algorithms Group.
* Mark 27.1, 2020.
*/
#include <nag.h>
#include <dco.hpp>
#include <nagad.h>
#include <stdio.h>
#include <math.h>
#include <iostream>
#include <string>
using namespace std;
int main(void)
{
// Scalars
int exit_status = 0;
cout << "E04NE_A1W_F C++ Header Example Program Results\n\n";
// Create AD tape
nagad_a1w_ir_create();
// Create AD configuration data object
Integer ifail = 0;
void *ad_handle = 0;
x10aa_a1w_f_(ad_handle,ifail);
// Skip first line of data file
string mystr;
getline (cin, mystr);
// Read problem sizes
Integer m, n, nclin;
cin >> m;
cin >> n;
cin >> nclin;
Integer liwork = n;
Integer lda = m, sda = n, ldc = nclin, lb = n + nclin;
Integer lwork;
lwork = 9*n;
if (nclin>0) {
lwork = lwork + 2*n*n + 6*nclin;
}
nagad_a1w_w_rtype *a=0, *b_in=0, *b=0, *bl=0, *bu=0, *c=0;
nagad_a1w_w_rtype *cvec=0, *clamda=0, *work=0, *x=0, *rwsav=0;
Integer *istate=0, *iwork=0, *iwsav=0, *kx;
logical *lwsav=0;
double *db=0, *dbl=0, *dbu=0;
a = new nagad_a1w_w_rtype [lda*sda];
b = new nagad_a1w_w_rtype [m];
b_in = new nagad_a1w_w_rtype [m];
bl = new nagad_a1w_w_rtype [lb];
bu = new nagad_a1w_w_rtype [lb];
c = new nagad_a1w_w_rtype [nclin*n];
clamda = new nagad_a1w_w_rtype [lb];
x = new nagad_a1w_w_rtype [n];
kx = new Integer [n];
work = new nagad_a1w_w_rtype [lwork];
rwsav = new nagad_a1w_w_rtype [475];
lwsav = new logical [120];
istate = new Integer [lb];
iwork = new Integer [liwork];
iwsav = new Integer [610];
db = new double [m];
dbl = new double [lb];
dbu = new double [lb];
// Read problem parameters and register for differentiation
double yr;
for (int i=0; i<m; i++) {
for (int j=0; j<n; j++) {
Integer k = i + j*m;
cin >> yr;
a[k] = yr;
}
}
for (int i=0; i<m; i++) {
cin >> yr;
b_in[i] = yr;
}
for (int i=0; i<nclin; i++) {
for (int j=0; j<n; j++) {
Integer k = i + j*nclin;
cin >> yr;
c[k] = yr;
}
}
for (int i=0; i<lb; i++) {
cin >> yr;
bl[i] = yr;
}
for (int i=0; i<lb; i++) {
cin >> yr;
bu[i] = yr;
}
for (int i=0; i<n; i++) {
cin >> yr;
x[i] = yr;
}
for (int i=0; i<m; i++) {
nagad_a1w_ir_register_variable(&b_in[i]);
}
for (int i=0; i<lb; i++) {
nagad_a1w_ir_register_variable(&bl[i]);
nagad_a1w_ir_register_variable(&bu[i]);
}
// Initialize sav arrays
ifail = 0;
char cwsav[1];
e04wb_a1w_f_("E04NCA",cwsav,1,lwsav,120,iwsav,610,rwsav,475,ifail,6,1);
// Set option via string
e04ne_a1w_f_("Print Level = -1",lwsav,iwsav,rwsav,16);
// Solve the problem
for (int i=0; i<m; i++) {
b[i] = b_in[i];
}
Integer iter;
nagad_a1w_w_rtype obj;
ifail = -1;
e04nc_a1w_f_(ad_handle,m,n,nclin,ldc,lda,c,bl,bu,cvec,istate,kx,x,a,
b,iter,obj,clamda,iwork,liwork,work,lwork,lwsav,iwsav,rwsav,
ifail);
// Primal results
double inc = 1.0;
cout.setf(ios::scientific,ios::floatfield);
if (ifail==0 || ifail>1) {
cout.precision(4);
cout << "\n Optimal objective function value = ";
cout.width(12); cout << nagad_a1w_get_value(obj) << endl;
cout << "\n Solution point: " << endl;
for (int i=0; i<n; i++) {
cout.width(8); cout << i;
cout.width(12); cout << nagad_a1w_get_value(x[i]) << endl;
}
} else {
cout << "e04nc_a1w_f_ failed with ifail = " << ifail << endl;
goto END;
}
cout << "\n Derivatives calculated: First order adjoints\n";
cout << " Computational mode : algorithmic\n\n";
cout << " Derivatives:\n\n";
// Setup evaluation of derivatives of fsumsq via adjoints.
nagad_a1w_inc_derivative(&obj,inc);
nagad_a1w_ir_interpret_adjoint(ifail);
for (int i=0; i<m; ++i) {
db[i] = nagad_a1w_get_derivative(b_in[i]);
}
for (int i=0; i<lb; ++i) {
dbl[i] = nagad_a1w_get_derivative(bl[i]);
dbu[i] = nagad_a1w_get_derivative(bu[i]);
}
cout << "\nDerivatives of obj w.r.t. B, BL and BU\n\n";
NagError fail;
INIT_FAIL(fail);
x04cac(Nag_ColMajor,Nag_GeneralMatrix,Nag_NonUnitDiag,1,m,db,1,
" dobj/dB",0,&fail);
cout << endl;
x04cac(Nag_ColMajor,Nag_GeneralMatrix,Nag_NonUnitDiag,1,lb,dbl,1,
" dobj/dBL",0,&fail);
cout << endl;
x04cac(Nag_ColMajor,Nag_GeneralMatrix,Nag_NonUnitDiag,1,lb,dbu,1,
" dobj/dBU",0,&fail);
END:
// Remove computational data object and tape
x10ab_a1w_f_(ad_handle,ifail);
nagad_a1w_ir_remove();
delete [] a;
delete [] b;
delete [] b_in;
delete [] bl;
delete [] bu;
delete [] c;
delete [] clamda;
delete [] x;
delete [] kx;
delete [] work;
delete [] rwsav;
delete [] lwsav;
delete [] istate;
delete [] iwork;
delete [] iwsav;
delete [] db;
delete [] dbl;
delete [] dbu;
return exit_status;
}