C      ALGORITHM 755, COLLECTED ALGORITHMS FROM ACM.
C      THIS WORK PUBLISHED IN TRANSACTIONS ON MATHEMATICAL SOFTWARE,
C      VOL. 22, NO. 2, June, 1996, P.  131--167.
C
C This file contains 5 files separated by lines of the form
C         C*** filename
C
C The filenames in this file are:
C
C README               dex.shar             exa.shar            
C install.shar         src.shar                                 
C
C*** README
   --------------------------------------------------------------
   ADOL-C version 1.6 as of January 1,    1995
   --------------------------------------------------------------

ADOL-C = Automatic Differentiation by Overloading in C/C++ 


This directory  contains the subdirectories
SRC  (ADOL-C source and examples in SRC/EXA and SRC/DEX )

To run ADOL-C you should also untar the file
adol-c.ins.tar consisting of UNIX scripts and makefiles
into this directory.

The tarfile adol-c.doc.tar can be handled separately.
C*** dex.shar
#! /bin/sh
# This is a shell archive.  Remove anything before this line, then unpack
# it by saving it into a file and typing "sh file".  To overwrite existing
# files, type "sh file -c".  You can also feed this as standard input via
# unshar, or by typing "sh <file", e.g..  If this archive is complete, you
# will see the following message at the end:
#		"End of shell archive."
# Contents:  README detexam.c gaussexam.c odexam.c scalexam.c
#   vectexam.c
# Wrapped by trh@tempest on Thu Jun 20 15:35:01 1996
PATH=/bin:/usr/bin:/usr/ucb ; export PATH
if test -f 'README' -a "${1}" != "-c" ; then 
  echo shar: Will not clobber existing file \"'README'\"
else
echo shar: Extracting \"'README'\" \(395 characters\)
sed "s/^X//" >'README' <<'END_OF_FILE'
X   --------------------------------------------------------------
X   ADOL-C version 1.6 as of January 1,   1995
X   --------------------------------------------------------------
X
XThe directory */SRC/DEX contains the files
Xdetexam.c     makefile      scalexam.c
Xgaussexam.c   odexam.c      vectexam.c
X
XTo compile them use the make command after calling ???install. 
XSee */INS/README for details.
END_OF_FILE
if test 395 -ne `wc -c <'README'`; then
    echo shar: \"'README'\" unpacked with wrong size!
fi
chmod +x 'README'
# end of 'README'
fi
if test -f 'detexam.c' -a "${1}" != "-c" ; then 
  echo shar: Will not clobber existing file \"'detexam.c'\"
else
echo shar: Extracting \"'detexam.c'\" \(2116 characters\)
sed "s/^X//" >'detexam.c' <<'END_OF_FILE'
X/*
X   --------------------------------------------------------------
X   File detexam.c of ADOL-C version 1.6 as of January 1,   1995
X   --------------------------------------------------------------
X   detexam.c contains the determinant example described in the
X   manual
X*/
X
X#include "adouble.h"
X#include "adutils.h"
X#include <stream.h>
X
Xadouble** A;                        // A is an n x n matrix
Xint n;                              // k <= n is the order
Xadouble det(int k, int m) {         // of the submatrix
X  if(m == 0 ) return 1.0 ;          // its column indices
X  else {                            // are encoded in m.
X    adouble* pt = A[k-1];
X    adouble t =0 ;
X    int s, p =1;
X    if (k%2) s = 1; else s = -1;
X    for(int i=0;i<n;i++) {
X      int p1 = 2*p;
X      if ( m%p1 >= p ) {
X        t += *pt*s*det(k-1, m-p);   // Recursive call to det.
X        s = -s; }
X      ++pt;
X      p = p1; }
X    return t; }
X}
X
Xvoid main() {
X  int i, m=1,tag=1,keep=1;
X  cout << "order of matrix = ? \n"; // Select matrix size
X  cin >> n;
X  A = new adouble*[n];              // or adoublem A(n,n);
X  trace_on(tag,keep);               //      tag=1=keep
X  double detout=0.0 , diag = 1.0;   // here keep the intermediates for
X  for (i=0; i<n; i++) {             // the subsequent call to reverse
X    m *=2;
X    A[i] = new adouble[n];          // not needed for adoublem
X    adouble* pt = A[i];
X    for (int j=0;j<n; j++)
X      A[i][j] <<= j/(1.0+i);        //make all elements of A independent
X    diag += value(A[i][i]);         //value(adouble) converts to double
X    A[i][i] += 1.0; }
X  det(n,m-1) >>= detout;            // Actual function call.
X  printf("\n %f - %f = %f  (should be 0)\n",detout,diag,detout-diag);
X  trace_off();
X  double u[1];
X  u[0] = 1.0;
X  double* B = new double[n*n];
X  reverse(tag,1,n*n,1,u,B);
X  cout <<" \n first base? : ";
X  for (i=0;i<n;i++) {
X    adouble sum = 0;
X    for (int j=0;j<n;j++)           // The matrix A times the first n
X      sum += A[i][j]*B[j];          // components of the gradient B
X    cout<<value(sum)<<" "; }        // must be a Cartesian basis vector
X  cout<<"\n";
X}
X
END_OF_FILE
if test 2116 -ne `wc -c <'detexam.c'`; then
    echo shar: \"'detexam.c'\" unpacked with wrong size!
fi
chmod +x 'detexam.c'
# end of 'detexam.c'
fi
if test -f 'gaussexam.c' -a "${1}" != "-c" ; then 
  echo shar: Will not clobber existing file \"'gaussexam.c'\"
else
echo shar: Extracting \"'gaussexam.c'\" \(4105 characters\)
sed "s/^X//" >'gaussexam.c' <<'END_OF_FILE'
X/*
X   --------------------------------------------------------------
X   File gaussexam.c of ADOL-C version 1.6 as of January 1,   1995
X   --------------------------------------------------------------
X   gaussexam.c contains the example with gaussian elimination
X   described in the manual
X*/
X
X#include <stream.h>
X#include <stdio.h>
X#ifdef __GNUG__
X#include <std.h>
X#else
X#include <stdlib.h>
X#endif
X
X#include "adouble.h"    // These includes provide the compiler with
X#include "adutils.h"    // definitions and utilities for `adoubles'.
X
Xvoid gausselim(int n, adoublem& A, adoublev& bv)
X{
X  along i;              // active integer declaration
X  adoublev temp(n);     // active vector declaration 
X  adouble r,rj,temps;
X  int j,k;
X  for (k=0; k < n; k++) // elimination loop 
X  {
X    i = k;
X    r = fabs(A[k][k]);  // initial pivot size 
X    for (j=k+1; j<n; j++)
X    {
X      rj = fabs(A[j][k]); 
X      // look for a larger element in the same column 
X      condassign(i,rj-r,j); // conditional assignment 
X      condassign(r,rj-r,rj);
X    } // endfor
X    temp = A[i]; // switch rows using active subscripting
X    A[i] = A[k]; // necessary even if i happens to equal 
X    A[k] = temp; // k during taping
X    temps = bv[i];
X    bv[i]=bv[k];
X    bv[k]=temps;
X    if (!value(A[k][k])) // passive subscripting
X      exit(1); // Matrix singular! 
X    temps= A[k][k];
X    A[k] /= temps;
X    bv[k] /= temps;
X    for (j=k+1; j<n; j++)
X    {
X      temps= A[j][k];
X      A[j] -= temps*A[k]; // vector operations
X      bv[j] -= temps*bv[k];
X    } // endfor
X  } // endfor elimination loop
X  temp=0.0;
X  for(k=n-1; k >= 0; k--)  // backsubstitution
X     temp[k] = (bv[k]-(A[k]*temp))/A[k][k];
X  bv=temp;
X  return;
X} // end gausselim
X
Xvoid main() 
X{
X  int i,j;
X  short tag = 1;
X  int dum=1;
X  const int size=5;
X  const int indep=size*size+size;
X  const int depen=size;
X  double* arguments=new double[indep];
X  double* taylors=new double[depen];
X  double yp[size],xp[size*size+size];  // passive variable
X  double **A_1, **A_2, *a_1, *a_2, *b_1, *b_2;
X  A_1=(double**)malloc(size*sizeof(double*));
X  A_2=(double**)malloc(size*sizeof(double*));
X  a_1=(double*)malloc(size*sizeof(double));
X  a_2=(double*)malloc(size*sizeof(double));
X  b_1=(double*)malloc(size*sizeof(double));
X  b_2=(double*)malloc(size*sizeof(double));
X  for(i=0;i<size;i++){
X    A_1[i]=(double*)malloc(size*sizeof(double));
X    A_2[i]=(double*)malloc(size*sizeof(double));
X    a_1[i]=i*0.25;
X    a_2[i]=i*0.5;
X    b_1[i]=i*0.33;
X    b_2[i]=i*0.68;
X  } // endfor 
X  for(i=0;i<size;i++) {
X    for(j=0;j<size;j++) {
X      A_1[i][j]=a_1[i]*b_1[j];
X      A_2[i][j]=a_2[i]*b_2[j];
X    } // endfor 
X    A_1[i][i]+=i+1;
X    A_2[i][i]+=i+1.5;
X  } // endfor
X  adoublem A(size,size);
X  adoublev bv(size);  // active variables
X  int N=size*size;
X  trace_on(tag,dum);   // Begin taping all calculations with 'adoubles'
X  for(i=0;i<size;i++)
X  {
X    for(j=0;j<size;j++)
X    {
X      A[i][j]<<=A_1[i][j]; /* indep. vars */
X      arguments[i*size+j]=A_1[i][j]; /* args for forward */
X    } /* endfor */
X  } /* endfor */
X  for(i=0;i<size;i++)
X  {
X    bv[i]<<=-i-1; /* indep. vars */
X    arguments[N+i]=-i-1; /* args for forward */
X  }
X  gausselim(size,A,bv);
X  bv >>= yp;
X  trace_off(); 
X  forward(tag,depen,indep,0,1,arguments,taylors);
X  cout << "Compare the calculated solution components of the\nforward sweep and the direct evaluation: forward - direct = 0 ?\n";
X  for(i=0;i<depen;i++)
X  cout << taylors[i] << " - " << yp[i] << " = " << taylors[i] - yp[i] << "\n";
X  // use the same tape for an other system matrix:
X  for(i=0;i<size;i++)
X  {
X    for(j=0;j<size;j++)
X    {
X      arguments[j*size+i]=A_2[i][j]; /* new args for forward */
X      A[i][j]=A_2[i][j]; /* new args for gausselim */
X    } /* endfor */
X    bv[i]=-i-1; /* old indep. vars */
X  } /* endfor */
X  gausselim(size,A,bv); //calculation without taping
X  forward(tag,depen,indep,0,1,arguments,taylors);
X  cout << "\nThe same comparison for a different system matrix: \n";
X  for(i=0;i<depen;i++)
X  cout << taylors[i] << " - " << value(bv[i]) << " = " << taylors[i] - value(bv[i]) << "\n";
X} // endmain
X
END_OF_FILE
if test 4105 -ne `wc -c <'gaussexam.c'`; then
    echo shar: \"'gaussexam.c'\" unpacked with wrong size!
fi
chmod +x 'gaussexam.c'
# end of 'gaussexam.c'
fi
if test -f 'odexam.c' -a "${1}" != "-c" ; then 
  echo shar: Will not clobber existing file \"'odexam.c'\"
else
echo shar: Extracting \"'odexam.c'\" \(1915 characters\)
sed "s/^X//" >'odexam.c' <<'END_OF_FILE'
X/*
X   --------------------------------------------------------------
X   File odeexam.c of ADOL-C version 1.6 as of January 1,   1995
X   --------------------------------------------------------------
X   odeexam.c contains the ODE example described in the manual
X*/
X
X#include "adouble.h"
X#include "adutils.h"
X#include <stream.h>
X
Xvoid tracerhs(short int tag, double* py, double* pyprime) {
Xadoublev y(3);             //This time we left the parameters
Xadoublev yprime(3);        // passive and use the vector types.
Xtrace_on(tag);
Xy <<= py;                  //Initialize and mark independents
Xyprime[0] = -sin(y[2]) + 1e8*y[2]*(1-1/y[0]);
Xyprime[1] = -10*y[0] + 3e7*y[2]*(1-y[1]);
Xyprime[2] = -yprime[0] - yprime[1];
Xyprime >>= pyprime;        //Mark and pass dependents
Xtrace_off(tag);
X} // end tracerhs
X
Xvoid main() {
Xint i,j,deg;  
Xint n=3;
Xdouble py[3];
Xdouble pyp[3];
Xcout << "degree of Taylor series =?\n";
Xcin >> deg;
Xdouble **X;
XX=(double**)malloc(n*sizeof(double*));
Xfor(i=0;i<n;i++)
X  X[i]=(double*)malloc((deg+1)*sizeof(double));
Xdouble*** Z=new double**[n];
Xdouble*** B=new double**[n];
Xshort** nz = new short*[n];
Xfor(i=0;i<n;i++) {
X  Z[i]=new double*[n];
X  B[i]=new double*[n];
X  for(j=0;j<n;j++){
X    Z[i][j]=new double[deg];
X    B[i][j]=new double[deg];
X  } // end for 
X} // end for 
Xfor(i=0;i<n;i++) {
X  py[i] = (i == 0) ? 1.0 : 0.0;       // Initialize the base point
X  X[i][0] = py[i];                    // and the Taylor coefficient;
X  nz[i] = new short[n];               // set up sparsity array
X} // end for                        
Xtracerhs(1,py,pyp);                   // trace RHS with tag = 1
Xforode(1,n,deg,X);                    // compute deg coefficients
Xreverse(1,n,n,deg-1,Z,nz);            // U defaults to the identity
Xaccode(n,deg-1,Z,B,nz);
Xcout << "nonzero pattern:\n";
Xfor(i=0;i<n;i++) {
X  for(j=0;j<n;j++)
X    cout << nz[i][j]<<"\t";
X  cout <<"\n"; 
X} // end for 
X} // end main
END_OF_FILE
if test 1915 -ne `wc -c <'odexam.c'`; then
    echo shar: \"'odexam.c'\" unpacked with wrong size!
fi
chmod +x 'odexam.c'
# end of 'odexam.c'
fi
if test -f 'scalexam.c' -a "${1}" != "-c" ; then 
  echo shar: Will not clobber existing file \"'scalexam.c'\"
else
echo shar: Extracting \"'scalexam.c'\" \(2566 characters\)
sed "s/^X//" >'scalexam.c' <<'END_OF_FILE'
X/*
X   --------------------------------------------------------------
X   File scalexam.c of ADOL-C version 1.6 as of January 1,   1995
X   --------------------------------------------------------------
X   scalexam.c contains the scalar example described in the
X   manual
X*/
X
X#include "adouble.h"
X#include "adutils.h"
X#include <stream.h>
X
Xadouble power(adouble x, int n) {
Xadouble z=1;
Xif (n>0) {                         // Recursion and branches
X  int nh =n/2;                     // that do not depend on
X  z = power(x,nh);                 // adoubles are fine !!!!
X  z *= z;
X  if (2*nh != n) 
X    z *= x;
X  return z; 
X} // end if
Xelse {
X  if (n==0)                        // The local adouble z dies
X    return z;                      // as it goes out of scope.
X  else 
X    return 1/power(x,-n); 
X} // end else    
X} // end power
X
Xvoid main() {
Xint i,tag=1;
Xcout<<"monomial degree=? \n";      // Input the desired degree.
Xint n; cin >> n;
X/*Allocations and Initializations*/
Xdouble* Y[1];
X*Y = new double[n+2];
Xdouble* X[1];                      // Allocate passive variables with
X*X = new double[n+4];              // extra dimension for derivatives
XX[0][0] = 0.5;                     // function value = 0. coefficient
XX[0][1] = 1.0;                     // first derivative = 1. coefficient
Xfor(i=0; i < n+2; i++)
X  X[0][i+2]=0;                     // further coefficients.
Xdouble* Z[1];                      // used for checking consistency
X*Z = new double[n+2];              // between forward and reverse
Xadouble y,x;                       // Declare active variables
X/*Beginning of Active Section*/
Xtrace_on(1);                       // tag = 1 and keep = 0
Xx <<= X[0][0];                     // Only one independent var
Xy = power(x,n);                    // Actual function call
Xy >>= Y[0][0];                     // Only one dependent adouble
Xtrace_off();                       // No global adouble has died
X/*End of Active Section */
Xdouble u[1];                       // weighting vector
Xu[0]=1;                            // for reverse call
Xfor(i=0; i < n+2; i++) {           // Note that keep = i+1 in call
X  forward(tag,1,1,i,i+1,X,Y);      // Evaluate the i-the derivative
X  if (i==0)
X    cout << Y[0][i] << " - " << value(y) << " = " << Y[0][i]-value(y)
X    << " (should be 0)\n";
X  else
X    cout << Y[0][i] << " - " << Z[0][i] << " = " << Y[0][i]-Z[0][i] 
X    << " (should be 0)\n";
X  reverse(tag,1,1,i,u,Z);         // Evaluate the (i+1)-st deriv.
X  Z[0][i+1]=Z[0][i]/(i+1);        // Scale derivative to Taylorcoeff.
X} // end for 
X} // end main
X
END_OF_FILE
if test 2566 -ne `wc -c <'scalexam.c'`; then
    echo shar: \"'scalexam.c'\" unpacked with wrong size!
fi
chmod +x 'scalexam.c'
# end of 'scalexam.c'
fi
if test -f 'vectexam.c' -a "${1}" != "-c" ; then 
  echo shar: Will not clobber existing file \"'vectexam.c'\"
else
echo shar: Extracting \"'vectexam.c'\" \(1835 characters\)
sed "s/^X//" >'vectexam.c' <<'END_OF_FILE'
X/*
X   --------------------------------------------------------------
X   File vectexam.c of ADOL-C version 1.6 as of January 1,   1995
X   --------------------------------------------------------------
X   vectexam.c contains the vector example described in the
X   manual
X*/
X
X#include "adouble.h"
X#include "adutils.h"
X#include <stream.h>
X#include <math.h>
X
Xvoid main() {
Xint n,i,j,counts[12];
Xcout << "number of independent variables = ?  \n";
Xcin >> n;
Xdouble* xp = new double[n];          
Xadouble* x = new adouble[n];         // or: adoublev x(n);
Xfor(i=0;i<n;i++)
X  xp[i] = (i+1.0)/(2.0+i);           // some initialization
Xtrace_on(1);                         // tag =1, keep=0 by default
Xadouble y = 1;
Xfor(i=0;i<n;i++){
X  x[i] <<= xp[i];                    // or  x<<= xp outside the loop
X  y *= x[i]; 
X} // end for
Xdouble yp=0.0;
Xy >>= yp;
Xdelete[] x;                          // Not needed if x adoublev
Xtrace_off();
Xtapestats(1,counts);                 // Reading of tape statistics
Xcout<<"maxlive "<<counts[2]<<"\n";
X// ..... print other tape stats
Xdouble* g = new double[n];           // or: doublev g(n);
Xgradient(1,n,xp,g);                  // gradient evaluation
Xdouble** H=(double**)malloc(n*sizeof(double*));
Xfor(i=0;i<n;i++)
X  H[i]=(double*)malloc((i+1)*sizeof(double)); 
Xhessian(1,n,xp,H);                   // H equals (n-1)g since g is
Xdouble errg =0;                      // homogeneous of degree n-1.
Xdouble errh =0;
Xfor(i=0;i<n;i++) 
X  errg += fabs(g[i]-yp/xp[i]);       // vanishes analytically.
Xfor(i=0;i<n;i++) {
X  for(j=0;j<n;j++) {
X    if (i>j)                         // lower half of hessian
X      errh += fabs(H[i][j]-g[i]/xp[j]); 
X  } // end for 
X} // end for
Xcout << yp-1/(1.0+n) << " error in function \n";
Xcout << errg <<" error in gradient \n";
Xcout << errh <<" consistency check \n";
X} // end main
X
X
END_OF_FILE
if test 1835 -ne `wc -c <'vectexam.c'`; then
    echo shar: \"'vectexam.c'\" unpacked with wrong size!
fi
chmod +x 'vectexam.c'
# end of 'vectexam.c'
fi
echo shar: End of shell archive.
exit 0
C*** exa.shar
#! /bin/sh
# This is a shell archive.  Remove anything before this line, then unpack
# it by saving it into a file and typing "sh file".  To overwrite existing
# files, type "sh file -c".  You can also feed this as standard input via
# unshar, or by typing "sh <file", e.g..  If this archive is complete, you
# will see the following message at the end:
#		"End of shell archive."
# Contents:  README detexam.c eutroph.c gaussexam.c helm-auto-exam.c
#   helm-diff-exam.c helm-vect-exam.c od2exam.c odexam.c scalexam.c
#   shuttlexam.c vectexam.c
# Wrapped by trh@tempest on Thu Jun 20 15:35:21 1996
PATH=/bin:/usr/bin:/usr/ucb ; export PATH
if test -f 'README' -a "${1}" != "-c" ; then 
  echo shar: Will not clobber existing file \"'README'\"
else
echo shar: Extracting \"'README'\" \(700 characters\)
sed "s/^X//" >'README' <<'END_OF_FILE'
X   --------------------------------------------------------------
X   ADOL-C version 1.6 as of January 1,   1995
X   --------------------------------------------------------------
X
XThe directory */SRC/EXA contains the files
Xdetexam.c         helm-auto-exam.c  makefile          scalexam.c
Xeutroph.c         helm-diff-exam.c  od2exam.c         shuttlexam.c
Xgaussexam.c       helm-vect-exam.c  odexam.c          vectexam.c
X
XTo compile them use the make command after calling ???install.
XRead */INS/README for details.
X
XSome of the examples are extended versions of the documented 
Xexamples in */SRC/DEX. Others provide timing and correctness
Xinformation or use some of the more specialized capabilities.
END_OF_FILE
if test 700 -ne `wc -c <'README'`; then
    echo shar: \"'README'\" unpacked with wrong size!
fi
chmod +x 'README'
# end of 'README'
fi
if test -f 'detexam.c' -a "${1}" != "-c" ; then 
  echo shar: Will not clobber existing file \"'detexam.c'\"
else
echo shar: Extracting \"'detexam.c'\" \(3421 characters\)
sed "s/^X//" >'detexam.c' <<'END_OF_FILE'
X/*
X   --------------------------------------------------------------
X   Testexample  of ADOL-C version 1.6 as of January 1,   1995
X   --------------------------------------------------------------
X*/
X
X#include "adouble.h"
X#include "adutils.h"
X
X#ifdef __GNUG__
X#include <std.h>
X#include <builtin.h>
X#else
X#include <stdlib.h>
X#endif
X
X#include <stdio.h>
X#include <stream.h>
X#include <time.h>
Xint n,it;
Xdouble** PA;
Xdouble pdet(int k, int m) 
X  {
X    if(m == 0 ) return 1.0 ;
X    else
X    {
X    double* pt = PA[k-1];
X    double t=0 ;
X    int p =1;
X    int s;
X    if (k%2) s = 1;
X    else s = -1;
X    for(int i=0;i<n;i++)
X      {
X       int p1 = 2*p;
X       if ( m%p1 >= p )
X	 {
X          t += *pt*s*pdet(k-1, m-p);
X          s = -s;
X	  }
X       ++pt;
X       p = p1;
X     } 
X   return t;
X    }
X  }
X
Xadouble** A;
Xadouble det(int k, int m) 
X  {
X    if(m == 0 ) return 1.0 ;
X    else
X    {
X    adouble* pt = A[k-1];
X    adouble t=0 ;
X    int p =1;
X    int s;
X    if (k%2) s = 1;
X    else s = -1;
X    for(int i=0;i<n;i++)
X      {
X       int p1 = 2*p;
X       if ( m%p1 >= p )
X	 {
X          t += *pt*s*det(k-1, m-p);
X          s = -s;
X	  }
X       ++pt;
X       p = p1;
X     } 
X   return t;
X    }
X  }
Xvoid main()
X{
X   int i;
X   int tag = 1;
X   printf("order of matrix = ? \n",n);
X   scanf("%d",&n);
X   A = new adouble*[n];
X   PA = new double*[n];
X   int n2 =n*n;
X   double* a = new double[n2];
X   double diag;
X   diag = 0;
X   int m=1;
X   double t00 = myclock();
X   trace_on(tag,m);
X   int loc =0;
X   for (i=0; i<n; i++) 
X      {
X       m *=2;
X       A[i] = new adouble[n];
X       PA[i] = new double[n];
X//     printf("\n %d  ",i);
X       adouble* pt = A[i];
X       double* ppt = PA[i];
X       for (int j=0;j<n; j++)
X	  {
X	  *pt++ <<= j/(1.0+i);
X	  *ppt++ = j/(1.0+i);
X	  a[loc++] = j/(1.0+i);
X//	  printf("%f  ",value(A[i][j]));
X	  }
X       diag += value(A[i][i]);   // val corrected to value 2/23/91
X       A[i][i] += 1.0; 
X       PA[i][i] += 1.0; 
X       }
X    diag += 1;
X    adouble deter; 
X    deter = det(n,m-1);
X    double detout=0.0;
X    deter >>= detout;
X    printf("\n %f =? %f should be the same \n",detout,diag);
X    trace_off();
X    double t12 = myclock();
X    int itu; itu=8-n; itu=itu*itu*itu*itu;
X    itu = itu > 0 ? itu : 1;
X    double raus;
X    for(it = 0; it < itu; it++)
X       raus = pdet(n,m-1);
X    double t13 = myclock();
X    double rtu = itu/(t13-t12);
X//    cout << itu <<" reps -> time "<< 1/rtu <<"\n";
X//    cout << t0-tm1+t1-t01 <<"= file time \n";
X    double* B = new double[n2];
X    double* detaut = new double[1];
X    double t11 = myclock();
X    for(it = 0; it < itu; it++)
X    forward(tag,1,n2,0,1,a,detaut);
X    double t21 = myclock();
X    double u[1];
X    u[0] = 1.0;
X    for(it = 0; it < itu; it++)
X    reverse(tag,1,n2,1,u,B);
X    double t31 = myclock();
X//  for(i=0;i<n2;i++) cout<<"xbar["<<i<<"][0] --> "<<B[i][0]<<"\n";
X    cout << "\n first base? :   \n";
X    for (i=0;i<n;i++) 
X      {
X      adouble sum = 0;
X      adouble* pt;
X      pt = A[i];
X      for (int j=0;j<n;j++)
X         sum += (*pt++)*B[j];
X      cout << value(sum) <<" ";
X      }
X      cout << "\n";
X      cout << "\n times for "
X      <<"\n tracing: \t"<< (t11-t00)*rtu  
X      <<" units \t" << (t11-t00) << "    seconds "
X      <<"\n forward: \t"<< (t21-t11)*rtu/itu 
X      <<" units \t" << (t21-t11)/itu << "    seconds "
X      <<"\n reverse: \t"<<(t31-t21)*rtu/itu
X      <<" units \t" << (t31-t21)/itu << "    seconds \n";
X}
END_OF_FILE
if test 3421 -ne `wc -c <'detexam.c'`; then
    echo shar: \"'detexam.c'\" unpacked with wrong size!
fi
chmod +x 'detexam.c'
# end of 'detexam.c'
fi
if test -f 'eutroph.c' -a "${1}" != "-c" ; then 
  echo shar: Will not clobber existing file \"'eutroph.c'\"
else
echo shar: Extracting \"'eutroph.c'\" \(4136 characters\)
sed "s/^X//" >'eutroph.c' <<'END_OF_FILE'
X/*
X   --------------------------------------------------------------
X   Testexample  of ADOL-C version 1.6 as of January 1,   1995
X   --------------------------------------------------------------
X*/
X
X#include "adouble.h"
X#include "adutils.h"
Xvoid eutroph(unsigned short tag, double* px,  double* pxp)
X{
Xdouble IK=0.11 ;
Xdouble FRZ=0.3 ;
Xdouble EFFUZ=0.6;
Xdouble PRITZ=1.0e-3;
Xdouble RESP=5.0e-3;
Xdouble sinK=5.0e-3;
Xdouble PRITA=0.1;
Xdouble RZ=1.0e-2;
Xdouble K2=4.0e-2;
Xdouble K3=5.0e-1;
Xdouble KSP=2.0e2;
Xdouble KSF=1.0;
Xdouble BETA=100.0/1.25;
Xdouble ALPHA=0.002;
Xdouble TRZ=2;
Xdouble EPSP = 0.4;
Xdouble FI1 = 230.4;
Xdouble FI3=282.8;
Xdouble FI4=127.5;
Xdouble FI5=141.9;
Xdouble p = 40.0;
Xdouble DEPTH = 45;
X/************* fix controls ********/
Xdouble PRFOS = 0.5*p;
Xdouble M = 0.1;
Xdouble ZMIX = (45+RZ)/2;
Xdouble QIV=0.297E-02/3;
X/******initialize adoubles *************/
Xadouble x[5],xp[5];
Xint i;
Xtrace_on(tag);
Xfor(i=0;i<4;i++)
X  x[i]<<= px[i];
Xadouble T;
XT <<= px[4];
Xxp[4] = 1;
Xdouble tdum=0.0;
Xadouble TEMP=9.5+7.9*sin(T+FI1);
Xadouble FOTOP = 12.0+4.19*sin(T+280.0);
Xadouble I=229.0+215.0*sin(T+FI3)+15.3*sin(2.0*T+FI4)+ 21.7*sin(3.0*T+FI5);
Xadouble PIDI=.8+.25*cos(T)-.12*cos(2.*T);
Xdouble MORITZ = 0.075;
Xdouble Q = 0.786E6;
Xdouble VND = 0.265E9;
Xdouble V = VND;
Xif (T<72) I *= 0.603;
Xadouble EPS = ALPHA * x[0] + x[3] + EPSP;
Xadouble temp = I * exp(-EPS*ZMIX);
Xadouble temp2 = 2*IK*FOTOP;
Xadouble GROW;
XGROW = 1.2*FOTOP/EPS/ZMIX * (1.333 * atan ( I / temp2 )
X -IK*FOTOP / I * log( 1 + pow( (I /temp2 ),2) ) 
X -1.333 * atan ( temp / temp2)
X +IK*FOTOP/temp* log( 1+pow(temp/temp2, 2) )) * x[2] /(KSF+x[2]) 
X       * 0.366 * pow(K2,0.52) * exp(0.09*TEMP) * pow(x[0],(1-0.52));
Xxp[0] = GROW - RESP * TEMP * x[0] - FRZ * x[0] * x[1] - sinK * PIDI * x[0] 
X          + (PRITA - x[0]) * Q/VND;
Xxp[1] = FRZ * x[0] / K2 * x[1] / 1000 * EFFUZ*KSP / KSP+x[0] 
X             - RZ * x[1] - MORITZ * x[1] + (PRITZ - x[1] ) * Q/V;
Xxp[2] = K3 * (-GROW + RESP * TEMP * x[0] + FRZ * x[0] * x[1] *
X              (1 - EFFUZ*KSP /(KSP+x[0]) ) + RZ * K2 * 1000 *
X              x[1] + MORITZ * K2 * 1000 * x[1] ) + (PRFOS - x[2])* Q/V;
Xxp[3] = (- x[3] * Q  + BETA * M / TRZ)/VND;
Xfor (i=0;i<4;i++)
X  xp[i] >>= pxp[i];
Xxp[4] >>= tdum;
Xtrace_off();
X}
X
Xvoid eutroph(double* px,  double* pxp)
X{
Xdouble IK=0.11 ;
Xdouble FRZ=0.3 ;
Xdouble EFFUZ=0.6;
Xdouble PRITZ=1.0e-3;
Xdouble RESP=5.0e-3;
Xdouble sinK=5.0e-3;
Xdouble PRITA=0.1;
Xdouble RZ=1.0e-2;
Xdouble K2=4.0e-2;
Xdouble K3=5.0e-1;
Xdouble KSP=2.0e2;
Xdouble KSF=1.0;
Xdouble BETA=100.0/1.25;
Xdouble ALPHA=0.002;
Xdouble TRZ=2;
Xdouble EPSP = 0.4;
Xdouble FI1 = 230.4;
Xdouble FI3=282.8;
Xdouble FI4=127.5;
Xdouble FI5=141.9;
Xdouble p = 40.0;
Xdouble DEPTH = 45;
X/************* fix controls ********/
Xdouble PRFOS = 0.5*p;
Xdouble M = 0.1;
Xdouble ZMIX = (45+RZ)/2;
Xdouble QIV=0.297E-02/3;
X/******initialize doubles *************/
Xdouble x[5],xp[5];
Xint i;
Xfor(i=0;i<4;i++)
X  x[i]= px[i];
Xdouble T;
XT = px[4];
Xxp[4] = 1;
Xdouble TEMP=9.5+7.9*sin(T+FI1);
Xdouble FOTOP = 12.0+4.19*sin(T+280.0);
Xdouble I=229.0+215.0*sin(T+FI3)+15.3*sin(2.0*T+FI4)+ 21.7*sin(3.0*T+FI5);
Xdouble PIDI=.8+.25*cos(T)-.12*cos(2.*T);
Xdouble MORITZ = 0.075;
Xdouble Q = 0.786E6;
Xdouble VND = 0.265E9;
Xdouble V = VND;
Xif (T<72) I *= 0.603;
Xdouble EPS = ALPHA * x[0] + x[3] + EPSP;
Xdouble temp = I * exp(-EPS*ZMIX);
Xdouble temp2 = 2*IK*FOTOP;
Xdouble GROW;
XGROW = 1.2*FOTOP/EPS/ZMIX * (1.333 * atan ( I / temp2 )
X -IK*FOTOP / I * log( 1 + pow( (I /temp2 ),2) ) 
X -1.333 * atan ( temp / temp2)
X +IK*FOTOP/temp* log( 1+pow(temp/temp2, 2) )) * x[2] /(KSF+x[2]) 
X       * 0.366 * pow(K2,0.52) * exp(0.09*TEMP) * pow(x[0],(1-0.52));
Xxp[0] = GROW - RESP * TEMP * x[0] - FRZ * x[0] * x[1] - sinK * PIDI * x[0] 
X          + (PRITA - x[0]) * Q/VND;
Xxp[1] = FRZ * x[0] / K2 * x[1] / 1000 * EFFUZ*KSP / KSP+x[0] 
X             - RZ * x[1] - MORITZ * x[1] + (PRITZ - x[1] ) * Q/V;
Xxp[2] = K3 * (-GROW + RESP * TEMP * x[0] + FRZ * x[0] * x[1] *
X              (1 - EFFUZ*KSP /(KSP+x[0]) ) + RZ * K2 * 1000 *
X              x[1] + MORITZ * K2 * 1000 * x[1] ) + (PRFOS - x[2])* Q/V;
Xxp[3] = (- x[3] * Q  + BETA * M / TRZ)/VND;
Xfor (i=0;i<5;i++)
X  pxp[i] = xp[i];
X}
END_OF_FILE
if test 4136 -ne `wc -c <'eutroph.c'`; then
    echo shar: \"'eutroph.c'\" unpacked with wrong size!
fi
chmod +x 'eutroph.c'
# end of 'eutroph.c'
fi
if test -f 'gaussexam.c' -a "${1}" != "-c" ; then 
  echo shar: Will not clobber existing file \"'gaussexam.c'\"
else
echo shar: Extracting \"'gaussexam.c'\" \(8616 characters\)
sed "s/^X//" >'gaussexam.c' <<'END_OF_FILE'
X/*
X   --------------------------------------------------------------
X   Testexample  of ADOL-C version 1.6 as of January 1,   1995
X   --------------------------------------------------------------
X*/
X
X#include <stream.h>
X#include <stdio.h>
X
X#ifdef __GNUG__
X#include <std.h>
X#else
X#include <stdlib.h>
X#endif
X#include "usrparms.h"
Xextern "C" {
X#include "taputil3.h"
X}
X#include "adouble.h"    // These includes provide the compiler with
X#include "adutils.h"    // definitions and utilities for `adoubles'.
X
Xvoid gausselim(int n, adoublem& A, adoublev& bv)
X{
X  along i;
X  adoublev temp(n);
X  adouble r,rj,temps;
X  int j,k,ik;
X  for (k=0; k < n; k++)
X  {
X    for(j=0;j<n;j++)
X      cout << value(A[k][j]) << "  ";
X    cout << "             " << value(bv[k]) << "\n";
X  }
X  cout << "initial state ----------------------\n";
X  for (k=0; k < n; k++) /* elimination loop */
X  {
X    i = k;
X    r = fabs(A[k][k]); /* initial pivot element */
X    for (j=k+1; j<n; j++)
X    {
X      rj = fabs(A[j][k]); /* look for a greater element in the same column */
X       condassign(i,(rj >r),j);
X       condassign(r,(rj >r),rj);
X    } // endfor
X     cout << i << "index \n";
X    temp = A[i];
X    A[i] = A[k];
X    A[k] = temp; /* exchange  of rows */
X    temps = bv[i];
X    bv[i]=bv[k];
X    bv[k]=temps;
X    if (!value(A[k][k]))
X    {
X      cout << " Matrix does not have full rank!\n";
X      exit(-1);
X    } // endif
X    cout << "changed rows: ---------------------\n";
X    for (ik=0; ik < n; ik++)
X    {
X    for(j=0;j<n;j++)
X      cout << value(A[ik][j]) << "  ";
X    cout << "             " << value(bv[ik]) << "\n";
X    }
X    temps= A[k][k];
X    A[k] = A[k]/temps;
X    bv[k] = bv[k] /temps;
X    for (j=k+1; j<n; j++)
X    {
X      temps= A[j][k];
X      A[j] -= temps*A[k];
X      bv[j] -= temps*bv[k];
X    } // endfor
X    cout << "step:---------------------------\n";
X    for (ik=0; ik < n; ik++)
X    {
X    for(j=0;j<n;j++)
X      cout << value(A[ik][j]) << "  ";
X    cout << "             " << value(bv[ik]) << "\n";
X    }
X  } // endfor elimination loop
X  temp=0.0;
X  for(k=n-1; k >= 0; k--)
X  {
X     temp[k] = (bv[k]-(A[k]*temp))/A[k][k];
X      cout << value(temp[k]) << "\n";
X  }
X  bv=temp;
X  return;
X} // end gausselim
X
X
Xvoid main() 
X{
X  int i,j,k,l=1,ok=1;
X  short tag = 1;
X  double epsilon=0.0000000001; // max. allowed difference between results
X  int dum=1;
X  const int max_deg=4; // maximal order of derivation
X  const int tayl_num=2; // Number of taylor series
X  int pages=1; // for eventually writing the tape to a file
X  const int size=5;
X  const int indep=size*size+size;
X  const int depen=size;
X  const int laglength=2;
X  double*lagras=new double[depen];
X  for(i=0;i<depen;i++)
X   lagras[i]=i+1;
X  double** lagrav=myalloc(laglength,depen);
X  for(j=0;j<laglength;j++)
X  {
X    for(i=0;i<depen;i++)
X      lagrav[j][i]=j+i+1;
X  } // endfor
X  short** nonzero=new short*[laglength];
X  for(i=0;i<laglength;i++)
X    nonzero[i]=new short[indep];
X  double** resultshos=myalloc(indep,max_deg);
X  double*** resultshov=myalloc(laglength,indep,max_deg);
X  double* resultsfos=new double[indep];
X  double** resultsfov=myalloc(laglength,indep);
X  double* basepoint=new double[indep];
X  double* valuepoint=new double[depen];
X  double*** arguments=myalloc(indep,tayl_num,max_deg);
X  double*** scalargs=myalloc(tayl_num,indep,max_deg+1);
X  double*** scalres=myalloc(tayl_num,depen,max_deg+1);
X  double*** taylors=myalloc(depen,tayl_num,max_deg);
X
X  double yp[size],xp[size*size+size];  // passive variable
X  adoublem A(size,size);
X  adoublev bv(size);  // active variables
X  int N=size*size;
X  trace_on(tag,dum);   // Begin taping all calculations with 'adoubles'
X  for(i=0;i<size;i++)
X  {
X    for(j=0;j<size;j++)
X    {
X      A[i][j]<<=pow(1+j,i); /* indep. vars */
X      xp[i*size+j]=pow(1+j,i); /* args for forward */
X    } /* endfor */
X  } /* endfor */
X  for(i=0;i<size;i++)
X  {
X    bv[i]<<=-i-1; /* indep. vars */
X    xp[N+i]=-i-1; /* args for forward */
X  }
X  gausselim(size,A,bv);
X  bv >>= yp;
X  trace_off(); 
X  int buf_size,maxlive,deaths;
X  int tape_stats[11];  /* tape stats */
X  tapestats(tag,tape_stats);
X
X  maxlive = tape_stats[2];
X  deaths = tape_stats[3];
X  buf_size =  tape_stats[4];
X
X  // initialization for Forward - testing +++++++++++++++++++++++++++++++++++++
X
X  basepoint=xp;
X  for(i=0;i<tayl_num;i++)
X  {
X    for(j=0;j<indep;j++)
X    {
X      scalargs[i][j][0]=xp[j];
X    } // endfor 
X  } // endfor 
X  for(i=0;i<indep;i++)
X  {
X    for(j=0;j<tayl_num;j++)
X    {
X      for(k=0;k<max_deg;k++)
X      {
X        arguments[i][j][k]=i+j+k+3;
X        scalargs[j][i][k+1]=i+j+k+3;
X      } // endfor
X    } // endfor
X  } // endfor
X
X  // calculation ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
X  for(i=0;i<tayl_num;i++)
X    hos_forward(tag,depen,indep,max_deg,1,scalargs[i],scalres[i]);
X  hov_forward(tag,depen,indep,max_deg,tayl_num,basepoint,arguments,valuepoint,taylors);
X  // test for correctness +++++++++++++++++++++++++++++++++++++++++++++++
X  for(i=0;i<depen;i++)
X  {
X    cout << "dependent variable number "<< i << "\n";
X    for(j=0;j<tayl_num;j++)
X    {
X      cout << "taylor serie number " << j << "\n";
X      cout <<"hov_f. valuepoint["<<i<<"]: "<< valuepoint[i] << " =?     hos_f. scalres["<<j<<"]["<<i<<"][0]: " << scalres[j][i][0] << "   =? yp["<<i<<"] : " << yp[i] << "\n";
X      if (fabs(valuepoint[i]-scalres[j][i][0])>epsilon)
X      {
X        cout << "difference is here <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<\n";
X        ok=0;
X      }
X      for(k=0;k<max_deg;k++)
X      {
X        cout <<"hov_f. taylors["<<i<<"]["<<j<<"]["<<k<<"]:"<< taylors[i][j][k] <<"  =?   hos_f. scalres["<<j<<"]["<<i<<"]["<<k+1<<"]: " << scalres[j][i][k+1] << "   <- inp. coeff.: " << scalargs[j][i][k+1] << "\n";
X        if (fabs(taylors[i][j][k]-scalres[j][i][k+1])>epsilon)
X        {
X          cout << "difference is here <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<\n";
X          ok=0;
X        } // endif
X      } // endfor
X    } // endfor
X  } // endfor
X
X  // some preparation for the 4 different reverse modes: -----------------
X  hos_forward(tag,depen,indep,max_deg,max_deg,scalargs[0],scalres[0]);
X  cout << "reverse sweeps will be done for the first taylor serie only\n";
X  hos_reverse(tag,depen,indep,max_deg-1,lagras,resultshos);
X  hov_reverse(tag,depen,indep,max_deg-1,laglength,lagrav,resultshov,nonzero);
X  hos_forward(tag,depen,indep,max_deg,1,scalargs[0],scalres[0]);
X  fos_reverse(tag,depen,indep,lagras,resultsfos);
X  fov_reverse(tag,depen,indep,laglength,lagrav,resultsfov);
X  // output
X  for (i=0;i<laglength;i++)
X  {
X    if (i==0)
X    {
X    for (j=0;j<indep;j++)    
X    {
X      for (k=0;k<max_deg;k++)
X      {
X        if (k==0)
X        {
X          cout << "reshov["<<i<<"]["<<j<<"]["<<k<<"]: "<<  resultshov[i][j][k] << " =? reshos["<<j<<"]["<<k<<"]: "<<  resultshos[j][k] << " =? resfov["<<i<<"]["<<j<<"]: "<<  resultsfov[i][j] << " =? resfos["<<j<<"]: "<< resultsfos[j] << "\n";
X          if ((fabs(resultshov[i][j][k]-resultshos[j][k])>epsilon) || (fabs(resultshov[i][j][k]- resultsfov[i][j])>epsilon) || (fabs(resultshov[i][j][k]-resultsfos[j])>epsilon))
X          {
X            cout << "difference is here <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<\n";
X            ok=0;
X          } // endif
X        } // endif
X        else
X        {
X          cout << "reshov["<<i<<"]["<<j<<"]["<<k<<"]: "<<  resultshov[i][j][k] << " =? reshos["<<j<<"]["<<k<<"]: "<<  resultshos[j][k] << "\n";
X          if (fabs(resultshov[i][j][k]-resultshos[j][k])>epsilon)
X          {
X            cout << "difference is here <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<\n";
X            ok=0;
X          } // endif
X        } // endelse
X      } // endfor
X    } // endfor
X    } // endif 
X    else
X    {
X    for (j=0;j<indep;j++)    
X    {
X      for (k=0;k<max_deg;k++)
X      {
X        if (k==0)
X        {
X          cout << "reshov["<<i<<"]["<<j<<"]["<<k<<"]: "<<  resultshov[i][j][k] << " =? resfov["<<i<<"]["<<j<<"]: "<<  resultsfov[i][j]  << "\n";
X          if (fabs(resultshov[i][j][k]- resultsfov[i][j])>epsilon)
X          {
X	    cout << "difference is here <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<\n";
X            ok=0;
X          } // endif
X        } // endif
X        else
X          cout << "reshov["<<i<<"]["<<j<<"]["<<k<<"]: "<<  resultshov[i][j][k] << "\n";
X      } // endfor
X    } // endfor
X    } // endelse
X  } // endfor 
X  for (i=0;i<laglength;i++)
X  {
X    for (j=0;j<indep;j++)
X    cout << "nonzero["<<i<<"]["<<j<<"]: " << nonzero[i][j] << "\n";
X  } // endfor 
X  if (! ok)
X    cout << "calculation  is not ok<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<\n This message may be caused by very small differences (not necessary \nrecognizable in the output)\n";
X} // endmain  
X
END_OF_FILE
if test 8616 -ne `wc -c <'gaussexam.c'`; then
    echo shar: \"'gaussexam.c'\" unpacked with wrong size!
fi
chmod +x 'gaussexam.c'
# end of 'gaussexam.c'
fi
if test -f 'helm-auto-exam.c' -a "${1}" != "-c" ; then 
  echo shar: Will not clobber existing file \"'helm-auto-exam.c'\"
else
echo shar: Extracting \"'helm-auto-exam.c'\" \(2003 characters\)
sed "s/^X//" >'helm-auto-exam.c' <<'END_OF_FILE'
X/*
X   --------------------------------------------------------------
X   Testexample  of ADOL-C version 1.6 as of January 1,   1995
X   --------------------------------------------------------------
X*/
X
X
X#include "adouble.h"
X#include "adutils.h"
X#include <stream.h>
X#include <stdio.h>
X
X#ifdef __GNUG__
X#include <std.h>
X#else
X#include <stdlib.h>
X#endif
X
X/* 
X   This program computes first order directional derivatives 
X   for the helmholtz energy function.
X*/
X    struct tms *buffer;
X    int n,deg,ideg;
X    adouble y,z,u;
X    adouble den,r,t0,t1,t2,t3;
X    adouble ttim[6];
X    adouble ttim2[6];
X    adouble bx,te,he,xax,tem;
X 
Xadouble energy(int n,adouble x[], adouble bv[])
X{
X  adouble r,he;
X  int i,j;
X  xax = 0;
X  bx = 0;
X  he =0;
X  te =0;
X  
X  for (i=0; i < n; i++)
X    {
X      he += x[i]*log(x[i]);
X      bx +=  bv[i]*x[i];
X      tem = (2.0/(1.0+i+i))*x[i];
X      for (j=0; j<i; j++) 
X	tem += (1.0/(1.0+i+j))*x[j];
X      xax += x[i]*tem;
X    };
X  xax *= 0.5;
X  he = 1.3625E-3*(he-te*log(1.0-bx));
X  r=sqrt(2.0);
X  he = he - log((1+bx*(1+r))/(1+bx*(1-r)))*xax/bx;
X  
X  return he;
X}
X
X
X
Xvoid main( int argc,char *argv[]) 
X{
X  int nf,n,j;
X  if (argc < 2)
X    {
X      printf("Error- I expect at least one integer: #of independents/10 \n");
X      exit(-1);
X    }
X  nf = atoi(argv[1]); 
X  double r;
X  double result=0.0;
X  n = 10*nf; 
X  adouble* x=new adouble[n+1];
X  adouble* bv=new adouble[n+1];
X  adouble* dir=new adouble[n+1];
X  double* grad=new double[n+1];
X  r=  1.0/n;
X  for (j=0; j < n; j++) 
X    {
X      dir[j]=0.1*j;
X      bv[j]= 0.02*(1.0+fabs(sin(double(j))));
X    }
X  
X  int imd_rev =1;
X  trace_on(1,imd_rev);
X  for (j=0; j < n; j++) 
X    {
X      x[j]<<=r*sqrt(1.0+j);
X    }
X  he = energy(n,x,bv);
X  he >>= result;
X
X  trace_off();
X  printf("%f -- energy\n",result);
X  reverse(1,1,n,0,1.0,grad);
X  for (int l=0; l < n;l++)
X    {
X      printf("%d, %f,  \n",l,grad[l]);
X    }
X  printf("%f -- energy\n",result);
X  free((char*) x);
X  free((char*) bv);
X  free((char*) dir);
X  free((char*) grad);
X}
X
END_OF_FILE
if test 2003 -ne `wc -c <'helm-auto-exam.c'`; then
    echo shar: \"'helm-auto-exam.c'\" unpacked with wrong size!
fi
chmod +x 'helm-auto-exam.c'
# end of 'helm-auto-exam.c'
fi
if test -f 'helm-diff-exam.c' -a "${1}" != "-c" ; then 
  echo shar: Will not clobber existing file \"'helm-diff-exam.c'\"
else
echo shar: Extracting \"'helm-diff-exam.c'\" \(2078 characters\)
sed "s/^X//" >'helm-diff-exam.c' <<'END_OF_FILE'
X/*
X   --------------------------------------------------------------
X   Testexample  of ADOL-C version 1.6 as of January 1,   1995
X   --------------------------------------------------------------
X*/
X
X#include <sys/types.h>
X#include <stdio.h>
X#include <sys/times.h>
X#include <math.h>
X#include <stdlib.h>
X#define delta 0.000001
X
X/* 
X   This program computes first order directional derivatives 
X   for the helmholtz energy function.
X*/
X
X    struct tms *buffer;
X    int n,deg,ideg;
X    double y,z,u;
X    double den,r,t0,t1,t2,t3;
X    double ttim[6];
X    double ttim2[6];
X    double bx,te,he,xax,tem;
X 
Xdouble energy(int n,double x[],double bv[])
X{
X  double r,he;
X  int i,j;
X  xax = 0;
X  bx = 0;
X  he =0;
X  te =0;
X  
X  for (i=0; i < n; i++)
X    {
X      he += x[i]*log(x[i]);
X      bx +=  bv[i]*x[i];
X      tem = (2.0/(1.0+i+i))*x[i];
X      for (j=0; j<i; j++) 
X	tem += (1.0/(1.0+i+j))*x[j];
X      xax += x[i]*tem;
X    };
X  xax *= 0.5;
X  he = 1.3625E-3*(he-te*log(1.0-bx));
X  r=sqrt(2.0);
X  he = he - log((1+bx*(1+r))/(1+bx*(1-r)))*xax/bx;
X  
X  return he;
X}
X
X
Xvoid main(int argc,char *argv[]) 
X{
X  int nf;
X  int n,j,l;
X  double r;
X  double he2;
X  double he1;
X  double q;
X  double j_prime;
X  double *x;
X  double *bv;
X  double *dir;
X
X  if (argc < 2)
X    {
X      printf("Error- I expect at least one integer: #of independents/10 \n");
X      exit(-1);
X    }
X  nf = atoi(argv[1]);
X  n = 10*nf;
X  x  = (double *)malloc((n+1)*sizeof(double));
X  bv = (double *)malloc((n+1)*sizeof(double));
X  dir = (double *)malloc((n+1)*sizeof(double));
X  r=1.0/n;
X  for (j=0; j < n; j++) 
X    {
X      dir[j]=0.1*j;
X      j_prime = j;
X      bv[j]= 0.02*(1.0+fabs( sin( j_prime ) ) );
X      /* for (int i=0; i < n; i++) 
X	   am[i][j] = 1.0/(1.0+i+j); */
X    }
X  for (j=0; j < n; j++) 
X    {
X      x[j]=r*sqrt(1.0+j);
X    }
X  he = energy(n,x,bv); 
X  he2 = he;
X  printf("%f -- energy\n",he);
X  for (l=0; l < n;l++)
X    {
X      
X      x[l]=x[l]+delta;
X      he1 = energy(n,x,bv);
X      x[l]=x[l]-delta;
X      q = ((he1-he)/delta);
X      printf("%d, %f,  \n",l,q);
X    }
X  free(dir);
X  free(bv);
X  free(x);
X}
X
END_OF_FILE
if test 2078 -ne `wc -c <'helm-diff-exam.c'`; then
    echo shar: \"'helm-diff-exam.c'\" unpacked with wrong size!
fi
chmod +x 'helm-diff-exam.c'
# end of 'helm-diff-exam.c'
fi
if test -f 'helm-vect-exam.c' -a "${1}" != "-c" ; then 
  echo shar: Will not clobber existing file \"'helm-vect-exam.c'\"
else
echo shar: Extracting \"'helm-vect-exam.c'\" \(1846 characters\)
sed "s/^X//" >'helm-vect-exam.c' <<'END_OF_FILE'
X/*
X   --------------------------------------------------------------
X   Testexample  of ADOL-C version 1.6 as of January 1,   1995
X   --------------------------------------------------------------
X*/
X
X#include "adouble.h"
X#include "adutils.h"
X
X/* 
X   This program computes first order directional derivatives 
X   for the helmholtz energy function. Uses vector operations.
X  
X*/
X    struct tms *buffer;
X    int n,deg,ideg;
X    adouble y,z,u;
X    adouble den,r,t0,t1,t2,t3;
X    adouble ttim[6];
X    adouble ttim2[6];
X    adouble bx,te,he,xax,tem;
X 
Xadouble energy(int n, const adoublev &x, const  adoublev &bv)
X{
X  adouble r,he;
X  int i,j;
X  xax = 0;
X  bx = 0;
X  he =0;
X  te =0;
X  
X  bx =  bv*x;
X  for (i=0; i < n; i++)
X    {
X      he += x[i]*log(x[i]);
X      tem = (2.0/(1.0+i+i))*x[i];
X      for (j=0; j<i; j++) 
X	tem += (1.0/(1.0+i+j))*x[j];
X      xax += x[i]*tem;
X    };
X  xax *= 0.5;
X  he = 1.3625E-3*(he-te*log(1.0-bx));
X  r=sqrt(2.0);
X  he = he - log((1+bx*(1+r))/(1+bx*(1-r)))*xax/bx;
X  
X  return he;
X}
X
X
X
Xvoid main( int argc,char *argv[]) 
X{
X  int nf,n,j;
X  if (argc < 2)
X    {
X      printf("Error- I expect at least one integer: #of independents/10 \n");
X      exit(-1);
X    }
X  nf = atoi(argv[1]); 
X  double r;
X  double result=0.0;
X  n = 10*nf; 
X  double* grad=new double[n+1];
X  adoublev x(n);
X  adoublev bv(n);
X  adoublev dir(n);
X  double*  x_pri;
X  x_pri=(double*)malloc(n*sizeof(double));
X  r=  1.0/n;
X  for (j=0; j < n; j++) 
X    {
X      dir[j]=0.1*j;
X      bv[j]= 0.02*(1.0+fabs(sin(double(j))));
X      x_pri[j] =r*sqrt(1.0+j); 
X    }
X  
X  int imd_rev =1;
X  trace_on(1,imd_rev);
X  x<<= x_pri;
X
X  he = energy(n,x,bv);
X  he >>= result;
X
X  trace_off();
X  printf("%f -- energy\n",result);
X  reverse(1,1,n,0,1.0,grad);
X  for (int l=0; l < n;l++)
X    {
X      printf("%d, %f,  \n",l,grad[l]);
X    }
X  printf("%f -- energy\n",result);
X}
X
X
END_OF_FILE
if test 1846 -ne `wc -c <'helm-vect-exam.c'`; then
    echo shar: \"'helm-vect-exam.c'\" unpacked with wrong size!
fi
chmod +x 'helm-vect-exam.c'
# end of 'helm-vect-exam.c'
fi
if test -f 'od2exam.c' -a "${1}" != "-c" ; then 
  echo shar: Will not clobber existing file \"'od2exam.c'\"
else
echo shar: Extracting \"'od2exam.c'\" \(4565 characters\)
sed "s/^X//" >'od2exam.c' <<'END_OF_FILE'
X/*
X   --------------------------------------------------------------
X   Testexample  of ADOL-C version 1.6 as of January 1,   1995
X   --------------------------------------------------------------
X*/
X
X#include "adouble.h"
X#include "adutils.h"
X#include <stream.h>
X#include <stdio.h>
X
X#ifdef __GNUG__
X#include <std.h>
X#include <builtin.h>
X#else
X#include <stdlib.h>
X#endif
X
Xint const N=5;     // State Space Dimesion of ODE
X
X/**********************************************************
X   This orinigal cersion of the right hand side may be used
X   for run time comparisons. However, the results are not 
X   representative because the function is extremely small
X   and is likely to stay in cache if evaluated repeatedly.
X*********************************************************/
Xvoid eutroph(double*,double*);
Xvoid eutroph(unsigned short, double*,double*);
X
Xvoid main()
X{
X/*******************************************************
X   Select problem set up data and generate the tracerhs
X*******************************************************/
Xcout << "highest derivatives =? \n";
Xint D;
Xcin >> D;
Xint i,j,k;
Xint yes ;
Xdouble **z, *zz, *pyp;
Xz = myalloc(N,D+1);;
Xzz = new double[N];
Xpyp = new double[N];
X*z[0] = 0.5;
X*z[1] = 0.0005;
X*z[2] = 4.00;
X*z[3] = 0.0;
X*z[4] = 0.0;
Xfor (i=0;i<N;i++)
X  zz[i] = *z[i];
Xdouble*** B = myalloc(N,N,D);
Xdouble*** A = myalloc(N,N,D);
X/******************Compute the unit time for comparison**********/
Xdouble t0 = myclock();
Xfor(j=0;j<100;j++)
X{ zz[1] = 1.0/j;
Xeutroph(zz,pyp);}
Xdouble t1 = myclock();
Xcout << (t1-t0)/100 <<" unitime";
Xdouble rtu;
Xdouble stu;
Xif (t1-t0) {
X  rtu = 2*100.0/(t1-t0)/D/(D+1);
X  stu = 100.0/(t1-t0);
X}
Xelse {
X  rtu=0.0;
X  stu=0.0;
X}
X/******************Do the actual taping ********************/
Xunsigned short tag=0;
Xeutroph(tag,zz,pyp);
X
X/*******************************************************
X Check out forode and jacode for consistency on tape
X*******************************************************/
X
Xdouble tau;
Xcout <<"\nEnter nonzero scaling paramater \n ";
Xcin >> tau;
Xdouble **w = myalloc(N,D+1);;
Xshort** nonzero;
Xnonzero = new short*[N];
Xfor (i=0;i<N;i++)
X  nonzero[i] = new short[N];
Xdouble ten = D < 50 ? 50 : 1;
Xt0 = myclock();
Xfor(j=0;j<ten;j++)
Xforode(tag,N,tau,D,z);
Xt1 = myclock();
Xfor(j=0;j<ten;j++)
Xreverse (tag,N,N,D-1,A,nonzero);
Xdouble t2 = myclock();
Xfor(j=0;j<ten;j++)
Xaccode(N,tau,D-1,A,B,nonzero);
Xdouble t3 = myclock();
Xcout <<" Print out the nonzero pattern? \n";
Xcin >> yes;
Xif(yes)
X{
Xcout << " 4 = transcend , 3 = rational , 2 = polynomial , 1 = linear , 0 = zero \n";
Xcout << " negative number k indicate that entries of all B_j with j < -k vanish  \n";
Xfor(i=0;i<N;i++)
X   {
X   for(j=0;j<N;j++)
X      cout << nonzero[i][j] <<"   ";
X   cout <<"\n";
X   }
X}
X/****************************************************
X  The D+1 columns of z should now be consistent with the
X  ODE as represented by the time. Feeding z into forward
X  we obtain a coeffient array w, whose columns should
X  equal to the shifted and scaled columns of z
X*****************************************************/
Xcout <<"\nCheck that forward reproduces the Taylor series \n";
Xforward(tag,N,N,D-1,D,z,w);
Xdouble err = 0;
Xfor(i=0;i<D;i++)
X  {
X   for(j=0;j<N;j++)
X     {
X     double avg = (fabs(w[j][i]*tau)+fabs(z[j][i+1]*(i+1)))/2;
X     if (avg < 0.1) avg = 0.1;
X     if(avg) err += fabs(w[j][i]*tau-z[j][i+1]*(i+1))/avg;
X     }
X  }
Xcout << err << "= total error \n";
Xt0 /=ten;  t1 /= ten; t2 /= ten; t3 /= ten;
Xcout << (t1-t0)*stu<<" units or "<<(t1-t0)*rtu<<" scunits " << t1-t0<<" seconds just forode \n";
Xcout << (t2-t1)*stu<<" units or "<<(t2-t1)*rtu<<" scunits " << t2-t1<<" seconds just reverse \n";
Xcout << (t3-t2)*stu<<" units or "<<(t3-t2)*rtu<<" scunits " <<t3-t2<<" seconds just accode \n";
X/*  If desired print out Jacobians of Taylor coeffcients with
X   respect to the base point */
Xcout <<"\nPrint Jacobian of Taylor coefficient vectors? \n";
Xcin >> yes;
Xif(yes)
X  {
X  for(i=0;i<D;i++){
X    cout<<"\n\t<-- B("<<i<<")\n";
X    for(j=0;j<N;j++){
X      for(k=0;k<N;k++)
X        cout<<B[j][k][i]<<"  ";
X      cout<<"\n";}}
X  } 
Xcout <<"\n Enter increment for differencing, skipped if zero: \n"; 
Xdouble h;
Xcin >> h;
Xfor (i=0;i<N;i++)
X   *w[i] = *z[i];
Xif(h!=0)   
Xfor (i=0;i<D;i++)
X  {
X  err = 0;
X  for(k=0;k<N;k++)
X    {
X    *w[k] += h;
X    forode(tag,N,tau,D,w);
X    *w[k] -= h;
X    for(j=0;j<N;j++)
X      err += B[j][k][i] != 0 ? fabs(1-(w[j][i+1]-z[j][i+1])/h/B[j][k][i])
X	    : fabs((w[j][i+1]-z[j][i+1])/h) ;
X    };
Xcout<<"Relative truncation errors in B("<<i<<") ---> "<<err<<"\n"; 
X};  
X}
END_OF_FILE
if test 4565 -ne `wc -c <'od2exam.c'`; then
    echo shar: \"'od2exam.c'\" unpacked with wrong size!
fi
chmod +x 'od2exam.c'
# end of 'od2exam.c'
fi
if test -f 'odexam.c' -a "${1}" != "-c" ; then 
  echo shar: Will not clobber existing file \"'odexam.c'\"
else
echo shar: Extracting \"'odexam.c'\" \(5184 characters\)
sed "s/^X//" >'odexam.c' <<'END_OF_FILE'
X/*
X   --------------------------------------------------------------
X   Testexample  of ADOL-C version 1.6 as of January 1,   1995
X   --------------------------------------------------------------
X*/
X
X#include "adouble.h"
X#include "adutils.h"
X#include <stream.h>
X#include <stdio.h>
X
X#ifdef __GNUG__
X#include <std.h>
X#include <builtin.h>
X#else
X#include <stdlib.h>
X#endif
X
Xint const N=3;     // State Space Dimesion of ODE
X
X/**********************************************************
X   This orinigal cersion of the right hand side may be used
X   for run time comparisons. However, the results are not 
X   representative because the function is extremely small
X   and is likely to stay in cache if evaluated repeatedly.
X*********************************************************/
X
Xvoid tracerhs(double* y, double* yprime)
X{
Xyprime[0] = -sin(y[2]) + 1e8*y[2]*(1-1/y[0]);
Xyprime[1] = -10*y[0] + 3e7*y[2]*(1-y[1]);
Xyprime[2] = -yprime[0] - yprime[1];
X}
X
X/********************************************************
X   This overloaded function generates the tape by evaluating
X   the right hand side in terms of adouble variables.
X*********************************************************/
Xvoid tracerhs(unsigned int tag, double* py, double* pyprime)
X{
X// py must represent some feasible state space point
Xadouble y[N],yprime[N];
Xint i;
Xtrace_on(tag);
X
Xfor (i=0;i<N;i++)
X  y[i] <<= py[i];    //  Initialize and mark independents
Xyprime[0] = -sin(y[2]) + 1e8*y[2]*(1-1/y[0]);
Xyprime[1] = -10*y[1] + 3e7*y[2]*(1-y[1]);
Xyprime[2] = -yprime[0] - yprime[1];
Xfor (i=0;i<N;i++)
X   yprime[i] >>= pyprime[i];   // Mark and pass dependents
X
Xtrace_off();
X}
X
Xvoid main()
X{
X/*******************************************************
X   Select problem set up data and generate the tracerhs
X*******************************************************/
Xcout << "highest derivatives =? \n";
Xint D;
Xcin >> D;
Xint i,j,k;
Xint yes ;
Xdouble **z, *zz, *pyp;
Xz = new double*[N];
Xzz = new double[N];
Xpyp = new double[N];
Xfor (i=0;i<N;i++)
X  {
X  z[i] = new double[D+1];
X  if(i==0) {*z[i] = 1;} else *z[i] =0.0;
X  zz[i] = *z[i];
X  }
Xfor (i=0;i<N;i++)
X  zz[i] = *z[i];
Xdouble*** B = myalloc(N,N,D);
Xdouble*** A = myalloc(N,N,D);
X/******************Compute the unit time for comparison**********/
Xdouble t0 = myclock();
Xfor(j=0;j<10000;j++)
X{ zz[1] = 1.0/j;
Xtracerhs(zz,pyp);}
Xdouble t1 = myclock();
Xdouble rtu = 10000.0/(t1-t0);
X/******************Do the actual taping ********************/
Xunsigned short tag=0;
Xtracerhs(tag,zz,pyp);
X
X/*******************************************************
X Check out forode and jacode for consistency on tape
X*******************************************************/
X
Xdouble tau;
Xcout <<" Enter nonzero scaling paramater \n ";
Xcin >> tau;
Xdouble **w = myalloc(N,D+1);;
Xshort** nonzero;
Xnonzero = new short*[N];
Xfor (i=0;i<N;i++)
X  nonzero[i] = new short[N];
Xdouble ten = 200 ;// D < 50 ? 50 : D;
Xt0 = myclock();
Xfor(j=0;j<ten;j++)
Xforode(tag,N,tau,D,z);
Xt1 = myclock();
Xfor(j=0;j<ten;j++)
Xreverse (tag,N,N,D-1,A,nonzero);
Xdouble t2 = myclock();
Xfor(j=0;j<ten;j++)
Xaccode(N,tau,D-1,A,B,nonzero);
Xdouble t3 = myclock();
Xcout <<" Print out the nonzero pattern? \n";
Xcin >> yes;
Xif(yes)
X{
Xcout << " 4 = transcend , 3 = rational , 2 = polynomial , 1 = linear , 0 = zero \n";
Xcout << " negative number k indicate that entries of all B_j with j < -k vanish  \n";
Xfor(i=0;i<N;i++)
X   {
X   for(j=0;j<N;j++)
X      cout << nonzero[i][j] <<"   ";
X   cout <<"\n";
X   }
X}
X/****************************************************
X  The D+1 columns of z should now be consistent with the
X  ODE as represented by the time. Feeding z into forward
X  we obtain a coeffient array w, whose columns should
X  equal to the shifted and scaled columns of z
X*****************************************************/
Xcout <<"\nCheck that forward reproduces the Taylor series \n";
Xforward(tag,N,N,D-1,D,z,w);
Xdouble err = 0;
Xfor(i=0;i<D;i++)
X  {
X   for(j=0;j<N;j++)
X     {
X     double avg = (fabs(w[j][i]*tau)+fabs(z[j][i+1]*(i+1)))/2;
X     if (avg < 0.1) avg = 0.1;
X     if(avg) err += fabs(w[j][i]*tau-z[j][i+1]*(i+1))/avg;
X     }
X  }
Xcout << err << "= total error \n";
Xt0 /=ten;  t1 /= ten; t2 /= ten; t3 /= ten;
Xcout << (t1-t0)*rtu<<" units or "<<t1-t0<<" seconds just forode \n";
Xcout << (t2-t1)*rtu<<" units or "<<t2-t1<<" seconds just reverse \n";
Xcout << (t3-t2)*rtu<<" units or "<<t3-t2<<" seconds just accode \n";
X/*  If desired print out Jacobians of Taylor coeffcients with
X   respect to the base point */
Xcout <<"\nPrint Jacobian of Taylor coefficient vectors? \n";
Xcin >> yes;
Xif(yes)
X  {
X  for(i=0;i<D;i++){
X    cout<<"\n\t<-- B("<<i<<")\n";
X    for(j=0;j<N;j++){
X      for(k=0;k<N;k++)
X        cout<<B[j][k][i]<<"  ";
X      cout<<"\n";}}
X  } 
Xcout <<"\n Enter increment for differencing, skipped if zero: \n"; 
Xdouble h;
Xcin >> h;
Xfor (i=0;i<N;i++)
X   *w[i] = *z[i];
Xif(h!=0)   
Xfor (i=0;i<D;i++)
X  {
X  err = 0;
X  for(k=0;k<N;k++)
X    {
X    *w[k] += h;
X    forode(tag,N,tau,D,w);
X    *w[k] -= h;
X    for(j=0;j<N;j++)
X      err += B[j][k][i] != 0 ? fabs(1-(w[j][i+1]-z[j][i+1])/h/B[j][k][i])
X	    : fabs((w[j][i+1]-z[j][i+1])/h) ;
X    };
Xcout<<"Relative truncation errors in B("<<i<<") ---> "<<err<<"\n"; 
X};  
X}
END_OF_FILE
if test 5184 -ne `wc -c <'odexam.c'`; then
    echo shar: \"'odexam.c'\" unpacked with wrong size!
fi
chmod +x 'odexam.c'
# end of 'odexam.c'
fi
if test -f 'scalexam.c' -a "${1}" != "-c" ; then 
  echo shar: Will not clobber existing file \"'scalexam.c'\"
else
echo shar: Extracting \"'scalexam.c'\" \(4935 characters\)
sed "s/^X//" >'scalexam.c' <<'END_OF_FILE'
X/*
X   --------------------------------------------------------------
X   Testexample  of ADOL-C version 1.6 as of January 1,   1995
X   --------------------------------------------------------------
X*/
X
X#include <stream.h>
X#include <stdio.h>
X
X#ifdef __GNUG__
X#include <std.h>
X#else
X#include <stdlib.h>
X#endif
X
X/*  This program can be used to verify the consistency and correctness
Xof derivatives computed by ADOL-C in its forward and eevere mode.  
XThe use is required to selct one integer input id. For positive n = id
Xthe monomial x^n is evaluated recursively at x=0.5 and all its nonzero
XTaylor coeffcients at this point are evaluated in the forward and
Xreverse mode. A negative choice of id >= -9 leads to one of nine
Xidentities, whose derivatives should be trivial. These identities
Xmay be used to check the correctness of particular code segments
Xin the ADOL-C sources forward.c and reverse.c. No timings are
Xperformed in this example program */
X
X#include "adouble.h"    // These includes provide the compiler with
X#include "adutils.h"    // definitions and utilities for `adoubles'.
X
X//   The monomial evaluation routine which has been obtained from
X//   the original version by retyping all `doubles' as `adoubles'.
X
Xadouble power(adouble x, int n)
X  {
X  adouble z=1;
X  if (n>0)
X    {
X     int nh =n/2;
X     z = power(x,nh);
X     z *= z;
X     if (2*nh != n) z *= x;
X     return z;
X     }
X  else
X    {
X     if (n==0) 
X       return z;
X     else return 1.0/power(x,-n);
X    }
X  }
Xvoid main() 
X{
X  int n,i,id;
X  int tag = 0;
X  cout << "problem number(-1 .. -10) / degree of monomial =? \n";
X  cin >> id;
X  n = id >0 ? id : 3;
X  double *xp,*yp;
X  xp = new double[n+4];
X  yp = new double[n+4];
X  yp[0]=0;
X  xp[0] = 0.5;
X  xp[1] = 1.0;
X  adouble y,x; 
X  int dum=1; 
X  trace_on(tag,dum);   // Begin taping all calculations with 'adoubles'
X  x <<= xp[0];
X  if( id >= 0 )
X    { 
X    cout << "Evaluate and differentiate recursive power routine \n";
X    y = power(x,n);
X    }
X  else
X    {
X    cout<<"Check Operations and Functions by Algebraic Identities \n";
X    double pi = 2*asin(1.0);
X    switch (id)
X      {
X      case -1 : 
X	 cout << "Addition/Subtraction: y = x + x - (2.0/3)*x - x/3 \n";
X	 y =  x + x - (2.0/3)*x - x/3 ;
X	 break;
X      case -2 : 
X         cout << "Multiplication/divison:  y = x*x/x \n";
X         y = x*x/x;
X	 break;
X      case -3 :
X	 cout << "Square root and power: y = sqrt(pow(x,2)) \n"; 
X	 y = sqrt(pow(x,2));
X	 break;
X      case -4 :
X	 cout << "Exponential and log: y = exp(log(log(exp(x)))) \n";
X	 y = exp(log(log(exp(x))));
X	 break;
X      case -5 :
X	 cout << "Trig identity: y = x + sin(2*x)-2*cos(x)*sin(x) \n";
X	 y =  x + sin(2.0*x)-2.0*cos(x)*sin(x);
X	 break;
X      case -6 :
X         cout << "Check out quadrature macro \n";
X	 y = exp(myquad(myquad(exp(x))));
X	 break;
X      case -7 :
X	 cout << "Arcsin: y = sin(asin(acos(cos(x)))) \n";
X	 y = sin(asin(acos(cos(x))));
X	 break;
X      case -8 :
X	 cout << "Hyperbolic tangent: y = x + tanh(x)-sinh(x)/cosh(x) \n";
X	 y = x + tanh(x)-sinh(x)/cosh(x) ;
X	 break;
X      case -9 :
X	 cout << "Absolute value: y = x + fabs(x) - fabs(-x) \n";
X	 y = x + fabs(-x) - fabs(x);
X         break;
X      case -10 :
X	 cout << "atan2: y = atan2(sin(x-0.5+pi),cos(x-0.5+pi)) \n";
X	 y = atan2(sin(x),cos(x));
X         // y= tan(atan2(x,1.0));
X	 break;
X      default : cout << " Please select problem number >= -10 \n";
X		exit(-1);
X      }
X    cout << "Round-off error: " << value(y-x)  << " \n";
X    }
X  y >>= yp[0];
X  trace_off();  // The (partial) execution trace is completed.
X  int oper,indep,depen,buf_size,maxlive,deaths;
X  int tape_stats[11];
X  tapestats(tag,tape_stats);
X  indep = tape_stats[0];
X  depen = tape_stats[1];
X  buf_size = tape_stats[4];
X  oper = tape_stats[5];
X  deaths = tape_stats[3];
X  maxlive = tape_stats[2];
X
X  
X  cout<<"\n";
X  cout<<"independents "<<indep<<"\n";
X  cout<<"dependents   "<<depen<<"\n";
X  cout<<"operations   "<<oper<<"\n";
X  cout<<"buffer size  "<<buf_size<<"\n";
X  cout<<"maxlive      "<<maxlive<<"\n";
X  cout<<"deaths       "<<deaths<<"\n";
X  double *res;
X  res = new double[n+2];
X  double u[1]; 
X  u[0]=1;
X cout << "\nThe two Taylor coefficients in each row should agree\n\n";
X
X double ***V = (double***)new double**[1];
X V[0] = new double*[1];
X V[0][0] = new double[n+2];
X double **U = new double*[1]; 
X U[0] = new double[1];
X U[0][0] = 1;
X double** xpoint = &xp;
X double** ypoint = &yp;
X double** respoint = &res;
X cout << " \n \t   forward  \t    reverse  \n";
X for( i=0; i < n+2; i++)
X   {  
X   xp[i+2]=0;    
X   forward(tag,depen,indep,i,i+1,xpoint,respoint);
X   cout<< i <<"\t"<< res[i] <<"\t \t "<< yp[i] << "\n";
X   reverse(tag,depen,indep,i,u,ypoint); // call higher order scalar reverse
X   reverse(tag,depen,indep,i,1,U,V);
X   yp[i+1] = yp[i]/(i+1);
X   if(V[0][0][i] != yp[i])
X     cout << i <<"-th component in error "<<V[0][0][i]-yp[i] <<"\n";
X   }
X cout << "\nWhen n<0 all rows except the first two should vanish \n";
X }
END_OF_FILE
if test 4935 -ne `wc -c <'scalexam.c'`; then
    echo shar: \"'scalexam.c'\" unpacked with wrong size!
fi
chmod +x 'scalexam.c'
# end of 'scalexam.c'
fi
if test -f 'shuttlexam.c' -a "${1}" != "-c" ; then 
  echo shar: Will not clobber existing file \"'shuttlexam.c'\"
else
echo shar: Extracting \"'shuttlexam.c'\" \(7393 characters\)
sed "s/^X//" >'shuttlexam.c' <<'END_OF_FILE'
X/*
X   --------------------------------------------------------------
X   Testexample  of ADOL-C version 1.6 as of January 1,   1995
X   --------------------------------------------------------------
X*/
X
X#include "adouble.h"
X#include "adutils.h"
X#include <stream.h>
X#include <stdio.h>
X
X#ifdef __GNUG__
X#include <std.h>
X#else
X#include <stdlib.h>
X#endif
X
X#define tag 3
Xdouble getunitime(){
Xdouble t0 = myclock();
Xfor(int it=0;it<5000;it++)
X  {
X  double f[7];
X  double H,x,l,V,g,A,b,Hp,xp,lp,Vp,gp,Ap,bp,
X          r,gr,rho,L,cd,ma,Om,Z;
X  // *** Initialization of independent variables
X  H = 264039.328;
X  x = 177.718047;
X  l = 32.0417885;
X  V = 24317.0798;
X  g = -0.749986488;
X  A = 62.7883367;
X  b = 41.100771834;
X  Hp = -318;
X  xp = 0.01;
X  lp = 0.1;
X  Vp = -3.6;
X  gp = 0.001;
X  Ap = 0.1;
X  bp =0.06*(it+1);
X  double ae = 20902900;
X  double mu = 0.14E+17;
X  bp /= (it+1);
X  r = H+ae;
X  gr = mu/(r*r);
X  rho = .002378*exp(-H/23800.);
X  double a = 40;
X  double S =2690;
X  double crtd = 180/3.14;
X  double  cl = .84-.48*(38.-a*crtd)/26.;
X  L = .5*rho*cl*S*V*V;
X  cd = .78-.58*(38.-a*crtd)/26.;
X  ma = 5964.496499824;
X  Om = .72921159e-4;
X  Z = .5*rho*cd*S*V*V;
X  double C0 = 3.974960446019;
X  double C1 = -.01448947694635;
X  double C2 = -.2156171551995e-4;
X  double C3 = -.1089609507291e-7;
X  double V0 = 0;
X// evaluate the dynamic equations ...
X  double sing,cosg,sinA,cosA,sinl,cosl,tanl; 
X  sinA =sin(A);
X  cosA = cos(A);
X  sing =sin(g);
X  cosg = cos(g);
X  sinl=sin(l);
X  cosl=cos(l);
X  tanl = sinl/cosl;
X  f[0] = V*sing-Hp;
X  f[1] = V*cosg*sinA/(r*cosl)-xp;
X  f[2] = V*cosg*cosA/r-lp;
X  f[3] = -Z/ma-gr*sing-Om*Om*r*cosl
X         *(sinl*cosA*cosg-cosl*sing)-Vp;
X  f[4] = L*cos(b)/(ma*V)+cosl/V*(V*V/r-gr)
X         +2*Om*cosl*sinA
X	 +Om*Om*r*cosl/V*(sinl*cosA*sing+cosl*cosg)
X	 -gp;
X  f[5] = L*sin(b)/(ma*V*cosg)+V/r*cosg*sinA*tanl
X         -2*Om*(cosl*cosA*sing/cosg-sinl)
X	 +Om*Om*r*cosl*sinl*sinA/(V*cosg)-Ap;
X  f[6] = Z/ma - (C0+(V-V0)*(C1+(V-V0)*(C2+(V-V0)*C3)));
X  }
X  double t1 = myclock();
X  double ti = (t1-t0)/5000.0;
X  return ti ;
X}
X
Xvoid main() {
X  double rtu = 1.0/getunitime();
X  int i,j,k,deg;
X  adouble f[7];
X  adouble H,x,l,V,g,A,b,Hp,xp,lp,Vp,gp,Ap,bp,
X          r,gr,rho,L,cd,ma,Om,Z;
X  cout<<"\nenter the degree: "; cin>>deg; cout<<"\n";
X  trace_on(tag);
X  // *** Initialization of independent variables
X  H <<= 264039.328;
X  x <<= 177.718047;
X  l <<= 32.0417885;
X  V <<= 24317.0798;
X  g <<= -0.749986488;
X  A <<= 62.7883367;
X  b <<= 41.100771834;
X  Hp <<= -318;
X  xp <<= 0.01;
X  lp <<= 0.1;
X  Vp <<= -3.6;
X  gp <<= 0.001;
X  Ap <<= 0.1;
X  bp <<=0.06;
X  double ae = 20902900;
X  double mu = 0.14E+17;
X  r = H+ae;
X  gr = mu/(r*r);
X  rho = .002378*exp(-H/23800.);
X  double a = 40;
X  double S =2690;
X  double crtd = 180/3.14;
X  double  cl = .84-.48*(38.-a*crtd)/26.;
X  L = .5*rho*cl*S*V*V;
X  cd = .78-.58*(38.-a*crtd)/26.;
X  ma = 5964.496499824;
X  Om = .72921159e-4;
X  Z = .5*rho*cd*S*V*V;
X  double C0 = 3.974960446019;
X  double C1 = -.01448947694635;
X  double C2 = -.2156171551995e-4;
X  double C3 = -.1089609507291e-7;
X  double V0 = 0;
X// evaluate the dynamic equations ...
X  adouble sing,cosg,sinA,cosA,sinl,cosl,tanl; 
X  sinA =sin(A);
X  cosA = cos(A);
X  sing =sin(g);
X  cosg = cos(g);
X  sinl=sin(l);
X  cosl=cos(l);
X  tanl = sinl/cosl;
X  f[0] = V*sing-Hp;
X  f[1] = V*cosg*sinA/(r*cosl)-xp;
X  f[2] = V*cosg*cosA/r-lp;
X  f[3] = -Z/ma-gr*sing-Om*Om*r*cosl
X         *(sinl*cosA*cosg-cosl*sing)-Vp;
X  f[4] = L*cos(b)/(ma*V)+cosl/V*(V*V/r-gr)
X         +2*Om*cosl*sinA
X	 +Om*Om*r*cosl/V*(sinl*cosA*sing+cosl*cosg)
X	 -gp;
X  f[5] = L*sin(b)/(ma*V*cosg)+V/r*cosg*sinA*tanl
X         -2*Om*(cosl*cosA*sing/cosg-sinl)
X	 +Om*Om*r*cosl*sinl*sinA/(V*cosg)-Ap;
X  f[6] = Z/ma - (C0+(V-V0)*(C1+(V-V0)*(C2+(V-V0)*C3)));
X  // *** pass final values of active variables to passive variables
X  double res[7];
X  for(i=0;i<7;i++)
X    f[i] >>= res[i];
X  trace_off ();                  
X  // Set up correspondence between user's Variables and program Variables
X  const int m = 7;
X  const int n = 14;
X  double **X = myalloc(n,deg+1);     // independent variable values
X  double **Y = myalloc(m,deg+1);    // output Taylor coefficients
X  double **Y0 = myalloc(m,deg+1);   // output Taylor coefficients
X  X[0][0] = value(H);
X  X[1][0] = value(x);
X  X[2][0] = value(l);
X  X[3][0] = value(V);
X  X[4][0] = value(g);
X  X[5][0] = value(A);
X  X[6][0] = value(b);
X  X[7][0] = value(Hp);
X  X[8][0] = value(xp);
X  X[9][0] = value(lp);
X  X[10][0] = value(Vp);
X  X[11][0] = value(gp);
X  X[12][0] = value(Ap);
X  X[13][0] = value(bp);
X  srand(53);
X  for(i=1;i<=deg;i++)
X    for(j=0;j<n;j++)
X      X[j][i] = sin(rand());
X  double *u = new double[m];        // weighting vector for scalar reverse 
X  for (i=0;i<m;i++)
X    u[i] = 0.0;
X  double **S_rev = myalloc(n,deg+1); // result adjoints from scalar reverse
X  double ***V_rev = myalloc(m,n,deg+1);
X  double ***W_rev = myalloc(m,n,deg+1);
X  int rep, repu;
X  repu = (int)(100.0/(deg+1));
X  double epselon = 1.0e-3;
X // time divided differencing using forward
X   double t0 = myclock();
X   forward (tag,m,n,deg,0,X,Y);
X   for (i=0;i<n;i++) {             
X      X[i][0] *= 1+epselon;
X      for (rep =0;rep < repu ;rep ++)
X          forward (tag,m,n,deg,0,X,Y0);  // may wish to store columns of matrix :
X      double recx = 1.0/(epselon*X[i][0]);
X      for(k=0;k<=deg;k++)
X	  for(j=0;j<m;j++)
X              W_rev[j][i][k] = (Y0[j][k]-Y[j][k])*recx ;
X      X[i][0] /= 1+epselon; }         // (Y[1..m][deg] - yofx[1..m]) / epselon
X    double t1 = myclock();
X    forward(tag,m,n,deg,deg+1,X,Y);       // in preparation for reverse sweeps
X// time single vector reverse call
X    double t2 = myclock();
X    short** nonzero = new short*[7];
X    for (int ii=0;ii<7;ii++)
X       nonzero[ii] = new short[14];
X    for (rep =0;rep < repu ;rep ++)
X    reverse (tag,m,n,deg,V_rev,nonzero);// matrix is stored as :
X    double t3  = myclock();
X    cout <<" Print out the nonzero pattern? \n";
X    int yes; cin >> yes;
X    if(yes)
X    {
X  cout<<" 4 = transcend , 4 = rational , 2 = polynomial , 1 = linear , 0 = zero \n";
X    for(i=0;i<7;i++)
X      {
X      for(j=0;j<14;j++)
X         cout << nonzero[i][j] <<"   ";
X       cout <<"\n";
X       }
X     }
X// time multiple calls to scalar reverse
X    float err =0;
X    cout << "Print comparison between reverse and differences? \n"; 
X    cin >> yes;
X    double t4 = myclock();
X    for (i=0;i<m;i++) {
X      u[i] = 1;                     
X    for (rep =0;rep < repu ;rep ++)
X      reverse (tag,m,n,deg,u,S_rev);// rows of matrix are stored as :
X      u[i] = 0;                    // S_rev[1..n][deg]
X      for ( j=0;j<n;j++) 
X	 for (int k=0;k<=deg;k++)
X	   {
X	   double lerr= fabs(S_rev[j][k]-V_rev[i][j][k]);
X	   if (lerr != 0.0)
X	   err += lerr/ (fabs(S_rev[j][k])+fabs(V_rev[i][j][k]));
X	   if(yes && (S_rev[j][k] != 0 || W_rev[i][j][k] != 0) )
X 	   cout << S_rev[j][k] << " =?= " << W_rev[i][j][k] << "\n";
X	   }
X    }
X    double t5 = myclock();
X    cout<<"Jacobian discrepancy  : "<<err<<"  between reverse modes\n";
X    cout << "forward-eval:  " << rtu*(t1-t0)/(repu*n) << 
X    " units or  "<<(t1-t0)/(repu*n) <<"  seconds \n";
X    cout << "forward-diff:  " << rtu*(t1-t0)/repu <<
X    " units or  "<< (t1-t0)/repu <<"  seconds \n";
X    cout << "vect-reverse:  " << rtu*(t3-t2)/repu <<
X    " units or  "<< (t3-t2)/repu <<"  seconds \n";
X    cout << "scal-reverse:  " << rtu*(t5-t4)/repu <<
X    " units or  " << (t5-t4)/repu <<"  seconds \n";
X}
END_OF_FILE
if test 7393 -ne `wc -c <'shuttlexam.c'`; then
    echo shar: \"'shuttlexam.c'\" unpacked with wrong size!
fi
chmod +x 'shuttlexam.c'
# end of 'shuttlexam.c'
fi
if test -f 'vectexam.c' -a "${1}" != "-c" ; then 
  echo shar: Will not clobber existing file \"'vectexam.c'\"
else
echo shar: Extracting \"'vectexam.c'\" \(4490 characters\)
sed "s/^X//" >'vectexam.c' <<'END_OF_FILE'
X/*
X   --------------------------------------------------------------
X   Testexample  of ADOL-C version 1.6 as of January 1,   1995
X   --------------------------------------------------------------
X*/
X
X#include "adouble.h"
X#include "adutils.h"
X#include <stream.h>
X#define abs(x) ((x >= 0) ? (x) : -(x))
X#define maxabs(x,y) (((x)>abs(y)) ? (x) : abs(y))
X#define TAG 1
X
X#ifdef CLOCKS_PER_SEC
X#define clockspeed 1.0/CLOCKS_PER_SEC
X#else
X#define clockspeed 1.e-6    //machine dependent
X#endif
X#include <time.h>
Xlong t0, t1,t2,t3,t4,t5,t6,t7,t8,t9;
Xvoid main() {
X  int n,i,oper,indep,depen,buf_size,maxlive,deaths;
X  int tape_stats[11];
X  cout << "number of independent variables = ?  \n";
X  cin >> n;
X  double **xp = new double*[n];
X  double yp =1;                     // Undifferenciated double code 
X  for (i=0;i<n;i++)
X    {
X    xp[i] = new double[3];
X    xp[i][1]=0;
X    xp[i][2]=0;
X    }
X  t0 = clock();
X  for(i=0;i<n;i++)
X    {
X    *xp[i] = (i+1.0)/(2.0+i); 
X    yp *= *xp[i]; 
X     };                        
X  t1 = clock();
X  double yout=0;
X  int keep=1;
X  adouble* x;
X  x = new adouble[n];
X  trace_on(TAG,keep);
X  adouble y;
X  y =1;
X  for(i=0;i<n;i++) {
X    x[i] <<= xp[i][0]; 
X    y *= x[i];
X  } 
X  y >>= yout;
X  t2 = clock();
X  cout<< yout <<" =? "<<yp<<" function values should be the same \n";
X  delete x;
X  trace_off();                        // Reading of tape statistics
X
X  tapestats(TAG,tape_stats);
X  indep = tape_stats[0];
X  depen = tape_stats[1];
X  buf_size = tape_stats[4];
X  oper = tape_stats[5];
X  deaths = tape_stats[3];
X  maxlive = tape_stats[2];
X
X  
X  cout<<"\n";
X  cout<<"independents "<<indep<<"\n";
X  cout<<"dependents   "<<depen<<"\n";
X  cout<<"operations   "<<oper<<"\n";
X  cout<<"buffer size  "<<buf_size<<"\n";
X  cout<<"maxlive      "<<maxlive<<"\n";
X  cout<<"deaths       "<<deaths<<"\n";
X  double **r = new double*[1];
X  r[0] = new double[1];
X  r[0][0] = yp;
X  double err;
X  int degree;      
X  double *z = new double[n];
X  double **g = new double*[n];
X  double* h = new double[n];
X  double *ind = new double[n];
X  for (i=0;i<n;i++)
X    g[i] = new double[1];
X  for(int it=0; it <2; it++) {        // To come back later with perturbed xp
X    degree =0;
X
X    t3 = clock();
X    forward(TAG,1,n,degree,keep,xp,r);
X    t4 = clock();
X    reverse(TAG,1,n,degree,1.0,g);        // Reverse sweep to evaluate gradient
X    t5 = clock();
X    err=0;
X    for(i =0;i<n;i++) {               // Compare with deleted product
X      err = maxabs(err,xp[i][0]*g[i][0]/r[0][0] - 1.0);
X      ind[i] = xp[i][0];
X    }
X    cout<< err  <<" = maximum relative errors in gradient \n";
X    // Combine previous two sweeps in gradient evaluation
X    t6 = clock();
X    gradient(TAG,n,ind,z);      //last argument lagrange is ommitted
X    t7 = clock();
X    err = 0;
X    // Compare with previous numerical result
X    for( i=0; i<n; i++) 
X      {
X	err =  maxabs(err,g[i][0]/z[i] - 1.0);
X//      printf("g[%d][0] = %f  z[%d] = %f \n",i,float(g[i][0]),i,float(z[i]));
X      }
X    cout << err <<" = gradient error should be exactly zero \n";
X    double *tan = new double[n];      // Compute first row of Hessian
X    for(i=1;i<n;i++) tan[i] = 0.0 ;
X    tan[0]=1.0; 
X    t8 = clock();
X    hess_vec(TAG,n,ind,tan,h);       // Computes Hessian times direction z.
X    t9 = clock();
X    err = abs(h[0]);
X    //Compare with doubly deleted product
X    for(i=1;i<n;i++) err = maxabs(err,xp[0][0]*h[i]/g[i][0]-1.0);
X    cout<< err  <<" = maximum relative error in Hessian column \n";
X    double h1n = h[n-1];                // Check for symmetry
X    xp[0][1]=tan[0]=0;
X    xp[n-1][1]=tan[n-1]=1;
X    hess_vec(TAG,n,ind,tan,h);       // Computes Hessian times direction z.
X    cout<<h1n<<" = "<<h[0]<<" (1,n) and (n,1) entry should be the same\n";
X    // Third derivative tensor stuff
X    xp[0][1]=1.0;
X    degree = 2;
X    double **rv;
X    rv = new double*[1];
X    rv[0] = new double[degree+1];
X    double **t;
X    t = new double*[n];
X    for (i=0;i<n;i++)  t[i] =new double[degree+1];
X  }
X  if( t1-t0) 
X    {double rtu = 1.0/(t1-t0);   
X    cout << "\n times for "
X	 <<"\n unitime:   " << (t1-t0)*clockspeed << "  seconds "
X         <<"\n tracing:   "<< (t2-t1)*rtu << "   units "
X         <<"\n forward:   "<< (t4-t3)*rtu  << "   units "
X         <<"\n reverse:   "<<(t5-t4)*rtu   << "   units "
X         <<"\n gradeval:   "<<(t7-t6)*rtu  << "   units "
X         <<"\n hesseval:   "<<(t9-t8)*rtu  << "   units "
X         <<"\n";
X    }
X  else cout << "\n-> zero timing due to small problem  dimension \n";
X}
END_OF_FILE
if test 4490 -ne `wc -c <'vectexam.c'`; then
    echo shar: \"'vectexam.c'\" unpacked with wrong size!
fi
chmod +x 'vectexam.c'
# end of 'vectexam.c'
fi
echo shar: End of shell archive.
exit 0
C*** install.shar
#! /bin/sh
# This is a shell archive.  Remove anything before this line, then unpack
# it by saving it into a file and typing "sh file".  To overwrite existing
# files, type "sh file -c".  You can also feed this as standard input via
# unshar, or by typing "sh <file", e.g..  If this archive is complete, you
# will see the following message at the end:
#		"End of shell archive."
# Contents:  README aixinstall aixuninstall gnuinstall gnuuninstall
#   makefile.dex.aix makefile.dex.gnu makefile.dex.xxx
#   makefile.exa.aix makefile.exa.gnu makefile.exa.xxx
#   makefile.src.aix makefile.src.gnu makefile.src.xxx xxxinstall
#   xxxuninstall
# Wrapped by trh@tempest on Thu Jun 20 15:33:06 1996
PATH=/bin:/usr/bin:/usr/ucb ; export PATH
if test -f 'README' -a "${1}" != "-c" ; then 
  echo shar: Will not clobber existing file \"'README'\"
else
echo shar: Extracting \"'README'\" \(1423 characters\)
sed "s/^X//" >'README' <<'END_OF_FILE'
X   --------------------------------------------------------------
X   ADOL-C version 1.6 as of January 1,    1995
X   --------------------------------------------------------------
X
XThis directory contains makefiles and other UNIX scripts.
X
XTo produce the ADOL-C library libad.a use the executable 
X<operating_system>install (e.g. aixinstall).
XIt inserts appropriate makefiles into the ADOL-C library
Xand the two example subdirectories provided.
XAfter that the make command can be invoked as usual:
X
X- in */SRC
Xmake 
Xwill produce the library libad.a
X
X- in */SRC/DEX or */SRC/EXA
Xmake <example_filename>
Xwill build the executable <example_filename>.
X
XThe design goals, applicability and some implementation details
Xof ADOL-C are described in the tared LaTeX file adol-c.doc.tar.
XAny difficulties and questions should be reported to:
Xadol-c@math.tu-dresden.de
X
XAIX: Problems with float constants may occur if the environment variable
XLANG is not set to En_US -- test it with: 
Xset
Xset it with: 
Xexport LANG=En_US
X-- because the compiler may parse constants containing a decimal dot 
Xnot correctly.
X
XGNU: Some source files contain remove and unlink calls.
XAlthough remove complies with the ANSI C standard it turned out, that
Xin some situations (e.g. using GNU's compilers on a SUN workstation)
Xunlink has to be used instead of remove. In this case 
Xchange the comment signs in the source where both alternatives 
Xare offered.
X
END_OF_FILE
if test 1423 -ne `wc -c <'README'`; then
    echo shar: \"'README'\" unpacked with wrong size!
fi
chmod +x 'README'
# end of 'README'
fi
if test -f 'aixinstall' -a "${1}" != "-c" ; then 
  echo shar: Will not clobber existing file \"'aixinstall'\"
else
echo shar: Extracting \"'aixinstall'\" \(1035 characters\)
sed "s/^X//" >'aixinstall' <<'END_OF_FILE'
X#  --------------------------------------------------------------
X#  File aixinstall of ADOL-C version 1.6 as of January 1,   1995
X#  --------------------------------------------------------------
X#  aixinstall rewrites some fileextensions and copies
X#  the correct makefiles for ADOL-C itself into */SRC
X#  and for the examples into the subdirectories */SRC/EXA and */SRC/DEX.
X
Xcp makefile.src.aix ../SRC/makefile
Xcp makefile.dex.aix ../SRC/DEX/makefile
Xcp makefile.exa.aix ../SRC/EXA/makefile
Xcd ../SRC
Xmv adouble.c  adouble.C  
Xmv avector.c  avector.C  
Xmv drivers.c  drivers.C  
Xmv utils.c  utils.C
Xcd DEX
Xmv detexam.c detexam.C     
Xmv scalexam.c scalexam.C
Xmv gaussexam.c gaussexam.C   
Xmv odexam.c odexam.C      
Xmv vectexam.c vectexam.C
Xcd ../EXA
Xmv detexam.c detexam.C
Xmv helm-auto-exam.c helm-auto-exam.C
Xmv helm-vect-exam.c helm-vect-exam.C
Xmv odexam.c odexam.C
Xmv od2exam.c od2exam.C
Xmv eutroph.c eutroph.C
Xmv scalexam.c scalexam.C
Xmv shuttlexam.c shuttlexam.C
Xmv vectexam.c vectexam.C
Xmv gaussexam.c gaussexam.C
Xcd ../..
X
END_OF_FILE
if test 1035 -ne `wc -c <'aixinstall'`; then
    echo shar: \"'aixinstall'\" unpacked with wrong size!
fi
chmod +x 'aixinstall'
# end of 'aixinstall'
fi
if test -f 'aixuninstall' -a "${1}" != "-c" ; then 
  echo shar: Will not clobber existing file \"'aixuninstall'\"
else
echo shar: Extracting \"'aixuninstall'\" \(928 characters\)
sed "s/^X//" >'aixuninstall' <<'END_OF_FILE'
X#  ---------------------------------------------------------------
X#  File aixuninstall of ADOL-C version 1.6 as of January 1,   1995
X#  ---------------------------------------------------------------
X
Xcd ../SRC
Xrm makefile
Xmv adouble.C  adouble.c  
Xmv avector.C  avector.c  
Xmv drivers.C  drivers.c  
Xmv utils.C  utils.c
X/bin/rm *.o
X/bin/rm libad.a
Xcd DEX
Xrm makefile
Xmv detexam.C detexam.c     
Xmv scalexam.C scalexam.c
Xmv gaussexam.C gaussexam.c   
Xmv odexam.C odexam.c      
Xmv vectexam.C vectexam.c
X/bin/rm *.o
X/bin/rm *xam
X/bin/rm _adol*
X/bin/rm adoltemp.xxx
Xcd ../EXA
Xrm makefile
Xmv detexam.C detexam.c
Xmv helm-auto-exam.C helm-auto-exam.c
Xmv helm-vect-exam.C helm-vect-exam.c
Xmv odexam.C odexam.c
Xmv od2exam.C od2exam.c
Xmv eutroph.C eutroph.c
Xmv scalexam.C scalexam.c
Xmv shuttlexam.C shuttlexam.c
Xmv vectexam.C vectexam.c
Xmv gaussexam.C gaussexam.c
X/bin/rm *.o
X/bin/rm *xam
X/bin/rm _adol*
X/bin/rm adoltemp.xxx
Xcd ../..
X
END_OF_FILE
if test 928 -ne `wc -c <'aixuninstall'`; then
    echo shar: \"'aixuninstall'\" unpacked with wrong size!
fi
chmod +x 'aixuninstall'
# end of 'aixuninstall'
fi
if test -f 'gnuinstall' -a "${1}" != "-c" ; then 
  echo shar: Will not clobber existing file \"'gnuinstall'\"
else
echo shar: Extracting \"'gnuinstall'\" \(464 characters\)
sed "s/^X//" >'gnuinstall' <<'END_OF_FILE'
X#  --------------------------------------------------------------
X#  File gnuinstall of ADOL-C version 1.6 as of January 1,   1995
X#  --------------------------------------------------------------
X#  gnuinstall  copies
X#  the correct makefiles for ADOL-C itself into */SRC
X#  and for the examples into the subdirectories */SRC/EXA and */SRC/DEX.
X
Xcp makefile.src.gnu ../SRC/makefile
Xcp makefile.dex.gnu ../SRC/DEX/makefile
Xcp makefile.exa.gnu ../SRC/EXA/makefile
X
END_OF_FILE
if test 464 -ne `wc -c <'gnuinstall'`; then
    echo shar: \"'gnuinstall'\" unpacked with wrong size!
fi
chmod +x 'gnuinstall'
# end of 'gnuinstall'
fi
if test -f 'gnuuninstall' -a "${1}" != "-c" ; then 
  echo shar: Will not clobber existing file \"'gnuuninstall'\"
else
echo shar: Extracting \"'gnuuninstall'\" \(425 characters\)
sed "s/^X//" >'gnuuninstall' <<'END_OF_FILE'
X#  ---------------------------------------------------------------
X#  File gnuuninstall of ADOL-C version 1.6 as of January 1,   1995
X#  ---------------------------------------------------------------
X
Xcd ../SRC
Xrm makefile
X/bin/rm *.o
X/bin/rm libad.a
Xcd DEX
Xrm makefile
X/bin/rm *.o
X/bin/rm *xam
X/bin/rm _adol*
X/bin/rm adoltemp.xxx
Xcd ../EXA
Xrm makefile
X/bin/rm *.o
X/bin/rm *xam
X/bin/rm _adol*
X/bin/rm adoltemp.xxx
Xcd ../..
X
END_OF_FILE
if test 425 -ne `wc -c <'gnuuninstall'`; then
    echo shar: \"'gnuuninstall'\" unpacked with wrong size!
fi
chmod +x 'gnuuninstall'
# end of 'gnuuninstall'
fi
if test -f 'makefile.dex.aix' -a "${1}" != "-c" ; then 
  echo shar: Will not clobber existing file \"'makefile.dex.aix'\"
else
echo shar: Extracting \"'makefile.dex.aix'\" \(1476 characters\)
sed "s/^X//" >'makefile.dex.aix' <<'END_OF_FILE'
X# 
X#  --------------------------------------------------------------
X#  makefile (DEX) of ADOL-C version 1.6 as of January 1,   1995
X#  --------------------------------------------------------------
X#  makefile for documented examples in subdirectory DEX 
X#  written for IBM RS/6000 with AIX 3.2.
X#
XAD = ../
X# AD may be any directory with ADOL-C library and header files 
X#
XCFLAG =  -I$(AD)
XLFLAG = -L$(AD) 
XCC = xlC
XMCC = xlc
XLIBS = -lad -lm 
Xall:    vectexam scalexam detexam odexam gaussexam
X
Xvectexam : vectexam.o $(AD)/libad.a
X	$(CC) -o vectexam vectexam.o $(LFLAG) $(LIBS) 
Xvectexam.o : vectexam.C $(AD)/usrparms.h $(AD)/adouble.h $(AD)/adutils.h
X	$(CC) -c $(CFLAG) vectexam.C
X
Xscalexam : scalexam.o $(AD)/libad.a
X	$(CC) -o scalexam scalexam.o $(LFLAG) $(LIBS) 
Xscalexam.o : scalexam.C $(AD)/usrparms.h $(AD)/adouble.h $(AD)/adutils.h
X	$(CC) -c $(CFLAG) scalexam.C
X
Xdetexam : detexam.o $(AD)/libad.a
X	$(CC) -o detexam detexam.o $(LFLAG) $(LIBS) 
Xdetexam.o : detexam.C $(AD)/usrparms.h $(AD)/adouble.h $(AD)/adutils.h
X	$(CC) -c $(CFLAG) detexam.C
X
Xodexam : odexam.o $(AD)/libad.a
X	$(CC) -o odexam odexam.o $(LFLAG) $(LIBS) 
Xodexam.o : odexam.C $(AD)/usrparms.h $(AD)/adouble.h $(AD)/adutils.h
X	$(CC) -c $(CFLAG) odexam.C
X
Xgaussexam : gaussexam.o $(AD)/libad.a
X	$(CC) -o gaussexam gaussexam.o $(LFLAG) $(LIBS) 
Xgaussexam.o : gaussexam.C $(AD)/usrparms.h $(AD)/adouble.h $(AD)/adutils.h
X	$(CC) -c $(CFLAG) gaussexam.C
X
Xclean:
X	/bin/rm *.o
Xreallyclean:
X	/bin/rm *exam
X     
END_OF_FILE
if test 1476 -ne `wc -c <'makefile.dex.aix'`; then
    echo shar: \"'makefile.dex.aix'\" unpacked with wrong size!
fi
chmod +x 'makefile.dex.aix'
# end of 'makefile.dex.aix'
fi
if test -f 'makefile.dex.gnu' -a "${1}" != "-c" ; then 
  echo shar: Will not clobber existing file \"'makefile.dex.gnu'\"
else
echo shar: Extracting \"'makefile.dex.gnu'\" \(1469 characters\)
sed "s/^X//" >'makefile.dex.gnu' <<'END_OF_FILE'
X# 
X#  --------------------------------------------------------------
X#  makefile (DEX) of ADOL-C version 1.6 as of January 1,   1995
X#  --------------------------------------------------------------
X#  makefile for documented examples in subdirectory DEX 
X#  written for GNU's  g++ compiler.
X#
XAD = ../
X# AD may be any directory with ADOL-C library and header files 
X#
XCFLAG =  -O -I$(AD)
XLFLAG = -L$(AD)  
XCC = g++	
XLIBS = -lad -lm 
Xall:    vectexam scalexam detexam odexam gaussexam
X
Xvectexam : vectexam.o $(AD)/libad.a
X	$(CC) -o vectexam vectexam.o $(LFLAG) $(LIBS) 
Xvectexam.o : vectexam.c $(AD)/usrparms.h $(AD)/adouble.h $(AD)/adutils.h
X	$(CC) -c $(CFLAG) vectexam.c
X
Xscalexam : scalexam.o $(AD)/libad.a
X	$(CC) -o scalexam scalexam.o $(LFLAG) $(LIBS) 
Xscalexam.o : scalexam.c $(AD)/usrparms.h $(AD)/adouble.h $(AD)/adutils.h
X	$(CC) -c $(CFLAG) scalexam.c
X
Xdetexam : detexam.o $(AD)/libad.a
X	$(CC) -g -o detexam detexam.o $(LFLAG) $(LIBS) 
Xdetexam.o : detexam.c $(AD)/usrparms.h $(AD)/adouble.h $(AD)/adutils.h
X	$(CC) -c $(CFLAG) detexam.c
X
Xodexam : odexam.o $(AD)/libad.a
X	$(CC) -o odexam odexam.o $(LFLAG) $(LIBS) 
Xodexam.o : odexam.c $(AD)/usrparms.h $(AD)/adouble.h $(AD)/adutils.h
X	$(CC) -c $(CFLAG) odexam.c
X
Xgaussexam : gaussexam.o $(AD)/libad.a
X	$(CC) -o gaussexam gaussexam.o $(LFLAG) $(LIBS) 
Xgaussexam.o : gaussexam.c $(AD)/usrparms.h $(AD)/adouble.h $(AD)/adutils.h
X	$(CC) -c $(CFLAG) gaussexam.c
X
Xclean:
X	/bin/rm *.o
Xreallyclean:
X	/bin/rm *exam
X     
END_OF_FILE
if test 1469 -ne `wc -c <'makefile.dex.gnu'`; then
    echo shar: \"'makefile.dex.gnu'\" unpacked with wrong size!
fi
chmod +x 'makefile.dex.gnu'
# end of 'makefile.dex.gnu'
fi
if test -f 'makefile.dex.xxx' -a "${1}" != "-c" ; then 
  echo shar: Will not clobber existing file \"'makefile.dex.xxx'\"
else
echo shar: Extracting \"'makefile.dex.xxx'\" \(1431 characters\)
sed "s/^X//" >'makefile.dex.xxx' <<'END_OF_FILE'
X# 
X#  --------------------------------------------------------------
X#  makefile (DEX) of ADOL-C version 1.6 as of January 1,   1995
X#  --------------------------------------------------------------
X#  makefile for documented examples in subdirectory DEX 
X#
XAD = ../
X# AD may be any directory with ADOL-C library and header files 
X#
XCFLAG =  -O -I$(AD)
XLFLAG = -L$(AD)  
XCC = CC	
XLIBS = -lad -lm 
Xall:    vectexam scalexam detexam odexam gaussexam
Xvectexam : vectexam.o $(AD)/libad.a
X	$(CC) -o vectexam vectexam.o $(LFLAG) $(LIBS) 
Xvectexam.o : vectexam.c $(AD)/usrparms.h $(AD)/adouble.h $(AD)/adutils.h
X	$(CC) -c $(CFLAG) vectexam.c
X
Xscalexam : scalexam.o $(AD)/libad.a
X	$(CC) -o scalexam scalexam.o $(LFLAG) $(LIBS) 
Xscalexam.o : scalexam.c $(AD)/usrparms.h $(AD)/adouble.h $(AD)/adutils.h
X	$(CC) -c $(CFLAG) scalexam.c
X
Xdetexam : detexam.o $(AD)/libad.a
X	$(CC) -g -o detexam detexam.o $(LFLAG) $(LIBS) 
Xdetexam.o : detexam.c $(AD)/usrparms.h $(AD)/adouble.h $(AD)/adutils.h
X	$(CC) -c $(CFLAG) detexam.c
X
Xodexam : odexam.o $(AD)/libad.a
X	$(CC) -o odexam odexam.o $(LFLAG) $(LIBS) 
Xodexam.o : odexam.c $(AD)/usrparms.h $(AD)/adouble.h $(AD)/adutils.h
X	$(CC) -c $(CFLAG) odexam.c
X
Xgaussexam : gaussexam.o $(AD)/libad.a
X	$(CC) -o gaussexam gaussexam.o $(LFLAG) $(LIBS) 
Xgaussexam.o : gaussexam.c $(AD)/usrparms.h $(AD)/adouble.h $(AD)/adutils.h
X	$(CC) -c $(CFLAG) gaussexam.c
X
Xclean:
X	/bin/rm *.o
Xreallyclean:
X	/bin/rm *exam
X     
END_OF_FILE
if test 1431 -ne `wc -c <'makefile.dex.xxx'`; then
    echo shar: \"'makefile.dex.xxx'\" unpacked with wrong size!
fi
chmod +x 'makefile.dex.xxx'
# end of 'makefile.dex.xxx'
fi
if test -f 'makefile.exa.aix' -a "${1}" != "-c" ; then 
  echo shar: Will not clobber existing file \"'makefile.exa.aix'\"
else
echo shar: Extracting \"'makefile.exa.aix'\" \(2522 characters\)
sed "s/^X//" >'makefile.exa.aix' <<'END_OF_FILE'
X#
X#  --------------------------------------------------------------
X#  makefile (EXA) of ADOL-C version 1.6 as of January 1,   1995
X#  --------------------------------------------------------------
X#  makefile for undocumented examples in subdirectory EXA
X#  written for IBM RS/6000 with AIX 3.2.
X#
XAD = ../
X# AD may be any directory with ADOL-C library and header files 
X#
XCFLAG =  -I$(AD)
XLFLAG = -L$(AD)  
XCC = xlC
XMCC = xlc
XLIBS = -lad -lm 
Xall:    vectexam scalexam detexam odexam gaussexam helm-diff-exam helm-auto-exam helm-vect-exam shuttlexam od2exam 
X
Xhelm-diff-exam  : helm-diff-exam.c
X	$(MCC)  -o helm-diff-exam helm-diff-exam.c -lm
X
Xhelm-auto-exam  : helm-auto-exam.o
X	$(CC)  -o helm-auto-exam helm-auto-exam.o $(LFLAG) $(LIBS) 
Xhelm-auto-exam.o: helm-auto-exam.C  $(AD)/adouble.h $(AD)/adutils.h
X	$(CC) -c $(CFLAG) helm-auto-exam.C 
X
Xhelm-vect-exam  : helm-vect-exam.o
X	$(CC)  -o helm-vect-exam helm-vect-exam.o $(LFLAG) $(LIBS) 
Xhelm-vect-exam.o: helm-vect-exam.C  $(AD)/adouble.h $(AD)/adutils.h
X	$(CC) -c $(CFLAG) helm-vect-exam.C 
X
Xshuttlexam  : shuttlexam.o $(AD)/libad.a
X	$(CC)  -o shuttlexam shuttlexam.o $(LFLAG) $(LIBS) 
Xshuttlexam.o: shuttlexam.C  $(AD)/usrparms.h $(AD)/adouble.h $(AD)/adutils.h
X	$(CC) -c  $(CFLAG) shuttlexam.C 
X
Xvectexam : vectexam.o $(AD)/libad.a
X	$(CC) -o vectexam vectexam.o $(LFLAG) $(LIBS) 
Xvectexam.o : vectexam.C $(AD)/usrparms.h $(AD)/adouble.h $(AD)/adutils.h
X	$(CC) -c $(CFLAG) vectexam.C
X
Xscalexam : scalexam.o $(AD)/libad.a
X	$(CC) -o scalexam scalexam.o $(LFLAG) $(LIBS) 
Xscalexam.o : scalexam.C $(AD)/usrparms.h $(AD)/adouble.h $(AD)/adutils.h
X	$(CC) -c $(CFLAG) scalexam.C
X
Xdetexam : detexam.o $(AD)/libad.a
X	$(CC)  -o detexam detexam.o $(LFLAG) $(LIBS) 
Xdetexam.o : detexam.C $(AD)/usrparms.h $(AD)/adouble.h $(AD)/adutils.h
X	$(CC) -c $(CFLAG) detexam.C
X
Xodexam : odexam.o $(AD)/libad.a
X	$(CC) -o odexam odexam.o $(LFLAG) $(LIBS) 
Xodexam.o : odexam.C $(AD)/usrparms.h $(AD)/adouble.h $(AD)/adutils.h
X	$(CC) -c $(CFLAG) odexam.C
X
Xod2exam : od2exam.o eutroph.o $(AD)/libad.a
X	$(CC) -o od2exam od2exam.o eutroph.o $(LFLAG) $(LIBS) 
Xod2exam.o : od2exam.C $(AD)/usrparms.h $(AD)/adouble.h $(AD)/adutils.h
X	$(CC) -c $(CFLAG) od2exam.C
Xeutroph.o : eutroph.C $(AD)/usrparms.h $(AD)/adouble.h
X	$(CC) -c $(CFLAG) eutroph.C
X
Xgaussexam : gaussexam.o $(AD)/libad.a
X	$(CC) -o gaussexam gaussexam.o $(LFLAG) $(LIBS) 
Xgaussexam.o : gaussexam.C $(AD)/usrparms.h $(AD)/adouble.h $(AD)/adutils.h
X	$(CC) -c $(CFLAG) gaussexam.C
X
Xclean:
X	/bin/rm *.o
Xreallyclean:
X	/bin/rm *exam
X     
END_OF_FILE
if test 2522 -ne `wc -c <'makefile.exa.aix'`; then
    echo shar: \"'makefile.exa.aix'\" unpacked with wrong size!
fi
chmod +x 'makefile.exa.aix'
# end of 'makefile.exa.aix'
fi
if test -f 'makefile.exa.gnu' -a "${1}" != "-c" ; then 
  echo shar: Will not clobber existing file \"'makefile.exa.gnu'\"
else
echo shar: Extracting \"'makefile.exa.gnu'\" \(2530 characters\)
sed "s/^X//" >'makefile.exa.gnu' <<'END_OF_FILE'
X#
X#  --------------------------------------------------------------
X#  makefile (EXA) of ADOL-C version 1.6 as of January 1,   1995
X#  --------------------------------------------------------------
X#  makefile for undocumented examples in subdirectory EXA
X#  written for  GNU's  gcc and g++ compilers.
X#
XAD = ../
X# AD may be any directory with ADOL-C library and header files 
X#
XCFLAG =  -O -I$(AD)
XLFLAG = -L$(AD)   
XCC = g++
XMCC = gcc
XLIBS = -lad -lm 
Xall:    vectexam scalexam detexam odexam gaussexam helm-diff-exam helm-auto-exam helm-vect-exam shuttlexam od2exam
X
Xhelm-diff-exam  : helm-diff-exam.c
X	$(MCC)  -o helm-diff-exam helm-diff-exam.c -lm
X
Xhelm-auto-exam  : helm-auto-exam.o
X	$(CC)  -o helm-auto-exam helm-auto-exam.o $(LFLAG) $(LIBS) 
Xhelm-auto-exam.o: helm-auto-exam.c  $(AD)/adouble.h $(AD)/adutils.h
X	$(CC) -c $(CFLAG) helm-auto-exam.c 
X
Xhelm-vect-exam  : helm-vect-exam.o
X	$(CC)  -o helm-vect-exam helm-vect-exam.o $(LFLAG) $(LIBS) 
Xhelm-vect-exam.o: helm-vect-exam.c  $(AD)/adouble.h $(AD)/adutils.h
X	$(CC) -c $(CFLAG) helm-vect-exam.c 
X
Xshuttlexam  : shuttlexam.o $(AD)/libad.a
X	$(CC)  -o shuttlexam shuttlexam.o $(LFLAG) $(LIBS) 
Xshuttlexam.o: shuttlexam.c  $(AD)/usrparms.h $(AD)/adouble.h $(AD)/adutils.h
X	$(CC) -c  $(CFLAG) shuttlexam.c 
X
Xvectexam : vectexam.o $(AD)/libad.a
X	$(CC) -o vectexam vectexam.o $(LFLAG) $(LIBS) 
Xvectexam.o : vectexam.c $(AD)/usrparms.h $(AD)/adouble.h $(AD)/adutils.h
X	$(CC) -c $(CFLAG) vectexam.c
X
Xscalexam : scalexam.o $(AD)/libad.a
X	$(CC) -o scalexam scalexam.o $(LFLAG) $(LIBS) 
Xscalexam.o : scalexam.c $(AD)/usrparms.h $(AD)/adouble.h $(AD)/adutils.h
X	$(CC) -c $(CFLAG) scalexam.c
X
Xdetexam : detexam.o $(AD)/libad.a
X	$(CC)  -o detexam detexam.o $(LFLAG) $(LIBS) 
Xdetexam.o : detexam.c $(AD)/usrparms.h $(AD)/adouble.h $(AD)/adutils.h
X	$(CC) -c $(CFLAG) detexam.c
X
Xodexam : odexam.o $(AD)/libad.a
X	$(CC) -o odexam odexam.o $(LFLAG) $(LIBS) 
Xodexam.o : odexam.c $(AD)/usrparms.h $(AD)/adouble.h $(AD)/adutils.h
X	$(CC) -c $(CFLAG) odexam.c
X
Xod2exam : od2exam.o eutroph.o $(AD)/libad.a
X	$(CC) -o od2exam od2exam.o eutroph.o $(LFLAG) $(LIBS) 
Xod2exam.o : od2exam.c $(AD)/usrparms.h $(AD)/adouble.h $(AD)/adutils.h
X	$(CC) -c $(CFLAG) od2exam.c
Xeutroph.o : eutroph.c $(AD)/usrparms.h $(AD)/adouble.h
X	$(CC) -c $(CFLAG) eutroph.c
X
Xgaussexam : gaussexam.o $(AD)/libad.a
X	$(CC) -o gaussexam gaussexam.o $(LFLAG) $(LIBS) 
Xgaussexam.o : gaussexam.c $(AD)/usrparms.h $(AD)/adouble.h $(AD)/adutils.h
X	$(CC) -c $(CFLAG) gaussexam.c
X
Xclean:
X	/bin/rm *.o
Xreallyclean:
X	/bin/rm *exam
X     
END_OF_FILE
if test 2530 -ne `wc -c <'makefile.exa.gnu'`; then
    echo shar: \"'makefile.exa.gnu'\" unpacked with wrong size!
fi
chmod +x 'makefile.exa.gnu'
# end of 'makefile.exa.gnu'
fi
if test -f 'makefile.exa.xxx' -a "${1}" != "-c" ; then 
  echo shar: Will not clobber existing file \"'makefile.exa.xxx'\"
else
echo shar: Extracting \"'makefile.exa.xxx'\" \(2481 characters\)
sed "s/^X//" >'makefile.exa.xxx' <<'END_OF_FILE'
X#
X#  --------------------------------------------------------------
X#  makefile (EXA) of ADOL-C version 1.6 as of January 1,   1995
X#  --------------------------------------------------------------
X#  makefile for undocumented examples in subdirectory EXA
XAD = ../
X# AD may be any directory with ADOL-C library and header files 
X#
XCFLAG =  -O -I$(AD)
XLFLAG = -L$(AD)   
XCC = CC
XMCC = cc
XLIBS = -lad -lm 
Xall:    vectexam scalexam detexam odexam gaussexam helm-diff-exam helm-auto-exam helm-vect-exam shuttlexam od2exam
X
Xhelm-diff-exam  : helm-diff-exam.c
X	$(MCC)   -o helm-diff-exam helm-diff-exam.c -lm
X
Xhelm-auto-exam  : helm-auto-exam.o
X	$(CC)  -o helm-auto-exam helm-auto-exam.o $(LFLAG) $(LIBS) 
Xhelm-auto-exam.o: helm-auto-exam.c  $(AD)/adouble.h $(AD)/adutils.h
X	$(CC) -c $(CFLAG) helm-auto-exam.c 
X
Xhelm-vect-exam  : helm-vect-exam.o
X	$(CC)  -o helm-vect-exam helm-vect-exam.o $(LFLAG) $(LIBS) 
Xhelm-vect-exam.o: helm-vect-exam.c  $(AD)/adouble.h $(AD)/adutils.h
X	$(CC) -c $(CFLAG) helm-vect-exam.c 
X
Xshuttlexam  : shuttlexam.o $(AD)/libad.a
X	$(CC)  -o shuttlexam shuttlexam.o $(LFLAG) $(LIBS) 
Xshuttlexam.o: shuttlexam.c  $(AD)/usrparms.h $(AD)/adouble.h $(AD)/adutils.h
X	$(CC) -c  $(CFLAG) shuttlexam.c 
X
Xvectexam : vectexam.o $(AD)/libad.a
X	$(CC) -o vectexam vectexam.o $(LFLAG) $(LIBS) 
Xvectexam.o : vectexam.c $(AD)/usrparms.h $(AD)/adouble.h $(AD)/adutils.h
X	$(CC) -c $(CFLAG) vectexam.c
X
Xscalexam : scalexam.o $(AD)/libad.a
X	$(CC) -o scalexam scalexam.o $(LFLAG) $(LIBS) 
Xscalexam.o : scalexam.c $(AD)/usrparms.h $(AD)/adouble.h $(AD)/adutils.h
X	$(CC) -c $(CFLAG) scalexam.c
X
Xdetexam : detexam.o $(AD)/libad.a
X	$(CC)  -o detexam detexam.o $(LFLAG) $(LIBS) 
Xdetexam.o : detexam.c $(AD)/usrparms.h $(AD)/adouble.h $(AD)/adutils.h
X	$(CC) -c $(CFLAG) detexam.c
X
Xodexam : odexam.o $(AD)/libad.a
X	$(CC) -o odexam odexam.o $(LFLAG) $(LIBS) 
Xodexam.o : odexam.c $(AD)/usrparms.h $(AD)/adouble.h $(AD)/adutils.h
X	$(CC) -c $(CFLAG) odexam.c
X
Xod2exam : od2exam.o eutroph.o $(AD)/libad.a
X	$(CC) -o od2exam od2exam.o eutroph.o $(LFLAG) $(LIBS) 
Xod2exam.o : od2exam.c $(AD)/usrparms.h $(AD)/adouble.h $(AD)/adutils.h
X	$(CC) -c $(CFLAG) od2exam.c
Xeutroph.o : eutroph.c $(AD)/usrparms.h $(AD)/adouble.h
X	$(CC) -c $(CFLAG) eutroph.c
X
Xgaussexam : gaussexam.o $(AD)/libad.a
X	$(CC) -o gaussexam gaussexam.o $(LFLAG) $(LIBS) 
Xgaussexam.o : gaussexam.c $(AD)/usrparms.h $(AD)/adouble.h $(AD)/adutils.h
X	$(CC) -c $(CFLAG) gaussexam.c
X
Xclean:
X	/bin/rm *.o
Xreallyclean:
X	/bin/rm *exam
X     
END_OF_FILE
if test 2481 -ne `wc -c <'makefile.exa.xxx'`; then
    echo shar: \"'makefile.exa.xxx'\" unpacked with wrong size!
fi
chmod +x 'makefile.exa.xxx'
# end of 'makefile.exa.xxx'
fi
if test -f 'makefile.src.aix' -a "${1}" != "-c" ; then 
  echo shar: Will not clobber existing file \"'makefile.src.aix'\"
else
echo shar: Extracting \"'makefile.src.aix'\" \(2910 characters\)
sed "s/^X//" >'makefile.src.aix' <<'END_OF_FILE'
X#
X#  --------------------------------------------------------------
X#  makefile (SRC) of ADOL-C version 1.6 as of January 1,   1995
X#  --------------------------------------------------------------
X#  makefile for the library libad.a of ADOL-C
X#  written for IBM RS/6000 with AIX 3.2.
X#
X
XCFLAGS =  
XLIB =  -lc
XCC = xlC 
XMCC = xlc 
Xlibad: adouble.o avector.o taputil1.o taputil2.o taputil3.o hos_forward.o hov_forward.o fov_forward.o hos_reverse.o fos_reverse.o hov_reverse.o fov_reverse.o tayutil.o drivers.o driversc.o utils.o
X	ranlib libad.a
X	@echo 'Library created'
Xadouble.o: adouble.C adouble.h avector.h oplate.h taputil1.h 
X	$(CC) -c $(CFLAGS) $(LIB) adouble.C
X	ar rcv libad.a adouble.o
Xavector.o: avector.C adouble.h avector.h oplate.h taputil1.h
X	$(CC) -c $(CFLAGS) $(LIB) avector.C
X	ar rcv libad.a avector.o
Xtaputil1.o: taputil1.c oplate.h taputil2.h tayutil.h usrparms.h
X	$(MCC) -c $(CFLAGS) $(LIB) taputil1.c
X	ar rcv libad.a taputil1.o
Xtaputil2.o: taputil2.c dvlparms.h oplate.h taputil3.h usrparms.h
X	$(MCC) -c $(CFLAGS) $(LIB) taputil2.c
X	ar rcv libad.a taputil2.o
Xtaputil3.o: taputil3.c dvlparms.h oplate.h tayutil.h taputil1.h taputil2.h usrparms.h
X	$(MCC) -c $(CFLAGS) $(LIB) taputil3.c
X	ar rcv libad.a taputil3.o
Xhos_forward.o: hos_forward.c dvlparms.h taputil1.h taputil2.h taputil3.h tayutil.h oplate.h usrparms.h
X	$(MCC) -c $(CFLAGS) $(LIB) hos_forward.c
X	ar rcv libad.a hos_forward.o
Xhov_forward.o: hov_forward.c dvlparms.h taputil1.h taputil2.h taputil3.h tayutil.h oplate.h usrparms.h
X	$(MCC) -c $(CFLAGS) $(LIB) hov_forward.c
X	ar rcv libad.a hov_forward.o
Xfov_forward.o: fov_forward.c dvlparms.h taputil1.h taputil2.h taputil3.h tayutil.h oplate.h usrparms.h
X	$(MCC) -c $(CFLAGS) $(LIB) fov_forward.c
X	ar rcv libad.a fov_forward.o
Xhos_reverse.o: hos_reverse.c dvlparms.h taputil1.h taputil2.h taputil3.h tayutil.h oplate.h usrparms.h
X	$(MCC) -c $(CFLAGS) $(LIB) hos_reverse.c
X	ar rcv libad.a hos_reverse.o
Xfos_reverse.o: fos_reverse.c dvlparms.h taputil1.h taputil2.h taputil3.h tayutil.h oplate.h usrparms.h
X	$(MCC) -c $(CFLAGS) $(LIB) fos_reverse.c
X	ar rcv libad.a fos_reverse.o
Xhov_reverse.o: hov_reverse.c dvlparms.h taputil1.h taputil2.h taputil3.h tayutil.h oplate.h usrparms.h
X	$(MCC) -c $(CFLAGS) $(LIB) hov_reverse.c
X	ar rcv libad.a hov_reverse.o
Xfov_reverse.o: fov_reverse.c dvlparms.h taputil1.h taputil2.h taputil3.h tayutil.h oplate.h usrparms.h
X	$(MCC) -c $(CFLAGS) $(LIB) fov_reverse.c
X	ar rcv libad.a fov_reverse.o
Xtayutil.o: tayutil.c dvlparms.h usrparms.h tayutil.h
X	$(MCC) -c $(CFLAGS) $(LIB) tayutil.c
X	ar rcv libad.a tayutil.o
Xutils.o: utils.C tayutil.h taputil3.h 
X	$(CC) -c $(CFLAGS) $(LIB) utils.C
X	ar rcv libad.a utils.o
Xdriversc.o: driversc.c dvlparms.h adutilsc.h
X	$(MCC) -c $(CFLAGS) $(LIB) driversc.c
X	ar rcv libad.a driversc.o
Xdrivers.o: drivers.C dvlparms.h adutils.h
X	$(CC) -c $(CFLAGS) $(LIB) drivers.C
X	ar rcv libad.a drivers.o
Xclean : 
X	/bin/rm *.o
X
END_OF_FILE
if test 2910 -ne `wc -c <'makefile.src.aix'`; then
    echo shar: \"'makefile.src.aix'\" unpacked with wrong size!
fi
chmod +x 'makefile.src.aix'
# end of 'makefile.src.aix'
fi
if test -f 'makefile.src.gnu' -a "${1}" != "-c" ; then 
  echo shar: Will not clobber existing file \"'makefile.src.gnu'\"
else
echo shar: Extracting \"'makefile.src.gnu'\" \(2919 characters\)
sed "s/^X//" >'makefile.src.gnu' <<'END_OF_FILE'
X
X#  --------------------------------------------------------------
X#  makefile (SRC) of ADOL-C version 1.6 as of January 1,   1995
X#  --------------------------------------------------------------
X#  makefile for the library libad.a of ADOL-C
X#  written for  GNU's  gcc and g++ compilers.
X#
X
XCFLAGS =  -O 
XCC = g++
XMCC = gcc 
XLIBS = -lad -lm
Xlibad: adouble.o avector.o taputil1.o taputil2.o taputil3.o hos_forward.o hov_forward.o fov_forward.o hos_reverse.o fos_reverse.o hov_reverse.o fov_reverse.o tayutil.o drivers.o driversc.o utils.o
X	ranlib libad.a
X	@echo 'Library created'
Xadouble.o: adouble.c adouble.h avector.h oplate.h taputil1.h 
X	$(CC) -c $(CFLAGS) $(LIB) adouble.c
X	ar rcv libad.a adouble.o
Xavector.o: avector.c adouble.h avector.h oplate.h taputil1.h
X	$(CC) -c $(CFLAGS) $(LIB) avector.c
X	ar rcv libad.a avector.o
Xtaputil1.o: taputil1.c oplate.h taputil2.h tayutil.h usrparms.h
X	$(MCC) -c $(CFLAGS) $(LIB) taputil1.c
X	ar rcv libad.a taputil1.o
Xtaputil2.o: taputil2.c dvlparms.h oplate.h taputil3.h usrparms.h
X	$(MCC) -c $(CFLAGS) $(LIB) taputil2.c
X	ar rcv libad.a taputil2.o
Xtaputil3.o: taputil3.c dvlparms.h oplate.h tayutil.h taputil1.h taputil2.h usrparms.h
X	$(MCC) -c $(CFLAGS) $(LIB) taputil3.c
X	ar rcv libad.a taputil3.o
Xhos_forward.o: hos_forward.c dvlparms.h taputil1.h taputil2.h taputil3.h tayutil.h oplate.h usrparms.h
X	$(MCC) -c $(CFLAGS) $(LIB) hos_forward.c
X	ar rcv libad.a hos_forward.o
Xhov_forward.o: hov_forward.c dvlparms.h taputil1.h taputil2.h taputil3.h tayutil.h oplate.h usrparms.h
X	$(MCC) -c $(CFLAGS) $(LIB) hov_forward.c
X	ar rcv libad.a hov_forward.o
Xfov_forward.o: fov_forward.c dvlparms.h taputil1.h taputil2.h taputil3.h tayutil.h oplate.h usrparms.h
X	$(MCC) -c $(CFLAGS) $(LIB) fov_forward.c
X	ar rcv libad.a fov_forward.o
Xhos_reverse.o: hos_reverse.c dvlparms.h taputil1.h taputil2.h taputil3.h tayutil.h oplate.h usrparms.h
X	$(MCC) -c $(CFLAGS) $(LIB) hos_reverse.c
X	ar rcv libad.a hos_reverse.o
Xfos_reverse.o: fos_reverse.c dvlparms.h taputil1.h taputil2.h taputil3.h tayutil.h oplate.h usrparms.h
X	$(MCC) -c $(CFLAGS) $(LIB) fos_reverse.c
X	ar rcv libad.a fos_reverse.o
Xhov_reverse.o: hov_reverse.c dvlparms.h taputil1.h taputil2.h taputil3.h tayutil.h oplate.h usrparms.h
X	$(MCC) -c $(CFLAGS) $(LIB) hov_reverse.c
X	ar rcv libad.a hov_reverse.o
Xfov_reverse.o: fov_reverse.c dvlparms.h taputil1.h taputil2.h taputil3.h tayutil.h oplate.h usrparms.h
X	$(MCC) -c $(CFLAGS) $(LIB) fov_reverse.c
X	ar rcv libad.a fov_reverse.o
Xtayutil.o: tayutil.c dvlparms.h usrparms.h tayutil.h
X	$(MCC) -c $(CFLAGS) $(LIB) tayutil.c
X	ar rcv libad.a tayutil.o
Xutils.o: utils.c tayutil.h taputil3.h 
X	$(CC) -c $(CFLAGS) $(LIB) utils.c
X	ar rcv libad.a utils.o
Xdriversc.o: driversc.c dvlparms.h adutilsc.h
X	$(MCC) -c $(CFLAGS) $(LIB) driversc.c
X	ar rcv libad.a driversc.o
Xdrivers.o: drivers.c dvlparms.h adutils.h
X	$(CC) -c $(CFLAGS) $(LIB) drivers.c
X	ar rcv libad.a drivers.o
Xclean:
X	/bin/rm *.o
X
END_OF_FILE
if test 2919 -ne `wc -c <'makefile.src.gnu'`; then
    echo shar: \"'makefile.src.gnu'\" unpacked with wrong size!
fi
chmod +x 'makefile.src.gnu'
# end of 'makefile.src.gnu'
fi
if test -f 'makefile.src.xxx' -a "${1}" != "-c" ; then 
  echo shar: Will not clobber existing file \"'makefile.src.xxx'\"
else
echo shar: Extracting \"'makefile.src.xxx'\" \(2873 characters\)
sed "s/^X//" >'makefile.src.xxx' <<'END_OF_FILE'
X
X#  --------------------------------------------------------------
X#  makefile (SRC) of ADOL-C version 1.6 as of January 1,   1995
X#  --------------------------------------------------------------
X#  makefile for the library libad.a of ADOL-C
X
XCFLAGS =  -O     
XCC = CC
XMCC = cc 
XLIBS = -lad -lm
Xlibad: adouble.o avector.o taputil1.o taputil2.o taputil3.o hos_forward.o hov_forward.o fov_forward.o hos_reverse.o fos_reverse.o hov_reverse.o fov_reverse.o tayutil.o drivers.o driversc.o utils.o
X	ranlib libad.a
X	@echo 'Library created'
Xadouble.o: adouble.c adouble.h avector.h oplate.h taputil1.h 
X	$(CC) -c $(CFLAGS) $(LIB) adouble.c
X	ar rcv libad.a adouble.o
Xavector.o: avector.c adouble.h avector.h oplate.h taputil1.h
X	$(CC) -c $(CFLAGS) $(LIB) avector.c
X	ar rcv libad.a avector.o
Xtaputil1.o: taputil1.c oplate.h taputil2.h tayutil.h usrparms.h
X	$(MCC) -c $(CFLAGS) $(LIB) taputil1.c
X	ar rcv libad.a taputil1.o
Xtaputil2.o: taputil2.c dvlparms.h oplate.h taputil3.h usrparms.h
X	$(MCC) -c $(CFLAGS) $(LIB) taputil2.c
X	ar rcv libad.a taputil2.o
Xtaputil3.o: taputil3.c dvlparms.h oplate.h tayutil.h taputil1.h taputil2.h usrparms.h
X	$(MCC) -c $(CFLAGS) $(LIB) taputil3.c
X	ar rcv libad.a taputil3.o
Xhos_forward.o: hos_forward.c dvlparms.h taputil1.h taputil2.h taputil3.h tayutil.h oplate.h usrparms.h
X	$(MCC) -c $(CFLAGS) $(LIB) hos_forward.c
X	ar rcv libad.a hos_forward.o
Xhov_forward.o: hov_forward.c dvlparms.h taputil1.h taputil2.h taputil3.h tayutil.h oplate.h usrparms.h
X	$(MCC) -c $(CFLAGS) $(LIB) hov_forward.c
X	ar rcv libad.a hov_forward.o
Xfov_forward.o: fov_forward.c dvlparms.h taputil1.h taputil2.h taputil3.h tayutil.h oplate.h usrparms.h
X	$(MCC) -c $(CFLAGS) $(LIB) fov_forward.c
X	ar rcv libad.a fov_forward.o
Xhos_reverse.o: hos_reverse.c dvlparms.h taputil1.h taputil2.h taputil3.h tayutil.h oplate.h usrparms.h
X	$(MCC) -c $(CFLAGS) $(LIB) hos_reverse.c
X	ar rcv libad.a hos_reverse.o
Xfos_reverse.o: fos_reverse.c dvlparms.h taputil1.h taputil2.h taputil3.h tayutil.h oplate.h usrparms.h
X	$(MCC) -c $(CFLAGS) $(LIB) fos_reverse.c
X	ar rcv libad.a fos_reverse.o
Xhov_reverse.o: hov_reverse.c dvlparms.h taputil1.h taputil2.h taputil3.h tayutil.h oplate.h usrparms.h
X	$(MCC) -c $(CFLAGS) $(LIB) hov_reverse.c
X	ar rcv libad.a hov_reverse.o
Xfov_reverse.o: fov_reverse.c dvlparms.h taputil1.h taputil2.h taputil3.h tayutil.h oplate.h usrparms.h
X	$(MCC) -c $(CFLAGS) $(LIB) fov_reverse.c
X	ar rcv libad.a fov_reverse.o
Xtayutil.o: tayutil.c dvlparms.h usrparms.h tayutil.h
X	$(MCC) -c $(CFLAGS) $(LIB) tayutil.c
X	ar rcv libad.a tayutil.o
Xutils.o: utils.c tayutil.h taputil3.h 
X	$(CC) -c $(CFLAGS) $(LIB) utils.c
X	ar rcv libad.a utils.o
Xdriversc.o: driversc.c dvlparms.h adutilsc.h
X	$(MCC) -c $(CFLAGS) $(LIB) driversc.c
X	ar rcv libad.a driversc.o
Xdrivers.o: drivers.c dvlparms.h adutils.h
X	$(CC) -c $(CFLAGS) $(LIB) drivers.c
X	ar rcv libad.a drivers.o
Xclean:
X	/bin/rm *.o
X
END_OF_FILE
if test 2873 -ne `wc -c <'makefile.src.xxx'`; then
    echo shar: \"'makefile.src.xxx'\" unpacked with wrong size!
fi
chmod +x 'makefile.src.xxx'
# end of 'makefile.src.xxx'
fi
if test -f 'xxxinstall' -a "${1}" != "-c" ; then 
  echo shar: Will not clobber existing file \"'xxxinstall'\"
else
echo shar: Extracting \"'xxxinstall'\" \(464 characters\)
sed "s/^X//" >'xxxinstall' <<'END_OF_FILE'
X#  --------------------------------------------------------------
X#  File xxxinstall of ADOL-C version 1.6 as of January 1,   1995
X#  --------------------------------------------------------------
X#  xxxinstall  copies
X#  the correct makefiles for ADOL-C itself into */SRC
X#  and for the examples into the subdirectories */SRC/EXA and */SRC/DEX.
X
Xcp makefile.src.xxx ../SRC/makefile
Xcp makefile.dex.xxx ../SRC/DEX/makefile
Xcp makefile.exa.xxx ../SRC/EXA/makefile
X
END_OF_FILE
if test 464 -ne `wc -c <'xxxinstall'`; then
    echo shar: \"'xxxinstall'\" unpacked with wrong size!
fi
chmod +x 'xxxinstall'
# end of 'xxxinstall'
fi
if test -f 'xxxuninstall' -a "${1}" != "-c" ; then 
  echo shar: Will not clobber existing file \"'xxxuninstall'\"
else
echo shar: Extracting \"'xxxuninstall'\" \(425 characters\)
sed "s/^X//" >'xxxuninstall' <<'END_OF_FILE'
X#  ---------------------------------------------------------------
X#  File xxxuninstall of ADOL-C version 1.6 as of January 1,   1995
X#  ---------------------------------------------------------------
X
Xcd ../SRC
Xrm makefile
X/bin/rm *.o
X/bin/rm libad.a
Xcd DEX
Xrm makefile
X/bin/rm *.o
X/bin/rm *xam
X/bin/rm _adol*
X/bin/rm adoltemp.xxx
Xcd ../EXA
Xrm makefile
X/bin/rm *.o
X/bin/rm *xam
X/bin/rm _adol*
X/bin/rm adoltemp.xxx
Xcd ../..
X
END_OF_FILE
if test 425 -ne `wc -c <'xxxuninstall'`; then
    echo shar: \"'xxxuninstall'\" unpacked with wrong size!
fi
chmod +x 'xxxuninstall'
# end of 'xxxuninstall'
fi
echo shar: End of shell archive.
exit 0
C*** src.shar
#! /bin/sh
# This is a shell archive.  Remove anything before this line, then unpack
# it by saving it into a file and typing "sh file".  To overwrite existing
# files, type "sh file -c".  You can also feed this as standard input via
# unshar, or by typing "sh <file", e.g..  If this archive is complete, you
# will see the following message at the end:
#		"End of shell archive."
# Contents:  README adouble.c adouble.h adutils.h adutilsc.h avector.c
#   avector.h drivers.c driversc.c dvlparms.h fos_reverse.c
#   fov_forward.c fov_reverse.c hos_forward.c hos_reverse.c
#   hov_forward.c hov_reverse.c oplate.h taputil1.c taputil1.h
#   taputil2.c taputil2.h taputil3.c taputil3.h tayutil.c tayutil.h
#   usrparms.h utils.c
# Wrapped by trh@tempest on Thu Jun 20 15:34:17 1996
PATH=/bin:/usr/bin:/usr/ucb ; export PATH
if test -f 'README' -a "${1}" != "-c" ; then 
  echo shar: Will not clobber existing file \"'README'\"
else
echo shar: Extracting \"'README'\" \(789 characters\)
sed "s/^X//" >'README' <<'END_OF_FILE'
X   --------------------------------------------------------------
X   ADOL-C version 1.6 as of January 1,   1995
X   --------------------------------------------------------------
X
XThe directory */SRC contains the directories
XDEX  (documented examples)
XEXA  (undocumented examples)
Xand the files:
Xadouble.c      drivers.c      hos_forward.c  taputil1.h     tayutil.h
Xadouble.h      driversc.c     hos_reverse.c  taputil2.c     usrparms.h
Xadutils.h      dvlparms.h     hov_forward.c  taputil2.h     utils.c
Xadutilsc.h     fos_reverse.c  hov_reverse.c  taputil3.c
Xavector.c      fov_forward.c  oplate.h       taputil3.h
Xavector.h      fov_reverse.c  taputil1.c     tayutil.c
X
XTo produce the ADOL-C library libad.a use the make command
Xafter calling ???install. Read */INS/README for details.
X
END_OF_FILE
if test 789 -ne `wc -c <'README'`; then
    echo shar: \"'README'\" unpacked with wrong size!
fi
chmod +x 'README'
# end of 'README'
fi
if test -f 'adouble.c' -a "${1}" != "-c" ; then 
  echo shar: Will not clobber existing file \"'adouble.c'\"
else
echo shar: Extracting \"'adouble.c'\" \(26915 characters\)
sed "s/^X//" >'adouble.c' <<'END_OF_FILE'
X/*
X   --------------------------------------------------------------
X   File adouble.c of ADOL-C version 1.6 as of January 1,   1995
X   --------------------------------------------------------------
X   Adouble.c contains that definitions of procedures used to defined various
X   badouble, adub, and adouble operations. These operations actually 
X   have two purposes.
X   The first purpose is to actual compute the function, just as the same
X   code written for double precision (single precision - complex - interval) 
X   arithmetic would.  The second purpose is to write a transcript of the
X   computation for the reverse pass of automatic differentiation.
X*/
X
X/* Local Includes */
X
X#include "adouble.h"
X#include "oplate.h"
X
X/* Include these routines that are written in straight C. */
X
Xextern "C" {
X#include "taputil1.h"
X}
X
X/* Include Files */
X
X#include <string.h>
X#include <stdio.h>
X
Xvoid condassign(double &res, const double &cond, const double &arg1, const double &arg2)
X{
X res=cond ? arg1 : arg2;
X}
X
Xvoid condassign(double &res, const double &cond, const double &arg1)
X{
X  res=cond ? arg1 : res;
X}
X
X/* Global vars */
X
Xdouble* store;
Xint trace_flag =0;
X
Xstatic locint maxloc = sizeof(locint) ==2 ? 65535 : 2147483647;
Xstatic locint current_top = 0; // = largest live location + 1
Xstatic locint location_cnt = 0 ;    // = maximal # of lives so far
Xstatic locint maxtop = 0; // = current size of store
Xstatic locint maxtop2;
Xstatic locint dealloc = 0; // = # of locations to be freed
Xstatic locint deminloc = 0;  // = lowest loc to be freed 
X
X/*------------------------------------------------------*/
X/* The first several routines are for memory management */
X/*------------------------------------------------------*/
X
X/*
X  Return the next free location in "adouble" memory
X*/
Xlocint next_loc()
X{ 
X/* First deallocate dead adoubles if they form a contiguous tail: */
X#ifdef overwrite
X  if (dealloc && dealloc+deminloc == current_top)    
X    {          
X     if(trace_flag) write_death(deminloc, current_top - 1);
X     current_top = deminloc ;
X     dealloc =0; 
X     deminloc = maxloc;
X     }
X#endif
X  if ( current_top == location_cnt) ++location_cnt ;
X  if ( location_cnt > maxtop ) 
X     {
X      maxtop2 = ++maxtop*2 > maxloc ? maxloc : 2*maxtop;
X      if (maxtop2 == maxloc )
X	 {
X         printf("ADOL-C fatal error  !! \n ");
X         printf("maximal number of live active variables exceeded\n\n");
X	 printf("Possible remedies :\n\n ");
X       	 printf(" 1. Use more automatic local variables and \n");
X	 printf("    allocate/deallocate adoubles on free store\n");
X	 printf("     in a strictly last in first out fashion\n\n");
X	 printf(" 2. Extend the range by redefining the type of \n");
X         printf("    locint from unsigned short or int to int or long\n");
X	 exit(-3);
X	 }
X      else
X	 {
X	 maxtop = maxtop2;
X	 if(maxtop == 2)
X	  {
X	   store = (double *)malloc(maxtop*sizeof(double));
X	   deminloc = maxloc;
X	   }
X         else
X           {
X	 store = (double *)realloc((char *)store,maxtop*sizeof(double));
X	   }
X	 if( store == 0) 
X	   {
X           printf("ADOL-C fatal error !! \n");
X  	   printf("Failure to reallocate storage for adouble values\n");
X	 printf("Possible remedies :\n\n ");
X       	 printf(" 1. Use more automatic local variables and \n");
X	 printf("    allocate/deallocate adoubles on free store\n");
X	 printf("    in a strictly last in first out fashion\n");
X	 printf(" 2. Extend the range by redefining the type of\n");
X         printf("    locint to unsigned short or int to int or long\n");
X	 printf(" 3. Enlarge your system stacksize limit\n");
X	   exit(-3);
X	   }
X	}
X      }
X  return current_top++ ;
X}
X
X
Xlocint next_loc(int size)
X{ 
X/* First deallocate dead adoubles if they form a contiguous tail: */
X
X#ifdef overwrite
X  if (dealloc && dealloc+deminloc == current_top)    
X    {          
X     if(trace_flag) write_death(deminloc, current_top - 1);
X     current_top = deminloc ;
X     dealloc =0; 
X     deminloc = maxloc;
X     }
X#endif
X  if ( (current_top+size) >= location_cnt) location_cnt=current_top+size+1;
X  while ( location_cnt > maxtop ) 
X     {
X      maxtop2 = ++maxtop*2 > maxloc ? maxloc : 2*maxtop;
X      if (maxtop2 == maxloc )
X	 {
X         printf("ADOL-C fatal error !! \n ");
X         printf("maximal number of live active variables exceeded\n\n");
X	 printf("Possible remedies :\n\n ");
X       	 printf(" 1. Use more automatic local variables and \n");
X	 printf("    allocate/deallocate adoubles on free store\n");
X	 printf("     in a strictly last in first out fashion\n\n");
X	 printf(" 2. Extend the range by redefining the type of \n");
X         printf("    locint from unsigned short or int to int or long\n");
X	 exit(-3);
X	 }
X      else
X	 {
X	 maxtop = maxtop2;
X	 if(maxtop == 2)
X	  {
X	   store = (double *)malloc(maxtop*sizeof(double));
X	   deminloc = maxloc;
X	   }
X         else
X           {
X	     /* Allocate the storage */
X	     double *temp;
X	     temp = (double *)malloc(maxtop*sizeof(double));
X	      
X	     /* Copy over storage */
X	     for (int i=0; i<current_top; i++)
X	       temp[i]=store[i];
X
X	      free((char*) store);
X    
X	      store = temp;
X	   }
X	 if( store == 0) 
X	   {
X           printf("ADOL-C fatal error !! \n");
X  	   printf("Failure to reallocate storage for adouble values\n");
X	 printf("Possible remedies :\n\n ");
X       	 printf(" 1. Use more automatic local variables and \n");
X	 printf("    allocate/deallocate adoubles on free store\n");
X	 printf("    in a strictly last in first out fashion\n");
X	 printf(" 2. Extend the range by redefining the type of\n");
X         printf("    locint to unsigned short or int to int or long\n");
X	 printf(" 3. Enlarge your system stacksize limit\n");
X	   exit(-3);
X	   }
X	}
X      }
X
X#ifdef DEBUG
X  printf ("ADOL-C debug: Top is: %d\n ",current_top+size);
X#endif
X  locint return_val=current_top;
X  current_top+=size;
X  return return_val;
X}
X
X
X/*
X	Free a location in "adouble" memory.  
X*/
Xinline void free_loc(locint old_loc)
X{
X  ++dealloc;
X  if (old_loc < deminloc) deminloc = old_loc ;
X}
X
Xvoid free_loc(int old_loc, int size)
X{
X  dealloc+=size;
X  if (old_loc < deminloc) deminloc = old_loc ;
X}
X  
X
Xvoid take_stock() 
X{ 
X  for(int i =0; i< current_top; i++)
X       { 
X	double storei =store[i]; // Avoid I/O of NaN's !
X        if (storei == storei) write_int_assign_d(i,storei);
X	}
X  trace_flag = 1;
X}
X
Xlocint keep_stock()
X{
X  if (current_top > 0) write_death(0,current_top - 1);
X  trace_flag = 0;
X  return location_cnt;
X}
X
X
X/*----------------------------------------------------------------*/
X/* The remaining routines define the badouble,adub,and adouble    */
X/* routines.                                                      */
X/*----------------------------------------------------------------*/
X
X/* Basic constructors */
X/*
Xadub::adub(double y)
X{
X  location = next_loc();
X  store[location] = y;
X  if (trace_flag) write_int_assign_d(location,y);
X}
X*/
Xadouble::adouble()
X{
X  location = next_loc();
X  
X}
X
Xadouble::adouble(double y)
X{
X  location = next_loc();
X  store[location] = y;
X  if (trace_flag) write_int_assign_d(location,y);
X}
X
Xadouble::adouble(const adouble& a)
X{
X  location = next_loc();
X  store[location]=store[a.location];
X  if (trace_flag) write_int_assign_a(location,a.location);
X}
X
X
Xadouble::adouble(const adub& a)
X{
X  location = next_loc();
X  store[location]=store[a.loc()];
X  if (trace_flag) write_int_assign_a(location,a.loc());
X}
X
X/* Destructors */
X
X#ifdef overwrite
Xadouble::~adouble()
X{
X   ++dealloc; 
X   if (location < deminloc) deminloc = location;
X}
X
Xadub::~adub()
X{
X  ++dealloc; 
X  if (location < deminloc) deminloc = location;
X}
X
X#ifdef conditional
Xasub::~asub()
X{
X  ++dealloc;
X  if (location < deminloc)
X    deminloc = location;
X}
X#endif
X
X#endif
X
X/*
X  Member function returns the location of this adouble.
X*/
Xlocint badouble::loc() const 
X{
X  return location;
X}
X
X/*
X  double returns the true floating point value of an adouble variable
X*/
Xdouble value(const badouble& x) 
X{
X  return store[x.location];
X}
X
X/*
X  Define what it means to assign an adouble variable a constant value.
X*/
Xbadouble& badouble::operator = (double y) 
X{  
X  if (trace_flag) write_assign_d(location,y);
X  store[location]=y;
X  return *this;
X}   
X
X/*
X  Define what it means to assign an adouble variable an independent value.
X*/
X
Xbadouble& badouble::operator <<= (double y) 
X{  
X  if (trace_flag) write_assign_ind(location); 
X  store[location]=y;
X  return *this;
X}   
X
X/*
X  Define what it means to assign a float variable a dependent adouble value.
X*/
Xbadouble& badouble::operator >>= (double& y) 
X{  
X  if (trace_flag) write_assign_dep(location);
X  y = double (store[location]);
X  return *this;
X}   
X
X/*
X  Define what it means to assign an Badouble variable an Badouble value.
X  Optionally trace this action.
X*/
Xbadouble& badouble::operator = (const badouble& x) 
X{  
X  if (trace_flag) write_assign_a(location,x.location);
X  store[location]=store[x.location];
X  return *this;
X}   
Xbadouble& badouble::operator = (const adub& a)
X{
X  if (trace_flag) write_assign_a(location,a.location);
X  store[location]=store[a.location] ;
X  return *this;
X}
X
X/*
X  Define define what it means to output an adouble value. 
X  No tracing of this action
X*/
X
Xostream& operator << (ostream& out,const badouble& y)
X{
X  return out << store[y.location] << "(a)" ;
X}
X
X/*
X  Define define what it means to input adouble value.
X*/
X
Xistream& operator >> (istream& in,const badouble& y)
X{
X  double temp;
X  in >> temp;
X  store[y.location]=temp;
X  if (trace_flag) write_assign_d(y.location,temp);
X  return in;
X}
X  
X
Xadub adouble::operator++(int)  /* postfix increment */
X{
X  locint locat = next_loc();
X  store[locat]=store[location];
X  if (trace_flag) write_assign_a(locat,location);
X  if (trace_flag) write_d_same_arg(eq_plus_d,location,1.0);
X  store[location]++;
X  return locat ;
X}
X
Xadub adouble::operator--(int) /* postfix decrement */
X{
X  locint locat = next_loc();
X  store[locat]=store[location];
X  if (trace_flag) write_assign_a(locat,location);
X  if (trace_flag) write_d_same_arg(eq_min_d,location,1.0);
X  store[location]--;
X  return locat ;
X}
X
Xbadouble& adouble::operator++() /* prefix increment */
X{
X  if (trace_flag) write_d_same_arg(eq_plus_d,location,1.0);
X  store[location]++;
X  return *this;
X}
X
Xbadouble& adouble::operator--() /* prefix decrement */
X{
X  if (trace_flag) write_d_same_arg(eq_min_d,location,1.0);
X  store[location]--;
X  return *this;
X}
X
X
X/*
X  Adding a floating point to an adouble. Optionally trace this action.
X*/
Xbadouble& badouble::operator += (double y) 
X{  
X  if (trace_flag) write_d_same_arg(eq_plus_d,location,y);
X  store[location]+=y;
X  return *this; 
X} 
X
X
X/*
X  Subtracting a floating point from an adouble. Optionally trace this
X  activity.
X*/
Xbadouble& badouble::operator -= (double y) 
X{  
X  if (trace_flag) write_d_same_arg(eq_min_d,location,y);
X  store[location]-=y;
X  return *this;
X}
X
X/*
X  Add an adouble to another adouble. Optionally trace this action.
X*/
Xbadouble& badouble::operator += (const badouble& y) 
X{  
X  if (trace_flag) write_a_same_arg(eq_plus_a,location,y.location);
X  store[location]+=store[y.location];
X  return *this;
X}
X
X/*
X  Subtract an adouble from another adouble. Optionally trace this execution.
X*/
Xbadouble& badouble::operator -= (const badouble& y) 
X{  
X  if (trace_flag) write_a_same_arg(eq_min_a,location,y.location);
X  store[location]-=store[y.location];
X  return *this;
X}
X
X/* 
X  Multiply an adouble by a float. Optionally trace this execution.
X*/
Xbadouble& badouble::operator *= (double y) 
X{  
X  if (trace_flag) write_d_same_arg(eq_mult_d,location,y);
X  store[location]*=y;
X  return *this;
X}
X
X/*
X  Multiply one badouble by another. Optional trace.
X*/
Xbadouble& badouble::operator *= (const badouble& y) 
X{ 
X  if (trace_flag) write_a_same_arg(eq_mult_a,location,y.location);
X  store[location]*=store[y.location];
X  return *this;
X}
X
Xbadouble& badouble::operator /= (double y) 
X{  
X  *this = *this/y;
X  return *this;
X}
X
Xbadouble& badouble::operator /= (const badouble& y) 
X{ 
X  *this = *this*(1.0/y);
X  return *this;
X}
X
X/*   The Not Equal Operator (!=)      */
X
Xint operator != (const badouble& u,const badouble& v)
X{
X  return store[u.location] != store[v.location];
X}
X
Xint operator != (double u,const badouble& v)
X{
X  return u != store[v.location];
X}
X
Xint operator != (const badouble& v,double u)
X{
X  return store[v.location] != u;
X}
X
X/*   The Equal Operator (==)      */
X
Xint operator == (const badouble& u,const badouble& v)
X{
X  return store[u.location] == store[v.location];
X}
X
Xint operator == (double u,const badouble& v)
X{
X  return u == store[v.location];
X}
X
Xint operator == (const badouble& v,double u)
X{
X  return store[v.location] == u;
X}
X
X/*   The Less than or Equal Operator (<=)      */
X
Xint operator <= (const badouble& u,const badouble& v)
X{
X  return store[u.location] <= store[v.location];
X}
X
Xint operator <= (double u,const badouble& v)
X{
X  return u <= store[v.location];
X}
X
Xint operator <= (const badouble& v,double u)
X{
X  return store[v.location] <= u;
X}
X
X/*   The Greater than or Equal Operator (>=)      */
X
Xint operator >= (const badouble& u,const badouble& v)
X{
X  return store[u.location] >= store[v.location];
X}
X
Xint operator >= (double u,const badouble& v)
X{
X  return u >= store[v.location];
X}
X
Xint operator >= (const badouble& v,double u)
X{
X  return store[v.location] >= u;
X}
X
X/*   The Greater than Operator (>)      */
X
Xint operator > (const badouble& u,const badouble& v)
X{
X  return store[u.location] > store[v.location];
X}
X
Xint operator > (double u,const badouble& v)
X{
X  return u > store[v.location];
X}
X
Xint operator > (const badouble& v,double u)
X{
X  return store[v.location] > u;
X}
X
X/*   The Less than Operator (<)      */
X
Xint operator < (const badouble& u,const badouble& v)
X{
X  return store[u.location] < store[v.location];
X}
X
Xint operator < (double u,const badouble& v)
X{
X  return u < store[v.location];
X}
X
Xint operator < (const badouble& v,double u)
X{
X  return store[v.location] < u;
X}
X
X/* 
X  Adding two badoubles.  NOTE: calculates address of temporary, and returns
X  an adub.
X*/
X
Xadub operator + (const badouble& x, const badouble& y) 
X{ 
X  locint locat = next_loc();
X  store[locat]= store[x.location]+store[y.location];
X  if (trace_flag) write_two_a_rec(plus_a_a,locat,x.location,y.location);
X  return locat;
X}
X
X/*
X  Adding a badouble and a double. Optional trace. Temporary assignment.
X*/
X
Xadub operator + (double x, const badouble& y) 
X{ 
X  locint locat = next_loc();
X  store[locat]= x+store[y.location];
X  if (trace_flag) write_args_d_a(plus_d_a,locat,x,y.location);
X  return locat;
X}
X
Xadub operator + (const badouble& y, double x) 
X{ 
X  locint locat = next_loc();
X  store[locat]= x+store[y.location];
X  if (trace_flag) write_args_d_a(plus_d_a,locat,x,y.location);
X  return locat;
X}
X
X/*
X  Subtraction of two badoubles. Optional Trace. Temporary used.
X*/
X
Xadub operator - (const badouble& x, const badouble& y)
X{  
X  locint locat = next_loc();
X  store[locat]=store[x.location]-store[y.location];
X  if (trace_flag) write_two_a_rec(min_a_a,locat,x.location,y.location);
X  return locat;
X}
X
X/*
X  Subtract a badouble from a double. Optional trace. Temporary used. 
X*/
X
Xadub operator - (double x, const badouble& y)
X{
X  locint locat = next_loc();
X  store[locat]=x-store[y.location];
X  if (trace_flag) write_args_d_a(min_d_a,locat,x,y.location);
X  return locat; 
X}
X
X
X/*
X  Multiply two badouble numbers.  Optional trace. Use temporary.
X*/
X
Xadub operator * (const badouble& x, const badouble& y)
X{ 
X  locint locat = next_loc();
X  store[locat]=store[x.location]*store[y.location];
X  if (trace_flag) write_two_a_rec(mult_a_a,locat,x.location,y.location);
X  return locat;
X}
X
X/* 
X  Multiply a badouble by a double.  Optional Trace. 
X*/ 
X
Xadub operator * (double x, const badouble& y)
X{ 
X  locint locat = next_loc();
X  store[locat]=x*store[y.location];
X  if (trace_flag) write_args_d_a(mult_d_a,locat,x,y.location);
X  return locat;
X}
X
X/*
X   Divide a badouble by an badouble.
X*/
X
Xadub operator / (const badouble& x, const badouble& y)
X{  
X  locint locat = next_loc();
X  store[locat] = store[x.location]/store[y.location];
X  if (trace_flag) write_two_a_rec(div_a_a,locat,x.location,y.location);
X  return locat;
X}
X
X/*
X  Division double - badouble.
X*/
X
Xadub operator / (double x, const badouble& y)
X{ 
X  locint locat = next_loc();
X  store[locat]= x/store[y.location];
X  if (trace_flag) write_args_d_a(div_d_a,locat,x,y.location);
X  return locat;
X}
X
X/* 
X  Compute exponential of badouble.  
X*/
X
Xadub exp (const badouble& x)
X{  
X  locint locat = next_loc();
X  store[locat]=exp(store[x.location]);
X  if (trace_flag) write_single_op(exp_op,locat,x.location);
X  return locat; 
X}
X
X/*
X  Compute logarithm of badouble. Optional Trace. Use temporary. 
X*/
X
Xadub log (const badouble& x)
X{ 
X  locint locat = next_loc();
X  store[locat]=log(store[x.location]);
X  if (trace_flag) write_single_op(log_op,locat,x.location);
X  return locat; 
X}
X
X/*
X  Compute sqrt of adouble. Optional Trace. Use temporary. 
X*/
X
Xadub sqrt (const badouble& x)
X{ 
X  locint locat = next_loc();
X  store[locat]=sqrt(store[x.location]);
X  if (trace_flag) write_single_op(sqrt_op,locat,x.location);
X  return locat; 
X}
X
X/*
X  Compute sin of badouble. Optional trace.
X  Note:Sin and Cos are always evaluated together
X*/
Xadub sin (const badouble& x) 
X{ 
X  locint locat = next_loc(); 
X  store[locat]=sin(store[x.location]);
X  adouble y;
X  store[y.location]=cos(store[x.location]);
X  if (trace_flag) write_quad(sin_op,locat,x.location,y.location);
X  return locat;
X}
X
X/*
X  Compute cos of badouble. Optional trace.
X*/
X
Xadub cos (const badouble& x)
X{ 
X  locint locat = next_loc();
X  store[locat]=cos(store[x.location]);
X  adouble y;
X  store[y.location]=sin(store[x.location]);
X  if (trace_flag) write_quad(cos_op, locat,x.location,y.location);
X  return locat; 
X}
X
Xadub tan (const badouble& x) 
X{ 
X  return sin(x)/cos(x);
X}
X
X/*
X  Asin value. -- really a quadrature. Use temporary. Optional trace.
X*/
X
Xadub asin (const badouble& x)
X{
X  locint locat = next_loc();
X  adouble y = 1.0/sqrt(1.0-x*x);
X  store[locat]=asin(store[x.location]);
X  if (trace_flag) write_quad(asin_op,locat,x.location,y.location);
X  return locat; 
X}
X
X/*
X  Acos value. -- really a quadrature. Use temporary. Optional trace.
X*/
X
Xadub acos (const badouble& x)
X{
X  locint locat = next_loc();
X  adouble y = -1.0/sqrt(1.0-x*x);
X  store[locat]=acos(store[x.location]);
X  if (trace_flag) write_quad(acos_op,locat,x.location,y.location);
X  return locat; 
X}
X
X/*
X  Atan value. -- really a quadrature. Use temporary. Optional trace.
X*/
X
Xadub atan (const badouble& x)
X{
X  locint locat = next_loc();
X  adouble y= 1.0/(1.0+x*x);
X  store[locat]=atan(store[x.location]);
X  if (trace_flag) write_quad(atan_op,locat,x.location,y.location);
X  return locat; 
X}
X
Xadub atan2(const badouble& y,const badouble& x)
X{
X  const double pihalf = asin(1.0);
X  double vx = value(x);
X  double vy = value(y);
X  double sy = (vy > 0) ? 1.0 : -1.0 ;
X  if(fabs(vx) > fabs(vy))
X    {
X      if(vx>0)
X	return atan(y/x);
X      else
X	return atan(y/x)+sy*2*pihalf;
X    } 
X  else
X    {
X      if(vy !=0) 
X	return sy*pihalf-atan(x/y);
X      else 
X      {  /* nodifferentiable case */
X        locint locat=next_loc();
X        store[locat]=0.0;
X        if(trace_flag) write_int_assign_d(locat,0.0);
X	return locat;  
X      }
X    }
X}
X
X/*
X  power value. -- adouble/double .
X*/
X
Xadub pow (const badouble& x,double y)
X{
X  locint locat = next_loc();
X  store[locat] = pow(store[x.location],y);
X  if (trace_flag) write_args_d_a(pow_op,locat,y,x.location);
X  return locat;
X}
X
X/*
X  power value. --- adouble/adouble .
X*/
X
Xadub pow (const badouble& x,const badouble& y)  
X{
X  double vx = store[x.location];
X  if(vx>0)
X    return exp(y*log(x));
X  else
X    {
X      double vy = store[y.location];
X      if(vx < 0 || vy >= 0)
X	{
X	  cout << "ADOL-C message: exponent of negative basis deactivated \n";
X	  return pow(x,value(y));
X	}
X      else 
X	cout << "ADOL-C message: negative exponent and zero basis deactivated \n";
X      locint locat=next_loc();
X      store[locat]=pow(vx,vy);
X      if(trace_flag) write_int_assign_d(locat,store[locat]);
X      return locat;
X    }   
X}
X
X/*
X  log base 10 of an adouble value.
X*/
X
Xadub log10 (const badouble& x) 
X{
X  return log(x)/log(10);
X}
X
X/*
X  Hyperbolic Sine of an adouble value.
X*/
X
Xadub sinh (const badouble& x) 
X{
X  adouble temp= exp(x);
X  return  0.5*(temp-1/temp);
X}
X
X/*
X  Hyperbolic Cosine of an adouble value.
X*/
X
Xadub cosh (const badouble& x) 
X{
X  adouble temp= exp(x);
X  return 0.5*(temp+1/temp);
X}
X
X/*
X  Hyperbolic Tangent of an adouble value.
X*/
X
Xadub tanh (const badouble& x) 
X{
X  adouble temp= exp(2*x);
X  return (temp-1)/(temp+1);
X}
X
X/*
X  Ceiling Function (Note: This function is nondifferentiable)
X*/
X
Xadub ceil (const badouble& x) 
X{
X  locint locat=next_loc();
X  store[locat]=ceil(store[x.location]);
X  if(trace_flag) write_int_assign_d(locat,store[locat]);
X  return locat;
X}
X
X/*
X  Floor Function (Note: This function is nondifferentiable)
X*/
X
Xadub floor (const badouble& x) 
X{
X  locint locat=next_loc();
X  store[locat]=floor(store[x.location]);
X  if(trace_flag) write_int_assign_d(locat,store[locat]);
X  return locat;
X}
X
X#ifdef Inverse_hyperbolics
X
X/*
X  Asinh value. -- really a quadrature. Use temporary. Optional trace.
X*/
X
Xadub asinh (const badouble& x)
X{
X  locint locat = next_loc();
X  adouble y= 1.0/sqrt(1.0+x*x);
X  store[locat]=asinh(store[x.location]);
X  if (trace_flag) write_quad(gen_quad,locat,x.location,y.location);
X  return locat; 
X} 
X
X/*
X  Acosh value. -- really a quadrature. Use temporary. Optional trace.
X*/
X
Xadub acosh (const badouble& x)
X{
X  locint locat = next_loc();
X  adouble y= 1.0/sqrt(1.0-x*x);
X  store[locat]=acosh(store[x.location]);
X  if (trace_flag) write_quad(gen_quad,locat,x.location,y.location);
X  return locat; 
X}
X
X/*
X  Atanh value. -- really a quadrature. Use temporary. Optional trace.
X*/
X
Xadub atanh (const badouble& x)
X{
X  locint locat = next_loc();
X  adouble y= 1.0/(1.0-x*x);
X  store[locat]=atanh(store[x.location]);
X  if (trace_flag) write_quad(gen_quad,locat,x.location,y.location);
X  return locat; 
X}
X#endif
X
X/*
X  Fabs Function (Note: This function is also nondifferentiable at x=0)
X*/
Xadub fabs (const badouble& x)
X{
X  locint locat = next_loc();
X  store[locat] = fabs(store[x.location]);
X  if (trace_flag) write_single_op(abs_val,locat,x.location);
X  return locat;
X}
X
X/*
X  max and min functions 
X*/
X
Xadub max (const badouble& x, const badouble& y)
X{
X  return (0.5*(x+y+fabs(x-y)));
X}
X
Xadub min (const badouble& x, const badouble& y)
X{
X  return (0.5*(x+y-fabs(x-y)));
X}
X
X
X/*
X  Ldexp Function. 
X*/
X
Xadub ldexp (const badouble& x,int exp) 
X{
X  return x*ldexp(1.0,exp);
X}
X
X
X/*  The error function erf, enable if your math.h contains erf(double) */
X
Xadub erf(const badouble& x) 
X{
X  locint locat = next_loc();
X  adouble q= exp(-x*x);
X  store[locat]=erf(store[x.location]);
X  if (trace_flag) write_quad(gen_quad,locat,x.location,q.location);
X  return locat;
X} 
X
X/* Macro for user defined quadratures, example myquad is below */
X
X#define extend_quad(func,integrand)\
Xadouble func (const badouble& arg)\
X{  adouble temp; \
X    adouble val; \
X    integrand; \
X    store[temp.location]=func(store[arg.location]); \
X    if (trace_flag) \
X	write_quad(gen_quad,temp.location,arg.location,val.location);\
X    return temp; }
X
Xdouble myquad(double& x)
X{
X  double res;
X  res = log(x);
X  return res;
X}
X
X/* This defines the natural logarithm as a quadrature */
X
Xextend_quad(myquad,val = 1/arg)
X
X
X/* ADDITIONAL ASSIGNMENTS */
X
X/*
X  Define what it means to assign an adouble variable a float value.
X*/
X
Xadouble& adouble::operator = (double y) 
X{  
X   if (trace_flag) write_assign_d(location,y);
X   store[location]=y;
X   return *this;
X}  
X
Xadouble& adouble::operator = (const badouble& x) 
X{  
X   if (trace_flag) write_assign_a(location,x.loc());
X   store[location]=store[x.loc()];
X   return *this;
X}   
X
Xadouble& adouble::operator = (const adouble& x) 
X{  
X   if (trace_flag) write_assign_a(location,x.location);
X   store[location]=store[x.location];
X   return *this;
X}   
X
Xbadouble& badouble::operator = (const adouble& x) 
X{  
X   if (trace_flag) write_assign_a(location,x.location);
X   store[location]=store[x.location];
X   return *this;
X}   
X
Xadouble& adouble::operator = (const adub& a)
X{
X  if (trace_flag) write_assign_a(location,a.loc());
X  store[location]=store[a.loc()] ;
X  return *this;
X}
X
X
X#ifdef conditional
Xvoid condassign(adouble &result, const adouble &arg1, const adouble &r1, const adouble &r2) 
X{
X  if (trace_flag)
X    write_condassign(result.location,arg1.location,r1.location,
X		     r2.location);
X
X  if (store[arg1.location]>0)
X    store[result.location]=store[r1.location];
X  else
X    store[result.location]=store[r2.location];
X}
X
Xvoid condassign(adouble &result, const adouble &arg1, const adouble &r1) 
X{
X  if (trace_flag)		
X    write_condassign2(result.location,arg1.location,r1.location);
X  
X  if (store[arg1.location]>0)
X    store[result.location]=store[r1.location];
X}
X
Xasub::asub(locint start, locint index)
X{
X#ifdef DEBUG
X  printf("ADOL-C debug: Constructing an asub with 2 arguments\n");
X#endif
X  
X  base=start;
X  offset=index;
X
X  location=next_loc();
X
X  store[location]=store[base+(int)store[offset]];
X  
X  if (trace_flag)
X    write_associating_value(subscript,location,base,offset);
X}
X
Xalong& along::operator = (int y) 
X{  
X   if (trace_flag) write_assign_d(location,y);
X   store[location]=y;
X   return *this;
X}   
X
Xasub& asub::operator <<= (double y) 
X{  
X  if (trace_flag)
X    {
X      write_assign_ind(location);
X      write_associating_value(subscript_l,location,base,offset);
X    }
X
X  store[base+(int)store[offset]]=y;
X
X  return *this;
X}   
X
Xasub& asub::operator = (const adub& a)
X{
X  if (trace_flag)
X      write_associating_value(subscript_l,a.loc(),base,offset);
X  store[base+(int)store[offset]]=store[a.loc()] ;
X  return *this;
X}
X
Xasub& asub::operator = (double x)
X{
X  if (trace_flag)
X    write_associating_value_ld(subscript_ld,x,base,offset);
X    store[base+(int)store[offset]]=x;
X  return *this;
X}
X
Xasub& asub::operator = (const badouble& x) 
X{  
X  if (trace_flag)
X    write_associating_value(subscript_l,x.loc(),base,offset);
X  store[base+(int)store[offset]]=store[x.loc()];
X  return *this;
X}   
X
Xalong& along::operator = (const badouble& x) 
X{  
X  if (trace_flag)
X    write_assign_a(location,x.loc());
X  store[location]=store[x.loc()];
X  return *this;
X}
X
Xalong& along::operator = (const along& x) 
X{  
X  if (trace_flag)
X    write_assign_a(location,x.location);
X  store[location]=store[x.location];
X  return *this;
X}
X
Xalong& along::operator = (const adub& a)
X{
X  if (trace_flag)
X    write_assign_a(location,a.loc());
X  store[location]=store[a.loc()] ;
X  return *this;
X}
X
Xalong::along(int y)
X{
X  store[location] = y;
X  if (trace_flag) write_int_assign_d(location,y);
X}
X
Xalong::along(const along& a)
X{
X  store[location]=store[a.location];
X  if (trace_flag) write_int_assign_a(location,a.location);
X}
X
Xalong::along(const adub& a)
X{
X  store[location]=store[a.loc()];
X  if (trace_flag) write_int_assign_a(location,a.loc());
X}
X#endif
X
X
X
X/* end of adouble.c */
X
X
END_OF_FILE
if test 26915 -ne `wc -c <'adouble.c'`; then
    echo shar: \"'adouble.c'\" unpacked with wrong size!
fi
chmod +x 'adouble.c'
# end of 'adouble.c'
fi
if test -f 'adouble.h' -a "${1}" != "-c" ; then 
  echo shar: Will not clobber existing file \"'adouble.h'\"
else
echo shar: Extracting \"'adouble.h'\" \(14752 characters\)
sed "s/^X//" >'adouble.h' <<'END_OF_FILE'
X/*
X  ---------------------------------------------------------------
X  file adouble.h of ADOL-C version 1.6 as of January 1,   1995 
X
X  Included in:
X              adouble.c
X              avector.c
X	      all ADOL-C applications programs.
X  
X  -----------------------------------------------------------------
X
X  adouble.h contains the basis for the class of adouble
X  included here are all the possible functions defined on
X  the adouble class.  Notice that, as opposed to ealier versions,
X  both the class adub and the class adouble are derived from a base
X  class (badouble).  See below for further explanation.
X*/
X
X/*      D I S C L A I M E R 
X
XThe ADOL-C Software is provided under the following disclaimer:
X
XNO WARRANTY.  The software was created in the course of a research
Xendeavor. It is not a commercial package.  The present version is
Xstill in development, and is distributed "AS IS, WITH ALL DEFECTS."
XBy using the software, each user agrees to assume all responsibility
Xfor any and all such use.  The authors and Argonne National Laboratory
Xare not aware that the software or the use thereof infringe any
Xproprietary right belonging to a third party.  However, NO WARRANTY,
XCONDITION, OR REPRESENTATION OF ANY KIND, EXPRESS OR IMPLIED, is made
Xabout the software, including without limitation any warranty of title,
Xnoninfringement, merchantability, or fitness for a particular purpose,
Xby the authors or their affiliated institutions.
X
XNO CONSEQUENTIAL DAMAGES.  Independent of the foregoing disclaimer
Xof warranties, each person that uses the software thereby agrees, that
XNEITHER ARGONNE NATIONAL LABORATORY NOR THE AUTHORS OR THEIR AFFILIATED
XINSTITUTIONS SHALL BE LIABLE FOR ANY INCIDENTAL OR CONSEQUENTIAL DAMAGES
XIN CONNECTION WITH THE USE OF THE SOFTWARE, INCLUDING WITHOUT LIMITATION
XLOST PROFITS OR INJURY TO BUSINESS, WHETHER OR NOT ARGONNE NATIONAL
XLABORATORY, AND THE AUTHORS AND THEIR AFFILIATED INSTITUTIONS KNOW OR
XHAVE REASON TO KNOW OF THE POSSIBILITY OF SUCH DAMAGES.
X
XINDEMNITY.  Each person that uses the software thereby agrees, to
Xindemnify and defend Argonne National Laboratory and the authors and
Xtheir affiliated institutions, or any of them, against any loss, expense,
Xclaim, damage, or liability of any kind arising from or connected with
Xtheir respective uses of the software, and to hold them or any of them
Xharmless from any of the same, WHETHER OR NOT ARISING IN WHOLE OR IN PART
XFROM THE NEGLIGENCE OR GROSS NEGLIGENCE OF ARGONNE NATIONAL LABORATORY OR
XANY OF THE AUTHORS OR THEIR AFFILIATED INSTITUTIONS.
X
XSUPPORT. Each person that uses this software understands that the software
Xis not supported by the authors or by their affiliated institutions.
X*/
X
X
X#include "usrparms.h"
X#include "dvlparms.h" /* Developers Parameters */
X
X#include <stream.h>
X
X/*
X  Notice that the purpose of the class adub is merely to avoid the generation
X  and recording of an extra return adouble for each elementary 
X  operation and function call. The same result can be achieved much
X  more elegantly with GNUs named return variables, which would also 
X  achieve the desired last in first out pattern for adouble construction 
X  and destruction.
X*/
X
Xclass adouble;
Xclass adub;
Xclass badouble;
X#ifdef conditional
Xclass badoublev;
Xclass adoublev;
Xclass adubv;
X/* class doublev; */
X
X
Xvoid condassign(double &res, const double &cond, const double &arg1, const double &arg2);
Xvoid condassign(double &res, const double &cond, const double &arg1);
X
Xinline double max(const double &x, const double &y){
X  return (0.5*(x+y+fabs(x-y))); }
Xinline double min(const double &x, const double &y){
X  return (0.5*(x+y-fabs(x-y))); }
X
X
X
X#endif
X
X/* 
X   The class badouble contains the basic definitions for 
X   the arithmetic operations, comparisons, etc. 
X   This is a basic class from which the adub and adouble are 
X   derived.  Notice that the constructors/destructors for 
X   the class badouble are of the trivial variety.  This is the
X   main difference among badoubles, adubs, and adoubles.
X*/
X
Xclass badouble{
X  friend class badoublev;
X protected:
X  locint location;
X  badouble(){};
X  badouble(const badouble& a){location = a.location;};
X  badouble(locint lo){location = lo;};
X
X public:
X
X#ifdef conditional
X
X  friend void condassign(adouble &result, const adouble &arg1,
X                         const adouble &r1, const adouble &r2);
X  friend void condassign(adouble &result, const adouble &arg1,
X                         const adouble &r1);
X#endif
X
X  locint loc() const;
X  friend double value(const badouble&);
X  badouble& operator >>= (double&);
X  badouble& operator <<= (double);
X  badouble& operator = (double);
X  badouble& operator = (const badouble&);
X  badouble& operator = (const adub&);
X  badouble& operator = (const adouble&);
X  badouble& operator += (double);
X  badouble& operator += (const badouble&);
X  badouble& operator -= (double y);
X  badouble& operator -= (const badouble&);
X  badouble& operator *= (double);
X  badouble& operator *= (const badouble&);
X  badouble& operator /= (double);
X  badouble& operator /= (const badouble&);
X
X  friend ostream& operator << (ostream&, const badouble&);
X  friend istream& operator >> (istream&, const badouble&);
X
X  friend int operator != (const badouble&,const badouble&);
X  friend int operator != (double,const badouble&);
X  friend int operator != (const badouble&,double);
X  friend int operator == (const badouble&,const badouble&);
X  friend int operator == (double,const badouble&);
X  friend int operator == (const badouble&,double);
X  friend int operator >= (const badouble&,const badouble&);
X  friend int operator >= (double,const badouble&);
X  friend int operator >= (const badouble&,double);
X  friend int operator <= (const badouble&,const badouble&);
X  friend int operator <= (double,const badouble&);
X  friend int operator <= (const badouble&,double);
X  friend int operator > (const badouble&,const badouble&);
X  friend int operator > (double,const badouble&);
X  friend int operator > (const badouble&,double);
X  friend int operator < (const badouble&,const badouble&);
X  friend int operator < (double,const badouble&);
X  friend int operator < (const badouble&,double);
X
X  /* End of Comparision Operators */
X
X  inline friend adub operator + (const badouble& x); //{return x + 0.0 ;} ; 
X  friend adub operator + (const badouble&,const badouble&); 
X  friend adub operator + (double, const badouble&); 
X  friend adub operator + (const badouble&, double); 
X  inline friend adub operator - (const badouble& x ,double y); //{return (-y)+x;}; 
X  friend adub operator - (const badouble&,const badouble&); 
X  friend adub operator - (double, const badouble&); 
X  inline friend adub operator - (const badouble& x); //{return 0.0 - x;}; 
X  friend adub operator * (const badouble&,const badouble&); 
X  friend adub operator * (double, const badouble& ); 
X  inline friend adub operator * (const badouble& x, double y); //{return y*x;}; 
X  inline friend adub operator / (const badouble& x, double y); // {return (1.0/y)*x;}; 
X  friend adub operator / (const badouble&,const badouble&); 
X  friend adub operator / (double,const badouble&); 
X  friend adub exp (const badouble&); 
X  friend adub log (const badouble&); 
X  friend adub sqrt (const badouble&);
X  friend adub sin (const badouble&); 
X  friend adub cos (const badouble&);
X  friend adub tan (const badouble&);
X  friend adub asin (const badouble&);
X  friend adub acos (const badouble&);
X  friend adub atan (const badouble&); 
X  friend adub atan2 (const badouble&,const badouble&); 
X  friend adub pow (const badouble&,double);
X  friend adub pow (const badouble&,const badouble&);
X  friend adub log10 (const badouble&);
X
X  /* User defined version of logarithm to test extend_quad macro */
X
X  friend adouble myquad(const badouble&);
X
X  /* Additional ANSI C standard Math functions Added by DWJ on 8/6/90 */
X
X  friend adub sinh (const badouble&);
X  friend adub cosh (const badouble&);
X  friend adub tanh (const badouble&);
X  friend adub ceil (const badouble&);
X  friend adub floor (const badouble&);
X  friend adub asinh (const badouble&);
X  friend adub acosh (const badouble&);
X  friend adub atanh (const badouble&);
X  friend adub fabs (const badouble&);
X  friend adub max (const badouble&, const badouble&);
X  friend adub min (const badouble&, const badouble&);
X  friend adub ldexp (const badouble&,int);
X  friend adub frexp (const badouble&,int*);
X  friend adub erf (const badouble&);
X  /* End of ANSI C Additions */
X};
X
X/* The derived classes */
X/* 
X   The class Adub
X   ---- Basically used as a temporary result.  The address for an
X        adub is usually generated within an operation.  That address
X        is "freed" when the adub goes out of scope (at destruction time).
X   ---- operates just like a badouble, but it has a destructor defined for it.
X*/
X
Xclass adub:public badouble{
X  friend class adouble;
X protected:
X  adub(locint lo):badouble(lo){};
X  adub():badouble(0){
X      cout << "ADOL-C error: illegal default construction of adub variable\n" ;
X      exit(-2);
X         };
X  adub(double):badouble(0){
X      cout << "ADOL-C error: illegal  construction of adub variable from double\n" ;
X      exit(-2);
X         };
X public:
X  friend double value(const badouble&);
X  friend ostream& operator << (ostream&, const badouble&);
X  friend istream& operator >> (istream&, const badouble&);
X
X  friend int operator != (const badouble&,const badouble&);
X  friend int operator != (double,const badouble&);
X  friend int operator != (const badouble&,double);
X  friend int operator == (const badouble&,const badouble&);
X  friend int operator == (double,const badouble&);
X  friend int operator == (const badouble&,double);
X  friend int operator >= (const badouble&,const badouble&);
X  friend int operator >= (double,const badouble&);
X  friend int operator >= (const badouble&,double);
X  friend int operator <= (const badouble&,const badouble&);
X  friend int operator <= (double,const badouble&);
X  friend int operator <= (const badouble&,double);
X  friend int operator > (const badouble&,const badouble&);
X  friend int operator > (double,const badouble&);
X  friend int operator > (const badouble&,double);
X  friend int operator < (const badouble&,const badouble&);
X  friend int operator < (double,const badouble&);
X  friend int operator < (const badouble&,double);
X
X  /* End of Comparision Operators */
X
X  friend adub operator + (const badouble& x); //{return x + 0.0 ;} ; 
X  friend adub operator + (const badouble&,const badouble&); 
X  friend adub operator + (double, const badouble&); 
X  friend adub operator + (const badouble&, double); 
X  friend adub operator - (const badouble& x ,double y); //{return (-y)+x;}; 
X  friend adub operator - (const badouble&,const badouble&); 
X  friend adub operator - (double, const badouble&); 
X  friend adub operator - (const badouble& x); //{return 0.0 - x;}; 
X  friend adub operator * (const badouble&,const badouble&); 
X  friend adub operator * (double, const badouble& ); 
X  friend adub operator * (const badouble& x, double y); //{return y*x;}; 
X  friend adub operator / (const badouble& x, double y); // {return (1.0/y)*x;}; 
X  friend adub operator / (const badouble&,const badouble&); 
X  friend adub operator / (double,const badouble&); 
X  friend adub exp (const badouble&); 
X  friend adub log (const badouble&); 
X  friend adub sqrt (const badouble&);
X  friend adub sin (const badouble&); 
X  friend adub cos (const badouble&);
X  friend adub tan (const badouble&);
X  friend adub asin (const badouble&);
X  friend adub acos (const badouble&);
X  friend adub atan (const badouble&); 
X  friend adub atan2 (const badouble&,const badouble&); 
X  friend adub pow (const badouble&,double);
X  friend adub pow (const badouble&,const badouble&);
X  friend adub log10 (const badouble&);
X
X  /* User defined version of logarithm to test extend_quad macro */
X
X  friend adouble myquad(const badouble&);
X
X  /* Additional ANSI C standard Math functions Added by DWJ on 8/6/90 */
X
X  friend adub sinh (const badouble&);
X  friend adub cosh (const badouble&);
X  friend adub tanh (const badouble&);
X  friend adub ceil (const badouble&);
X  friend adub floor (const badouble&);
X  friend adub asinh (const badouble&);
X  friend adub acosh (const badouble&);
X  friend adub atanh (const badouble&);
X  friend adub fabs (const badouble&);
X  friend adub max (const badouble&, const badouble&);
X  friend adub min (const badouble&, const badouble&);
X  friend adub ldexp (const badouble&,int);
X  friend adub frexp (const badouble&,int*);
X  friend adub erf (const badouble&);
X
X/*  removed 1/95 
X  friend adub operator*(const badoublev &op1, const doublev &op2);
X  friend adub operator*(const doublev &op1, const badoublev &op2);
X*/
X  friend adub operator*(const badoublev &op1, double* op2);
X  friend adub operator*(double* op1, const badoublev &op2);
X  friend adub operator*(const badoublev &op1, const badoublev &op2);
X  /* excluded because g++ warnings
X  friend adub operator*(const badoublev &op1, const doublev &op2);
X  friend adub operator*(const doublev &op1, const badoublev &op2);
X  */
X
X#ifdef overwrite
X  ~adub();
X#endif
X  };
X/*
X  The class adouble.
X  ---Derived from badouble.  Contains the standard constructors/destructors.
X  ---At construction, it is given a new address, and at destruction, that
X     address is freed.
X*/
Xclass adouble:public badouble{
X public:
X  adouble(const adub& a);
X  adouble(const adouble&);
X  adouble();
X  adouble(double);
X  adub operator++(int);
X  adub operator--(int);
X  badouble&  operator++();
X  badouble&  operator--();
X
X#ifdef overwrite
X  ~adouble();
X#endif
X  adouble& operator = (double);
X  adouble& operator = (const badouble&);
X  adouble& operator = (const adouble&);
X  adouble& operator = (const adub&);
X};
X
Xinline adub operator + (const badouble& x){return x + 0.0 ;} 
Xinline adub operator - (const badouble& x ,double y){return (-y)+x;}
Xinline adub operator - (const badouble& x){return 0.0 - x;}
Xinline adub operator * (const badouble& x, double y){return y*x;}
Xinline adub operator / (const badouble& x, double y){return (1.0/y)*x;}
X
X
X/* Supporting routines. */
X
Xvoid trace_on(short,int&); 
Xvoid trace_on(short);
X
Xvoid trace_off(int);
Xvoid trace_off();
X
X/* Include the definition of the vector classes */
X
X#ifdef conditional
Xclass asub:public badouble
X{
X  locint base,offset;
X public:
X  asub(locint start,locint index);
X#ifdef overwrite
X  ~asub();
X#endif
X  asub& operator <<= (double);
X  asub& operator = (double x);
X  asub& operator = (const adub&);
X  asub& operator = (const badouble&);
X};
X
Xclass along:public adouble
X{
X public:
X  along(const adub& a);
X  along(const along&);
X  along(){};
X  along(int);
X  along& operator = (int);
X  along& operator = (const badouble&);
X  along& operator = (const along&);
X  along& operator = (const adub&);
X};
X#endif
X
X#include "avector.h"
X
X
X
X
X
X
END_OF_FILE
if test 14752 -ne `wc -c <'adouble.h'`; then
    echo shar: \"'adouble.h'\" unpacked with wrong size!
fi
chmod +x 'adouble.h'
# end of 'adouble.h'
fi
if test -f 'adutils.h' -a "${1}" != "-c" ; then 
  echo shar: Will not clobber existing file \"'adutils.h'\"
else
echo shar: Extracting \"'adutils.h'\" \(2657 characters\)
sed "s/^X//" >'adutils.h' <<'END_OF_FILE'
X/*
X  ------------------------------------------------------------- 
X  File adutils.h of ADOL-C version 1.6 as of January 1,   1995 
X  Included in ---> drivers.c
X
X  -------------------------------------------------------------
X  Contains the definitions of the standard utility functions for
X  ADOL-C.  All of these routines are defined in drivers.c.
X  (See adutilsc.h for utility routines that are callable from FORTRAN,
X   C, and C++.)
X*/
X
Xextern "C" {
X#include "adutilsc.h"
X}
X/* Memory management routines. */
X
Xextern double ** myalloc(int,int);
Xextern double *** myalloc(int,int,int);
X
X
X/* forward(tag,m,n,d,keep,X[n][d+1],Y[m][d+1]) */
X
Xvoid forward(short,int,int,int,int,double**,double**);
X
X/* Y can be one dimensional if m=1 */
X
Xvoid forward(short,int,int,int,int,double**,double*);
X
X/* X and Y can be one dimensional if d = 0 */
X
Xvoid forward(short,int,int,int,int,double*,double*); 
X
X/* forward(tag,m,n,d,p,x[n],X[n][p][d],y[m],Y[m][p][d])        */
X
Xvoid forward(short, int,int,int,int,double*,double***,double*,double***);
X 
X/* forward(tag,m,n,p,x[n],X[n][p],y[m],Y[m][p])        */
X
Xvoid forward(short, int,int,int,double*,double**,double*,double**);
X
X/* reverse(tag,m,n,d,u[m],Z[n][d+1]) */
X
Xvoid reverse(short,int,int,int,double*,double**);
X
X/* u can be a scalar if m=1; */
X
Xvoid reverse(short,int,int,int,double,double**);
X
X/* Z can be vector if d = 0; Done by specialized code */
X
Xvoid reverse(short,int,int,int,double*,double*);
X
X/* u and Z can be scalars if m=1 and d=0; */
X
Xvoid reverse(short,int,int,int,double,double*);
X
X/* reverse(tag,m,n,d,p,U[m][p],Z[p][n][d+1],nz[p][n]) */
X
Xvoid reverse(short,int,int,int,int,double**,double***,short** =0);
X
X/* U can be a vector if m=1 */
Xvoid reverse(short,int,int,int,int,double*,double***,short** = 0);
X
X/* If d=0 then Z may be matrix; Done by specialized code */
Xvoid reverse(short,int,int,int,int,double**,double**);
X
X/* If m=1 and d=0 then U can be vector and Z a matrix but no nz. */
X
Xvoid reverse(short,int,int,int,int,double*,double**);
X
X/* If p and U are omitted they default to m and I so that as above */
X
Xvoid reverse(short,int,int,int,double***,short** =0);
X
X/* forode(tag,n,tau,dold,dnew,X[n][d+1]) */
X
Xvoid forode(short,int,double,int,int,double**);
X
X/* the scaling defaults to 1 */
X
Xvoid forode(short,int,/*1.0*/ int,int,double**);
X
X/* previous order defaults to 0 */
X
Xvoid forode(short,int,double,/*0*/ int,double**);
X
X/* both default */
X
Xvoid forode(short,int,/*1.0 , 0*/int,double**);
X
X/* accode(n,tau,d,Z,B,nz) */
X
Xvoid accode(int,double,int,double***,double***,short** = 0 );
X
X/* scaling defaults to 1 */
X
Xvoid accode(int,/*1.0*/ int,double***,double***,short** = 0 );
X
X
X
X
X
X
END_OF_FILE
if test 2657 -ne `wc -c <'adutils.h'`; then
    echo shar: \"'adutils.h'\" unpacked with wrong size!
fi
chmod +x 'adutils.h'
# end of 'adutils.h'
fi
if test -f 'adutilsc.h' -a "${1}" != "-c" ; then 
  echo shar: Will not clobber existing file \"'adutilsc.h'\"
else
echo shar: Extracting \"'adutilsc.h'\" \(4704 characters\)
sed "s/^X//" >'adutilsc.h' <<'END_OF_FILE'
X/*
X  ------------------------------------------------------------- 
X  File adutilsc.h of ADOL-C version 1.6 as of January 1,   1995 
X  Included in ---> driversc.c
X                   adutils.h
X
X
X  -------------------------------------------------------------
X
X
X 
X   This header file list the user utilities that are callable from C
X   Overloaded C++ routines are listed in adutils.h.  
X   Functions prototyped here are defined in the files
X            ---> driversc.c
X                 hos_forward.c  (hos_forward)
X		 fos_reverse.c  (fos_reverse)
X		 fov_reverse.c  (fov_reverse)
X		 hov_reverse.c  (hov_reverse)
X		 hos_reverse.c  (hos_reverse)
X		 tapestats      (taputil3.c)
X
X*/
X
X
X/* tapestats(tag,counts)  from (taputil3.c) */
Xvoid tapestats(short,int*); 
X
Xtypedef long   fint;
Xtypedef double fdouble;
X
Xdouble myclock();
Xdouble** myalloc2(int, int);
Xdouble*** myalloc3(int, int, int);
X
X/* hos_forward(tag,m,n,d,keep,X[n][d+1],Y[m][d+1]) from (hos_forward.c) */
X
Xvoid hos_forward(short,int,int,int,int,double**,double**);
X
X/* now pack the arrays into vectors for Fortran calling */
X
Xfint hos_forward_(fint*,fint*,fint*,fint*,fint*,fdouble*,fdouble*);
X
X/* hov_forward(tag,m,n,d,p,x[n],X[n][p][d],y[m],Y[m][p][d])        */
X
Xvoid hov_forward(short, int,int,int,int,double*,double***,double*,double***);
X
X/* now pack the arrays into vectors for Fortran calling      */
X
Xfint hov_forward_(fint*,fint*,fint*,fint*,fint*,fdouble*,fdouble*,fdouble*,fdouble*);
X
X/* fov_forward(tag,m,n,p,x[n],X[n][p],y[m],Y[m][p])   */
X 
Xvoid fov_forward(short, int,int,int,double*,double**,double*,double**);
X 
X/* now pack the arrays into vectors for Fortran calling      */
X
Xfint fov_forward_(fint*,fint*,fint*,fint*,fdouble*,fdouble*,fdouble*,fdouble*);
X
X/*  hos_reverse(tag,m,n,d,u[m],Z[n][d+1]) from (hos_reverse.c) */
X
Xvoid hos_reverse(short,int,int,int,double*,double**);
X
X/* now pack the arrays into vectors for Fortran calling      */
X
Xfint hos_reverse_(fint*,fint*,fint*,fint*,fdouble*,fdouble*);
X
X/* fos_reverse(tag,m,n,u[m],z[n]);  from (fos_reverse.c)     */
Xvoid fos_reverse(short,int,int,double*,double*);
X
X/* now pack the arrays into vectors for Fortran calling      */
Xfint fos_reverse_(fint*,fint*,fint*,fdouble*,fdouble*);
X
X/* hov_reverse(tag,m,n,d,p,U[m][p],Z[p][n][d+1],nz[p][n]) from(hov_reverse.c)*/
X
Xvoid hov_reverse(short,int,int,int,int,double**,double***,short**);
X
X/* now pack the arrays into vectors for Fortran calling      */
Xfint hov_reverse_(fint*,fint*,fint*,fint*,fint*,fdouble*,fdouble*);
X
X/* fov_reverse(tag,m,n,d,p,U[m][p],Z[p][n]); from (fov_reverse.c)  */
X
Xvoid fov_reverse(short,int,int,int,double**,double**);
X
X/* now pack the arrays into vectors for Fortran calling      */
X
Xfint fov_reverse_(fint*,fint*,fint*,fint*,fdouble*,fdouble*);
X
X/* function(tag,m,n,x[n],y[m])                               */
X
Xvoid function(short,int,int,double*,double*);
Xfint function_(fint*,fint*,fint*,fdouble*,fdouble*);
X
X/* gradient(tag,n,x[n],g[n])                              */
X
Xvoid gradient(short,int,double*,double*);
Xfint gradient_(fint*,fint*,fdouble*,fdouble*);
X
X/* lagra_hess_vec(tag,m,n,x[n],u[m],v[n],w[n]);              */
X
Xvoid lagra_hess_vec(short,int,int,double*,double*,double*,double*);
Xfint lagra_hess_vec_(fint*,fint*,fint*,fdouble*,fdouble*,fdouble*,fdouble*);
X
X/* hess_vec(tag,n,x[n],v[n],w[n]);                           */
X
Xvoid hess_vec(short,int,double*,double*,double*);
Xfint hess_vec_(fint*,fint*,fdouble*,fdouble*,fdouble*);
X
X/* hessian(tag,n,x[n], lower triangle of H[n][n])            */
X
Xvoid hessian(short,int,double*,double**);
X
X/* now pack the arrays into vectors for Fortran calling      */
X
Xfint hessian_(fint*,fint*,fdouble*,fdouble*);
X
X/* jacobian(tag,m,n,x[n],J[m][n])                            */
X
Xvoid jacobian(short,int,int,double*,double**);
X
X/* now pack the arrays into vectors for Fortran calling      */
X
Xfint jacobian_(fint*,fint*,fint*,fdouble*,fdouble*);
X
X/* jac_vec(tag,m,n,x[n],v[n],u[m]);                          */
X
Xvoid jac_vec(short,int,int,double*,double*,double*);
Xfint jac_vec_(fint*,fint*,fint*,fdouble*,fdouble*,fdouble*);
X
X/* vec_jac(tag,m,n,repeat,x[n],u[m],v[n]);                   */
X
Xvoid vec_jac(short,int,int,int,double*,double*,double*);
Xfint vec_jac_(fint*,fint*,fint*,fint*,fdouble*,fdouble*,fdouble*);
X
X/* forodec(tag,n,tau,dold,dnew,X[n][d+1])                    */
X
Xvoid forodec(short,int,double,int,int,double**);
Xfint forodec_(fint*,fint*,fdouble*,fint*,fint*,fdouble*);
X
X/* accodec(n,tau,d,Z[n][n][d+1],B[n][n][d+1],nz[n][n])       */
X
Xvoid accodec(int,double,int,double***,double***,short**);
X
X/* now pack the arrays into vectors for Fortran calling      */
X
Xfint accodec_(fint*,fdouble*,fint*,fdouble*,fdouble*);
X 
X
X
X
X
X
X
X
X
X
X
END_OF_FILE
if test 4704 -ne `wc -c <'adutilsc.h'`; then
    echo shar: \"'adutilsc.h'\" unpacked with wrong size!
fi
chmod +x 'adutilsc.h'
# end of 'adutilsc.h'
fi
if test -f 'avector.c' -a "${1}" != "-c" ; then 
  echo shar: Will not clobber existing file \"'avector.c'\"
else
echo shar: Extracting \"'avector.c'\" \(12337 characters\)
sed "s/^X//" >'avector.c' <<'END_OF_FILE'
X/*
X  -----------------------------------------------------------------------
X  file avector.c of ADOL-C version 1.6 as of January 1,   1995            
X  -----------------------------------------------------------------------
X  Avector.c contains the necessary routines for vector operations       
X  that are defined in avector.h.  Note: avector.h is already included   
X  in adouble.h, and hence does not need to be included here.            
X*/
X
X/* Local Includes */
X
X#include "adouble.h"
X#include "oplate.h"
X
X/* The "write" routines for the vector operations are written in straight C */
Xextern "C" {
X#include "taputil1.h"
X}
X
X/* Extra Include Files */
X
X#include <string.h>
X#include <stdio.h>
X#include <stdarg.h>
X
X/* Global vars and routines from adouble.c */
X
Xextern double* store;
Xextern int trace_flag;
Xextern locint next_loc(int size);
Xextern locint next_loc();
Xextern locint free_loc(int,int);
X
X/* ----- Start of vector operations ----- */
X
X/* ----- ACTIVE VECTOR SECTION ----- */
X  
Xadoublev::adoublev(int n)
X{
X#ifdef DEBUG
X  printf("ADOL-C debug:Declaring active vector\n");
X#endif
X  
X  size=n;
X  start_loc=next_loc(size); 
X}
X
X
X
Xadoublev::adoublev(const adoublev &op1)
X{
X#ifdef DEBUG
X  printf("ADOL-C debug:Declaring active vector and initializing from adoublev\n");
X#endif
X
X  size=op1.size;
X  start_loc=next_loc(size);
X
X  for (int i=0; i<size; i++)
X    store[start_loc+i]=store[op1.start_loc+i];
X  
X  if (trace_flag) write_intvec_assign_av(size,start_loc,op1.start_loc);
X    
X}
X
Xadoublev::adoublev(const adubv& a)
X{
X  start_loc = next_loc(a.sz());
X  for (int i=0; i<a.sz(); i++)
X    store[start_loc+i]=store[a.loc()+i];
X  if (trace_flag) write_intvec_assign_av(a.sz(),start_loc,a.loc());
X}
X
X
Xadoublev& adoublev::operator = (double* y) 
X{
X  if (trace_flag) write_assign_vec_dv(size,start_loc,y);
X
X  for (int i=0; i<size; i++)
X    store[start_loc+i]=y[i];
X  
X  return *this;
X}
X
X
Xadoublev& adoublev::operator = (double y)
X{
X#ifdef DEBUG
X  printf("ADOL-C debug:In adoublev=double\n");
X#endif
X
X
X  for (int i=0; i<size; i++)
X      store[start_loc+i]=y;
X
X  if (trace_flag)
X    write_assign_vec_dv(size,start_loc,store+start_loc);
X  return *this;
X}
X
X
X
Xadoublev& adoublev::operator = (const badoublev& x) 
X{  
X  if (trace_flag) write_assign_av(size,start_loc,x.loc());
X  for (int i=0; i<size; i++)
X    store[start_loc+i]=store[x.loc()+i];
X  return *this;
X}
X
Xadoublev& adoublev::operator = (const adoublev& x) 
X{  
X  if (trace_flag) write_assign_av(size,start_loc,x.start_loc);
X  for (int i=0; i<size; i++)
X    store[start_loc+i]=store[x.start_loc+i];
X  return *this;
X}
X
Xadoublev& adoublev::operator = (const adubv& a)
X{
X  if (trace_flag) write_assign_av(size,start_loc,a.loc());
X  for (int i=0; i<size; i++)
X    store[start_loc+i]=store[a.loc()+i];
X  return *this;
X}
X
X#ifdef overwrite
X adoublev::~adoublev()
X{
X#ifdef DEBUG
X  printf("ADOL-C debug:Destructing active vector\n");
X#endif
X 
X  free_loc(start_loc,size);
X}
X
Xadubv::~adubv()
X{
X  free_loc(start_loc,size);
X}
X
Xadoublem::~adoublem()
X{
X#ifdef DEBUG
X  printf("ADOL-C debug:Destructing active matrix\n");
X#endif
X  delete[] index;
X}
X#endif
X
Xostream& operator << (ostream& out,const badoublev &op1)
X{
X  out << "(";
X
X  for (int i=0; i<op1.size-1; i++)
X    out << store[op1.start_loc+i] << ", ";
X
X  out << store[(op1.start_loc+op1.size)-1] << ")(a)";
X
X  return out;
X}  
X
X
Xbadouble badoublev::operator[](int i) const  
X{
X  /* Used so can access the vector like an array with the [] */
X  /* Check if out of range */
X  if (i<0 || i>=size)
X    {
X      printf ("ADOL-C error: adoublev index out of range.\n");
X      exit(-3);
X    }
X
X  return start_loc+i;
X}
X
Xbadoublev& badoublev::operator=(const badoublev &op1)
X{
X#ifdef DEBUG
X  printf("ADOL-C debug:In badoublev = badoublev\n");
X#endif
X
X  if (trace_flag)
X    write_assign_av(size,start_loc,op1.start_loc);
X  
X  for (int i=0; i<op1.size; i++)
X    store[start_loc+i]=store[op1.start_loc+i];
X  
X  return *this;
X}
X
Xbadoublev& badoublev::operator= (const adubv &op1)
X{
X  if (trace_flag)
X    write_assign_av(size,start_loc,op1.start_loc);
X  
X  for (int i=0; i<op1.size; i++)
X    store[start_loc+i]=store[op1.start_loc+i];
X
X  return *this;
X}
X
Xbadoublev& badoublev::operator = (const adoublev& x) 
X{  
X  if (trace_flag) write_assign_av(size,start_loc,x.start_loc);
X
X  for (int i=0; i<size; i++)
X    store[start_loc+i]=store[x.start_loc+i];
X  
X  return *this;
X}   
X
X
X
X/*
XDefine what it means to assign an adouble vector an independent float vector.
X*/
Xadoublev& adoublev::operator <<= (double* y) 
X{
X#ifdef DEBUG
X  printf("ADOL-C debug:IND EQ double*\n");
X#endif
X
X  if (trace_flag) write_assign_indvec(size,start_loc,y);
X  for (int i=0; i<size; i++)
X    store[(start_loc)+i]=y[i];
X  return *this;
X}   
X
X/*
X  Define what it means to assign a float vector a dependent adouble vector.
X*/
Xadoublev& adoublev::operator >>= (double* y) 
X{  
X#ifdef DEBUG
X  printf("ADOL-C debug:DEP EQ double* operator\n");
X#endif
X
X  if (trace_flag) write_assign_depvec(size,start_loc);
X  for (int i=0; i<size; i++)
X    y[i] = double (store[(start_loc)+i]);
X  return *this;
X}   
X
X/* New operators here */
X
X
X
X
Xbadoublev& badoublev::operator -= (const badoublev& y) 
X{ 
X  if (trace_flag)
X    write_av_same_arg(eq_min_av,size,start_loc,y.start_loc);
X  
X  for (int i=0; i<size; i++)
X    store[start_loc+i]-=store[y.start_loc+i];
X  
X  return *this;
X}
X
X
X
Xbadoublev& badoublev::operator += (const badoublev& y) 
X{ 
X  if (trace_flag)
X    write_av_same_arg(eq_plus_av,size,start_loc,y.start_loc);
X  
X  for (int i=0; i<size; i++)
X    store[start_loc+i]+=store[y.start_loc+i];
X  
X  return *this;
X}
X
Xbadoublev& badoublev::operator *= (double y) 
X{
X  if (trace_flag)
X    write_samearg_av_d(eq_mult_av_d,size,start_loc,y);
X
X  for (int i=0; i<size; i++)
X    store[start_loc+i]*=y;
X
X  return *this;
X}
X
Xbadoublev& badoublev::operator *= (const badouble& y) 
X{
X  int loc1,i;
X  loc1 = y.loc();
X
X  if (trace_flag)
X    write_av_same_arg(eq_mult_av_a,size,start_loc,loc1);
X  for (i=0; i<size; i++)
X    store[start_loc+i]*=store[loc1];
X  return *this;
X}
X
Xbadoublev& badoublev::operator/=(double y) 
X{  
X  *this = *this/y;
X  return *this;
X}
X
Xbadoublev& badoublev::operator/=(const badouble& y) 
X{ 
X *this = *this*(1.0/y);
X  return *this;
X}
X
Xadubv operator+(const badoublev &op1,const badoublev &op2)
X{
X  int i;
X  locint size;
X  locint start_loc;
X  if (op1.size!=op2.size)
X    {
X      printf("ADOL-C error: Can not add vectors as not same size\n");
X      exit(-3);
X    }
X  else
X    {
X      size=op1.size;
X      start_loc=next_loc(size);
X      for (i=0; i<size; i++)
X	store[start_loc+i]=store[op1.start_loc+i]+store[op2.start_loc+i];
X      
X      if (trace_flag) write_two_av_rec(plus_av_av,size,start_loc,
X				       op1.start_loc,op2.start_loc);
X      
X    }
X  return adubv(start_loc,size);
X}
X
X
X
Xadubv operator*(const badoublev &op1, double n)
X{
X  int i;
X  locint size=op1.size;
X  locint start_loc=next_loc(size);
X
X  for (i=0; i<size; i++)
X    store[start_loc+i]=store[op1.start_loc+i]*n;
X  
X  if (trace_flag) write_args_d_av(mult_d_av,size,start_loc,n,op1.start_loc);
X
X  return adubv(start_loc,size);
X}
X
Xadubv operator*(double n, const badoublev &op1)
X{
X  int i;
X  locint size=op1.size;
X  locint start_loc=next_loc(size);
X
X  for (i=0; i<size; i++)
X    store[start_loc+i]=store[op1.start_loc+i]*n;
X  
X  if (trace_flag)
X    write_args_d_av(mult_d_av,size,start_loc,n,op1.start_loc);
X    
X  return adubv(start_loc,size);
X}
X
Xadub operator*(const badoublev &op1,const badoublev &op2)
X{
X  int i;
X  double x=0;
X  locint locat=next_loc();
X  
X  if (op1.size!=op2.size)
X    {
X      printf("ADOL-C error: Can not take dot product, vectors are not same size\n");
X      exit(-3);
X    }
X  else
X    {
X      for (i=0; i<op1.size; i++)
X	x+=store[op1.start_loc+i]*store[op2.start_loc+i];
X      
X      store[locat]=x;
X      
X      if (trace_flag)
X	write_two_av_rec(dot_av_av,op1.size,locat,
X			 op1.start_loc,op2.start_loc);
X      
X    }
X  return locat;
X}
X
Xadubv operator / (const badoublev &x, const badouble &y)
X{
X  int i;
X  int loc1 = y.loc();
X  int size=x.size;
X  locint start_loc=next_loc(size);
X
X  for (i=0; i<size; i++)
X    store[start_loc+i]=store[x.start_loc+i]*(1.0/store[loc1]);
X
X  if (trace_flag)
X    write_av_a_rec(div_av_a,size,start_loc,x.start_loc,loc1);
X  
X  return adubv(start_loc,size);
X}
X
Xadubv operator-(const badoublev &op1,const badoublev &op2)
X{
X  int i;
X  locint size;
X  locint start_loc;
X  if (op1.size!=op2.size)
X    {
X      printf("ADOL-C error: Can not add vectors as not same size\n");
X      exit(-3);
X    }
X  else
X    {
X      size=op1.size;
X      start_loc=next_loc(size);
X      for (i=0; i<size; i++)
X	store[start_loc+i]=store[op1.start_loc+i]-store[op2.start_loc+i];
X      
X      if (trace_flag) write_two_av_rec(sub_av_av,size,start_loc,
X				       op1.start_loc,op2.start_loc);
X      
X    }
X  return adubv(start_loc,size);
X}
X
X
X
X
X  
Xadubv operator*(const badoublev &op1, const badouble &n)
X{
X  int loc1 = n.loc();
X  int size=op1.size;
X  locint start_loc=next_loc(size);
X  int i;
X
X  for (i=0; i<size; i++)
X    store[start_loc+i]=store[op1.start_loc+i]*store[loc1];
X
X  if (trace_flag) write_av_a_rec(mult_av_a,size,start_loc,op1.start_loc,loc1);
X    
X  return adubv(start_loc,size);
X}
X
Xadubv operator*(const badouble &n, const badoublev &op1)
X{
X  int loc1 = n.loc();
X  int size=op1.size;
X  locint start_loc=next_loc(size);
X  int i;
X
X  for (i=0; i<size; i++)
X    store[start_loc+i]=store[loc1]*store[op1.start_loc+i];
X
X  if (trace_flag)
X    write_av_a_rec(mult_a_av,size,start_loc,op1.start_loc,loc1);
X
X  return adubv(start_loc,size);
X}
X
X/* Active matrix section */
Xadoublem::adoublem(int row, int col)
X{
X  m=row;
X  n=col;
X  index = new adoublev[m];
X  for (int i=0; i<m; i++)
X  {
X    index[i].size=n;
X    index[i].start_loc=next_loc(n);
X  }
X}
X
Xadoublev& adoublem::operator[](int i) 
X{
X  if (i<0 || i>=m)
X    {
X      printf ("ADOL-C error: adoublem index out of range.\n");
X      exit(-3);
X    }
X  return (index[i]);
X}
X
X
X
X#ifdef conditional
Xasub badoublev::operator[](const along &i)  const
X{
X#ifdef DEBUG
X  printf("ADOL-C debug:In along overloaded []\n");
X#endif
X  
X  /* Used so can access the vector like an array with the [] */
X  /* Check if out of range */
X  if ((i<0) || (i>=size))
X    printf ("ADOL-C warning:: adoublev index out of range.\n");
X
X  return asub(start_loc,i.loc());
X}
X
X
X
X/* asubv operations <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< */
X
X#ifdef overwrite
Xasubv::~asubv()
X{
X#ifdef DEBUG
X  printf("ADOL-C debug:Destructing active subscript vector\n");
X#endif
X
X  free_loc(start_loc,size);
X
X};
X#endif
X
X
Xasubv::asubv(adoublev* start, locint index)
X{
X#ifdef DEBUG
X  printf("ADOL-C debug: Constructing an asubv with 3 arguments\n");
X#endif
X  begin=(start[0]).loc(); /* start of matrix */
X  base=(start[(int)store[index]]).loc(); /* start of the i-th row */
X  offset=index;
X  size=(start[(int)store[index]]).sz(); /* size of the row-vector */
X  start_loc=next_loc(size);
X  for(int i=0;i<size;i++)
X    store[start_loc+i]=store[base+i];
X  if (trace_flag)
X    write_associating_vector(m_subscript,start_loc,begin,offset,size);
X}
X
X
Xasubv adoublem::operator[](const along &i)
X{
X#ifdef DEBUG
X  printf("ADOL-C debug: In along overloaded []\n");
X#endif
X  /* Used so can access the vector like an array with the [] */
X  /* Check if out of range */
X  if (i<0 || i>=n)
X    printf ("ADOL-C warning:: adoublem index out of range.\n");
X  return asubv(index,i.loc());
X}
X
X
Xasubv& asubv::operator = (const adubv& a)
X{
X  if (trace_flag)
X    write_associating_vector(m_subscript_l,a.loc(),begin,offset,size);
X  for(int i=0;i<size;i++)
X    store[base+i]=store[a.loc()+i] ;
X  return *this;
X}
X
Xasubv& asubv::operator = (const badoublev& x)
X{ 
X  if (trace_flag)
X    write_associating_vector(m_subscript_l,x.loc(),begin,offset,size);
X  for(int i=0;i<size;i++)
X    store[base+i]=store[x.loc()+i];
X  return *this;
X}  
X
Xasubv& asubv::operator <<= (double* y)
X{
X  if (trace_flag)
X    {
X      write_assign_indvec(size,start_loc,y);
X      write_associating_vector(m_subscript_l,start_loc,begin,offset,size);
X    }
X  for(int i=0;i<size;i++)
X    store[base+i]=y[i];
X  return *this;
X}
X
Xasubv& asubv::operator = (double* x)
X{
X  if (trace_flag)
X    write_associating_vector_ld(x,begin,offset,size);
X  for(int i=0;i<size;i++)
X    store[base+i]=x[i];
X  return *this;
X}
X
X
X
X#endif
X
X
X
X
Xadubv operator+ (const badoublev& x)
X{
X  return x*(1.0);
X}
X  
Xadubv operator- (const badoublev& x)
X{
X  return x*(-1.0);
X}
END_OF_FILE
if test 12337 -ne `wc -c <'avector.c'`; then
    echo shar: \"'avector.c'\" unpacked with wrong size!
fi
chmod +x 'avector.c'
# end of 'avector.c'
fi
if test -f 'avector.h' -a "${1}" != "-c" ; then 
  echo shar: Will not clobber existing file \"'avector.h'\"
else
echo shar: Extracting \"'avector.h'\" \(9496 characters\)
sed "s/^X//" >'avector.h' <<'END_OF_FILE'
X/* 
X  --------------------------------------------------------------------
X  file avector.h of ADOL-C version 1.6 as of January 1,   1995 
X  Included in
X              adouble.h, and hence ---->
X	                                 adouble.c
X					 avector.c
X					 All ADOL-C applications.
X  --------------------------------------------------------------------
X
X  Avector.h defines classes of vectors and matrices.
X
X  badoublev  --> class of basic active vectors. 
X  adubv      --> class of temporary active vectors.
X                 (derived from badoublev.  Contains copy constructors, 
X                  destructors.)
X  adoublev   --> class of active vectors. (derived from badoublev,
X                 contains the standard constructors and destructors.
X		 
X*/
X
X/* ----- Forward declaration ----- */
Xclass badoublev;
Xclass adoublev;  
Xclass adubv;
X/* removed 1/95 
Xclass doublev;
X*/
Xclass err_retu;
Xclass asubv;
X
X
Xclass err_retu
X{
Xchar* message;
Xpublic:
Xerr_retu(char* x){printf("%s \n",x);};
X};
X
X
X/* ----- DECLARATION OF VECTOR CLASSES ----- */     
X/* Passive vectors and matrices */
X
X
X/* REMOVED 1/95  */
X
X
X/* ----- End of passive section ----- */
X
Xclass badoublev
X{
X protected:
X  locint start_loc;  /* Starting location of vector in store */
X  int size;          /* Size of the vector */
X  badoublev(){};
X  badoublev(int lo, int sz){start_loc = lo; size=sz;};
X  badoublev(const badoublev& a){start_loc = a.start_loc; size=a.size;};
X  
X public:
X
X  /* Access functions */
X  int sz() const {return size;}  /* Get the size of the vector */
X  int loc() const {return start_loc;}  /* Get the size of the vector */
X
X#ifdef conditional
X  asub operator[](const along&) const;
X#endif
X
X
X/* excluded before 1/95 
X  badoublev& operator >>= (doublev& );
X  badoublev& operator <<= (doublev& );
X  badoublev& operator >>= (double* );
X  badoublev& operator <<= (double* );
X*/
X
X  badouble operator[](int) const;  /* Can access component like an array */
X
X  badoublev& operator+=(const badoublev&);
X  badoublev& operator-=(const badoublev&);
X  badoublev& operator*=(double);
X  badoublev& operator/=(double);
X/* removed 1/95
X  badoublev& operator-=(const doublev&);
X  badoublev& operator+=(const doublev&);
X*/
X  badoublev& operator-=(double*);
X  badoublev& operator+=(double*);
X  badoublev& operator*=(const badouble& );
X  badoublev& operator/=(const badouble& );
X  friend adubv operator/(const badoublev &op1, const badouble &n);
X  inline friend adubv operator/(const badoublev &op1, double n);
X/*  removed 1/95
X  badoublev& operator= (const doublev&);
X*/
X  badoublev& operator= (const badoublev&);
X  badoublev& operator= (const adubv &y);
X  badoublev& operator= (const adoublev &y);
X
X  friend ostream& operator << (ostream&, const badoublev&);
X
X  friend adubv operator+ (const badoublev &x);
X  friend adubv operator- (const badoublev &x);
X  
X  /* overload operations */
X  friend adubv operator+(const badoublev &op1,const badoublev &op2);
X  friend adubv operator-(const badoublev &op1,const badoublev &op2);
X  friend adubv operator*(const badoublev &op1, double n);
X  friend adubv operator*(double n, const badoublev &op1);
X  friend adub operator*(const badoublev &op1, const badoublev &op2);
X
X  /* overloaded for interaction of constant and active vectors */
X/* removed 1/95
X  friend adubv operator+(const badoublev &op1, const doublev &op2);
X  friend adubv operator+(const doublev &op1, const badoublev &op2);
X*/
X  friend adubv operator+(const badoublev &op1, double* op2);
X  friend adubv operator+(double* op2, const badoublev &op1);
X/* removed 1/95
X  friend adubv operator-(const badoublev &op1, const doublev &op2);
X  friend adubv operator-(const doublev &op1, const badoublev &op2);
X*/
X  friend adubv operator-(const badoublev &op1, double* op2);
X  friend adubv operator-(double* op1, const badoublev &op2);
X/* removed 1/95
X  friend adub operator*(const badoublev &op1, const doublev &op2);
X  friend adub operator*(const doublev &op1, const badoublev &op2);
X*/
X  friend adub operator*(const badoublev &op1, double* op2);
X  friend adub operator*(double* op1, const badoublev &op2);
X  
X  /* overloaded for interaction of active scalars and active vectors */
X/* removed 1/95
X  friend adubv operator/(const doublev &op1, const badouble &n);
X*/
X  friend adubv operator*(const badoublev &op1, const badouble &n);
X  friend adubv operator*(const badouble &n, const badoublev &op1);
X  /* excluded operations */
X  err_retu operator>>=(double) {return("ADOL-C error: illegal argument combination for operator >>=\n"); };
X  err_retu operator<<=(double) {return("ADOL-C error: illegal argument combination for operator <<=\n"); };
X  err_retu operator+= (double) {return("ADOL-C error: illegal argument combination for operator +=\n"); };
X  err_retu operator-= (double) {return("ADOL-C error: illegal argument combination for operator -=\n"); };
X  inline friend err_retu operator+(const badoublev,double) {return("ADOL-C error: illegal argument combination for operator +\n"); };
X  inline friend err_retu operator-(const badoublev,double) {return("ADOL-C error: illegal argument combination for operator -\n"); };
X  inline friend err_retu operator+(double,const badoublev) {return("ADOL-C error: illegal argument combination for operator +\n"); };
X  inline friend err_retu operator-(double,const badoublev) {return("ADOL-C error: illegal argument combination for operator -\n"); };
X};
X
Xclass adubv:public badoublev{
X  adubv(int lo,int sz){start_loc=lo;size=sz;};
X/* removed 1/95
X  adubv(doublev&);
X*/
X  adubv():badoublev(0,0){
X      cout << "ADOL-C error: illegal default construction of adub variable\n" ;
X      exit(-2);
X         };
X
X public:    
X/* removed 1/95
X  friend adub operator*(const badoublev &op1, const doublev &op2);
X  friend adub operator*(const doublev &op1, const badoublev &op2);
X*/
X  friend adub operator*(const badoublev &op1, double* op2);
X  friend adub operator*(double* op1, const badoublev &op2);
X  friend adub operator*(const badoublev &op1, const badoublev &op2);
X  /* excluded because g++ warnings
X  friend adub operator*(const badoublev &op1, const doublev &op2);
X  friend adub operator*(const doublev &op1, const badoublev &op2);
X  */
X/* removed 1/95
X  friend adubv operator+(const badoublev &op1, const doublev &op2);
X  friend adubv operator+(const doublev &op1, const badoublev &op2);
X  friend adubv operator-(const badoublev &op1, const doublev &op2);
X  friend adubv operator-(const doublev &op1, const badoublev &op2);
X  friend adubv operator/(const doublev &op1, const badouble &n);
X  friend adubv operator*(const doublev &op1, const badouble &n);
X  friend adubv operator*(const badouble &n, const doublev &op1);
X*/
X  friend adubv operator/(const badoublev &op1, const badouble &n);
X  inline friend adubv operator/(const badoublev &op1, double n);
X  friend adubv operator+ (const badoublev &x);
X  friend adubv operator- (const badoublev &x);
X  friend adubv operator+(const badoublev &op1,const badoublev &op2);
X  friend adubv operator-(const badoublev &op1,const badoublev &op2);
X  friend adubv operator*(const badoublev &op1, double n);
X  friend adubv operator*(double n, const badoublev &op1);
X  /* excluded because g++ warnings
X  friend adubv operator+(const badoublev &op1, const doublev &op2);
X  friend adubv operator+(const doublev &op1, const badoublev &op2);
X  */
X  friend adubv operator+(const badoublev &op1, double* op2);
X  friend adubv operator+(double* op2, const badoublev &op1);
X  /* excluded because g++ warnings
X  friend adubv operator-(const badoublev &op1, const doublev &op2);
X  friend adubv operator-(const doublev &op1, const badoublev &op2);
X  */
X  friend adubv operator-(const badoublev &op1, double* op2);
X  friend adubv operator-(double* op1, const badoublev &op2);
X  /* excluded because g++ warnings
X  friend adubv operator/(const doublev &op1, const badouble &n);
X  */
X  friend adubv operator*(const badoublev &op1, const badouble &n);
X  friend adubv operator*(const badouble &n, const badoublev &op1);
X#ifdef overwrite
X  ~adubv();
X#endif
X};
X
Xclass adoublev:public badoublev
X{
X  friend class adoublem;
X  adoublev(){};
X public:
X  adoublev(const adubv& a);
X  adoublev(const adoublev&);
X  adoublev(int sz);
X//  adoublev(int n, double *values);
X/* removed 1/95
X  adoublev(doublev&);
X*/
X#ifdef overwrite
X  ~adoublev();
X#endif
X/* removed 1/95
X  adoublev& operator= (const doublev &y);
X*/
X  adoublev& operator= (const badoublev&);
X  adoublev& operator= (const adoublev&);
X  adoublev& operator= (const adubv&);
X  adoublev& operator= (double y);
X  adoublev& operator= (double* y);
X/* removed 1/95
X  adoublev& operator >>= (doublev& );
X  adoublev& operator <<= (doublev& );
X*/
X  adoublev& operator >>= (double* );
X  adoublev& operator <<= (double* );
X};
X
X
Xinline adubv operator / (const badoublev& x, double y){return (1.0/y)*x;}
X
X
X/* Active matrix class */
Xclass adoublem
X{
X  int n, m;          /* Size of the matrix */
X  adoublev *index;     /* So each row is an adoublev */
X public:
X  adoublem(int n, int m);
X  ~adoublem();
X  adoublev& operator[](int i);  /* Can access component like an array */
X#ifdef conditional
X   asubv operator[](const along&);
X#endif
X};
X
X#ifdef conditional
Xclass asubv:public badoublev
X{
X  locint base,offset,begin;
X  public:
X  asubv(adoublev* start, locint index);
X#ifdef overwrite
X    ~asubv();
X#endif
X/* removed 1/95
X  asubv& operator <<= (doublev&);
X  asubv& operator = (doublev);
X*/
X  asubv& operator <<= (double*);
X  asubv& operator = (double*);
X  asubv& operator = (const adubv&);
X  asubv& operator = (const badoublev&);
X };
X#endif
X
X
END_OF_FILE
if test 9496 -ne `wc -c <'avector.h'`; then
    echo shar: \"'avector.h'\" unpacked with wrong size!
fi
chmod +x 'avector.h'
# end of 'avector.h'
fi
if test -f 'drivers.c' -a "${1}" != "-c" ; then 
  echo shar: Will not clobber existing file \"'drivers.c'\"
else
echo shar: Extracting \"'drivers.c'\" \(7215 characters\)
sed "s/^X//" >'drivers.c' <<'END_OF_FILE'
X/*
X  ------------------------------------------------------------------------
X  file drivers.c of ADOL-C version 1.6 as of January 1,   1995  
X  ------------------------------------------------------------------------
X  This file contains definitions for the functions prototyped in
X  adutils.h.  Each function is an ADOL-C C++ utility.
X*/
X
X
X#include "adutils.h"   /* Prototypes */
X#include "dvlparms.h"  /* Developers Parameters */
X
X
X#define fabs(x) ((x) > 0 ? (x) : -(x))
X#define ceil(x) ((int)((x)+1) - (int)((x) == (int)(x)))
X
X
Xdouble** myalloc(int m,int n)
X{
X  
X  /* This function allocates row matrices contiguously  */
X  
X  return myalloc2(m,n);
X  
X  /* To deallocate an array set up by   A = myalloc(m,n)  */
X  
X  /*  use  free((char*)*A); free((char*)A); in that order */
X  
X}
X
Xdouble*** myalloc(int m,int n,int p)
X{
X  
X  /* This function allocates 3-tensors contiguously */
X  
X  return  myalloc3(m,n,p);
X  
X  /* To deallocate an array set up by  A = myalloc(m,n,p)     */
X
X  /* use free((char*)**A); free((char*)*A); free((char*)A) ;  */
X  
X}
X
Xvoid forward(short tag,
X             int depen,
X             int indep,
X             int degre,
X             int keep,
X             double** X,
X             double** Y)
X{
X  hos_forward(tag,depen,indep,degre,keep,X,Y);
X}
X
Xvoid forward(short tag,
X	     int depen,
X	     int indep,
X	     int degre,
X	     int keep,
X	     double** X,
X	     double* Y)
X{
X  if(depen==1) 
X    hos_forward(tag,depen,indep,degre,keep,X,&Y);
X  else 
X    {
X      printf("ADOL-C error: wrong Y dimension in forward \n");
X      exit(-1);
X    }
X}
X
Xvoid forward(short tag,
X	     int depen,
X	     int indep,
X	     int degre,
X	     int keep,
X	     double* X,
X	     double* Y)
X{
X  static double **Xl, **Yl;
X  static int indax, depax;
X  if(degre != 0)
X    {
X      printf("ADOL-C error:  wrong X and Y dimensions in forward \n");
X      exit(-1);
X    }
X  else
X    {
X      if (indep compsize indax || depen compsize depax)
X	{
X	  if(indax)
X	    {
X	      free((char*)*Xl);
X	      free((char*)Xl);
X	      free((char*)*Yl);
X	      free((char*)Yl);
X	    }
X	  Xl = myalloc(indep,1);
X	  Yl = myalloc(depen,1);
X	  indax = indep;
X	  depax = depen;
X	}
X    }
X  for(int i=0; i<indep; i++)
X    *Xl[i] = X[i];
X  hos_forward(tag,depen,indep,degre,keep,Xl,Yl);
X  for(i=0; i<depen; i++)
X    Y[i] = *Yl[i];
X}
X
Xvoid forward(short tag,
X             int depen,
X             int indep,
X             int degre,
X             int taylnum,
X             double* base,
X             double*** X,
X             double* value,
X             double*** Y)
X{
X  hov_forward(tag,depen,indep,degre,taylnum,base,X,value,Y);
X}
X
Xvoid forward(short tag,
X             int depen,
X             int indep,
X             int taylnum,
X             double* base,
X             double** X,
X             double* value,
X             double** Y)
X{
X  fov_forward(tag,depen,indep,taylnum,base,X,value,Y);
X}
X
X
Xvoid reverse(short tag, 
X             int depen,
X	     int indep,
X	     int degre,
X	     double* u,
X	     double** Z)
X{
X  hos_reverse(tag,depen,indep,degre,u,Z);
X}
X
Xvoid reverse(short tag, 
X             int depen,
X	     int indep,
X	     int degre,
X	     double u,
X	     double** Z)
X{
X  if(depen != 1) 
X    {
X      printf("ADOL-C error:  wrong u dimension in scalar-reverse \n");
X      exit(-1);
X    }
X  else
X    {
X      hos_reverse(tag,depen,indep,degre,&u,Z);
X    }
X}
X
Xvoid reverse(short tag, 
X             int depen,
X	     int indep,
X	     int degre,
X	     double* u,
X	     double* Z)
X{
X  if(degre != 1) 
X    {
X      printf("ADOL-C error:  wrong Z dimension in scalar-reverse \n");
X      exit(-1);
X    }
X  fos_reverse(tag,depen,indep,u,Z);
X}
X
Xvoid reverse(short tag, 
X             int depen,
X	     int indep,
X	     int degre,
X	     double u,
X	     double* Z)
X{
X  if(depen != 1 || degre !=0 ) 
X    {
X      printf("ADOL-C error:  wrong u or Z dimension in scalar-reverse \n");
X      exit(-1);
X    }
X  else
X    fos_reverse(tag,depen,indep,&u,Z);
X}
X
Xvoid reverse(short tag, 
X             int depen,
X	     int indep,
X	     int degre,
X	     int nrows,
X	     double** U,
X	     double*** Z,
X	     short** nz)
X{
X  hov_reverse(tag,depen,indep,degre,nrows,U,Z,nz);
X}
X
Xvoid reverse(short tag, 
X             int depen,
X	     int indep,
X	     int degre,
X	     int nrows,
X	     double* U,
X	     double*** Z,
X	     short** nz)
X{
X  if(depen != 1 ) 
X    {
X      printf("ADOL-C error:  wrong U dimension in vector-reverse \n");
X      exit(-1);
X    }
X  else
X    hov_reverse(tag,depen,indep,degre,nrows,&U,Z,nz);
X}
X
Xvoid reverse(short tag, 
X             int depen,
X	     int indep,
X	     int degre,
X	     int nrows,
X	     double** U,
X	     double** Z)
X{
X  if(degre != 0) 
X    {
X      printf("ADOL-C error:  wrong degree in vector-reverse \n");
X      exit(-1);
X    }
X  else
X    fov_reverse(tag,depen,indep,nrows,U,Z);
X}
X
Xvoid reverse(short tag, 
X             int depen,
X	     int indep,
X	     int degre,
X	     int nrows,
X	     double* U,
X	     double** Z)
X{
X  if(depen != 1) 
X    {
X      printf("ADOL-C error:  wrong U dimension in vector-reverse \n");
X      exit(-1);
X    }
X  else
X    fov_reverse(tag,depen,indep,nrows,&U,Z);
X}
X
Xvoid reverse(short tag, 
X             int depen,
X	     int indep,
X	     int degre,
X	     double*** Z,
X	     short** nz)
X{
X  static int depax;
X  static double** I;
X  if(depen compsize depax)
X    {
X      if(depax) 
X	{
X	  free((char*)*I); free((char*)I);
X	}
X      I = myalloc(depen,depen);
X      for (int i=0;i<depen;i++)
X	{
X	  for (int j=0;j<depen;j++)
X	    I[i][j] = 0;
X	  I[i][i] =1;
X	}
X      depax = depen;
X    }
X  hov_reverse(tag,depen,indep,degre,depen,I,Z,nz);
X}
X
Xvoid forode(short tag,             // tape identifier
X            int n,                 // space dimension
X            double tau,            // scaling defaults to 1.0
X            int dol,               // previous degree defaults to zero
X            int deg,               // New degree of consistency
X            double** y)            // Taylor series
X{
X  forodec(tag,n,tau,dol,deg,y);
X}
X
X
Xvoid forode(short tag, int n, double tau, int deg, double** y)
X{
X  /***   Default for previous degree is zero, do things from scratch ***/
X  int zero = 0;
X  forodec(tag, n, tau, zero, deg, y);
X}
X
Xvoid forode(short tag, int n, int dol, int deg, double** y)
X{
X  /***   Default for scaling is 1.0       *****/
X  double tau = 1.0;
X  forodec(tag, n, tau, dol, deg, y);
X}
X
Xvoid forode(short tag, int n, int deg, double** y)
X{
X  /***    Combination of both previous defaults   ******/
X  double tau = 1.0;
X  forode(tag, n, tau, deg, y);
X}
X
Xvoid accode(int n,             // space dimension
X            double tau,        // scaling defaults to 1.0
X            int deg,           // highest degree
X	    double*** A,       // input tensor of "partial" Jacobians
X            double*** B,       // output tensor of "total" Jacobians
X	    short** nonzero )  // optional sparsity characterization 
X{
X  accodec(n,tau,deg,A,B,nonzero);
X}
X
Xvoid accode(int n,             // space dimension
X            int deg,           // highest degree
X	    double*** A,       // input tensor of "partial" Jacobians
X            double*** B,       // output tensor of "total" Jacobians
X	    short** nonzero )  // optional sparsity characterization 
X{
X  double tau = 1.0;
X  accodec(n,tau,deg,A,B,nonzero);
X}
X
END_OF_FILE
if test 7215 -ne `wc -c <'drivers.c'`; then
    echo shar: \"'drivers.c'\" unpacked with wrong size!
fi
chmod +x 'drivers.c'
# end of 'drivers.c'
fi
if test -f 'driversc.c' -a "${1}" != "-c" ; then 
  echo shar: Will not clobber existing file \"'driversc.c'\"
else
echo shar: Extracting \"'driversc.c'\" \(21466 characters\)
sed "s/^X//" >'driversc.c' <<'END_OF_FILE'
X/*
X  ------------------------------------------------------------------------
X  file driversc.c of ADOL-C version 1.6 as of January 1,   1995  
X  ------------------------------------------------------------------------
X  This file contains definitions for the functions prototyped in
X  adutilsc.h.  Each function is an ADOL-C straight C utility.
X*/
X
X/*--------------------------------------------------*/
X/* Included timing data for myclock                 */
X/*--------------------------------------------------*/
X
X
X#ifdef __STDC__
X#include <time.h>
X
Xdouble myclock(void)
X{ return (double)clock() / CLOCKS_PER_SEC; }
X
X#else
X#include <sys/types.h>
X#include <sys/times.h>
X
X#ifndef HZ	/* clock ticks per second */
X#define HZ 60.
X#endif
X
Xdouble myclock() {
X  struct tms t;
X  times(&t);
X  return t.tms_utime / HZ;
X} /* end myclock */
X#endif
X
X
X#ifdef __cplusplus
Xextern "C" {
X#endif
X
X#include "dvlparms.h" /* Developers Parameters */
X#include "adutilsc.h" /* Function Prototypes   */
X
X
X
Xdouble* myalloc1(int m)
X{
X  double* A = (double*)malloc(m*sizeof(double));
X  return A;
X}
X
Xdouble** myalloc2(int m,int n)
X{
X  double* Adum = (double*)malloc(m*n*sizeof(double));
X  double**  A = (double**)malloc(m*sizeof(double*));
X  int i;
X  for(i=0;i<m;i++)
X    {
X      A[i] = Adum;
X      Adum += n;
X    }
X  return A;
X
X  /* To deallocate an array set up by   A = myalloc2(m,n)   */
X  /*   use  free((char*)*A); free((char*)A); in that order  */
X
X }
X
Xdouble*** myalloc3(int m,int n,int p)
X{
X  /* This function allocates 3-tensors contiguously */ 
X  double* Adum = (double*) malloc(m*n*p*sizeof(double));
X  double**   Apt = (double**)malloc(m*n*sizeof(double*));
X  double***   A = (double***)malloc(m*sizeof(double**));
X  int i,j;
X  for(i=0;i<m;i++)
X    {
X      A[i] = Apt;
X      for(j=0;j<n;j++)
X	{
X	  *Apt++ =  Adum;
X	  Adum += p;
X	}
X    }   
X  return A;
X
X /* To deallocate an array set up by  A = myalloc3(m,n,p)  */
X
X  /* use free((char*)**A); free((char*)*A); free((char*)A); */
X
X }
X
Xstatic void spread1(int m,
X		    fdouble* x,
X		    double* X)
X{ 
X  int j;
X  for(j=0;j<m;j++)
X    X[j] = *x++;
X}
X
Xstatic void pack1(int m,
X		  double* X,
X		  fdouble* x)
X{ 
X  int j;
X  for(j=0;j<m;j++)
X      *x++ = X[j] ;
X}
X
Xstatic void spread2(int m,
X		    int n,
X		    fdouble* x,
X		    double** X)
X{ 
X  int i,j;
X  for(j=0;j<n;j++)
X    for(i=0;i<m;i++)
X      X[i][j] = *x++;
X}
X
Xstatic void pack2(int m,
X		  int n,
X		  double** X,
X		  fdouble* x)
X{ 
X  int i,j;
X  for(j=0;j<n;j++)
X    for(i=0;i<m;i++)
X      *x++ = X[i][j] ;
X}
X
Xstatic void spread3(int m,
X		    int n,
X		    int p,
X		    fdouble* x,
X		    double*** X)
X{ 
X  int i,j,k;
X  for(k=0;k<p;k++)
X    for(j=0;j<n;j++)
X      for(i=0;i<m;i++)
X	X[i][j][k] = *x++;
X}
X
Xstatic void pack3(int m,
X		  int n,
X		  int p,
X		  double*** X,
X		  fdouble* x)
X{
X  int i,j,k;
X  for(k=0;k<p;k++)
X    for(j=0;j<n;j++)
X      for(i=0;i<m;i++)
X	*x++ = X[i][j][k];
X}
X
Xfint hos_forward_(fint* ftag,
X		 fint* fm,
X		 fint* fn,
X		 fint* fd,
X		 fint* fk,
X		 fdouble* fx,
X		 fdouble* fy)
X{
X  int tag=*ftag, m=*fm, n=*fn, d=*fd, k=*fk;
X  double** X = myalloc2(n,d+1);
X  double** Y = myalloc2(m,d+1);
X  spread2(n,d+1,fx,X);
X  hos_forward(tag,m,n,d,k,X,Y);
X  pack2(m,d+1,Y,fy);
X  free((char*)*X);free((char*)X);
X  free((char*)*Y);free((char*)Y);
X  return 1;
X}
X
Xfint hov_forward_(fint* ftag,
X                 fint* fm,
X                 fint* fn,
X                 fint* fd,
X                 fint* fp,
X                 fdouble* fbase,
X                 fdouble* fx,
X                 fdouble* fvalue,
X                 fdouble* fy)
X{
X  int tag=*ftag, m=*fm, n=*fn, d=*fd, p=*fp;
X  double* base = myalloc1(n);
X  double* value = myalloc1(m);
X  double*** X = myalloc3(n,p,d);
X  double*** Y = myalloc3(m,p,d);
X  spread1(n,fbase,base);
X  spread3(n,p,d,fx,X);
X  hov_forward(tag,m,n,d,p,base,X,value,Y);
X  pack3(m,p,d,Y,fy);
X  pack1(m,value,fvalue);
X  free((char*)**X); free((char*)*X); free((char*)X);
X  free((char*)**Y); free((char*)*Y); free((char*)Y);
X  free((char*)base); free((char*)value);
X  return 11;
X}
X
Xfint fov_forward_(fint* ftag,
X                 fint* fm,
X                 fint* fn,
X                 fint* fp,
X                 fdouble* fbase,
X                 fdouble* fx,
X                 fdouble* fvalue,
X                 fdouble* fy)
X{
X  int tag=*ftag, m=*fm, n=*fn, p=*fp;
X  double* base = myalloc1(n);
X  double* value = myalloc1(m);
X  double** X = myalloc2(n,p);
X  double** Y = myalloc2(m,p);
X  spread1(n,fbase,base);
X  spread2(n,p,fx,X);
X  fov_forward(tag,m,n,p,base,X,value,Y);
X  pack2(m,p,Y,fy);
X  pack1(m,value,fvalue);
X  free((char*)*X); free((char*)X);
X  free((char*)*Y); free((char*)Y);
X  free((char*)base); free((char*)value);
X  return 12;
X}
X
X  
X
Xfint hos_reverse_(fint* ftag,
X		 fint* fm,
X		 fint* fn,
X		 fint* fd,
X		 fdouble* fu,
X		 fdouble* fz)
X{
X  int tag=*ftag, m=*fm, n=*fn, d=*fd;
X  double** Z = myalloc2(n,d+1);
X  double* u = myalloc1(n);
X  spread1(n,fu,u);
X  hos_reverse(tag,m,n,d,u,Z);
X  pack2(n,d+1,Z,fz);
X  free((char*)*Z); free((char*)Z);
X  free((char*)u);
X  return 2;
X}
X
Xfint fos_reverse_(fint* ftag,
X		 fint* fm,
X		 fint* fn,
X		 fdouble* fu,
X		 fdouble* fz)
X{
X  int tag=*ftag, m=*fm, n=*fn;
X  double* u = myalloc1(n);
X  double* Z = myalloc1(n);
X  spread1(n,fu,u);
X  fos_reverse(tag,m,n,u,Z);
X  pack1(n,Z,fz);
X  free((char*)Z); free((char*)u);
X  return 3;
X}
X
Xfint hov_reverse_(fint* ftag,
X		 fint* fm,
X		 fint* fn,
X		 fint* fd,
X		 fint* fp,
X		 fdouble* fu,
X		 fdouble* fz)
X{
X  int tag=*ftag, m=*fm, n=*fn, d=*fd, p=*fp;
X  double** U = myalloc2(p,m);
X  double*** Z = myalloc3(p,n,d+1);
X  short ** nop = 0;
X  spread2(p,m,fu,U);
X  hov_reverse(tag,m,n,d,p,U,Z,nop);
X  pack3(p,n,d+1,Z,fz);
X  free((char*)**Z); free((char*)*Z); free((char*)Z);
X  free((char*)*U); free((char*)U);
X  return 4;
X}
X
Xfint fov_reverse_(fint* ftag,
X		 fint* fm,
X		 fint* fn,
X		 fint* fp,
X		 fdouble* fu,
X		 fdouble* fz)
X{
X  int tag=*ftag, m=*fm, n=*fn, p=*fp;
X  double** U = myalloc2(p,m);
X  double** Z = myalloc2(p,n);
X  spread2(p,m,fu,U);
X  fov_reverse(tag,m,n,p,U,Z);
X  pack2(p,n,Z,fz);
X  free((char*)*Z); free((char*)Z);
X  free((char*)*U); free((char*)U);
X  return 5;
X}
X
Xvoid lagra_hess_vec(short tag,
X		    int m,
X		    int n,
X		    double *argument,
X		    double *tangent,
X		    double *lagrange,
X		    double *result)
X{ 
X  int i;
X  int degree = 1;
X  int keep = degree+1;
X  static double **X, **Y;
X  static int maxn, maxm;
X  if(n > maxn || m > maxm)
X    {
X      if(maxn)
X	{
X	  free((char*)*X); free((char*)X);
X	  free((char*)*Y); free((char*)Y);
X	}
X      X = myalloc2(n,2);
X      Y = myalloc2(m,2);
X      maxn = n;
X      maxm = m;
X    } 
X  for(i=0;i<n;i++)
X    {
X      X[i][0] = argument[i];
X      X[i][1] = tangent[i];
X    }
X  hos_forward(tag,m,n,degree,keep,X,Y);
X  hos_reverse(tag,m,n,degree,lagrange,X);
X  for(i=0;i<n;i++)
X    result[i] = X[i][1];
X}
X
Xfint lagra_hess_vec_(fint* ftag,
X		    fint* fm,
X		    fint* fn,
X		    fdouble *fargument,
X		    fdouble *ftangent,
X		    fdouble *flagrange,
X		    fdouble *fresult)
X{
X  int tag=*ftag, m=*fm, n=*fn;
X  double *argument = myalloc1(n);
X  double *tangent = myalloc1(n);
X  double *lagrange = myalloc1(m);
X  double *result = myalloc1(n);
X  spread1(n,fargument,argument);
X  spread1(n,ftangent,tangent);
X  spread1(m,flagrange,lagrange);
X  lagra_hess_vec(tag,m,n,argument,tangent,lagrange,result);
X  pack1(n,result,fresult);
X  free((char*)argument); free((char*)tangent); free((char*)lagrange);
X  free((char*)result);
X  return 16;
X}
X
Xstatic double one = 1.0;
X
Xvoid hess_vec(short tag,
X	      int n,
X	      double *argument,
X	      double *tangent,
X	      double *result)
X{
X  lagra_hess_vec(tag,1,n,argument,tangent,&one,result);
X}
X
Xfint hess_vec_(fint* ftag,
X	      fint* fn,
X	      fdouble *fargument,
X	      fdouble *ftangent,
X	      fdouble *fresult)
X{ 
X  int tag=*ftag, n=*fn;
X  double *argument = myalloc1(n);
X  double *tangent = myalloc1(n);
X  double *result = myalloc1(n);
X  spread1(n,fargument,argument);
X  spread1(n,ftangent,tangent);
X  hess_vec(tag,n,argument,tangent,result);
X  pack1(n,result,fresult);
X  free((char*)argument); free((char*)tangent); free((char*)result);
X  return 15;
X}
X
Xvoid hessian(short tag,
X	     int n,
X	     double* argument,
X	     double** hess)
X{
X  int i,j;
X  double *v = (double*)malloc(sizeof(double)*n); 
X  double *w = (double*)malloc(sizeof(double)*n); 
X  for(i=0;i<n;i++)
X    v[i] = 0;
X  for(i=0;i<n;i++)
X    {
X      v[i] = 1;   
X      hess_vec(tag,n,argument,v,w);
X      for(j=0;j<=i;j++)
X	hess[i][j] = w[j];
X      v[i] = 0;
X    }
X
X  free((char *)v); 
X  free((char *) w); 
X  /* Note that only the lower triangle of hess is filled in */
X}
X
Xfint hessian_(fint* ftag,
X	     fint* fn,
X	     fdouble* fx,
X	     fdouble* fh) /* length of h should be n*n but the 
X                           upper half of this matrix remains unchanged */
X{
X  int tag=*ftag, n=*fn;
X  int i;
X  double** H = myalloc2(n,n);
X  double* x = myalloc1(n);
X  spread1(n,fx,x);
X  hessian(tag,n,x,H);
X  pack2(n,n,H,fh);
X  free((char*)*H); free((char*)H);
X  free((char*)x);
X  return 7;
X}
X
Xvoid jacobian(short tag,
X	      int depen,
X	      int indep,
X	      double *argument,
X	      double **jacobian)
X{
X  int i,j;
X  static int mmax, nmax;
X  static double **result, **I, **X; 
X  if(depen > mmax || indep > nmax)   
X    {
X      if(mmax) {free((char*)*I);
X		free((char*)I);
X		free((char*)*result);
X		free((char*)result);
X		free((char*)*X);
X		free((char*)X);}
X      I = myalloc2(depen,depen);
X      for (i=0;i<depen;i++)
X	{
X	  for (j=0;j<depen;j++)
X	    I[i][j] =0;
X	  I[i][i] =1;
X	}
X      result = myalloc2(depen,1);
X      X  = myalloc2(indep,1);
X      mmax = depen;
X      nmax = indep;
X    }
X  for(i=0;i<indep;i++)
X    *X[i] = argument[i];
X  hos_forward(tag,depen,indep,0,1,X,result);
X  fov_reverse(tag,depen,indep,depen,I,jacobian);
X}
X
Xfint jacobian_(fint* ftag,
X	      fint* fdepen,
X	      fint* findep,
X	      fdouble *fargument,
X	      fdouble *fjac)
X{
X  int tag=*ftag, depen=*fdepen, indep=*findep;
X  double** Jac = myalloc2(depen,indep);
X  double* argument = myalloc1(indep);
X  spread1(indep,fargument,argument);
X  jacobian(tag,depen,indep,argument,Jac);
X  pack2(depen,indep,Jac,fjac);
X  free((char*)*Jac); free((char*)Jac);
X  free((char*)argument);
X  return 8;
X}
X
Xvoid jac_vec(short tag,
X	     int m, 
X	     int n,
X	     double* argument,
X	     double* tangent,
X	     double* column)
X{
X  int i;
X  static double **X, **Y;
X  static int maxn, maxm;
X  if(n > maxn || m > maxm)
X    {
X      if(maxn)
X	{
X	  free((char*)*X); free((char*)X);
X	  free((char*)*Y); free((char*)Y);
X	}
X      X = myalloc2(n,2);
X      Y = myalloc2(m,2);
X      maxn = n;
X      maxm = m;
X    } 
X  for(i=0;i<n;i++)
X    {
X      X[i][0] = argument[i];
X      X[i][1] = tangent[i];
X    }
X  hos_forward(tag,m,n,1,0,X,Y);
X  for(i=0;i<m;i++)
X    column[i] = Y[i][1];
X}
X
Xfint jac_vec_(fint* ftag,
X	     fint* fm, 
X	     fint* fn,
X	     fdouble* fargument,
X	     fdouble* ftangent,
X	     fdouble* fcolumn)
X{
X  int tag=*ftag, m=*fm, n=*fn;
X  double* argument = myalloc1(n);
X  double* tangent = myalloc1(n);
X  double* column = myalloc1(m);
X  spread1(n,ftangent,tangent);
X  spread1(n,fargument,argument);
X  jac_vec(tag,m,n,argument,tangent,column);
X  pack1(m,column,fcolumn);
X  free((char*)argument); free((char*)tangent); free((char*)column);
X  return 17;
X}
X
Xvoid vec_jac(short tag,
X	     int m,
X	     int n,
X	     int repeat,
X	     double* argument,
X	     double* lagrange,
X	     double* row)
X{
X  int i;
X  static double **X, **Y;
X  static int maxn, maxm;
X  if(n > maxn || m > maxm)
X    {
X      if(maxn)
X	{
X	  free((char*)*X); free((char*)X);
X	  free((char*)*Y); free((char*)Y);
X	}
X      X = myalloc2(n,1);
X      Y = myalloc2(m,1);
X      maxn = n;
X      maxm = m;
X    } 
X  for(i=0;i<n;i++)
X    {
X    X[i][0] = argument[i];
X    }
X  if(!repeat) hos_forward(tag,m,n,0,1,X,Y);
X  fos_reverse(tag,m,n,lagrange,row); 
X}
X
Xfint vec_jac_(fint* ftag,
X	     fint* fm,
X	     fint* fn,
X	     fint* frepeat,
X	     fdouble* fargument,
X	     fdouble* flagrange,
X	     fdouble* frow)
X{ 
X  int tag=*ftag, m=*fm, n=*fn, repeat=*frepeat;
X  double* argument = myalloc1(n);
X  double* lagrange = myalloc1(m);
X  double* row = myalloc1(n);
X  spread1(m,flagrange,lagrange);
X  spread1(n,fargument,argument);
X  vec_jac(tag,m,n,repeat,argument,lagrange, row);
X  pack1(n,row,frow);
X  free((char*)argument); free((char*)lagrange); free((char*)row);
X  return 18;
X}
X
Xvoid function(short tag,
X              int m,
X	      int n,
X	      double* argument,
X	      double* result)
X{
X  int i,j;
X  static double **X, **Y;
X  static int maxn, maxm;
X  if(n > maxn || m > maxm)
X    {
X      if(maxn)
X	{
X	  free((char*)*X); free((char*)X);
X	  free((char*)*Y); free((char*)Y);
X	}
X      X = myalloc2(n,1);
X      Y = myalloc2(m,1);
X      maxn = n;
X      maxm = m;
X    } 
X  for(i=0;i<n;i++) 
X    *X[i] = argument[i];
X  hos_forward(tag,m,n,0,0,X,Y);
X  for(j=0;j<m;j++)
X    result[j] = *Y[j];
X  /* free((char*)*X);free((char*)X);
X     free((char*)*Y);free((char*)Y); */
X}
X  
Xfint function_(fint* ftag,
X              fint* fm,
X	      fint* fn,
X	      fdouble* fargument,
X	      fdouble* fresult)
X{
X  int tag=*ftag, m=*fm,  n=*fn;
X  double* argument = myalloc1(m);
X  double* result = myalloc1(n);
X  spread1(m,fargument,argument);
X  function(tag,m,n,argument,result);
X  pack1(n,result,fresult);
X  free((char*)argument); free((char*)result); 
X  return 19;
X}
X
Xvoid gradient(short tag,
X	      int n,
X	      double* argument,
X	      double* result)
X{
X  int i;
X  double y2;
X  double* y1=&y2;
X  double** y=&y1;
X  static double **X;
X  static int maxn;
X  if(n > maxn)
X    {
X      if(maxn)
X	{
X	  free((char*)*X); free((char*)X);
X	}
X      X = myalloc2(n,1);
X      maxn = n;
X    } 
X  for(i=0;i<n;i++)
X    *X[i] = argument[i];
X  hos_forward(tag,1,n,0,1,X,y);
X  vec_jac(tag,1,n,1,argument,&one,result);
X}
X
Xfint gradient_(fint* ftag,
X	      fint* fn,
X	      fdouble* fargument,
X	      fdouble* fresult)
X{
X  int tag=*ftag, n=*fn;
X  double* argument=myalloc1(n);
X  double* result=myalloc1(n);
X  spread1(n,fargument,argument);
X  gradient(tag,n,argument,result);
X  pack1(n,result,fresult);
X  free((char*)result); free((char*)argument);
X  return 20;
X}
X
Xvoid forodec(short tag,    /* tape identifier */
X	     int n,        /* space dimension */
X	     double tau,   /* scaling defaults to 1.0 */
X	     int dol,      /* previous degree defaults to zero */
X	     int deg,      /* New degree of consistency        */
X	     double** y)   /* Taylor series */
X{
X  /*********************************************************************
X    This is assumed to be the autonomous case.
X    Here we are just going around computing the vectors 
X    y[][i] for  dol < i <= deg
X    by successive calls to forward that works on the tape identified
X    by tag. This tape (array of file) must obviously have been
X    generated by a the execution of an active section between
X    trace_on and trace_off with n independent and n dependent variables
X    y must have been set up as  pointer to an array of n pointers
X    to double arrays containing at least deg+1 components.
X    The scaling by tau is sometimes necessary to avoid overflow.
X    **********************************************************************/
X  
X  static int i, j, k, nax, dax;
X  static double **z, taut;
X  if ( n > nax || deg > dax )
X    {
X      if(nax) {free((char*) *z); free((char*) z);}
X      z = myalloc2(n,deg+1);     
X      nax = n;
X      dax = deg;
X    }
X  
X  /******  Here we get  going    ********/
X  for (j=dol;j<deg;j++)
X    {
X      k = (deg)*(j == deg-1 ) ;         /* keep death values in prepration */
X      hos_forward(tag,n,n,j,k,y,z);     /* for  reverse called by jacode   */
X      taut = tau/(1+j);                 /* only the last time through.     */
X      for (i=0;i<n;i++)
X	y[i][j+1] = taut*z[i][j];
X    }
X}
X
Xfint forodec_(fint* ftag,    /* tape identifier */
X            fint* fn,       /* space dimension */
X            fdouble* ftau,  /* scaling defaults to 1.0 */
X            fint* fdol,     /* previous degree defaults to zero */
X            fint* fdeg,     /* New degree of consistency        */
X	    fdouble* fy)   /* Taylor series                    */
X{
X  int tag=*ftag, n=*fn, dol=*fdol, deg=*fdeg;
X  int i;
X  double tau=*ftau;
X  double** Y = myalloc2(n,deg+1);
X  for(i=0;i<n;i++)
X    *Y[i] = fy[i];
X  forodec(tag,n,tau,dol,deg,Y);
X  pack2(n,deg+1,Y,fy);
X  free((char*)*Y); free((char*)Y);
X  return 9;
X}
X
Xvoid accodec(int n,             /* space dimension */
X            double tau,         /* scaling defaults to 1.0 */
X            int deg,            /* highest degree          */
X	    double*** A,        /* input tensor of "partial" Jacobians */
X            double*** B,        /* output tensor of "total" Jacobians  */
X	    short** nonzero )   /* optional sparsity characterization  */
X{
X/*
X    The purpose of this subroutine is to compute the total derivatives
X               B[i=0...n-1][j=0...n-1][k=0...deg].
X    The matrix obtained for fixed k represents the Jacobian of the
X    (k+1)-st Taylor coefficient vector with respect to the base point of
X    the ODE, i.e., the 0-th coefficient vector. The input array
X	       A[i=0...n-1][j=0...n-1][k=0...deg]
X    has exactly the same format, except that it-s k-th matrix slice
X    represents a partial derivative in that the indirect dependence
X    of the k-th coefficient vector on the base point via the (k-1)-st
X    and other lower Taylor coeffcients has not been taken into account.
X    The B's are compute from the A's by the chainrule with the parameter
X    tau thrown in for scaling. The calculation is performed so that
X    A may directly be overwritten by B i.e. their pointers arguments may
X    coincide to save storage.
X	   Sparsity is used so far only to reduce the operations count 
X    but not to save space. In general we expect that for each given pair
X    (i,j) the entries A[i][j][k=0...] are nonzero either for all k, or for no k,
X    or for k=0 only. 
X	   On entry the optional short array nonzero may be used to identify
X    all entries of the A[.][.][k] that are potentially nonzero, i.e. 
X
X            nonzero[i][j] <= 0  implies   A[i][j][k] = 0 for all k 
X	    nonzero[i][j] = 1   implies   A[i][j][k] = 0 for all k > 0 .
X
X    In other words we only allow the sparsity of the matrices A[.][.][k]
X    to be increasing in that A[.][.][1] is possibly sparser than A[.][.][0]
X    and all subseqent A[.][.][k] with k > 0 have the same sparsity pattern.
X    That is the typical situation since A[.][.][k] is the k-th
X    Taylor coefficient in the time expansion of the Jacobian of the
X    right hand side. The entries of this square matrix tend to be either
X    constant or trancendental functions of time.
X	   The matrices B_k = B[.][.][k] are obtained from the A_k = A[.][.][k]
X    by the recurrence
X                        tau   /        k                  \
X	         B_k = ----- |  A_k + SUM A_{j-1} B_{k-j}  |
X	                k+1   \       j=1                 /
X
X    Assuming that the diagonal entries A[i][i][0] are structurally nonzero
X    we find that the matrices B[.][.][k=1..] can only lose sparsity
X    as k increase. Therfore, we can redefine the nonpositive values 
X    nonzero[i][j] so that on exit
X
X	    k <= -nonzero[i][j]  implies     B[i][j][k] = 0 
X
X    which is trivially satisfied for all positive values of nonzero[i][j].
X    Due to the increasing sparsity of the A_i and the decreasing sparsity
X    of the B_i the first product in the sum of the RHS above determines the
X    sparsity pattern of the resulting B_k. Hence the optimal values of
X    the nonzero[i][j] depend only on the sparsity pattern of A_0. More
X    specifically, all positive -nonzero[i][j] represent the length of the
X    shortest directed path connecting nodes j and i in the incidence graph 
X    of A_0. 
X*/    
X
X  int i,j,k,m,p,nzip,nzpj,isum;
X  double *Aip, *Bpj, scale, sum;
X  for (k=0;k<=deg;k++)   /* Lets calculate B_k */
X    {
X      scale = tau/(1.0+k);
X      if(nonzero)
X	{
X	  for (i=0;i<n;i++)
X	    for(j=0;j<n;j++)
X	      if(k   < -nonzero[i][j]) 
X		B[i][j][k] = 0.0;
X	      else   
X		{
X		  sum = A[i][j][k];
X		  isum = (nonzero[i][j] >  0);
X		  for (p=0;p<n;p++)
X		    {
X		      nzip = nonzero[i][p];
X		      nzpj = nonzero[p][j];
X		      if(nzpj > 0) nzpj = 0;
X		      if(nzip > 0 && k > -nzpj )  /*otherwise all terms vanish*/
X			{
X			  Aip = A[i][p];
X			  Bpj = B[p][j]+k-1;
X			  sum += *Aip*(*Bpj);
X			  isum =1;
X			  if(nzip > 1 )   /* the A[i][p][m>0] may be nonzero*/
X			    for(m=k-1; m>-nzpj;m--)
X			      sum += *(++Aip)*(*(--Bpj));
X			}
X		    }
X		  if(isum)         /* we found something nonzero after all*/
X		    B[i][j][k] = sum*scale;
X		  else
X		    {B[i][j][k]= 0;
X		     nonzero[i][j]--;
X		   }
X		}
X	}
X      else
X	{
X	  for (i=0;i<n;i++)
X	    for(j=0;j<n;j++)
X	      {
X		sum = A[i][j][k];
X		for (p=0;p<n;p++)
X		  {
X		    Aip = A[i][p];
X		    Bpj = B[p][j]+k-1;
X		    for(m=k; m>0 ;m--)
X		      sum += *(Aip++)*(*Bpj--);
X		    B[i][j][k] = sum*scale;
X		  }
X	      }
X	}
X    }
X}
X
Xfint accodec_(fint* fn,             /* space dimension */
X	      fdouble* ftau,        /* scaling defaults to 1.0 */
X              fint* fdeg,           /* highest degree          */ 
X	      fdouble* fa,          /* input tensor of "partial" Jacobians */
X              fdouble* fb)          /* output tensor of "total" Jacobians  */
X{ 
X  int n=*fn, deg=*fdeg;
X  double tau=*ftau;
X  double*** A = myalloc3(n,n,deg); 
X  double*** B = myalloc3(n,n,deg); 
X  spread3(n,n,deg,fa,A);
X  accodec(n,tau,deg,A,B,0);
X  pack3(n,n,deg,B,fb);
X  free((char*)**A); free((char*)*A); free((char*)A);
X  free((char*)**B); free((char*)*B); free((char*)B);
X  return 10;
X}
X
X#ifdef __cplusplus
X}
X#endif
X
END_OF_FILE
if test 21466 -ne `wc -c <'driversc.c'`; then
    echo shar: \"'driversc.c'\" unpacked with wrong size!
fi
chmod +x 'driversc.c'
# end of 'driversc.c'
fi
if test -f 'dvlparms.h' -a "${1}" != "-c" ; then 
  echo shar: Will not clobber existing file \"'dvlparms.h'\"
else
echo shar: Extracting \"'dvlparms.h'\" \(1369 characters\)
sed "s/^X//" >'dvlparms.h' <<'END_OF_FILE'
X/*
X -------------------------------------------------------------------------
X file dvlparms.h of ADOL-C version 1.6 as of January 1,   1995          
X Included in ---->
X                  drivers.c
X		  driversc.c
X                  fos_reverse.c
X                  fov_reverse.c 
X                  hos_forward.c
X                  hos_reverse.c
X                  hov_reverse.c
X		  taputil1.c
X                  taputil2.c
X                  taputil3.c
X                  tayutil.c
X
X
X ------------------------------------------------------------------------- 
X
X  The sole purpose of this file is to provide the developers and          
X  maintainers of ADOL-C and include file that contains library wide       
X  definitions, etc.                                                       
X
X*/
X
X/* Include the standard library, stdio routines, math functions */
X/* and error number routines.                                   */
X/* __GNUG__ is defined by g++, __GNUC__ by g++ and gcc          */
X#ifdef __GNUG__ 
X#include <std.h>
X#else
X#include <stdlib.h>
X#endif
X
X#include <stdio.h>
X#include <math.h>
X#include <errno.h>
X
X/* Define Compsize */
X
X#define compsize >
X
X/* Possible ADOL-C options. */
X
X#define overwrite   overwrite
X#define conditional conditional
X
X/*-------------------------------*/
X/* Reserved for future expansion */
X/*-------------------------------*/
X
X
X
X
X
X
X
X
X
X
X
X
X
END_OF_FILE
if test 1369 -ne `wc -c <'dvlparms.h'`; then
    echo shar: \"'dvlparms.h'\" unpacked with wrong size!
fi
chmod +x 'dvlparms.h'
# end of 'dvlparms.h'
fi
if test -f 'fos_reverse.c' -a "${1}" != "-c" ; then 
  echo shar: Will not clobber existing file \"'fos_reverse.c'\"
else
echo shar: Extracting \"'fos_reverse.c'\" \(19128 characters\)
sed "s/^X//" >'fos_reverse.c' <<'END_OF_FILE'
X/*
X   ----------------------------------------------------------------
X   File fos_reverse.c of ADOL-C version 1.6 as of January 1,   1995
X   ----------------------------------------------------------------
X   Contains the routine fos_reverse (first-order-scalar reverse 
X   mode).
X
X*/
X
X#ifdef __cplusplus
Xextern "C" {
X#endif
X
X
X/* 
X  There are four basic versions of the procedure `reverse', which
X  are optimized for the cases of scalar or vector reverse sweeps
X  with first or higher derivatives, respectively. In the calling
X  sequence this distinction is apparent from the type of the
X  parameters `lagrange' and `results'. The former may be left out
X  and the integer parameters `depen', `indep', `degre', and `nrows'
X  must be set or default according to the following matrix of
X  calling cases. 
X
X           no lagrange         double* lagrange     double** lagrange
X
Xdouble*   gradient of scalar   weight vector times    infeasible 
Xresults   valued function      Jacobian product       combination
X
X          ( depen = 1 ,         ( depen > 0 ,         
X	    degre = 0 ,           degre = 0 ,              ------
X	    nrows = 1 )           nrows = 1 )
X
Xdouble**  Jacobian of vector   weight vector times     weight matrix
Xresults   valued function      Taylor-Jacobians        times Jacobian
X           
X	  ( 0 < depen           ( depen > 0 ,          ( depen > 0 ,
X	      = nrows ,           degre > 0 ,            degre = 0 ,
X	    degre = 0 )           nrows = 1 )            nrows > 0 )
X
Xdouble*** full family of         ------------          weigth matrix x
Xresults   Taylor-Jacobians       ------------          Taylor Jacobians
X
X
X*/ 
X
X#include "dvlparms.h" /* Developers Parameters */
X
X/* Necessary Includes */
X
X#include "usrparms.h"
X#include "oplate.h"
X#include "taputil1.h"
X#include "taputil2.h"
X#include "taputil3.h"
X#include "tayutil.h"
X
Xstatic short tag;
X
X
X/****************************************************************************/
X/* First-order scalar reverse.                                              */
X/****************************************************************************/
Xvoid fos_reverse(short tnum,         /* tape id */
X		 int depen,          /* consistency chk on # of dependents */
X		 int indep,          /* consistency chk on # of independents */
X		 double* lagrange,
X		 double* results)    /*  coefficient vectors */
X{
X  unsigned char operation;
X  int tape_stats[11];  /* tape stats */
X
X  locint result=0;
X  locint arg=0;
X  locint res=0;
X  locint loc1=0;
X  locint loc2=0;
X  double stored_val=0.0;
X  locint result_v=0;
X  locint loc1_v=0;
X  locint loc2_v=0;
X  double *d = 0;
X  locint size = 0;
X
X  static int rax;
X  static double* As;
X  static revreal* Trs;
X  int i,l,kl;
X  double r0;
X  double* Ad;
X
X  int indexi;
X  int indexd;
X  int rev_location_cnt;
X  int dep_cnt;
X  int indep_cnt;
X
X  int buffer;
X
X  int taycheck;
X  int numdep,numind;
X
X  tag = tnum;   /*tag is global which indicates which tape to look at */
X    
X
X    
X  tapestats(tag,tape_stats);
X
X  indep_cnt = tape_stats[0];
X  dep_cnt = tape_stats[1];
X  rev_location_cnt = tape_stats[2];
X  buffer =  tape_stats[4];
X
X
X  
X  set_buf_size(buffer);
X
X  if ((depen != dep_cnt)||(indep != indep_cnt))
X    {
X      printf("ADOL-C error: Reverse sweep on tape %d  aborted!\n",tag);
X      printf("Number of dependent and/or independent variables ");
X      printf("passed to reverse is\ninconsistant with number ");
X      printf("recorded on tape %d \n",tag);
X      exit (-1);
X    }
X  
X  indexi = indep_cnt - 1;
X  indexd = dep_cnt - 1;
X/*
X  for (kl =0; kl < indep_cnt; kl++) results[kl]=NaN;
X*/
X  
X  if(rev_location_cnt compsize rax) 
X    {
X      if(rax)
X	{ 
X	  free((char*) Trs);
X	  free((char*) As);
X	}
X      Trs = (revreal*) malloc(rev_location_cnt*sizeof(revreal));
X      As = (revreal*) malloc(rev_location_cnt*sizeof(revreal));
X      rax = rev_location_cnt;
X    }
X  Ad = As;
X  for(i=0;i<rev_location_cnt;i++) *Ad++ = 0;
X  taylor_back(Trs,&numdep,&numind,&taycheck);
X  
X  if(taycheck < 0)   
X    {
X      printf("\n ADOL-C error: reverse fails because it was not preceeded \n");
X      printf("by a forward sweep with degree 0 \n");
X      exit(-2);
X    };
X  
X  if((numdep != depen)||(numind != indep))
X    {
X      printf("\n ADOL-C error: reverse fails on tape %d because the number of\n"
X	     ,tag);
X      printf("independent and/or dependent variables given to reverse are\n");
X      printf("inconsistant with that of the internal taylor array.\n");
X      exit(-2);
X    }
X  
X  
X  /* Set up the tape */
X
X  init_rev_sweep(tag);
X
X
X  /* Read the last operation */
X
X  operation=get_op_r();
X  
X  while (operation != start_of_tape) 
X    {
X
X      /* Switch Statemnet to execute operations in reverse */
X      switch (operation) {
X
X	/* Markers */
X
X      case end_of_int:
X        get_loc_block_r(); /* Get the next int block */
X        break;
X      case end_of_val:
X        get_val_block_r(); /* Get the next val block */
X        break;
X      case end_of_op:
X        get_op_block_r();
X        operation = get_op_r(); /* Skip next operation,it's another end_of_op */
X        break;
X      case start_of_tape:
X      case end_of_tape:
X	break;
X
X	/* Scalar Operations */
X      case int_adb_a:
X        loc1 = get_locint_r();
X        loc2 = get_locint_r();
X	As[loc2] += As[loc1];
X	As[loc1] = 0.0;
X	break;
X      case assign_a:
X        loc1 = get_locint_r();
X        loc2 = get_locint_r();
X	get_taylor(loc1);
X	As[loc2] += As[loc1];
X	As[loc1] = 0.0;
X	break;
X      case int_adb_d:
X        loc1 = get_locint_r();
X        stored_val = get_val_r();
X	As[loc1] = 0;
X	break;
X      case assign_d:
X        loc1 = get_locint_r();
X        stored_val = get_val_r();
X	As[loc1] = 0;
X	get_taylor(loc1);
X	break;
X      case assign_ind:
X        loc1 = get_locint_r();
X	get_taylor(loc1);
X	results[indexi] =As[loc1];
X	indexi--;
X	break;
X      case assign_dep:
X        loc1 = get_locint_r();
X	As[loc1] =lagrange[indexd];
X	indexd--;
X	break;
X      case eq_plus_d:
X        result=get_locint_r();
X        stored_val = get_val_r();
X	get_taylor(result);
X	break;
X      case eq_plus_a: 
X        result=get_locint_r();
X        loc1=get_locint_r();
X	get_taylor(result);
X	As[loc1] +=As[result];
X	break;
X      case eq_min_d:
X        result=get_locint_r();
X        stored_val = get_val_r();
X	get_taylor(result);
X	break;
X      case eq_min_a: 
X        result=get_locint_r();
X        loc1=get_locint_r();
X	get_taylor(result);
X	As[loc1] -= As[result];
X	break;
X      case eq_mult_d:
X        result=get_locint_r();
X        stored_val = get_val_r();
X	get_taylor(result);
X	As[result] *=stored_val;
X	break;
X      case eq_mult_a:
X        result=get_locint_r();
X        loc1=get_locint_r();
X	get_taylor(result);
X	r0 = As[result];
X	As[result] = 0;
X	As[loc1] += r0*Trs[result];
X	As[result] += r0*Trs[loc1] ; 
X	break;
X      case plus_a_a:
X        result =get_locint_r();
X        loc2=get_locint_r();
X        loc1=get_locint_r();
X	As[loc1]+=As[result];
X	As[loc2]+=As[result];
X	break;
X      case plus_d_a:
X        result = get_locint_r();
X        loc1=get_locint_r();
X        stored_val = get_val_r();
X	As[loc1] += As[result];
X	break;
X      case min_a_a:
X        result =get_locint_r();
X        loc2=get_locint_r();
X        loc1=get_locint_r();
X	As[loc1]+=As[result];
X	As[loc2]-=As[result];
X	break;
X      case min_d_a:
X        result = get_locint_r();
X        loc1=get_locint_r();
X        stored_val = get_val_r();
X	As[loc1] -= As[result];
X	break;
X      case mult_a_a:
X        result =get_locint_r();
X        loc2=get_locint_r();
X        loc1=get_locint_r();
X	As[loc2] += 
X	  As[result]*Trs[loc1];
X	As[loc1] += 
X	  As[result]*Trs[loc2];
X	break;
X      case mult_d_a:
X        result = get_locint_r();
X        loc1=get_locint_r();
X        stored_val = get_val_r();
X	As[loc1] +=
X	  stored_val*As[result];
X	break;
X      case div_a_a:
X        result =get_locint_r();
X        loc2=get_locint_r();
X        loc1=get_locint_r();
X	r0= As[result]/Trs[loc2];
X	As[loc1] += r0;
X	As[loc2] -=
X	  r0*Trs[result];
X	break;
X      case div_d_a:
X        result = get_locint_r();
X        loc1=get_locint_r();
X        stored_val = get_val_r();
X	As[loc1] -= As[result]*
X	  Trs[result]/Trs[loc1];
X	break;
X      case pow_op:
X        result = get_locint_r();
X        loc1=get_locint_r();
X        stored_val = get_val_r();
X        if (Trs[loc1]==0.0)
X          r0=0.0;
X        else
X          r0=1.0/Trs[loc1];
X	As[loc1] += As[result]*
X           stored_val* Trs[result]*r0;
X	break;
X      case death_not:
X        loc2 = get_locint_r();
X        loc1 = get_locint_r();
X	for (i=loc1;i<=loc2;i++)
X	  {
X	    As[i] = 0.0;
X	    get_taylor(i);
X	  }
X	break;
X      case exp_op:
X        result = get_locint_r();
X        loc1=get_locint_r();
X	As[loc1] +=
X	  As[result]*Trs[result];
X	break;
X      case sin_op:
X        result = get_locint_r();
X        loc2 = get_locint_r();
X        loc1 = get_locint_r();
X        stored_val = get_val_r();
X	As[loc1] +=
X	  As[result]*Trs[loc2];
X	break;
X      case cos_op:
X        result = get_locint_r();
X        loc2 = get_locint_r();
X        loc1 = get_locint_r();
X        stored_val = get_val_r();
X	As[loc1] -=
X	  As[result]*Trs[loc2];
X	break;
X      case sqrt_op:
X        result = get_locint_r();
X        loc1=get_locint_r();
X        if (Trs[result]==0.0)
X          r0=0.0;
X        else
X          r0=0.5/Trs[result];
X	As[loc1] += r0*As[result];
X	break;
X      case abs_val:
X        result = get_locint_r();
X        loc1=get_locint_r();
X        if(Trs[loc1]<0.0)
X          As[loc1]-=As[result];
X        else if(Trs[loc1]>0.0)
X          As[loc1]+=As[result];
X        break;
X
X      case asin_op:
X      case acos_op:
X      case atan_op:
X      case gen_quad:
X        result = get_locint_r();
X        loc2 = get_locint_r();
X        loc1 = get_locint_r();
X        stored_val = get_val_r();
X	As[loc1] += 
X	  As[result]*Trs[loc2];
X	break;      
X      case log_op:
X        result = get_locint_r();
X        loc1=get_locint_r();
X	As[loc1] += 
X	  As[result]/Trs[loc1];
X	break;
X 
X      /* Vector operations */
X
X      case int_av_av:
X        result_v= get_locint_r();
X        size = get_locint_r();
X        loc1_v = get_locint_r();
X	for (l=0;l<size;l++)
X	  {
X	    loc1 = result_v + l;   /* Location of left-hand-side  */
X	    loc2 = loc1_v + l;   /* Location of right-hand-side */
X	    /* code for int_adb_a */
X	    As[loc2] += As[loc1];
X	    As[loc1] = 0.0;
X	  }
X	break;
X      case assign_dv:
X        loc1_v = get_locint_r();
X        size = get_locint_r();
X        d = get_val_v_r(size);
X	for (l=size-1;l>=0;l--)
X	  {
X	    loc1 = loc1_v + l;           /* Location of left-hand-side */
X	    stored_val = d[l];      /* Value of right-hand-side   */     
X	    /* code for assign_d */
X	    As[loc1] = 0;
X	    get_taylor(loc1);
X	  }
X	break;
X      case assign_av:
X        loc1_v = get_locint_r();
X        size = get_locint_r();
X        loc2_v = get_locint_r();
X	for (l=size-1;l>=0;l--)
X	  {
X	    loc1 = loc1_v + l;             /* Location of left-hand-side  */
X	    loc2 = loc2_v + l;             /* Location of right-hand-side */
X	    /* code for assign_a */
X	    get_taylor(loc1);
X	    As[loc2] += As[loc1];
X	    As[loc1] = 0.0;
X	  }
X	break;
X      case assign_indvec:
X        loc1_v = get_locint_r();
X        size = get_locint_r();
X	for (l=size-1;l>=0;l--)
X	  {
X	    loc1 = loc1_v + l;             /* Location of left-hand-side */
X	    /* code for assign_ind */
X	    get_taylor(loc1);
X	    results[indexi] =As[loc1];
X	    indexi--;
X	  }
X	reset_val_r();
X	break;
X      case assign_depvec:
X        loc1_v = get_locint_r();
X        size = get_locint_r();
X	for (l=size-1;l>=0;l--)
X	  {
X	    loc1 = loc1_v + l;             /* Location of the left-hand-side */
X	    /* code for assign_dep */
X	    As[loc1] =lagrange[indexd];
X	    indexd--;
X	  }
X	break;
X      case eq_min_av:
X        result_v = get_locint_r();
X        size = get_locint_r();
X        loc1_v = get_locint_r();
X	for (l=size-1;l>=0;l--)
X	  {
X	    result = result_v + l;            /* Location of left-hand-side  */
X	    loc1   = loc1_v + l;              /* Location on right-hand-side */
X	    /* code for eq_min_a */ 
X	    get_taylor(result);
X	    As[loc1] -= As[result];
X	  }
X	break;
X      case eq_plus_av:
X        result_v = get_locint_r();
X        size = get_locint_r();
X        loc1_v = get_locint_r();
X	for (l=size-1;l>=0;l--)
X	  {
X	    result = result_v + l;            /* Location of left-hand-side  */
X	    loc1   = loc1_v   + l;            /* Location on right-hand-side */
X	    /* code for eq_plus_a */
X	    get_taylor(result);
X	    As[loc1] +=As[result];
X	  }
X	break;
X      case eq_mult_av_a:
X        result_v = get_locint_r();
X        size = get_locint_r();
X        loc1 = get_locint_r();
X	for (l=size-1;l>=0;l--)
X	  {
X	    result = result_v + l;      /* Location of the left-hand-side  */
X	    /* loc1   = fixed;             Location on the right-hand-side */
X	    /* code for eq_mult_a*/
X	    get_taylor(result);
X	    r0 = As[result];
X	    As[result] = 0;
X	    As[loc1] += r0*Trs[result];
X	    As[result] += r0*Trs[loc1] ; 
X	    
X	  }
X	break;
X      case eq_mult_av_d:
X        result_v = get_locint_r();
X        size = get_locint_r();
X        stored_val = get_val_r();
X	for (l=size-1;l>=0;l--)
X	  {
X	    result = result_v + l;      /* Location of the left-hand-side  */
X	    /* code for eq_mult_d*/
X	    get_taylor(result);
X	    As[result] *=stored_val;
X	  }
X	break;
X      case plus_av_av:
X        result_v = get_locint_r();
X        size     = get_locint_r();
X        loc2_v   = get_locint_r();
X        loc1_v   = get_locint_r();
X	for (l=0;l<size;l++)
X	  {
X	    loc2   = loc2_v    + l;       /* Location of var 2  */
X	    loc1   = loc1_v    + l;       /* Location of var 1  */
X	    result = result_v  + l;       /* Location of result */
X	    /* code for plus_a_a */
X	    As[loc1]+=As[result];
X	    As[loc2]+=As[result];
X	  }
X	break;
X      case sub_av_av:
X        result_v = get_locint_r();
X        size     = get_locint_r();
X        loc2_v   = get_locint_r();
X        loc1_v   = get_locint_r();
X	for (l=0;l<size;l++)
X	  {
X	    loc2   = loc2_v    + l;       /* Location of var 2  */
X	    loc1   = loc1_v    + l;       /* Location of var 1  */
X	    result = result_v  + l;       /* Location of result */
X	    /* code for min_a_a */
X	    As[loc1]+=As[result];
X	    As[loc2]-=As[result];
X	  }
X	break;
X      case dot_av_av:
X        result_v = get_locint_r();
X        size     = get_locint_r();
X        loc2_v   = get_locint_r();
X        loc1_v   = get_locint_r();
X	result = result_v;
X	for (l=0;l<size;l++)
X	  {
X	    loc2 = loc2_v + l;
X	    loc1 = loc1_v + l;
X	    /* code for mult_a_a  */
X	    As[loc2] += As[result]*Trs[loc1];
X	    As[loc1] += As[result]*Trs[loc2];
X	  }
X	As[result] = 0;
X
X	break;
X      case mult_d_av:
X        result_v = get_locint_r();
X        size = get_locint_r();
X        loc1_v = get_locint_r();
X        stored_val =get_val_r();
X	for (l=0;l<size;l++)
X	  {
X	    loc1   = loc1_v   + l;   /* Location on the right-hand-side */
X	    result = result_v + l;   /* location of the result */
X	    /* stored_val = Fixed double value */
X	    
X	    /* code for mult_d_a */
X	    As[loc1] += stored_val*As[result];
X	    /* Be Careful here also see line 753 */
X	  }
X	break;
X      case div_av_a:
X        result_v = get_locint_r();
X        size     = get_locint_r();
X        loc2_v   = get_locint_r();
X        loc1_v   = get_locint_r();
X	loc2= loc2_v;     /* Location of adouble */
X	for (l=0;l<size;l++)
X	  {
X	    loc1   = loc1_v   + l;  /* Location of right-hand-side vector[l] */
X	    result = result_v + l;  /* Location of the result */
X	    /* code for div_a_a */
X	    r0= As[result]/Trs[loc2];
X	    As[loc1] += r0;
X	    As[loc2] -= r0*Trs[result];
X	  }
X	break;
X      case mult_av_a:
X        result_v = get_locint_r();
X        size     = get_locint_r();
X        loc2_v   = get_locint_r();
X        loc1_v   = get_locint_r();
X	loc2= loc2_v;   /* Location of adouble */
X	for (l=0;l<size;l++)
X	  {
X	    loc1   = loc1_v   + l; /* Location of right-hand-side vector[l] */
X	    result = result_v + l; /* Location of the result */
X     
X	    /* code for mult_a_a */
X	    As[loc2] += As[result]*Trs[loc1];
X	    As[loc1] += As[result]*Trs[loc2];
X	  }
X	break;
X      case mult_a_av:
X        result_v = get_locint_r();
X        size     = get_locint_r();
X        loc2_v   = get_locint_r();
X        loc1_v   = get_locint_r();
X	loc1= loc2_v;      /* Location of the adouble */
X	for (l=0;l<size;l++)
X	  {
X	    loc2= loc1_v+l;      /* Location of right hand side vectore[l]  */
X	    result = result_v + l; /* Location of the result */
X	    
X	    /* code for mult_a_a */
X	    As[loc2] += As[result]*Trs[loc1];
X	    As[loc1] += As[result]*Trs[loc2];
X	  }
X	break;
X	
X#ifdef conditional
X      case cond_assign:
X        result = get_locint_r();
X        loc2 = get_locint_r();
X        loc1 = get_locint_r();
X        loc1_v = get_locint_r();
X	get_taylor(result);
X        if(Trs[loc1_v]>0)
X        {
X	  As[loc1] += As[result];
X	  As[result] = 0.0;
X        } /* endif */
X        else
X        {
X          As[loc2] += As[result];
X          As[result] = 0.0;
X        } /* endelse */
X	break;
X      case cond_assign_s:
X        result = get_locint_r();
X        loc1 = get_locint_r();
X        loc1_v = get_locint_r();
X	get_taylor(result);
X        if(Trs[loc1_v]>0)
X        {
X	  As[loc1] += As[result];
X	  As[result] = 0.0;
X        } /* endif */
X	break;
X      case subscript:
X        result = get_locint_r();
X        loc1 = get_locint_r();
X        loc1_v = get_locint_r(); 
X	get_taylor(result);
X	As[loc1_v+(int)(Trs[loc1])] += As[result];
X	As[result] = 0.0;
X	break;
X      case subscript_l:
X        result = get_locint_r();
X        loc1 = get_locint_r();
X        loc1_v = get_locint_r(); 
X	get_taylor(loc1_v+(int)(Trs[loc1]));
X	As[result] += As[loc1_v+(int)(Trs[loc1])];
X	As[loc1_v+(int)(Trs[loc1])] = 0.0;
X	break;
X      case subscript_ld:
X        loc1 = get_locint_r();
X        loc1_v = get_locint_r(); 
X        stored_val = get_val_r();
X	As[loc1_v+(int)(Trs[loc1])] = 0.0;
X	break;
X      case m_subscript:
X        result = get_locint_r();
X        size = get_locint_r();
X        loc1 = get_locint_r();
X        loc1_v = get_locint_r(); 
X        for (l=size-1;l>=0;l--)
X        {
X          res=result+l;
X          arg=loc1_v+(int)(Trs[loc1])*size+l;
X	  As[arg] += As[res];
X	  As[res] = 0.0;
X        } /* endfor */
X	break;
X      case m_subscript_l:
X        result = get_locint_r();
X        size = get_locint_r();
X        loc1 = get_locint_r();
X        loc1_v = get_locint_r(); 
X        for (l=size-1;l>=0;l--)
X        {
X          arg=loc1_v+(int)(Trs[loc1])*size+l;
X          res=result+l;
X	  get_taylor(arg);
X	  As[res] += As[arg];
X	  As[arg] = 0.0;
X        } /* endfor */
X	break;
X      case m_subscript_ld:
X        size = get_locint_r();
X        loc2 = get_locint_r();
X        loc1 = get_locint_r();
X        loc1_v = get_locint_r(); 
X        d = get_val_v_r(size);
X        for (l=size-1;l>=0;l--)
X        {
X          arg=loc1_v+(int)(Trs[loc1])*size+l+loc2;
X	  As[arg] = 0.0;
X        } /* endfor */
X	break;
X#endif	
X
X
X      default:
X	/* Die here, we screwed up */
X	printf("ADOL-C error: Fatal error in fos_reverse on operation %d\n",
X	       operation);
X	exit(-1);
X	break;
X      }
X
X      /* Get the next operation */
X
X      operation=get_op_r();
X    }
X  end_sweep();
X}
X
X#ifdef __cplusplus
X}
X#endif
X
END_OF_FILE
if test 19128 -ne `wc -c <'fos_reverse.c'`; then
    echo shar: \"'fos_reverse.c'\" unpacked with wrong size!
fi
chmod +x 'fos_reverse.c'
# end of 'fos_reverse.c'
fi
if test -f 'fov_forward.c' -a "${1}" != "-c" ; then 
  echo shar: Will not clobber existing file \"'fov_forward.c'\"
else
echo shar: Extracting \"'fov_forward.c'\" \(24111 characters\)
sed "s/^X//" >'fov_forward.c' <<'END_OF_FILE'
X/*
X   ----------------------------------------------------------------
X   File fov_forward.c of ADOL-C version 1.6 as of January 1,   1995
X   ----------------------------------------------------------------
X   Contains the routine fov_forward (first-order-vector forward
X   mode).
X
X*/
X
X#ifdef __cplusplus
Xextern "C" {
X#endif
X
X
X#include "dvlparms.h" /* Developers Parameters */
X#include "usrparms.h"
X#include "oplate.h"
X#include "taputil1.h"
X#include "taputil2.h"
X#include "taputil3.h"
X#include "tayutil.h"
X#include "adutilsc.h"
X
Xstatic short tag;
X
Xstatic int for_location_cnt;
Xstatic int dep_cnt;
Xstatic int ind_cnt;
X
X/****************************************************************************/
X/* First Order Vector version of the forward mode.                         */
X/****************************************************************************/
Xvoid fov_forward(short tnum,         /* tape id */
X		 int depcheck,       /* consistency chk on # of dependents */
X		 int indcheck,       /* consistency chk on # of independents */
X		 int p,              /* # of taylor series */
X                 double *basepoint,  /* independent variable values */
X		 double **argument,  /* Taylor coefficients (input) */
X                 double *valuepoint, /* Taylor coefficients (output) */
X		 double **taylors)   /* matrix of coifficient vectors */
X/* the order of the indices in argument and taylors is [var][taylor] */
X{
X  unsigned char operation;
X  int tape_stats[11];  /* tape stats */
X
X  locint size = 0;
X  locint result=0;
X  locint result_v=0;
X  locint loc1=0;
X  locint loc1_v=0;
X  locint loc2=0;
X  locint loc2_v=0;
X  double stored_val=0.0;
X  double *d = 0;
X
X  int  l, pl;
X  double r0;
X  locint arg,arg1,arg2,res;
X  int indexi =0; 
X  int indexd =0;
X  double  *Targ,*Tres,*Tqo,*Targ1,*Targ2,*Tloc1,*Tloc2; 
X  double coval,divs;
X  int buffer; 
X  static int fax, kax;
X  static double *Tdum; 
X  double* T0;
X  double** T;
X
X#ifdef inf_num
Xdouble i_num=inf_num;
Xdouble i_den=inf_den;
Xdouble n_num=non_num;
Xdouble n_den=non_den;
Xdouble InfVal;
Xdouble NoNum;
X#endif
X
X  tag = tnum;         /*tag is global which specifies which tape to look at */
X  
X  tapestats(tag,tape_stats);
X
X  ind_cnt = tape_stats[0];
X  dep_cnt = tape_stats[1];
X  for_location_cnt = tape_stats[2];
X  buffer =  tape_stats[4];
X
X  set_buf_size(buffer);
X  T0 = (double*)malloc(for_location_cnt*sizeof(double));
X  T = (double**)myalloc2(for_location_cnt,p); 
X  if ((depcheck != dep_cnt)||(indcheck != ind_cnt))
X    {
X      printf("ADOL-C error: forward sweep on tape %d  aborted!\n",tag);
X      printf("Number of dependent and/or independent variables passed to forward is\ninconsistant with number recorded on tape %d \n",tag);
X      exit (-1);
X    } /* endif */
X  
X
X  /* Initialize the Forward Sweep */
X  init_for_sweep(tag);
X
X
X  operation=get_op_f();
X  while (operation !=end_of_tape)
X    {
X      switch (operation){
X      case end_of_op:
X        get_op_block_f();
X        operation=get_op_f(); 
X        /* Skip next operation, it's another end_of_op */
X        break;
X      case end_of_int:
X        get_loc_block_f();
X        break;
X      case end_of_val:
X        get_val_block_f();
X        break;
X      case start_of_tape:
X      case end_of_tape:
X	break;
X      case int_adb_a:  /* initialize an adouble */	
X        arg = get_locint_f();
X        res = get_locint_f();
X	Targ = T[arg];
X        Tres = T[res]; 
X        T0[res]= T0[arg];
X        for (l=0;l<p;l++)
X	  Tres[l]=Targ[l];
X	break;
X      case assign_a:  /* assign an adouble variable an adouble value. (=) */
X        arg = get_locint_f();
X        res = get_locint_f();
X	Targ = T[arg];
X        Tres = T[res];
X        T0[res]= T0[arg];
X        for (l=0;l<p;l++)
X          Tres[l]=Targ[l];
X        break;
X      case int_adb_d: /* initialize an double */
X        res = get_locint_f();
X	Tres = T[res];
X	T0[res]=get_val_f();
X        for (l=0;l<p;l++)
X	  Tres[l]=0;
X	break;
X      case assign_d: /* assign an adouble variable a float value. (=) */
X        res = get_locint_f();
X	Tres = T[res];
X	T0[res]=get_val_f();
X        for (l=0;l<p;l++)
X          Tres[l]=0;
X	break;
X      case assign_ind: /* assign an adouble variable an independent 
X                          float value (<<=) */
X        res = get_locint_f();
X	Tres = T[res];
X        T0[res]=basepoint[indexi];
X        for (l=0;l<p;l++)
X	  Tres[l]=argument[indexi][l];
X	++indexi;
X	break;
X      case assign_dep: /* assign a float variable a 
X                          dependent adouble value. (>>=) */
X	res = get_locint_f();
X	Tres = T[res];
X        valuepoint[indexd]=T0[res];
X        if (taylors != 0 )  
X        {
X          for (l=0;l<p;l++)
X	    taylors[indexd][l] = Tres[l];
X        } /* endif */
X	indexd++;
X	break;
X      case eq_plus_d: /* Add a floating point to an adouble. (+=) */
X        T0[get_locint_f()]+= get_val_f();
X	break;
X      case eq_plus_a: /* Add an adouble to another adouble. (+=) */
X        arg=get_locint_f();
X        res=get_locint_f();
X	Tres = T[res];
X	Targ = T[arg];
X        T0[res]+= T0[arg];
X        for (l=0;l<p;l++)
X	  Tres[l]+=Targ[l];
X	break;
X      case eq_min_d: /* Subtract a floating point from an adouble. (-=) */
X	T0[get_locint_f()]-= get_val_f();
X	break;
X      case eq_min_a: /* Subtract an adouble from another adouble. (-=) */
X        arg=get_locint_f();
X        res=get_locint_f();
X	Tres = T[res];
X	Targ = T[arg];   
X        T0[res]-=T0[arg];
X        for (l=0;l<p;l++)
X	  Tres[l]-=Targ[l];
X	break;
X      case eq_mult_d:  /* Multiply an adouble by a float. (*=) */
X        res=get_locint_f();
X        coval = get_val_f();
X	Tres = T[res];
X        T0[res]*=coval;
X        for (l=0;l<p;l++)
X	  Tres[l]*=coval;
X	break;
X      case eq_mult_a: /* Multiply one adouble by another. (*=) */
X        arg=get_locint_f();
X        res=get_locint_f();
X	Tres = T[res];
X	Targ = T[arg];
X        for( l = 0; l < p; l++)
X          Tres[l]=T0[res]*Targ[l]+Tres[l]*T0[arg];
X        T0[res]*=T0[arg];
X	break;
X      case plus_a_a: /* Add two adoubles. (+) */
X        arg1=get_locint_f();
X        arg2=get_locint_f();
X        res =get_locint_f();
X	Tres = T[res];
X	Targ1 = T[arg1];
X	Targ2 = T[arg2];
X        T0[res]=T0[arg1]+T0[arg2];
X        for( l = 0; l < p; l++)
X	  Tres[l]=Targ1[l]+Targ2[l];
X	break;
X      case plus_d_a: /* Add an adouble and a double. (+) */
X        arg=get_locint_f();
X        res = get_locint_f();
X	Tres = T[res];
X	Targ = T[arg];
X	T0[res]=T0[arg]+get_val_f();
X        for( l = 0; l < p; l++)
X	  Tres[l]=Targ[l];
X	break;
X      case min_a_a: /* Subtraction of two adoubles. (-) */
X        arg1=get_locint_f();
X        arg2=get_locint_f();
X        res =get_locint_f();
X	Tres = T[res];
X	Targ1 = T[arg1];
X	Targ2 = T[arg2];
X        T0[res]=T0[arg1]-T0[arg2];
X        for( l = 0; l < p; l++)
X          Tres[l]=Targ1[l]-Targ2[l];
X	break;
X      case min_d_a: /* Subtract an adouble from a double. (-) */
X        arg=get_locint_f();
X        res = get_locint_f();
X        Tres = T[res];
X        Targ = T[arg];
X	T0[res]=get_val_f()-T0[arg];
X        for( l = 0; l < p; l++)
X	  Tres[l] = -Targ[l];
X	break;
X      case mult_a_a: /* Multiply two adoubles. (*) */
X        arg1=get_locint_f();
X        arg2=get_locint_f();
X        res =get_locint_f();
X        Tres = T[res];
X        Targ1 = T[arg1];
X        Targ2 = T[arg2];
X        T0[res]=T0[arg1]*T0[arg2];
X        for( l = 0; l < p; l++)
X          Tres[l]=T0[arg1]*Targ2[l]+Targ1[l]*T0[arg2];
X	break;
X      case mult_d_a: /* Multiply an adouble by a double. (*) */
X        arg=get_locint_f();
X        res = get_locint_f();
X        coval = get_val_f();
X        Tres = T[res];
X        Targ = T[arg];
X        T0[res]=T0[arg]*coval;
X        for( l = 0; l < p; l++)
X	  Tres[l]=Targ[l]*coval;
X	break;
X      case div_a_a: /* Divide an adouble by an adouble. (/) */
X        arg1=get_locint_f();
X        arg2=get_locint_f();
X        res =get_locint_f();
X        Tres = T[res];
X        Targ1 = T[arg1];
X        Targ2 = T[arg2];
X	divs   = 1/T0[arg2];
X        T0[res]=T0[arg1]*divs;
X        for( l = 0; l < p; l++)
X	  Tres[l]=Targ1[l]*divs+T0[res]*(-Targ2[l]*divs);
X	break;
X      case div_d_a: /* Division double - adouble. (/) */
X        arg=get_locint_f();
X        res = get_locint_f();
X        Tres = T[res];
X        Targ = T[arg];
X	divs = 1/T0[arg];
X	T0[res]=get_val_f()*divs;
X        for( l = 0; l < p; l++)
X	  Tres[l]=T0[res]*(-Targ[l]*divs);
X	break;
X      case sqrt_op: /* Compute sqrt of adouble. */
X        arg=get_locint_f();
X        res= get_locint_f();
X        Targ = T[arg];
X	Tres = T[res];
X	T0[res]=sqrt(T0[arg]);
X        for( l = 0; l < p; l++){
X          if (T0[arg]==0.0){
X#ifdef inf_num
X  InfVal=i_num/i_den;
X  NoNum=n_num/n_den;
X#endif
X            if (Targ[l]>0.0)
X              r0=InfVal;
X            else if (Targ[l]<0.0) 
X              r0=NoNum;
X            else
X              r0=0.0;
X          } /* end if */
X          else {
X            r0 = 0.5/T0[res];
X          } /* end else */
X	  Tres[l]=r0*Targ[l];
X        } /* end for */
X	break;
X      case abs_val: /* Compute fabs of adouble. */
X        arg=get_locint_f();
X        res= get_locint_f();
X        Targ = T[arg];
X        Tres = T[res];
X        T0[res]=fabs(T0[arg]);
X        for( l = 0; l < p; l++)
X          if (T0[arg]<0.0)
X            Tres[l]= -Targ[l];
X          else if(T0[arg]>0.0)
X            Tres[l]=Targ[l];
X          else
X            Tres[l]= fabs(Targ[l]);
X        break;
X
X      case exp_op: /* exponent operation */
X        arg=get_locint_f();
X        res= get_locint_f();
X	Tres = T[res];
X	Targ = T[arg];
X	T0[res]=exp(T0[arg]);
X        for( l = 0; l < p; l++)
X	  Tres[l]=T0[res]*Targ[l];
X	break;
X      case sin_op: /* sine operation */
X        arg1 = get_locint_f();
X        arg2 = get_locint_f();
X        res = get_locint_f();
X        coval = get_val_f();
X	Targ = T[arg2];
X	Tres = T[res]; 
X	Tqo = T[arg1];
X	T0[arg2]=cos(T0[arg1]);
X	T0[res] = sin(T0[arg1]);
X        for( l = 0; l < p; l++)
X	{
X	    Targ[l] = -(T0[res]*Tqo[l]);
X	    Tres[l]=T0[arg2]*Tqo[l];
X        } /* endfor */
X	break;
X      case cos_op:  /* cosine operation */
X        arg1 = get_locint_f();
X        arg2 = get_locint_f();
X        res = get_locint_f();
X        coval = get_val_f();
X	Targ = T[arg2];
X	Tres = T[res];
X	Tqo = T[arg1];
X        T0[arg2]=sin(T0[arg1]);
X        T0[res] = cos(T0[arg1]);
X        for( l = 0; l < p; l++)
X        {
X	  Targ[l] = T0[res]*Tqo[l];
X	  Tres[l] = -(T0[arg2]*Tqo[l]);
X        } /* endfor */
X	break;
X      case asin_op: 
X        arg1 = get_locint_f();
X        arg2 = get_locint_f();
X        res = get_locint_f();
X        coval = get_val_f();
X        Targ = T[arg2];
X        Tres = T[res];
X        Tqo = T[arg1];
X	T0[res]=asin(T0[arg1]);
X        for( l = 0; l < p; l++)
X	  Tres[l]=T0[arg2]*Tqo[l];
X	break;
X      case acos_op:
X        arg1 = get_locint_f();
X        arg2 = get_locint_f();
X        res = get_locint_f();
X        coval = get_val_f();
X        Targ = T[arg2];
X        Tres = T[res];
X        Tqo = T[arg1];
X	T0[res]=acos(T0[arg1]);
X        for( l = 0; l < p; l++)
X	  Tres[l]=T0[arg2]*Tqo[l];
X	break;
X      case atan_op:
X        arg1 = get_locint_f();
X        arg2 = get_locint_f();
X        res = get_locint_f();
X        coval = get_val_f();
X        Targ = T[arg2];
X        Tres = T[res];
X        Tqo = T[arg1];
X	T0[res]=atan(T0[arg1]);
X        for( l = 0; l < p; l++)
X	  Tres[l]=T0[arg2]*Tqo[l];
X	break;
X      case gen_quad:  
X        arg1 = get_locint_f();
X        arg2 = get_locint_f();
X        res = get_locint_f();
X        coval = get_val_f();
X        Targ = T[arg2];
X        Tres = T[res];
X        Tqo = T[arg1];
X	T0[res]=coval;
X        for( l = 0; l < p; l++)
X	  Tres[l]=T0[arg2]*Tqo[l];
X	break;
X      case log_op:
X        arg=get_locint_f();
X        res= get_locint_f();
X	Tres = T[res];
X	Targ = T[arg];
X	divs = 1.0/T0[arg];
X	T0[res]=log(T0[arg]);
X        for( l = 0; l < p; l++)
X	  Tres[l]=Targ[l]*divs;
X	break;
X      case pow_op:
X        arg=get_locint_f();
X        res = get_locint_f();
X        coval = get_val_f();
X	Tres = T[res];
X	Targ = T[arg];
X	T0[res] = pow(T0[arg],coval);
X        for( l = 0; l < p; l++){
X          if (T0[arg]==0.0){
X#ifdef inf_num
X  InfVal=i_num/i_den;
X  NoNum=n_num/n_den;
X#endif
X            if (Targ[l]>0.0)
X              r0=InfVal;
X            else if (Targ[l]<0.0)
X              r0=NoNum;
X            else
X              r0=0.0;
X          } /* end if */
X          else {
X            r0 = 1.0/T0[arg];
X          } /* end else */
X          Tres[l] = T0[res]*Targ[l]*coval*r0;
X        } /* end for */
X	break;
X
X      
X      case int_av_av:
X        loc1_v = get_locint_f();
X        size = get_locint_f();
X        result_v= get_locint_f();
X        for (l=0;l<size;l++)
X        {
X          res = result_v + l;   /* Location of left-hand-side  */
X          arg = loc1_v + l;   /* Location of right-hand-side */
X          Targ = T[arg];
X          Tres = T[res];
X          T0[res]= T0[arg];
X          for (pl=0;pl<p;pl++)
X            Tres[pl]=Targ[pl];
X        } /* endfor */
X        break;
X      case assign_dv:
X        size = get_locint_f();
X        loc1_v = get_locint_f();
X        d = get_val_v_f(size);
X        for (l=0;l<size;l++)
X        {
X            res = loc1_v + l;           /* Location of left-hand-side */
X            Tres = T[res];
X            T0[res]=d[l];   
X            for (pl=0;pl<p;pl++)
X	      Tres[pl]=0;
X        } /* endfor */
X        break;
X      case assign_av:
X        loc2_v = get_locint_f();
X        size = get_locint_f();
X        loc1_v = get_locint_f();
X        for (l=0;l<size;l++)
X        {
X          res = loc1_v + l;             /* Location of the left-hand-side  */
X          arg = loc2_v + l;             /* Location of the right-hand-side */
X          Targ = T[arg];
X          Tres = T[res];
X          T0[res]=T0[arg];
X          for (pl=0;pl<p;pl++)
X            Tres[pl]=Targ[pl];
X        } /* endfor */
X        break;
X      case assign_indvec:
X        size = get_locint_f();
X        loc1_v = get_locint_f();
X        for (l=0;l<size;l++)
X        {
X          res = loc1_v + l;             /* Location of the left-hand-side */
X          Tres = T[res];
X          T0[res]=basepoint[indexi];
X          for (pl=0;pl<p;pl++)
X            Tres[pl]=argument[indexi][pl];
X          ++indexi;
X        } /* endfor */
X        break;
X      case assign_depvec:
X        size = get_locint_f();
X        loc1_v = get_locint_f();
X        for (l=0;l<size;l++)
X        {
X          res = loc1_v + l;             /* Location of the left-hand-side */
X          Tres = T[res];
X          valuepoint[indexd]=T0[res];
X          if (taylors != 0 )  
X          {
X            for (pl=0;pl<p;pl++)
X	      taylors[indexd][pl] = Tres[pl];
X          } /* endif */
X          indexd++;
X        } /* endfor */
X        break;
X      case eq_min_av:
X        loc1_v = get_locint_f();
X        size = get_locint_f();
X        result_v = get_locint_f();
X        for (l=0;l<size;l++)
X        {
X          res = result_v + l;            /* Location of the left-hand-side  */
X          arg = loc1_v + l;            /* Location on the right-hand-side */
X          Tres = T[res];
X          Targ = T[arg];
X          T0[res]-=T0[arg];
X          for (pl=0;pl<p;pl++)
X            Tres[pl] -= Targ[pl];
X        } /* endfor */
X        break;
X      case eq_plus_av:
X        loc1_v = get_locint_f();
X        size = get_locint_f();
X        result_v = get_locint_f();
X        for (l=0;l<size;l++)
X        {
X          res = result_v + l;            /* Location of the left-hand-side  */
X          arg = loc1_v   + l;            /* Location on the right-hand-side */
X          Tres = T[res];
X          Targ = T[arg];
X          T0[res]+= T0[arg];
X          for (pl=0;pl<p;pl++)
X            Tres[pl]+=Targ[pl];
X        } /* endfor */
X        break;
X      case eq_mult_av_a:
X        arg = get_locint_f();
X        size = get_locint_f();
X        result_v = get_locint_f();
X        for (l=0;l<size;l++)
X        {
X          res = result_v + l;      /* Location of the left-hand-side  */
X          Tres = T[res];
X          Targ = T[arg];
X          for (pl=0;pl<p;pl++)
X	    Tres[pl]=T0[res]*Targ[pl]+Tres[pl]*T0[arg];
X          T0[res]*=T0[arg]; 
X        } /* endfor */
X        break;
X      case eq_mult_av_d:
X        size = get_locint_f();
X        result_v = get_locint_f();
X        coval = get_val_f();
X        for (l=0;l<size;l++)
X        {
X          res = result_v + l;      /* Location of the left-hand-side  */
X          Tres = T[res];
X          T0[res]*=coval;
X          for (pl=0;pl<p;pl++)
X            Tres[pl]*=coval;
X        } /* endfor */
X        break;
X      case plus_av_av:
X        loc1_v   = get_locint_f();
X        loc2_v   = get_locint_f();
X        size     = get_locint_f();
X        result_v = get_locint_f();
X        for (l=0;l<size;l++)
X        {
X          arg2   = loc2_v    + l;       /* Location of var 2  */
X          arg1   = loc1_v    + l;       /* Location of var 1  */
X          res = result_v  + l;       /* Location of result */
X          Tres = T[res];
X          Targ1 = T[arg1];
X          Targ2 = T[arg2];
X          T0[res]=T0[arg1]+T0[arg2];
X          for (pl=0;pl<p;pl++)
X            Tres[pl]=Targ1[pl]+Targ2[pl];
X        } /* endfor */
X        break;
X      case sub_av_av:
X        loc1_v   = get_locint_f();
X        loc2_v   = get_locint_f();
X        size     = get_locint_f();
X        result_v = get_locint_f();
X        for (l=0;l<size;l++)
X        {
X          arg2   = loc2_v    + l;       /* Location of var 2  */
X          arg1   = loc1_v    + l;       /* Location of var 1  */
X          res = result_v  + l;       /* Location of result */
X          Tres = T[res];
X          Targ1 = T[arg1];
X          Targ2 = T[arg2];
X          T0[res]=T0[arg1]-T0[arg2];
X          for (pl=0;pl<p;pl++)
X	    Tres[pl]=Targ1[pl]-Targ2[pl];
X        } /* endfor */
X        break;
X      case dot_av_av:
X        loc1_v   = get_locint_f();
X        loc2_v   = get_locint_f();
X        size     = get_locint_f();
X        res = get_locint_f();
X        Tres = T[res];
X        T0[res]=0;
X        for (pl=0;pl<p;pl++)
X          Tres[pl]=0.0;
X        for (l=0;l<size;l++)
X        {
X          arg2 = loc2_v + l;
X          arg1 = loc1_v + l;
X          Targ1 = T[arg1];
X          Targ2 = T[arg2];
X          Tres = T[res];
X          T0[res]+=T0[arg1]*T0[arg2];
X          for (pl=0;pl<p;pl++)
X	    Tres[pl]+=T0[arg1]*Targ2[pl]+Targ1[pl]*T0[arg2];
X        } /* endfor */
X        break;
X      case mult_d_av:
X        loc1_v = get_locint_f();
X        size = get_locint_f();
X        result_v = get_locint_f();
X        coval =get_val_f();
X        for (l=0;l<size;l++)
X        {
X          arg = loc1_v   + l;   /* Location on the right-hand-side */
X          res = result_v + l;   /* location of the result */
X          Tres = T[res];
X          Targ = T[arg];
X          T0[res]=T0[arg]*coval;
X          for (pl=0;pl<p;pl++)
X            Tres[pl]=Targ[pl]*coval;
X        } /* endfor */
X        break;
X      case div_av_a:
X        loc1_v   = get_locint_f();
X        arg2     = get_locint_f();
X        size     = get_locint_f();
X        result_v = get_locint_f();
X        for (l=0;l<size;l++)
X        {
X          arg1 = loc1_v   + l;  /* Location of the right-hand-side vector */
X          res = result_v + l;  /* Location of the result */
X          /* code for div_a_a */
X          Tres = T[res];
X          Targ1 = T[arg1];
X          Targ2 = T[arg2];
X          divs   = 1/T0[arg2];
X          T0[res]=T0[arg1]*divs;
X          for (pl=0;pl<p;pl++)
X	    Tres[pl]=(Targ1[pl]-T0[res]*Targ2[pl])*divs;
X        } /* endfor */
X        break;
X      case mult_av_a:
X        loc1_v   = get_locint_f();
X        arg2     = get_locint_f();
X        size     = get_locint_f();
X        result_v = get_locint_f();
X        for (l=0;l<size;l++)
X         {
X          arg1 = loc1_v   + l; /* Location of the right-hand-side vector */
X          res = result_v + l; /* Location of the result */
X          Tres = T[res];
X          Targ1 = T[arg1];
X          Targ2 = T[arg2];
X          T0[res]=T0[arg1]*T0[arg2];
X          for (pl=0;pl<p;pl++)
X	    Tres[pl]=T0[arg1]*Targ2[pl]+Targ1[pl]*T0[arg2];
X        } /* endfor */
X        break;
X      case mult_a_av:
X        loc1_v   = get_locint_f();
X        arg1     = get_locint_f();
X        size     = get_locint_f();
X        result_v = get_locint_f();
X        for (l=0;l<size;l++)
X        {
X          arg2= loc1_v+l;   /* Location of right hand side vector */
X          res = result_v + l; /* Location of the result */
X          Tres = T[res];
X          Targ1 = T[arg1];
X          Targ2 = T[arg2];
X          T0[res]=T0[arg1]*T0[arg2];
X          for (pl=0;pl<p;pl++)
X            Tres[pl]=T0[arg1]*Targ2[pl]+Targ1[pl]*T0[arg2];
X        } /* endfor */
X        break;
X
X#ifdef conditional
X      case cond_assign:
X        arg = get_locint_f();
X        loc1 = get_locint_f();
X        loc2 = get_locint_f();
X        res = get_locint_f();
X        Tres = T[res];
X        Targ = T[arg];
X        Tloc1 = T[loc1];
X        Tloc2 = T[loc2];
X        if (T0[arg]>0)
X        {
X          T0[res]=T0[loc1];
X	  for( l = 0; l < p; l++)
X	    Tres[l]=Tloc1[l];
X        } /* endif */
X        else
X        {
X          T0[res]=T0[loc2];
X	  for( l = 0; l < p; l++)
X	    Tres[l]=Tloc2[l];
X        } /* endelse */
X        break;
X      case cond_assign_s:
X        arg = get_locint_f();
X        loc1 = get_locint_f();
X        res = get_locint_f();
X        Tres = T[res];
X        Targ = T[arg];
X        Tloc1 = T[loc1];
X        if (T0[arg]>0)
X	{
X          T0[res]=T0[loc1];
X	  for(l = 0; l < p; l++)
X	    Tres[l]=Tloc1[l];
X        } /* endif */
X        break;
X      case subscript:
X        loc1_v=get_locint_f();  /* Base */
X        loc1=get_locint_f();/* pointer to the variable containing the offset */
X        res=get_locint_f();
X        Tres=T[res];
X        arg=loc1_v+(int)(T0[loc1]);
X        Targ = T[arg];
X        T0[res]=T0[arg];
X        for( l = 0; l < p; l++)
X          Tres[l]=Targ[l];
X        break;
X      case subscript_l:
X        loc1_v=get_locint_f();  /* Base */
X	loc1=get_locint_f();
X        arg=loc1_v+(int)(T0[loc1]);
X        res=get_locint_f();
X        Tres = T[res];
X        Targ = T[arg];
X        T0[arg]=T0[res];
X        for( l = 0; l < p; l++)
X          Targ[l]=Tres[l];
X        break;
X      case subscript_ld:
X        loc1_v=get_locint_f();  /* Base */
X        loc1=get_locint_f();  /* pointer to the variable containing the offset */
X        res = loc1_v+(int)(T0[loc1]);
X        Tres = T[res];
X        T0[res]=get_val_f();
X        for( l = 0; l < p; l++)
X          Tres[l]=0;
X        break;
X      case m_subscript:
X        loc1_v=get_locint_f();  /* Base */
X        loc1=get_locint_f();/* pointer to the variable containing the offset */
X        size=get_locint_f();
X        result=get_locint_f();
X        for (l=0;l<size;l++)
X        {
X          res=result+l;
X          Tres=T[res];
X          arg=loc1_v+(int)(T0[loc1])*size+l;
X          Targ = T[arg];
X          T0[res]=T0[arg];
X          for(pl=0;pl<p;pl++)
X            Tres[pl]=Targ[pl];
X        } /* endfor */
X        break;
X      case m_subscript_l:
X        loc1_v=get_locint_f();  /* Base */
X	loc1=get_locint_f();
X        size=get_locint_f();
X        arg=get_locint_f(); /* RHS */
X        for (l=0;l<size;l++)
X        {
X          res=loc1_v+(int)(T0[loc1])*size+l;
X          Tres = T[res];
X          Targ = T[arg+l];
X          T0[res]=T0[arg+l];
X          for(pl=0;pl<p;pl++)
X            Tres[pl]=Targ[pl];
X        } /* endfor */
X        break;
X      case m_subscript_ld:
X        loc1_v=get_locint_f();  /* Base */
X        loc1=get_locint_f();  /* pointer to the variable containing the offset */
X        loc2=get_locint_f(); /* offset in the vector itself */
X        size=get_locint_f();
X        d = get_val_v_f(size);
X        for (l=0;l<size;l++)
X        {
X          res = loc1_v+(int)(T0[loc1])*size+l+loc2;
X          Tres = T[res];
X          T0[res]=d[l];
X          for(pl=0;pl<p;pl++)
X            Tres[pl]=0;
X        } /* endfor */
X        break;
X#endif
X
X      case death_not:
X        loc1=get_locint_f();
X        loc1=get_locint_f();
X  	break;
X      default:
X	/* Die here, we screwed up */
X	printf("ADOL-C error: Fatal error in fov_forward for op %d\n",operation);
X	break;
X	
X      } /* endswitch */
X      operation=get_op_f();
X    }  /* endwhile */
X  end_sweep();
X} /* end fov_forward */
X
X
X
X#ifdef __cplusplus
X}
X#endif
X
END_OF_FILE
if test 24111 -ne `wc -c <'fov_forward.c'`; then
    echo shar: \"'fov_forward.c'\" unpacked with wrong size!
fi
chmod +x 'fov_forward.c'
# end of 'fov_forward.c'
fi
if test -f 'fov_reverse.c' -a "${1}" != "-c" ; then 
  echo shar: Will not clobber existing file \"'fov_reverse.c'\"
else
echo shar: Extracting \"'fov_reverse.c'\" \(23970 characters\)
sed "s/^X//" >'fov_reverse.c' <<'END_OF_FILE'
X/*
X   ----------------------------------------------------------------
X   File fov_reverse.c of ADOL-C version 1.6 as of January 1,   1995
X   ----------------------------------------------------------------
X   Contains the routine fov_reverse (first-order-vector reverse 
X   mode).
X
X*/
X
X
X#ifdef __cplusplus
Xextern "C" {
X#endif
X
X/* 
X  There are four basic versions of the procedure `reverse', which
X  are optimized for the cases of scalar or vector reverse sweeps
X  with first or higher derivatives, respectively. In the calling
X  sequence this distinction is apparent from the type of the
X  parameters `lagrange' and `results'. The former may be left out
X  and the integer parameters `depen', `indep', `degre', and `nrows'
X  must be set or default according to the following matrix of
X  calling cases. 
X
X           no lagrange         double* lagrange     double** lagrange
X
Xdouble*   gradient of scalar   weight vector times    infeasible 
Xresults   valued function      Jacobian product       combination
X
X          ( depen = 1 ,         ( depen > 0 ,         
X	    degre = 0 ,           degre = 0 ,              ------
X	    nrows = 1 )           nrows = 1 )
X
Xdouble**  Jacobian of vector   weight vector times     weight matrix
Xresults   valued function      Taylor-Jacobians        times Jacobian
X           
X	  ( 0 < depen           ( depen > 0 ,          ( depen > 0 ,
X	      = nrows ,           degre > 0 ,            degre = 0 ,
X	    degre = 0 )           nrows = 1 )            nrows > 0 )
X
Xdouble*** full family of         ------------          weigth matrix x
Xresults   Taylor-Jacobians       ------------          Taylor Jacobians
X
X
X*/ 
X
X#include "dvlparms.h" /* Developers Parameters */
X
X/* Necessary Includes */
X
X#include "usrparms.h"
X#include "oplate.h"
X#include "taputil1.h"
X#include "taputil2.h"
X#include "taputil3.h"
X#include "tayutil.h"
X
X/* Static Locals */
X
Xstatic short tag;
Xstatic int p,pd;
X
X/* External memory management routines from driversc.c */
X 
Xdouble** myalloc2(int, int);
Xdouble*** myalloc3(int, int, int);
X
X/****************************************************************************/
X/* First-Order Vector Reverse Pass.                                         */
X/****************************************************************************/
X
Xvoid fov_reverse(short tnum,         /* tape id */
X		 int depen,          /* consistency chk on # of dependents */
X		 int indep,          /* consistency chk on # of independents */
X		 int nrows,          /* # of Jacobian rows being calculated */
X		 double **lagrange,  /* domain weight vector */
X		 double **results)   /* matrix of coefficient vectors */
X{   
X  unsigned char operation;
X  int tape_stats[11];  /* tape stats */
X
X  locint result=0;
X  locint arg=0;
X  locint res=0;
X  locint loc1=0;
X  locint loc2=0;
X  double stored_val=0.0;
X  locint result_v=0;
X  locint loc1_v=0;
X  locint loc2_v=0;
X  double *d=0;
X  locint size =0;
X
X  static int rax,pax;
X  static double** A;
X  static revreal* Trs;
X  int i,l;
X  double r0,r_0;
X  int indexi;
X  int indexd;
X  int rev_location_cnt;
X  int dep_cnt;
X  int indep_cnt;
X  int buffer;
X  int taycheck;
X  int degre = 0;
X  int numdep,numind;
X  static revreal *A1, *A2, *Ares, Tr1, Tr2, Tres;
X  static revreal *Atemp, *Atemp2;
X
X  tag = tnum;   /*tag is global which indicates which tape to look at */
X    pd = nrows;
X  
X  tapestats(tag,tape_stats);
X  indep_cnt = tape_stats[0];
X  dep_cnt = tape_stats[1];
X  rev_location_cnt = tape_stats[2];
X  buffer =  tape_stats[4];
X  
X  set_buf_size(buffer);
X
X  if ((depen != dep_cnt)||(indep != indep_cnt))
X    {
X      printf("ADOL-C error: reverse sweep on tape %d  aborted!\n",tag);
X      printf("Number of dependent and/or independent variables passed");
X      printf(" to reverse is\ninconsistant with number ");
X      printf("recorded on tape  %d \n",tag);
X      exit (-1);
X    }
X  
X  indexi = indep_cnt - 1;
X  indexd = dep_cnt - 1;
X  
X  
X  if (rev_location_cnt compsize  rax || pd compsize pax)
X    {
X      if(pax)
X	{
X	  /* delete Atemp;
X	     delete Atemp2;
X	     delete Trs; */
X	  free((char *)Atemp);
X	  free((char *)Atemp2);
X	  free((char *)Trs);
X	  free((char*) *A); free((char*) A);
X	}
X      /* Atemp = new revreal[pd];
X         Atemp2 = new revreal[pd];
X         Trs = new revreal[rev_location_cnt]; */
X      Atemp = (revreal *)malloc(sizeof(revreal)*pd);
X      Atemp2 = (revreal *)malloc(sizeof(revreal)*pd);
X      Trs = (revreal *)malloc(sizeof(revreal)*rev_location_cnt);
X
X      A = myalloc2(rev_location_cnt,pd);
X      rax = rev_location_cnt;
X      pax = pd;
X    }
X  taylor_back(Trs,&numdep,&numind,&taycheck);
X  
X  if(taycheck != degre)   
X    {
X      printf("\n ADOL-C error: reverse fails because it was not preceeded \n");
X      printf("by a forward sweep with degree %d !!!!!\n",degre);
X      exit(-2);
X    };
X  
X  if((numdep != depen)||(numind != indep))
X    {
X      printf("\n ADOL-C error: reverse fails on tape %d because the number of\n",tag);
X      printf("independent and/or dependent variables given to reverse are\n");
X      printf("inconsistant with that of the internal taylor array.\n");
X      exit(-2);
X    }
X  
X  
X  /* Set up the tape */
X
X  init_rev_sweep(tag); 
X
X  /* Get the last operation */
X
X  operation=get_op_r();
X  
X  while (operation != start_of_tape) 
X    {
X      
X      /* Switch statement to execute the operations (in reverse) */
X      
X      switch (operation) 
X	{
X	  /* Markers */
X	  
X       	case end_of_int:
X        get_loc_block_r(); /* Get the next int block */
X        break;
X	case end_of_val:
X        get_val_block_r(); /* Get the next val block */
X        break;
X	case end_of_op:
X        get_op_block_r();
X        operation = get_op_r();/* Skip next operation, it's another end_of_op */
X        break;
X	case start_of_tape:
X	case end_of_tape:
X	  break;
X	  
X	  /* Scalar Operations */
X	  
X	case int_adb_a:
X        loc1 = get_locint_r();
X        loc2 = get_locint_r();
X	  /*get_taylor(loc1); */
X	  A1 = A[loc2];
X	  Ares = A[loc1];
X	  for (p=0;p<pd;p++)
X	    {
X	      *A1++ += *Ares;
X	      *Ares++  = 0;
X	    }
X	  break;
X	case assign_a:
X        loc1 = get_locint_r();
X        loc2 = get_locint_r();
X	  get_taylor(loc1);
X	  A1 = A[loc2];
X	  Ares = A[loc1];
X	  for (p=0;p<pd;p++)
X	    {
X	      *A1++ += *Ares;
X	      *Ares++  = 0;
X	    }
X	  break;
X	  
X	case int_adb_d:
X        loc1 = get_locint_r();
X        stored_val = get_val_r();
X	  Ares = A[loc1];
X	  for (p=0;p<pd;p++)
X	    *Ares++ = 0.0;
X	  break;
X	  
X	case assign_d:
X        loc1 = get_locint_r();
X        stored_val = get_val_r();
X	  Ares = A[loc1];
X	  for (p=0;p<pd;p++)
X	    *Ares++ = 0.0;
X	  get_taylor(loc1);
X	  break;
X	  
X	case assign_ind:
X        loc1 = get_locint_r();
X	  get_taylor(loc1);
X	  Ares = A[loc1];
X	  for (p=0;p<pd;p++)
X	    results[p][indexi] = *Ares++; 
X	  indexi--;
X	  break;
X	  
X	case assign_dep:
X        loc1 = get_locint_r();
X	  Ares = A[loc1];
X	  for (p=0;p<pd;p++)
X	    *Ares++ = lagrange[p][indexd];
X	  indexd--;
X	  break;
X	  
X	case eq_plus_d:
X        result=get_locint_r();
X        stored_val = get_val_r();
X	  get_taylor(result);
X	  break;
X	  
X	case eq_plus_a: 
X        result=get_locint_r();
X        loc1=get_locint_r();
X	  get_taylor(result);
X	  Ares=A[result];
X	  A1=A[loc1];
X	  for (p=0;p<pd;p++)
X	    *A1++ += *Ares++;
X	  break;
X	  
X	case eq_min_d:
X        result=get_locint_r();
X        stored_val = get_val_r();
X	  get_taylor(result);
X	  break;
X	  
X	case eq_min_a: 
X        result=get_locint_r();
X        loc1=get_locint_r();
X	  get_taylor(result);
X	  Ares=A[result];
X	  A1=A[loc1];
X	  for (p=0;p<pd;p++)
X	    *A1++ -= *Ares++;
X	  break;
X	  
X	case eq_mult_d:
X        result=get_locint_r();
X        stored_val = get_val_r();
X	  get_taylor(result);
X	  Ares = A[result];
X	  for (p=0;p<pd;p++)
X	    *Ares++  *= stored_val;
X	  break;
X	  
X	case eq_mult_a:
X        result=get_locint_r();
X        loc1=get_locint_r();
X	  get_taylor(result);
X	  Tr1 = Trs[loc1];
X	  Tres = Trs[result];
X	  A1 = A[loc1];
X	  Ares = A[result];
X	  for (p=0;p<pd;p++)
X	    {
X	      r0 = *Ares;
X	      *Ares = 0;
X	      *A1++ += r0*Tres; 
X	      *Ares++ += r0*Tr1; 
X	    }
X	  break;
X	  
X	case plus_a_a:
X        result =get_locint_r();
X        loc2=get_locint_r();
X        loc1=get_locint_r();
X	  Ares = A[result];
X	  A1 = A[loc1];
X	  A2 = A[loc2];
X	  for (p=0;p<pd;p++)
X	    {
X	      *A1++ += *Ares;
X	      *A2++ += *Ares++;
X	    }
X	  break;
X	      
X	case plus_d_a:
X        result = get_locint_r();
X        loc1=get_locint_r();
X        stored_val = get_val_r();
X	  Ares = A[result];
X	  A1 = A[loc1];
X	  for (p=0;p<pd;p++)
X	    *A1++ += *Ares++;
X	  break;
X	  
X	case min_a_a:
X        result =get_locint_r();
X        loc2=get_locint_r();
X        loc1=get_locint_r();
X	  Ares = A[result];
X	  A1 = A[loc1];
X	  A2 = A[loc2];
X	  for (p=0;p<pd;p++)
X	    {
X	      *A1++ += *Ares;
X	      *A2++ -= *Ares++;
X	    }
X	  break;
X	      
X	case min_d_a:
X        result = get_locint_r();
X        loc1=get_locint_r();
X        stored_val = get_val_r();
X	  Ares = A[result];
X	  A1 = A[loc1];
X	  for (p=0;p<pd;p++)
X	    *A1++ -= *Ares++;
X	  break;
X	  
X	case mult_a_a:
X        result =get_locint_r();
X        loc2=get_locint_r();
X        loc1=get_locint_r();
X	  Tr1 = Trs[loc1];
X	  Tr2 = Trs[loc2];
X	  Ares = A[result];
X	  A2 = A[loc2];
X	  A1 = A[loc1];
X	  for (p=0;p<pd;p++)
X	    {
X	      *A2++ += *Ares*Tr1;
X	      *A1++ += (*Ares++)*Tr2;
X	    }
X	  break;
X	  
X	case mult_d_a:
X        result = get_locint_r();
X        loc1=get_locint_r();
X        stored_val = get_val_r();
X	  Ares = A[result];
X	  A1= A[loc1];
X	  for (p=0;p<pd;p++)
X	    *A1++ += stored_val* (*Ares++);
X	  break;
X	  
X	case div_a_a:
X        result =get_locint_r();
X        loc2=get_locint_r();
X        loc1=get_locint_r();
X	  Tr2 = Trs[loc2];
X	  Tres = Trs[result];
X	  r0=1/Tr2;
X	  r_0=-r0*Tres;
X	  Ares = A[result];
X	  A2 = A[loc2];
X	  A1 = A[loc1];
X	  for (p=0;p<pd;p++)
X	    {
X	      *A1++ += *Ares*r0;
X	      *A2++ += (*Ares++)*r_0;
X	    }
X	  break;
X	  
X	case div_d_a:
X        result = get_locint_r();
X        loc1=get_locint_r();
X        stored_val = get_val_r();
X	  r0= -Trs[result]/Trs[loc1];
X	  Ares = A[result];
X	  A1 = A[loc1];
X	  for (p=0;p<pd;p++)
X	    *A1++ += *Ares++ * r0;
X	  break;
X	  
X	case pow_op:
X        result = get_locint_r();
X        loc1=get_locint_r();
X        stored_val = get_val_r();
X          if (Trs[loc1]==0.0)
X            r0=0.0;
X          else
X	    r0 = stored_val*Trs[result]/Trs[loc1];
X	  Ares = A[result];
X	  A1 = A[loc1];
X	  for (p=0;p<pd;p++)
X	    *A1++ += *Ares++ * r0;
X	  break;
X	  
X	case death_not:
X        loc2 = get_locint_r();
X        loc1 = get_locint_r();
X	  for (i=loc1;i<=loc2;i++)
X	    {
X	      A1 = A[i];
X	      for (p=0;p<pd;p++)
X		*A1++ = 0.0;
X	      get_taylor(i);
X	    }
X	  break;
X	  
X	case exp_op:
X        result = get_locint_r();
X        loc1=get_locint_r();
X	  Tres = Trs[result];
X	  Ares = A[result];
X	  A1 = A[loc1];
X	  for (p=0;p<pd;p++)
X	    *A1++ += *Ares++ * Tres;
X	  break;
X	  
X	case sin_op:
X        result = get_locint_r();
X        loc2 = get_locint_r();
X        loc1 = get_locint_r();
X        stored_val = get_val_r();
X	  Tr2 = Trs[loc2];
X	  Ares = A[result];
X	  A1 = A[loc1];
X	  for (p=0;p<pd;p++)
X	    *A1++ += *Ares++ * Tr2;
X	  break;
X	  
X	case cos_op:
X        result = get_locint_r();
X        loc2 = get_locint_r();
X        loc1 = get_locint_r();
X        stored_val = get_val_r();
X	  Tr2 = Trs[loc2];
X	  Ares = A[result];
X	  A1 = A[loc1];
X	  for (p=0;p<pd;p++)
X	    *A1++ -= *Ares++ * Tr2;
X	  break;
X	  
X	case sqrt_op:
X        result = get_locint_r();
X        loc1=get_locint_r();
X	  Ares = A[result];
X	  A1 = A[loc1];
X          if (Trs[result]==0.0)
X            r0=0.0;
X          else 
X	    r0 = 0.5/Trs[result];
X	  for (p=0;p<pd;p++)
X	    *A1++ += *Ares++ * r0;
X	  break;
X	  
X        case abs_val:
X        result = get_locint_r();
X        loc1=get_locint_r();
X        Ares = A[result];
X        A1 = A[loc1];
X        if(Trs[loc1]<0.0)
X        {
X          for (p=0;p<pd;p++)
X            *(A1++) -= *(Ares++);
X        }
X        else if (Trs[loc1]>0.0)
X        {
X          for (p=0;p<pd;p++)
X            *(A1++) += *(Ares++);
X        }
X        break;
X
X
X	case asin_op:
X	case acos_op:
X	case atan_op:
X	case gen_quad:
X        result = get_locint_r();
X        loc2 = get_locint_r();
X        loc1 = get_locint_r();
X        stored_val = get_val_r();
X	  Ares = A[result];
X	  A1 = A[loc1];
X	  Tr2 = Trs[loc2];
X	  for (p=0;p<pd;p++)
X	    *A1++ += *Ares++ * Tr2;
X	  break;      
X	  
X	case log_op:
X        result = get_locint_r();
X        loc1=get_locint_r();
X	  Ares = A[result];
X	  A1 = A[loc1];
X	  r0 = 1.0/Trs[loc1];
X	  for (p=0;p<pd;p++)
X	    *A1++ += *Ares++ * r0;
X	  break;
X	  
X	  
X	  /* Vector Operations */
X
X	case int_av_av:
X        result_v= get_locint_r();
X        size = get_locint_r();
X        loc1_v = get_locint_r();
X	  for (l=0;l<size;l++)
X	    {
X	      loc1 = result_v + l;   /* Location of left-hand-side  */
X	      loc2 = loc1_v + l;   /* Location of right-hand-side */
X	      /* code for int_adb_a */
X	      A1 = A[loc2];
X	      Ares = A[loc1];
X	      for (p=0;p<pd;p++)
X		{
X		  *A1++ += *Ares;
X		  *Ares++  = 0;
X		}
X	    }
X	  break;
X	case assign_dv:
X        loc1_v = get_locint_r();
X        size = get_locint_r();
X        d = get_val_v_r(size);
X	  for (l=size-1;l>=0;l--)
X	    {
X	      loc1 = loc1_v + l;           /* Location of left-hand-side */
X	      stored_val = d[l];           /* Value of right-hand-side   */
X	      /* code for assign_d */
X	      Ares = A[loc1];
X	      for (p=0;p<pd;p++)
X		*Ares++ = 0.0;
X	      get_taylor(loc1);
X	    }
X	  break;
X	case assign_av:
X        loc1_v = get_locint_r();
X        size = get_locint_r();
X        loc2_v = get_locint_r();
X	  for (l=size-1;l>=0;l--)
X	    {
X	      loc1 = loc1_v + l;             /* Location of left-hand-side  */
X	      loc2 = loc2_v + l;             /* Location of right-hand-side */
X	      /* code for assign_a */
X	      get_taylor(loc1);
X	      A1 = A[loc2];
X	      Ares = A[loc1];
X	      for (p=0;p<pd;p++)
X		{
X		  *A1++ += *Ares;
X		  *Ares++  = 0;
X		}
X	      
X	    }
X	  break;
X	case assign_indvec:
X        loc1_v = get_locint_r();
X        size = get_locint_r();
X	  for (l=size-1;l>=0;l--)
X	    {
X	      loc1 = loc1_v + l;             /* Location of left-hand-side */
X	      
X	      /* code for assign_ind */
X	      get_taylor(loc1);
X	      Ares = A[loc1];
X	      for (p=0;p<pd;p++)
X		results[p][indexi] = *Ares++; 
X	      indexi--;
X	    }
X	  reset_val_r();
X	  break;
X	case assign_depvec:
X        loc1_v = get_locint_r();
X        size = get_locint_r();
X	  for (l=size-1;l>=0;l--)
X	    {
X	      loc1 = loc1_v + l;             /* Location of left-hand-side */
X	      /* code for assign_dep */
X	      Ares = A[loc1];
X	      for (p=0;p<pd;p++)
X		*Ares++ = lagrange[p][indexd];
X	      indexd--;
X	    }
X	  break;
X	case eq_min_av:
X        result_v = get_locint_r();
X        size = get_locint_r();
X        loc1_v = get_locint_r();
X	  for (l=size-1;l>=0;l--)
X	    {
X	      result = result_v + l;          /* Location of left-hand-side  */
X	      loc1   = loc1_v + l;            /* Location on right-hand-side */
X	      /* code for eq_min_a */ 
X	      get_taylor(result);
X	      Ares=A[result];
X	      A1=A[loc1];
X	      for (p=0;p<pd;p++)
X		*A1++ -= *Ares++;
X	    }
X	  break;
X	case eq_plus_av:
X        result_v = get_locint_r();
X        size = get_locint_r();
X        loc1_v = get_locint_r();
X	  for (l=size-1;l>=0;l--)
X	    {
X	      result = result_v + l;         /* Location of left-hand-side  */
X	      loc1   = loc1_v   + l;         /* Location on right-hand-side */
X	      /* code for eq_plus_a */
X	      get_taylor(result);
X	      Ares=A[result];
X	      A1=A[loc1];
X	      for (p=0;p<pd;p++)
X		*A1++ += *Ares++;
X	    }
X	  break;
X	case eq_mult_av_a:
X        result_v = get_locint_r();
X        size = get_locint_r();
X        loc1 = get_locint_r();
X	  for (l=size-1;l>=0;l--)
X	    {
X	      result = result_v + l;      /* Location of the left-hand-side  */
X	      /* loc1   = fixed;             Location on the right-hand-side */
X	      
X	      /* code for eq_mult_a*/
X	      get_taylor(result);
X	      Tr1 = Trs[loc1];
X	      Tres = Trs[result];
X	      A1 = A[loc1];
X	      Ares = A[result];
X	      for (p=0;p<pd;p++)
X		{
X		  r0 = *Ares;
X		  *Ares = 0;
X		  *A1++ += r0*Tres; 
X		  *Ares++ += r0*Tr1; 
X		}
X	    }
X	  break;
X	case eq_mult_av_d:
X        result_v = get_locint_r();
X        size = get_locint_r();
X        stored_val = get_val_r();
X	  for (l=size-1;l>=0;l--)
X	    {
X	      result = result_v + l;      /* Location of the left-hand-side  */
X	      /* stored_val = fixed;         Location on the right-hand-side */
X	      /* code for eq_mult_d*/
X	      get_taylor(result);
X	      Ares = A[result];
X	      for (p=0;p<pd;p++)
X		*Ares++  *= stored_val;
X	    }
X	  break;
X	case plus_av_av:
X        result_v = get_locint_r();
X        size     = get_locint_r();
X        loc2_v   = get_locint_r();
X        loc1_v   = get_locint_r();
X	  for (l=0;l<size;l++)
X	    {
X	      loc2   = loc2_v    + l;       /* Location of var 2  */
X	      loc1   = loc1_v    + l;       /* Location of var 1  */
X	      result = result_v  + l;       /* Location of result */
X	      /* code for plus_a_a */
X	      Ares = A[result];
X	      A1 = A[loc1];
X	      A2 = A[loc2];
X	      for (p=0;p<pd;p++)
X		{
X		  *A1++ += *Ares;
X		  *A2++ += *Ares++;
X		}
X	      
X	    }
X	  break;
X	case sub_av_av:
X        result_v = get_locint_r();
X        size     = get_locint_r();
X        loc2_v   = get_locint_r();
X        loc1_v   = get_locint_r();
X	  for (l=0;l<size;l++)
X	    {
X	      loc2   = loc2_v    + l;       /* Location of var 2  */
X	      loc1   = loc1_v    + l;       /* Location of var 1  */
X	      result = result_v  + l;       /* Location of result */
X	      /* code for min_a_a */
X	      Ares = A[result];
X	      A1 = A[loc1];
X	      A2 = A[loc2];
X	      for (p=0;p<pd;p++)
X		{
X		  *A1++ += *Ares;
X		  *A2++ -= *Ares++;
X		}
X	      
X	    }
X	  break;
X	case dot_av_av:
X        result_v = get_locint_r();
X        size     = get_locint_r();
X        loc2_v   = get_locint_r();
X        loc1_v   = get_locint_r();
X	  result = result_v;
X	  for (l=0;l<size;l++)
X	    {
X	      loc2 = loc2_v + l;
X	      loc1 = loc1_v + l;
X	      /* code for mult_a_a  */
X	      Tr1 = Trs[loc1];
X	      Tr2 = Trs[loc2];
X	      Ares = A[result];
X	      A2 = A[loc2];
X	      A1 = A[loc1];
X	      for (p=0;p<pd;p++)
X		{
X		  *A2++ += *Ares*Tr1;
X		  *A1++ += (*Ares++)*Tr2;
X		}
X	      
X	    }
X	  Ares = A[result];
X	  for (p=0;p<pd;p++)
X	    *Ares++ = 0.0;
X	  break;
X	case mult_d_av:
X        result_v = get_locint_r();
X        size = get_locint_r();
X        loc1_v = get_locint_r();
X        stored_val =get_val_r();
X	  for (l=0;l<size;l++)
X	    {
X	      loc1   = loc1_v   + l;   /* Location on the right-hand-side */
X	      result = result_v + l;   /* location of the result */
X	      /* code for mult_d_a */
X	      Ares = A[result];
X	      A1= A[loc1];
X	      for (p=0;p<pd;p++)
X		*A1++ += stored_val* (*Ares++);
X	      /* Be Careful here also see line 753 */
X	    }
X	  break;
X	case div_av_a:
X        result_v = get_locint_r();
X        size     = get_locint_r();
X        loc2_v   = get_locint_r();
X        loc1_v   = get_locint_r();
X	  loc2= loc2_v;     /* Location of adouble */
X	  for (l=0;l<size;l++)
X	    {
X	      loc1   = loc1_v   + l;  /* Location of rght-hnd-side vector[l] */
X	      result = result_v + l;  /* Location of the result */
X	      
X	      /* code for div_a_a */
X	      Tr2 = Trs[loc2];
X	      Tres = Trs[result];
X	      r0=1/Tr2;
X	      r_0=-r0*Tres;
X	      Ares = A[result];
X	      A2 = A[loc2];
X	      A1 = A[loc1];
X	      for (p=0;p<pd;p++)
X		{
X		  *A1++ += *Ares*r0;
X		  *A2++ += (*Ares++)*r_0;
X		}
X	    }
X	  break;
X	case mult_av_a:
X        result_v = get_locint_r();
X        size     = get_locint_r();
X        loc2_v   = get_locint_r();
X        loc1_v   = get_locint_r();
X	  loc2= loc2_v;   /* Location of adouble */
X	  for (l=0;l<size;l++)
X	    {
X	      loc1   = loc1_v   + l; /* Location of rght-hnd-side vector[l] */
X	      result = result_v + l; /* Location of result */
X	      
X	      /* code for mult_a_a */
X	      Tr1 = Trs[loc1];
X	      Tr2 = Trs[loc2];
X	      Ares = A[result];
X	      A2 = A[loc2];
X	      A1 = A[loc1];
X	      for (p=0;p<pd;p++)
X		{
X		  *A2++ += *Ares*Tr1;
X		  *A1++ += (*Ares++)*Tr2;
X		}
X	    }
X	  break;
X	case mult_a_av:
X        result_v = get_locint_r();
X        size     = get_locint_r();
X        loc2_v   = get_locint_r();
X        loc1_v   = get_locint_r();
X	  loc1= loc2_v;      /* Location of the adouble */
X	  for (l=0;l<size;l++)
X	    {
X	      loc2= loc1_v+l;      /* Location of rght hnd side vector[l]  */
X	      result = result_v + l; /* Location of the result */
X     
X	      /* code for mult_a_a */
X	      Tr1 = Trs[loc1];
X	      Tr2 = Trs[loc2];
X	      Ares = A[result];
X	      A2 = A[loc2];
X	      A1 = A[loc1];
X	      for (p=0;p<pd;p++)
X		{
X		  *A2++ += *Ares*Tr1;
X		  *A1++ += (*Ares++)*Tr2;
X		}
X	    }
X	  break;
X	
X#ifdef conditional
X	case cond_assign:
X        result = get_locint_r();
X        loc2 = get_locint_r();
X        loc1 = get_locint_r();
X        loc1_v = get_locint_r(); 
X	  get_taylor(result);
X	  A1 = A[loc1];
X	  Ares = A[result];
X          A2 = A[loc2];
X          if(Trs[loc1_v]>0.0)
X          {
X	    for (p=0;p<pd;p++)
X	    {
X	      *A1++ += *Ares;
X	      *Ares++  = 0;
X	    } /* endfor */
X          } /* endif */
X          else
X          {
X            for (p=0;p<pd;p++)
X            {
X              *A2++ += *Ares;
X              *Ares++  = 0;
X            } /* endfor */
X          } /* endelse */
X	  break;
X	case cond_assign_s:
X        result = get_locint_r();
X        loc1 = get_locint_r();
X        loc1_v = get_locint_r(); 
X	  get_taylor(result);
X	  A1 = A[loc1];
X	  Ares = A[result];
X          if(Trs[loc1_v]>0.0)
X          {
X	    for (p=0;p<pd;p++)
X	    {
X	      *A1++ += *Ares;
X	      *Ares++  = 0;
X	    } /* endfor */
X          } /* endif */
X	  break;
X	case subscript:
X        result = get_locint_r();
X        loc1 = get_locint_r();
X        loc1_v = get_locint_r(); 
X	  get_taylor(result);
X	  A1 = A[loc1_v+(int)(Trs[loc1])];
X	  Ares = A[result];
X	  for (p=0;p<pd;p++)
X	    {
X	      *A1++ += *Ares;
X	      *Ares++  = 0;
X	    }
X	  break;
X	case subscript_l:
X        result = get_locint_r();
X        loc1 = get_locint_r();
X        loc1_v = get_locint_r(); 
X	  get_taylor(loc1_v+(int)(Trs[loc1]));
X	  A1 = A[result];
X	  Ares = A[loc1_v+(int)(Trs[loc1])];
X	  for (p=0;p<pd;p++)
X	    {
X	      *A1++ += *Ares;
X	      *Ares++  = 0;
X	    }
X	  break;
X	  
X	case subscript_ld:
X        loc1 = get_locint_r();
X        loc1_v = get_locint_r(); 
X        stored_val = get_val_r();
X	  Ares = A[loc1_v+(int)(Trs[loc1])];
X	  for (p=0;p<pd;p++)
X	    *Ares++ = 0.0;
X	  break;
X	case m_subscript:
X        result = get_locint_r();
X        size = get_locint_r();
X        loc1 = get_locint_r();
X        loc1_v = get_locint_r(); 
X        for (l=size-1;l>=0;l--)
X        {
X          res=result+l;
X	  A1 = A[loc1_v+(int)(Trs[loc1])*size+l];
X	  Ares = A[res];
X	  for (p=0;p<pd;p++)
X	    {
X	      *A1++ += *Ares;
X	      *Ares++  = 0;
X	    }
X        } /* endfor */
X	break;
X	case m_subscript_l:
X        result = get_locint_r();
X        size = get_locint_r();
X        loc1 = get_locint_r();
X        loc1_v = get_locint_r(); 
X        for (l=size-1;l>=0;l--)
X        {
X          res=result+l;
X          arg=loc1_v+(int)(Trs[loc1])*size+l;
X	  get_taylor(arg);
X	  A1 = A[res];
X	  Ares = A[arg];
X	  for (p=0;p<pd;p++)
X	    {
X	      *A1++ += *Ares;
X	      *Ares++  = 0;
X	    }
X        } /* endfor */
X	break;
X	case m_subscript_ld:
X        size = get_locint_r();
X        loc2 = get_locint_r();
X        loc1 = get_locint_r();
X        loc1_v = get_locint_r(); 
X        d = get_val_v_r(size);
X        for (l=size-1;l>=0;l--)
X        {
X          res= loc1_v+(int)(Trs[loc1])*size+l+loc2;
X	  Ares = A[res];
X	  for (p=0;p<pd;p++)
X	    *Ares++ = 0.0;
X        } /* endfor */
X	break;
X#endif	      
X
X
X	default:
X	  printf("ADOL-C error: Fatal error in fov_reverse on operation %d\n",
X		 operation);
X	  exit(-1);
X	  break;
X	}
X      /* Get the next operation to perform */
X
X      operation = get_op_r();
X
X    }
X
X  end_sweep();
X}
X
X#ifdef __cplusplus
X}
X#endif
X
END_OF_FILE
if test 23970 -ne `wc -c <'fov_reverse.c'`; then
    echo shar: \"'fov_reverse.c'\" unpacked with wrong size!
fi
chmod +x 'fov_reverse.c'
# end of 'fov_reverse.c'
fi
if test -f 'hos_forward.c' -a "${1}" != "-c" ; then 
  echo shar: Will not clobber existing file \"'hos_forward.c'\"
else
echo shar: Extracting \"'hos_forward.c'\" \(21946 characters\)
sed "s/^X//" >'hos_forward.c' <<'END_OF_FILE'
X/*
X   ----------------------------------------------------------------
X   File hos_forward.c of ADOL-C version 1.6 as of January 1,   1995
X   ----------------------------------------------------------------
X   Contains the routine hos_forward (higher-order-scalar forward 
X   mode).
X
X*/
X
X#ifdef __cplusplus
Xextern "C" {
X#endif
X
X#include "dvlparms.h" /* Developers Parameters */
X
X/* Necessary Includes */
X
X#include "usrparms.h"
X#include "oplate.h"
X#include "taputil1.h"
X#include "taputil2.h"
X#include "taputil3.h"
X#include "tayutil.h"
X
X
X/* Local Static Variables */
X
Xstatic double** T;
X
Xstatic short tag;
X
Xstatic int for_location_cnt;
Xstatic int dep_cnt;
Xstatic int ind_cnt;
Xstatic int degree;
Xstatic int deaths;
X
X/****************************************************************************/
X/* Higher Order Scalar version of the forward mode.                         */
X/****************************************************************************/
Xvoid hos_forward(short tnum,         /* tape id */
X		 int depcheck,       /* consistency chk on # of dependents */
X		 int indcheck,       /* consistency chk on # of independents */
X		 int gdegree,        /* highest derivative degree */
X		 int keep,           /* flag for reverse sweep */
X		 double **argument,  /* independant variable values */
X		 double **taylors)   /* matrix of coifficient vectors */
X{
X  unsigned char operation;
X  int tape_stats[11];  /* tape stats */
X
X
X  
X
X  locint size = 0;
X  locint result=0;
X  locint result_v=0;
X  locint loc1=0;
X  locint loc1_v=0;
X  locint loc2=0;
X  locint loc2_v=0;
X  double stored_val=0.0;
X  double *d = 0;
X
X  int k, i, j ,l, loop,rloc;
X  double r0;
X  locint arg,res;
X  int indexi =0; 
X  int indexd =0;
X  double  *Targ,*Tres,*Tqo,*Trloc2,*Targ1,*Targ2; 
X  double coval,divs;
X  int buffer; 
X  double x,y;
X  static int fax, kax;
X  static double *Tdum, *z; 
X  int taylbuf;
X  int even;
X  double* Td;
X
X#ifdef inf_num
Xdouble i_num=inf_num;
Xdouble i_den=inf_den;
Xdouble n_num=non_num;
Xdouble n_den=non_den;
Xdouble InfVal;
Xdouble NoNum;
X#endif
X
X  degree = gdegree;
X  tag = tnum;         /*tag is global which specifies which tape to look at */
X  k = degree + 1;
X  
X  tapestats(tag,tape_stats);
X
X  ind_cnt = tape_stats[0];
X  dep_cnt = tape_stats[1];
X  for_location_cnt = tape_stats[2];
X  deaths = tape_stats[3];
X  buffer =  tape_stats[4];
X
X  set_buf_size(buffer);
X
X
X  
X  if ((depcheck != dep_cnt)||(indcheck != ind_cnt))
X    {
X      printf("\n ADOL-C error: forward sweep on tape %d  aborted!\n",tag);
X      printf("Number of dependent and/or independent variables passed to forward is\ninconsistant with number recorded on tape %d \n",tag);
X      exit (-1);
X    }
X  
X   if (k compsize kax || for_location_cnt compsize fax)
X    {
X      free((char*) Tdum);
X      free((char **) T);
X      free((char *) z); 
X      Tdum = (double*) malloc(for_location_cnt*k*sizeof(double));
X      z = (double *)malloc(sizeof(double)*k);
X      Td=Tdum;
X      T = (double **)malloc(sizeof(double*)*for_location_cnt);
X      for (i=0;i<for_location_cnt;i++)
X	{
X	  T[i]=Td;
X	  Td += k;
X	}
X      kax= k;
X      fax = for_location_cnt;
X    }
X  taylbuf = keep*sizeof(revreal)*deaths;
X  if (keep)
X    {
X      taylbuf = 4+taylbuf/(1+taylbuf/bufsize);
X      taylor_begin(taylbuf,T,keep-1);
X    }
X  
X  /* Initialize the Forward Sweep */
X  init_for_sweep(tag);
X
X  operation=get_op_f();
X  while (operation !=end_of_tape)
X    { /* Switch Statement to perform operations */
X      switch (operation){
X
X      case end_of_op:
X	get_op_block_f();
X        operation=get_op_f();
X        /* Skip next operation, it's another end_of_op */
X        break;
X      case end_of_int:
X        get_loc_block_f();
X        break;
X      case end_of_val:
X        get_val_block_f();
X        break;
X      case start_of_tape:
X      case end_of_tape:
X	break;
X	
X	/* Scalar Operations */
X
X      case int_adb_a:	
X        Targ = T[get_locint_f()];
X        Tres = T[get_locint_f()];
X	for (i=0;i<k;i++)
X	  Tres[i]=Targ[i];
X	break;
X      case assign_a:	
X        Targ = T[get_locint_f()];
X        res = get_locint_f();
X        Tres = T[res];
X	if (keep)
X	  write_taylor(res,keep);
X	for (i=0;i<k;i++)
X	  Tres[i]=Targ[i];
X	break;
X      case int_adb_d:
X	Tres = T[get_locint_f()];
X	Tres[0]=get_val_f();
X	for (i=1;i<k;i++)
X	  Tres[i]=0;
X	break;
X      case assign_d:
X        res = get_locint_f();
X	Tres = T[res];
X	if (keep)
X	  write_taylor(res,keep);
X	Tres[0]=get_val_f();
X	for (i=1;i<k;i++)
X	  Tres[i]=0;
X	break;
X      case assign_ind:
X        res = get_locint_f();
X	Tres = T[res];
X	if (keep)
X	  write_taylor(res,keep);
X	for (i=0;i<k;i++){
X	  Tres[i]=argument[indexi][i];}
X	++indexi;
X	break;
X      case assign_dep:
X	Tres = T[get_locint_f()];
X	if (taylors != 0 )  
X	  for (loop=0;loop<k;loop++)
X	    taylors[indexd][loop] = Tres[loop];
X	indexd++;
X	break;
X      case eq_plus_d:
X        res=get_locint_f();
X	Tres = T[res];
X	if (keep)
X	  write_taylor(res,keep);
X	Tres[0]+= get_val_f();
X	break;
X      case eq_plus_a: 
X	Targ = T[get_locint_f()];
X        res=get_locint_f();
X	Tres = T[res];
X	if (keep)
X	  write_taylor(res,keep);
X	for (i=0;i<k;i++)
X	  Tres[i]+=Targ[i];
X	break;
X      case eq_min_d:
X	res=get_locint_f();
X	Tres = T[res];
X	if (keep)
X	  write_taylor(res,keep);
X	Tres[0]-=get_val_f();
X	break;
X      case eq_min_a:
X	Targ = T[get_locint_f()];
X        res=get_locint_f();
X	Tres = T[res];
X	if (keep)
X	  write_taylor(res,keep); 
X	for (i=0;i<k;i++)
X	  Tres[i] -= Targ[i];
X	break;
X      case eq_mult_d: 
X        res=get_locint_f();
X        coval = get_val_f();
X	Tres = T[res];
X	if (keep)
X	  write_taylor(res,keep); 
X	for (i=0;i<k;i++)
X	  Tres[i]*=coval;
X	break;
X      case eq_mult_a: /* Convolution */
X	Targ = T[get_locint_f()];
X        res=get_locint_f();
X	Tres = T[res];
X	if (keep)
X	  write_taylor(res,keep); 
X	for (i=k-1;i>=0;i--)
X	  {
X	    x=0;
X	    for (j=0;j<=i;j++)
X	      x+=Tres[j]*Targ[i-j];
X	    Tres[i]=x;
X	  }
X	break;
X      case plus_a_a:
X	Targ1 = T[get_locint_f()];
X	Targ2 = T[get_locint_f()];
X	Tres = T[get_locint_f()];
X	for (i=0;i<k;i++)
X	  Tres[i]=Targ1[i]+Targ2[i];
X	break;
X      case plus_d_a:
X	Targ = T[get_locint_f()];
X	Tres = T[get_locint_f()];
X	Tres[0]=Targ[0]+ get_val_f();
X	for (i=1;i<k;i++)
X	  Tres[i]=Targ[i];
X	break;
X      case min_a_a:
X        Targ1 = T[get_locint_f()];
X        Targ2 = T[get_locint_f()];
X        Tres = T[get_locint_f()];
X	for (i=0;i<k;i++)
X	  Tres[i]=Targ1[i]-Targ2[i];
X	break;
X      case min_d_a:
X        Targ = T[get_locint_f()];
X        Tres = T[get_locint_f()];
X	Tres[0]=get_val_f() -Targ[0];
X	for (i=1;i<k;i++)
X	  Tres[i] = -Targ[i];
X	break;
X      case mult_a_a:
X        Targ1 = T[get_locint_f()];
X        Targ2 = T[get_locint_f()];
X        Tres = T[get_locint_f()];
X	for (i=0;i<k;i++)
X	  {
X	    x=0;
X	    for (j=0;j<=i;j++)
X	      x+=Targ1[j]*Targ2[i-j];
X	    Tres[i]=x;
X	  }
X	break;
X      case mult_d_a:
X        Targ = T[get_locint_f()];
X        Tres = T[get_locint_f()];
X	coval =get_val_f();
X	for (i=0;i<k;i++)
X	  Tres[i]=Targ[i]*coval;
X	break;
X      case div_a_a:
X        Targ1 = T[get_locint_f()];
X        Targ2 = T[get_locint_f()];
X        Tres = T[get_locint_f()];
X	divs   = 1/Targ2[0];
X	for (i=0;i<k;i++)
X	  {
X	    x=Targ1[i]*divs;
X	    z[i]=-Targ2[i]*divs;
X	    for (j=0;j<i;j++)
X	      x+=Tres[j]*z[i-j];
X	    Tres[i]=x;
X	  }
X	break;
X      case div_d_a:
X        Targ = T[get_locint_f()];
X        Tres = T[get_locint_f()];
X        coval =get_val_f();
X	divs = 1/Targ[0];
X	Tres[0]=coval*divs;
X	for (i=1;i<k;i++)
X	  {
X	    x=0;
X	    z[i]=-Targ[i]*divs;
X	    for (j=0;j<i;j++)
X	      x+=Tres[j]*z[i-j];
X	    Tres[i] = x;
X	  }
X	break;
X      case sqrt_op:
X        Targ = T[get_locint_f()];
X	Tres = T[get_locint_f()];
X	Tres[0]=sqrt(Targ[0]);
X        if (Targ[0]==0.0){
X#ifdef inf_num
X  InfVal=i_num/i_den;
X  NoNum=n_num/n_den;
X#endif
X          r0=0.0;
X          for (i=1;i<k;i++){
X            if (Targ[i]>0.0){
X              r0=InfVal;
X              i=k;
X            } /* end if */
X            if (Targ[i]<0.0){
X              r0=NoNum;
X              i=k;
X            } /* end if */
X          } /* end for */
X        } /* end if */
X        else {
X          r0 = 0.5/Tres[0];
X        } /* end else */
X        even =0;
X        for (i=1;i<k;i++) {
X          x=0;
X          for (j=1;2*j<i;j++)
X            x+=Tres[j]*Tres[i-j];
X          x *= 2;
X          if(even) x += Tres[i/2]*Tres[i/2];
X          even = !even;
X          Tres[i]=r0*(Targ[i]-x);
X        } /* end for */
X	break;
X      case abs_val:
X        Targ = T[get_locint_f()];
X        Tres = T[get_locint_f()];
X        x=0.0;
X        for (i=0;i<k;i++)
X        {
X            if((x==0.0) && (Targ[i]!=0.0))
X            {
X              if (Targ[i]<0.0)
X                x = -1.0;
X              else
X                x=1.0;
X            }
X            Tres[i] = x*Targ[i];
X        }
X        break;
X
X      case exp_op:
X	Targ = T[get_locint_f()];
X	Tres = T[get_locint_f()];
X	Tres[0]=exp(Targ[0]);
X	for (i=1;i<k;i++)
X	  { double x=0;
X
X	    z[i] = i*Targ[i];
X	    for (j=0;j<i;j++)
X	      x+= Tres[j]*z[i-j];
X	    Tres[i]=x/i;
X	  }
X	break;
X      case sin_op:
X        coval=get_val_f();
X        Tqo = T[get_locint_f()];
X        Targ = T[get_locint_f()];
X        Tres = T[get_locint_f()];
X	Targ[0]=cos(Tqo[0]);
X	Tres[0] = sin(Tqo[0]);
X	for (i=1;i<k;i++)
X	  {
X	    x=0;y=0;
X	    z[i] = i*Tqo[i];
X	    for (j=0;j<i;j++)
X	      {
X		x+= Targ[j]*z[i-j]; 
X		y+= Tres[j]*z[i-j];
X	      }
X	    Targ[i] = -y/i;
X	    Tres[i]=x/i;
X	  }
X	break;
X      case cos_op: 
X        coval=get_val_f();
X        Tqo = T[get_locint_f()];
X        Targ = T[get_locint_f()];
X        Tres = T[get_locint_f()];
X	Targ[0]=sin(Tqo[0]);
X	Tres[0]=cos(Tqo[0]);
X	for (i=1;i<k;i++)
X	  {
X	    x=0;y=0;
X	    z[i] = i*Tqo[i];
X	    for (j=0;j<i;j++)
X	      {
X		x+= Targ[j]*z[i-j]; 
X		y+= Tres[j]*z[i-j];
X	      }
X	    Targ[i] = y/i;
X	    Tres[i] = -x/i;
X	  }
X	break;
X      case asin_op:
X	coval=get_val_f();
X        Tqo = T[get_locint_f()];
X        Targ = T[get_locint_f()];
X        Tres = T[get_locint_f()];
X        Tres[0]=asin(Tqo[0]);
X	for (i=1;i<k;i++)
X	  {
X	    x=0;
X	    z[i] = i*Tqo[i];
X	    for (j=0;j<i;j++)
X	      x+= Targ[j]*z[i-j]; 
X	    Tres[i]=x/i;
X	  }
X	break;
X      case acos_op:
X        coval=get_val_f();
X        Tqo = T[get_locint_f()];
X        Targ = T[get_locint_f()];
X        Tres = T[get_locint_f()];
X        Tres[0]=acos(Tqo[0]);
X	for (i=1;i<k;i++)
X	  {
X	    x=0;
X	    z[i] = i*Tqo[i];
X	    for (j=0;j<i;j++)
X	      x+= Targ[j]*z[i-j];
X	    Tres[i]=x/i;
X	  }
X	break;
X      case atan_op:
X        coval=get_val_f();
X        Tqo = T[get_locint_f()];
X        Targ = T[get_locint_f()];
X        Tres = T[get_locint_f()];
X	Tres[0]=atan(Tqo[0]);
X	for (i=1;i<k;i++)
X	  {
X	    x=0;
X	    z[i] = i*Tqo[i];
X	    for (j=0;j<i;j++)
X	      x+= Targ[j]*z[i-j]; 
X	    Tres[i]=x/i;
X	  }
X	break;
X      case gen_quad:
X        Tqo = T[get_locint_f()];
X        Targ = T[get_locint_f()];
X        Tres = T[get_locint_f()];
X	Tres[0]=get_val_f();
X	for (i=1;i<k;i++)
X	  {
X	    x=0;
X	    z[i] = i*Tqo[i];
X	    for (j=0;j<i;j++)
X	      x+= Targ[j]*z[i-j];
X	    Tres[i]=x/i;
X	  }
X	break;
X      case log_op:
X	Targ = T[get_locint_f()];
X	Tres = T[get_locint_f()];
X	divs = 1.0/Targ[0];
X	Tres[0]=log(Targ[0]);
X	for (i=1;i<k;i++)
X	  {
X	    x=0;
X	    for (j=1;j<i;j++)
X	      x+= Targ[i-j]*z[j]; 
X	    Tres[i]=(Targ[i]-x/i)*divs;
X	    z[i] = i*Tres[i];
X	  }
X	break;
X      case pow_op:
X        coval = get_val_f();
X	Targ = T[get_locint_f()];
X	Tres = T[get_locint_f()];
X	Tres[0] = pow(Targ[0],coval);
X        if (Targ[0]==0.0){
X#ifdef inf_num
X  InfVal=i_num/i_den;
X  NoNum=n_num/n_den;
X#endif
X          r0=0.0;
X          for (i=1;i<k;i++){
X            if (Targ[i]>0.0){
X              r0=InfVal;
X              i=k;
X            } /* end if */
X            if (Targ[i]<0.0){
X              r0=NoNum;
X              i=k;
X            } /* end if */
X          } /* end for */
X        } /* end if */
X        else {
X          r0 = 1.0/Targ[0];
X        } /* end else */
X	for (i=1;i<k;i++)
X	  {
X	    x = 0 ;
X	    y = coval*i;
X	    for (j=0;j<i;j++)
X	      {
X		x += Tres[j]*Targ[i-j]*y;
X		y -= coval+1;
X	      }
X	    Tres[i] = x*r0/i;
X	  }
X	break;
X	
X      case death_not:
X        loc1 = get_locint_f();
X        loc2 = get_locint_f();
X        if (keep) 
X        {
X          do write_taylor(loc2,keep);
X          while(loc1 < loc2-- ); 
X        }
X	break;
X	
X      /* Vector Operations */
X      
X      case int_av_av:
X        loc1_v = get_locint_f();
X        size = get_locint_f();
X        result_v= get_locint_f();
X	for (l=0;l<size;l++)
X	  {
X	    Tres=T[result_v + l];   /* Location of left-hand-side  */
X	    Targ=T[loc1_v + l];     /* Location of right-hand-side */
X	    /* code for int_adb_a */
X	    for (i=0;i<k;i++)
X	      Tres[i]=Targ[i];
X	  }
X	break;
X      case assign_dv:
X        size = get_locint_f();
X        loc1_v = get_locint_f();
X        d = get_val_v_f(size);
X	for (l=0;l<size;l++)
X	  {
X	    res = loc1_v + l;           /* Location of left-hand-side */
X	    Tres = T[res];
X	    if (keep)
X	      write_taylor(res,keep);
X	    Tres[0]= d[l];
X	    for (i=1;i<k;i++)
X	      Tres[i]=0;
X	  }
X	break;
X      case assign_av:
X        loc2_v = get_locint_f();
X        size = get_locint_f();
X        loc1_v = get_locint_f();
X	for (l=0;l<size;l++)
X	  {
X	    res = loc1_v + l;             /* Location of left-hand-side  */
X	    Targ= T[loc2_v + l];  
X            Tres=T[res];
X	    /* code for assign_a */
X	    if (keep)
X	      write_taylor(res,keep);
X	    for (i=0;i<k;i++)
X	      Tres[i]=Targ[i];
X	  }
X	break;
X      case assign_indvec:
X        size = get_locint_f();
X        loc1_v = get_locint_f();
X	for (l=0;l<size;l++)
X	  {
X	    res = loc1_v + l;             /* Location of the left-hand-side */
X	    /* code for assign_ind */
X	    Tres = T[res];
X	    if (keep)
X	      write_taylor(res,keep);
X	    for (i=0;i<k;i++){
X	      Tres[i]=argument[indexi][i];}
X	    ++indexi;
X	  }
X	break;
X      case assign_depvec:
X        size = get_locint_f();
X        loc1_v = get_locint_f();
X	for (l=0;l<size;l++)
X	  {
X	    Tres=T[loc1_v + l];             /* Location of the left-hand-side */
X	    /* code for assign_dep */
X	    if (taylors != 0 )  
X	      for (loop=0;loop<k;loop++)
X		taylors[indexd][loop] = Tres[loop];
X	    indexd++;
X	  }
X	break;
X      case eq_min_av:
X        loc1_v = get_locint_f();
X        size = get_locint_f();
X        result_v = get_locint_f();
X	for (l=0;l<size;l++)
X	  {
X	    res = result_v + l;            /* Location of left-hand-side  */
X	    /* code for eq_min_a */ 
X	    Tres = T[res];
X	    Targ = T[loc1_v + l];
X	    if (keep)
X	      write_taylor(res,keep); 
X	    for (i=0;i<k;i++)
X	      Tres[i] -= Targ[i];
X	  }
X	break;
X      case eq_plus_av:
X        loc1_v = get_locint_f();
X        size = get_locint_f();
X        result_v = get_locint_f();
X	for (l=0;l<size;l++)
X	  {
X	    res = result_v + l;            /* Location of left-hand-side  */
X	    /* code for eq_plus_a */
X	    Tres = T[res];
X	    Targ = T[loc1_v   + l];
X	    if (keep)
X	      write_taylor(res,keep);
X	    for (i=0;i<k;i++)
X	      Tres[i]+=Targ[i];
X	  }
X	break;
X      case eq_mult_av_a:
X        Targ = T[get_locint_f()];
X        size = get_locint_f();
X        result_v = get_locint_f();
X	for (l=0;l<size;l++)
X	  {
X	    res = result_v + l;      /* Location of the left-hand-side  */
X	    /* code for eq_mult_a*/
X	    Tres = T[res];
X	    if (keep)
X	      write_taylor(res,keep); 
X	    for (i=k-1;i>=0;i--)
X	      {
X		x=0;
X		for (j=0;j<=i;j++)
X		  x+=Tres[j]*Targ[i-j];
X		Tres[i]=x;
X	      }
X	  }
X	break;
X      case eq_mult_av_d:
X        size = get_locint_f();
X        result_v = get_locint_f();
X        coval = get_val_f();
X	for (l=0;l<size;l++)
X	  {
X	    res = result_v + l;      /* Location of the left-hand-side  */
X	    /* stored_val = fixed;         Location on the right-hand-side */
X	    Tres = T[res];
X	    if (keep)
X	      write_taylor(res,keep); 
X	    for (i=0;i<k;i++)
X	      Tres[i]*=coval;
X	  }
X	break;
X      case plus_av_av:
X        loc1_v   = get_locint_f();
X        loc2_v   = get_locint_f();
X        size     = get_locint_f();
X        result_v = get_locint_f();
X	for (l=0;l<size;l++)
X	  {
X	    Targ2= T[loc2_v    + l];       /* Location of var 2  */
X	    Targ1 = T[loc1_v    + l];       /* Location of var 1  */
X	    Tres = T[result_v  + l];       /* Location of result */
X	    for (i=0;i<k;i++)
X	      Tres[i]=Targ1[i]+Targ2[i];
X	  }
X	break;
X      case sub_av_av:
X        loc1_v   = get_locint_f();
X        loc2_v   = get_locint_f();
X        size     = get_locint_f();
X        result_v = get_locint_f();
X	for (l=0;l<size;l++)
X	  {
X            Targ2= T[loc2_v    + l];       /* Location of var 2  */
X            Targ1 = T[loc1_v    + l];       /* Location of var 1  */
X            Tres = T[result_v  + l];       /* Location of result */
X	    for (i=0;i<k;i++)
X	      Tres[i]=Targ1[i]-Targ2[i];
X	  }
X	break;
X      case dot_av_av:
X        loc1_v   = get_locint_f();
X        loc2_v   = get_locint_f();
X        size     = get_locint_f();
X        Tres = T[get_locint_f()];
X	for (i=0;i<k;i++)
X	  Tres[i]=0.0;
X	for (l=0;l<size;l++)
X	  {
X	    Targ1 = T[loc2_v + l];
X	    Targ2 = T[loc1_v + l];
X	    /* code for mult_a_a  */
X	    for (i=0;i<k;i++)
X	      {
X		x=Tres[i];
X		for (j=0;j<=i;j++)
X		  x+=Targ1[j]*Targ2[i-j];
X		Tres[i]=x;
X	      }
X	  }
X	break;
X      case mult_d_av:
X        loc1_v = get_locint_f();
X        size = get_locint_f();
X        result_v = get_locint_f();
X        coval =get_val_f();
X	for (l=0;l<size;l++)
X	  {
X	    Targ=T[loc1_v   + l];   /* Location on the right-hand-side */
X	    Tres =T[result_v + l];   /* location of the result */
X	    for (i=0;i<k;i++)
X	      Tres[i]=Targ[i]*coval;
X	  }
X	break;
X      case div_av_a:
X        loc1_v   = get_locint_f();
X        Targ2 =T[ get_locint_f()];
X        size     = get_locint_f();
X        result_v = get_locint_f();
X	for (l=0;l<size;l++)
X	  {
X	    Targ1= T[loc1_v   + l];  /* Location of right-hand-side vector[l] */
X	    Tres = T[result_v + l];  /* Location of the result */
X	    divs   = 1/Targ2[0];
X	    for (i=0;i<k;i++)
X	      {
X		x=Targ1[i]*divs;
X		z[i]=-Targ2[i]*divs;
X		for (j=0;j<i;j++)
X		  x+=Tres[j]*z[i-j];
X		Tres[i]=x;
X	      }
X	  }
X	break;
X      case mult_av_a:
X        loc1_v   = get_locint_f();
X        Targ2=T[ get_locint_f()];
X        size     = get_locint_f();
X        result_v = get_locint_f();
X	for (l=0;l<size;l++)
X	  {
X	    Targ1=T[loc1_v   + l]; /* Location of right-hand-side vector[l] */
X	    Tres=T[ result_v + l]; /* Location of the result */
X	    for (i=0;i<k;i++)
X	      {
X		x=0;
X		for (j=0;j<=i;j++)
X		  x+=Targ1[j]*Targ2[i-j];
X		Tres[i]=x;
X	      }
X	  }
X	break;
X      case mult_a_av:
X        loc1_v   = get_locint_f();
X        Targ1 = T[get_locint_f()];
X        size     = get_locint_f();
X        result_v = get_locint_f();
X	for (l=0;l<size;l++)
X	  {
X	    Targ2=T[loc1_v+l];   /* Location of right hand side vector[l]  */
X	    Tres=T[result_v + l]; /* Location of the result */
X	    for (i=0;i<k;i++)
X	      {
X		x=0;
X		for (j=0;j<=i;j++)
X		  x+=Targ1[j]*Targ2[i-j];
X		Tres[i]=x;
X	      }
X	  }
X	break;
X
X#ifdef conditional
X      case cond_assign:
X        Targ=T[get_locint_f()];
X        Targ1=T[get_locint_f()];
X        Targ2=T[get_locint_f()];
X        res=get_locint_f();
X        Tres=T[res];
X        if (keep)
X          write_taylor(res,keep);
X	if (*Targ>0)
X	  {
X	    for (i=0;i<k;i++)
X	      Tres[i]=Targ1[i];
X	  }
X	else
X	  {
X	    for (i=0;i<k;i++)
X	      Tres[i]=Targ2[i];
X	  }
X	break;
X      case cond_assign_s:
X        Targ =T[get_locint_f()];
X        Targ1 =T[get_locint_f()];
X        res = get_locint_f();
X        Tres=T[res];
X        if (keep)
X          write_taylor(res,keep);
X	if (*Targ>0)
X	{
X	  for (i=0;i<k;i++)
X	    Tres[i]=Targ1[i];
X	}
X	break;
X      case subscript:	
X        loc1_v=get_locint_f();  /* Base */
X        loc1=get_locint_f();  /* Offset */
X        result=get_locint_f();
X	rloc = result;
X	Trloc2 = T[loc1_v+(int)T[loc1][0]];
X	if (keep)
X	  write_taylor(rloc,keep);
X	for (i=0;i<k;i++)
X	  T[rloc][i]=Trloc2[i];
X	break;
X      case subscript_l:	
X        loc1_v=get_locint_f();  /* Base */
X        loc1=get_locint_f();  /* Offset */
X        result=get_locint_f();
X	rloc = loc1_v+(int)T[loc1][0];
X	Trloc2 = T[result];
X	if (keep)
X	  write_taylor(rloc,keep);
X	for (i=0;i<k;i++)
X	  T[rloc][i]=Trloc2[i];
X	break;
X      case subscript_ld:	
X        stored_val = get_val_f();
X        loc1_v=get_locint_f();  /* Base */
X        loc1=get_locint_f();  /* Offset */
X	res = loc1_v+(int)T[loc1][0];
X	Tres = T[res];
X	coval = stored_val;
X	Tres[0]=coval;
X	for (i=1;i<k;i++)
X	  Tres[i]=0;
X	break;
X      case m_subscript:	
X        loc1_v=get_locint_f();  /* Base */
X        loc1=get_locint_f();  /* Offset */
X        size=get_locint_f();
X        result=get_locint_f();
X        for (l=0;l<size;l++)
X        {
X          arg=loc1_v+(int)T[loc1][0]*size+l;
X          res=result+l;
X	  Targ = T[arg];
X          Tres = T[res];
X	  for (i=0;i<k;i++)
X	    Tres[i]=Targ[i];
X        }
X	break;
X      case m_subscript_l:	
X        loc1_v=get_locint_f();  /* Base LHS */
X        loc1=get_locint_f();  /* Offset LHS */
X        size=get_locint_f();
X        arg=get_locint_f(); /* RHS */
X        for (l=0;l<size;l++)
X        {
X          res = loc1_v+(int)T[loc1][0]*size+l;
X	  Targ = T[arg+l];
X          Tres = T[res];
X	  if (keep)
X	    write_taylor(res,keep);
X	  for (i=0;i<k;i++)
X	    Tres[i]=Targ[i];
X        }
X	break;
X      case m_subscript_ld:	
X        loc1_v=get_locint_f();  /* Base */
X        loc1=get_locint_f();  /* Offset */
X        loc2=get_locint_f(); /* offset in the vector itself */
X        size=get_locint_f();
X        d = get_val_v_f(size);
X        for (l=0;l<size;l++)
X        {
X	  res = loc1_v+(int)T[loc1][0]*size+l+loc2;
X	  Tres = T[res];
X	  Tres[0]=d[l]; 
X	  for (i=1;i<k;i++)
X	    Tres[i]=0;
X        }
X	break;
X#endif	
X
X	
X      default:
X	/* Die here, we screwed up */
X	printf("ADOL-C error: Fatal error in hos_forward with operation %d\n",
X	       operation);
X	exit(-1);
X	break;
X	
X      } /* end of switch */
X
X      /* Read the next operation */
X
X      operation=get_op_f();
X    } /* end of while */
X
X  if (keep) taylor_close(taylbuf,depcheck,indcheck);
X
X  end_sweep();
X
X} /* end of hos_forward */
X
X
X
X#ifdef __cplusplus
X}
X#endif
X
END_OF_FILE
if test 21946 -ne `wc -c <'hos_forward.c'`; then
    echo shar: \"'hos_forward.c'\" unpacked with wrong size!
fi
chmod +x 'hos_forward.c'
# end of 'hos_forward.c'
fi
if test -f 'hos_reverse.c' -a "${1}" != "-c" ; then 
  echo shar: Will not clobber existing file \"'hos_reverse.c'\"
else
echo shar: Extracting \"'hos_reverse.c'\" \(27609 characters\)
sed "s/^X//" >'hos_reverse.c' <<'END_OF_FILE'
X/*
X   ----------------------------------------------------------------
X   File hos_reverse.c of ADOL-C version 1.6 as of January 1,   1995
X   ----------------------------------------------------------------
X   Contains the routine hos_reverse (higher-order-scalar reverse 
X   mode).
X
X*/
X
X#ifdef __cplusplus
Xextern "C" {
X#endif
X
X
X/* 
X  There are four basic versions of the procedure `reverse', which
X  are optimized for the cases of scalar or vector reverse sweeps
X  with first or higher derivatives, respectively. In the calling
X  sequence this distinction is apparent from the type of the
X  parameters `lagrange' and `results'. The former may be left out
X  and the integer parameters `depen', `indep', `degre', and `nrows'
X  must be set or default according to the following matrix of
X  calling cases. 
X
X           no lagrange         double* lagrange     double** lagrange
X
Xdouble*   gradient of scalar   weight vector times    infeasible 
Xresults   valued function      Jacobian product       combination
X
X          ( depen = 1 ,         ( depen > 0 ,         
X	    degre = 0 ,           degre = 0 ,              ------
X	    nrows = 1 )           nrows = 1 )
X
Xdouble**  Jacobian of vector   weight vector times     weight matrix
Xresults   valued function      Taylor-Jacobians        times Jacobian
X           
X	  ( 0 < depen           ( depen > 0 ,          ( depen > 0 ,
X	      = nrows ,           degre > 0 ,            degre = 0 ,
X	    degre = 0 )           nrows = 1 )            nrows > 0 )
X
Xdouble*** full family of         ------------          weigth matrix x
Xresults   Taylor-Jacobians       ------------          Taylor Jacobians
X
X
X*/ 
X
X#include "dvlparms.h" /* Developers Parameters */
X
X/* Necessary Includes */
X
X#include "usrparms.h"
X#include "oplate.h"
X#include "taputil1.h"
X#include "taputil2.h"
X#include "taputil3.h"
X#include "tayutil.h"
X
X/* Static Locals */
Xstatic short tag;
X
X/* External memory management routines from driversc.c */
X
Xdouble** myalloc2(int, int);
Xdouble*** myalloc3(int, int, int);
X
X/*-------------------------------------------------------------------------*/
X/* Higher Order Scalar Reverse Pass.                                       */
X/*-------------------------------------------------------------------------*/
Xvoid hos_reverse(short tnum,         /* tape id */
X		 int depen,          /* consistency chk on # of dependants */
X		 int indep,          /* consistency chk on # of independants */
X		 int degre,          /* highest derivative degre  */
X		 double *lagrange,   /* range weight vector       */
X		 double **results)   /* matrix of coefficient vectors */
X       
X{   
X  unsigned char operation;
X  int tape_stats[11];  /* tape stats */
X
X  locint result=0;
X  locint arg=0;
X  locint res=0;
X  locint loc1=0;
X  locint loc2=0;
X  double stored_val=0.0;
X  locint result_v=0;
X  locint loc1_v=0;
X  locint loc2_v=0;
X  double *d = 0;
X  locint size = 0;
X
X  static double** A;
X  static revreal** Tr;
X  static revreal *Atemp, *Atemp2, *Trtemp;
X  revreal *A1, *A2, *Ares, *Tr1, *Tr2, *Tres;
X  int dep_cnt,indep_cnt;
X  int numdep,numind;
X  double r0b,divs;
X  /*Check these */
X
X  int rev_location_cnt,buffer;
X  int i,j,k,l,kl;
X  double x,y,r0,r_0;
X  int indexi;
X  int indexd;
X  static int kax, rax;
X  int taycheck;
X
X  /* Set up stuff for the tape */
X  
X  tag = tnum;   /*tag is global which indicates which tape to look at*/
X
X  k = degre+1;
X  
X  
X  tapestats(tag,tape_stats);
X
X  indep_cnt = tape_stats[0];
X  dep_cnt = tape_stats[1];
X  rev_location_cnt = tape_stats[2];
X  buffer =  tape_stats[4];
X
X  set_buf_size(buffer);
X
X  
X  if ((depen != dep_cnt)||(indep != indep_cnt))
X    {
X      printf("ADOL-C error: reverse sweep on tape %d  aborted!\n",tag);
X      printf("Number of dependent and/or independent variables passed to ");
X      printf("reverse is\ninconsistant with number");
X      printf("recorded on tape  %d \n",tag);
X      exit (-1);
X    }
X  
X  indexi = indep_cnt - 1;
X  indexd = dep_cnt - 1;
X/*
X  for (kl =0; kl < indep_cnt; kl++) results[kl][0]=NaN;
X*/
X 
X  if(k compsize kax || rev_location_cnt compsize rax) 
X    {
X      if(rax)
X	{
X	  free((char *) Atemp);
X	  free((char *) Atemp2);
X	  free((char *) Trtemp);
X	  /* delete Atemp;
X	     delete Atemp2;
X	     delete Trtemp; */
X	  free((char*) *Tr); free((char*)Tr);
X	  free((char*) *A); free((char*)A);
X	}
X      Atemp = (revreal *)malloc(k*sizeof(revreal));
X      Atemp2 = (revreal *)malloc(k*sizeof(revreal));
X      Trtemp = (revreal *)malloc(k*sizeof(revreal));
X      /* Atemp = new revreal[k];
X	 Atemp2 = new revreal[k];
X	 Trtemp = new revreal[k]; */
X
X      Tr = myalloc2(rev_location_cnt,k);
X      A = myalloc2(rev_location_cnt,k);
X      kax = k;
X      rax = rev_location_cnt;
X    }
X
X  taylor_back2(Tr,&numdep,&numind,&taycheck);
X  
X  if(taycheck != degre)   
X    {
X      printf("\n ADOL-C error: reverse fails because it was not preceeded \n");
X      printf("by a forward sweep with degree %d !!!!!!!!\n",degre);
X      exit(-2);
X    };
X  
X  if((numdep != depen)||(numind != indep))
X    {
X      printf("\n ADOL-C error: reverse fails on tape %d because the number of\n"
X	     ,tag);
X      printf("independent and/or dependent variables given to reverse are\n");
X      printf("inconsistant with that of the internal taylor array.\n");
X      exit(-2);
X    }
X  
X  init_rev_sweep(tag);
X  operation=get_op_r();
X
X  while (operation != start_of_tape) 
X    {
X
X      /* Switch statement to execute the operations in Reverse */
X
X      switch (operation) {
X
X	/* Markers */
X
X      case end_of_int:
X        get_loc_block_r(); /* Get the next int block */
X        break;
X      case end_of_val:
X        get_val_block_r(); /* Get the next val block */
X        break;
X      case end_of_op:
X        get_op_block_r();
X        operation = get_op_r();/* Skip next operation, it's another end_of_op */
X        break;
X      case start_of_tape:
X      case end_of_tape:
X	break;
X
X      /* Scalar Operations */
X
X      case int_adb_a:
X        loc1 = get_locint_r();
X        loc2 = get_locint_r();
X	A1 = A[loc2];
X	Ares = A[loc1];
X	for (i=0;i<k;i++)
X	  {
X	    A1[i]+=Ares[i];
X	    Ares[i] = 0.0;
X	  }
X	break;
X      case assign_a:
X        loc1 = get_locint_r();
X        loc2 = get_locint_r();
X	get_taylors(loc1,k);
X	A1 = A[loc2];
X	Ares = A[loc1];
X	for (i=0;i<k;i++)
X	  {
X	    A1[i]+=Ares[i];
X	    Ares[i] = 0.0;
X	  }
X	break;
X      case int_adb_d:
X        loc1 = get_locint_r();
X        stored_val = get_val_r();
X	Ares = A[loc1];
X	for (i=0;i<k;i++)
X	  *Ares++ = 0.0;
X	break;
X      case assign_d:
X        loc1 = get_locint_r();
X        stored_val = get_val_r();
X	Ares = A[loc1];
X	for (i=0;i<k;i++)
X	  *Ares++ = 0.0;
X	get_taylors(loc1,k);
X	break;
X	
X      case assign_ind:
X        loc1 = get_locint_r();
X	get_taylors(loc1,k);
X	Ares = A[loc1];
X	for (i=0;i<k;i++)
X	  results[indexi][k-1-i]= *Ares++;
X	indexi--;
X	break;
X	
X      case assign_dep:
X        loc1 = get_locint_r();
X	Ares = A[loc1];
X	Ares[k-1] = lagrange[indexd];
X	indexd--;
X	break;
X	
X      case eq_plus_d:
X        result=get_locint_r();
X        stored_val = get_val_r();
X	get_taylors(result,k);
X	break;
X	
X      case eq_plus_a: 
X        result=get_locint_r();
X        loc1=get_locint_r();
X	get_taylors(result,k);
X	Ares=A[result];
X	A1=A[loc1];
X	for (i=0;i<k;i++)
X	  *A1++ += *Ares++;
X	break;
X	
X      case eq_min_d:
X        result=get_locint_r();
X        stored_val = get_val_r();
X	get_taylors(result,k);
X	break;
X	
X      case eq_min_a: 
X        result=get_locint_r();
X        loc1=get_locint_r();
X	get_taylors(result,k);
X	Ares=A[result];
X	A1=A[loc1];
X	for (i=0;i<k;i++)
X	  *A1++ -= *Ares++;
X	break;
X	
X      case eq_mult_d:
X        result=get_locint_r();
X        stored_val = get_val_r();
X	get_taylors(result,k);
X	A1 = A[result];
X	for (i=0;i<k;i++)
X	  A1[i]*=stored_val;
X	break;
X	
X      case eq_mult_a:
X        result=get_locint_r();
X        loc1=get_locint_r();
X	get_taylors(result,k);
X	Tres = Tr[result];
X	Tr1 = Tr[loc1];
X	A1 = A[loc1];
X	Ares = A[result]; 
X	for (i=k-1;i>=0;i--)
X	  {
X	    x = 0.0;
X	    y = 0.0;
X	    Atemp[i] = Ares[i];
X	    Ares[i] = 0;
X	    for (j=i;j<k;j++)
X	      {
X		x+=Atemp[j]*Tres[j-i];
X		y+=Atemp[j]*Tr1[j-i];
X	      }
X	    A1[i]+=x;
X	    Ares[i]+=y;
X	  }
X	break;
X	
X      case plus_a_a:
X        result =get_locint_r();
X        loc2=get_locint_r();
X        loc1=get_locint_r();
X	Ares = A[result];
X	A1 = A[loc1];
X	A2 = A[loc2];
X	for (i=0;i<k;i++)
X	  {
X	    *A1++ += *Ares;
X	    *A2++ += *Ares++;
X	  }
X	break;
X	
X      case plus_d_a:
X        result = get_locint_r();
X        loc1=get_locint_r();
X        stored_val = get_val_r();
X	Ares = A[result];
X	A1 = A[loc1];
X	for (i=0;i<k;i++)
X	  *A1++ += *Ares++;
X	break;
X	
X      case min_a_a:
X        result =get_locint_r();
X        loc2=get_locint_r();
X        loc1=get_locint_r();
X	Ares = A[result];
X	A1 = A[loc1];
X	A2 = A[loc2];
X	for (i=0;i<k;i++)
X	  {
X	    *A1++ += *Ares;
X	    *A2++ -= *Ares++;
X	  }
X	break;
X	
X      case min_d_a:
X        result = get_locint_r();
X        loc1=get_locint_r();
X        stored_val = get_val_r();
X	Ares = A[result];
X	A1 = A[loc1];
X	for (i=0;i<k;i++)
X	  *A1++ -= *Ares++;
X	break;
X	
X      case mult_a_a:
X        result =get_locint_r();
X        loc2=get_locint_r();
X        loc1=get_locint_r();
X	Ares = A[result];
X	A2 = A[loc2];
X	A1 = A[loc1];
X	Tr1 = Tr[loc1];
X	Tr2 = Tr[loc2];
X	for (i=0;i<k;i++)
X	  {
X	    x = 0.0;
X	    y = 0.0;
X	    for (j=i;j<k;j++)
X	      {
X		x+=Ares[j]*Tr1[j-i];
X		y+=Ares[j]*Tr2[j-i];
X	      }
X	    A2[i]+=x;
X	    A1[i]+=y;
X	  }
X	break;
X	
X      case mult_d_a:
X        result = get_locint_r();
X        loc1=get_locint_r();
X        stored_val = get_val_r();
X	Ares = A[result];
X	A1= A[loc1];
X	for (i=0;i<k;i++)
X	  *A1++ += stored_val* (*Ares++);
X	break;
X	
X      case div_a_a:
X        result =get_locint_r();
X        loc2=get_locint_r();
X        loc1=get_locint_r();
X	Tr2 = Tr[loc2];
X	Tres = Tr[result];
X	Ares = A[result];
X	A2 = A[loc2];
X	A1 = A[loc1];
X	r0=1/Tr2[0];
X	for (i=k-2;i>=0;i--)
X	  {
X	    x = 0.0;
X	    for (j=i+1;j<k;j++)
X	      x+=Ares[j]*Tr2[j-i];
X	    Ares[i]-=x*r0;
X	  }
X	r_0 = 0.0;
X	for (i=0;i<k;i++)
X	  r_0+=Ares[i]*Tres[i]; 
X	A2[0]-=r_0*r0;
X	
X	for (i=1;i<k;i++)
X	  {
X	    x = 0.0;
X	    for (j=i;j<k;j++)
X	      x+=Ares[j]*Tres[j-i];
X	    A2[i]-=x*r0;
X	  }
X	for (i=0;i<k;i++)
X	  A1[i]+=r0*Ares[i];
X	break;
X	
X      case div_d_a:
X        result = get_locint_r();
X        loc1=get_locint_r();
X        stored_val = get_val_r();
X	Tr1 = Tr[loc1];
X	Tres = Tr[result];
X	Ares = A[result];
X	A1 = A[loc1];
X	r0=1/Tr1[0];
X	for (i=k-2;i>=0;i--)
X	  {
X	    x = 0.0;
X	    for (j=i+1;j<k;j++)
X	      x += Ares[j]*Tr1[j-i];
X	    Ares[i] -= r0*x;
X	  }
X	x = 0.0;
X	for (i=0;i<k;i++)
X	  x+=Ares[i]*Tres[i];
X	r_0=Tr1[0]*x;
X	
X	A1[0]-=r_0*r0*r0;
X	
X	for (i=1;i<k;i++)
X	  {
X	    x = 0.0;
X	    for (j=i;j<k;j++)
X	      x+=Ares[j]*Tres[j-i];
X	    A1[i]-=r0*x;
X	  }
X	break;
X	
X      case pow_op:
X        result = get_locint_r();
X        loc1=get_locint_r();
X        stored_val = get_val_r();
X	Tr1 = Tr[loc1];
X	Tres = Tr[result];
X	Ares = A[result];
X	A1 = A[loc1];
X        if (Tr1[0]==0.0)
X          r0=0.0;
X        else
X	  r0 = 1/Tr1[0];
X	r0b = 0.0;
X	for (i=k-1;i>0;i--)
X	  {
X	    x = Ares[i]*r0/i;
X	    r0b += Ares[i]*Tres[i];
X	    divs = -i;
X	    for (j=i-1;j>=0;j--)
X	      { divs += stored_val+1;
X		/*  stored_val*(i-j)-j; */
X		Ares[j] += x*divs*Tr1[i-j];
X		A1[i-j] += x*divs*Tres[j];
X	      }
X	  }
X	A1[0] += (Ares[0]*stored_val*Tres[0]-r0b)*r0;
X	break;
X	
X      case death_not:
X        loc2 = get_locint_r();
X        loc1 = get_locint_r();
X	for (i=loc1;i<=loc2;i++)
X	  {
X	    A1 = A[i];
X	    for (j=0;j<k;j++)
X	      *A1++ = 0.0;
X	    get_taylors(i,k);
X	  }
X	break;
X	
X      case exp_op:
X        result = get_locint_r();
X        loc1=get_locint_r();
X	Ares = A[result];
X	A1 = A[loc1];
X	Tres = Tr[result];
X	Tr1 = Tr[loc1];
X	for (i=k-2;i>=0;i--)
X	  {
X	    Atemp[i+1] = Ares[i+1] / (i+1);
X	    Trtemp[k-1-i] = (k-1-i) * Tr1[k-1-i];
X	    x = 0.0;
X	    for (j=i+1;j<k;j++)
X	      x+=Atemp[j]*Trtemp[j-i];
X	    Ares[i]+=x;
X	  }
X	for (i=1;i<k;i++)
X	  {
X	    x = 0.0;
X	    for (j=i;j<k;j++)
X	      x+=Atemp[j]*Tres[j-i];
X	    A1[i]+=i*x;
X	  }
X	A1[0]+=Ares[0]*Tres[0];
X	break;
X	
X      case sin_op:
X        result = get_locint_r();
X        loc2 = get_locint_r();
X        loc1 = get_locint_r();
X        stored_val = get_val_r();
X	Ares = A[result];
X	A2 = A[loc2];
X	A1 = A[loc1];
X	Tr1 = Tr[loc1];
X	Tr2 = Tr[loc2];
X	Tres = Tr[result];
X	for (i=k-2;i>=0;i--)
X	  {
X	    x = 0.0;
X	    y = 0.0;
X	    Atemp[i+1] = Ares[i+1] / (i+1);
X	    Atemp2[i+1] = A2[i+1] / (i+1);
X	    Trtemp[k-1-i] = (k-1-i) * Tr1[k-1-i];
X	    for (j=i+1;j<k;j++)
X	      {
X		x+=Atemp[j]*Trtemp[j-i];
X		y+=Atemp2[j]*Trtemp[j-i];
X	      }
X	    A2[i]+=x;
X	    Ares[i]-=y;
X	  }
X	for (i=1;i<k;i++)
X	  {
X	    x = 0.0;
X	    for (j=i;j<k;j++)
X	      x += Tr2[j-i]*Atemp[j]-Atemp2[j]*Tres[j-i] ; 
X	    A1[i]+=i*x;
X	  }
X	A1[0] += Ares[0]*Tr2[0]-A2[0]*Tres[0];
X	break;
X	
X      case cos_op:
X        result = get_locint_r();
X        loc2 = get_locint_r();
X        loc1 = get_locint_r();
X        stored_val = get_val_r();
X	A2 = A[loc2];
X	Ares = A[result];
X	A1 = A[loc1];
X	Tr1 = Tr[loc1];
X	Tres = Tr[result];
X	Tr2 = Tr[loc2];
X	for (i=k-2;i>=0;i--)
X	  {
X	    x = 0.0;
X	    y = 0.0;
X	    Atemp[i+1] = Ares[i+1] / (i+1);
X	    Atemp2[i+1] = A2[i+1] / (i+1);
X	    Trtemp[k-1-i] = (k-1-i) * Tr1[k-1-i];
X	    for (j=i+1;j<k;j++)
X	      {
X		x+=Atemp2[j]*Trtemp[j-i];
X		y+=Atemp[j]*Trtemp[j-i];
X	      }
X	    Ares[i]+=x;
X	    A2[i]-=y;
X	  }
X	for (i=1;i<k;i++)
X	  {
X	    x = 0.0;
X	    for (j=i;j<k;j++)
X	      x += Tres[j-i]*Atemp2[j]-Atemp[j]*Tr2[j-i] ;
X	    A1[i]+=i*x;
X	  }
X	A1[0] += A2[0]*Tres[0]-Ares[0]*Tr2[0];
X	break;
X	
X      case sqrt_op:
X        result = get_locint_r();
X        loc1=get_locint_r();
X	Ares = A[result];
X	A1 = A[loc1];
X	Tres = Tr[result];
X        if (Tres[0]==0.0)
X          r0=0.0;
X        else 
X	  r0=1.0/Tres[0];
X	for (i=k-2;i>0;i--)
X	  {
X	    x = 0.0;
X	    for (j=i+1;j<k;j++)
X	      x += Ares[j]*Tres[j-i];
X	    Ares[i]-=r0*x;
X	  }
X	x = 0.0;
X	r_0 = r0/2;
X	for (i=1;i<k;i++)
X	  {
X	    x+=Ares[i]*Tres[i];
X	    A1[i] += r_0*Ares[i];   
X	  }
X	Ares[0] -= x*r0;
X	A1[0] += r_0*Ares[0];
X	break;
X      case abs_val:
X        result = get_locint_r();
X        loc1=get_locint_r();
X        Ares = A[result];
X        A1 = A[loc1];
X        Tres = Tr[result];
X        Tr1 = Tr[loc1];
X        x = 0.0;
X        j=0;
X        for (i=0;i<k;i++)
X        {
X          if((x==0.0) && (Tr1[i]!=0.0))
X          {
X            j=i;
X            if (Tr1[i]<0.0)
X              x = -1.0;
X            else
X              x=1.0;
X          }
X        }
X        for (i=j;i<k;i++)
X          A1[i] += x*Ares[i];
X        break;
X	
X
X      case asin_op:
X      case acos_op:
X      case atan_op:
X      case gen_quad:
X        result = get_locint_r();
X        loc2 = get_locint_r();
X        loc1 = get_locint_r();
X        stored_val = get_val_r();
X	Ares = A[result];
X	A2 = A[loc2];
X	A1 = A[loc1];
X	Tr1 = Tr[loc1];
X	Tr2 = Tr[loc2];
X	for (i=k-1;i>0;i--)
X	  {
X	    Atemp[i] = Ares[i] / i;
X	    Trtemp[k-i] = (k-i)*Tr1[k-i];
X	    x = 0.0;
X	    for (j=i;j<k;j++)
X	      x+=Atemp[j]*Trtemp[j-i+1];
X	    A2[i-1]+=x;
X	  }
X	A1[0]+=Tr2[0]*Ares[0];
X	for (i=1;i<k;i++)
X	  {
X	    x = 0.0;
X	    for (j=i;j<k;j++)
X	      x+=Atemp[j]*Tr2[j-i];
X	    A1[i]+=i*x;
X	  }
X	break;      
X	
X      case log_op:
X        result = get_locint_r();
X        loc1=get_locint_r();
X	Ares = A[result];
X	A1 = A[loc1];
X	Tr1 = Tr[loc1];
X	Tres = Tr[result];
X	r0=1/Tr1[0];
X	for (i=k-2;i>0;i--)
X	  {
X	    x = 0.0;
X	    Atemp[i+1] = Ares[i+1] / (i+1);
X	    for (j=i+1;j<k;j++)
X	      x+=Atemp[j]*Tr1[j-i];
X	    Ares[i]-=x*i*r0;
X	  }
X	x = 0.0;
X	for (i=1;i<k;i++)
X	  {
X	    x += Ares[i]*Tres[i];
X	    Trtemp[i] = i * Tres[i];
X	  }
X	r_0 = x/r0;
X	for (i=1;i<k;i++)
X	  {
X	    x=Ares[i];
X	    for (j=i+1;j<k;j++)
X	      x-=Atemp[j]*Trtemp[j-i];
X	    A1[i]+=r0*x;
X	  }
X	A1[0]+=r0*Ares[0]-r0*r0*r_0; 
X	break;
X
X	/* Vector Operations */
X
X      case int_av_av:
X        result_v= get_locint_r();
X        size = get_locint_r();
X        loc1_v = get_locint_r();
X	for (l=0;l<size;l++)
X	  {
X	    loc1 = result_v + l;   /* Location of left-hand-side  */
X	    loc2 = loc1_v + l;   /* Location of right-hand-side */
X	    /* code for int_adb_a */
X	    A1 = A[loc2];
X	    Ares = A[loc1];
X	    for (i=0;i<k;i++)
X	      {
X		A1[i]+=Ares[i];
X		Ares[i] = 0.0;
X	      }
X	  }
X	break;
X      case assign_dv:
X        loc1_v = get_locint_r();
X        size = get_locint_r();
X        d = get_val_v_r(size);
X	for (l=size-1;l>=0;l--)
X	  {
X	    loc1 = loc1_v + l;           /* Location of left-hand-side */
X	    stored_val = d[l];           /* Value of right-hand-side   */     
X	    /* code for assign_d */
X	    Ares = A[loc1];
X	    for (i=0;i<k;i++)
X	      *Ares++ = 0.0;
X	    get_taylors(loc1,k);
X	  }
X	break;
X      case assign_av:
X        loc1_v = get_locint_r();
X        size = get_locint_r();
X        loc2_v = get_locint_r();
X	for (l=size-1;l>=0;l--)
X	  {
X	    loc1 = loc1_v + l;             /* Location of left-hand-side  */
X	    loc2 = loc2_v + l;             /* Location of right-hand-side */
X	    /* code for assign_a */
X	    get_taylors(loc1,k);
X	    A1 = A[loc2];
X	    Ares = A[loc1];
X	    for (i=0;i<k;i++)
X	      {
X		A1[i]+=Ares[i];
X		Ares[i] = 0.0;
X	      }
X	  }
X	break;
X      case assign_indvec:
X        loc1_v = get_locint_r();
X        size = get_locint_r();
X	for (l=size-1;l>=0;l--)
X	  {
X	    loc1 = loc1_v + l;             /* Location of the left-hand-side */
X	    /* code for assign_ind */
X	    get_taylors(loc1,k);
X	    Ares = A[loc1];
X	    for (i=0;i<k;i++)
X	      results[indexi][k-1-i]= *Ares++;
X	    indexi--;
X	  }
X	reset_val_r();
X	break;
X      case assign_depvec:
X        loc1_v = get_locint_r();
X        size = get_locint_r();
X	for (l=size-1;l>=0;l--)
X	  {
X	    loc1 = loc1_v + l;             /* Location of the left-hand-side */
X	    /* code for assign_dep */
X	    Ares = A[loc1];
X	    Ares[k-1] = lagrange[indexd];
X	    indexd--;
X	  }
X	break;
X      case eq_min_av:
X        result_v = get_locint_r();
X        size = get_locint_r();
X        loc1_v = get_locint_r();
X	for (l=size-1;l>=0;l--)
X	  {
X	    result = result_v + l;            /* Location of left-hand-side  */
X	    loc1   = loc1_v + l;              /* Location on right-hand-side */
X	    /* code for eq_min_a */ 
X	    get_taylors(result,k);
X	    Ares=A[result];
X	    A1=A[loc1];
X	    for (i=0;i<k;i++)
X	      *A1++ -= *Ares++;
X	  }
X	break;
X      case eq_plus_av:
X        result_v = get_locint_r();
X        size = get_locint_r();
X        loc1_v = get_locint_r();
X	for (l=size-1;l>=0;l--)
X	  {
X	    result = result_v + l;            /* Location of left-hand-side  */
X	    loc1   = loc1_v   + l;            /* Location on right-hand-side */
X	    /* code for eq_plus_a */
X	    get_taylors(result,k);
X	    Ares=A[result];
X	    A1=A[loc1];
X	    for (i=0;i<k;i++)
X	      *A1++ += *Ares++;
X	  }
X	break;
X      case eq_mult_av_a:
X        result_v = get_locint_r();
X        size = get_locint_r();
X        loc1 = get_locint_r();
X	for (l=size-1;l>=0;l--)
X	  {
X	    result = result_v + l;      /* Location of the left-hand-side  */
X	    /* loc1   = fixed;             Location on the right-hand-side */
X     
X	    /* code for eq_mult_a*/
X	    get_taylors(result,k);
X	    Tres = Tr[result];
X	    Tr1 = Tr[loc1];
X	    A1 = A[loc1];
X	    Ares = A[result]; 
X	    for (i=k-1;i>=0;i--)
X	      {
X		x = 0.0;
X		y = 0.0;
X		Atemp[i] = Ares[i];
X		Ares[i] = 0;
X		for (j=i;j<k;j++)
X		  {
X		    x+=Atemp[j]*Tres[j-i];
X		    y+=Atemp[j]*Tr1[j-i];
X		  }
X		A1[i]+=x;
X		Ares[i]+=y;
X	      }
X	  }
X	break;
X      case eq_mult_av_d:
X        result_v = get_locint_r();
X        size = get_locint_r();
X        stored_val = get_val_r();
X	for (l=size-1;l>=0;l--)
X	  {
X	    result = result_v + l;      /* Location of the left-hand-side  */
X	    /* stored_val = fixed;         value on the right-hand-side */
X	    /* code for eq_mult_d*/
X	    get_taylors(result,k);
X	    A1 = A[result];
X	    for (i=0;i<k;i++)
X	      A1[i]*=stored_val;
X	  }
X	break;
X      case plus_av_av:
X        result_v = get_locint_r();
X        size     = get_locint_r();
X        loc2_v   = get_locint_r();
X        loc1_v   = get_locint_r();
X	for (l=0;l<size;l++)
X	  {
X	    loc2   = loc2_v    + l;       /* Location of var 2  */
X	    loc1   = loc1_v    + l;       /* Location of var 1  */
X	    result = result_v  + l;       /* Location of result */
X	    /* code for plus_a_a */
X	    Ares = A[result];
X	    A1 = A[loc1];
X	    A2 = A[loc2];
X	    for (i=0;i<k;i++)
X	      {
X		*A1++ += *Ares;
X		*A2++ += *Ares++;
X	      }
X	  }
X	break;
X      case sub_av_av:
X        result_v = get_locint_r();
X        size     = get_locint_r();
X        loc2_v   = get_locint_r();
X        loc1_v   = get_locint_r();
X	for (l=0;l<size;l++)
X	  {
X	    loc2   = loc2_v    + l;       /* Location of var 2  */
X	    loc1   = loc1_v    + l;       /* Location of var 1  */
X	    result = result_v  + l;       /* Location of result */
X	    /* code for min_a_a */
X	    Ares = A[result];
X	    A1 = A[loc1];
X	    A2 = A[loc2];
X	    for (i=0;i<k;i++)
X	      {
X		*A1++ += *Ares;
X		*A2++ -= *Ares++;
X	      }
X	  }
X	break;
X      case dot_av_av:
X        result_v = get_locint_r();
X        size     = get_locint_r();
X        loc2_v   = get_locint_r();
X        loc1_v   = get_locint_r();
X	result = result_v;
X	for (l=0;l<size;l++)
X	  {
X	    loc2 = loc2_v + l;
X	    loc1 = loc1_v + l;
X	    /* code for mult_a_a  */
X	    Ares = A[result];
X	    A2 = A[loc2];
X	    A1 = A[loc1];
X	    Tr1 = Tr[loc1];
X	    Tr2 = Tr[loc2];
X	    for (i=0;i<k;i++)
X	      {
X		x = 0.0;
X		y = 0.0;
X		for (j=i;j<k;j++)
X		  {
X		    x+=Ares[j]*Tr1[j-i];
X		    y+=Ares[j]*Tr2[j-i];
X		  }
X		A2[i]+=x;
X		A1[i]+=y;
X	      }
X	  }
X	Ares = A[result];
X	for (i=0;i<k;i++)
X	  *Ares++ = 0.0;
X	break;
X      case mult_d_av:
X        result_v = get_locint_r();
X        size = get_locint_r();
X        loc1_v = get_locint_r();
X        stored_val =get_val_r();
X	for (l=0;l<size;l++)
X	  {
X	    loc1   = loc1_v   + l;   /* Location on the right-hand-side */
X	    result = result_v + l;   /* location of the result */
X	    /* stored_val = Fixed double value */
X	    
X	    /* code for mult_d_a */
X	    Ares = A[result];
X	    A1= A[loc1];
X	    for (i=0;i<k;i++)
X	      *A1++ += stored_val* (*Ares++);
X	  }
X	break;
X      case div_av_a:
X        result_v = get_locint_r();
X        size     = get_locint_r();
X        loc2_v   = get_locint_r();
X        loc1_v   = get_locint_r();
X	loc2= loc2_v;     /* Location of adouble */
X	for (l=0;l<size;l++)
X	  {
X	    loc1   = loc1_v   + l;  /* Location of right-hand-side vector[l] */
X	    result = result_v + l;  /* Location of the result */
X	    
X	    /* code for div_a_a */
X	    Tr2 = Tr[loc2];
X	    Tres = Tr[result];
X	    Ares = A[result];
X	    A2 = A[loc2];
X	    A1 = A[loc1];
X	    r0=1/Tr2[0];
X	    for (i=k-2;i>=0;i--)
X	      {
X		x = 0.0;
X		for (j=i+1;j<k;j++)
X		  x+=Ares[j]*Tr2[j-i];
X		Ares[i]-=x*r0;
X	      }
X	    r_0 = 0.0;
X	    for (i=0;i<k;i++)
X	      r_0+=Ares[i]*Tres[i]; 
X	    A2[0]-=r_0*r0;
X	    
X	    for (i=1;i<k;i++)
X	      {
X		x = 0.0;
X		for (j=i;j<k;j++)
X		  x+=Ares[j]*Tres[j-i];
X		A2[i]-=x*r0;
X	      }
X	    for (i=0;i<k;i++)
X	      A1[i]+=r0*Ares[i];
X	  }
X	break;
X      case mult_av_a:
X        result_v = get_locint_r();
X        size     = get_locint_r();
X        loc2_v   = get_locint_r();
X        loc1_v   = get_locint_r();
X	loc2= loc2_v;   /* Location of adouble */
X	for (l=0;l<size;l++)
X	  {
X	    loc1   = loc1_v   + l; /* Location of right-hand-side vector[l] */
X	    result = result_v + l; /* Location of the result */
X     
X	    /* code for mult_a_a */
X	    Ares = A[result];
X	    A2 = A[loc2];
X	    A1 = A[loc1];
X	    Tr1 = Tr[loc1];
X	    Tr2 = Tr[loc2];
X	    for (i=0;i<k;i++)
X	      {
X		x = 0.0;
X		y = 0.0;
X		for (j=i;j<k;j++)
X		  {
X		    x+=Ares[j]*Tr1[j-i];
X		    y+=Ares[j]*Tr2[j-i];
X		  }
X		A2[i]+=x;
X		A1[i]+=y;
X	      }
X	  }
X	break;
X      case mult_a_av:
X        result_v = get_locint_r();
X        size     = get_locint_r();
X        loc2_v   = get_locint_r();
X        loc1_v   = get_locint_r();
X	loc1= loc2_v;      /* Location of the adouble */
X	for (l=0;l<size;l++)
X	  {
X	    loc2= loc1_v+l;         /* Location of rght hnd side vectore[l]  */
X	    result = result_v + l;  /* Location of the result */
X	    
X	    /* code for mult_a_a */
X	    Ares = A[result];
X	    A2 = A[loc2];
X	    A1 = A[loc1];
X	    Tr1 = Tr[loc1];
X	    Tr2 = Tr[loc2];
X	    for (i=0;i<k;i++)
X	      {
X		x = 0.0;
X		y = 0.0;
X		for (j=i;j<k;j++)
X		  {
X		    x+=Ares[j]*Tr1[j-i];
X		    y+=Ares[j]*Tr2[j-i];
X		  }
X		A2[i]+=x;
X		A1[i]+=y;
X	      }
X	  }
X	break;
X#ifdef conditional
X      case cond_assign:
X        result = get_locint_r();
X        loc2 = get_locint_r();
X        loc1 = get_locint_r();
X        loc1_v = get_locint_r(); 
X	get_taylors(result,k);
X        Tr1 = Tr[loc1_v];
X	Ares = A[result];
X        if(*Tr1>0)
X        {
X          A1 = A[loc1];
X	  for (i=0;i<k;i++)
X	  {
X	    A1[i]+=Ares[i];
X	    Ares[i] = 0.0;
X	  } /* endfor */
X        } /* endif */
X        else
X        {
X          A1 = A[loc2];
X          for (i=0;i<k;i++)
X          {
X            A1[i]+=Ares[i];
X            Ares[i] = 0.0;
X          } /* endfor */
X        } /* endelse */
X	break;
X      case cond_assign_s:
X        result = get_locint_r();
X        loc1 = get_locint_r();
X        loc1_v = get_locint_r(); 
X        get_taylors(result,k);
X        Tr1 = Tr[loc1_v];
X        if(*Tr1>0)
X        {
X          A1 = A[loc1];
X          Ares = A[result];
X          for (i=0;i<k;i++)
X          {
X            A1[i]+=Ares[i];
X            Ares[i] = 0.0;
X          } /* endfor */
X        } /* endif */
X	break;
X      case subscript:
X        result = get_locint_r();
X        loc1 = get_locint_r();
X        loc1_v = get_locint_r(); 
X	get_taylors(result,k);
X	A1 = A[loc1_v+(int)(Tr[loc1][0])];
X	Ares = A[result];
X	for (i=0;i<k;i++)
X	  {
X	    A1[i]+=Ares[i];
X	    Ares[i] = 0.0;
X	  }
X	break;
X      case subscript_l:
X        result = get_locint_r();
X        loc1 = get_locint_r();
X        loc1_v = get_locint_r(); 
X	get_taylors(loc1_v+(int)(Tr[loc1][0]),k);
X	A1 = A[result];
X	Ares = A[loc1_v+(int)(Tr[loc1][0])];
X	for (i=0;i<k;i++)
X	  {
X	    A1[i]+=Ares[i];
X	    Ares[i] = 0.0;
X	  }
X	break;
X      case subscript_ld:
X        loc1 = get_locint_r();
X        loc1_v = get_locint_r(); 
X        stored_val = get_val_r();
X        arg=loc1_v+(int)(Tr[loc1][0]);
X	Ares = A[arg];
X	for (i=0;i<k;i++)
X	  *Ares++ = 0.0;
X	break;
X      case m_subscript:
X        result = get_locint_r();
X        size = get_locint_r();
X        loc1 = get_locint_r();
X        loc1_v = get_locint_r(); 
X        for (l=size-1;l>=0;l--)
X        {
X          res=result+l;
X          arg=loc1_v+(int)(Tr[loc1][0])*size+l;
X	  A1 = A[arg];
X	  Ares = A[res];
X	  for (i=0;i<k;i++)
X	  {
X	    A1[i]+=Ares[i];
X	    Ares[i] = 0.0;
X	  } /* endfor */
X        } /* endfor */
X	break;
X      case m_subscript_l:
X        result = get_locint_r();
X        size = get_locint_r();
X        loc1 = get_locint_r();
X        loc1_v = get_locint_r(); 
X        for (l=size-1;l>=0;l--)
X        {
X          res= result+l;
X          arg= loc1_v+(int)(Tr[loc1][0])*size+l;
X	  get_taylors(arg,k);
X	  A1 = A[res];
X	  Ares = A[arg];
X	  for (i=0;i<k;i++)
X	  {
X	    A1[i]+=Ares[i];
X	    Ares[i] = 0.0;
X	  } /* endfor */
X        } /* endfor */
X	break;
X      case m_subscript_ld:
X        size = get_locint_r();
X        loc2 = get_locint_r();
X        loc1 = get_locint_r();
X        loc1_v = get_locint_r(); 
X        d = get_val_v_r(size);
X        for (l=size-1;l>=0;l--)
X        {
X          arg=loc1_v+(int)(Tr[loc1][0])*size+l+loc2;
X	  Ares = A[arg];
X	  for (i=0;i<k;i++)
X	    *Ares++ = 0.0;
X        } /* endfor */
X	break;
X#endif	
X
X
X	default:
X	/*             Die here, we screwed up     */ 
X	printf("ADOL-C error: Fatal error in hos_reverse on operation  %d\n",
X	       operation);
X	exit(-1);
X	break;
X      }
X
X      /* Get the next operation */
X
X      operation=get_op_r();
X    }
X
X  end_sweep();
X}
X
X#ifdef __cplusplus
X}
X#endif
X
END_OF_FILE
if test 27609 -ne `wc -c <'hos_reverse.c'`; then
    echo shar: \"'hos_reverse.c'\" unpacked with wrong size!
fi
chmod +x 'hos_reverse.c'
# end of 'hos_reverse.c'
fi
if test -f 'hov_forward.c' -a "${1}" != "-c" ; then 
  echo shar: Will not clobber existing file \"'hov_forward.c'\"
else
echo shar: Extracting \"'hov_forward.c'\" \(35205 characters\)
sed "s/^X//" >'hov_forward.c' <<'END_OF_FILE'
X/*
X   ----------------------------------------------------------------
X   File hov_forward.c of ADOL-C version 1.6 as of January 1,   1995
X   ----------------------------------------------------------------
X   Contains the routine hov_forward (higher-order-vector forward
X   mode).
X
X*/
X
X#ifdef __cplusplus
Xextern "C" {
X#endif
X
X
X#include "dvlparms.h" /* Developers Parameters */
X#include "usrparms.h"
X#include "oplate.h"
X#include "taputil1.h"
X#include "taputil2.h"
X#include "taputil3.h"
X#include "tayutil.h"
X#include "adutilsc.h"
X
Xstatic short tag;
X
Xstatic int for_location_cnt;
Xstatic int dep_cnt;
Xstatic int ind_cnt;
Xstatic int degree;
X
X/****************************************************************************/
X/* Higher Order Vector version of the forward mode.                         */
X/****************************************************************************/
Xvoid hov_forward(short tnum,         /* tape id */
X		 int depcheck,       /* consistency chk on # of dependents */
X		 int indcheck,       /* consistency chk on # of independents */
X		 int gdegree,        /* highest derivative degree */
X		 int p,              /* # of taylor series */
X                 double *basepoint,  /* independent variable values */
X		 double ***argument, /* Taylor coefficients (input) */
X                 double *valuepoint, /* Taylor coefficients (output) */
X		 double ***taylors)  /* matrix of coifficient vectors */
X/* the order of the indices in argument and taylors is [var][taylor][deriv] */
X{
X  unsigned char operation;
X  int tape_stats[11];  /* tape stats */
X
X  locint size = 0;
X  locint result=0;
X  locint result_v=0;
X  locint loc1=0;
X  locint loc1_v=0;
X  locint loc2=0;
X  locint loc2_v=0;
X  double stored_val=0.0;
X  double *d = 0;
X
X  int k, i, j ,l, rloc,pl;
X  double r0;
X  locint arg,arg1,arg2,res;
X  int indexi =0; 
X  int indexd =0;
X  double  *Targ,*Tres,*Tqo,*Targ1,*Targ2,*Tloc1,*Tloc2; 
X  double coval,divs;
X  int buffer; 
X  double x,y;
X  static int fax, kax;
X  static double *Tdum; 
X  double *z;
X  int even;
X  double* T0;
X  double*** T;
X
X#ifdef inf_num
Xdouble i_num=inf_num;
Xdouble i_den=inf_den;
Xdouble n_num=non_num;
Xdouble n_den=non_den;
Xdouble InfVal;
Xdouble NoNum;
X#endif
X
X  degree = gdegree;
X  tag = tnum;         /*tag is global which specifies which tape to look at */
X  k = degree + 1;
X  
X  tapestats(tag,tape_stats);
X
X  ind_cnt = tape_stats[0];
X  dep_cnt = tape_stats[1];
X  for_location_cnt = tape_stats[2];
X  buffer =  tape_stats[4];
X
X  set_buf_size(buffer);
X  T0 = (double*)malloc(for_location_cnt*sizeof(double));
X  T = (double***)myalloc3(for_location_cnt,p,degree); 
X  z = (double*)malloc(k*sizeof(double));
X  if ((depcheck != dep_cnt)||(indcheck != ind_cnt))
X    {
X      printf("ADOL-C error: forward sweep on tape %d  aborted!\n",tag);
X      printf("Number of dependent and/or independent variables passed to forward is\ninconsistant with number recorded on tape %d \n",tag);
X      exit (-1);
X    } /* endif */
X  
X
X  /* Initialize the Forward Sweep */
X  init_for_sweep(tag);
X
X
X  operation=get_op_f();
X  while (operation !=end_of_tape)
X    {
X      switch (operation){
X      case end_of_op:
X        get_op_block_f();
X        operation=get_op_f(); 
X        /* Skip next operation, it's another end_of_op */
X        break;
X      case end_of_int:
X        get_loc_block_f();
X        break;
X      case end_of_val:
X        get_val_block_f();
X        break;
X      case start_of_tape:
X      case end_of_tape:
X	break;
X      case int_adb_a:  /* initialize an adouble */	
X        arg = get_locint_f();
X        res = get_locint_f();
X	Targ = *T[arg];
X        Tres = *T[res]; 
X        T0[res]= T0[arg];
X        for (l=0;l<p;l++)
X        {
X          for (i=0;i<k-1;i++)
X	    Tres[i]=Targ[i];
X          Targ+=degree;
X          Tres+=degree;
X        } /* endfor*/
X	break;
X      case assign_a:  /* assign an adouble variable an adouble value. (=) */
X        arg = get_locint_f();
X        res = get_locint_f();
X	Targ = *T[arg];
X        Tres = *T[res];
X        T0[res]= T0[arg];
X        for (l=0;l<p;l++)
X        {
X          for (i=0;i<k-1;i++)
X            Tres[i]=Targ[i];
X          Targ+=degree;
X          Tres+=degree;
X        } /* endfor*/
X        break;
X      case int_adb_d: /* initialize an double */
X        res = get_locint_f();
X        coval = get_val_f();
X	Tres = *T[res];
X	T0[res]=coval;
X        for (l=0;l<p;l++)
X        {
X	  for (i=0;i<k-1;i++)
X	    Tres[i]=0;
X          Tres+=degree;
X        } /* endfor*/
X	break;
X      case assign_d: /* assign an adouble variable a float value. (=) */
X        res = get_locint_f();
X        coval = get_val_f();
X	Tres = *T[res];
X	T0[res]=coval;
X        for (l=0;l<p;l++)
X        {
X          for (i=0;i<k-1;i++)
X            Tres[i]=0;
X          Tres+=degree;
X        } /* endfor*/
X	break;
X      case assign_ind: /* assign an adouble variable an independent 
X                          float value (<<=) */
X        res = get_locint_f();
X	Tres = *T[res];
X        T0[res]=basepoint[indexi];
X        for (l=0;l<p;l++)
X        {
X	  for (i=0;i<k-1;i++)
X	    Tres[i]=argument[indexi][l][i];
X          Tres+=degree;
X        } /* endfor*/
X	++indexi;
X	break;
X      case assign_dep: /* assign a float variable a 
X                          dependent adouble value. (>>=) */
X	res = get_locint_f();
X	Tres = *T[res];
X        valuepoint[indexd]=T0[res];
X        if (taylors != 0 )  
X        {
X          for (l=0;l<p;l++)
X          {
X	    for (i=0;i<k-1;i++)
X	      taylors[indexd][l][i] = Tres[i];
X            Tres+=degree;
X          } /* endfor*/
X        } /* endif */
X	indexd++;
X	break;
X      case eq_plus_d: /* Add a floating point to an adouble. (+=) */
X        res=get_locint_f();
X        coval = get_val_f();
X        T0[res]+= coval;
X	break;
X      case eq_plus_a: /* Add an adouble to another adouble. (+=) */
X        arg=get_locint_f();
X        res=get_locint_f();
X	Tres = *T[res];
X	Targ = *T[arg];
X        T0[res]+= T0[arg];
X        for (l=0;l<p;l++)
X        {
X          for (i=0;i<k-1;i++)
X	    Tres[i]+=Targ[i];
X          Tres+= degree;
X          Targ+=degree;
X        } /* endfor */
X	break;
X      case eq_min_d: /* Subtract a floating point from an adouble. (-=) */
X        res=get_locint_f();
X        coval = get_val_f();
X	T0[res]-=coval;
X	break;
X      case eq_min_a: /* Subtract an adouble from another adouble. (-=) */
X        arg=get_locint_f();
X        res=get_locint_f();
X	Tres = *T[res];
X	Targ = *T[arg];   
X        T0[res]-=T0[arg];
X        for (l=0;l<p;l++)
X        {
X	  for (i=0;i<k-1;i++)
X	    Tres[i]-=Targ[i];
X          Tres+= degree;
X          Targ+=degree;
X        } /* endfor */
X	break;
X      case eq_mult_d:  /* Multiply an adouble by a float. (*=) */
X        res=get_locint_f();
X        coval = get_val_f();
X	Tres = *T[res];
X        T0[res]*=coval;
X        for (l=0;l<p;l++)
X        {
X	  for (i=0;i<k-1;i++)
X	    Tres[i]*=coval;
X          Tres+= degree;
X        } /* endfor */
X	break;
X      case eq_mult_a: /* Multiply one adouble by another. (*=) */
X        arg=get_locint_f();
X        res=get_locint_f();
X	Tres = *T[res];
X	Targ = *T[arg];
X        for( l = 0; l < p; l++)
X        {
X          for (i=k-2;i>=0;i--)
X          {
X  	    x=T0[res]*Targ[i];
X   	    for (j=0;j<i;j++)
X              x+=Tres[j]*Targ[i-j-1];
X            x+=Tres[i]*T0[arg]; 
X            Tres[i]=x;
X          } /* endfor */
X          Tres += degree;
X          Targ += degree;
X        } /* endfor */
X        T0[res]*=T0[arg];
X	break;
X      case plus_a_a: /* Add two adoubles. (+) */
X        arg1=get_locint_f();
X        arg2=get_locint_f();
X        res =get_locint_f();
X	Tres = *T[res];
X	Targ1 = *T[arg1];
X	Targ2 = *T[arg2];
X        T0[res]=T0[arg1]+T0[arg2];
X        for( l = 0; l < p; l++)
X        {
X	  for (i=0;i<k-1;i++)
X	    Tres[i]=Targ1[i]+Targ2[i];
X          Tres += degree;
X          Targ1+= degree;
X          Targ2+= degree;
X        } /* endfor */
X	break;
X      case plus_d_a: /* Add an adouble and a double. (+) */
X        arg=get_locint_f();
X        res = get_locint_f();
X        coval = get_val_f();
X	Tres = *T[res];
X	Targ = *T[arg];
X	T0[res]=T0[arg]+coval;
X        for( l = 0; l < p; l++)
X        {
X	  for (i=0;i<k-1;i++)
X	    Tres[i]=Targ[i];
X          Tres += degree;
X          Targ += degree;
X        } /* endfor */
X	break;
X      case min_a_a: /* Subtraction of two adoubles. (-) */
X        arg1=get_locint_f();
X        arg2=get_locint_f();
X        res =get_locint_f();
X	Tres = *T[res];
X	Targ1 = *T[arg1];
X	Targ2 = *T[arg2];
X        T0[res]=T0[arg1]-T0[arg2];
X        for( l = 0; l < p; l++)
X        {
X          for (i=0;i<k-1;i++)
X            Tres[i]=Targ1[i]-Targ2[i];
X          Tres += degree;
X          Targ1+= degree;
X          Targ2+= degree;
X        } /* endfor */
X	break;
X      case min_d_a: /* Subtract an adouble from a double. (-) */
X        arg=get_locint_f();
X        res = get_locint_f();
X        coval = get_val_f();
X        Tres = *T[res];
X        Targ = *T[arg];
X	T0[res]=coval-T0[arg];
X        for( l = 0; l < p; l++)
X        {
X	  for (i=0;i<k-1;i++)
X	    Tres[i] = -Targ[i];
X          Tres += degree;
X          Targ += degree;
X        } /* endfor */
X	break;
X      case mult_a_a: /* Multiply two adoubles. (*) */
X        arg1=get_locint_f();
X        arg2=get_locint_f();
X        res =get_locint_f();
X        Tres = *T[res];
X        Targ1 = *T[arg1];
X        Targ2 = *T[arg2];
X        T0[res]=T0[arg1]*T0[arg2];
X        for( l = 0; l < p; l++)
X        {
X	  for (i=0;i<k-1;i++)
X	  {
X            x=T0[arg1]*Targ2[i];
X            for (j=0;j<i;j++)
X              x+=Targ1[j]*Targ2[i-j-1];
X            x+=Targ1[i]*T0[arg2];
X            Tres[i]=x;
X	  } /* endfor*/
X          Tres += degree;
X          Targ1 += degree;
X 	  Targ2 += degree;
X        } /* endfor */
X	break;
X      case mult_d_a: /* Multiply an adouble by a double. (*) */
X        arg=get_locint_f();
X        res = get_locint_f();
X        coval = get_val_f();
X        Tres = *T[res];
X        Targ = *T[arg];
X        T0[res]=T0[arg]*coval;
X        for( l = 0; l < p; l++)
X        {
X	  for (i=0;i<k-1;i++)
X	    Tres[i]=Targ[i]*coval;
X          Tres += degree;
X          Targ += degree;
X        } /* endfor */
X	break;
X      case div_a_a: /* Divide an adouble by an adouble. (/) */
X        arg1=get_locint_f();
X        arg2=get_locint_f();
X        res =get_locint_f();
X        Tres = *T[res];
X        Targ1 = *T[arg1];
X        Targ2 = *T[arg2];
X	divs   = 1/T0[arg2];
X        T0[res]=T0[arg1]*divs;
X        for( l = 0; l < p; l++)
X        {
X	  for (i=0;i<k-1;i++)
X	  {
X	    x=Targ1[i]*divs;
X            x+=T0[res]*(-Targ2[i]*divs);
X	    z[i]= -Targ2[i]*divs;
X	    for (j=0;j<i;j++)
X	      x+=Tres[j]*z[i-j-1];
X	    Tres[i]=x;
X	  } /* endfor */
X          Tres += degree;
X          Targ1 += degree;
X          Targ2 += degree;
X        } /* endfor */
X	break;
X      case div_d_a: /* Division double - adouble. (/) */
X        arg=get_locint_f();
X        res = get_locint_f();
X        coval = get_val_f();
X        Tres = *T[res];
X        Targ = *T[arg];
X	divs = 1/T0[arg];
X	T0[res]=coval*divs;
X        for( l = 0; l < p; l++)
X        {
X	  for (i=0;i<k-1;i++)
X	  {
X	    x=0;
X	    z[i]=-Targ[i]*divs;
X            x+=T0[res]*z[i];
X	    for (j=0;j<i;j++)
X	      x+=Tres[j]*z[i-j-1];
X	    Tres[i] = x;
X	  } /* endfor */
X          Tres += degree;
X          Targ += degree;
X        } /* endfor */
X	break;
X      case sqrt_op: /* Compute sqrt of adouble. */
X        arg=get_locint_f();
X        res= get_locint_f();
X        Targ = *T[arg];
X	Tres = *T[res];
X	T0[res]=sqrt(T0[arg]);
X        for( l = 0; l < p; l++)
X        {
X          if (Targ[0]==0.0){
X#ifdef inf_num
X  InfVal=i_num/i_den;
X  NoNum=n_num/n_den;
X#endif
X            r0=0.0;
X            for (i=1;i<k;i++){
X              if (Targ[i]>0.0){
X                r0=InfVal;
X                i=k;
X              } /* end if */
X              if (Targ[i]<0.0){
X                r0=NoNum;
X                i=k;
X              } /* end if */
X            } /* end for */
X          } /* end if */
X          else {
X            r0 = 0.5/T0[res];
X          } /* end else */
X	  even =0;
X	  for (i=1;i<k;i++)
X	  {
X	    x=0;
X	    for (j=1;2*j<i;j++)
X	      x+=Tres[j-1]*Tres[i-j-1];
X	    x *= 2;
X	    if(even) 
X              x += Tres[i/2-1]*Tres[i/2-1];
X	    even = !even;
X	    Tres[i-1]=r0*(Targ[i-1]-x);
X	  } /* endfor */
X          Tres += degree;
X          Targ += degree;
X        } /* endfor */
X	break;
X      case abs_val: /* Compute fabs of adouble. */
X        arg=get_locint_f();
X        res= get_locint_f();
X        Targ = *T[arg];
X        Tres = *T[res];
X        T0[res]=fabs(T0[arg]);
X        y=0.0;
X        if (Targ[0]!=0.0)
X        {
X          if (Targ[0]<0.0)
X            y = -1.0;
X          else
X            y=1.0;
X        }
X        for( l = 0; l < p; l++)
X        {
X          x=y;
X          for (i=0;i<k-1;i++)
X          {
X            if((x==0.0) && (Targ[i]!=0.0))
X            {
X              if (Targ[i]<0.0)
X                x=-1.0;
X              else
X                x=1.0;
X            }
X            Tres[i] = x*Targ[i];
X          } /* endfor */
X          Tres += degree;
X          Targ += degree;
X        } /* endfor */
X        break;
X
X      case exp_op: /* exponent operation */
X        arg=get_locint_f();
X        res= get_locint_f();
X	Tres = *T[res];
X	Targ = *T[arg];
X	T0[res]=exp(T0[arg]);
X        for( l = 0; l < p; l++)
X        {
X	  for (i=0;i<k-1;i++)
X	  { 
X            double x=0;
X	    z[i] = (i+1)*Targ[i];
X            x+= T0[res]*z[i];
X	    for (j=0;j<i;j++)
X	      x+= Tres[j]*z[i-j-1];
X	    Tres[i]=x/(i+1);
X	  } /* endfor */
X          Tres += degree;
X          Targ += degree;
X        } /* endfor */
X	break;
X      case sin_op: /* sine operation */
X        arg1 = get_locint_f();
X        arg2 = get_locint_f();
X        res = get_locint_f();
X        coval = get_val_f();
X	Targ = *T[arg2];
X	Tres = *T[res]; 
X	Tqo = *T[arg1];
X	T0[arg2]=cos(T0[arg1]);
X	T0[res] = sin(T0[arg1]);
X        for( l = 0; l < p; l++)
X        {
X          for (i=0;i<k-1;i++)
X	  {
X	    x=0;y=0;
X	    z[i] = (i+1)*Tqo[i];
X            x+= T0[arg2]*z[i];
X            y+= T0[res]*z[i];
X	    for (j=0;j<i;j++)
X	      {
X		x+= Targ[j]*z[i-j-1]; 
X		y+= Tres[j]*z[i-j-1];
X	      } /* endfor */
X	    Targ[i] = -y/(i+1);
X	    Tres[i]=x/(i+1);
X	  } /* endfor */
X          Tres += degree;
X          Targ += degree;
X          Tqo += degree;
X        } /* endfor */
X	break;
X      case cos_op:  /* cosine operation */
X        arg1 = get_locint_f();
X        arg2 = get_locint_f();
X        res = get_locint_f();
X        coval = get_val_f();
X	Targ = *T[arg2];
X	Tres = *T[res];
X	Tqo = *T[arg1];
X        T0[arg2]=sin(T0[arg1]);
X        T0[res] = cos(T0[arg1]);
X        for( l = 0; l < p; l++)
X        {
X	  for (i=0;i<k-1;i++)
X	  {
X	    x=0;y=0;
X	    z[i] = (i+1)*Tqo[i];
X            x+= T0[arg2]*z[i];
X            y+= T0[res]*z[i];
X	    for (j=0;j<i;j++)
X	      {
X		x+= Targ[j]*z[i-j-1]; 
X		y+= Tres[j]*z[i-j-1];
X	      } /* endfor */
X	    Targ[i] = y/(i+1);
X	    Tres[i] = -x/(i+1);
X	  } /* endfor */
X          Tres += degree;
X          Targ += degree;
X          Tqo += degree;
X        } /* endfor */
X	break;
X      case asin_op: 
X        arg1 = get_locint_f();
X        arg2 = get_locint_f();
X        res = get_locint_f();
X        coval = get_val_f();
X        Targ = *T[arg2];
X        Tres = *T[res];
X        Tqo = *T[arg1];
X	T0[res]=asin(T0[arg1]);
X        for( l = 0; l < p; l++)
X        {
X	  for (i=0;i<k-1;i++)
X	  {
X	    x=0;
X	    z[i] = (i+1)*Tqo[i];
X            x+= T0[arg2]*z[i];
X	    for (j=0;j<i;j++)
X	      x+= Targ[j]*z[i-j-1]; 
X	    Tres[i]=x/(i+1);
X	  } /* endfor */
X          Tres += degree;
X          Targ += degree;
X          Tqo += degree;
X        } /* endfor */
X	break;
X      case acos_op:
X        arg1 = get_locint_f();
X        arg2 = get_locint_f();
X        res = get_locint_f();
X        coval = get_val_f();
X        Targ = *T[arg2];
X        Tres = *T[res];
X        Tqo = *T[arg1];
X	T0[res]=acos(T0[arg1]);
X        for( l = 0; l < p; l++)
X        {
X	  for (i=0;i<k-1;i++)
X	  {
X	    x=0;
X	    z[i] = (i+1)*Tqo[i];
X            x+= T0[arg2]*z[i];
X	    for (j=0;j<i;j++)
X	      x+= Targ[j]*z[i-j-1];
X	    Tres[i]=x/(i+1);
X	  } /* endfor */
X          Tres += degree;
X          Targ += degree;
X          Tqo += degree;
X        } /* endfor */
X	break;
X      case atan_op:
X        arg1 = get_locint_f();
X        arg2 = get_locint_f();
X        res = get_locint_f();
X        coval = get_val_f();
X        Targ = *T[arg2];
X        Tres = *T[res];
X        Tqo = *T[arg1];
X	T0[res]=atan(T0[arg1]);
X        for( l = 0; l < p; l++)
X        {
X	  for (i=0;i<k-1;i++)
X	  {
X	    x=0;
X	    z[i] = (i+1)*Tqo[i];
X            x+= T0[arg2]*z[i];
X	    for (j=0;j<i;j++)
X	      x+= Targ[j]*z[i-j-1]; 
X	    Tres[i]=x/(i+1);
X	  } /* endfor */
X          Tres += degree;
X          Targ += degree;
X          Tqo += degree;
X        } /* endfor */
X	break;
X      case gen_quad:  
X        arg1 = get_locint_f();
X        arg2 = get_locint_f();
X        res = get_locint_f();
X        coval = get_val_f();
X        Targ = *T[arg2];
X        Tres = *T[res];
X        Tqo = *T[arg1];
X	T0[res]=coval;
X        for( l = 0; l < p; l++)
X        {
X	  for (i=0;i<k-1;i++)
X	  {
X	    x=0;
X	    z[i] = (i+1)*Tqo[i];
X            x+= T0[arg2]*z[i];
X	    for (j=0;j<i;j++)
X	      x+= Targ[j]*z[i-j-1];
X	    Tres[i]=x/(i+1);
X	  } /* endfor */
X          Tres += degree;
X          Targ += degree;
X          Tqo += degree;
X        } /* endfor */
X	break;
X      case log_op:
X        arg=get_locint_f();
X        res= get_locint_f();
X	Tres = *T[res];
X	Targ = *T[arg];
X	divs = 1.0/T0[arg];
X	T0[res]=log(T0[arg]);
X        for( l = 0; l < p; l++)
X        {
X	  for (i=0;i<k-1;i++)
X	  {
X	    x=0;
X	    for (j=1;j<i+1;j++)
X	      x+= Targ[i-j]*z[j-1]; 
X	    Tres[i]=(Targ[i]-x/(i+1))*divs;
X	    z[i] = (i+1)*Tres[i];
X	  } /* endfor */
X          Tres += degree;
X          Targ += degree;
X        } /* endfor */
X	break;
X      case pow_op:
X        arg=get_locint_f();
X        res = get_locint_f();
X        coval = get_val_f();
X	Tres = *T[res];
X	Targ = *T[arg];
X	T0[res] = pow(T0[arg],coval);
X	r0 = 1/T0[arg];
X        for( l = 0; l < p; l++)
X        {
X          if (Targ[0]==0.0){
X#ifdef inf_num
X  InfVal=i_num/i_den;
X  NoNum=n_num/n_den;
X#endif
X            r0=0.0;
X            for (i=1;i<k;i++){
X              if (Targ[i]>0.0){
X                r0=InfVal;
X                i=k;
X              } /* end if */
X              if (Targ[i]<0.0){
X                r0=NoNum;
X                i=k;
X              } /* end if */
X            } /* end for */
X          } /* end if */
X          else {
X            r0 = 1.0/T0[arg];
X          } /* end else */
X	  for (i=1;i<k;i++)
X	  {
X	    x = 0 ;
X	    y = coval*i;
X            x += T0[res]*Targ[i-1]*y;
X            y -= coval+1;
X	    for (j=1;j<i;j++)
X	      {
X		x += Tres[j-1]*Targ[i-j-1]*y;
X		y -= coval+1;
X	      } /* endfor */
X	    Tres[i-1] = x*r0/i;
X	  } /* endfor */
X          Tres += degree;
X          Targ += degree;
X        } /* endfor */
X	break;
X
X      
X      case int_av_av:
X        loc1_v = get_locint_f();
X        size = get_locint_f();
X        result_v= get_locint_f();
X        for (l=0;l<size;l++)
X        {
X          res = result_v + l;   /* Location of left-hand-side  */
X          arg = loc1_v + l;   /* Location of right-hand-side */
X          /* code for int_adb_a */
X          Targ = *T[arg];
X          Tres = *T[res];
X          T0[res]= T0[arg];
X          for (pl=0;pl<p;pl++)
X          {
X            for (i=0;i<k-1;i++)
X              Tres[i]=Targ[i];
X            Tres += degree;
X            Targ += degree;
X          } /* endfor */
X        } /* endfor */
X        break;
X      case assign_dv:
X        size = get_locint_f();
X        loc1_v = get_locint_f();
X        d = get_val_v_f(size);
X        for (l=0;l<size;l++)
X        {
X            res = loc1_v + l;           /* Location of left-hand-side */
X            coval = d[l];      /* Value of right-hand-side   */     
X            /* code for assign_d */
X            Tres = *T[res];
X            T0[res]=coval;
X            for (pl=0;pl<p;pl++)
X            {
X              for (i=0;i<k-1;i++)
X	        Tres[i]=0;
X              Tres += degree;
X            } /* endfor */
X        } /* endfor */
X        break;
X      case assign_av:
X        loc2_v = get_locint_f();
X        size = get_locint_f();
X        loc1_v = get_locint_f();
X        for (l=0;l<size;l++)
X        {
X          res = loc1_v + l;             /* Location of the left-hand-side  */
X          arg = loc2_v + l;             /* Location of the right-hand-side */
X          /* code for assign_a */
X          rloc = loc1;
X          Targ = *T[arg];
X          Tres = *T[res];
X          T0[res]=T0[arg];
X          for (pl=0;pl<p;pl++)
X          {
X            for (i=0;i<k-1;i++)
X              Tres[i]=Targ[i];
X            Tres += degree;
X            Targ += degree;
X          } /* endfor */
X        } /* endfor */
X        break;
X      case assign_indvec:
X        size = get_locint_f();
X        loc1_v = get_locint_f();
X        for (l=0;l<size;l++)
X        {
X          res = loc1_v + l;             /* Location of the left-hand-side */
X          /* code for assign_ind */
X          Tres = *T[res];
X          T0[res]=basepoint[indexi];
X          for (pl=0;pl<p;pl++)
X          {
X            for (i=0;i<k-1;i++){
X              Tres[i]=argument[indexi][pl][i];}
X            Tres += degree;
X          } /* endfor */
X          ++indexi;
X        } /* endfor */
X        break;
X      case assign_depvec:
X        size = get_locint_f();
X        loc1_v = get_locint_f();
X        for (l=0;l<size;l++)
X        {
X          res = loc1_v + l;             /* Location of the left-hand-side */
X          /* code for assign_dep */
X          Tres = *T[res];
X          valuepoint[indexd]=T0[res];
X          if (taylors != 0 )  
X          {
X            for (pl=0;pl<p;pl++)
X            {
X              for (i=0;i<k-1;i++)
X	        taylors[indexd][pl][i] = Tres[i];
X              Tres += degree;
X            } /* endfor */
X          } /* endif */
X          indexd++;
X        } /* endfor */
X        break;
X      case eq_min_av:
X        loc1_v = get_locint_f();
X        size = get_locint_f();
X        result_v = get_locint_f();
X        for (l=0;l<size;l++)
X        {
X          res = result_v + l;            /* Location of the left-hand-side  */
X          arg = loc1_v + l;            /* Location on the right-hand-side */
X          /* code for eq_min_a */ 
X          Tres = *T[res];
X          Targ = *T[arg];
X          T0[res]-=T0[arg];
X          for (pl=0;pl<p;pl++)
X          {
X            for (i=0;i<k-1;i++)
X              Tres[i] -= Targ[i];
X            Tres+= degree;
X            Targ+=degree;
X          } /* endfor */
X        } /* endfor */
X        break;
X      case eq_plus_av:
X        loc1_v = get_locint_f();
X        size = get_locint_f();
X        result_v = get_locint_f();
X        for (l=0;l<size;l++)
X        {
X          res = result_v + l;            /* Location of the left-hand-side  */
X          arg = loc1_v   + l;            /* Location on the right-hand-side */
X          /* code for eq_plus_a */
X          Tres = *T[res];
X          Targ = *T[arg];
X          T0[res]+= T0[arg];
X          for (pl=0;pl<p;pl++)
X          {
X            for (i=0;i<k-1;i++)
X              Tres[i]+=Targ[i];
X            Tres+= degree;
X            Targ+= degree;
X          } /* endfor */
X        } /* endfor */
X        break;
X      case eq_mult_av_a:
X        arg = get_locint_f();
X        size = get_locint_f();
X        result_v = get_locint_f();
X        for (l=0;l<size;l++)
X        {
X          res = result_v + l;      /* Location of the left-hand-side  */
X          /* code for eq_mult_a*/
X          Tres = *T[res];
X          Targ = *T[arg];
X          for (pl=0;pl<p;pl++)
X          {
X            for (i=k-2;i>=0;i--)
X            {
X	      x=T0[res]*Targ[i];
X	      for (j=0;j<i;j++)
X	        x+=Tres[j]*Targ[i-j-1];
X              x+=Tres[i]*T0[arg];
X	      Tres[i]=x;
X            } /* endfor */
X            Tres+= degree;
X            Targ+= degree;
X          } /* endfor */
X          T0[res]*=T0[arg]; 
X        } /* endfor */
X        break;
X      case eq_mult_av_d:
X        size = get_locint_f();
X        result_v = get_locint_f();
X        coval = get_val_f();
X        for (l=0;l<size;l++)
X        {
X          res = result_v + l;      /* Location of the left-hand-side  */
X          /* code for eq_mult_d*/
X          Tres = *T[res];
X          T0[res]*=coval;
X          for (pl=0;pl<p;pl++)
X          {
X            for (i=0;i<k-1;i++)
X              Tres[i]*=coval;
X            Tres+= degree;
X          } /* endfor */
X        } /* endfor */
X        break;
X      case plus_av_av:
X        loc1_v   = get_locint_f();
X        loc2_v   = get_locint_f();
X        size     = get_locint_f();
X        result_v = get_locint_f();
X        for (l=0;l<size;l++)
X        {
X          arg2   = loc2_v    + l;       /* Location of var 2  */
X          arg1   = loc1_v    + l;       /* Location of var 1  */
X          res = result_v  + l;       /* Location of result */
X          /* code for plus_a_a */
X          Tres = *T[res];
X          Targ1 = *T[arg1];
X          Targ2 = *T[arg2];
X          T0[res]=T0[arg1]+T0[arg2];
X          for (pl=0;pl<p;pl++)
X          {
X            for (i=0;i<k-1;i++)
X              Tres[i]=Targ1[i]+Targ2[i];
X            Tres+= degree;
X            Targ1+= degree;
X            Targ2+= degree;
X          } /* endfor */
X        } /* endfor */
X        break;
X      case sub_av_av:
X        loc1_v   = get_locint_f();
X        loc2_v   = get_locint_f();
X        size     = get_locint_f();
X        result_v = get_locint_f();
X        for (l=0;l<size;l++)
X        {
X          arg2   = loc2_v    + l;       /* Location of var 2  */
X          arg1   = loc1_v    + l;       /* Location of var 1  */
X          res = result_v  + l;       /* Location of result */
X          /* code for min_a_a */
X          Tres = *T[res];
X          Targ1 = *T[arg1];
X          Targ2 = *T[arg2];
X          T0[res]=T0[arg1]-T0[arg2];
X          for (pl=0;pl<p;pl++)
X          {
X            for (i=0;i<k-1;i++)
X              Tres[i]=Targ1[i]-Targ2[i];
X            Tres+= degree;
X            Targ1+= degree;
X            Targ2+= degree;
X          } /* endfor */
X        } /* endfor */
X        break;
X      case dot_av_av:
X        loc1_v   = get_locint_f();
X        loc2_v   = get_locint_f();
X        size     = get_locint_f();
X        res = get_locint_f();
X        Tres = *T[res];
X        T0[res]=0;
X        for (pl=0;pl<p;pl++)
X        {
X          for (i=0;i<k-1;i++)
X            Tres[i]=0.0;
X          Tres+=degree;
X        } /* endfor */
X        for (l=0;l<size;l++)
X        {
X          arg2 = loc2_v + l;
X          arg1 = loc1_v + l;
X          /* code for mult_a_a  */
X          Targ1 = *T[arg1];
X          Targ2 = *T[arg2];
X          Tres = *T[res];
X          T0[res]+=T0[arg1]*T0[arg2];
X          for (pl=0;pl<p;pl++)
X          {
X            for (i=0;i<k-1;i++)
X            {
X	      x=Tres[i];
X              x+=T0[arg1]*Targ2[i];
X	      for (j=0;j<i;j++)
X	        x+=Targ1[j]*Targ2[i-j-1];
X              x+=Targ1[i]*T0[arg2];
X	      Tres[i]=x;
X            } /* endfor */
X            Tres+= degree;
X            Targ1+= degree;
X            Targ2+= degree;
X          } /* endfor */
X        } /* endfor */
X        break;
X      case mult_d_av:
X        loc1_v = get_locint_f();
X        size = get_locint_f();
X        result_v = get_locint_f();
X        coval =get_val_f();
X        for (l=0;l<size;l++)
X        {
X          arg = loc1_v   + l;   /* Location on the right-hand-side */
X          res = result_v + l;   /* location of the result */
X          /* code for mult_d_a */
X          Tres = *T[res];
X          Targ = *T[arg];
X          T0[res]=T0[arg]*coval;
X          for (pl=0;pl<p;pl++)
X          {
X            for (i=0;i<k-1;i++)
X              Tres[i]=Targ[i]*coval;
X            Tres+= degree;
X            Targ+= degree;
X          } /* endfor */
X        } /* endfor */
X        break;
X      case div_av_a:
X        loc1_v   = get_locint_f();
X        arg2     = get_locint_f();
X        size     = get_locint_f();
X        result_v = get_locint_f();
X        for (l=0;l<size;l++)
X        {
X          arg1 = loc1_v   + l;  /* Location of the right-hand-side vector[l] */
X          res = result_v + l;  /* Location of the result */
X          /* code for div_a_a */
X          Tres = *T[res];
X          Targ1 = *T[arg1];
X          Targ2 = *T[arg2];
X          divs   = 1/T0[arg2];
X          T0[res]=T0[arg1]*divs;
X          for (pl=0;pl<p;pl++)
X          {
X            for (i=0;i<k-1;i++)
X            {
X	      x=Targ1[i]*divs;
X              x+=T0[res]*(-Targ2[i]*divs);
X	      z[i]=-Targ2[i]*divs;
X	      for (j=0;j<i;j++)
X	        x+=Tres[j]*z[i-j-1];
X	      Tres[i]=x;
X            } /* endfor */
X            Tres+= degree;
X            Targ1+= degree;
X            Targ2+= degree;
X          } /* endfor */
X        } /* endfor */
X        break;
X      case mult_av_a:
X        loc1_v   = get_locint_f();
X        arg2     = get_locint_f();
X        size     = get_locint_f();
X        result_v = get_locint_f();
X        for (l=0;l<size;l++)
X         {
X          arg1 = loc1_v   + l; /* Location of the right-hand-side vector[l] */
X          res = result_v + l; /* Location of the result */
X          /* code for mult_a_a */
X          Tres = *T[res];
X          Targ1 = *T[arg1];
X          Targ2 = *T[arg2];
X          T0[res]=T0[arg1]*T0[arg2];
X          for (pl=0;pl<p;pl++)
X          {
X            for (i=0;i<k-1;i++)
X            {
X	      x=T0[arg1]*Targ2[i];
X	      for (j=0;j<i;j++)
X	        x+=Targ1[j]*Targ2[i-j-1];
X              x+=Targ1[i]*T0[arg2];
X	      Tres[i]=x;
X            } /* endfor */
X            Tres+= degree;
X            Targ1+= degree;
X            Targ2+= degree;
X          } /* endfor */
X        } /* endfor */
X        break;
X      case mult_a_av:
X        loc1_v   = get_locint_f();
X        arg1     = get_locint_f();
X        size     = get_locint_f();
X        result_v = get_locint_f();
X        for (l=0;l<size;l++)
X        {
X          arg2= loc1_v+l;      /* Location of right hand side vectore[l]  */
X          res = result_v + l; /* Location of the result */
X          /* code for mult_a_a */
X          Tres = *T[res];
X          Targ1 = *T[arg1];
X          Targ2 = *T[arg2];
X          T0[res]=T0[arg1]*T0[arg2];
X          for (pl=0;pl<p;pl++)
X          {
X            for (i=0;i<k-1;i++)
X            {
X              x=T0[arg1]*Targ2[i];
X              for (j=0;j<i;j++)
X                x+=Targ1[j]*Targ2[i-j-1];
X              x+=Targ1[i]*T0[arg2];
X              Tres[i]=x;
X            } /* endfor */
X            Tres+= degree;
X            Targ1+= degree;
X            Targ2+= degree;
X          } /* endfor */
X        } /* endfor */
X        break;
X
X#ifdef conditional
X      case cond_assign:
X        arg = get_locint_f();
X        loc1 = get_locint_f();
X        loc2 = get_locint_f();
X        res = get_locint_f();
X        Tres = *T[res];
X        Targ = *T[arg];
X        Tloc1 = *T[loc1];
X        Tloc2 = *T[loc2];
X        if (T0[arg]>0)
X        {
X          T0[res]=T0[loc1];
X        } /* endif */
X        else
X        {
X          T0[res]=T0[loc2];
X        } /* endif */
X        for( l = 0; l < p; l++)
X        {
X          if (T0[arg]>0)
X          {
X            for (i=0;i<k-1;i++)
X              Tres[i]=Tloc1[i];
X          } /* endif */
X          else
X          {
X            for (i=0;i<k-1;i++)
X              Tres[i]=Tloc2[i];
X          } /* endelse */
X          Tres += degree;
X          Tloc1+= degree;
X          Tloc2+= degree;
X        } /* endfor */
X        break;
X      case cond_assign_s:
X        arg = get_locint_f();
X        loc1 = get_locint_f();
X        res = get_locint_f();
X        Tres = *T[res];
X        Targ = *T[arg];
X        Tloc1 = *T[loc1];
X        if (T0[arg]>0)
X	{
X          T0[res]=T0[loc1];
X        } /* endif */
X        for(l = 0; l < p; l++)
X        {
X          if (T0[arg]>0)
X          {
X            for (i=0;i<k-1;i++)
X              Tres[i]=Tloc1[i];
X          } /* endif */
X          Tres += degree;
X          Tloc1+= degree;
X        } /* endfor */
X        break;
X      case subscript:
X        loc1_v=get_locint_f();  /* Base */
X        loc1=get_locint_f();/* pointer to the variable containing the offset */
X        res=get_locint_f();
X        Tres=*T[res];
X        arg=loc1_v+(int)(T0[loc1]);
X        Targ = *T[arg];
X        T0[res]=T0[arg];
X        for( l = 0; l < p; l++)
X        { 
X          for (i=0;i<k-1;i++)
X            Tres[i]=Targ[i];
X          Tres += degree;
X          Targ += degree; 
X        } /* endfor */
X        break;
X      case subscript_l:
X        loc1_v=get_locint_f();  /* Base */
X	loc1=get_locint_f();
X        arg=loc1_v+(int)(T0[loc1]);
X        res=get_locint_f();
X        Tres = *T[res];
X        Targ = *T[arg];
X        T0[arg]=T0[res];
X        for( l = 0; l < p; l++)
X        {
X          for (i=0;i<k-1;i++)
X            Targ[i]=Tres[i];
X         Tres += degree;
X         Targ += degree; 
X        } /* endfor */
X        break;
X      case subscript_ld:
X        loc1_v=get_locint_f();  /* Base */
X        loc1=get_locint_f();  /* pointer to the variable containing the offset */
X        res = loc1_v+(int)(T0[loc1]);
X        Tres = *T[res];
X        T0[res]=get_val_f();
X        for( l = 0; l < p; l++)
X        {
X          for (i=0;i<k-1;i++)
X            Tres[i]=0;
X          Tres += degree;
X        } /* endfor */
X        break;
X      case m_subscript:
X        loc1_v=get_locint_f();  /* Base */
X        loc1=get_locint_f();/* pointer to the variable containing the offset */
X        size=get_locint_f();
X        result=get_locint_f();
X        for (l=0;l<size;l++)
X        {
X          res=result+l;
X          Tres=*T[res];
X          arg=loc1_v+(int)(T0[loc1])*size+l;
X          Targ = *T[arg];
X          T0[res]=T0[arg];
X          for(pl=0;pl<p;pl++)
X          { 
X            for (i=0;i<k-1;i++)
X              Tres[i]=Targ[i];
X            Tres += degree;
X            Targ += degree; 
X          } /* endfor */
X        } /* endfor */
X        break;
X      case m_subscript_l:
X        loc1_v=get_locint_f();  /* Base */
X	loc1=get_locint_f();
X        size=get_locint_f();
X        arg=get_locint_f(); /* RHS */
X        for (l=0;l<size;l++)
X        {
X          res=loc1_v+(int)(T0[loc1])*size+l;
X          Tres = *T[res];
X          Targ = *T[arg+l];
X          T0[res]=T0[arg+l];
X          for(pl=0;pl<p;pl++)
X          {
X            for (i=0;i<k-1;i++)
X              Tres[i]=Targ[i];
X           Tres += degree;
X           Targ += degree; 
X          } /* endfor */
X        } /* endfor */
X        break;
X      case m_subscript_ld:
X        loc1_v=get_locint_f();  /* Base */
X        loc1=get_locint_f();  /* pointer to the variable containing the offset */
X        loc2=get_locint_f(); /* offset in the vector itself */
X        size=get_locint_f();
X        d = get_val_v_f(size);
X        for (l=0;l<size;l++)
X        {
X          res = loc1_v+(int)(T0[loc1])*size+l+loc2;
X          Tres = *T[res];
X          T0[res]=d[l];
X          for(pl=0;pl<p;pl++)
X          {
X            for (i=0;i<k-1;i++)
X              Tres[i]=0;
X            Tres += degree;
X          } /* endfor */
X        } /* endfor */
X        break;
X#endif
X
X      case death_not:
X        loc1=get_locint_f();
X        loc1=get_locint_f();
X  	break;
X      default:
X	/* Die here, we screwed up */
X	printf("ADOL-C error: Fatal error in hov_forward for op %d\n",operation);
X	break;
X	
X      } /* endswitch */
X      operation=get_op_f();
X    }  /* endwhile */
X  end_sweep();
X} /* end hov_forward */
X
X
X
X#ifdef __cplusplus
X}
X#endif
X
END_OF_FILE
if test 35205 -ne `wc -c <'hov_forward.c'`; then
    echo shar: \"'hov_forward.c'\" unpacked with wrong size!
fi
chmod +x 'hov_forward.c'
# end of 'hov_forward.c'
fi
if test -f 'hov_reverse.c' -a "${1}" != "-c" ; then 
  echo shar: Will not clobber existing file \"'hov_reverse.c'\"
else
echo shar: Extracting \"'hov_reverse.c'\" \(40471 characters\)
sed "s/^X//" >'hov_reverse.c' <<'END_OF_FILE'
X/*
X   ----------------------------------------------------------------
X   File hov_reverse.c of ADOL-C version 1.6 as of January 1,   1995
X   ----------------------------------------------------------------
X   Contains the routine hov_reverse (higher-order-vector reverse 
X   mode).
X
X*/
X
X#ifdef __cplusplus
Xextern "C" {
X#endif
X
X
X/* 
X  There are four basic versions of the procedure `reverse', which
X  are optimized for the cases of scalar or vector reverse sweeps
X  with first or higher derivatives, respectively. In the calling
X  sequence this distinction is apparent from the type of the
X  parameters `lagrange' and `results'. The former may be left out
X  and the integer parameters `depen', `indep', `degre', and `nrows'
X  must be set or default according to the following matrix of
X  calling cases. 
X
X           no lagrange         double* lagrange     double** lagrange
X
Xdouble*   gradient of scalar   weight vector times    infeasible 
Xresults   valued function      Jacobian product       combination
X
X          ( depen = 1 ,         ( depen > 0 ,         
X	    degre = 0 ,           degre = 0 ,              ------
X	    nrows = 1 )           nrows = 1 )
X
Xdouble**  Jacobian of vector   weight vector times     weight matrix
Xresults   valued function      Taylor-Jacobians        times Jacobian
X           
X	  ( 0 < depen           ( depen > 0 ,          ( depen > 0 ,
X	      = nrows ,           degre > 0 ,            degre = 0 ,
X	    degre = 0 )           nrows = 1 )            nrows > 0 )
X
Xdouble*** full family of         ------------          weigth matrix x
Xresults   Taylor-Jacobians       ------------          Taylor Jacobians
X
X*/ 
X
X#include "dvlparms.h" /* Developers Parameters */
X
X/* Necessary Includes */
X
X#include "usrparms.h"
X#include "oplate.h"
X#include "taputil1.h"
X#include "taputil2.h"
X#include "taputil3.h"
X#include "tayutil.h"
X
X/* Static Locals */
Xstatic short tag;
X
X
X/* External memory management routines from driversc.c */
X
Xdouble** myalloc2(int, int);
Xdouble*** myalloc3(int, int, int);
X
X#define maxinc(a,b) if ((a) < (b)) (a) = (b)
X
X/***************************************************************************/
X/* Higher Order - Vector Reverse.                                          */
X/***************************************************************************/
Xvoid hov_reverse(short tnum,/* tape id */
X		 int depen,          /* consistency chk on # of dependents */
X		 int indep,          /* consistency chk on # of independents */
X		 int degre,          /* highest derivative degre */
X		 int nrows,          /* # of Jacobian rows being calculated */
X		 double **lagrange,  /* domain weight vector */
X		 double ***results,  /* matrix of coefficient vectors */
X		 short ** nonzero )  /* structural sparsity  pattern  */
X{   
X  unsigned char operation;
X  int tape_stats[11];        /* tape stats */
X
X  locint result=0;
X  locint arg=0;
X  locint res=0;
X  locint loc1=0;
X  locint loc2=0;
X  double stored_val=0.0;
X  double r0b,divs;
X  locint result_v=0;
X  locint loc1_v=0;
X  locint loc2_v=0;
X  double *d=0;
X  locint size = 0;
X
X  int i,l,j,k,k1,p,pd,pdk;
X  static double** A;
X  static revreal** Tr;
X  static int kax, rax, pax;
X
X  double x,y,r_0;
X  double r0;
X  int indexi;
X  int indexd;
X  int rev_location_cnt;
X  int dep_cnt;
X  int indep_cnt;
X  int buffer;
X  int taycheck;
X  int numdep,numind;
X  static revreal *A1, *A2, *Ares, *Tr1, *Tr2, *Tres;
X  static revreal *Atemp, *Atemp2, *Trtemp;
X
X  tag = tnum;   /* tag is global which indicates which tape to look at */
X  pd = nrows;
X  k = degre+1;
X  k1 = k+1;
X  pdk = pd*k1;
X
X  tapestats(tag,tape_stats);
X
X  indep_cnt = tape_stats[0];
X  dep_cnt = tape_stats[1];
X  rev_location_cnt = tape_stats[2];
X  buffer =  tape_stats[4];
X
X  set_buf_size(buffer);
X
X  if ((depen != dep_cnt)||(indep != indep_cnt))
X  {
X    printf("ADOL-C error: reverse sweep on tape %d aborted!\n",tag);
X    printf("Number of dependent and/or independent variables passed");
X    printf(" to reverse is\ninconsistant with number ");
X    printf("recorded on tape %d \n",tag);
X    exit (-1);
X  }
X
X
X  indexi = indep_cnt - 1;
X  indexd = dep_cnt - 1;
X
X  if (k compsize kax || rev_location_cnt compsize  rax || pd compsize  pax)
X    {
X      if(pax)
X      {
X	/* delete Atemp;
X	   delete Atemp2;
X	   delete Trtemp; */
X	free((char*) Atemp);
X	free((char*) Atemp2);
X	free((char*) Trtemp);
X        free((char*) *Tr);
X        free((char*) Tr);
X        free((char*) *A);
X	free((char*) A);
X      }
X      Atemp = (revreal *)malloc(sizeof(revreal)*k1);
X      Atemp2 = (revreal *)malloc(sizeof(revreal)*k1);
X      Trtemp = (revreal *)malloc(sizeof(revreal)*k);
X
X    /* Atemp = new revreal[k1];
X       Atemp2 = new revreal[k1];
X       Trtemp = new revreal[k]; */
X    Tr = myalloc2(rev_location_cnt,k);
X    A = myalloc2(rev_location_cnt,pdk);
X    kax = k;
X    pax = pd;
X    rax = rev_location_cnt;
X  }
X  taylor_back2(Tr,&numdep,&numind,&taycheck);
X
X  if(taycheck != degre)   
X    {
X      printf("\n ADOL-C error: reverse fails because it was not preceeded \n");
X      printf("by a forward sweep with degree of %d degree was %d !!!!!!\n",taycheck,degre);
X      exit(-2);
X    };
X
X  if((numdep != depen)||(numind != indep))
X    {
X      printf("\n ADOL-C error: reverse fails on tape %d because the number of\n"
X	     ,tag);
X      printf("independent and/or dependent variables given to reverse are\n");
X      printf("inconsistant with that of the internal taylor array.\n");
X      exit(-2);
X    }
X
X  
X  /* Set up the tape */
X
X  /* my_init_rev_sweep(tag);*/
X  init_rev_sweep(tag);
X
X  /* Get the last operation */
X
X  operation=get_op_r();
X  
X  while (operation != start_of_tape) 
X    {
X
X      /* Switch Statement to execute operands (in reverse) */
X
X      switch (operation) {
X
X	/* Markers */
X
X      case end_of_int:
X        get_loc_block_r(); /* Get the next int block */
X        break;
X      case end_of_val:
X        get_val_block_r(); /* Get the next val block */
X        break;
X      case end_of_op:
X        get_op_block_r();
X        operation = get_op_r();/* Skip next operation, it's another end_of_op */
X        break;
X      case start_of_tape:
X      case end_of_tape:
X	break;
X
X	/* Scalar Operations */
X
X      case int_adb_a:
X        loc1 = get_locint_r();
X        loc2 = get_locint_r();
X	/* get_taylors(loc1,k); */
X	A1 = A[loc2];
X	Ares = A[loc1];
X	for (p=0;p<pd;p++)
X	  {
X	    if  (0==*Ares)
X	      {
X		Ares += k1;
X		A1 += k1;
X	      }
X	    else 
X	      {
X		maxinc(*A1,*Ares);
X		A1++; *Ares++ = 0;
X		for (i=0;i<k;i++)
X		  {
X		    *A1++ += *Ares;
X		    *Ares++ = 0 ;
X                  }
X	      }
X	  }
X	break;
X      case assign_a:
X        loc1 = get_locint_r();
X        loc2 = get_locint_r();
X	get_taylors(loc1,k);
X	A1 = A[loc2];
X	Ares = A[loc1];
X	for (p=0;p<pd;p++)
X	  {
X	    if  (0==*Ares)
X	      {
X		Ares += k1;
X		A1 += k1;
X	      }
X	    else 
X	      {
X		maxinc(*A1,*Ares);
X		A1++; *Ares++ = 0;
X		for (i=0;i<k;i++)
X		  {
X		    *A1++ += *Ares;
X		    *Ares++ = 0 ;
X                  }
X	      }
X	  }
X	break;
X	
X      case assign_d:
X        loc1 = get_locint_r();
X        stored_val = get_val_r();
X	Ares = A[loc1];
X	for (p=0;p<pdk;p++)
X	  *Ares++ = 0.0;
X	get_taylors(loc1,k);
X	break;
X      case int_adb_d:
X        loc1 = get_locint_r();
X        stored_val = get_val_r();
X	Ares = A[loc1];
X	for (p=0;p<pdk;p++)
X	  *Ares++ = 0.0;
X	/* get_taylors(loc1,k); */
X	break;
X	
X      case assign_ind:
X        loc1 = get_locint_r();
X	get_taylors(loc1,k);
X	Ares = A[loc1];
X	for (p=0;p<pd;p++)
X	  {
X	    if(nonzero)
X	      nonzero[p][indexi] = (int)*Ares;
X	    Ares++;
X	    for (i=0;i<k;i++)
X	      results[p][indexi][k-1-i]= *Ares++; 
X	  }
X	indexi--;
X	break;
X	
X      case assign_dep:
X        loc1 = get_locint_r();
X	Ares = A[loc1];
X	for (p=0;p<pd;p++)
X	  {
X	    Ares[k] = lagrange[p][indexd];
X	    if(Ares[k]) *Ares = 1.0;
X	    Ares += k1;
X	  }
X	indexd--;
X	break;
X	
X      case eq_plus_d:
X        result=get_locint_r();
X        stored_val = get_val_r();
X	get_taylors(result,k);
X	break;
X	
X      case eq_plus_a: 
X        result=get_locint_r();
X        loc1=get_locint_r();
X	get_taylors(result,k);
X	Ares=A[result];
X	A1=A[loc1];
X	for (p=0;p<pd;p++)
X	  if  (0 == *Ares)
X	    {
X	      Ares += k1;
X	      A1 += k1;
X	    }
X	  else
X	    {
X	      maxinc(*A1,*Ares);
X	      A1++; Ares++;
X	      for (i=0;i<k;i++)
X		*A1++ += *Ares++;
X	    }
X	break;
X	
X      case eq_min_d:
X        result=get_locint_r();
X        stored_val = get_val_r();
X	get_taylors(result,k);
X	break;
X	
X      case eq_min_a: 
X        result=get_locint_r();
X        loc1=get_locint_r();
X	get_taylors(result,k);
X	Ares=A[result];
X	A1=A[loc1];
X	for (p=0;p<pd;p++)
X	  if  (0==*Ares)
X	    {
X	      Ares += k1;
X	      A1 += k1;
X	    }
X	  else 
X	    {
X	      maxinc(*A1,*Ares);
X	      A1++; Ares++;
X	      for (i=0;i<k;i++)
X		*A1++ -= *Ares++;
X	    }
X	break;
X	
X      case eq_mult_d:
X        result=get_locint_r();
X        stored_val = get_val_r();
X	get_taylors(result,k);
X	Ares = A[result];
X	for (p=0;p<pd;p++)
X	  if  (0==*Ares++)
X	    Ares += k;
X	  else for (i=0;i<k;i++)
X	    *Ares++  *= stored_val;
X	break;
X	
X      case eq_mult_a:
X        result=get_locint_r();
X        loc1=get_locint_r();
X	get_taylors(result,k);
X	Tr1 = Tr[loc1];
X	Tres = Tr[result];
X	A1 = A[loc1];
X	Ares = A[result];
X	for (p=0;p<pd;p++)
X	  {
X	    if (0==*Ares) 
X	      {
X		A1 += k1;
X		Ares += k1;
X	      }
X	    else
X	      {
X		maxinc(*Ares,2.0);
X		maxinc(*A1,*Ares);
X		A1++; Ares++;
X		for (i=k-1;i>=0;i--)
X		  {
X		    x = 0.0;
X		    y = 0.0;
X		    Atemp[i] = Ares[i];
X		    Ares[i] = 0;
X		    for (j=i;j<k;j++)
X		      {
X			x+=Atemp[j]*Tres[j-i];
X			y+=Atemp[j]*Tr1[j-i];
X		      }
X		    A1[i] +=x;
X		    Ares[i] +=y;
X		  }
X		A1 += k;
X		Ares += k;
X              }
X	  }
X	break;
X	
X      case plus_a_a:
X        result =get_locint_r();
X        loc2=get_locint_r();
X        loc1=get_locint_r();
X	Ares = A[result];
X	A1 = A[loc1];
X	A2 = A[loc2];
X	for (p=0;p<pd;p++)
X	  if  (0==*Ares)
X	    {
X	      Ares+=k1;
X	      A1 += k1;
X	      A2 += k1;
X	    }
X	  else
X	    {
X	      maxinc(*A1,*Ares);
X	      maxinc(*A2,*Ares);
X	      A2++; A1++; Ares++;
X	      for (i=0;i<k;i++)
X		{
X		  *A1++ += *Ares;
X		  *A2++ += *Ares++;
X		}
X	    }
X	break;
X	
X      case plus_d_a:
X        result = get_locint_r();
X        loc1=get_locint_r();
X        stored_val = get_val_r();
X	Ares = A[result];
X	A1 = A[loc1];
X	for (p=0;p<pd;p++)
X	  if  (0==*Ares)
X	    {
X	      Ares+=k1;
X	      A1 += k1;
X	    }
X	  else
X	    {
X	      maxinc(*A1,*Ares);
X	      A1++; Ares++;
X	      for (i=0;i<k;i++)
X	        *A1++ += *Ares++;
X	    }
X	break;
X	
X      case min_a_a:
X        result =get_locint_r();
X        loc2=get_locint_r();
X        loc1=get_locint_r();
X	Ares = A[result];
X	A1 = A[loc1];
X	A2 = A[loc2];
X	for (p=0;p<pd;p++)
X	  if  (0==*Ares)
X	    {
X	      Ares+=k1;
X	      A1 += k1;
X	      A2 += k1;
X	    }
X	  else
X	    {
X	      maxinc(*A1,*Ares);
X	      maxinc(*A2,*Ares);
X	      A2++; A1++; Ares++;
X	      for (i=0;i<k;i++)
X	        {
X		  *A1++ += *Ares;
X		  *A2++ -= *Ares++;
X                }
X	    }
X	break;
X	
X      case min_d_a:
X        result = get_locint_r();
X        loc1=get_locint_r();
X        stored_val = get_val_r();
X	Ares = A[result];
X	A1 = A[loc1];
X	for (p=0;p<pd;p++)
X	  if (0==*Ares)
X	    {
X	      Ares+=k1;
X	      A1 += k1;
X	    }
X	  else
X	    {
X	      maxinc(*A1,*Ares);
X	      A1++; Ares++;
X	      for (i=0;i<k;i++)
X		*A1++ -= *Ares++;
X	    }
X	break;
X	
X      case mult_a_a:
X        result =get_locint_r();
X        loc2=get_locint_r();
X        loc1=get_locint_r();
X	Tr1 = Tr[loc1];
X	Tr2 = Tr[loc2];
X	Ares = A[result];
X	A2 = A[loc2];
X	A1 = A[loc1];
X	for (p=0;p<pd;p++)
X	  if (0==*Ares)
X	    { 
X	      A1 += k1;
X	      A2 += k1;
X	      Ares += k1;
X	    }
X	  else
X	    {
X	      revreal comp = (*Ares > 2.0) ? *Ares : 2.0 ;
X	      maxinc(*A1,comp);
X	      maxinc(*A2,comp);
X	      A1++; A2++; Ares++;
X              for (i=0;i<k;i++)
X                {
X		  x = 0.0;
X		  y = 0.0;
X		  for (j=i;j<k;j++)
X		    {
X		      x+=Ares[j]*Tr1[j-i];
X		      y+=Ares[j]*Tr2[j-i];
X		    }
X		  *A2++ +=x;
X		  *A1++ +=y;
X                }
X              Ares += k;
X	    } 
X	break;
X	
X      case mult_d_a:
X        result = get_locint_r();
X        loc1=get_locint_r();
X        stored_val = get_val_r();
X	Ares = A[result];
X	A1= A[loc1];
X	for (p=0;p<pd;p++)
X	  if  (0==*Ares)
X	    {
X	      Ares += k1;
X	      A1 += k1;
X	    }
X	  else
X	    {
X              maxinc(*A1,*Ares);
X	      A1++; Ares++;
X	      for (i=0;i<k;i++)
X		*A1++ += stored_val* (*Ares++);
X	    }
X	break;
X	
X      case div_a_a:
X        result =get_locint_r();
X        loc2=get_locint_r();
X        loc1=get_locint_r();
X	Tr2 = Tr[loc2];
X	Tres = Tr[result];
X	r0=1/(*Tr2);
X	Ares = A[result];
X	A2 = A[loc2];
X	A1 = A[loc1];
X	for (p=0;p<pd;p++)
X	  {
X	    if (0==*Ares)
X	      {
X		Ares += k1;
X		A1 += k1;
X		A2 += k1;
X	      }
X	    else
X	      {
X		maxinc(*A1,3.0);
X		maxinc(*A1,*Ares);
X		maxinc(*A2,3.0);
X		maxinc(*A2,*Ares);
X		A1++; A2++; Ares++;
X		for (i=k-2;i>=0;i--)
X		  {
X		    x = 0.0;
X		    for (j=i+1;j<k;j++)
X		      x+=Ares[j]*Tr2[j-i];
X		    Ares[i]-=x*r0;
X		  }
X		r_0 = 0.0;
X		for (i=0;i<k;i++)
X		  r_0+=Ares[i]*Tres[i];
X		*A2++ -= r_0*r0;
X		for (i=1;i<k;i++)
X		  {
X		    x = 0.0;
X		    for (j=i;j<k;j++)
X		      x+=Ares[j]*Tres[j-i];
X		    *A2++ -=x*r0;
X		  }
X		for (i=0;i<k;i++)
X		  *A1++ +=r0*Ares[i];
X		Ares += k;
X              }
X	  }
X	break;
X	
X      case div_d_a:
X        result = get_locint_r();
X        loc1=get_locint_r();
X        stored_val = get_val_r();
X	Tr1 = Tr[loc1];
X	r0=1/(*Tr1);
X	Tres = Tr[result];
X	Ares = A[result];
X	A1 = A[loc1];
X            for (p=0;p<pd;p++)
X              { 
X	      if (0==*Ares)
X		{
X		Ares += k1;
X		A1 += k1;
X		}
X             else
X	      {
X	      maxinc(*A1,*Ares);
X	      maxinc(*A1,3.0);
X	      A1++; Ares++;
X              for (i=k-2;i>=0;i--)
X                {
X                x = 0.0;
X                for (j=i+1;j<k;j++)
X                   x += Ares[j]*Tr1[j-i];
X                Ares[i] -= r0*x;
X                }
X              x = 0.0;
X              for (i=0;i<k;i++)
X                x+=Ares[i]*Tres[i];
X              r_0=Tr1[0]*x;
X              *A1++ -=r_0*r0*r0;
X              for (i=1;i<k;i++)
X                {
X                x = 0.0;
X                for (j=i;j<k;j++)
X                    x+=Ares[j]*Tres[j-i];
X                *A1++ -=r0*x;
X                }
X              Ares += k;
X      	      }
X              }
X            break;
X
X        case pow_op:
X        result = get_locint_r();
X        loc1=get_locint_r();
X        stored_val = get_val_r();
X	    Tr1 = Tr[loc1];
X	    Tres = Tr[result];
X	    Ares = A[result];
X	    A1 = A[loc1];
X            if (Tr1[0]==0.0)
X              r0=0.0;
X            else
X	      r0 = 1/Tr1[0];
X            for (p=0;p<pd;p++)
X              {
X              if (0==*Ares)
X                {
X                Ares += k1;
X                A1 += k1;
X                }
X              else
X                {
X                if (Tr1[0]==0.0){
X                *A1++ =5.0; Ares++;
X                }
X                else {
X                maxinc(*A1,*Ares);
X                maxinc(*A1,3.0);
X                A1++; Ares++;
X                }
X                r0b = 0.0;
X                for (i=k-1;i>0;i--)
X                  {
X                  x = Ares[i]*r0/i;
X                  r0b += Ares[i]*Tres[i];
X                  divs = -i;
X                  for (j=i-1;j>=0;j--)
X                    { divs += stored_val+1;
X                       Ares[j] += x*divs*Tr1[i-j];
X                       A1[i-j] += x*divs*Tres[j];
X                    }
X                  }
X                *A1 += (*Ares*stored_val*Tres[0]-r0b)*r0;
X                Ares += k;
X                A1 += k;
X               }
X              }
X          break; 
X
X        case death_not:
X        loc2 = get_locint_r();
X        loc1 = get_locint_r();
X            for (i=loc1;i<=loc2;i++)
X              {
X	       A1 = A[i];
X	       for (p=0;p<pdk;p++)
X                  *A1++ = 0.0;
X               get_taylors(i,k);
X              }
X            break;
X
X        case exp_op:
X        result = get_locint_r();
X        loc1=get_locint_r();
X            Tr1 = Tr[loc1];
X            Tres = Tr[result];
X            Ares = A[result];
X            A1 = A[loc1];
X            for(i=1;i<k;i++)
X               Trtemp[i] = i * Tr1[i];
X            for (p=0;p<pd;p++)
X              {
X	      if (0==*Ares)
X	      {
X	       A1 += k1;
X	       Ares += k1;
X	       }
X              else
X	      {
X               maxinc(*A1,*Ares);
X               maxinc(*A1,4.0);
X               A1++; Ares++;
X              for (i=k-2;i>=0;i--)
X                {
X                Atemp[i+1] = Ares[i+1] / (i+1);
X                x = 0.0;
X                for (j=i+1;j<k;j++)
X                    x+=Atemp[j]*Trtemp[j-i];
X                Ares[i]+=x;
X                }
X              *A1++ += Ares[0]*Tres[0];
X              for (i=1;i<k;i++)
X                {
X                x = 0.0;
X                for (j=i;j<k;j++)
X                   x+=Atemp[j]*Tres[j-i];
X                *A1++ +=i*x;
X                }
X              Ares += k;
X     	      }
X              }
X            break;
X            
X        case sin_op:
X        result = get_locint_r();
X        loc2 = get_locint_r();
X        loc1 = get_locint_r();
X        stored_val = get_val_r();
X            Tr1 = Tr[loc1];
X            Tr2 = Tr[loc2];
X            Tres = Tr[result];
X            Ares = A[result];
X            A2 = A[loc2];
X            A1 = A[loc1];
X            for(i=1;i<k;i++)
X                Trtemp[i] = i * Tr1[i];
X            for (p=0;p<pd;p++)
X              {
X	      if (0==*Ares)
X	       {
X		A1 += k1;
X		A2 += k1;
X		Ares += k1;
X	       }
X              else
X	      {
X              maxinc(*A1,*Ares);
X              maxinc(*A1,4.0);
X              maxinc(*A2,*Ares);
X              maxinc(*A2,4.0);
X              A1++; A2++; Ares++;
X              for (i=k-2;i>=0;i--)
X                {
X                x = 0.0;
X                y = 0.0;
X                Atemp[i+1] = Ares[i+1] / (i+1);
X                Atemp2[i+1] = A2[i+1] / (i+1);
X                for (j=i+1;j<k;j++)
X                  {
X                  x+=Atemp[j]*Trtemp[j-i];
X                  y+=Atemp2[j]*Trtemp[j-i];
X                  }
X                A2[i]+=x;
X                Ares[i]-=y;
X                }
X              *A1++ += Ares[0]*Tr2[0]-A2[0]*Tres[0];
X              for (i=1;i<k;i++)
X                {
X                x = 0.0;
X                for (j=i;j<k;j++)
X                   x += Tr2[j-i]*Atemp[j]-Atemp2[j]*Tres[j-i] ;
X                *A1++ +=i*x;
X                }
X              A2 += k;
X	      Ares += k;
X              }
X              }
X            break;
X            
X        case cos_op:
X        result = get_locint_r();
X        loc2 = get_locint_r();
X        loc1 = get_locint_r();
X        stored_val = get_val_r();
X            Tr1 = Tr[loc1];
X            Tres = Tr[result];
X            Tr2 = Tr[loc2];
X            Ares = A[result];
X            A2 = A[loc2];
X            A1 = A[loc1];
X            for(i=1;i<k;i++)
X               Trtemp[i] = i * Tr1[i];
X            for (p=0;p<pd;p++)
X              {
X	      if (0==*Ares)
X	      {
X	      A1 += k1;
X	      A2 += k1;
X	      Ares += k1;
X	      }
X	      else
X	      {
X              maxinc(*A1,*Ares);
X              maxinc(*A1,4.0);
X              maxinc(*A2,*Ares);
X              maxinc(*A2,4.0);
X              A1++; A2++; Ares++;
X              for (i=k-2;i>=0;i--)
X                {
X                x = 0.0;
X                y = 0.0;
X                Atemp[i+1] = Ares[i+1] / (i+1);
X                Atemp2[i+1] = A2[i+1] / (i+1);
X                for (j=i+1;j<k;j++)
X                  {
X                  x+=Atemp2[j]*Trtemp[j-i];
X                  y+=Atemp[j]*Trtemp[j-i];
X                  }
X                Ares[i]+=x;
X                A2[i]-=y;
X                }
X              *A1++ += A2[0]*Tres[0]-Ares[0]*Tr2[0];
X              for (i=1;i<k;i++)
X              {
X                x = 0.0;
X                for (j=i;j<k;j++)
X                   x += Tres[j-i]*Atemp2[j]-Atemp[j]*Tr2[j-i] ;
X                *A1++ +=i*x;
X              }
X	      A2 += k;
X	      Ares += k;
X	      }
X	    } 
X            break;
X            
X        case sqrt_op:
X        result = get_locint_r();
X        loc1=get_locint_r();
X            Ares = A[result];
X            A1 = A[loc1];
X            Tres = Tr[result];
X            if ((*Tres)==0.0)
X              r0=0.0;
X            else
X              r0=1.0/(*Tres);
X            for (p=0;p<pd;p++)
X              {
X		if (0==*Ares)
X		  {
X		    A1 += k1;
X		    Ares += k1;
X		  }
X		else
X		  {
X                    if ((*Tres)==0.0) {
X                    *A1++ = 5.0; Ares++;
X                    } 
X                    else {
X                    maxinc(*A1,*Ares);
X                    maxinc(*A1,4.0);
X                    A1++; Ares++;
X                    }
X		    for (i=k-2;i>0;i--)
X		      {
X			x = 0.0;
X			for (j=i+1;j<k;j++)
X			  x += Ares[j]*Tres[j-i];
X			Ares[i]-=r0*x;
X		      }
X		    x = 0.0;
X		    r_0 = r0/2;
X		    for (i=1;i<k;i++)
X		      {
X			x+=Ares[i]*Tres[i];
X			A1[i] += r_0*Ares[i];
X		      }
X		    Ares[0] -= x*r0;
X		    A1[0] += r_0*Ares[0];
X		    Ares +=k;
X		    A1 += k;
X		  }
X              }
X            break;
X        case abs_val:
X        result = get_locint_r();
X        loc1=get_locint_r();
X            Ares = A[result];
X            A1 = A[loc1];
X            Tr1 = Tr[loc1];
X            x=0.0;
X            j=0;
X            for (i=0;i<k;i++) {
X              if((x==0.0) && (Tr1[i]!=0.0)) {
X                j=i;
X                if(Tr1[i]<0.0)
X                  x = -1.0;
X                else
X                  x= 1.0;
X              } /* end if */
X            } /* end for */
X            for (p=0;p<pd;p++) {
X              if (0==*Ares) {
X                A1 += k1;
X                Ares += k1;
X              } /* endif */
X              else {
X                if(Tr1[0]==0.0) {
X                  *A1++=5.0; Ares++;
X                } /* end if */
X                else {
X                maxinc(*A1,*Ares);
X                A1++; Ares++;
X                } /* end else */
X                for (i=j;i<k;i++)
X                  A1[i] += x*Ares[i];
X                Ares +=k;
X                A1 += k; 
X              } /* end else */
X            } /* endfor */
X            break;
X
X
X	    
X        case asin_op:
X        case acos_op:
X        case atan_op:
X        case gen_quad:
X        result = get_locint_r();
X        loc2 = get_locint_r();
X        loc1 = get_locint_r();
X        stored_val = get_val_r();
X            Ares = A[result];
X            A2 = A[loc2];
X            A1 = A[loc1];
X            Tr1 = Tr[loc1];
X            Tr2 = Tr[loc2];
X            for(i=1;i<k;i++)
X	      Trtemp[i] = i*Tr1[i];
X            for (p=0;p<pd;p++)
X	      {
X		if(0==*Ares)
X		  {
X		    A1 += k1;
X		    A2 += k1;
X		    Ares += k1;
X		  }
X		else
X		  {
X                    maxinc(*A1,*Ares);
X                    maxinc(*A1,4.0);
X                    maxinc(*A2,*Ares);
X                    maxinc(*A2,4.0);
X                    A1++; A2++; Ares++;
X		    for (i=k-1;i>0;i--)
X		      {
X			Atemp[i] = Ares[i] / i;
X			x = 0.0;
X			for (j=i;j<k;j++)
X			  x+=Atemp[j]*Trtemp[j-i+1];
X			A2[i-1]+=x;
X		      }
X		    *A1++ +=Tr2[0]*Ares[0];
X		    for (i=1;i<k;i++)
X		      {
X			x = 0.0;
X			for (j=i;j<k;j++)
X			  x+=Atemp[j]*Tr2[j-i];
X			*A1++ +=i*x;
X		      }
X		    A2 += k; 
X		    Ares += k;
X		  }
X	      }
X            break;      
X            
X        case log_op:
X        result = get_locint_r();
X        loc1=get_locint_r();
X            Ares = A[result];
X            A1 = A[loc1];
X            Tr1 = Tr[loc1];
X            Tres = Tr[result];
X            r0=1/Tr1[0];
X            for(i=1;i<k;i++)
X	      Trtemp[i] = i*Tres[i];
X            for (p=0;p<pd;p++)
X              {
X		if (0==*Ares)
X		  {
X		    A1 += k1;
X		    Ares += k1;
X		  }
X		else
X		  { 
X                    maxinc(*A1,*Ares);
X                    maxinc(*A1,4.0);
X                    A1++; Ares++;
X		    for (i=k-2;i>0;i--)
X		      {
X			x = 0.0;
X			Atemp[i+1] = Ares[i+1] / (i+1);
X			for (j=i+1;j<k;j++)
X			  x+=Atemp[j]*Tr1[j-i];
X			Ares[i]-=x*i*r0;
X		      }
X		    x = 0.0;
X		    for (i=1;i<k;i++)
X		      x += Ares[i]*Tres[i];
X		    r_0 = x/r0;
X		    *A1++ +=r0*Ares[0]-r0*r0*r_0;
X		    for (i=1;i<k;i++)
X		      {
X			x=Ares[i];
X			for (j=i+1;j<k;j++)
X			  x-=Atemp[j]*Trtemp[j-i];
X			*A1++ +=r0*x;
X		      }
X		    Ares += k;
X		  }
X              }
X            break;
X
X	/* Vector Operations */
X
X      case int_av_av:
X        result_v= get_locint_r();
X        size = get_locint_r();
X        loc1_v = get_locint_r();
X	for (l=0;l<size;l++)
X	  {
X	    loc1 = result_v + l;   /* Location of left-hand-side  */
X	    loc2 = loc1_v + l;   /* Location of right-hand-side */
X	    /* code for int_adb_a */
X	    A1 = A[loc2];
X	    Ares = A[loc1];
X	    for (p=0;p<pd;p++)
X	      {
X		if  (0==*Ares)
X		  {
X		    Ares += k1;
X		    A1 += k1;
X		  }
X		else 
X		  {
X		    maxinc(*A1,*Ares);
X		    A1++; *Ares++ = 0;
X		    for (i=0;i<k;i++)
X		      {
X			*A1++ += *Ares;
X			*Ares++ = 0 ;
X		      }
X		  }
X	      }
X	    
X	  }
X	break;
X      case assign_dv:
X        loc1_v = get_locint_r();
X        size = get_locint_r();
X        d = get_val_v_r(size);
X	for (l=size-1;l>=0;l--)
X	  {
X	    loc1 = loc1_v + l;           /* Location of left-hand-side */
X	    stored_val = d[l];      /* Value of right-hand-side   */     
X	    /* code for assign_d */
X	    Ares = A[loc1];
X	    for (p=0;p<pdk;p++)
X	      *Ares++ = 0.0;
X	    get_taylors(loc1,k);
X	  }
X	reset_val_r();
X	break;
X      case assign_av:
X        loc1_v = get_locint_r();
X        size = get_locint_r();
X        loc2_v = get_locint_r();
X	for (l=size-1;l>=0;l--)
X	  {
X	    loc1 = loc1_v + l;             /* Location of left-hand-side  */
X	    loc2 = loc2_v + l;             /* Location of right-hand-side */
X	    /* code for assign_a */
X	    get_taylors(loc1,k);
X	    A1 = A[loc2];
X	    Ares = A[loc1];
X	    for (p=0;p<pd;p++)
X	      {
X		if  (0==*Ares)
X		  {
X		    Ares += k1;
X		    A1 += k1;
X		  }
X		else 
X		  {
X		    maxinc(*A1,*Ares);
X		    A1++; *Ares++ = 0;
X		    for (i=0;i<k;i++)
X		      {
X			*A1++ += *Ares;
X			*Ares++ = 0 ;
X		      }
X		  }
X	      }
X	  }
X	break;
X      case assign_indvec:
X        loc1_v = get_locint_r();
X        size = get_locint_r();
X	for (l=size-1;l>=0;l--)
X	  {
X	    loc1 = loc1_v + l;             /* Location of the left-hand-side */
X	    /* code for assign_ind */
X	    get_taylors(loc1,k);
X	    Ares = A[loc1];
X	    for (p=0;p<pd;p++)
X	      {
X		if(nonzero)
X		  nonzero[p][indexi] = (int)*Ares;
X		Ares++;
X		for (i=0;i<k;i++)
X		  results[p][indexi][k-1-i]= *Ares++; 
X	      }
X	    indexi--;
X	  }
X	reset_val_r();
X	break;
X      case assign_depvec:
X        loc1_v = get_locint_r();
X        size = get_locint_r();
X	for (l=size-1;l>=0;l--)
X	  {
X	    loc1 = loc1_v + l;             /* Location of the left-hand-side */
X	    /* code for assign_dep */
X	    Ares = A[loc1];
X	    for (p=0;p<pd;p++)
X	      {
X		Ares[k] = lagrange[p][indexd];
X		if(Ares[k]) *Ares = 1.0;
X		Ares += k1;
X	      }
X	    indexd--;
X	  }
X	break;
X      case eq_min_av:
X        result_v = get_locint_r();
X        size = get_locint_r();
X        loc1_v = get_locint_r();
X	for (l=size-1;l>=0;l--)
X	  {
X	    result = result_v + l;            /* Location of left-hand-side  */
X	    loc1   = loc1_v + l;              /* Location on right-hand-side */
X	    /* code for eq_min_a */ 
X	    get_taylors(result,k);
X	    Ares=A[result];
X	    A1=A[loc1];
X	    for (p=0;p<pd;p++)
X	      if  (0==*Ares)
X		{
X		  Ares += k1;
X		  A1 += k1;
X		}
X	      else 
X		{
X		  maxinc(*A1,*Ares);
X		  A1++; Ares++;
X		  for (i=0;i<k;i++)
X		    *A1++ -= *Ares++;
X		}
X	  }
X	break;
X      case eq_plus_av:
X        result_v = get_locint_r();
X        size = get_locint_r();
X        loc1_v = get_locint_r();
X	for (l=size-1;l>=0;l--)
X	  {
X	    result = result_v + l;            /* Location of left-hand-side  */
X	    loc1   = loc1_v   + l;            /* Location on right-hand-side */
X	    /* code for eq_plus_a */
X	    get_taylors(result,k);
X	    Ares=A[result];
X	    A1=A[loc1];
X	    for (p=0;p<pd;p++)
X	      if  (0 == *Ares)
X		{
X		  Ares += k1;
X		  A1 += k1;
X		}
X	      else
X		{
X		  maxinc(*A1,*Ares);
X		  A1++; Ares++;
X		  for (i=0;i<k;i++)
X		    *A1++ += *Ares++;
X		}
X	    
X	  }
X	break;
X      case eq_mult_av_a:
X        result_v = get_locint_r();
X        size = get_locint_r();
X        loc1 = get_locint_r();
X	for (l=size-1;l>=0;l--)
X	  {
X	    result = result_v + l;      /* Location of the left-hand-side  */
X	    /* loc1   = fixed;             Location on the right-hand-side */
X	    
X	    /* code for eq_mult_a*/
X	    get_taylors(result,k);
X	    Tr1 = Tr[loc1];
X	    Tres = Tr[result];
X	    A1 = A[loc1];
X	    Ares = A[result];
X	    for (p=0;p<pd;p++)
X	      {
X		if (0==*Ares) 
X		  {
X		    A1 += k1;
X		    Ares += k1;
X		  }
X		else
X		  {
X		    maxinc(*Ares,2.0);
X		    maxinc(*A1,*Ares);
X		    A1++; Ares++;
X		    for (i=k-1;i>=0;i--)
X		      {
X			x = 0.0;
X			y = 0.0;
X			Atemp[i] = Ares[i];
X			Ares[i] = 0;
X			for (j=i;j<k;j++)
X			  {
X			    x+=Atemp[j]*Tres[j-i];
X			    y+=Atemp[j]*Tr1[j-i];
X			  }
X			A1[i] +=x;
X			Ares[i] +=y;
X		      }
X		    A1 += k;
X		    Ares += k;
X		  }
X	      }
X	  }
X	break;
X      case eq_mult_av_d:
X        result_v = get_locint_r();
X        size = get_locint_r();
X        stored_val = get_val_r();
X	for (l=size-1;l>=0;l--)
X	  {
X	    result = result_v + l;      /* Location of the left-hand-side  */
X	    /* stored_val = fixed;            value on the right-hand-side */
X	    /* code for eq_mult_d*/
X	    get_taylors(result,k);
X	    Ares = A[result];
X	    for (p=0;p<pd;p++)
X	      if  (0==*Ares++)
X		Ares += k;
X	      else for (i=0;i<k;i++)
X		*Ares++  *= stored_val;
X	  }
X	break;
X      case sub_av_av:
X        result_v = get_locint_r();
X        size     = get_locint_r();
X        loc2_v   = get_locint_r();
X        loc1_v   = get_locint_r();
X	for (l=0;l<size;l++)
X	  {
X	    loc2   = loc2_v    + l;       /* Location of var 2  */
X	    loc1   = loc1_v    + l;       /* Location of var 1  */
X	    result = result_v  + l;       /* Location of result */
X	    /* code for min_a_a */
X	    Ares = A[result];
X	    A1 = A[loc1];
X	    A2 = A[loc2];
X	    for (p=0;p<pd;p++)
X	      if  (0==*Ares)
X		{
X		  Ares+=k1;
X		  A1 += k1;
X		  A2 += k1;
X		}
X	      else
X		{
X		  maxinc(*A1,*Ares);
X		  maxinc(*A2,*Ares);
X		  A2++; A1++; Ares++;
X		  for (i=0;i<k;i++)
X		    {
X		      *A1++ += *Ares;
X		      *A2++ -= *Ares++;
X		    }
X		}
X	    
X	  }
X	break;
X      case plus_av_av:
X        result_v = get_locint_r();
X        size     = get_locint_r();
X        loc2_v   = get_locint_r();
X        loc1_v   = get_locint_r();
X	for (l=0;l<size;l++)
X	  {
X	    loc2   = loc2_v    + l;       /* Location of var 2  */
X	    loc1   = loc1_v    + l;       /* Location of var 1  */
X	    result = result_v  + l;       /* Location of result */
X	    /* code for plus_a_a */
X	    Ares = A[result];
X	    A1 = A[loc1];
X	    A2 = A[loc2];
X	    for (p=0;p<pd;p++)
X	      if  (0==*Ares)
X		{
X		  Ares+=k1;
X		  A1 += k1;
X		  A2 += k1;
X		}
X	      else
X		{
X		  maxinc(*A1,*Ares);
X		  maxinc(*A2,*Ares);
X		  A2++; A1++; Ares++;
X		  for (i=0;i<k;i++)
X		    {
X		      *A1++ += *Ares;
X		      *A2++ += *Ares++;
X		    }
X		}
X	    
X	  }
X	break;
X      case dot_av_av:
X        result_v = get_locint_r();
X        size     = get_locint_r();
X        loc2_v   = get_locint_r();
X        loc1_v   = get_locint_r();
X	result = result_v;
X	for (l=0;l<size;l++)
X	  {
X	    loc2 = loc2_v + l;
X	    loc1 = loc1_v + l;
X	    /* code for mult_a_a  */
X	    Tr1 = Tr[loc1];
X	    Tr2 = Tr[loc2];
X	    Ares = A[result];
X	    A2 = A[loc2];
X	    A1 = A[loc1];
X	    for (p=0;p<pd;p++)
X	      if (0==*Ares)
X		{ 
X		  A1 += k1;
X		  A2 += k1;
X		  Ares += k1;
X		}
X	      else
X		{
X		  revreal comp = (*Ares > 2.0) ? *Ares : 2.0 ;
X		  maxinc(*A1,comp);
X		  maxinc(*A2,comp);
X		  A1++; A2++; Ares++;
X		  for (i=0;i<k;i++)
X		    {
X		      x = 0.0;
X		      y = 0.0;
X		      for (j=i;j<k;j++)
X			{
X			  x+=Ares[j]*Tr1[j-i];
X			  y+=Ares[j]*Tr2[j-i];
X			}
X		      *A2++ +=x;
X		      *A1++ +=y;
X		    }
X		  Ares += k;
X		} 
X	  }
X	Ares = A[result];
X	for (p=0;p<pdk;p++)
X	  *Ares++ = 0.0;
X	
X	break;
X      case mult_d_av:
X        result_v = get_locint_r();
X        size = get_locint_r();
X        loc1_v = get_locint_r();
X        stored_val =get_val_r();
X	for (l=0;l<size;l++)
X	  {
X	    loc1   = loc1_v   + l;   /* Location on the right-hand-side */
X	    result = result_v + l;   /* location of the result */
X	    /* stored_val = Fixed double value */
X	    
X	    /* code for mult_d_a */
X	    Ares = A[result];
X	    A1= A[loc1];
X	    for (p=0;p<pd;p++)
X	      if  (0==*Ares)
X		{
X		  Ares += k1;
X		  A1 += k1;
X		}
X	      else
X		{
X		  maxinc(*A1,*Ares);
X		  A1++; Ares++;
X		  for (i=0;i<k;i++)
X		    *A1++ += stored_val* (*Ares++);
X		}
X	  }
X	break;
X      case div_av_a:
X        result_v = get_locint_r();
X        size     = get_locint_r();
X        loc2_v   = get_locint_r();
X        loc1_v   = get_locint_r();
X	loc2= loc2_v;     /* Location of adouble */
X	for (l=0;l<size;l++)
X	  {
X	    loc1   = loc1_v   + l;  /* Location of right-hand-side vector[l] */
X	    result = result_v + l;  /* Location of the result */
X	    
X	    /* code for div_a_a */
X	    Tr2 = Tr[loc2];
X	    Tres = Tr[result];
X	    r0=1/(*Tr2);
X	    Ares = A[result];
X	    A2 = A[loc2];
X	    A1 = A[loc1];
X	    for (p=0;p<pd;p++)
X	      {
X		if (0==*Ares)
X		  {
X		    Ares += k1;
X		    A1 += k1;
X		    A2 += k1;
X		  }
X		else
X		  {
X		    maxinc(*A1,3.0);
X		    maxinc(*A1,*Ares);
X		    maxinc(*A2,3.0);
X		    maxinc(*A2,*Ares);
X		    A1++; A2++; Ares++;
X		    for (i=k-2;i>=0;i--)
X		      {
X			x = 0.0;
X			for (j=i+1;j<k;j++)
X			  x+=Ares[j]*Tr2[j-i];
X			Ares[i]-=x*r0;
X		      }
X		    r_0 = 0.0;
X		    for (i=0;i<k;i++)
X		      r_0+=Ares[i]*Tres[i];
X		    *A2++ -= r_0*r0;
X		    for (i=1;i<k;i++)
X		      {
X			x = 0.0;
X			for (j=i;j<k;j++)
X			  x+=Ares[j]*Tres[j-i];
X			*A2++ -=x*r0;
X		      }
X		    for (i=0;i<k;i++)
X		      *A1++ +=r0*Ares[i];
X		    Ares += k;
X		  }
X	      }
X	  }
X	break;
X      case mult_av_a:
X        result_v = get_locint_r();
X        size     = get_locint_r();
X        loc2_v   = get_locint_r();
X        loc1_v   = get_locint_r();
X	loc2= loc2_v;   /* Location of adouble */
X	for (l=0;l<size;l++)
X	  {
X	    loc1   = loc1_v   + l; /* Location of right-hand-side vector[l] */
X	    result = result_v + l; /* Location of the result */
X	    
X	    /* code for mult_a_a */
X	    Tr1 = Tr[loc1];
X	    Tr2 = Tr[loc2];
X	    Ares = A[result];
X	    A2 = A[loc2];
X	    A1 = A[loc1];
X	    for (p=0;p<pd;p++)
X	      if (0==*Ares)
X		{ 
X		  A1 += k1;
X		  A2 += k1;
X		  Ares += k1;
X		}
X	      else
X		{
X		  revreal comp = (*Ares > 2.0) ? *Ares : 2.0 ;
X		  maxinc(*A1,comp);
X		  maxinc(*A2,comp);
X		  A1++; A2++; Ares++;
X		  for (i=0;i<k;i++)
X		    {
X		      x = 0.0;
X		      y = 0.0;
X		      for (j=i;j<k;j++)
X			{
X			  x+=Ares[j]*Tr1[j-i];
X			  y+=Ares[j]*Tr2[j-i];
X			}
X		      *A2++ +=x;
X		      *A1++ +=y;
X		    }
X		  Ares += k;
X		} 
X	    
X	  }
X	break;
X      case mult_a_av:
X        result_v = get_locint_r();
X        size     = get_locint_r();
X        loc2_v   = get_locint_r();
X        loc1_v   = get_locint_r();
X	loc1= loc2_v;      /* Location of the adouble */
X	for (l=0;l<size;l++)
X	  {
X	    loc2= loc1_v+l;        /* Location of right hand side vector[l]  */
X	    result = result_v + l; /* Location of the result */
X	    
X	    /* code for mult_a_a */
X	    Tr1 = Tr[loc1];
X	    Tr2 = Tr[loc2];
X	    Ares = A[result];
X	    A2 = A[loc2];
X	    A1 = A[loc1];
X	    for (p=0;p<pd;p++)
X	      if (0==*Ares)
X		{ 
X		  A1 += k1;
X		  A2 += k1;
X		  Ares += k1;
X		}
X	      else
X		{
X		  revreal comp = (*Ares > 2.0) ? *Ares : 2.0 ;
X		  maxinc(*A1,comp);
X		  maxinc(*A2,comp);
X		  A1++; A2++; Ares++;
X		  for (i=0;i<k;i++)
X		    {
X		      x = 0.0;
X		      y = 0.0;
X		      for (j=i;j<k;j++)
X			{
X			  x+=Ares[j]*Tr1[j-i];
X			  y+=Ares[j]*Tr2[j-i];
X			}
X		      *A2++ +=x;
X		      *A1++ +=y;
X		    }
X		  Ares += k;
X		} 
X	  }
X	break;
X#ifdef conditional
X      case cond_assign:
X        result = get_locint_r();
X        loc2 = get_locint_r();
X        loc1 = get_locint_r();
X        loc1_v = get_locint_r(); 
X	get_taylors(result,k);
X	A1 = A[loc1];
X	Ares = A[result];
X        A2 = A[loc2];
X        Tr1 = Tr[loc1_v];
X        if (*Tr1>0)
X        {
X	  for (p=0;p<pd;p++)
X	  {
X	    if  (0==*Ares)
X	    {
X              Ares += k1;
X	      A1 += k1;
X	    } /* endif */
X	    else 
X	    {
X              maxinc(*A1,*Ares);
X              A1++; *Ares++ = 0;
X              for (i=0;i<k;i++)
X              {
X                 *A1++ += *Ares;
X                 *Ares++ = 0 ;
X              } /* endfor */
X            } /* endelse */
X	  } /* endfor */
X        } /* endif */
X        else
X        {
X          for (p=0;p<pd;p++)
X          {
X            if  (0==*Ares)
X            {
X              Ares += k1;
X              A2 += k1;
X            } /* endif */
X            else
X            {
X              maxinc(*A2,*Ares);
X              A2++; *Ares++ = 0;
X              for (i=0;i<k;i++)
X              {
X                 *A2++ += *Ares;
X                 *Ares++ = 0 ;
X              } /* endfor */
X            } /* endelse */
X          } /* endfor */
X        } /* endelse */
X	break;
X      case cond_assign_s:
X        result = get_locint_r();
X        loc1 = get_locint_r();
X        loc1_v = get_locint_r(); 
X	get_taylors(result,k);
X	A1 = A[loc1];
X	Ares = A[result];
X        Tr1 = Tr[loc1_v];
X        if (*Tr1>0)
X        {
X          for (p=0;p<pd;p++)
X          {
X            if  (0==*Ares)
X            {
X              Ares += k1;
X              A1 += k1;
X            } /* endif */
X            else
X            {
X              maxinc(*A1,*Ares);
X              A1++; *Ares++ = 0;
X              for (i=0;i<k;i++)
X              {
X                 *A1++ += *Ares;
X                 *Ares++ = 0 ;
X              } /* endfor */
X            } /* endelse */
X          } /* endfor */
X        } /* endif */
X	break;
X      case subscript:
X        result = get_locint_r();
X        loc1 = get_locint_r();
X        loc1_v = get_locint_r(); 
X	get_taylors(result,k);
X	A1 = A[loc1_v+(int)(Tr[loc1][0])];
X	Ares = A[result];
X	for (p=0;p<pd;p++)
X	  {
X	    if  (0==*Ares)
X	      {
X		Ares += k1;
X		A1 += k1;
X	      }
X	    else 
X	      {
X		maxinc(*A1,*Ares);
X		A1++; *Ares++ = 0;
X		for (i=0;i<k;i++)
X		  {
X		    *A1++ += *Ares;
X		    *Ares++ = 0 ;
X                  }
X	      }
X	  }
X	break;
X      case subscript_l:
X        result = get_locint_r();
X        loc1 = get_locint_r();
X        loc1_v = get_locint_r(); 
X	get_taylors(loc1_v+(int)(Tr[loc1][0]),k);
X	A1 = A[result];
X	Ares = A[loc1_v+(int)(Tr[loc1][0])];
X	for (p=0;p<pd;p++)
X	  {
X	    if  (0==*Ares)
X	      {
X		Ares += k1;
X		A1 += k1;
X	      }
X	    else 
X	      {
X		maxinc(*A1,*Ares);
X		A1++; *Ares++ = 0;
X		for (i=0;i<k;i++)
X		  {
X		    *A1++ += *Ares;
X		    *Ares++ = 0 ;
X                  }
X	      }
X	  }
X	break;
X      case subscript_ld:
X        loc1 = get_locint_r();
X        loc1_v = get_locint_r(); 
X        stored_val = get_val_r();
X	Ares = A[loc1_v+(int)(Tr[loc1][0])];
X	for (p=0;p<pdk;p++)
X	  *Ares++ = 0.0;
X	break;
X      case m_subscript:
X        result = get_locint_r();
X        size = get_locint_r();
X        loc1 = get_locint_r();
X        loc1_v = get_locint_r(); 
X        for (l=size-1;l>=0;l--)
X        {
X          res=result+l;
X          arg=loc1_v+(int)(Tr[loc1][0])*size+l;
X	  A1 = A[arg];
X          Ares = A[res];
X	  for (p=0;p<pd;p++)
X	  {
X	    if  (0==*Ares)
X	      {
X		Ares += k1;
X		A1 += k1;
X	      }
X	    else 
X	      {
X		maxinc(*A1,*Ares);
X		A1++; *Ares++ = 0;
X		for (i=0;i<k;i++)
X		  {
X		    *A1++ += *Ares;
X		    *Ares++ = 0 ;
X                  }
X	      }
X	  }
X        } /* endfor */
X	break;
X      case m_subscript_l:
X        result = get_locint_r();
X        size = get_locint_r();
X        loc1 = get_locint_r();
X        loc1_v = get_locint_r(); 
X        for (l=size-1;l>=0;l--)
X        {
X          res=result+l;
X          arg= loc1_v+(int)(Tr[loc1][0])*size+l;
X	  get_taylors(arg,k);
X	  A1 = A[res];
X	  Ares = A[arg];
X	  for (p=0;p<pd;p++)
X	  {
X	    if  (0==*Ares)
X	      {
X		Ares += k1;
X		A1 += k1;
X	      }
X	    else 
X	      {
X		maxinc(*A1,*Ares);
X		A1++; *Ares++ = 0;
X		for (i=0;i<k;i++)
X		  {
X		    *A1++ += *Ares;
X		    *Ares++ = 0 ;
X                  }
X	      }
X	  }
X        } /* endfor */
X	break;
X      case m_subscript_ld:
X        size = get_locint_r();
X        loc2 = get_locint_r();
X        loc1 = get_locint_r();
X        loc1_v = get_locint_r(); 
X        d = get_val_v_r(size);
X        for (l=size-1;l>=0;l--)
X        {
X          arg=loc1_v+(int)(Tr[loc1][0])*size+l+loc2;
X	  Ares = A[arg];
X	  for (p=0;p<pdk;p++)
X	    *Ares++ = 0.0;
X        } /* endfor */
X	break;
X#endif	 
X   
X      default:
X	printf("ADOL-C error: Fatal error in hov_reverse on operation %d\n",
X	       operation);
X	exit(-1);
X	break;
X      }
X
X      /* Get the next operation */
X
X      operation=get_op_r();
X    }
X  end_sweep();
X}
X
X#ifdef __cplusplus
X}
X#endif
X
END_OF_FILE
if test 40471 -ne `wc -c <'hov_reverse.c'`; then
    echo shar: \"'hov_reverse.c'\" unpacked with wrong size!
fi
chmod +x 'hov_reverse.c'
# end of 'hov_reverse.c'
fi
if test -f 'oplate.h' -a "${1}" != "-c" ; then 
  echo shar: Will not clobber existing file \"'oplate.h'\"
else
echo shar: Extracting \"'oplate.h'\" \(2866 characters\)
sed "s/^X//" >'oplate.h' <<'END_OF_FILE'
X/* 
X -------------------------------------------------------------------------
X File oplate.h of ADOL-C version 1.6 as of January 1,   1995          
X Included in ---->
X                  adouble.c
X		  avector.c 
X                  fos_reverse.c
X                  fov_reverse.c 
X                  hos_forward.c
X                  hos_reverse.c
X                  hov_reverse.c
X                  taputil1.c
X                  taputil2.c
X                  taputil3.c
X
X		  
X Provides numeric values for the various opcodes used by ADOL-C.
X
X ------------------------------------------------------------------------- 
X
X*/
X
X/*
X  Opcodes for scalar operations
X*/
X
X#define death_not 1
X#define assign_ind 2
X#define assign_dep 3
X#define assign_a 4
X#define assign_d 5
X#define eq_plus_d 6
X#define eq_plus_a 7
X#define eq_min_d 8
X#define eq_min_a 9
X#define eq_mult_d 10
X#define eq_mult_a 11
X#define plus_a_a 12
X#define plus_d_a 13
X#define min_a_a 14
X#define min_d_a 15
X#define mult_a_a 16
X#define mult_d_a 17
X#define div_a_a 18
X#define div_d_a 19
X#define exp_op 20
X#define cos_op 21
X#define sin_op 22
X#define atan_op 23
X#define log_op 24
X#define pow_op 25
X
X/* New as of 4/9/90 */
X
X#define asin_op 26
X#define acos_op 27
X#define sqrt_op 28
X/* removed 1/95
X#define eq_div_a 29
X#define eq_div_d 30
X#define tan_op 31
X*/
X
X/* New as of 7/3/90 */
X
X#define ignore_me 0
X#define gen_quad 32 /* A General Quadrature */
X
X/* New as of 6/10/93 */
X
X#define int_adb_a 33 /* Initialize an adouble with another adouble */
X#define int_adb_d 34 /* Initialize an adouble with a double value  */
X
X/* New as of 7/13/93 */
X
X/* Opcodes for tape delimiters. */
X
X#define end_of_tape 35
X#define start_of_tape 36
X
X#define end_of_op 37
X#define end_of_int 38
X#define end_of_val 39
X
X/* For vector operations */
X
X#define plus_av_av    40
X/* removed 1/95
X#define plus_dv_av    41
X*/
X#define sub_av_av     42
X/* removed 1/95
X#define sub_dv_av     43
X#define sub_av_dv     44
X*/
X#define dot_av_av     45
X/* removed 1/95
X#define dot_dv_av     46
X*/
X#define mult_a_av     47
X#define mult_d_av     48
X/* removed 1/95
X#define mult_a_dv     49
X*/
X#define int_av_av     50
X/* removed 1/95
X#define int_av_dv     51  
X*/
X#define assign_av     52
X#define assign_dv     53
X#define assign_indvec 54
X#define assign_depvec 55
X/* removed 1/95
X#define eq_min_dv     56
X*/
X#define eq_min_av     57
X/* removed 1/95
X#define eq_plus_dv    58
X*/
X#define eq_plus_av    59
X#define div_av_a      60
X#define eq_mult_av_d  61
X#define eq_mult_av_a  62
X/* removed 1/95
X#define dot_av_dv     63
X*/
X#define mult_av_a     64
X
X#define cond_assign   70
X#define cond_assign_s 71
X 
X#define m_subscript   72
X#define m_subscript_l 73
X#define m_subscript_ld 74
X
X#define subscript     75
X#define subscript_l   76
X#define subscript_ld  77
X
X/* removed 1/95
X#define cross_av_av   80
X#define mult_cv3_av4  81
X*/
X/*New as of 8/14/94 */
X#define abs_val       101
X
X
X
END_OF_FILE
if test 2866 -ne `wc -c <'oplate.h'`; then
    echo shar: \"'oplate.h'\" unpacked with wrong size!
fi
chmod +x 'oplate.h'
# end of 'oplate.h'
fi
if test -f 'taputil1.c' -a "${1}" != "-c" ; then 
  echo shar: Will not clobber existing file \"'taputil1.c'\"
else
echo shar: Extracting \"'taputil1.c'\" \(8164 characters\)
sed "s/^X//" >'taputil1.c' <<'END_OF_FILE'
X/*
X   --------------------------------------------------------------
X   File taputil1.c of ADOL-C version 1.6 as of January 1,   1995
X   --------------------------------------------------------------
X   Provides the definition of the write- interface functions and
X   write statistics functions (get_write_stats, clear_stats).
X   The majority of these functions are called by the badouble, 
X   badoublev operations defined in adouble.c and avector.c.
X   These routines write operations to "tape." 
X*/
X
X#ifdef __cplusplus
Xextern "C" {
X#endif
X
X#include "dvlparms.h" /* Developers Parameters */
X
X/* Necessary Local Includes */
X
X#include "usrparms.h"
X#include "tayutil.h"
X#include "oplate.h"
X#include "taputil2.h"
X
X/* Static variables for statistics */
X
Xstatic int ind_ptr;
Xstatic int dep_ptr;
Xstatic int death_ptr;
Xstatic int revalso;
X
X/* Store --- external double pointer from adouble.c */
Xextern double* store;
X
X
Xvoid get_write_stats(int *x, int *y, int *z, int *w)
X{
X  *x = dep_ptr;
X  *y = ind_ptr;
X  *z = death_ptr;
X  *w = revalso;
X}
X
Xvoid clear_stats(int reverse_flag)
X{
X  revalso = reverse_flag;
X  ind_ptr=0;
X  dep_ptr=0;
X  death_ptr=0;      
X}
X
X
X
X/* ---- Write Routines for sequential functions ----- */
X
X
X
Xvoid write_death(locint loc1, locint loc2) 
X{
X  put_op(death_not);
X  put_locint(loc1);
X  put_locint(loc2);
X  death_ptr += loc2-loc1+1;
X  if (revalso) 
X    {
X     write_scaylor(store[loc2]);
X     while(loc2>loc1) write_scaylor(store[--loc2]);
X     }
X}
X
Xvoid write_assign_a( locint loc1,
X		     locint loc2)
X{
X  put_op(assign_a);
X  put_locint(loc2);
X  put_locint(loc1);
X  ++(death_ptr);
X  if (revalso) write_scaylor(store[loc1]);
X}
Xvoid write_int_assign_a( locint loc1,
X		         locint loc2)
X{
X  put_op(int_adb_a);
X  put_locint(loc2);
X  put_locint(loc1);
X  /*  ++(death_ptr); */
X}
X
Xvoid write_assign_ind( locint loc1) 
X{
X
X  (ind_ptr)++;
X
X  put_op(assign_ind);
X  put_locint(loc1);
X
X  ++(death_ptr);
X  if(revalso) write_scaylor(store[loc1]);
X}
X
Xvoid write_assign_dep( locint loc1)
X{
X  (dep_ptr)++;
X
X  put_op(assign_dep);
X  put_locint(loc1);
X}
X
Xvoid write_assign_d( locint loc1, double value)
X{
X  put_op(assign_d);
X  put_locint(loc1);
X  put_val(value);
X  ++(death_ptr);
X  if (revalso)  write_scaylor(store[loc1]);
X}
X
Xvoid write_int_assign_d( locint loc1, double value)
X{
X  put_op(int_adb_d);
X  put_locint(loc1);
X  put_val(value);
X  /* ++(death_ptr); */
X  /* if (revalso)  write_scaylor(store[loc1]); */
X}
Xvoid write_a_same_arg(unsigned char giv_typ,locint result,locint loc1)
X{
X  put_op(giv_typ);
X  put_locint(loc1);
X  put_locint(result);
X  ++death_ptr;
X  if (revalso)  write_scaylor(store[result]);
X}
Xvoid write_d_same_arg(unsigned char giv_typ,locint result,double value)
X{
X  put_op(giv_typ);
X  put_locint(result);
X  put_val(value);
X  ++death_ptr;
X  if (revalso)  write_scaylor(store[result]);
X}
Xvoid write_two_a_rec( unsigned char giv_typ,locint result,
X		      locint loc_1,locint loc_2)
X{
X  put_op(giv_typ);
X  put_locint(loc_1);
X  put_locint(loc_2);
X  put_locint(result);
X}
Xvoid write_args_d_a(unsigned char giv_typ, locint result,
X		    double const_val,locint a_loc)
X{
X  put_op(giv_typ);
X  put_locint(a_loc);
X  put_locint(result);
X  put_val(const_val);
X}
X
Xvoid write_single_op(unsigned char giv_typ,
X		     locint result,locint old_loc)
X{
X  put_op(giv_typ);
X  put_locint(old_loc);
X  put_locint(result);
X}
Xvoid write_quad(unsigned char giv_typ,
X		locint result,locint old_loc,locint deriv_loc)
X{
X  put_op(giv_typ);
X  put_val(store[result]);
X  put_locint(old_loc);
X  put_locint(deriv_loc);
X  put_locint(result);
X}
X
X
X
X
X/* -----  Write Routines for vector functions -------- */
X
X
X
X
Xvoid write_assign_av(locint size,locint loc1,locint loc2)
X{
X  put_op(assign_av);
X  put_locint(loc2);
X  put_locint(size);
X  put_locint(loc1);
X  death_ptr+=size;
X  if (revalso) write_scaylors((store+loc1),size);
X}
X
Xvoid write_intvec_assign_av(locint size,locint result, locint loc1)
X{
X  put_op(int_av_av);
X  put_locint(loc1);
X  put_locint(size);
X  put_locint(result);
X}
X
X
Xvoid write_assign_indvec(locint size, locint loc1,double *vals)
X{
X  (ind_ptr)+=size;
X  put_op(assign_indvec);
X  put_locint(size);
X  put_locint(loc1);
X  death_ptr+=size;
X  if(revalso) write_scaylors((store+loc1),size);
X}
X
X
X
Xvoid write_assign_depvec(locint size, locint loc1)
X{
X  (dep_ptr)+=size;
X  put_op(assign_depvec);
X  put_locint(size);
X  put_locint(loc1);
X}
X
Xvoid write_assign_vec_dv(locint size, locint loc1, double* vals)
X{
X  locint space_left, vals_left=size,loc=loc1;
X  death_ptr+=size;
X  space_left=get_val_space();
X  while (space_left<vals_left){
X    put_op(assign_dv);
X    put_locint(space_left);
X    put_locint(loc1);
X    put_vals_p(vals,space_left);
X    vals+=space_left;
X    vals_left-=space_left;
X    loc1+=space_left;
X    space_left=get_val_space();
X  } /* end_while */
X  if (vals_left>0){
X    put_op(assign_dv);
X    put_locint(vals_left);
X    put_locint(loc1);
X    put_vals_r(vals,vals_left);
X  } /* endif */
X  if(revalso) write_scaylors((store+loc),size);
X}
X
X
X
Xvoid write_av_same_arg(unsigned char giv_typ,locint size,
X		       locint result,locint loc1)
X{
X  put_op(giv_typ);
X  put_locint(loc1);
X  put_locint(size);
X  put_locint(result);
X  death_ptr+=size;
X  if (revalso) write_scaylors((store+result),size);
X}
Xvoid write_samearg_av_d(unsigned char giv_typ,locint size,
X		       locint result,double y)
X{
X  put_op(giv_typ);
X  put_locint(size);
X  put_locint(result);
X  put_val(y);
X  death_ptr+=size;
X  if (revalso) write_scaylors((store+result),size);
X}
X
X
X
Xvoid write_two_av_rec(unsigned char giv_typ, locint size,
X			locint result, locint loc_1, locint loc_2)
X{
X  put_op(giv_typ);
X  put_locint(loc_1);
X  put_locint(loc_2);
X  put_locint(size);
X  put_locint(result);
X}
X
Xvoid write_av_a_rec(unsigned char giv_typ, locint size,locint result_s,
X		    locint x_start,locint a_loc)
X{
X  put_op(giv_typ);
X  put_locint(x_start);
X  put_locint(a_loc);
X  put_locint(size);
X  put_locint(result_s);
X}
X
X
X
Xvoid write_args_d_av(unsigned char giv_typ,locint size, locint result,
X		       double const_val,locint a_loc)
X{
X  put_op(giv_typ);
X  put_locint(a_loc);
X  put_locint(size);
X  put_locint(result);
X  put_val(const_val);
X}
X
X#ifdef conditional
Xvoid write_condassign(locint result, locint cop, locint r1,locint r2)
X{
X  put_op(cond_assign);
X  put_locint(cop);
X  put_locint(r1);
X  put_locint(r2);
X  put_locint(result);
X  ++(death_ptr);
X  if (revalso) write_scaylor(store[result]);
X}
X
Xvoid write_condassign2(locint result, locint cop, locint r1)
X{
X  put_op(cond_assign_s);
X  put_locint(cop);
X  put_locint(r1);
X  put_locint(result);
X  ++(death_ptr);
X  if (revalso) write_scaylor(store[result]);
X}
X
Xvoid write_associating_value(unsigned char giv_typ, locint location,
X			     locint base, locint offset)
X{
X  put_op(giv_typ);
X  put_locint(base);
X  put_locint(offset);
X  put_locint(location);
X  ++(death_ptr);
X  if (revalso) write_scaylor(store[location]);
X}
X 
Xvoid write_associating_value_ld(unsigned char giv_typ, double x,
X				locint base, locint offset)
X{
X  put_op(giv_typ);
X  put_val(x);
X  put_locint(base);
X  put_locint(offset);
X  if (giv_typ==subscript_l)
X  {
X    ++(death_ptr);
X    if (revalso) write_scaylor(store[base+(int)store[offset]]);
X  }
X}
X
Xvoid write_associating_vector(unsigned char giv_typ, locint s_loc,
X                              locint begin,  locint offset, locint size)
X{
X  put_op(giv_typ);
X  put_locint(begin);
X  put_locint(offset);
X  put_locint(size);
X  put_locint(s_loc);
X  death_ptr+=size;
X  if (revalso) write_scaylors((store+s_loc),size); 
X}
X
Xvoid write_associating_vector_ld(double* x, locint begin,  locint offset, 
X                                 locint size)
X{
X locint space_left, vals_left=size,loc=0;
X  space_left=get_val_space();
X  while (space_left<vals_left){
X    put_op(m_subscript_ld);
X    put_locint(begin);
X    put_locint(offset);
X    put_locint(loc);
X    put_locint(space_left);
X    put_vals_p(x,space_left);
X    x+=space_left;
X    vals_left-=space_left;
X    loc+=space_left;
X    space_left=get_val_space();
X  } /* end_while */
X  if (vals_left>0){
X    put_op(m_subscript_ld);
X    put_locint(begin);
X    put_locint(offset);
X    put_locint(loc);
X    put_locint(vals_left);
X    put_vals_r(x,vals_left);
X  } /* endif */
X}
X
X
X
X#endif
X
X
X#ifdef __cplusplus
X}
X#endif
X
END_OF_FILE
if test 8164 -ne `wc -c <'taputil1.c'`; then
    echo shar: \"'taputil1.c'\" unpacked with wrong size!
fi
chmod +x 'taputil1.c'
# end of 'taputil1.c'
fi
if test -f 'taputil1.h' -a "${1}" != "-c" ; then 
  echo shar: Will not clobber existing file \"'taputil1.h'\"
else
echo shar: Extracting \"'taputil1.h'\" \(3272 characters\)
sed "s/^X//" >'taputil1.h' <<'END_OF_FILE'
X/*
X -------------------------------------------------------------------------
X File taputil1.h of ADOL-C version 1.6 as of January 1,   1995          
X Included in ---->
X                  adouble.c
X		  avector.c
X                  fos_reverse.c
X                  fov_reverse.c 
X                  hos_forward.c
X                  hos_reverse.c
X                  hov_reverse.c
X                  taputil3.c
X
X
X ------------------------------------------------------------------------- 
X
X taputil1.h contains the prototypes for the functions defined in taputil1.c
X These functions provide general information on write statistics and
X provided an interface for writing operations to the 
X tape.
X*/
X
X
X/* Utilities */
X
Xextern void get_write_stats(int*, int*, int*, int*);
Xextern void clear_stats(int);
X
X/* Write routines for scalars */
X
Xextern void write_death(locint,locint);
Xextern void write_int_assign_a(locint,locint);
Xextern void write_int_assign_d(locint,double);
Xextern void write_assign_a(locint,locint);
Xextern void write_assign_d(locint,double);
Xextern void write_assign_ind(locint); 
Xextern void write_assign_dep(locint);
Xextern void write_a_same_arg(unsigned char,locint,locint);
Xextern void write_d_same_arg(unsigned char,locint,double);
Xextern void write_args_i_a(unsigned char,locint,int,locint);
Xextern void write_args_a_i(unsigned char,locint,locint,int);
Xextern void write_args_d_a(unsigned char,locint,double,locint);
Xextern void write_args_a_d(unsigned char,locint,locint,double);
Xextern void write_two_a_rec(unsigned char,locint,locint,locint);
Xextern void write_single_op(unsigned char,locint,locint);
Xextern void write_quad(unsigned char,locint,locint,locint);
X
X/* write routines for vectors */
X
Xextern void write_intvec_assign_av(locint,locint,locint);
Xextern void write_assign_vec_dv(locint, locint, double*);
Xextern void write_assign_av(locint, locint,locint);
Xextern void write_assign_indvec(locint,locint,double*);
Xextern void write_assign_depvec(locint size, locint loc1);
Xextern void write_dv_same_arg(unsigned char,locint,locint, double*);
Xextern void write_av_same_arg(unsigned char,locint,locint,locint);
Xextern void write_samearg_av_d(unsigned char,locint,locint,double);
Xextern void write_two_av_rec(unsigned char,locint,locint,locint,locint);
Xextern void write_args_dv_av(unsigned char,locint,locint,double*,locint);
Xextern void write_args_d_av(unsigned char,locint,locint,double,locint);
Xextern void write_av_a_rec(unsigned char,locint,locint, locint, locint);
Xextern void write_args_dv_a(unsigned char,locint,locint,double*,locint);
X
X
X#ifdef conditional
Xextern void write_condassign(locint result, locint cop, locint r1,locint r2);
Xextern void write_condassign2(locint result, locint cop, locint r1);
Xextern void write_associating_value(unsigned char giv_typ, locint location,
X				    locint base, locint offset);
Xextern void write_associating_value_ld(unsigned char giv_typ, double x,
X				       locint base, locint offset);
Xextern void write_associating_vector(unsigned char giv_typ, locint s_loc,
X                              locint begin,  locint offset, locint size);
Xextern void write_associating_vector_ld(double* x, locint begin,  
X                                        locint offset, locint size);
X#endif
X
X/* End of Include */
X
X
X
X
END_OF_FILE
if test 3272 -ne `wc -c <'taputil1.h'`; then
    echo shar: \"'taputil1.h'\" unpacked with wrong size!
fi
chmod +x 'taputil1.h'
# end of 'taputil1.h'
fi
if test -f 'taputil2.c' -a "${1}" != "-c" ; then 
  echo shar: Will not clobber existing file \"'taputil2.c'\"
else
echo shar: Extracting \"'taputil2.c'\" \(13458 characters\)
sed "s/^X//" >'taputil2.c' <<'END_OF_FILE'
X/*
X   --------------------------------------------------------------
X   File taputil2.c of ADOL-C version 1.6 as of January 1,   1995
X   --------------------------------------------------------------
X   Provides the definition of the tape - interface functions,etc.
X   The majority of these functions are called by the forward (hos_forward)
X   and reverse (fos, fov, hos, hov -reverse) functions and the functions
X   in taputil1.c.
X*/
X
X#ifdef __cplusplus
Xextern "C" {
X#endif
X
X#include "dvlparms.h" /* Developers Parameters */
X
X/* Necessary Includes */
X
X#include "usrparms.h"
X#include "oplate.h"
X#include "taputil3.h"
X
X/* Buffers for the operation tape, location tape, real tape. */
X
Xunsigned char *op_codes;
Xlocint *loc_tape;
Xdouble *real_tape;
X
X/* File pointers to the operation tape, location tape, real tape */ 
Xstatic FILE *op_file_out;
Xstatic FILE *int_file_out;
Xstatic FILE *val_file_out;
X
X/* Stats on operation tape, location tape, real tape */
Xstatic int op_access_ptr,int_access_ptr,val_access_ptr;
Xstatic int op_len_ptr,int_len_ptr,val_len_ptr;
X
X/* Pointers into the operation tape, location tape, real tape */
Xint op_ptr;
Xint loc_ptr;
Xint real_ptr;
X
Xunsigned char *g_op_ptr;
Xlocint *g_loc_ptr;
Xdouble *g_real_ptr;
X
X/* Strings for the tape names (actual file names) */
Xstatic char *op_file,*int_file,*val_file;
X
X/* Current buffer size */
Xstatic int buff_size;
X
X
X
Xvoid set_buf_size(int size)
X{
X  buff_size = size;
X}
X
Xvoid set_buffers(char *file1, unsigned char *op_addr,
X		 char *file2, locint *int_addr,
X		 char *file3, double *real_addr)
X{
X  op_codes = op_addr;
X  loc_tape = int_addr;
X  real_tape = real_addr;
X  op_file = file1;
X  int_file = file2;
X  val_file = file3;
X  op_ptr=loc_ptr=real_ptr = 0;
X  op_access_ptr = int_access_ptr = val_access_ptr = 0;
X  op_len_ptr=int_len_ptr=val_len_ptr = 0;
X}
X/****************************************************************/
X/** Put_Block puts a block of tape to the disk.  I assume this **/
X/** is called only during a first forward pass or during the   **/
X/** the taping itself. Its purpose is to record all of the     **/
X/** computations.                                              **/
X/****************************************************************/
Xvoid put_op_block(int buffer_size)
X{
X  int n;
X  if (op_access_ptr == 0)
X    {
X
X    op_file_out = fopen(op_file,"r");
X    if (op_file_out != 0)
X      {
X#ifdef DEBUG
X	printf("ADOL-C debug: old tapefile %s exists and deleted\n",op_file);
X#endif
X	fclose(op_file_out);
X        if(remove(op_file))  /*  Complies with ANSI C standard */
X   /*   if(unlink(op_file))      works on some UNIX systems */
X	  printf("ADOL-C error: unable to remove old tapefile\n");
X	op_file_out = fopen(op_file,"w");
X      }
X    else
X      {
X	op_file_out = fopen(op_file,"w");
X	errno =0; /* Clear Out the Error */
X      }
X    op_access_ptr = 1;
X    }
X
X  op_len_ptr += buffer_size;
X
X  if ((n=fwrite((char *)op_codes,buffer_size,1,op_file_out))!=1)
X    {
X      printf("ADOL-C error: Fatal error-doing a write %d--- error %d\n",n,errno);
X      fprintf(stderr,"ADOL-C error: Fatal error-doing a write %d--- error %d\n",n,errno);
X      switch (errno) {
X      case 28: /* ENOSPC */
X	printf("No space left on device-contact sys. manager\n");
X	fprintf(stderr,"No space left on device-contact sys. manager\n");
X	break;
X      case 27: /* EFBIG */
X	printf("File too big-- tape space exhausted.\n");
X	fprintf(stderr,"File too big-- tape space exhausted.\n");
X	break;
X      default:
X	printf("Unexpected unix file error-- %d.\n",errno);
X	fprintf(stderr,"Unexpected unix file error-- %d.\n",errno);
X	break;
X      }
X      exit(-3);
X    }
X  op_ptr=0;
X  errno=0;
X}
Xvoid put_locint_block(int buffer_size)
X{
X  int n;
X  if (int_access_ptr == 0)
X    {
X    int_file_out = fopen(int_file,"r");
X    if (int_file_out != 0)
X      {
X#ifdef DEBUG
X	printf("ADOL-C debug: old tapefile %s exists and deleted\n",int_file);
X#endif
X	fclose(int_file_out);
X        if(remove(int_file))  /*    Complies with ANSI C standard */
X   /*   if(unlink(int_file))        works on some UNIX systems    */
X	  printf("ADOL-C error: unable to remove old tapefile\n");
X	int_file_out = fopen(int_file,"w");
X      }
X    else
X      {
X	int_file_out = fopen(int_file,"w");
X	errno =0; /* Clear Out the Error */
X      }
X    int_access_ptr = 1;
X    }
X
X  int_len_ptr += buffer_size;
X
X  if ((n=fwrite((locint *)loc_tape,buffer_size*sizeof(locint),1,int_file_out))!=1)
X    {
X      printf("ADOL-C error: Fatal error-doing a write %d--- error %d\n",n,errno);
X      fprintf(stderr,"ADOL-C error: Fatal error-doing a write %d--- error %d\n",n,errno);
X      switch (errno) {
X      case 28: /* ENOSPC */
X	printf("No space left on device-contact sys. manager\n");
X	fprintf(stderr,"No space left on device-contact sys. manager\n");
X	break;
X      case 27: /* EFBIG */
X	printf("File too big-- tape space exhausted.\n");
X	fprintf(stderr,"File too big-- tape space exhausted.\n");
X	break;
X      default:
X	printf("Unexpected unix file error-- %d.\n",errno);
X	fprintf(stderr,"Unexpected unix file error-- %d.\n",errno);
X	break;
X      }
X      exit(-3);
X    }
X  loc_ptr=0;
X  errno=0;
X}
Xvoid put_val_block(int buffer_size)
X{
X  int n;
X  if (val_access_ptr == 0)
X    {
X
X    val_file_out = fopen(val_file,"r");
X    if (val_file_out != 0)
X      {
X#ifdef DEBUG
X	printf("ADOL-C debug: old tapefile %s exists and deleted\n",val_file);
X#endif
X	fclose(val_file_out);
X        if(remove(val_file))   /* Complies with ANSI C standard */
X     /*	if(unlink(val_file))      works on some UNIX systems    */
X	  printf("ADOL-C error: unable to remove old tapefile\n");
X	val_file_out = fopen(val_file,"w");
X      }
X    else
X      {
X	val_file_out = fopen(val_file,"w");
X	errno =0; /* Clear Out the Error */
X      }
X    val_access_ptr = 1;
X    }
X
X  val_len_ptr += buffer_size;
X
X  if ((n=fwrite((double *)real_tape,buffer_size*sizeof(double),1,val_file_out))!=1)
X    {
X      printf("ADOL-C error: Fatal error-doing a write %d--- error %d\n",n,errno);
X      fprintf(stderr,"ADOL-C error: Fatal error-doing a write %d--- error %d\n",n,errno);
X      switch (errno) {
X      case 28: /* ENOSPC */
X	printf("No space left on device-contact sys. manager\n");
X	fprintf(stderr,"No space left on device-contact sys. manager\n");
X	break;
X      case 27: /* EFBIG */
X	printf("File too big-- tape space exhausted.\n");
X	fprintf(stderr,"File too big-- tape space exhausted.\n");
X	break;
X      default:
X	printf("Unexpected unix file error-- %d.\n",errno);
X	fprintf(stderr,"Unexpected unix file error-- %d.\n",errno);
X	break;
X      }
X      exit(-3);
X    }
X  real_ptr=0;
X  errno=0;
X}
X
Xvoid close_tape(int *stats, int flag)
X{
X  int i;
X  int access = (flag || op_access_ptr || int_access_ptr ||val_access_ptr);
X  if (access)
X    {
X      if (op_ptr!=0)
X	put_op_block(op_ptr);
X      fclose(op_file_out);
X    }
X  else op_len_ptr=op_ptr;
X
X  stats[5]=op_len_ptr;
X  stats[6]=op_access_ptr;
X
X  if (access)
X    {
X     if (real_ptr!=0)
X       put_val_block(real_ptr);
X      fclose(val_file_out);
X    }
X  else
X    val_len_ptr = real_ptr;
X  stats[9]=val_len_ptr;
X  stats[10]=val_access_ptr;
X  if (access)
X    {
X     if (loc_ptr!=0)
X       put_locint_block(loc_ptr);
X     stats[7]=int_len_ptr;
X     stats[8]=int_access_ptr;
X     fseek(int_file_out,0,0);
X     fwrite(stats,11*sizeof(int),1,int_file_out);
X     fclose(int_file_out);
X   }
X  else{
X    int_len_ptr=loc_ptr;
X    stats[7]=int_len_ptr;
X    stats[8]=int_access_ptr;
X    for(i=0;i<11;i++)
X      {
X	loc_tape[i]=stats[i];
X      }
X  }
X}
X
Xstatic long op_file_cnt,int_file_cnt,val_file_cnt;
X
Xvoid end_sweep()
X{
X  if (op_access_ptr)
X    { 
X      fclose(op_file_out);
X    } 
X  if (int_access_ptr)
X    { 
X      fclose(int_file_out);
X    }
X  if (val_access_ptr)
X    { 
X      fclose(val_file_out);
X    }
X
X}
X
X
Xvoid init_rev_sweep(int tag)
X{
X  get_op_stats(tag,&op_file,&op_len_ptr,&op_access_ptr,&op_codes);
X  if (op_access_ptr)
X    { 
X      op_file_out=fopen(op_file,"r");
X      op_ptr=op_len_ptr % buff_size;
X      fseek(op_file_out,0,2);
X      op_file_cnt =  ftell(op_file_out);
X      op_file_cnt -=op_ptr*sizeof(unsigned char);
X      fseek(op_file_out,op_file_cnt,0);
X      fread((char *)op_codes,op_ptr,1,op_file_out);
X      op_file_cnt -= buff_size*sizeof(unsigned char);
X      g_op_ptr=op_codes+op_ptr;
X    } 
X  else g_op_ptr = op_codes + op_len_ptr;
X  get_int_stats(tag,&int_file,&int_len_ptr,&int_access_ptr,&loc_tape);
X  if (int_access_ptr)
X    { 
X      int_file_out=fopen(int_file,"r");
X      loc_ptr=int_len_ptr % buff_size;
X      fseek(int_file_out,0,2);
X      int_file_cnt =  ftell(int_file_out);
X      int_file_cnt -=loc_ptr*sizeof(locint);
X      fseek(int_file_out,int_file_cnt,0);
X      fread((char *)loc_tape,loc_ptr*sizeof(locint),1,int_file_out);
X      int_file_cnt -= buff_size*sizeof(locint);
X      g_loc_ptr=loc_tape+loc_ptr;
X    } 
X  else g_loc_ptr= loc_tape+int_len_ptr;
X  get_val_stats(tag,&val_file,&val_len_ptr,&val_access_ptr,&real_tape);
X  if (val_access_ptr)
X    { 
X      val_file_out=fopen(val_file,"r");
X      real_ptr= val_len_ptr % buff_size;
X      fseek(val_file_out,0,2);
X      val_file_cnt =  ftell(val_file_out);
X      val_file_cnt -=real_ptr*sizeof(double);
X      fseek(val_file_out,val_file_cnt,0);
X      fread((char *)real_tape,real_ptr*sizeof(double),1,val_file_out);
X      val_file_cnt -= buff_size*sizeof(double);
X      g_real_ptr= real_tape+real_ptr;
X    } 
X  else g_real_ptr=real_tape+val_len_ptr;
X}
X
X
X#define min(a,b) ( (a)>(b)? (b):(a) )
X
Xvoid init_for_sweep(int tag)
X{
X  get_op_stats(tag,&op_file,&op_len_ptr,&op_access_ptr,&op_codes);
X  if (op_access_ptr)
X    { 
X      op_file_out=fopen(op_file,"r");
X      op_ptr=min(buff_size,op_len_ptr); 
X      fread((char *)op_codes,op_ptr,1,op_file_out);
X      op_len_ptr-=op_ptr;
X    } 
X  g_op_ptr=op_codes;
X  get_int_stats(tag,&int_file,&int_len_ptr,&int_access_ptr,&loc_tape);
X  if (int_access_ptr)
X    { 
X      int_file_out=fopen(int_file,"r");
X      loc_ptr=min(buff_size,int_len_ptr);
X      fread((locint *)loc_tape,sizeof(locint),loc_ptr,int_file_out);
X      int_len_ptr-=loc_ptr;
X    } 
X  g_loc_ptr=loc_tape+22; 
X  /* loc_tape = (loc_tape+loc_ptr); */
X  get_val_stats(tag,&val_file,&val_len_ptr,&val_access_ptr,&real_tape);
X  if (val_access_ptr)
X    { 
X      val_file_out=fopen(val_file,"r");
X      real_ptr= min(val_len_ptr,buff_size);
X      fread((char *)real_tape,real_ptr*sizeof(double),1,val_file_out);
X      val_len_ptr-=real_ptr;
X    } 
X  g_real_ptr=real_tape;
X}
Xvoid get_op_block_f()
X{
X  op_ptr=min(buff_size,op_len_ptr); 
X  fread((char *)op_codes,op_ptr,1,op_file_out);
X  op_len_ptr-=op_ptr;
X  g_op_ptr=op_codes;
X}
X
Xvoid get_loc_block_f()
X{
X  loc_ptr=min(buff_size,int_len_ptr);
X  fread((char *)loc_tape,loc_ptr*sizeof(locint),1,int_file_out);
X  int_len_ptr-=loc_ptr;
X  g_loc_ptr=loc_tape;
X}
X
Xvoid get_val_block_f()
X{
X  real_ptr= min(val_len_ptr,buff_size);
X  fread((char *)real_tape,real_ptr*sizeof(double),1,val_file_out);
X  val_len_ptr-=real_ptr;
X  g_real_ptr=real_tape;
X  g_loc_ptr++; /* get_locint_f(); value used in reverse only */
X}
X    
Xvoid get_op_block_r()
X{
X  fseek(op_file_out,op_file_cnt,0);
X  fread((char *)op_codes,buff_size,1,op_file_out);
X  op_file_cnt -= buff_size*sizeof(unsigned char);
X  g_op_ptr=op_codes+buff_size;
X}
X
Xvoid get_loc_block_r()
X{
X  fseek(int_file_out,int_file_cnt,0);
X  fread((char *)loc_tape,buff_size*sizeof(locint),1,int_file_out);
X  int_file_cnt -= buff_size*sizeof(locint);
X  g_loc_ptr=loc_tape+buff_size-loc_tape[buff_size-1];
X}
Xvoid get_val_block_r()
X{
X  locint temp;
X  fseek(val_file_out,val_file_cnt,0);
X  fread((char *)real_tape,buff_size*sizeof(double),1,val_file_out);
X  val_file_cnt -= buff_size*sizeof(double);
X  temp=*(--g_loc_ptr);   /*get_locint_r();*/ 
X  g_real_ptr=real_tape+buff_size-temp;
X}
X
Xvoid put_to_op(unsigned char op)
X{
X  if (op_ptr == buff_size-1){
X    op_codes[op_ptr]=end_of_op;
X    put_op_block(buff_size);
X    op_codes[op_ptr++]=end_of_op;
X  }
X  op_codes[op_ptr++]=op;
X}
Xvoid put_locint(locint);
X
Xvoid put_op(unsigned char op)
X{
X  if (loc_ptr > buff_size-5) 
X    {
X      loc_tape[buff_size-1]=buff_size-loc_ptr;
X      put_locint_block(buff_size);
X      put_to_op(end_of_int);
X    }
X  if (real_ptr > buff_size-5) 
X    {
X      put_locint(buff_size-real_ptr);
X      put_val_block(buff_size);
X      put_to_op(end_of_val);
X    }
X  put_to_op(op);
X}
X
X
X
X
Xvoid put_val(double r_val)
X{
X  /* if (real_ptr == buff_size) put_val_block(buff_size); */
X  real_tape[real_ptr++]=r_val;
X}
X
Xvoid put_vals_p(double *r_val,int size)
X{
X  int j;
X  for (j=0;j<size;j++)
X    {
X      real_tape[real_ptr++]=r_val[j];
X    }
X  put_locint(buff_size-real_ptr);
X  put_val_block(buff_size);
X  put_to_op(end_of_val);
X}
X
Xvoid put_vals_r(double *r_val,int size)
X{
X  int j;
X  for (j=0;j<size;j++)
X    {
X      real_tape[real_ptr++]=r_val[j];
X    }
X}
X
Xint get_val_space()
X{
X  if ((buff_size-real_ptr-5)<0) {
X    put_locint(buff_size-real_ptr);
X    put_val_block(buff_size);
X    put_to_op(end_of_val);
X  } /* endif */
X  return (buff_size-real_ptr-5);
X}
X
X
X
Xdouble *get_val_v_r(locint size)
X{
X  g_real_ptr -= size;
X  return(g_real_ptr);
X}
Xdouble *get_val_v_f(locint size)
X{
X  double *temp = g_real_ptr;
X  g_real_ptr += size;
X  return (temp);
X}
Xvoid reset_val_r()
X{
X  if (g_real_ptr == real_tape)
X    {
X      get_val_block_r();
X    }
X}
X
Xvoid put_locint(locint loc1)
X{
X  /*if (loc_ptr == buff_size) put_locint_block(buff_size); */
X  loc_tape[loc_ptr++]=loc1;
X}
X
X#ifdef DEBUG
Xunsigned char get_op_f()
X{
X  unsigned char temp;
X  temp= *g_op_ptr++;
X  printf("f_op: %i\n",temp-'\0');
X  return temp;
X}
X#endif
X
X#ifdef __cplusplus
X}
X#endif
END_OF_FILE
if test 13458 -ne `wc -c <'taputil2.c'`; then
    echo shar: \"'taputil2.c'\" unpacked with wrong size!
fi
chmod +x 'taputil2.c'
# end of 'taputil2.c'
fi
if test -f 'taputil2.h' -a "${1}" != "-c" ; then 
  echo shar: Will not clobber existing file \"'taputil2.h'\"
else
echo shar: Extracting \"'taputil2.h'\" \(1813 characters\)
sed "s/^X//" >'taputil2.h' <<'END_OF_FILE'
X/*
X -------------------------------------------------------------------------
X File taputil2.h of ADOL-C version 1.6 as of January 1,   1995          
X Included in ---->
X                  fos_reverse.c
X                  fov_reverse.c 
X                  hos_forward.c
X                  hos_reverse.c
X                  hov_reverse.c
X		  taputil1.c
X                  taputil3.c
X
X
X ------------------------------------------------------------------------- 
X
X taputil2.h contains the prototypes for the functions (and macros) 
X defined in taputil2.c.  The functions and macros provide
X get and put like operation access to the tape.
X
X*/
Xextern void set_buf_size(int);
Xextern void set_buffers(char*,unsigned char*,char*, locint*,char*, double *);
Xextern void close_tape(int*, int);
Xextern void init_rev_sweep(int);
Xextern void init_for_sweep(int);
Xextern void end_sweep();
Xextern void put_op(unsigned char);
Xextern void put_val(double);
Xextern void put_vals_p(double *,int);
Xextern void put_vals_r(double *,int);
Xextern int get_val_space();
Xextern void put_locint(locint);
Xextern void get_op_block_f();
Xextern void get_loc_block_f();
Xextern void get_val_block_f();
Xextern void get_op_block_r();
Xextern void get_loc_block_r();
Xextern void get_val_block_r();
Xextern double * get_val_v_f(locint);
Xextern double * get_val_v_r(locint);
Xextern void reset_val_r();
X#ifdef DEBUG
Xextern unsigned char get_op_f();
X#endif
Xextern unsigned char *op_codes,*g_op_ptr;
Xextern locint *loc_tape,*g_loc_ptr;
Xextern double *real_tape,*g_real_ptr;
Xextern int op_ptr;
Xextern int loc_ptr;
Xextern int real_ptr;
X
X#define get_op_r() *(--g_op_ptr)
X#define get_locint_r() *(--g_loc_ptr)
X#define get_val_r() *(--g_real_ptr)
X#ifndef DEBUG
X#define get_op_f() *g_op_ptr++ 
X#endif
X#define get_locint_f() *g_loc_ptr++
X#define get_val_f() *g_real_ptr++
X
END_OF_FILE
if test 1813 -ne `wc -c <'taputil2.h'`; then
    echo shar: \"'taputil2.h'\" unpacked with wrong size!
fi
chmod +x 'taputil2.h'
# end of 'taputil2.h'
fi
if test -f 'taputil3.c' -a "${1}" != "-c" ; then 
  echo shar: Will not clobber existing file \"'taputil3.c'\"
else
echo shar: Extracting \"'taputil3.c'\" \(12170 characters\)
sed "s/^X//" >'taputil3.c' <<'END_OF_FILE'
X/*
X   --------------------------------------------------------------
X   File taputil3.c of ADOL-C version 1.6 as of January 1,   1995
X   --------------------------------------------------------------
X   Provides the tape management routines tapestats, start_trace,
X   stop_trace, etc.
X*/
X
X#include <string.h>
X/* #include <malloc.h>  not always necessary */
X
X#ifdef __cplusplus
Xextern "C" {
X#endif
X
X#include "dvlparms.h" /* Developers Parameters */
X#include "usrparms.h"
X#include "oplate.h"
X#include "tayutil.h"
X#include "taputil1.h"
X#include "taputil2.h"
X
X
X/* Max number of tapes currently in use */ 
Xstatic int maxtapes = 0;
X
X/* File Names */
Xstatic char op_file[20];
Xstatic char int_file[20];
Xstatic char val_file[20];
X
X/* Arrays of pointers to the various tape buffers */
Xstatic unsigned char **op_tape;
Xstatic locint **int_tape;
Xstatic double **val_tape;
X
X/* Array of pointers to the stats arrays (of size 11) */
Xstatic int **stats;
X
X
Xvoid fail (int error)
X{
X  switch (error)
X  {
X  case -1:
X    printf("ADOL-C error: Malloc of memory failed!");
X    exit (0);
X  }
X}
X
X/* 
X   int2asc converts the integer num to a string, places it
X   in the array string, and returns the pointer to the 
X   string.  (I now that this is rather redundant, but I
X   didn't write the original code for this.-- DWJ ;-)                         
X*/
Xchar* int2asc(int num, char string[])
X{
X  sprintf(string,"%d",num);
X  return(string);
X}
X
X
X/********************************************************************/
X/* The subroutine get_fstr appends to the filename FNAME            */
X/* (found in usrparms.h) the number fnum, and puts the resulting    */
X/* string in fstr.                                                  */
X/********************************************************************/ 
Xvoid  get_fstr (char *fstr,short fnum)
X
X/**** 
X  The caller of this function is responsible for allocating the appropriate 
X  amount of storage for fstr [strlen(FNAME)+1 <= strlen(fstr) 
X                                              <= strlen(FNAME)+5] 
X****/
X{
X  char tstr[10];
X
X  if (fnum)
X  {
X    strcpy (fstr,FNAME);
X    int2asc (fnum,tstr);
X    strcat (fstr,tstr);
X  }
X  else
X  {
X    strcpy (fstr,FNAME);
X    fstr[strlen(fstr)-1] = '\0';
X  }
X
X}
X/********************************************************************/
X/* The subroutine get_fstr appends to the filename FNAME            */
X/* (found in usrparms.h) the number fnum, and puts the resulting    */
X/* string in fstr.                                                  */
X/********************************************************************/ 
Xvoid  get_fstr1 (char *fstr,short fnum)
X
X/**** 
X  The caller of this function is responsible for allocating the appropriate 
X  amount of storage for fstr [strlen(FNAME)+1 <= strlen(fstr) 
X                                              <= strlen(FNAME)+5] 
X****/
X{
X  char tstr[10];
X
X  if (fnum)
X  {
X    strcpy (fstr,FNAME1);
X    int2asc (fnum,tstr);
X    strcat (fstr,tstr);
X  }
X  else
X  {
X    strcpy (fstr,FNAME1);
X    fstr[strlen(fstr)-1] = '\0';
X  }
X
X}
X/********************************************************************/
X/* The subroutine get_fstr appends to the filename FNAME            */
X/* (found in usrparms.h) the number fnum, and puts the resulting    */
X/* string in fstr.                                                  */
X/********************************************************************/ 
Xvoid  get_fstr2 (char *fstr,short fnum)
X
X/**** 
X  The caller of this function is responsible for allocating the appropriate 
X  amount of storage for fstr [strlen(FNAME)+1 <= strlen(fstr) 
X                                              <= strlen(FNAME)+5] 
X****/
X{
X  char tstr[10];
X
X  if (fnum)
X  {
X    strcpy (fstr,FNAME2);
X    int2asc (fnum,tstr);
X    strcat (fstr,tstr);
X  }
X  else
X  {
X    strcpy (fstr,FNAME2);
X    fstr[strlen(fstr)-1] = '\0';
X  }
X
X}
Xvoid get_op_stats(int tag, char **ret_op_file, int *ret_op_len, 
Xint *ret_op_access,unsigned char **ret_op_tape)
X{
X  get_fstr(op_file,tag);
X  *ret_op_file = op_file;
X  *ret_op_len = stats[tag][5];
X  *ret_op_access = stats[tag][6];
X  *ret_op_tape = op_tape[tag];
X
X}
Xvoid get_int_stats(int tag, char **ret_int_file, int *ret_int_len, 
Xint *ret_int_access,locint **ret_int_tape)
X{
X  get_fstr1(int_file,tag);
X  *ret_int_file = int_file;
X  *ret_int_len = stats[tag][7];
X  *ret_int_access = stats[tag][8];
X  *ret_int_tape = int_tape[tag];
X
X}
Xvoid get_val_stats(int tag, char **ret_val_file, int *ret_val_len, 
Xint *ret_val_access,double **ret_val_tape)
X{
X  get_fstr2(val_file,tag);
X  *ret_val_file = val_file;
X  *ret_val_len = stats[tag][9];
X  *ret_val_access = stats[tag][10];
X  *ret_val_tape = val_tape[tag];
X}
X
Xstatic int tag;
X
Xstatic void init_stat_space(short tnum)
X{
X  unsigned char **t1;          /* t1,t2,t3 and t4 are temporaries */
X  double **t2;
X  locint **t3;
X  int **t4;
X  int jj,
X
X  tag = tnum;
X  /* Set up space for */ 
X  if (maxtapes==0) /*this is only done at first call to start_trace or
X                     init_stat_space */
X    {
X      maxtapes = 10;
X      if ((op_tape = (unsigned char **)malloc(maxtapes*sizeof(unsigned char*)))==0) 
X	fail(-1);
X      if ((int_tape = (locint **)malloc(maxtapes*sizeof(locint *)))==0)
X	fail(-1);
X      if ((val_tape = (double **)malloc(maxtapes*sizeof(double *)))==0)
X	fail(-1);
X      
X      if ((stats = (int**)malloc(maxtapes*sizeof(int*)))==0)
X	fail(-1);
X      for(jj=0;jj<maxtapes;jj++)
X	{
X	  op_tape[jj]=0;
X	  int_tape[jj] = 0;
X	  val_tape[jj]= 0;
X	  stats[jj] = 0;
X	}
X    }
X  
X  if (tag>=maxtapes)
X    {
X      t1=op_tape;
X      t3=int_tape;
X      t2=val_tape;
X      t4 = stats;
X      if ((op_tape =(unsigned char**)malloc(2*tag*sizeof(unsigned char*)))==0) 
X	fail(-1);
X      if ((int_tape = (locint **)malloc(2*tag*sizeof(locint *)))==0)
X	fail(-1);
X      if ((val_tape = (double **)malloc(2*tag*sizeof(double *)))==0)
X	fail(-1);
X      if ((stats = (int**)malloc(tag*2*sizeof(int*)))==0)
X	fail(-1);
X      
X      for (jj=0;jj<maxtapes;jj++)
X	{
X	  op_tape[jj]=t1[jj];
X	  int_tape[jj]=t3[jj];
X	  val_tape[jj]=t2[jj];
X	  stats[jj]=t4[jj];
X	}
X      free((char *)t1);free((char *)t2);free((char *)t3);free((char *)t4);
X
X      for(jj=maxtapes;jj<2*tag;jj++)
X	{
X	  op_tape[jj]=0;
X	  int_tape[jj]=0;
X	  val_tape[jj] = 0;
X	  stats[jj] = 0;
X	}
X      maxtapes = 2*tag;
X    }
X}
X
Xstatic void set_up_buffers(short tag, int buffer_size)
X{
X  /* Return old memory ... if used */
X  if(op_tape[tag]) free((char*)op_tape[tag]);
X  if(int_tape[tag]) free((char*)int_tape[tag]);
X  if(val_tape[tag]) free((char*)val_tape[tag]);
X  if(stats[tag]) free((char*)stats[tag]);
X  
X  op_tape[tag] = (unsigned char *)malloc(buffer_size*sizeof(unsigned char));
X  int_tape[tag]= (locint *)malloc(buffer_size*sizeof(locint));
X  val_tape[tag]= (double *)malloc(buffer_size*sizeof(double));
X  stats[tag] = (int*)malloc(11*sizeof(int));
X}
X
Xstatic void read_tape_stats(short tag, int *stats)
X{
X  char int_file[20];
X
X  FILE *int_file_in;
X
X  get_fstr1(int_file,tag);
X  
X  if ((int_file_in = fopen(int_file,"r"))==0) 
X    {
X      printf("ADOL-C error: Error reading integer tape number %d \n",tag);
X      printf("Fopen returned error number %d \n",tag);
X      exit(-1);
X    }
X  if (fread((char *)stats,11*sizeof(int),1,int_file_in)!= 1)
X    {
X      printf("ADOL-C error: Error reading integer tape number %d \n",tag);
X      printf("Fread returned error number %d \n",tag);
X      exit(-1);
X    }
X  fclose(int_file_in);
X}
X
X/*-------------------------------------------------------------------------*/
X/* Tapestats:                                                              */
X/* Returns statistics on the tape tag.  The array tape_stat is assumed to  */
X/* contain at least 11 elements.  The elements of the array are the        */
X/* following.                                                              */
X/* tape_stat[0] = # of independent variables.                              */
X/* tape_stat[1] = # of dependent variables.                                */
X/* tape_stat[2] = max # of live variables.                                 */
X/* tape_stat[3] = # of death notices.                                      */
X/* tape_stat[4] = buffer size (# of chars, # of doubles, # of locints)     */
X/* tape_stat[5] = # of operations.                                         */ 
X/* tape_stat[6] = operation file access flag (1 = file in use, 0 otherwise)*/
X/* tape_stat[7] = # of saved locations.                                    */ 
X/* tape_stat[8] = location file access flag (1 = file in use, 0 otherwise) */
X/* tape_stat[9] = # of saved constant values.                              */ 
X/* tape_stat[10]= value file access flag (1 = file in use, 0 otherwise)    */
X/*                                                                         */
X/*-------------------------------------------------------------------------*/
X
Xvoid tapestats(short tag,int *tape_stat)
X{ 
X  int i;
X
X  /* Make sure that there is tape access */
X  init_stat_space(tag);
X
X  if(stats[tag] == 0) 
X     { 
X       /* Tape number does not exist , so read in tape data */
X
X       read_tape_stats(tag,tape_stat);
X
X       set_up_buffers(tag,tape_stat[4]);
X
X       /* Copy data to stats for future use */
X
X       for (i = 0;i <11;i++)
X	 {
X	   stats[tag][i]= tape_stat[i];
X	 }
X     }
X  else
X    {
X      for (i=0; i<11;i++)
X	{
X	  tape_stat[i] = stats[tag][i];
X	}
X    }
X}
X
X
X  
X/***************************************************************************/
X/* start_trace: (part of trace_on)                                         */
X/* Initialization for the taping process.  Sets up the arrays op_tape,     */
X/* int_tape, val_tape, and stats.  Op_tape, int_tape, val_tape are arrays  */
X/* of pointers to individual buffers for operations, integers (locints),   */
X/* and values (doubles).  Also initializes buffers for this tape, sets     */
X/* files names, and calls appropriate setup routines.                      */
X/***************************************************************************/
X
Xvoid start_trace(short tnum,int revals)
X{
X  int revalso;
X  int kk;
X
X  double** dum = 0;
X  int degree = 0;
X  
X  revalso = revals;
X  tag = tnum;
X  
X  /* Set buffer size to be the default in usrparms.h */
X  set_buf_size(bufsize);
X
X  get_fstr(op_file,tag);
X  get_fstr1(int_file,tag);
X  get_fstr2(val_file,tag);
X  
X  init_stat_space(tag);
X
X  /* Return old memory ... if used */
X  if(op_tape[tag]) free((char*)op_tape[tag]);
X  if(int_tape[tag]) free((char*)int_tape[tag]);
X  if(val_tape[tag]) free((char*)val_tape[tag]);
X  if(stats[tag]) free((char*)stats[tag]);
X  
X  op_tape[tag] = (unsigned char *)malloc(bufsize*sizeof(unsigned char));
X  int_tape[tag]= (locint *)malloc(bufsize*sizeof(locint));
X  val_tape[tag]= (double *)malloc(bufsize*sizeof(double));
X  stats[tag] = (int*)malloc(11*sizeof(int));
X  
X  
X  clear_stats(revalso);
X  
X  /* Initialize Tapes */
X  set_buffers(op_file,op_tape[tag],
X	      int_file,int_tape[tag],
X	      val_file,val_tape[tag]);
X  
X  
X  /* Put operation denoting the start_of_the tape */ 
X  put_op(start_of_tape);
X  /* Leave space for the stats */
X  for (kk=0;kk<22;kk++)
X    put_locint(0);
X  
X  
X  if (revalso) taylor_begin(bufsize,dum,degree);
X}
X
X
X/*************************************************************************/
X/* Stop Tracing.  Clean up, and turn off trace_flag.                    **/
X/*************************************************************************/
Xvoid stop_trace(int locations, int flag)
X{
X  int tape_stats[11];
X  int i,sizer;
X
X  int loc_ptr,dep_ptr,ind_ptr,death_ptr,revalso;
X  /* int op_cnt,loc_cnt,val_cnt,access_ptr; */
X
X  loc_ptr = locations;     
X  put_op(end_of_tape);        /* Mark end of tape. */
X
X  get_write_stats(&dep_ptr,&ind_ptr,&death_ptr,&revalso);
X  tape_stats[0]=ind_ptr;
X  tape_stats[1]=dep_ptr;
X  tape_stats[2]=loc_ptr;
X  tape_stats[3]=death_ptr;
X  tape_stats[4]=bufsize;
X  close_tape(tape_stats,flag); /** closes the tape, files up stats, and
X                                   writes the tape stats to the integer
X                                   tape. **/
X  
X  sizer = sizeof(revreal)*(death_ptr);
X  if (revalso) taylor_close(sizer/(1+sizer/bufsize),dep_ptr,ind_ptr);
X  for (i=0;i<11;i++)
X    {
X      stats[tag][i]=tape_stats[i];
X    }
X}
X
X#ifdef __cplusplus
X}
X#endif
X
END_OF_FILE
if test 12170 -ne `wc -c <'taputil3.c'`; then
    echo shar: \"'taputil3.c'\" unpacked with wrong size!
fi
chmod +x 'taputil3.c'
# end of 'taputil3.c'
fi
if test -f 'taputil3.h' -a "${1}" != "-c" ; then 
  echo shar: Will not clobber existing file \"'taputil3.h'\"
else
echo shar: Extracting \"'taputil3.h'\" \(995 characters\)
sed "s/^X//" >'taputil3.h' <<'END_OF_FILE'
X/*
X -------------------------------------------------------------------------
X File taputil3.h of ADOL-C version 1.6 as of January 1,   1995          
X Included in ---->
X                  fos_reverse.c
X                  fov_reverse.c 
X                  hos_forward.c
X                  hos_reverse.c
X                  hov_reverse.c
X		  taputil2.c
X                  utils.c
X
X
X ------------------------------------------------------------------------- 
X
X taputil3.h contains the prototypes for the functions 
X defined in taputil3.c.  The functions provide
X initialization and stopage of the taping process, as well as
X statistics gathering functions.
X
X*/
X
X/* Stats functions */
X
Xextern void get_op_stats(int,char **,int *,int *,unsigned char **);
Xextern void get_int_stats(int,char **,int *,int *,locint **);
Xextern void get_val_stats(int,char **,int *,int *,double **);
Xextern void tapestats(short,int *);
X
X/* Tracing */
X
Xextern void start_trace(short,int);
Xextern void stop_trace(int,int);
X
X
X
X
X
X
END_OF_FILE
if test 995 -ne `wc -c <'taputil3.h'`; then
    echo shar: \"'taputil3.h'\" unpacked with wrong size!
fi
chmod +x 'taputil3.h'
# end of 'taputil3.h'
fi
if test -f 'tayutil.c' -a "${1}" != "-c" ; then 
  echo shar: Will not clobber existing file \"'tayutil.c'\"
else
echo shar: Extracting \"'tayutil.c'\" \(7884 characters\)
sed "s/^X//" >'tayutil.c' <<'END_OF_FILE'
X/*
X   --------------------------------------------------------------
X   File tayutil.c of ADOL-C version 1.6 as of January 1,   1995
X   --------------------------------------------------------------
X   Taylor series utilities - primarily called from the module
X   hos_forward.c (--- a forward pass generates taylor coefficients which
X   need to be saved when a variable dies, or is overwritten) and 
X   the reverse modules (-- to retrieve these taylor coefficients to calculate
X   the adjoints.
X*/
X
X#ifdef __cplusplus
Xextern "C" {
X#endif
X
X#include "dvlparms.h" /* Developers Parameters */
X
X#include "usrparms.h"
X#include "tayutil.h"
X
X
X/* Global Variables to this routine */
X
Xstatic int numdep;
Xstatic int numind;
Xstatic int T_file_access = 0;
Xstatic FILE* temp2_file=0;
Xstatic int taylor_cnt;
Xstatic revreal * save_taylor = 0;
Xstatic int T_write_cnt;
Xstatic int T_blocks, T_tail, T_buf_size, T_length; 
Xstatic double** T;
Xstatic revreal ** Tr;
Xstatic revreal * Trs;
Xstatic int degsave;
X
X
X/* Access routines */
X
X/* Has a taylor file been written? */
X
Xint taylor_access()
X{
X  return T_file_access;
X}
X
X/* Close any open taylor file. */
X
Xvoid close_taylor()
X{
X  fclose(temp2_file);
X}
X
X/******************************************************************/
X/** T_Put_Block puts a block of tape to the disk.  I assume this **/
X/** is called only during a successive forward pass,             **/
X/** computation.                                                 **/
X/******************************************************************/
Xstatic void T_put_block(int nitems)
X{
X  int n;
X  if(T_file_access == 0) temp2_file = fopen("adoltemp.xxx","w+");
X  if(T_write_cnt == 0) fseek(temp2_file,0,0); 
X  T_file_access = 1;
X  taylor_cnt=0;
X  if((n=fwrite((char *)save_taylor,sizeof(revreal)*nitems,
X          1,temp2_file))!=1) {
X  fprintf(stderr,"ADOL-C error: fatal error-doing a write %d--- error %d\n",n,errno);
X      switch (errno) {
X      case 28: /* ENOSPC */
X	fprintf(stderr,"No space left on device-contact sys. manager\n");
X	break;
X      case 27: /* EFBIG */
X	fprintf(stderr,"File to big-- Taylor-tape space exhausted.\n");
X	break;
X      default:
X	fprintf(stderr,"Unexpected error %d .\n",errno);
X	break;
X      }
X      exit(-1);
X    }
X  T_write_cnt++;
X}
X
X/*-----------------------------------------------------------------------*/
X/* Static function T_prev_block                                          */
X/* called by taylor_back, taylor_back2, get_taylor, get_taylors          */
X/* Gets the next (previous block) of size nitems                         */
X/*-----------------------------------------------------------------------*/
Xstatic int T_prev_block(int nitems)
X{
X  int n;
X#ifdef DEBUG
Xprintf("ADOL-C debug: prev %d =nitems %d T_write_cnt \n", nitems, T_write_cnt);
X#endif
X  if (T_file_access)
X    {
X      if (T_write_cnt == 0)
X	{
X	  return 0;
X	}
X      T_write_cnt--;
X      fseek(temp2_file,T_buf_size*T_write_cnt*sizeof(revreal),0);
X      n=fread((char *)save_taylor,sizeof(revreal),nitems,temp2_file);
X      if(n != nitems)
X	{ 
X	 printf("ADOL-C error: Read error on taylor file n= %d\n",n);
X	 return 0;
X	 }
X      taylor_cnt = nitems;
X      return 1;
X    }
X  return 0;
X}
X
X/*---------------------------------------------------------------------*/
X/* Write_taylor writes the block of size depth of taylor coefficients  */
X/* from point loc to the taylor buffer.  If the buffer is filled, then */
X/* it is written to the taylor tape (T_put_block).                     */
X/*---------------------------------------------------------------------*/
Xvoid write_taylor(locint loc,int depth)
X{
X  int i;
X  double* Tloc = T[loc];
X  for (i=0;i<depth;i++)
X    {
X      save_taylor[taylor_cnt++]=Tloc[i];  /* In this assignment the */
X
X      if (taylor_cnt == T_buf_size) /* precision will be sacrificed if the */
X	{                           /* type revreal is defined as float.   */
X          T_put_block(T_buf_size);
X	}
X    }
X}
X
X/*-------------------------------------------------------------------------*/
X/* Write_scaylor writes a single element (x) to the taylor buffer.  If full*/
X/* the buffer is written out.                                              */
X/*-------------------------------------------------------------------------*/
Xvoid write_scaylor(revreal x)
X{
X  save_taylor[taylor_cnt++]= x;
X  if(taylor_cnt == T_buf_size) T_put_block(T_buf_size);
X}
X
X
X/*-------------------------------------------------------------------------*/
X/* Write_scaylors writes # size elements from x to the taylor buffer.      */
X/* If full, the buffer is written out.                                     */
X/*-------------------------------------------------------------------------*/
Xvoid write_scaylors(revreal *x, int size)
X{ 
X  int i;
X  for(i=0; i<size; i++)
X    {
X      save_taylor[taylor_cnt++]= x[i];
X      if(taylor_cnt == T_buf_size) T_put_block(T_buf_size);
X    }
X}
X
X/* Close the taylor file, reset data. */
X
Xvoid taylor_close(int buffer,int dep,int ind)
X{
X  int n;
X
X  numdep = dep;
X  numind = ind;
X  T_tail = taylor_cnt;
X  T_length = T_buf_size*T_write_cnt+taylor_cnt;
X  if (T_write_cnt)
X     {
X     if(T_tail>0 ) T_put_block(T_tail);
X     free((char *)save_taylor);
X     save_taylor =0;
X     }
X  T_blocks = T_write_cnt;
X  if ((T_blocks) && (T_length*sizeof(revreal) <= buffer))
X    { 
X      save_taylor = (revreal *) malloc(T_length*sizeof(revreal));
X      fseek(temp2_file,0,0);
X      n=fread((char *)save_taylor,sizeof(revreal),T_length,temp2_file);
X      if ( n != T_length)
X	{
X	  printf("ADOL-C error: read error in taylor_close n= %d\n",n);
X	  exit(-2);
X	}
X      T_tail = T_length;
X      T_blocks = 0;
X    }
X#ifdef DEBUG
X  if(T_blocks)
X    printf("\n ADOL-C debug: taylor file of length %d bytes completed\n", T_length*sizeof(revreal));
X  else
X    printf("\n ADOL-C debug: taylor array of length %d bytes completed\n", T_length*sizeof(revreal));
X#endif
X}
X
X/* Set up statics for writing taylor data */
X 
Xvoid taylor_begin(int buffer,double** Tg,int degree)
X{ 
X  T = Tg;
X  if(save_taylor) free((char *)save_taylor);
X  T_buf_size = 1+buffer/sizeof(revreal);
X  save_taylor = (revreal *)malloc(sizeof(revreal)*T_buf_size);
X  T_write_cnt = 0;
X  T_length = 0;
X  taylor_cnt = 0; 
X  degsave = degree;
X}
X
X
Xvoid taylor_back2(revreal** Trg,int* dep,int* ind,int* degree)
X{
X  *dep = numdep;
X  *ind = numind;
X  *degree = degsave;
X  Tr = Trg;
X  T_write_cnt = T_blocks;
X  taylor_cnt = T_tail;
X  if (T_blocks == 0 && save_taylor == 0 )
X  { 
X    printf("ADOL-C error: no temp file or array for reverse sweep \n");
X    exit(-2);
X   }
X  if(T_blocks)
X     {
X       if(save_taylor) free((char*) save_taylor);
X       save_taylor = (revreal*) malloc(T_buf_size*sizeof(revreal));
X       if(T_prev_block(T_tail) == 0) printf("ADOL-C error: problems in back \n");
X     }
X}
X
Xvoid taylor_back(revreal* Trg,int* dep,int* ind,int* degree)
X{
X  *dep = numdep;
X  *ind = numind;
X  *degree = degsave;
X  Trs = Trg;
X  T_write_cnt = T_blocks;
X  taylor_cnt = T_tail;
X  if (T_blocks == 0 && save_taylor == 0 )
X  { 
X    printf("ADOL-C error: no temp file or array for reverse sweep \n");
X    exit(-2);
X   }
X  if(T_blocks)
X     {
X       if(save_taylor) free((char*) save_taylor);
X       save_taylor = (revreal*) malloc(T_buf_size*sizeof(revreal));
X       if(T_prev_block(T_tail) == 0) printf("ADOL-C error: problems in back \n");
X     }
X}
X
Xvoid get_taylors(locint loc,int depth)
X{
X  int i;
X  revreal* Trloc = Tr[loc];
X  for (i = depth-1;i >= 0;i--)
X    {
X      if (taylor_cnt ==0)
X	{
X	  if (!T_prev_block(T_buf_size))
X	    {
X	      fprintf(stderr,"ADOL-C error: Fatal Error in get_taylor ");
X	      exit(-1);
X	    }
X	}
X      Trloc[i] = save_taylor[--taylor_cnt];
X    }
X}
X
Xvoid get_taylor(locint loc)
X{
X  if (taylor_cnt ==0)
X    {
X      if (!T_prev_block(T_buf_size))
X	{
X	  fprintf(stderr,"ADOL-C error: Fatal Error in get_taylor ");
X	  exit(-1);
X	}
X    }
X  Trs[loc] = save_taylor[--taylor_cnt];
X}
X
X
X#ifdef __cplusplus
X}
X#endif
X
END_OF_FILE
if test 7884 -ne `wc -c <'tayutil.c'`; then
    echo shar: \"'tayutil.c'\" unpacked with wrong size!
fi
chmod +x 'tayutil.c'
# end of 'tayutil.c'
fi
if test -f 'tayutil.h' -a "${1}" != "-c" ; then 
  echo shar: Will not clobber existing file \"'tayutil.h'\"
else
echo shar: Extracting \"'tayutil.h'\" \(1058 characters\)
sed "s/^X//" >'tayutil.h' <<'END_OF_FILE'
X/*
X  --------------------------------------------------------------------
X  file tayutil.h of ADOL-C version 1.6 as of January 1,   1995
X  Included in -->
X                 fos_reverse.c
X                 fov_reverse.c
X                 hos_forward.c
X                 hos_reverse.c
X                 hov_reverse.c
X                 taputil1.c
X                 taputil3.c
X                 tayutil.c
X                 utils.c
X   
X   -------------------------------------------------------------------
X   tayutil.h defines the prototypes for the functions from 
X   tayutil.c.  See tayutil.c for an explanation of the functionality 
X   of these routines.
X
X*/
X
X#ifndef __STDC__
X   int unlink(char *); 
X#endif
Xint taylor_access();
Xvoid close_taylor();
Xvoid taylor_begin(int, double**,int);
Xvoid taylor_close(int,int,int);
Xvoid write_taylor(locint, int);
Xvoid get_taylor(locint);
Xvoid get_taylors(locint, int);
Xvoid write_scaylor(revreal);
Xvoid write_scaylors(revreal*,int);
Xvoid taylor_back(revreal*, int*, int*, int*);
Xvoid taylor_back2(revreal**, int*, int*, int*);
X
X
END_OF_FILE
if test 1058 -ne `wc -c <'tayutil.h'`; then
    echo shar: \"'tayutil.h'\" unpacked with wrong size!
fi
chmod +x 'tayutil.h'
# end of 'tayutil.h'
fi
if test -f 'usrparms.h' -a "${1}" != "-c" ; then 
  echo shar: Will not clobber existing file \"'usrparms.h'\"
else
echo shar: Extracting \"'usrparms.h'\" \(1324 characters\)
sed "s/^X//" >'usrparms.h' <<'END_OF_FILE'
X/*
X -------------------------------------------------------------------------
X File usrparms.h of ADOL-C version 1.6 as of January 1,   1995          
X Included in ---->
X                  fos_reverse.c
X                  fov_reverse.c 
X                  hos_forward.c
X                  hos_reverse.c
X                  hov_reverse.c
X		  taputil1.c
X                  taputil2.c
X                  taputil3.c
X                  tayutil.c
X		  utils.c
X
X
X ------------------------------------------------------------------------- 
X
X Usrparms.h contains the parameters which might affect 
X the performance of the ADOL-C system.  Intended to be tweeked by
X users and local maintainence personal.
X                       
X*/
X
X
X#define bufsize	    65536 /*16384 or  524288  */
X#define locint      unsigned short   
X#define revreal     double
X#define inf_num     1.0  /* don't undefine these;  on non-IEEE machines */
X#define inf_den     0.0  /* change the values to get small fractions    */
X#define non_num     0.0  /* (inf_num/inf_den) and (non_num/non_den)     */
X#define non_den     0.0  /* respectively, see the documentation         */
X/* #define DEBUG       DEBUG  */
X#define store       dontusethisuglymessplease 
X#define FNAME2       "_adol-rl_tape."
X#define FNAME1       "_adol-in_tape."
X#define FNAME        "_adol-op_tape."
X
X
END_OF_FILE
if test 1324 -ne `wc -c <'usrparms.h'`; then
    echo shar: \"'usrparms.h'\" unpacked with wrong size!
fi
chmod +x 'usrparms.h'
# end of 'usrparms.h'
fi
if test -f 'utils.c' -a "${1}" != "-c" ; then 
  echo shar: Will not clobber existing file \"'utils.c'\"
else
echo shar: Extracting \"'utils.c'\" \(2917 characters\)
sed "s/^X//" >'utils.c' <<'END_OF_FILE'
X/*
X   --------------------------------------------------------------
X   File utils.c of ADOL-C version 1.6 as of January 1,   1995
X   --------------------------------------------------------------
X   Contains the definitions of trace_on/ trace_off and the 
X   class clean_up.  The class clean_up makes sure the once the
X   program leaves, any temporary taylor file is deleted.
X   Note that this file must be compiled with C++.
X*/
X
X
X/* Basic Includes */
X
X#include "dvlparms.h"
X#include <stdio.h>
X#include <stream.h>
X#include "usrparms.h"
X
X/* External routines from Adouble.c */
X
Xextern locint keep_stock();
Xextern void take_stock();   
X
Xextern "C" {
X#include "tayutil.h"
X#include "taputil3.h"
X}
X
X/***********************************************************************/
X/* Added class clean-up, so that when the program leaves, it will clean*/
X/* up the temporary file.                                              */
X/***********************************************************************/
X
Xclass cleanup{
X    int valid;
Xpublic:
X    cleanup();
X    ~cleanup();
X};
Xcleanup::cleanup()
X{
X  valid = 0;
X}
Xcleanup::~cleanup()
X{
X      if (taylor_access())
X	{
X	  close_taylor();
X          remove("adoltemp.xxx");     /*     Complies with ANSI standard */ 
X      /*     unlink("adoltemp.xxx");   works on some UNIX systems */ 
X	}
X}
X
Xstatic cleanup at_end;
X
X/***************************************************************************/
X/* Trace_on:                                                               */
X/* Initialization for the taping process.  Sets up the arrays op_tape,     */
X/* int_tape, val_tape, and stats.  Op_tape, int_tape, val_tape are arrays  */
X/* of pointers to individual buffers for operations, integers (locints),   */
X/* and values (doubles).  Also initializes buffers for this tape, sets     */
X/* files names, and calls appropriate setup routines.                      */
X/***************************************************************************/
X
Xvoid trace_on(short tnum,int& revals)
X{
X  start_trace(tnum,revals);
X  take_stock();   /* record all existing adoubles on the tape */
X}
X
Xvoid trace_on(short tag)
X{ 
X  int dum = 0; 
X  trace_on(tag,dum);
X} 
X
X/*************************************************************************/
X/* Stop Tracing.  Clean up, and turn off trace_flag.                    **/
X/*************************************************************************/
Xvoid trace_off(int flag)
X{
X  int locations;
X  locations = keep_stock();     /* copy remaining live variables and turns */
X                                /* off trace_flag  */
X  stop_trace(locations,flag);   
X  cout.flush();
X}
X
X
X/************************************************************************/
X/* Trace_off() is essentially trace_off(0).                             */
X/************************************************************************/
Xvoid trace_off()
X{
X  int lofl = 0;
X  trace_off(lofl);
X}
X
END_OF_FILE
if test 2917 -ne `wc -c <'utils.c'`; then
    echo shar: \"'utils.c'\" unpacked with wrong size!
fi
chmod +x 'utils.c'
# end of 'utils.c'
fi
echo shar: End of shell archive.
exit 0