/* F11BD_A1W_F C++ Header Example Program.
*
* Copyright 2019 Numerical Algorithms Group.
* Mark 27, 2019.
*/
#include <dco.hpp>
#include <nag.h>
#include <nagx04.h>
#include <nagad.h>
#include <stdio.h>
#include <nag_stdlib.h>
#include <iostream>
using namespace std;
int main(void)
{
int exit_status = 0;
void *ad_handle = 0;
Integer ifail = 0;
cout << "F11BD_A1W_F C++ Header Example Program Results\n\n";
// Skip heading in data file
string mystr;
getline (cin, mystr);
// Read problem size
Integer n, m;
double alphar;
cin >> n;
cin >> m;
cin >> alphar;
// Allocate arrays containing A and its factorized form, B
// and the solution X.
nagad_a1w_w_rtype *b=0, *x=0, *work=0;
double *dx;
Integer lwork = 2*m*n + 1000;
if (!(b = NAG_ALLOC(n, nagad_a1w_w_rtype)) ||
!(x = NAG_ALLOC(n, nagad_a1w_w_rtype)) ||
!(work = NAG_ALLOC(lwork, nagad_a1w_w_rtype)) ||
!(dx = NAG_ALLOC(2*n, double))) {
cout << "Allocation failure\n";
exit_status = -1;
exit (exit_status);
}
// Create AD tape
nagad_a1w_ir_create();
nagad_a1w_w_rtype alpha, bb, b1, a, c;
alpha = alphar;
b1 = 12.0;
a = 1.0;
c = 1.0;
bb = b1 - 2.0;
nagad_a1w_ir_register_variable(&alpha);
nagad_a1w_ir_register_variable(&bb);
// Create AD configuration data object
ifail = 0;
x10aa_a1w_f_(ad_handle,ifail);
for (int i=0; i<n; ++i) {
b[i] = b1*(i+1);
x[i] = 3.0;
}
b[n-1] = b[n-1] - (n+1);
b[0] = b[0] + (b1-1.0)*alpha;
for (int i=1; i<n-1; ++i) {
b[i] = b[i] + b1*alpha;
}
b[n-1] = b[n-1] + (b1-1.0)*alpha;
// Initialize rthe solver
Integer iterm = 2, maxitn = 800, monit = 0, lwreq = lwork;
nagad_a1w_w_rtype sigmax = 0.0, anorm;
nagad_a1w_w_rtype tol = 1.0e-10;
ifail = 0;
f11bd_a1w_f_(ad_handle,"RGMRES","P","2","N",iterm,n,m,tol,maxitn,
anorm,sigmax,monit,lwreq,work,lwork,ifail,6,1,1,1);
// Reverse communication call of solver
Integer irevcm = 0;
nagad_a1w_w_rtype wgt[1];
while (irevcm != 4) {
ifail = 0;
f11be_a1w_f_(ad_handle,irevcm,x,b,wgt,work,lwreq,ifail);
if (irevcm != 4) {
ifail = -1;
if (irevcm == -1) {
// b = A^Tx
b[0] = bb*x[0] + a*x[1];
for (int i=1; i<n-1; ++i) {
b[i] = c*x[i-1] + bb*x[i] + a*x[i+1];
}
b[n-1] = c*x[n-2] + bb*x[n-1];
}
if (irevcm == 1) {
// b = Ax
b[0] = bb*x[0] + c*x[1];
for (int i=1; i<n-1; ++i) {
b[i] = a*x[i-1] + bb*x[i] + c*x[i+1];
}
b[n-1] = a*x[n-2] + bb*x[n-1];
}
if (irevcm == 2) {
for (int i=0; i<n; ++i) {
b[i] = x[i]/bb;
}
}
}
}
cout.setf(ios::scientific,ios::floatfield);
cout.precision(2);
cout << " Solution vector Residual vector\n";
for (int i=0;i<n;++i) {
cout.width(12);cout << nagad_a1w_get_value(x[i]) << " ";
cout.width(13);cout << nagad_a1w_get_value(b[i]) << endl;
}
cout << "\n\n Derivatives calculated: First order adjoints\n";
cout << " Computational mode : algorithmic\n";
cout << "\n Derivatives of diagonal of L w.r.t first column of A:\n";
// Obtain derivatives
for (int i=0; i<n; i++) {
// Reset adjoints, initialize derivative, and evaluate adjoint
nagad_a1w_ir_zero_adjoints();
double inc = 1.0;
nagad_a1w_inc_derivative(&x[i],inc);
ifail = 0;
nagad_a1w_ir_interpret_adjoint_sparse(ifail);
dx[i] = nagad_a1w_get_derivative(alpha);
dx[n+i] = nagad_a1w_get_derivative(bb);
}
// Print derivatives
cout << endl;
NagError fail;
INIT_FAIL(fail);
x04cac(Nag_ColMajor,Nag_GeneralMatrix,Nag_NonUnitDiag,n,2,dx,n,
" d/dalpha d/ddiag",0,&fail);
// Remove computational data object and tape
ifail = 0;
x10ab_a1w_f_(ad_handle,ifail);
nagad_a1w_ir_remove();
return exit_status;
}