Back to home page

MITgcm

 
 

    


File indexing completed on 2023-05-28 05:10:55 UTC

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