TAP_support/ADFirstAidKit/adDebugMPI.c

b4daa24319 Shre*0001 /*
                0002  * TAPENADE Automatic Differentiation Engine
                0003  * Copyright (C) 1999-2021 Inria
                0004  * See the LICENSE.md file in the project root for more information.
                0005  *
                0006  */
                0007
                0008 #include <string.h>
                0009 #include <stdio.h>
                0010 #include <stdlib.h>
                0011 #include <sys/types.h>
                0012 #include <sys/stat.h>
                0013 #include <errno.h>
                0014 #include <math.h>
                0015 #include "adDebug.h"
                0016
                0017 /* Special for the non-regression tests on AMPI */
                0018 #include <mpi.h>
                0019
                0020 extern void pushNArray(char *x, unsigned int nbChars, int checkReadOnly) ;
                0021 extern void popNArray(char *x, unsigned int nbChars, int checkReadOnly) ;
                0022 extern void pushCharacterArray(char *x, int n) ;
                0023 extern void popCharacterArray(char *x, int n) ;
                0024
                0025 /* The "call stack" used by debugging to
                0026  * keep track of the position in the call tree */
                0027 typedef struct _DBAD_CallStackElem {
                0028   char *funcname ;
                0029   int   deltadepth ;
                0030   int   code ;
                0031   struct _DBAD_CallStackElem *context ;
                0032 } DBAD_CallStackElem ;
                0033
                0034 static DBAD_CallStackElem dbad_topContext ;
                0035 static DBAD_CallStackElem *dbad_callStack ;
                0036 static int dbad_calltracedepth = 1 ;
                0037
                0038 static int dbad_mode, dbad_phase, dbad_nberrors ;
                0039 static int dbad_trace = 0 ;
                0040 static int dbad_nocommunication = 0 ;
                0041 /** The rank of the current process (from 0 up), if it is being tested.
                0042  * -2 means don't test the current process
                0043  * -1 means test this process (not-MPI case) but don't print process number! */
                0044 static int dbad_testThisProcess = -1 ;
                0045 static FILE *dbad_file ;
                0046 static double dbad_errormax, dbad_ddeps = 1.e-6 ;
                0047 static double dbad_seed = 0.137 ;
                0048 static double dbad_currentSeed = 0.0 ;
                0049 static double dbad_condensed_dd, dbad_condensed_tgt, dbad_condensed_adj ;
                0050 static double dbad_refsum, dbad_nextrefsum ;
                0051
                0052 /** Buffers for stack mechanism, redefined to avoid linking with adStack.c */
                0053 static double dbad_adr8buf[512] ;
                0054 static int dbad_adr8ibuf = 0 ;
                0055 static int dbad_adi4buf[512] ;
                0056 static int dbad_adi4ibuf = 0 ;
                0057
                0058 void dbad_pushReal8(double x) {
                0059   if (dbad_adr8ibuf >= 511) {
                0060     dbad_adr8buf[511] = x ;
                0061     pushNArray((char *)dbad_adr8buf, 512*8, 1) ;
                0062     dbad_adr8ibuf = 0 ;
                0063   } else {
                0064     dbad_adr8buf[dbad_adr8ibuf] = x ;
                0065     ++dbad_adr8ibuf ;
                0066   }
                0067 }
                0068
                0069 void dbad_popReal8(double *x) {
                0070   if (dbad_adr8ibuf <= 0) {
                0071     popNArray((char *)dbad_adr8buf, 512*8, 1) ;
                0072     dbad_adr8ibuf = 511 ;
                0073     *x = dbad_adr8buf[511] ;
                0074   } else {
                0075     --dbad_adr8ibuf ;
                0076     *x = dbad_adr8buf[dbad_adr8ibuf] ;
                0077   }
                0078 }
                0079
                0080 void dbad_pushinteger4(int x)  {
                0081   if (dbad_adi4ibuf >= 511) {
                0082     dbad_adi4buf[511] = x ;
                0083     pushNArray((char *)dbad_adi4buf, 512*4, 1) ;
                0084     dbad_adi4ibuf = 0 ;
                0085   } else {
                0086     dbad_adi4buf[dbad_adi4ibuf] = x ;
                0087     ++dbad_adi4ibuf ;
                0088   }
                0089 }
                0090
                0091 void dbad_popinteger4(int *x) {
                0092   if (dbad_adi4ibuf <= 0) {
                0093     popNArray((char *)dbad_adi4buf, 512*4, 1) ;
                0094     dbad_adi4ibuf = 511 ;
                0095     *x = dbad_adi4buf[511] ;
                0096   } else {
                0097     --dbad_adi4ibuf ;
                0098     *x = dbad_adi4buf[dbad_adi4ibuf] ;
                0099   }
                0100 }
                0101 /* End redefinition of the buffers for the stack mechanism */
                0102
                0103 void dbad_pushCallFrame(char* unitname, int deltadepth, int forcetraced) {
                0104   DBAD_CallStackElem *newCallLevel = (DBAD_CallStackElem*)malloc(sizeof(DBAD_CallStackElem)) ;
                0105   newCallLevel->funcname = (char*)malloc(100) ;
                0106   sprintf(newCallLevel->funcname, "%s", unitname) ;
                0107   newCallLevel->deltadepth = (dbad_calltracedepth>0?1-deltadepth:0) ;
                0108   dbad_calltracedepth -= newCallLevel->deltadepth ;
                0109   // forcing mechanism:
                0110   if (forcetraced>0 && forcetraced>dbad_calltracedepth) {
                0111     newCallLevel->deltadepth -= (forcetraced-dbad_calltracedepth) ;
                0112     dbad_calltracedepth = forcetraced ;
                0113   }
                0114   newCallLevel->code = 0 ;
                0115   newCallLevel->context = dbad_callStack ;
                0116   dbad_callStack = newCallLevel ;
                0117 }
                0118
                0119 void dbad_popCallFrame() {
                0120   dbad_calltracedepth += dbad_callStack->deltadepth ;
                0121   DBAD_CallStackElem *newCallLevel = dbad_callStack->context ;
                0122   free(dbad_callStack->funcname) ;
                0123   free(dbad_callStack) ;
                0124   dbad_callStack = newCallLevel ;
                0125 }
                0126
                0127 int dbad_debughere(int forcetraced) {
                0128   return (dbad_calltracedepth>0 || forcetraced) ;
                0129 }
                0130
                0131 int dbad_debugabove() {
                0132   return (dbad_calltracedepth+dbad_callStack->deltadepth)>0 ;
                0133 }
                0134
                0135 int dbad_callstackdepth() {
                0136   DBAD_CallStackElem *incallstack = dbad_callStack ;
                0137   int depth = 0 ;
                0138   while (incallstack) {++depth ; incallstack=incallstack->context ;}
                0139   return depth-1 ;
                0140 }
                0141
                0142 void dbad_resetCondensors() {
                0143   dbad_currentSeed = 0.0 ;
                0144   dbad_condensed_dd = 0.0 ;
                0145   dbad_condensed_tgt = 0.0 ;
                0146   dbad_condensed_adj = 0.0 ;
                0147 }
                0148
                0149 double dbad_nextRandom() {
                0150   dbad_currentSeed += dbad_seed ;
                0151   if (dbad_currentSeed>=1.0) dbad_currentSeed-=1.0 ;
                0152   /* Return a value in range [1.0 2.0[ */
                0153   return dbad_currentSeed+1.0 ;
                0154 }
                0155
                0156 /** Scales the tangent direction *indepd (now in range [1.0 2.0[)
                0157  * so that it has same magnitude as indep */
                0158 void dbad_scaleIndepDirection4(float *indepd, float indep) {
                0159   int exponent ;
                0160   frexpf(indep, &exponent);
                0161   *indepd = ldexpf(*indepd, exponent) ;
                0162 }
                0163
                0164 /** Scales the tangent direction *indepd (now in range [1.0 2.0[)
                0165  * so that it has same magnitude as indep */
                0166 void dbad_scaleIndepDirection8(double *indepd, double indep) {
                0167   int exponent ;
                0168   frexp(indep, &exponent);
                0169   *indepd = ldexp(*indepd, exponent) ;
                0170 }
                0171
                0172 void dbad_putOneVarName(char *varname) {
                0173   char buf[8]="        " ;
                0174   int len = strlen(varname) ;
                0175   if (len>8) len = 8 ;
                0176   memcpy(buf, varname, len) ;
                0177   fwrite(buf, sizeof(char), 8, dbad_file) ;
                0178 }
                0179
                0180 void dbad_ddcheckvarname(char* varname) {
                0181   char localBuf[9]="        " ;
                0182   char remoteBuf[9]="        " ;
                0183   int len = strlen(varname) ;
                0184   if (len>8) len = 8 ;
                0185   memcpy(localBuf, varname, len) ;
                0186   fread(remoteBuf, sizeof(char), 8, dbad_file) ;
                0187   if (strcmp(localBuf, remoteBuf)!=0) {
                0188     printf("Control mismatch, expecting a variable named \"%s\", got \"%s\"\n",localBuf,remoteBuf) ;
                0189     exit(0) ;
                0190   }
                0191 }
                0192
                0193 void dbad_putOne8(double var) {
                0194   fwrite(&var, sizeof(double), 1, dbad_file) ;
                0195 }
                0196
                0197 void dbad_putOne4(float var) {
                0198   float fl2[2] ;
                0199   fl2[0] = var ;
                0200   fwrite(fl2, sizeof(float), 2, dbad_file) ;
                0201 }
                0202
                0203 void dbad_getOne8(double *var) {
                0204   fread(var, sizeof(double), 1, dbad_file) ;
                0205 }
                0206
                0207 void dbad_getOne4(float *var) {
                0208   float fl2[2] ;
                0209   fread(fl2, sizeof(float), 2, dbad_file) ;
                0210   *var = fl2[0] ;
                0211 }
                0212
                0213 /* static int nbDebugDebug = 10 ; */
                0214
                0215 int dbad_discrepancy8(double vareps, double var, double vard, double *dd, float *diff) {
                0216   int hasDifference = 0 ;
                0217   int almostZero = -15;       // Tests more strict when almostZero goes down to -Inf.
                0218   int errMaxBits = 8;         // Tests more strict when errMaxBits goes up to +Inf.
                0219   int trustableMantissa = 53; // Tests more strict when trustableMantissa goes up to 52.
                0220   *dd = 0.0 ;
                0221   //TODO: test vareps and var for NaNs!
                0222   int expoTG ;
                0223   frexp(vard, &expoTG) ;
                0224   double dv = vareps-var ;
                0225 /* printf("vard:%24.16e expoTG:%i almostZero:%i dv:%24.16e - %24.16e = %24.16e\n",vard,expoTG,almostZero,vareps,var,dv) ; */
                0226   if (dv==0.0) {
                0227     *dd = 0.0 ;
                0228     if (vard==0.0 || expoTG<almostZero) {
                0229       hasDifference = 0 ;
                0230       *diff = 0.0 ;
                0231     } else {
                0232       hasDifference = 1;
                0233       *diff = 100.0;
                0234 /* if (nbDebugDebug && hasDifference) { */
                0235 /*   nbDebugDebug-- ; */
                0236 /*   printf("vard:%24.16e (%i) %i\n", vard, expoTG, (expoTG<almostZero)) ; */
                0237 /* } */
                0238     }
                0239   } else {
                0240     *dd = dv/dbad_ddeps ;
                0241     int expoDD ;
                0242     frexpf(*dd, &expoDD) ;
                0243     double hv = dv - dbad_ddeps*vard ;
                0244 /* printf("dd:%24.16e expoDD:%i almostZero:%i dbad_ddeps:%8.1e hv:%24.16e\n",*dd,expoDD,almostZero,dbad_ddeps,hv) ; */
                0245     if (hv==0.0 || expoTG<almostZero || expoDD<almostZero) {
                0246       hasDifference = 0 ;
                0247       *diff = 0.0 ;
                0248     } else {
                0249       int expoDV, expoV1, expoV2, expoV, expoHV ;
                0250       frexp(dv, &expoDV) ;
                0251       frexp(var, &expoV1) ;
                0252       frexp(vareps, &expoV2) ;
                0253       expoV = (var==0.0?expoV2:(vareps==0?expoV1:(expoV1>expoV2?expoV1:expoV2))) ;
                0254       frexp(hv, &expoHV) ;
                0255       int discrepancySmallness = expoDV-expoHV ;
                0256       int discrepancyExactness = trustableMantissa-expoV+expoDV ;
                0257       hasDifference = (discrepancySmallness<errMaxBits && discrepancySmallness<discrepancyExactness) ;
                0258
                0259       double absvard = (vard>=0.0?vard:-vard) ;
                0260       double absdd = (*dd>=0.0?*dd:-*dd) ;
                0261       double maxabs = (absvard>absdd?absvard:absdd) ;
                0262       double absvardmdd = vard-*dd ;
                0263       if (absvardmdd<0.0) absvardmdd=-absvardmdd ;
                0264       *diff = (float)((absvardmdd/maxabs)*100.0) ;
                0265 /* if (nbDebugDebug && hasDifference) { */
                0266 /*   nbDebugDebug-- ; */
                0267 /*   printf("vard:%24.16e [v-eps:%24.16e v-loc:%24.16e (%i)] dd:%24.16e (%i) -> %i\n", */
                0268 /*          vard, vareps, var, expoV, dv, expoDV, expoHV) ; */
                0269 /*   printf("n2:%i  52-M0+M1-6:%i different:%i %5.1f\n", */
                0270 /*          discrepancySmallness, discrepancyExactness, hasDifference, *diff) ; */
                0271 /* } */
                0272     }
                0273   }
                0274   return hasDifference ;
                0275 }
                0276
                0277 int dbad_discrepancy4(float vareps, float var, float vard, float *dd, float *diff) {
                0278   int hasDifference = 0 ;
                0279   int almostZero = -15;       // Tests more strict when almostZero goes down to -Inf.
                0280   int errMaxBits = 6;         // Tests more strict when errMaxBits goes up to +Inf.
                0281   int trustableMantissa = 23; // Tests more strict when trustableMantissa goes up to 52.
                0282   *dd = 0.0 ;
                0283   //TODO: test vareps and var for NaNs!
                0284   int expoTG ;
                0285   frexpf(vard, &expoTG) ;
                0286   float dv = vareps-var ;
                0287   if (dv==0.0) {
                0288     *dd = 0.0 ;
                0289     if (vard==0.0 || expoTG<almostZero) {
                0290       hasDifference = 0 ;
                0291       *diff = 0.0 ;
                0292     } else {
                0293       hasDifference = 1;
                0294       *diff = 100.0;
                0295 /* if (nbDebugDebug && hasDifference) { */
                0296 /*   nbDebugDebug-- ; */
                0297 /*   printf("vard:%24.16e (%i) %i\n", vard, expoTG, (expoTG<almostZero)) ; */
                0298 /* } */
                0299     }
                0300   } else {
                0301     *dd = dv/dbad_ddeps ;
                0302     int expoDD ;
                0303     frexpf(*dd, &expoDD) ;
                0304     float hv = dv - dbad_ddeps*vard ;
                0305     if (hv==0.0 || expoTG<almostZero || expoDD<almostZero) {
                0306       hasDifference = 0 ;
                0307       *diff = 0.0 ;
                0308     } else {
                0309       int expoDV, expoV1, expoV2, expoV, expoHV ;
                0310       frexpf(dv, &expoDV) ;
                0311       frexpf(var, &expoV1) ;
                0312       frexpf(vareps, &expoV2) ;
                0313       expoV = (var==0.0?expoV2:(vareps==0?expoV1:(expoV1>expoV2?expoV1:expoV2))) ;
                0314       frexpf(hv, &expoHV) ;
                0315       int discrepancySmallness = expoDV-expoHV ;
                0316       int discrepancyExactness = trustableMantissa-expoV+expoDV ;
                0317       hasDifference = (discrepancySmallness<errMaxBits && discrepancySmallness<discrepancyExactness) ;
                0318
                0319       float absvard = (vard>=0.0?vard:-vard) ;
                0320       float absdd = (*dd>=0.0?*dd:-*dd) ;
                0321       float maxabs = (absvard>absdd?absvard:absdd) ;
                0322       float absvardmdd = vard-*dd ;
                0323       if (absvardmdd<0.0) absvardmdd=-absvardmdd ;
                0324       *diff = (absvardmdd/maxabs)*100.0 ;
                0325 /* if (nbDebugDebug && hasDifference) { */
                0326 /*   nbDebugDebug-- ; */
                0327 /*   printf("vard:%24.16e [v-eps:%24.16e v-loc:%24.16e (%i)] dd:%24.16e (%i) -> %i\n", */
                0328 /*          vard, vareps, var, expoV, dv, expoDV, expoHV) ; */
                0329 /*   printf("n2:%i  52-M0+M1-6:%i different:%i %5.1f\n", */
                0330 /*          discrepancySmallness, discrepancyExactness, hasDifference, *diff) ; */
                0331 /* } */
                0332     }
                0333   }
                0334   return hasDifference ;
                0335 }
                0336
                0337 void dbad_display_location(char *placename) {
                0338  if (dbad_testThisProcess!=-2) {
                0339   int i ;
                0340   char* enclosproc = dbad_callStack->funcname ;
                0341   int callStackDepth = dbad_callstackdepth() ;
                0342   char indentWhite[20] = "                    " ;
                0343   if (callStackDepth<10) indentWhite[2*callStackDepth]='\0';
                0344   if (dbad_testThisProcess==-1) {
                0345     printf("%s[%2i]AT:%s OF %s\n", indentWhite, callStackDepth, placename, enclosproc) ;
                0346   } else {
                0347     printf("[process %i] %s[%2i]AT:%s OF %s\n", dbad_testThisProcess, indentWhite, callStackDepth, placename, enclosproc) ;
                0348   }
                0349  }
                0350 }
                0351
                0352 void dbad_adDebugTgt_testComplex16(char* varname, cdcmplx var, cdcmplx *vard, int conclude) {
                0353   if (dbad_testThisProcess!=-2) {
                0354     if (dbad_phase==1) {
                0355       dbad_putOneVarName(varname) ;
                0356       dbad_putOne8(var.dr) ;
                0357       dbad_putOne8(var.di) ;
                0358     } else if (dbad_phase==2) {
                0359       cdcmplx ddvar, dd ;
                0360       float diffR, diffI ;
                0361       int hasDifferenceR, hasDifferenceI ;
                0362       dbad_ddcheckvarname(varname) ;
                0363       dbad_getOne8(&(ddvar.dr)) ;
                0364       dbad_getOne8(&(ddvar.di)) ;
                0365       hasDifferenceR = dbad_discrepancy8(ddvar.dr, var.dr, vard->dr, &(dd.dr), &diffR) ;
                0366       hasDifferenceI = dbad_discrepancy8(ddvar.di, var.di, vard->di, &(dd.di), &diffI) ;
                0367       if (dbad_trace) {
                0368         printf("%s [v-eps:(%24.16e,%24.16e) v-loc:(%24.16e,%24.16e)] (%24.16e,%24.16e)(dd (%5.1f,%5.1f)%% DIFF? WITH ad)(%24.16e,%24.16e)\n",
                0369                varname,ddvar.dr,ddvar.di,var.dr,var.di,dd.dr,dd.di,diffR,diffI,vard->dr,vard->di) ;
                0370       } else if (hasDifferenceR||hasDifferenceI) {
                0371         printf("%s (%24.16e,%24.16e)(dd (%5.1f,%5.1f)%% DIFF WITH ad)(%24.16e,%24.16e)\n",
                0372                varname,dd,dd,diffR,diffI,vard->dr,vard->di) ;
                0373       }
                0374       if (conclude==-1) {
                0375         if (hasDifferenceR) {
                0376           vard->dr = dd.dr ;
                0377           printf("%s (.real) RESET:\n", varname) ;
                0378         }
                0379         if (hasDifferenceI) {
                0380           vard->di = dd.di ;
                0381           printf("%s (.imag) RESET:\n", varname) ;
                0382         }
                0383       }
                0384       if (conclude==1) {
                0385         cdcmplx varb ;
                0386         varb.dr = dbad_nextRandom();
                0387         varb.di = dbad_nextRandom();
                0388         dbad_condensed_dd  += dd.dr*varb.dr   + dd.di*varb.di;
                0389         dbad_condensed_tgt += vard->dr*varb.dr + vard->di*varb.di;
                0390       }
                0391     }
                0392   }
                0393 }
                0394
                0395 void dbad_adDebugTgt_testReal8(char* varname, double var, double *vard, int conclude) {
                0396   if (dbad_testThisProcess!=-2) {
                0397     if (dbad_phase==1) {
                0398       dbad_putOneVarName(varname) ;
                0399       dbad_putOne8(var) ;
                0400     } else if (dbad_phase==2) {
                0401       double ddvar, dd ;
                0402       float diff ;
                0403       dbad_ddcheckvarname(varname) ;
                0404       dbad_getOne8(&ddvar) ;
                0405       int hasDifference = dbad_discrepancy8(ddvar, var, *vard, &dd, &diff) ;
                0406       if (dbad_trace) {
                0407         printf("%s [v-eps:%24.16e v-loc:%24.16e] %24.16e(dd %5.1f%% DIFF? WITH ad)%24.16e\n",
                0408                varname,ddvar,var,dd,diff,*vard) ;
                0409       } else if (hasDifference) {
                0410         printf("%s %24.16e(dd %5.1f%% DIFF WITH ad)%24.16e\n",
                0411                varname,dd,diff,*vard) ;
                0412       }
                0413       if (conclude==-1 && hasDifference) {
                0414         *vard = dd ;
                0415         printf("%s RESET:\n", varname) ;
                0416       }
                0417       if (conclude==1) {
                0418         double varb = dbad_nextRandom() ;
                0419         dbad_condensed_dd += dd*varb;
                0420         dbad_condensed_tgt += *vard*varb;
                0421       }
                0422     }
                0423   }
                0424 }
                0425
                0426 void dbad_adDebugTgt_testReal4(char* varname, float var, float *vard, int conclude) {
                0427   if (dbad_testThisProcess!=-2) {
                0428     if (dbad_phase==1) {
                0429       dbad_putOneVarName(varname) ;
                0430       dbad_putOne4(var) ;
                0431     } else if (dbad_phase==2) {
                0432       float ddvar, dd ;
                0433       float diff ;
                0434       dbad_ddcheckvarname(varname) ;
                0435       dbad_getOne4(&ddvar) ;
                0436       int hasDifference = dbad_discrepancy4(ddvar, var, *vard, &dd, &diff) ;
                0437       if (dbad_trace) {
                0438         printf("%s [v-eps:%18.10e v-loc:%18.10e] %18.10e(dd %5.1f%% DIFF? WITH ad)%18.10e\n",
                0439                varname,ddvar,var,dd,diff,*vard) ;
                0440       } else if (hasDifference) {
                0441         printf("%s %18.10e(dd %5.1f%% DIFF WITH ad)%18.10e\n",
                0442                varname,dd,diff,*vard) ;
                0443       }
                0444       if (conclude==-1 && hasDifference) {
                0445         *vard = dd ;
                0446         printf("%s RESET:\n", varname) ;
                0447       }
                0448       if (conclude==1) {
                0449         double varb = dbad_nextRandom() ;
                0450         dbad_condensed_dd += ((double)dd)*varb;
                0451         dbad_condensed_tgt += ((double)*vard)*varb;
                0452       }
                0453     }
                0454   }
                0455 }
                0456
                0457 void dbad_adDebugTgt_testComplex16Array(char* varname, cdcmplx* var, cdcmplx* vard, int length, int conclude) {
                0458   if (!var || !vard) return ;
                0459   if (dbad_testThisProcess!=-2) {
                0460     int i ;
                0461     if (dbad_phase==1) {
                0462       dbad_putOneVarName(varname) ;
                0463       for (i=0 ; i<length ; ++i) {
                0464         dbad_putOne8(var[i].dr) ;
                0465         dbad_putOne8(var[i].di) ;
                0466       }
                0467     } else if (dbad_phase==2) {
                0468       cdcmplx ddvar, dd, vardbuf[10], ddbuf[10], varepsbuf[10], varlocbuf[10] ;
                0469       float diffR, diffI ;
                0470       int hasDifferenceR, hasDifferenceI, printedheader = 0, indexbuf[10], ibuf = 0 ;
                0471       dbad_ddcheckvarname(varname) ;
                0472       for (i=0 ; i<length ; ++i) {
                0473         dbad_getOne8(&ddvar.dr) ;
                0474         dbad_getOne8(&ddvar.di) ;
                0475         hasDifferenceR = dbad_discrepancy8(ddvar.dr, var[i].dr, vard[i].dr, &(dd.dr), &diffR) ;
                0476         hasDifferenceI = dbad_discrepancy8(ddvar.di, var[i].di, vard[i].di, &(dd.di), &diffI) ;
                0477         if (hasDifferenceR || hasDifferenceI || dbad_trace) {
                0478           if (dbad_trace) {
                0479             varepsbuf[ibuf] = ddvar ;
                0480             varlocbuf[ibuf] = var[i] ;
                0481           }
                0482           vardbuf[ibuf] = vard[i] ;
                0483           ddbuf[ibuf] = dd ;
                0484           indexbuf[ibuf] = i ;
                0485           ++ibuf ;
                0486         }
                0487         if (conclude==-1) { //Nudge the ad derivative back to divided-diff value!
                0488           if (hasDifferenceR) vard[i].dr = dd.dr ;
                0489           if (hasDifferenceI) vard[i].di = dd.di ;
                0490         }
                0491         if (ibuf>=5 || (i==length-1 && ibuf>0)) {
                0492           int j ;
                0493           if (!printedheader) {
                0494             if (conclude==-1)
                0495               printf("%s RESET:\n", varname) ;
                0496             else
                0497               printf("%s DIFFS:\n", varname) ;
                0498             printedheader = 1 ;
                0499           }
                0500           printf("    ") ;
                0501           for (j=0 ; j<ibuf ; ++j)
                0502             printf(" %4i->(%11.4e,%11.4e)", indexbuf[j], vardbuf[j].dr, vardbuf[j].di) ;
                0503           printf("\n    ") ;
                0504           if (dbad_trace) {
                0505             for (j=0 ; j<ibuf ; ++j)
                0506               printf("  (eps)(%11.4e,%11.4e)", varepsbuf[j].dr, varepsbuf[j].di) ;
                0507             printf("\n    ") ;
                0508             for (j=0 ; j<ibuf ; ++j)
                0509               printf("  (loc)(%11.4e,%11.4e)", varlocbuf[j].dr, varlocbuf[j].di) ;
                0510             printf("\n    ") ;
                0511           }
                0512           for (j=0 ; j<ibuf ; ++j)
                0513             printf("  (dd:)(%11.4e,%11.4e)", ddbuf[j].dr, ddbuf[j].di) ;
                0514           printf("\n") ;
                0515           ibuf = 0 ;
                0516         }
                0517         if (conclude==1) {
                0518           cdcmplx varb ;
                0519           varb.dr = dbad_nextRandom();
                0520           varb.di = dbad_nextRandom();
                0521           dbad_condensed_dd  += dd.dr*varb.dr      + dd.di*varb.di ;
                0522           dbad_condensed_tgt += vard[i].dr*varb.dr + vard[i].di*varb.di ;
                0523         }
                0524       }
                0525     }
                0526   }
                0527 }
                0528
                0529 void dbad_adDebugTgt_testReal8Array(char* varname, double* var, double* vard, int length, int conclude) {
                0530   if (!var || !vard) return ;
                0531   if (dbad_testThisProcess!=-2) {
                0532     int i ;
                0533     if (dbad_phase==1) {
                0534       dbad_putOneVarName(varname) ;
                0535       for (i=0 ; i<length ; ++i) {
                0536         dbad_putOne8(var[i]) ;
                0537       }
                0538     } else if (dbad_phase==2) {
                0539       double ddvar, dd, vardbuf[10], ddbuf[10], varepsbuf[10], varlocbuf[10] ;
                0540       float diff ;
                0541       int hasDifference, printedheader = 0, indexbuf[10], ibuf = 0 ;
                0542       dbad_ddcheckvarname(varname) ;
                0543       for (i=0 ; i<length ; ++i) {
                0544         dbad_getOne8(&ddvar) ;
                0545         hasDifference = dbad_discrepancy8(ddvar, var[i], vard[i], &dd, &diff) ;
                0546         if (dbad_trace) {
                0547           varepsbuf[ibuf] = ddvar ;
                0548           varlocbuf[ibuf] = var[i] ;
                0549         }
                0550         if (hasDifference || dbad_trace) {
                0551           vardbuf[ibuf] = vard[i] ;
                0552           ddbuf[ibuf] = dd ;
                0553           indexbuf[ibuf] = i ;
                0554           ++ibuf ;
                0555         }
                0556         if (conclude==-1 && hasDifference) { //Nudge the ad derivative back to divided-diff value!
                0557           vard[i] = dd ;
                0558         }
                0559         if (ibuf>=10 || (i==length-1 && ibuf>0)) {
                0560           int j ;
                0561           if (!printedheader) {
                0562             if (conclude==-1)
                0563               printf("%s RESET:\n", varname) ;
                0564             else
                0565               printf("%s DIFFS:\n", varname) ;
                0566             printedheader = 1 ;
                0567           }
                0568           printf("    ") ;
                0569           for (j=0 ; j<ibuf ; ++j)
                0570             printf(" %4i->%11.4e", indexbuf[j], vardbuf[j]) ;
                0571           printf("\n    ") ;
                0572           if (dbad_trace) {
                0573             for (j=0 ; j<ibuf ; ++j)
                0574               printf("  (eps)%11.4e", varepsbuf[j]) ;
                0575             printf("\n    ") ;
                0576             for (j=0 ; j<ibuf ; ++j)
                0577               printf("  (loc)%11.4e", varlocbuf[j]) ;
                0578             printf("\n    ") ;
                0579           }
                0580           for (j=0 ; j<ibuf ; ++j)
                0581             printf("  (dd:)%11.4e", ddbuf[j]) ;
                0582           printf("\n") ;
                0583           ibuf = 0 ;
                0584         }
                0585         if (conclude==1) {
                0586           double varb = dbad_nextRandom() ;
                0587           dbad_condensed_dd += dd*varb;
                0588           dbad_condensed_tgt += vard[i]*varb;
                0589         }
                0590       }
                0591     }
                0592   }
                0593 }
                0594
                0595 void dbad_adDebugTgt_testReal4Array(char* varname, float* var, float* vard, int length, int conclude) {
                0596   if (!var || !vard) return ;
                0597   if (dbad_testThisProcess!=-2) {
                0598     int i ;
                0599     if (dbad_phase==1) {
                0600       dbad_putOneVarName(varname) ;
                0601       for (i=0 ; i<length ; ++i) {
                0602         dbad_putOne4(var[i]) ;
                0603       }
                0604     } else if (dbad_phase==2) {
                0605       float ddvar, dd, vardbuf[10], ddbuf[10], varepsbuf[10], varlocbuf[10] ;
                0606       float diff ;
                0607       int hasDifference, printedheader = 0, indexbuf[10], ibuf = 0 ;
                0608       dbad_ddcheckvarname(varname) ;
                0609       for (i=0 ; i<length ; ++i) {
                0610         dbad_getOne4(&ddvar) ;
                0611         hasDifference = dbad_discrepancy4(ddvar, var[i], vard[i], &dd, &diff) ;
                0612         if (dbad_trace) {
                0613           varepsbuf[ibuf] = ddvar ;
                0614           varlocbuf[ibuf] = var[i] ;
                0615         }
                0616         if (hasDifference || dbad_trace) {
                0617           vardbuf[ibuf] = vard[i] ;
                0618           ddbuf[ibuf] = dd ;
                0619           indexbuf[ibuf] = i ;
                0620           ++ibuf ;
                0621         }
                0622         if (conclude==-1 && hasDifference) { //Nudge the ad derivative back to divided-diff value!
                0623           vard[i] = dd ;
                0624         }
                0625         if (ibuf>=10 || (i==length-1 && ibuf>0)) {
                0626           int j ;
                0627           if (!printedheader) {
                0628             if (conclude==-1)
                0629               printf("%s RESET:\n", varname) ;
                0630             else
                0631               printf("%s DIFFS:\n", varname) ;
                0632             printedheader = 1 ;
                0633           }
                0634           printf("    ") ;
                0635           for (j=0 ; j<ibuf ; ++j)
                0636             printf(" %4i->%11.4e", indexbuf[j], vardbuf[j]) ;
                0637           printf("\n    ") ;
                0638           if (dbad_trace) {
                0639             for (j=0 ; j<ibuf ; ++j)
                0640               printf("  (eps)%11.4e", varepsbuf[j]) ;
                0641             printf("\n    ") ;
                0642             for (j=0 ; j<ibuf ; ++j)
                0643               printf("  (loc)%11.4e", varlocbuf[j]) ;
                0644             printf("\n    ") ;
                0645           }
                0646           for (j=0 ; j<ibuf ; ++j)
                0647             printf("  (dd:)%11.4e", ddbuf[j]) ;
                0648           printf("\n") ;
                0649           ibuf = 0 ;
                0650         }
                0651         if (conclude==1) {
                0652           double varb = dbad_nextRandom() ;
                0653           dbad_condensed_dd += ((double)dd)*varb;
                0654           dbad_condensed_tgt += ((double)vard[i])*varb;
                0655         }
                0656       }
                0657     }
                0658   }
                0659 }
                0660
                0661 //###################### DEBUG OF TANGENT ##############################
                0662
                0663 void adDebugTgt_init(double epsilon, double seed, int tested_process) {
                0664   //argument "tested_process" is used only in the MPI case!!
                0665   dbad_mode = 1 ;
                0666   dbad_ddeps = epsilon ;
                0667   dbad_seed = seed ;
                0668   dbad_topContext.funcname = "TESTED CODE\0" ;
                0669   dbad_topContext.deltadepth = 0 ;
                0670   dbad_topContext.code = 0 ;
                0671   dbad_calltracedepth = 1 ;
                0672   dbad_callStack = &dbad_topContext ;
                0673   char* phase = getenv("DBAD_PHASE") ;
                0674   if (phase==NULL) {
                0675     printf("Please set DBAD_PHASE environment variable to 1 (perturbed), 2 (tangent), or 0 (no debug)\n") ;
                0676     exit(0) ;
                0677   } else if (strcmp(phase,"0")==0) {
                0678     dbad_phase = 0 ;
                0679   } else if (strcmp(phase,"1")==0) {
                0680     dbad_phase = 1 ;
                0681   } else if (strcmp(phase,"2")==0) {
                0682     dbad_phase = 2 ;
                0683   } else if (strcmp(phase,"-1")==0) {
                0684     dbad_phase = 1 ;
                0685     dbad_trace = 1 ;
                0686   } else if (strcmp(phase,"-2")==0) {
                0687     dbad_phase = 2 ;
                0688     dbad_trace = 1 ;
                0689   } else {
                0690     printf("DBAD_PHASE environment variable must be set to 1 (perturbed), 2 (tangent), or 0 (no debug)\n") ;
                0691     exit(0) ;
                0692   }
                0693   char* fifoFileName = (char*)malloc(20*sizeof(char)) ; //TODO: unclean fixed size.
                0694   int this_process_world_rank;
                0695   MPI_Comm_rank(MPI_COMM_WORLD, &this_process_world_rank);
                0696   if (tested_process==this_process_world_rank || tested_process==-1) {
                0697     dbad_testThisProcess = this_process_world_rank ;
                0698     sprintf(fifoFileName, "/tmp/DBAD_fifo%i\0", this_process_world_rank) ;
                0699   } else {
                0700     dbad_testThisProcess = -2 ;
                0701   }
                0702   if (dbad_testThisProcess!=-2) {
                0703     if (dbad_trace) {
                0704       printf("INTERNAL TESTS, epsilon=%7.1e\n", epsilon) ;
                0705       printf("===========================================================\n") ;
                0706     }
                0707     if (dbad_phase==1) {
                0708       if (dbad_testThisProcess==-1) {
                0709         printf("Starting TGT test, phase one, epsilon=%7.1e [seed=%7.1e]\n",
                0710                epsilon, seed) ;
                0711       } else {
                0712         printf("[process %i] Starting TGT test, phase one, epsilon=%7.1e [seed=%7.1e]\n",
                0713                dbad_testThisProcess, epsilon, seed) ;
                0714       }
                0715       printf("===========================================================\n") ;
                0716       mkfifo(fifoFileName, S_IWUSR | S_IRUSR | S_IRGRP | S_IROTH | S_IRWXU | S_IRWXO) ;
                0717       dbad_file = fopen(fifoFileName, "a") ;
                0718       if (dbad_file==NULL) {
                0719         char errbuf[20] ;
                0720         strerror_r(errno, errbuf, 20) ;
                0721         printf("FIFO ERROR %i: %s  OR  %s\n",errno,strerror(errno),errbuf) ;
                0722         exit(0) ;
                0723       }
                0724     } else if (dbad_phase==2) {
                0725       if (dbad_testThisProcess==-1) {
                0726         printf("Starting TGT test, phase two, epsilon=%7.1e [seed=%7.1e]\n",
                0727                epsilon, seed) ;
                0728       } else {
                0729         printf("[process %i] Starting TGT test, phase two, epsilon=%7.1e [seed=%7.1e]\n",
                0730                dbad_testThisProcess, epsilon, seed) ;
                0731       }
                0732       printf("===========================================================\n") ;
                0733       dbad_file = fopen(fifoFileName, "r") ;
                0734     }
                0735     dbad_resetCondensors() ;
                0736   }
                0737 }
                0738
                0739 void adDebugTgt_call(char* unitname, int deltadepth, int forcetraced) {
                0740   if (dbad_trace) {
                0741     printf("call %s deltadepth:%i forcetraced:%i\n", unitname, deltadepth, forcetraced) ;
                0742   }
                0743   if (dbad_phase!=0) {
                0744     dbad_pushCallFrame(unitname, deltadepth, forcetraced) ;
                0745   }
                0746 }
                0747
                0748 void adDebugTgt_exit() {
                0749   if (dbad_trace) {
                0750     printf("exit\n") ;
                0751   }
                0752   if (dbad_phase!=0) {
                0753     dbad_popCallFrame() ;
                0754   }
                0755   dbad_resetCondensors() ;
                0756 }
                0757
                0758 int adDebugTgt_here(char* placename, int forcetraced) {
                0759   if (dbad_testThisProcess!=-2) {
                0760     if (dbad_trace) {
                0761       printf("here?? %s forcetraced:%i\n", placename, forcetraced) ;
                0762       printf("    will return %i\n", (dbad_phase==0?0:dbad_debughere(forcetraced))) ;
                0763     }
                0764     if (dbad_phase==0) return 0 ;
                0765     return dbad_debughere(forcetraced) ;
                0766   } else {
                0767     return 0 ;
                0768   }
                0769 }
                0770
                0771 void adDebugTgt_initComplex16(char* varname, cdcmplx *indep, cdcmplx *indepd) {
                0772   indepd->dr = dbad_nextRandom() ;
                0773   indepd->di = dbad_nextRandom() ;
                0774 /*   dbad_scaleIndepDirection??(indepd, *indep) ; // One may prefer to comment this line out... */
                0775   if (dbad_phase==1) {
                0776     indep->dr = (indep->dr)+dbad_ddeps*(indepd->dr) ;
                0777     indep->di = (indep->di)+dbad_ddeps*(indepd->di) ;
                0778   }
                0779   if (dbad_trace)
                0780     printf("initComplex16 of %s: (%24.16e,%24.16e) //(%24.16e,%24.16e)\n", varname, indep->dr, indep->di, indepd->dr, indepd->di) ;
                0781 }
                0782
                0783 void adDebugTgt_initReal8(char* varname, double *indep, double *indepd) {
                0784   *indepd = dbad_nextRandom() ;
                0785 /*   dbad_scaleIndepDirection8(indepd, *indep) ; // One may prefer to comment this line out... */
                0786   if (dbad_phase==1)
                0787     *indep = (*indep)+dbad_ddeps*(*indepd) ;
                0788   if (dbad_trace)
                0789     printf("initReal8 of %s: %24.16e //%24.16e\n", varname, *indep, *indepd) ;
                0790 }
                0791
                0792 void adDebugTgt_initReal4(char* varname, float *indep, float *indepd) {
                0793   *indepd = (float)dbad_nextRandom() ;
                0794 /*   dbad_scaleIndepDirection4(indepd, *indep) ; // One may prefer to comment this line out... */
                0795   if (dbad_phase==1)
                0796     *indep = (*indep)+dbad_ddeps*(*indepd) ;
                0797   if (dbad_trace)
                0798     printf("initReal4 of %s: %24.16e //%24.16e\n", varname, (double)*indep, (double)*indepd) ;
                0799 }
                0800
                0801 void adDebugTgt_initComplex16Array(char* varname, cdcmplx *indep, cdcmplx *indepd, int length) {
                0802   if (!indep || !indepd) return ;
                0803   int i ;
                0804   for (i=0 ; i<length ; ++i) {
                0805     indepd[i].dr = dbad_nextRandom() ;
                0806     indepd[i].di = dbad_nextRandom() ;
                0807 /* printf("nextRandom %i (%24.16e,%24.16e)\n", i, indepd[i].dr, indepd[i].di) ; */
                0808 /*     dbad_scaleIndepDirection??(&indepd[i], indep[i]) ; // One may prefer to comment this line out... */
                0809 /* printf(" -> scaled %i (%24.16e,%24.16e)\n", i, indepd[i].dr, indepd[i].di) ; */
                0810   }
                0811   if (dbad_phase==1) {
                0812     for (i=0 ; i<length ; ++i) {
                0813       indep[i].dr += dbad_ddeps*indepd[i].dr ;
                0814       indep[i].di += dbad_ddeps*indepd[i].di ;
                0815     }
                0816   }
                0817   if (dbad_trace) {
                0818     printf("initComplex16Array of %s, length=%i:\n", varname, length) ;
                0819     for (i=0 ; i<length ; ++i)
                0820       printf("    %i:(%24.16e,%24.16e) //(%24.16e,%24.16e)",i,indep[i].dr,indep[i].di,indepd[i].dr,indepd[i].di) ;
                0821     printf("\n") ;
                0822   }
                0823 }
                0824
                0825 void adDebugTgt_initReal8Array(char* varname, double *indep, double *indepd, int length) {
                0826   if (!indep || !indepd) return ;
                0827   int i ;
                0828   for (i=0 ; i<length ; ++i) {
                0829     indepd[i] = dbad_nextRandom() ;
                0830 /* printf("nextRandom %i %24.16e\n", i, indepd[i]) ; */
                0831 /*     dbad_scaleIndepDirection8(&indepd[i], indep[i]) ; // One may prefer to comment this line out... */
                0832 /* printf(" -> scaled %i %24.16e\n", i, indepd[i]) ; */
                0833   }
                0834   if (dbad_phase==1) {
                0835     for (i=0 ; i<length ; ++i) {
                0836       indep[i] = indep[i]+dbad_ddeps*indepd[i] ;
                0837     }
                0838   }
                0839   if (dbad_trace) {
                0840     printf("initReal8Array of %s, length=%i:\n", varname, length) ;
                0841     for (i=0 ; i<length ; ++i)
                0842       printf("    %i:%24.16e //%24.16e",i,indep[i],indepd[i]) ;
                0843     printf("\n") ;
                0844   }
                0845 }
                0846
                0847 void adDebugTgt_initReal4Array(char* varname, float *indep, float *indepd, int length) {
                0848   if (!indep || !indepd) return ;
                0849   int i ;
                0850   for (i=0 ; i<length ; ++i) {
                0851     indepd[i] = (float)dbad_nextRandom() ;
                0852 /*     dbad_scaleIndepDirection4(&indepd[i], indep[i]) ; // One may prefer to comment this line out... */
                0853   }
                0854   if (dbad_phase==1) {
                0855     for (i=0 ; i<length ; ++i) {
                0856       indep[i] = indep[i]+dbad_ddeps*indepd[i] ;
                0857     }
                0858   }
                0859   if (dbad_trace) {
                0860     printf("initReal4Array of %s, length=%i:\n", varname, length) ;
                0861     for (i=0 ; i<length ; ++i)
                0862       printf("    %i:%24.16e //%24.16e",i,(double)indep[i],(double)indepd[i]) ;
                0863     printf("\n") ;
                0864   }
                0865 }
                0866
                0867 void adDebugTgt_passiveComplex16(char *varname, cdcmplx var) {
                0868   if (dbad_testThisProcess!=-2) {
                0869     if (dbad_phase==1) {
                0870       dbad_putOneVarName(varname) ;
                0871       dbad_putOne8(var.dr) ;
                0872       dbad_putOne8(var.di) ;
                0873     } else if (dbad_phase==2) {
                0874       cdcmplx ddvar ;
                0875       dbad_ddcheckvarname(varname) ;
                0876       dbad_getOne8(&(ddvar.dr)) ;
                0877       dbad_getOne8(&(ddvar.di)) ;
                0878       if (dbad_trace) {
                0879         printf("passiveComplex16 %s v-eps:(%24.16e,%24.16e) v-loc:(%24.16e,%24.16e) are %s\n",
                0880                varname,ddvar.dr,ddvar.di,var.dr,var.di,(ddvar.dr==var.dr && ddvar.di==var.di?"equal":"different")) ;
                0881       } else if (ddvar.dr!=var.dr || ddvar.di!=var.di) {
                0882         printf("passiveComplex16 %s appears to be varied (v-eps:(%24.16e,%24.16e) v-loc:(%24.16e,%24.16e)). Hope it is really not useful!\n",
                0883                varname,ddvar.dr,ddvar.di,var.dr,var.di) ;
                0884       }
                0885     }
                0886   }
                0887 }
                0888
                0889 void adDebugTgt_passiveReal8(char *varname, double var) {
                0890   if (dbad_testThisProcess!=-2) {
                0891     if (dbad_phase==1) {
                0892       dbad_putOneVarName(varname) ;
                0893       dbad_putOne8(var) ;
                0894     } else if (dbad_phase==2) {
                0895       double ddvar ;
                0896       dbad_ddcheckvarname(varname) ;
                0897       dbad_getOne8(&ddvar) ;
                0898       if (dbad_trace) {
                0899         printf("passiveReal8 %s v-eps:%24.16e v-loc:%24.16e are %s\n",
                0900                varname,ddvar,var,(ddvar==var?"equal":"different")) ;
                0901       } else if (ddvar!=var) {
                0902         printf("passiveReal8 %s appears to be varied (v-eps:%24.16e v-loc:%24.16e). Hope it is really not useful!\n",
                0903                varname,ddvar,var) ;
                0904       }
                0905     }
                0906   }
                0907 }
                0908
                0909 void adDebugTgt_passiveReal4(char *varname, float var) {
                0910   if (dbad_testThisProcess!=-2) {
                0911     if (dbad_phase==1) {
                0912       dbad_putOneVarName(varname) ;
                0913       dbad_putOne4(var) ;
                0914     } else if (dbad_phase==2) {
                0915       float ddvar ;
                0916       dbad_ddcheckvarname(varname) ;
                0917       dbad_getOne4(&ddvar) ;
                0918       if (dbad_trace) {
                0919         printf("passiveReal4 %s v-eps:%18.10 v-loc:%18.10 are %s\n",
                0920                varname,ddvar,var,(ddvar==var?"equal":"different")) ;
                0921       } else if (ddvar!=var) {
                0922         printf("passiveReal4 %s appears to be varied (v-eps:%18.10 v-loc:%18.10). Hope it is really not useful!\n",
                0923                varname,ddvar,var) ;
                0924       }
                0925     }
                0926   }
                0927 }
                0928
                0929 void adDebugTgt_passiveComplex16Array(char *varname, cdcmplx *var, int length) {
                0930   if (!var) return;
                0931   if (dbad_testThisProcess!=-2) {
                0932     int i ;
                0933     double varsum = 0.0 ;
                0934     for (i=0 ; i<length ; ++i) {
                0935       varsum += var[i].dr + var[i].di ;
                0936     }
                0937     adDebugTgt_passiveReal8(varname, varsum) ;
                0938   }
                0939 }
                0940
                0941 void adDebugTgt_passiveReal8Array(char *varname, double *var, int length) {
                0942   if (!var) return;
                0943   if (dbad_testThisProcess!=-2) {
                0944     int i ;
                0945     double varsum = 0.0 ;
                0946     for (i=0 ; i<length ; ++i) {
                0947       varsum += var[i] ;
                0948     }
                0949     adDebugTgt_passiveReal8(varname, varsum) ;
                0950   }
                0951 }
                0952
                0953 void adDebugTgt_passiveReal4Array(char *varname, float *var, int length) {
                0954   if (!var) return;
                0955   if (dbad_testThisProcess!=-2) {
                0956     int i ;
                0957     float varsum = 0.0 ;
                0958     for (i=0 ; i<length ; ++i) {
                0959       varsum += var[i] ;
                0960     }
                0961     adDebugTgt_passiveReal4(varname, varsum) ;
                0962   }
                0963 }
                0964
                0965 void adDebugTgt_testComplex16(char *varname, cdcmplx var, cdcmplx *vard) {
                0966   dbad_adDebugTgt_testComplex16(varname, var, vard, 0) ; //replace 0 with -1 to nudge vard
                0967 }
                0968
                0969 void adDebugTgt_testReal8(char *varname, double var, double *vard) {
                0970   dbad_adDebugTgt_testReal8(varname, var, vard, 0) ; //replace 0 with -1 to nudge vard
                0971 }
                0972
                0973 void adDebugTgt_testReal4(char *varname, float var, float *vard) {
                0974   dbad_adDebugTgt_testReal4(varname, var, vard, 0) ; //replace 0 with -1 to nudge vard
                0975 }
                0976
                0977 void adDebugTgt_testComplex16Array(char *varname, cdcmplx* var, cdcmplx* vard, int length) {
                0978   dbad_adDebugTgt_testComplex16Array(varname, var, vard, length, 0) ; //replace 0 with -1 to nudge vard
                0979 }
                0980
                0981 void adDebugTgt_testReal8Array(char *varname, double* var, double* vard, int length) {
                0982   dbad_adDebugTgt_testReal8Array(varname, var, vard, length, 0) ; //replace 0 with -1 to nudge vard
                0983 }
                0984
                0985 void adDebugTgt_testReal4Array(char *varname, float* var, float* vard, int length) {
                0986   dbad_adDebugTgt_testReal4Array(varname, var, vard, length, 0) ; //replace 0 with -1 to nudge vard
                0987 }
                0988
                0989 void adDebugTgt_concludeComplex16(char* varname, cdcmplx var, cdcmplx *vard) {
                0990   dbad_adDebugTgt_testComplex16(varname, var, vard, 1) ;
                0991 }
                0992
                0993 void adDebugTgt_concludeReal8(char* varname, double var, double *vard) {
                0994   dbad_adDebugTgt_testReal8(varname, var, vard, 1) ;
                0995 }
                0996
                0997 void adDebugTgt_concludeReal4(char* varname, float var, float *vard) {
                0998   dbad_adDebugTgt_testReal4(varname, var, vard, 1) ;
                0999 }
                1000
                1001 void adDebugTgt_concludeComplex16Array(char* varname, cdcmplx *var, cdcmplx *vard, int length) {
                1002   dbad_adDebugTgt_testComplex16Array(varname, var, vard, length, 1) ;
                1003 }
                1004
                1005 void adDebugTgt_concludeReal8Array(char* varname, double *var, double *vard, int length) {
                1006 //printf(" C :%24.16e d:%24.16e\n", var[0], vard[0]) ;
                1007   dbad_adDebugTgt_testReal8Array(varname, var, vard, length, 1) ;
                1008 }
                1009
                1010 void adDebugTgt_concludeReal4Array(char* varname, float *var, float *vard, int length) {
                1011   dbad_adDebugTgt_testReal4Array(varname, var, vard, length, 1) ;
                1012 }
                1013
                1014 void adDebugTgt_conclude() {
                1015   if (dbad_testThisProcess!=-2) {
                1016     printf("===========================================================\n") ;
                1017     if (dbad_trace) {
                1018       if (dbad_testThisProcess==-1) {
                1019         printf("Condensed results: %24.16e //%24.16e",dbad_condensed_tgt,dbad_condensed_dd) ;
                1020       } else {
                1021         printf("[process %i] Condensed results: %24.16e //%24.16e",dbad_testThisProcess,dbad_condensed_tgt,dbad_condensed_dd) ;
                1022       }
                1023     }
                1024     if (dbad_phase==2) {
                1025       double abstgt, absdd, maxabs, abserror, diff ;
                1026       abstgt = (dbad_condensed_tgt>=0.0?dbad_condensed_tgt:-dbad_condensed_tgt) ;
                1027       absdd = (dbad_condensed_dd>=0.0?dbad_condensed_dd:-dbad_condensed_dd) ;
                1028       maxabs = (abstgt>absdd?abstgt:absdd) ;
                1029       abserror = dbad_condensed_tgt-dbad_condensed_dd ;
                1030       if (abserror<0.0) abserror=-abserror ;
                1031       diff = (abserror*100.0)/ maxabs ;
                1032       if (dbad_testThisProcess==-1) {
                1033         printf("Condensed tangent: %24.16e (ad)%5.1f%% DIFF WITH (dd)%24.16e [seed:%7.1e]\n",
                1034                dbad_condensed_tgt,diff,dbad_condensed_dd,dbad_seed) ;
                1035       } else {
                1036         printf("[process %i] Condensed tangent: %24.16e (ad)%5.1f%% DIFF WITH (dd)%24.16e [seed:%7.1e]\n",
                1037                dbad_testThisProcess,dbad_condensed_tgt,diff,dbad_condensed_dd,dbad_seed) ;
                1038       }
                1039     }
                1040   }
                1041 }
                1042
                1043 void adDebugTgt_display(char *placename) {
                1044   if (dbad_testThisProcess!=-2) {
                1045     if (dbad_trace) {
                1046       if (dbad_testThisProcess==-1) {
                1047         printf("display %s\n", placename) ;
                1048       } else {
                1049         printf("[process %i] display %s\n", dbad_testThisProcess, placename) ;
                1050       }
                1051     }
                1052     if (dbad_phase==2) {
                1053       dbad_display_location(placename) ;
                1054     }
                1055   }
                1056 }
                1057
                1058 //############## DEBUG OF ADJOINT, FIRST SWEEP: ADJOINT RUN ################
                1059
                1060 void adDebugBwd_init(double errmax, double seed) {
                1061   dbad_mode = -1 ;
                1062   dbad_phase = 1 ;
                1063   dbad_errormax = errmax ;
                1064   dbad_seed = seed ;
                1065   dbad_topContext.funcname =  "TESTED CODE\0" ;
                1066   dbad_topContext.deltadepth = 0 ;
                1067   dbad_topContext.code = 0 ;
                1068   dbad_calltracedepth = 1 ;
                1069   dbad_callStack = &dbad_topContext ;
                1070   char* phase = getenv("DBAD_PHASE") ;
                1071   if (phase==NULL) {
                1072     printf("Please set DBAD_PHASE environment variable to 0 (no debug), 1 (sendToTgt), or -1 (plusTraces)\n") ;
                1073     dbad_phase = 1 ;
                1074   } else if (strcmp(phase,"0")==0) {
                1075     dbad_phase = 1 ;
                1076     dbad_nocommunication = 1 ;
                1077   } else if (strcmp(phase,"1")==0) {
                1078     dbad_phase = 1 ;
                1079   } else if (strcmp(phase,"-1")==0) {
                1080     dbad_phase = 1 ;
                1081     dbad_trace = 1 ;
                1082   } else {
                1083     printf("DBAD_PHASE environment variable must be set to 0 (no debug), 1 (sendToTgt), or -1 (plusTraces)\n") ;
                1084     exit(0) ;
                1085   }
                1086   printf("Starting ADJ test, phase one (bwd), errmax=%4.1f% [seed=%7.1e]\n", errmax, seed) ;
                1087   printf("===========================================================\n") ;
                1088   if (dbad_nocommunication) {
                1089     dbad_file = NULL ;
                1090     printf("FIFO COMMUNICATION TURNED OFF !\n") ;
                1091   } else {
                1092     mkfifo("/tmp/DBAD_fifo", S_IWUSR | S_IRUSR | S_IRGRP | S_IROTH | S_IRWXU | S_IRWXO) ;
                1093     dbad_file = fopen("/tmp/DBAD_fifo", "a") ;
                1094     if (dbad_file==NULL) {
                1095       char errbuf[20] ;
                1096       strerror_r(errno, errbuf, 20) ;
                1097       printf("FIFO ERROR %i: %s  OR  %s\n",errno,strerror(errno),errbuf) ;
                1098       exit(0) ;
                1099     }
                1100   }
                1101   dbad_resetCondensors() ;
                1102 }
                1103
                1104 void adDebugBwd_call(char *funcname, int deltadepth) {
                1105   dbad_pushCallFrame(funcname, deltadepth, 0) ;
                1106 }
                1107
                1108 void adDebugBwd_exit() {
                1109   dbad_resetCondensors() ;
                1110   if (dbad_debugabove()) {
                1111     if (dbad_nocommunication) {
                1112       printf("adDebug would send (%i %s)\n", (dbad_debughere(0)?2:-2), dbad_callStack->funcname) ;
                1113     } else {
                1114       fprintf(dbad_file, "%i\n", (dbad_debughere(0)?2:-2)) ;
                1115       fprintf(dbad_file, "%s\n", dbad_callStack->funcname) ;
                1116     }
                1117   }
                1118   dbad_popCallFrame() ;
                1119 }
                1120
                1121 int adDebugBwd_here(char* placename) {
                1122   dbad_resetCondensors() ;
                1123   return adDebugTgt_here(placename, 0) ;
                1124 }
                1125
                1126 //############## DEBUG OF ADJOINT, SECOND SWEEP: TANGENT RUN ################
                1127
                1128 void adDebugFwd_init(double errmax, double seed) {
                1129   dbad_mode = -1 ;
                1130   dbad_phase = 2 ;
                1131   dbad_errormax = errmax ;
                1132   dbad_seed = seed ;
                1133   dbad_topContext.funcname = "TESTED CODE\0" ;
                1134   dbad_topContext.deltadepth = 0 ;
                1135   dbad_topContext.code = 0 ;
                1136   dbad_calltracedepth = 1 ;
                1137   dbad_callStack = &dbad_topContext ;
                1138   char* phase = getenv("DBAD_PHASE") ;
                1139   if (phase==NULL) {
                1140     printf("Please set DBAD_PHASE environment variable to 0 (no debug), 2 (readFromAdj), or -2 (plusTraces)\n") ;
                1141     dbad_phase = 2 ;
                1142   } else if (strcmp(phase,"0")==0) {
                1143     dbad_phase = 2 ;
                1144     dbad_nocommunication = 1 ;
                1145   } else if (strcmp(phase,"2")==0) {
                1146     dbad_phase = 2 ;
                1147   } else if (strcmp(phase,"-2")==0) {
                1148     dbad_phase = 2 ;
                1149     dbad_trace = 1 ;
                1150   } else {
                1151     printf("DBAD_PHASE environment variable must be set to 0 (no debug), 2 (readFromAdj), or -2 (plusTraces)\n") ;
                1152     exit(0) ;
                1153   }
                1154   dbad_nberrors = 0 ;
                1155   printf("Starting ADJ test, phase two (fwd), errmax=%4.1f% [seed=%7.1e]\n", errmax, seed) ;
                1156   printf("===========================================================\n") ;
                1157   if (dbad_nocommunication) {
                1158     dbad_file = NULL ;
                1159     printf("FIFO COMMUNICATION TURNED OFF !\n") ;
                1160   } else {
                1161     dbad_file = fopen("/tmp/DBAD_fifo", "r") ;
                1162     dbad_resetCondensors() ;
                1163     /* Convention on the meaning of labels:
                1164        -1 -> a debug point, skipped
                1165         0 -> a debug point, traced but no associated value.
                1166         1 -> a debug point, traced, with an associated value.
                1167        -2 -> a call, skipped
                1168         2 -> a call, traced
                1169     */
                1170     int ret=0 ;
                1171     int label ;
                1172     char placename[40] ;
                1173     double value ;
                1174     while (1) {
                1175       ret = fscanf(dbad_file, "%i\n", &label) ;
                1176       if (ret!=1) break ;
                1177       ret = fscanf(dbad_file, "%s\n", placename) ;
                1178       if (label==1) {
                1179         ret = fscanf(dbad_file, "%lf\n", &value) ;
                1180         dbad_pushReal8(value) ;
                1181       }
                1182       pushCharacterArray(placename, 40) ;
                1183       dbad_pushinteger4(label) ;
                1184     }
                1185   }
                1186 }
                1187
                1188 void adDebugFwd_call(char *funcname) {
                1189   int label ;
                1190   char funcnamefrom[40] ;
                1191   char funcnamehere[40] ;
                1192   // In the special debug^2 case, on the 2nd phase (tangent) of the debugAdj, with DBAD_PHASE=0,
                1193   // push the call frame but do essentially nothing!
                1194   if (dbad_debughere(0) && !(dbad_nocommunication && dbad_phase==2)) {
                1195     dbad_popinteger4(&label) ;
                1196     if (label!=2 && label!=-2) {
                1197       printf("Control mismatch, expecting a trace (-2or2) from %s bwd call exit, got %i\n",funcname,label) ;
                1198       exit(0) ;
                1199     }
                1200     popCharacterArray(funcnamefrom, 40) ;
                1201     sprintf(funcnamehere,"%s",funcname) ;
                1202     if (strcmp(funcnamefrom,funcnamehere)!=0) {
                1203       printf("Control mismatch, expecting a call to %s, got %s\n",funcnamehere,funcnamefrom) ;
                1204       exit(0) ;
                1205     }
                1206     dbad_pushCallFrame(funcname, 0, 0) ;
                1207     if (label==2) { // then the call is traced:
                1208       dbad_callStack->deltadepth += (dbad_calltracedepth-1) ;
                1209       dbad_calltracedepth = 1 ;
                1210     } else { // then label==-2: the call is not traced:
                1211       dbad_callStack->deltadepth += dbad_calltracedepth ;
                1212       dbad_calltracedepth = 0 ;
                1213     }
                1214   } else {
                1215     dbad_pushCallFrame(funcname, 0, 0) ;
                1216   }
                1217 }
                1218
                1219 void adDebugFwd_exit() {
                1220   dbad_popCallFrame() ;
                1221 }
                1222
                1223 int adDebugFwd_here(char* placename) {
                1224   // In the special debug^2 case, on the 2nd phase (tangent) of the debugAdj, with DBAD_PHASE=0,
                1225   // never go into the derivative manipulation body, except to st the inputs at the very "start"
                1226   // and to print the result at the very "end".
                1227   if (dbad_nocommunication && dbad_phase==2) {
                1228     if (strcmp(placename,"end")==0 || strcmp(placename,"start")==0)
                1229       return 1 ;
                1230     else
                1231       return 0 ;
                1232   } else {
                1233     if (dbad_debughere(0)) {
                1234       int label ;
                1235       char placenamefrom[40] ;
                1236       char placenamehere[40] ;
                1237       dbad_resetCondensors() ;
                1238       dbad_popinteger4(&label) ;
                1239       if (label!=1 && label!=-1 && label!=0) {
                1240         printf("Control mismatch, expecting a trace (-1or0or1) from place %s, got %i\n",placename,label) ;
                1241         exit(0) ;
                1242       }
                1243       popCharacterArray(placenamefrom, 40) ;
                1244       sprintf(placenamehere,"%s",placename) ;
                1245       if (strcmp(placenamefrom,placenamehere)!=0) {
                1246         printf("Control mismatch, expecting place %s, got %s\n",placenamehere,placenamefrom) ;
                1247         exit(0) ;
                1248       }
                1249       if (label==1) {
                1250         dbad_popReal8(&dbad_nextrefsum) ;
                1251       }
                1252       return label!=-1 ;
                1253     } else {
                1254       return 0 ;
                1255     }
                1256   }
                1257 }
                1258
                1259 //############## DEBUG OF ADJOINT, FOR BOTH SWEEPS: ################
                1260
                1261 void adDebugAdj_rwComplex16(cdcmplx *vard) {
                1262   double varbR = dbad_nextRandom() ;
                1263   double varbI = dbad_nextRandom() ;
                1264   dbad_condensed_adj += varbR*(vard->dr) + varbI*(vard->di) ;
                1265   vard->dr = varbR ;
                1266   vard->di = varbI ;
                1267 }
                1268
                1269 void adDebugAdj_rwReal8(double *vard) {
                1270   double varb = dbad_nextRandom() ;
                1271   dbad_condensed_adj += varb*(*vard) ;
                1272   *vard = varb ;
                1273 }
                1274
                1275 void adDebugAdj_rwReal4(float *vard) {
                1276   double varb = dbad_nextRandom() ;
                1277   dbad_condensed_adj += varb*(*vard) ;
                1278   *vard = (float)varb ;
                1279 }
                1280
                1281 void adDebugAdj_rComplex16(cdcmplx *vard) {
                1282   double varbR = dbad_nextRandom() ;
                1283   double varbI = dbad_nextRandom() ;
                1284   dbad_condensed_adj += varbR*(vard->dr) + varbI*(vard->di) ;
                1285 }
                1286
                1287 /** Although at present this routine doesn't modify its argument,
                1288  * we still expect a reference for consistency
                1289  * with adDebugAdj_wReal8() and also adDebugAdj_rComplex16() */
                1290 void adDebugAdj_rReal8(double *vard) {
                1291   double varb = dbad_nextRandom() ;
                1292   dbad_condensed_adj += varb*(*vard) ;
                1293 }
                1294
                1295 /** Although at present this routine doesn't modify its argument,
                1296  * we still expect a reference for consistency
                1297  * with adDebugAdj_wReal4() and also adDebugAdj_rComplex16() */
                1298 void adDebugAdj_rReal4(float *vard) {
                1299   double varb = dbad_nextRandom() ;
                1300   dbad_condensed_adj += varb*(*vard) ;
                1301 }
                1302
                1303 void adDebugAdj_wComplex16(cdcmplx *vard) {
                1304   vard->dr = dbad_nextRandom() ;
                1305   vard->di = dbad_nextRandom() ;
                1306 }
                1307
                1308 void adDebugAdj_wReal8(double *vard) {
                1309   *vard = dbad_nextRandom() ;
                1310 }
                1311
                1312 void adDebugAdj_wReal4(float *vard) {
                1313   *vard = (float)dbad_nextRandom() ;
                1314 }
                1315
                1316 void adDebugAdj_rwComplex16Array(cdcmplx *vard, int length) {
                1317   int i ;
                1318   if (vard)
                1319     for (i=0 ; i<length ; ++i)
                1320       adDebugAdj_rwComplex16(&(vard[i])) ;
                1321 }
                1322
                1323 void adDebugAdj_rwReal8Array(double *vard, int length) {
                1324   int i ;
                1325   if (vard)
                1326     for (i=0 ; i<length ; ++i)
                1327       adDebugAdj_rwReal8(&(vard[i])) ;
                1328 }
                1329
                1330 void adDebugAdj_rwReal4Array(float *vard, int length) {
                1331   int i ;
                1332   if (vard)
                1333     for (i=0 ; i<length ; ++i)
                1334       adDebugAdj_rwReal4(&(vard[i])) ;
                1335 }
                1336
                1337 void adDebugAdj_rComplex16Array(cdcmplx *vard, int length) {
                1338   int i ;
                1339   if (vard)
                1340     for (i=0 ; i<length ; ++i)
                1341       adDebugAdj_rComplex16(&(vard[i])) ;
                1342 }
                1343
                1344 void adDebugAdj_rReal8Array(double *vard, int length) {
                1345   int i ;
                1346   if (vard)
                1347     for (i=0 ; i<length ; ++i)
                1348       adDebugAdj_rReal8(&(vard[i])) ;
                1349 }
                1350
                1351 void adDebugAdj_rReal4Array(float *vard, int length) {
                1352   int i ;
                1353   if (vard)
                1354     for (i=0 ; i<length ; ++i)
                1355       adDebugAdj_rReal4(&(vard[i])) ;
                1356 }
                1357
                1358 void adDebugAdj_wComplex16Array(cdcmplx *vard, int length) {
                1359   int i ;
                1360   if (vard)
                1361     for (i=0 ; i<length ; ++i)
                1362       adDebugAdj_wComplex16(&(vard[i])) ;
                1363 }
                1364
                1365 void adDebugAdj_wReal8Array(double *vard, int length) {
                1366   int i ;
                1367   if (vard)
                1368     for (i=0 ; i<length ; ++i)
                1369       adDebugAdj_wReal8(&(vard[i])) ;
                1370 }
                1371
                1372 void adDebugAdj_wReal4Array(float *vard, int length) {
                1373   int i ;
                1374   if (vard)
                1375     for (i=0 ; i<length ; ++i)
                1376       adDebugAdj_wReal4(&(vard[i])) ;
                1377 }
                1378
                1379 void adDebugAdj_rwDisplay(char *placename, int indent) {
                1380   adDebugAdj_rDisplay(placename, indent) ;
                1381   if (dbad_phase==2)
                1382     dbad_refsum = dbad_nextrefsum ;
                1383 }
                1384
                1385 void adDebugAdj_rDisplay(char *placename, int indent) {
                1386   if (dbad_phase==1) {
                1387     if (dbad_nocommunication) {
                1388       printf("adDebug would send (1 %s %24.16e)\n", placename, dbad_condensed_adj) ;
                1389     } else {
                1390       fprintf(dbad_file, "1\n") ;
                1391       fprintf(dbad_file, "%s\n", placename) ;
                1392       fprintf(dbad_file, "%24.16e\n", dbad_condensed_adj) ;
                1393     }
                1394   } else if (dbad_phase==2) {
                1395     // In the special debug^2 case, on the 2nd phase (tangent) of the debugAdj, with DBAD_PHASE=0,
                1396     // adDebugAdj_wdisplay is called ony on the "end" location. Print the tangent result:
                1397     if (dbad_nocommunication) {
                1398       printf("Condensed tangent result is %24.16e\n", dbad_condensed_adj) ;
                1399     } else {
                1400       double absref = (dbad_refsum>=0.0?dbad_refsum:-dbad_refsum) ;
                1401       double absadj = (dbad_condensed_adj>=0.0?dbad_condensed_adj:-dbad_condensed_adj) ;
                1402       double absdiff = dbad_refsum - dbad_condensed_adj ;
                1403       if (absdiff<0.0) absdiff = -absdiff ;
                1404       double reldiff = (absdiff*200.0)/(absref+absadj) ;
                1405       if (reldiff>dbad_errormax) {
                1406         printf("                         %5.1f%% DIFFERENCE!!  tgt:%24.16e  adj:%24.16e\n",
                1407                reldiff, dbad_condensed_adj, dbad_refsum) ;
                1408         ++dbad_nberrors ;
                1409       } else if (strcmp(placename,"end")==0 && dbad_nberrors==0) {
                1410         // When we are at end and no errors were found, always show the compared values
                1411         printf("                         difference is just %7.3f% between tgt:%24.16e and adj:%24.16e\n",
                1412                reldiff, dbad_condensed_adj, dbad_refsum) ;
                1413       }
                1414       if (indent==0) dbad_display_location(placename) ;
                1415     }
                1416   }
                1417   dbad_resetCondensors() ;
                1418 }
                1419
                1420 void adDebugAdj_wDisplay(char *placename, int indent) {
                1421   if (dbad_phase==1) {
                1422     if (dbad_nocommunication) {
                1423       printf("adDebug would send (0 %s)\n", placename) ;
                1424     } else {
                1425       fprintf(dbad_file, "0\n") ;
                1426       fprintf(dbad_file, "%s\n", placename) ;
                1427     }
                1428   } else if (dbad_phase==2) {
                1429     if (indent==0) dbad_display_location(placename) ;
                1430     dbad_refsum = dbad_nextrefsum ;
                1431   }
                1432   dbad_resetCondensors() ;
                1433 }
                1434
                1435 void adDebugAdj_skip(char *placename) {
                1436   if (dbad_phase==1 && dbad_debughere(0)) {
                1437     if (dbad_nocommunication) {
                1438       printf("adDebug would send (-1 %s)\n", placename) ;
                1439     } else {
                1440       fprintf(dbad_file, "-1\n") ;
                1441       fprintf(dbad_file, "%s\n", placename) ;
                1442     }
                1443   }
                1444 }
                1445
                1446 void adDebugAdj_conclude() {
                1447   if (dbad_phase==2) {
                1448     if (!dbad_nocommunication) {
                1449       // In the special debug^2 case, on the 2nd phase (tangent) of the debugAdj, with DBAD_PHASE=0,
                1450       // don't claim that any testing has been done!! but show the expected condensed tangent:
                1451       printf("End of ADJ test, %i error(s) found.\n", dbad_nberrors) ;
                1452       printf("===========================================================\n") ;
                1453     }
                1454   }
                1455 }
                1456
                1457 /* void adDebugAdj_show() { */
                1458 /*   printf("Present sum %24.16e, current seed is %f (%f)\n", dbad_condensed_adj, dbad_currentSeed, dbad_seed) ; */
                1459 /* } */
                1460
                1461 //############## INTERFACE PROCEDURES CALLED FROM FORTRAN ################
                1462
                1463 void addebugtgt_init_(double *epsilon, double *seed, int *tested_process) {
                1464   adDebugTgt_init(*epsilon, *seed, *tested_process) ;
                1465 }
                1466
                1467 void addebugtgt_call_(char* unitname, int *deltadepth, int *forcetraced) {
                1468   adDebugTgt_call(unitname, *deltadepth, *forcetraced) ;
                1469 }
                1470
                1471 void addebugtgt_exit_() {
                1472   adDebugTgt_exit() ;
                1473 }
                1474
                1475 int addebugtgt_here_(char* placename, int *forcetraced) {
                1476   return adDebugTgt_here(placename, *forcetraced) ;
                1477 }
                1478
                1479 void addebugtgt_initcomplex16_(char* varname, cdcmplx *indep, cdcmplx *indepd) {
                1480   adDebugTgt_initComplex16(varname, indep, indepd) ;
                1481 }
                1482
                1483 void addebugtgt_initreal8_(char* varname, double *indep, double *indepd) {
                1484   adDebugTgt_initReal8(varname, indep, indepd) ;
                1485 }
                1486
                1487 void addebugtgt_initreal4_(char* varname, float *indep, float *indepd) {
                1488   adDebugTgt_initReal4(varname, indep, indepd) ;
                1489 }
                1490
                1491 void addebugtgt_initcomplex16array_(char* varname, cdcmplx *indep, cdcmplx *indepd, int *length) {
                1492   adDebugTgt_initComplex16Array(varname, indep, indepd, *length) ;
                1493 }
                1494
                1495 void addebugtgt_initreal8array_(char* varname, double *indep, double *indepd, int *length) {
                1496   adDebugTgt_initReal8Array(varname, indep, indepd, *length) ;
                1497 }
                1498
                1499 void addebugtgt_initreal4array_(char* varname, float *indep, float *indepd, int *length) {
                1500   adDebugTgt_initReal4Array(varname, indep, indepd, *length) ;
                1501 }
                1502
                1503 void addebugtgt_passivecomplex16_(char *varname, cdcmplx *var) {
                1504   adDebugTgt_passiveComplex16(varname, *var) ;
                1505 }
                1506
                1507 void addebugtgt_passivereal8_(char *varname, double *var) {
                1508   adDebugTgt_passiveReal8(varname, *var) ;
                1509 }
                1510
                1511 void addebugtgt_passivereal4_(char *varname, float *var) {
                1512   adDebugTgt_passiveReal4(varname, *var) ;
                1513 }
                1514
                1515 void addebugtgt_passivecomplex16array_(char *varname, cdcmplx *var, int *length) {
                1516   adDebugTgt_passiveComplex16Array(varname, var, *length) ;
                1517 }
                1518
                1519 void addebugtgt_passivereal8array_(char *varname, double *var, int *length) {
                1520   adDebugTgt_passiveReal8Array(varname, var, *length) ;
                1521 }
                1522
                1523 void addebugtgt_passivereal4array_(char *varname, float *var, int *length) {
                1524   adDebugTgt_passiveReal4Array(varname, var, *length) ;
                1525 }
                1526
                1527 void addebugtgt_testcomplex16_(char *varname, cdcmplx *var, cdcmplx *vard) {
                1528   adDebugTgt_testComplex16(varname, *var, vard) ;
                1529 }
                1530
                1531 void addebugtgt_testreal8_(char *varname, double *var, double *vard) {
                1532   adDebugTgt_testReal8(varname, *var, vard) ;
                1533 }
                1534
                1535 void addebugtgt_testreal4_(char *varname, float *var, float *vard) {
                1536   adDebugTgt_testReal4(varname, *var, vard) ;
                1537 }
                1538
                1539 void addebugtgt_testcomplex16array_(char *varname, cdcmplx* var, cdcmplx* vard, int *length) {
                1540   adDebugTgt_testComplex16Array(varname, var, vard, *length) ;
                1541 }
                1542
                1543 void addebugtgt_testreal8array_(char *varname, double* var, double* vard, int *length) {
                1544   adDebugTgt_testReal8Array(varname, var, vard, *length) ;
                1545 }
                1546
                1547 void addebugtgt_testreal4array_(char *varname, float* var, float* vard, int *length) {
                1548   adDebugTgt_testReal4Array(varname, var, vard, *length) ;
                1549 }
                1550
                1551 void addebugtgt_concludecomplex16_(char* varname, cdcmplx *dep, cdcmplx *depd) {
                1552   adDebugTgt_concludeComplex16(varname, *dep, depd) ;
                1553 }
                1554
                1555 void addebugtgt_concludereal8_(char* varname, double *dep, double *depd) {
                1556   adDebugTgt_concludeReal8(varname, *dep, depd) ;
                1557 }
                1558
                1559 void addebugtgt_concludereal4_(char* varname, float *dep, float *depd) {
                1560   adDebugTgt_concludeReal4(varname, *dep, depd) ;
                1561 }
                1562
                1563 void addebugtgt_concludecomplex16array_(char* varname, cdcmplx *dep, cdcmplx *depd, int *length) {
                1564   adDebugTgt_concludeComplex16Array(varname, dep, depd, *length) ;
                1565 }
                1566
                1567 void addebugtgt_concludereal8array_(char* varname, double *dep, double *depd, int *length) {
                1568   adDebugTgt_concludeReal8Array(varname, dep, depd, *length) ;
                1569 }
                1570
                1571 void addebugtgt_concludereal4array_(char* varname, float *dep, float *depd, int *length) {
                1572   adDebugTgt_concludeReal4Array(varname, dep, depd, *length) ;
                1573 }
                1574
                1575 void addebugtgt_conclude_() {
                1576   adDebugTgt_conclude() ;
                1577 }
                1578
                1579 void addebugtgt_display_(char *placename) {
                1580   adDebugTgt_display(placename) ;
                1581 }
                1582
                1583 void addebugbwd_init_(double *errmax, double *seed) {
                1584   adDebugBwd_init(*errmax, *seed) ;
                1585 }
                1586
                1587 void addebugbwd_call_(char *funcname, int *deltadepth) {
                1588   adDebugBwd_call(funcname, *deltadepth) ;
                1589 }
                1590
                1591 void addebugbwd_exit_() {
                1592   adDebugBwd_exit() ;
                1593 }
                1594
                1595 int addebugbwd_here_(char* placename) {
                1596   return adDebugBwd_here(placename) ;
                1597 }
                1598
                1599 void addebugfwd_init_(double *errmax, double *seed) {
                1600   adDebugFwd_init(*errmax, *seed) ;
                1601 }
                1602
                1603 void addebugfwd_call_(char *funcname) {
                1604   adDebugFwd_call(funcname) ;
                1605 }
                1606
                1607 void addebugfwd_exit_() {
                1608   adDebugFwd_exit() ;
                1609 }
                1610
                1611 int addebugfwd_here_(char* placename) {
                1612   return adDebugFwd_here(placename) ;
                1613 }
                1614
                1615 void addebugadj_rwreal4_(float *vard) {
                1616   adDebugAdj_rwReal4(vard) ;
                1617 }
                1618
                1619 void addebugadj_rwreal8_(double *vard) {
                1620   adDebugAdj_rwReal8(vard) ;
                1621 }
                1622
                1623 void addebugadj_rwcomplex16_(cdcmplx *vard) {
                1624   adDebugAdj_rwComplex16(vard) ;
                1625 }
                1626
                1627 void addebugadj_rreal4_(float *vard) {
                1628   adDebugAdj_rReal4(vard) ;
                1629 }
                1630
                1631 void addebugadj_rreal8_(double *vard) {
                1632   adDebugAdj_rReal8(vard) ;
                1633 }
                1634
                1635 void addebugadj_rcomplex16_(cdcmplx *vard) {
                1636   adDebugAdj_rComplex16(vard) ;
                1637 }
                1638
                1639 void addebugadj_wreal4_(float *vard) {
                1640   adDebugAdj_wReal4(vard) ;
                1641 }
                1642
                1643 void addebugadj_wreal8_(double *vard) {
                1644   adDebugAdj_wReal8(vard) ;
                1645 }
                1646
                1647 void addebugadj_wcomplex16_(cdcmplx *vard) {
                1648   adDebugAdj_wComplex16(vard) ;
                1649 }
                1650
                1651 void addebugadj_rwreal4array_(float *vard, int *length) {
                1652   adDebugAdj_rwReal4Array(vard, *length) ;
                1653 }
                1654
                1655 void addebugadj_rwreal8array_(double *vard, int *length) {
                1656   adDebugAdj_rwReal8Array(vard, *length) ;
                1657 }
                1658
                1659 void addebugadj_rwcomplex16array_(cdcmplx *vard, int *length) {
                1660   adDebugAdj_rwComplex16Array(vard, *length) ;
                1661 }
                1662
                1663 void addebugadj_rreal4array_(float *vard, int *length) {
                1664   adDebugAdj_rReal4Array(vard, *length) ;
                1665 }
                1666
                1667 void addebugadj_rreal8array_(double *vard, int *length) {
                1668   adDebugAdj_rReal8Array(vard, *length) ;
                1669 }
                1670
                1671 void addebugadj_rcomplex16array_(cdcmplx *vard, int *length) {
                1672   adDebugAdj_rComplex16Array(vard, *length) ;
                1673 }
                1674
                1675 void addebugadj_wreal4array_(float *vard, int *length) {
                1676   adDebugAdj_wReal4Array(vard, *length) ;
                1677 }
                1678
                1679 void addebugadj_wreal8array_(double *vard, int *length) {
                1680   adDebugAdj_wReal8Array(vard, *length) ;
                1681 }
                1682
                1683 void addebugadj_wcomplex16array_(cdcmplx *vard, int *length) {
                1684   adDebugAdj_wComplex16Array(vard, *length) ;
                1685 }
                1686
                1687 void addebugadj_rwdisplay_(char *placename, int *indent) {
                1688   adDebugAdj_rwDisplay(placename, *indent) ;
                1689 }
                1690
                1691 void addebugadj_rdisplay_(char *placename, int *indent) {
                1692   adDebugAdj_rDisplay(placename, *indent) ;
                1693 }
                1694
                1695 void addebugadj_wdisplay_(char *placename, int *indent) {
                1696   adDebugAdj_wDisplay(placename, *indent) ;
                1697 }
                1698
                1699 void addebugadj_skip_(char* placename) {
                1700   adDebugAdj_skip(placename) ;
                1701 }
                1702
                1703 void addebugadj_conclude_() {
                1704   adDebugAdj_conclude() ;
                1705 }