1 /*----------------------------------------------------------------------------
2 ADOL-C -- Automatic Differentiation by Overloading in C++
3 File: tapedoc/tapedoc.c
4 Revision: $Id: tapedoc.c 762 2018-12-18 15:36:05Z mbanovic $
5 Contents: Routine tape_doc(..) writes the taped operations in LaTeX-code
6 to the file tape_doc.tex
7
8 Copyright (c) Andrea Walther, Andreas Griewank, Andreas Kowarz,
9 Hristo Mitev, Sebastian Schlenkrich, Jean Utke, Olaf Vogel
10
11 This file is part of ADOL-C. This software is provided as open source.
12 Any use, reproduction, or distribution of the software constitutes
13 recipient's acceptance of the terms of the accompanying license file.
14
15 ----------------------------------------------------------------------------*/
16
17 #include <adolc/tapedoc/tapedoc.h>
18 #include "oplate.h"
19 #include "taping_p.h"
20 #include <adolc/adalloc.h>
21 #include "dvlparms.h"
22
23 #include <math.h>
24 #include <string.h>
25
26 #ifdef ADOLC_AMPI_SUPPORT
27 #include "ampi/ampi.h"
28 #include "ampi/tape/support.h"
29 #endif
30
31 BEGIN_C_DECLS
32
33 /****************************************************************************/
34 /* STATIC VARIABLES */
35
36 /*--------------------------------------------------------------------------*/
37 static short tag;
38
39 static int op_cnt;
40 static int rev_op_cnt;
41 static int pagelength;
42 static FILE *fp;
43
44 static char baseName[]="tape_";
45 static char extension[]=".tex";
46
47 /****************************************************************************/
48 /* LOCAL WRITE ROUTINES */
49
50 /*--------------------------------------------------------------------------*/
filewrite_start(int opcode)51 void filewrite_start( int opcode ) {
52 char *fileName;
53 int num;
54
55 fileName=(char *)malloc(sizeof(char)*(9+sizeof(tag)*8+2));
56 if (fileName==NULL) fail(ADOLC_MALLOC_FAILED);
57 strncpy(fileName, baseName, strlen(baseName));
58 num=sprintf(fileName+strlen(baseName), "%d", tag);
59 strncpy(fileName+strlen(baseName)+num, extension, strlen(extension));
60 fileName[strlen(baseName)+num+strlen(extension)]=0;
61 if ((fp = fopen(fileName,"w")) == NULL) {
62 fprintf(DIAG_OUT,"cannot open file !\n");
63 adolc_exit(1,"",__func__,__FILE__,__LINE__);
64 }
65 free((void*)fileName);
66 fprintf(fp,"\\documentclass{article}\n");
67 fprintf(fp,"\\headheight0cm\n");
68 fprintf(fp,"\\headsep-1cm\n");
69 fprintf(fp,"\\textheight25cm\n");
70 fprintf(fp,"\\oddsidemargin-1cm\n");
71 fprintf(fp,"\\topmargin0cm\n");
72 fprintf(fp,"\\textwidth18cm\n");
73 fprintf(fp,"\\begin{document}\n");
74 fprintf(fp,"\\tiny\n");
75 #ifdef ADOLC_TAPE_DOC_VALUES
76 fprintf(fp,"\\begin{tabular}{|r|r|r|l|r|r|r|r||r|r||r|r|r|r|} \\hline \n");
77 fprintf(fp," & & code & op & loc & loc & loc & loc & double & double & value & value & value & value \\\\ \\hline \n");
78 fprintf(fp," & & %i & start of tape & & & & & & & & & & \\\\ \\hline \n",opcode);
79 #else
80 fprintf(fp,"\\begin{tabular}{|r|r|r|l|r|r|r|r||r|r|} \\hline \n");
81 fprintf(fp," & & code & op & loc & loc & loc & loc & double & double \\\\ \\hline \n");
82 fprintf(fp," & & %i & start of tape & & & & & & \\\\ \\hline \n",opcode);
83 #endif
84 pagelength = 0;
85 }
86
checkPageBreak()87 void checkPageBreak() {
88 if (pagelength == 100) { /* 101 lines per page */
89 fprintf(fp,"\\end{tabular}\\\\\n");
90 fprintf(fp,"\\newpage\n");
91 #ifdef ADOLC_TAPE_DOC_VALUES
92 fprintf(fp,"\\begin{tabular}{|r|r|r|l|r|r|r|r||r|r||r|r|r|r|} \\hline \n");
93 fprintf(fp," & & code & op & loc & loc & loc & loc & double & double & value & value & value & value \\\\ \\hline \n");
94 #else
95 fprintf(fp,"\\begin{tabular}{|r|r|r|l|r|r|r|r||r|r|} \\hline \n");
96 fprintf(fp," & & code & op & loc & loc & loc & loc & double & double \\\\ \\hline \n");
97 #endif
98 pagelength=-1;
99 }
100 }
101
102 /****************************************************************************/
103 /* filewrite( opcode number, op name, number locations, locations, values, */
104 /* number constants, constants ) */
105 /****************************************************************************/
filewrite(unsigned short opcode,const char * opString,int nloc,int * loc,double * val,int ncst,double * cst)106 void filewrite( unsigned short opcode, const char* opString, int nloc, int *loc,
107 double *val,int ncst, double* cst) {
108 int i;
109
110 checkPageBreak();
111
112 /* write opcode counters and number */
113 fprintf(fp,"%i & %i & %i & ",op_cnt, rev_op_cnt, opcode);
114
115 /* write opcode name if available */
116 if (opString) fprintf(fp,"%s",opString);
117
118 /* write locations (max 4) right-justified */
119 fprintf(fp," &");
120 if (opcode==ext_diff || opcode==ext_diff_iArr || opcode==ext_diff_v2)
121 opcode = ext_diff;
122 if (opcode!=ext_diff) { /* default */
123 for(i=0; i<(4-nloc); i++)
124 fprintf(fp," &");
125 for(i=0; i<nloc; i++)
126 fprintf(fp," %i &",loc[i]);
127 } else { /* ext_diff */
128 fprintf(fp," fctn %i &",loc[0]);
129 for(i=1; i<(4-nloc); i++)
130 fprintf(fp," &");
131 for(i=1; i<nloc; i++)
132 fprintf(fp," %i &",loc[i]);
133 }
134
135 /* write values */
136 #ifdef ADOLC_TAPE_DOC_VALUES /* values + constants */
137 /* constants (max 2) */
138 if (opcode==ext_diff || opcode == vec_copy)
139 nloc=0;
140 if (opcode == vec_dot || opcode == vec_axpy)
141 nloc=1;
142 for(i=0; i<(2-ncst); i++)
143 fprintf(fp," &");
144 for(i=0; i<ncst; i++)
145 fprintf(fp,"$ %e $&",cst[i]);
146 /* values (max 4) */
147 if (nloc) {
148 for(i=0; i<(4-nloc); i++)
149 fprintf(fp," &");
150 for(i=0; i<nloc-1; i++)
151 fprintf(fp,"$ %e $&",val[i]);
152 fprintf(fp,"$ %e $",val[nloc-1]);
153 } else {
154 for(i=0; i<3; i++)
155 fprintf(fp," &");
156 fprintf(fp," ");
157 }
158 #else /* constants only */
159 /* constants (max 2) */
160 if (ncst) {
161 for(i=0; i<(2-ncst); i++)
162 fprintf(fp," &");
163 for(i=0; i<ncst-1; i++)
164 fprintf(fp,"$ %e $ &",cst[i]);
165 fprintf(fp,"$ %e $",cst[ncst-1]);
166 } else {
167 fprintf(fp," &");
168 fprintf(fp," ");
169 }
170 #endif
171
172 fprintf(fp,"\\\\ \\hline \n"); /* end line */
173 fflush(fp);
174 pagelength++;
175 }
176
177 #ifdef ADOLC_AMPI_SUPPORT
178 /****************************************************************************/
179 /* filewrite_ampi( opcode number, op name, number locations, locations ) */
180 /****************************************************************************/
filewrite_ampi(unsigned short opcode,const char * opString,int nloc,int * loc)181 void filewrite_ampi( unsigned short opcode, const char* opString, int nloc, int *loc) {
182 int i;
183
184 checkPageBreak();
185
186 /* write opcode counters and number */
187 fprintf(fp,"%i & %i & %i & ",op_cnt, rev_op_cnt, opcode);
188
189 /* write opcode name if available */
190 if (opString) fprintf(fp,"%s",opString);
191
192 #ifdef ADOLC_TAPE_DOC_VALUES /* values + constants */
193 fprintf(fp," & \\multicolumn{10}{|l|}{");
194 #else
195 fprintf(fp," & \\multicolumn{6}{|l|}{(");
196 #endif
197 for(i=0; i<(nloc-1); i++) fprintf(fp," %i, ",loc[i]);
198 if (nloc) fprintf(fp," %i",loc[nloc-1]);
199 fprintf(fp,")} ");
200 fprintf(fp,"\\\\ \\hline \n"); /* end line */
201 fflush(fp);
202 pagelength++;
203 }
204 #endif
205
206 /*--------------------------------------------------------------------------*/
filewrite_end(int opcode)207 void filewrite_end( int opcode ) {
208 #ifdef ADOLC_TAPE_DOC_VALUES
209 fprintf(fp," %i & %i & %i & end of tape & & & & & & & & & & \\\\ \\hline \n",op_cnt,rev_op_cnt, opcode);
210 #else
211 fprintf(fp," %i & %i & %i & end of tape & & & & & & \\\\ \\hline \n",op_cnt,rev_op_cnt,opcode);
212 #endif
213 fprintf(fp,"\\end{tabular}");
214 fprintf(fp,"\\end{document}");
215 fclose(fp);
216 }
217
218
219 /****************************************************************************/
220 /* NOW THE CODE */
tape_doc(short tnum,int depcheck,int indcheck,double * basepoint,double * valuepoint)221 void tape_doc(short tnum, /* tape id */
222 int depcheck, /* consistency chk on # of dependents */
223 int indcheck, /* consistency chk on # of independents */
224 double *basepoint, /* independent variable values */
225 double *valuepoint) /* dependent variable values */
226 {
227 /****************************************************************************/
228 /* ALL VARIABLES */
229 unsigned char operation;
230
231 locint size = 0;
232 locint res = 0;
233 locint arg = 0;
234 locint arg1 = 0;
235 locint arg2 = 0;
236
237 double coval = 0, *d = 0;
238
239 int indexi = 0, indexd = 0;
240
241 /* loop indices */
242 int l;
243
244 /* Taylor stuff */
245 double *dp_T0;
246
247 /* interface temporaries */
248 int loc_a[maxLocsPerOp];
249 double val_a[4]={0,0,0,0}, cst_d[2]={0,0};
250 const char* opName;
251 #ifdef ADOLC_TAPE_DOC_VALUES
252 locint qq;
253 #endif
254 ADOLC_OPENMP_THREAD_NUMBER;
255 ADOLC_OPENMP_GET_THREAD_NUMBER;
256
257 /****************************************************************************/
258 /* INITs */
259 #ifdef ADOLC_AMPI_SUPPORT
260 MPI_Datatype anMPI_Datatype;
261 MPI_Comm anMPI_Comm;
262 MPI_Request anMPI_Request;
263 MPI_Op anMPI_Op;
264 int i;
265 double aDouble;
266 #endif
267 init_for_sweep(tnum);
268 tag = tnum;
269
270 if ((depcheck != ADOLC_CURRENT_TAPE_INFOS.stats[NUM_DEPENDENTS]) ||
271 (indcheck != ADOLC_CURRENT_TAPE_INFOS.stats[NUM_INDEPENDENTS]) ) {
272 fprintf(DIAG_OUT,"ADOL-C error: Tape_doc on tape %d aborted!\n",tag);
273 fprintf(DIAG_OUT,"Number of dependent (%d) and/or independent (%d) "
274 "variables passed to Tape_doc is\ninconsistent with "
275 "number recorded on tape %d (%zu:%zu)\n", depcheck,
276 indcheck, tag, ADOLC_CURRENT_TAPE_INFOS.stats[NUM_DEPENDENTS],
277 ADOLC_CURRENT_TAPE_INFOS.stats[NUM_INDEPENDENTS]);
278 adolc_exit(-1,"",__func__,__FILE__,__LINE__);
279 }
280
281 /* globals */
282 op_cnt=0;
283 rev_op_cnt=ADOLC_CURRENT_TAPE_INFOS.stats[NUM_OPERATIONS]+1;
284
285 dp_T0 = myalloc1(ADOLC_CURRENT_TAPE_INFOS.stats[NUM_MAX_LIVES]);
286
287 operation=get_op_f();
288 ++op_cnt;
289 --rev_op_cnt;
290 while (operation !=end_of_tape) {
291 switch (operation) {
292
293 /****************************************************************************/
294 /* MARKERS */
295
296 /*--------------------------------------------------------------------------*/
297 case end_of_op: /* end_of_op */
298 filewrite(operation,"end of op",0,loc_a,val_a,0,cst_d);
299 get_op_block_f();
300 operation=get_op_f();
301 ++op_cnt;
302 --rev_op_cnt;
303 /* Skip next operation, it's another end_of_op */
304 break;
305
306 /*--------------------------------------------------------------------------*/
307 case end_of_int: /* end_of_int */
308 filewrite(operation,"end of int",0,loc_a,val_a,0,cst_d);
309 get_loc_block_f();
310 break;
311
312 /*--------------------------------------------------------------------------*/
313 case end_of_val: /* end_of_val */
314 filewrite(operation,"end of val",0,loc_a,val_a,0,cst_d);
315 get_val_block_f();
316 break;
317
318 /*--------------------------------------------------------------------------*/
319 case start_of_tape: /* start_of_tape */
320 filewrite_start(operation);
321 break;
322
323 /*--------------------------------------------------------------------------*/
324 case end_of_tape: /* end_of_tape */
325 break;
326
327
328 /****************************************************************************/
329 /* COMPARISON */
330
331 /*--------------------------------------------------------------------------*/
332 case eq_zero : /* eq_zero */
333 arg = get_locint_f();
334 loc_a[0] = arg;
335 #ifdef ADOLC_TAPE_DOC_VALUES
336 val_a[0] = dp_T0[arg];
337 #endif
338 filewrite(operation,"eq zero",1,loc_a,val_a,0,cst_d);
339 break;
340 case neq_zero : /* neq_zero */
341 arg = get_locint_f();
342 loc_a[0] = arg;
343 #ifdef ADOLC_TAPE_DOC_VALUES
344 val_a[0] = dp_T0[arg];
345 #endif
346 filewrite(operation,"neq zero",1,loc_a,val_a,0,cst_d);
347 break;
348 case le_zero : /* le_zero */
349 arg = get_locint_f();
350 loc_a[0] = arg;
351 #ifdef ADOLC_TAPE_DOC_VALUES
352 val_a[0] = dp_T0[arg];
353 #endif
354 filewrite(operation,"le zero",1,loc_a,val_a,0,cst_d);
355 break;
356 case gt_zero : /* gt_zero */
357 arg = get_locint_f();
358 loc_a[0] = arg;
359 #ifdef ADOLC_TAPE_DOC_VALUES
360 val_a[0] = dp_T0[arg];
361 #endif
362 filewrite(operation,"gt zero",1,loc_a,val_a,0,cst_d);
363 break;
364 case ge_zero : /* ge_zero */
365 arg = get_locint_f();
366 loc_a[0] = arg;
367 #ifdef ADOLC_TAPE_DOC_VALUES
368 val_a[0] = dp_T0[arg];
369 #endif
370 filewrite(operation,"ge zero",1,loc_a,val_a,0,cst_d);
371 break;
372 case lt_zero : /* lt_zero */
373 arg = get_locint_f();
374 loc_a[0] = arg;
375 #ifdef ADOLC_TAPE_DOC_VALUES
376 val_a[0] = dp_T0[arg];
377 #endif
378 filewrite(operation,"lt zero",1,loc_a,val_a,0,cst_d);
379 break;
380
381
382 /****************************************************************************/
383 /* ASSIGNMENTS */
384
385 /*--------------------------------------------------------------------------*/
386 case assign_a: /* assign an adouble variable an assign_a */
387 /* adouble value. (=) */
388 arg = get_locint_f();
389 res = get_locint_f();
390 loc_a[0]=arg;
391 loc_a[1]=res;
392 #ifdef ADOLC_TAPE_DOC_VALUES
393 val_a[0]=dp_T0[arg];
394 dp_T0[res]= dp_T0[arg];
395 val_a[1]=dp_T0[res];
396 #endif
397 filewrite(operation,"assign a",2,loc_a,val_a,0,cst_d);
398 break;
399
400 /*--------------------------------------------------------------------------*/
401 case assign_d: /* assign an adouble variable a assign_d */
402 /* double value. (=) */
403 res = get_locint_f();
404 cst_d[0]=get_val_f();
405 loc_a[0]=res;
406 #ifdef ADOLC_TAPE_DOC_VALUES
407 dp_T0[res]= cst_d[0];
408 val_a[0]=dp_T0[res];
409 #endif
410 filewrite(operation,"assigne d",1,loc_a,val_a,1,cst_d);
411 break;
412
413 /*--------------------------------------------------------------------------*/
414 case assign_d_one: /* assign an adouble variable a assign_d_one */
415 /* double value. (1) (=) */
416 res = get_locint_f();
417 loc_a[0]=res;
418 #ifdef ADOLC_TAPE_DOC_VALUES
419 dp_T0[res]= 1.0;
420 val_a[0]=dp_T0[res];
421 #endif
422 filewrite(operation,"assign d one",1,loc_a,val_a,0,cst_d);
423 break;
424
425 /*--------------------------------------------------------------------------*/
426 case assign_d_zero: /* assign an adouble variable a assign_d_zero */
427 /* double value. (0) (=) */
428 res = get_locint_f();
429 loc_a[0]=res;
430 #ifdef ADOLC_TAPE_DOC_VALUES
431 dp_T0[res]= 0.0;
432 val_a[0]=dp_T0[res];
433 #endif
434 filewrite(operation,"assign d zero",1,loc_a,val_a,0,cst_d);
435 break;
436
437 /*--------------------------------------------------------------------------*/
438 case assign_ind: /* assign an adouble variable an assign_ind */
439 /* independent double value (<<=) */
440 res = get_locint_f();
441 loc_a[0]=res;
442 #ifdef ADOLC_TAPE_DOC_VALUES
443 dp_T0[res]= basepoint[indexi];
444 cst_d[0]= basepoint[indexi];
445 val_a[0]=dp_T0[res];
446 filewrite(operation,"assign ind",1,loc_a,val_a,1,cst_d);
447 #else
448 filewrite(operation,"assign ind",1,loc_a,val_a,0,cst_d);
449 #endif
450 indexi++;
451 break;
452
453 /*--------------------------------------------------------------------------*/
454 case assign_dep: /* assign a float variable a assign_dep */
455 /* dependent adouble value. (>>=) */
456 res = get_locint_f();
457 loc_a[0]=res;
458 #ifdef ADOLC_TAPE_DOC_VALUES
459 val_a[0]=dp_T0[res];
460 valuepoint[indexd++]=dp_T0[res];
461 #endif
462 filewrite(operation,"assign dep",1,loc_a,val_a,0,cst_d);
463 break;
464
465
466 /****************************************************************************/
467 /* OPERATION + ASSIGNMENT */
468
469 /*--------------------------------------------------------------------------*/
470 case eq_plus_d: /* Add a floating point to an eq_plus_d */
471 /* adouble. (+=) */
472 res = get_locint_f();
473 coval = get_val_f();
474 loc_a[0] = res;
475 cst_d[0] = coval;
476 #ifdef ADOLC_TAPE_DOC_VALUES
477 dp_T0[res] += coval;
478 val_a[0] = dp_T0[res];
479 #endif
480 filewrite(operation,"eq plus d",1,loc_a,val_a,1,cst_d);
481 break;
482
483 /*--------------------------------------------------------------------------*/
484 case eq_plus_a: /* Add an adouble to another eq_plus_a */
485 /* adouble. (+=) */
486 arg = get_locint_f();
487 res = get_locint_f();
488 loc_a[0]=arg;
489 loc_a[1]=res;
490 #ifdef ADOLC_TAPE_DOC_VALUES
491 val_a[0]=dp_T0[arg];
492 dp_T0[res]+= dp_T0[arg];
493 val_a[1]=dp_T0[res];
494 #endif
495 filewrite(operation,"eq plus a",2,loc_a,val_a,0,cst_d);
496 break;
497
498 /*--------------------------------------------------------------------------*/
499 case eq_plus_prod: /* Add an product to an eq_plus_prod */
500 /* adouble. (+= x1*x2) */
501 arg1 = get_locint_f();
502 arg2 = get_locint_f();
503 res = get_locint_f();
504 loc_a[0]=arg1;
505 loc_a[1]=arg2;
506 loc_a[2]=res;
507 #ifdef ADOLC_TAPE_DOC_VALUES
508 val_a[0]=dp_T0[arg1];
509 val_a[1]=dp_T0[arg2];
510 dp_T0[res] += dp_T0[arg1]*dp_T0[arg2];
511 val_a[2]=dp_T0[res];
512 #endif
513 filewrite(operation,"eq plus prod",3,loc_a,val_a,0,cst_d);
514 break;
515
516 /*--------------------------------------------------------------------------*/
517 case eq_min_d: /* Subtract a floating point from an eq_min_d */
518 /* adouble. (-=) */
519 res = get_locint_f();
520 coval = get_val_f();
521 loc_a[0] = res;
522 cst_d[0] = coval;
523 #ifdef ADOLC_TAPE_DOC_VALUES
524 dp_T0[res] -= coval;
525 val_a[0] = dp_T0[res];
526 #endif
527 filewrite(operation,"eq min d",1,loc_a,val_a,1,cst_d);
528 break;
529
530 /*--------------------------------------------------------------------------*/
531 case eq_min_a: /* Subtract an adouble from another eq_min_a */
532 /* adouble. (-=) */
533 arg = get_locint_f();
534 res = get_locint_f();
535 loc_a[0]=arg;
536 loc_a[1]=res;
537 #ifdef ADOLC_TAPE_DOC_VALUES
538 val_a[0]=dp_T0[arg];
539 dp_T0[res]-= dp_T0[arg];
540 val_a[1]=dp_T0[res];
541 #endif
542 filewrite(operation,"eq min a",2,loc_a,val_a,0,cst_d);
543 break;
544
545 /*--------------------------------------------------------------------------*/
546 case eq_min_prod: /* Subtract an product from an eq_min_prod */
547 /* adouble. (+= x1*x2) */
548 arg1 = get_locint_f();
549 arg2 = get_locint_f();
550 res = get_locint_f();
551 loc_a[0]=arg1;
552 loc_a[1]=arg2;
553 loc_a[2]=res;
554 #ifdef ADOLC_TAPE_DOC_VALUES
555 val_a[0]=dp_T0[arg1];
556 val_a[1]=dp_T0[arg2];
557 dp_T0[res] -= dp_T0[arg1]*dp_T0[arg2];
558 val_a[2]=dp_T0[res];
559 #endif
560 filewrite(operation,"eq min prod",3,loc_a,val_a,0,cst_d);
561 break;
562
563 /*--------------------------------------------------------------------------*/
564 case eq_mult_d: /* Multiply an adouble by a eq_mult_d */
565 /* flaoting point. (*=) */
566 res = get_locint_f();
567 coval = get_val_f();
568 loc_a[0] = res;
569 cst_d[0] = coval;
570 #ifdef ADOLC_TAPE_DOC_VALUES
571 dp_T0[res] *= coval;
572 val_a[0] = dp_T0[res];
573 #endif
574 filewrite(operation,"eq mult d",1,loc_a,val_a,1,cst_d);
575 break;
576
577 /*--------------------------------------------------------------------------*/
578 case eq_mult_a: /* Multiply one adouble by another eq_mult_a */
579 /* (*=) */
580 arg = get_locint_f();
581 res = get_locint_f();
582 loc_a[0]=arg;
583 loc_a[1]=res;
584 #ifdef ADOLC_TAPE_DOC_VALUES
585 val_a[0]=dp_T0[arg];
586 dp_T0[res]*= dp_T0[arg];
587 val_a[1]=dp_T0[res];
588 #endif
589 filewrite(operation,"eq mult a",2,loc_a,val_a,0,cst_d);
590 break;
591
592 /*--------------------------------------------------------------------------*/
593 case incr_a: /* Increment an adouble incr_a */
594 res = get_locint_f();
595 loc_a[0] = res;
596 #ifdef ADOLC_TAPE_DOC_VALUES
597 dp_T0[res]++;
598 val_a[0] = dp_T0[res];
599 #endif
600 filewrite(operation,"incr a",1,loc_a,val_a,0,cst_d);
601 break;
602
603 /*--------------------------------------------------------------------------*/
604 case decr_a: /* Increment an adouble decr_a */
605 res = get_locint_f();
606 loc_a[0] = res;
607 #ifdef ADOLC_TAPE_DOC_VALUES
608 dp_T0[res]--;
609 val_a[0] = dp_T0[res];
610 #endif
611 filewrite(operation,"decr a",1,loc_a,val_a,0,cst_d);
612 break;
613
614
615 /****************************************************************************/
616 /* BINARY OPERATIONS */
617
618 /*--------------------------------------------------------------------------*/
619 case plus_a_a: /* : Add two adoubles. (+) plus a_a */
620 arg1 = get_locint_f();
621 arg2 = get_locint_f();
622 res = get_locint_f();
623 loc_a[0]=arg1;
624 loc_a[1]=arg2;
625 loc_a[2]=res;
626 #ifdef ADOLC_TAPE_DOC_VALUES
627 val_a[0]=dp_T0[arg1];
628 val_a[1]=dp_T0[arg2];
629 dp_T0[res]=dp_T0[arg1]+dp_T0[arg2];
630 val_a[2]=dp_T0[res];
631 #endif
632 filewrite(operation,"plus a a",3,loc_a,val_a,0,cst_d);
633 break;
634
635 /*--------------------------------------------------------------------------*/
636 case plus_d_a: /* Add an adouble and a double plus_d_a */
637 /* (+) */
638 arg = get_locint_f();
639 res = get_locint_f();
640 coval = get_val_f();
641 loc_a[0] = arg;
642 loc_a[1] = res;
643 cst_d[0] = coval;
644 #ifdef ADOLC_TAPE_DOC_VALUES
645 val_a[0]=dp_T0[arg];
646 dp_T0[res]= dp_T0[arg] + coval;
647 val_a[1]=dp_T0[res];
648 #endif
649 filewrite(operation,"plus d a",2,loc_a,val_a,1,cst_d);
650 break;
651
652 /*--------------------------------------------------------------------------*/
653 case min_a_a: /* Subtraction of two adoubles min_a_a */
654 /* (-) */
655 arg1 = get_locint_f();
656 arg2 = get_locint_f();
657 res = get_locint_f();
658 loc_a[0]=arg1;
659 loc_a[1]=arg2;
660 loc_a[2]=res;
661 #ifdef ADOLC_TAPE_DOC_VALUES
662 val_a[0]=dp_T0[arg1];
663 val_a[1]=dp_T0[arg2];
664 dp_T0[res]=dp_T0[arg1]-dp_T0[arg2];
665 val_a[2]=dp_T0[res];
666 #endif
667 filewrite(operation,"min a a",3,loc_a,val_a,0,cst_d);
668 break;
669
670 /*--------------------------------------------------------------------------*/
671 case min_d_a: /* Subtract an adouble from a min_d_a */
672 /* double (-) */
673 arg = get_locint_f();
674 res = get_locint_f();
675 coval = get_val_f();
676 loc_a[0] = arg;
677 loc_a[1] = res;
678 cst_d[0] = coval;
679 #ifdef ADOLC_TAPE_DOC_VALUES
680 val_a[0] = dp_T0[arg];
681 dp_T0[res] = coval - dp_T0[arg];
682 val_a[1] = dp_T0[res];
683 #endif
684 filewrite(operation,"min d a",2,loc_a,val_a,1,cst_d);
685 break;
686
687 /*--------------------------------------------------------------------------*/
688 case mult_a_a: /* Multiply two adoubles (*) mult_a_a */
689 arg1 = get_locint_f();
690 arg2 = get_locint_f();
691 res = get_locint_f();
692 loc_a[0]=arg1;
693 loc_a[1]=arg2;
694 loc_a[2]=res;
695 #ifdef ADOLC_TAPE_DOC_VALUES
696 val_a[0]=dp_T0[arg1];
697 val_a[1]=dp_T0[arg2];
698 dp_T0[res]=dp_T0[arg1]*dp_T0[arg2];
699 val_a[2]=dp_T0[res];
700 #endif
701 filewrite(operation,"mult a a",3,loc_a,val_a,0,cst_d);
702 break;
703
704 /*--------------------------------------------------------------------------*/
705 case mult_d_a: /* Multiply an adouble by a double mult_d_a */
706 /* (*) */
707 arg = get_locint_f();
708 res = get_locint_f();
709 coval = get_val_f();
710 loc_a[0] = arg;
711 loc_a[1] = res;
712 cst_d[0] = coval;
713 #ifdef ADOLC_TAPE_DOC_VALUES
714 val_a[0] = dp_T0[arg];
715 dp_T0[res] = coval * dp_T0[arg];
716 val_a[1] = dp_T0[res];
717 #endif
718 filewrite(operation,"mult d a",2,loc_a,val_a,1,cst_d);
719 break;
720
721 /*--------------------------------------------------------------------------*/
722 case div_a_a: /* Divide an adouble by an adouble div_a_a */
723 /* (/) */
724 arg1 = get_locint_f();
725 arg2 = get_locint_f();
726 res = get_locint_f();
727 loc_a[0]=arg1;
728 loc_a[1]=arg2;
729 loc_a[2]=res;
730 #ifdef ADOLC_TAPE_DOC_VALUES
731 val_a[0]=dp_T0[arg1];
732 val_a[1]=dp_T0[arg2];
733 dp_T0[res]=dp_T0[arg1]/dp_T0[arg2];
734 val_a[2]=dp_T0[res];
735 #endif
736 filewrite(operation,"div a a",3,loc_a,val_a,0,cst_d);
737 break;
738
739 /*--------------------------------------------------------------------------*/
740 case div_d_a: /* Division double - adouble (/) div_d_a */
741 arg = get_locint_f();
742 res = get_locint_f();
743 coval = get_val_f();
744 loc_a[0] = arg;
745 loc_a[1] = res;
746 cst_d[0] = coval;
747 #ifdef ADOLC_TAPE_DOC_VALUES
748 val_a[0] = dp_T0[arg];
749 dp_T0[res] = coval / dp_T0[arg];
750 val_a[1] = dp_T0[res];
751 #endif
752 filewrite(operation,"div d a",2,loc_a,val_a,1,cst_d);
753 break;
754
755
756 /****************************************************************************/
757 /* SIGN OPERATIONS */
758
759 /*--------------------------------------------------------------------------*/
760 case pos_sign_a: /* pos_sign_a */
761 arg = get_locint_f();
762 res = get_locint_f();
763 loc_a[0]=arg;
764 loc_a[1]=res;
765 #ifdef ADOLC_TAPE_DOC_VALUES
766 val_a[0]=dp_T0[arg];
767 dp_T0[res]= dp_T0[arg];
768 val_a[1]=dp_T0[res];
769 #endif
770 filewrite(operation,"pos sign a",2,loc_a,val_a,0,cst_d);
771 break;
772
773 /*--------------------------------------------------------------------------*/
774 case neg_sign_a: /* neg_sign_a */
775 arg = get_locint_f();
776 res = get_locint_f();
777 loc_a[0]=arg;
778 loc_a[1]=res;
779 #ifdef ADOLC_TAPE_DOC_VALUES
780 val_a[0]=dp_T0[arg];
781 dp_T0[res]= -dp_T0[arg];
782 val_a[1]=dp_T0[res];
783 #endif
784 filewrite(operation,"neg sign a",2,loc_a,val_a,0,cst_d);
785 break;
786
787
788 /****************************************************************************/
789 /* UNARY OPERATIONS */
790
791 /*--------------------------------------------------------------------------*/
792 case exp_op: /* exponent operation exp_op */
793 arg = get_locint_f();
794 res = get_locint_f();
795 loc_a[0]=arg;
796 loc_a[1]=res;
797 #ifdef ADOLC_TAPE_DOC_VALUES
798 val_a[0]=dp_T0[arg];
799 dp_T0[res]= exp(dp_T0[arg]);
800 ADOLC_OPENMP_RESTORE_THREAD_NUMBER;
801 val_a[1]=dp_T0[res];
802 #endif
803 filewrite(operation,"exp op",2,loc_a,val_a,0,cst_d);
804 break;
805
806 /*--------------------------------------------------------------------------*/
807 case sin_op: /* sine operation sin_op */
808 arg1 = get_locint_f();
809 arg2 = get_locint_f();
810 res = get_locint_f();
811 loc_a[0]=arg1;
812 loc_a[1]=arg2;
813 loc_a[2]=res;
814 #ifdef ADOLC_TAPE_DOC_VALUES
815 /* olvo 980923 changed order to allow x=sin(x) */
816 val_a[0]=dp_T0[arg1];
817 dp_T0[arg2]= cos(dp_T0[arg1]);
818 dp_T0[res] = sin(dp_T0[arg1]);
819 ADOLC_OPENMP_RESTORE_THREAD_NUMBER;
820 val_a[1]=dp_T0[arg2];
821 val_a[2]=dp_T0[res];
822 #endif
823 filewrite(operation,"sin op",3,loc_a,val_a,0,cst_d);
824 break;
825
826 /*--------------------------------------------------------------------------*/
827 case cos_op: /* cosine operation cos_op */
828 arg1 = get_locint_f();
829 arg2 = get_locint_f();
830 res = get_locint_f();
831 loc_a[0]=arg1;
832 loc_a[1]=arg2;
833 loc_a[2]=res;
834 #ifdef ADOLC_TAPE_DOC_VALUES
835 /* olvo 980923 changed order to allow x=cos(x) */
836 val_a[0]=dp_T0[arg1];
837 dp_T0[arg2]= sin(dp_T0[arg1]);
838 dp_T0[res] = cos(dp_T0[arg1]);
839 ADOLC_OPENMP_RESTORE_THREAD_NUMBER;
840 val_a[1]=dp_T0[arg2];
841 val_a[2]=dp_T0[res];
842 #endif
843 filewrite(operation,"cos op",3,loc_a,val_a,0,cst_d);
844 break;
845
846 /*--------------------------------------------------------------------------*/
847 case atan_op: /* atan_op */
848 arg1 = get_locint_f();
849 arg2 = get_locint_f();
850 res = get_locint_f();
851 loc_a[0]=arg1;
852 loc_a[1]=arg2;
853 loc_a[2]=res;
854 #ifdef ADOLC_TAPE_DOC_VALUES
855 val_a[0]=dp_T0[arg1];
856 dp_T0[res] = atan(dp_T0[arg1]);
857 ADOLC_OPENMP_RESTORE_THREAD_NUMBER;
858 val_a[1]=dp_T0[arg2];
859 val_a[2]=dp_T0[res];
860 #endif
861 filewrite(operation,"atan op",3,loc_a,val_a,0,cst_d);
862 break;
863
864 /*--------------------------------------------------------------------------*/
865 case asin_op: /* asin_op */
866 arg1 = get_locint_f();
867 arg2 = get_locint_f();
868 res = get_locint_f();
869 loc_a[0]=arg1;
870 loc_a[1]=arg2;
871 loc_a[2]=res;
872 #ifdef ADOLC_TAPE_DOC_VALUES
873 val_a[0]=dp_T0[arg1];
874 dp_T0[res] = asin(dp_T0[arg1]);
875 ADOLC_OPENMP_RESTORE_THREAD_NUMBER;
876 val_a[1]=dp_T0[arg2];
877 val_a[2]=dp_T0[res];
878 #endif
879 filewrite(operation,"asin op",3,loc_a,val_a,0,cst_d);
880 break;
881
882 /*--------------------------------------------------------------------------*/
883 case acos_op: /* acos_op */
884 arg1 = get_locint_f();
885 arg2 = get_locint_f();
886 res = get_locint_f();
887 loc_a[0]=arg1;
888 loc_a[1]=arg2;
889 loc_a[2]=res;
890 #ifdef ADOLC_TAPE_DOC_VALUES
891 val_a[0]=dp_T0[arg1];
892 dp_T0[res] = acos(dp_T0[arg1]);
893 ADOLC_OPENMP_RESTORE_THREAD_NUMBER;
894 val_a[1]=dp_T0[arg2];
895 val_a[2]=dp_T0[res];
896 #endif
897 filewrite(operation,"acos op",3,loc_a,val_a,0,cst_d);
898 break;
899
900 #ifdef ATRIG_ERF
901
902 /*--------------------------------------------------------------------------*/
903 case asinh_op: /* asinh_op */
904 arg1 = get_locint_f();
905 arg2 = get_locint_f();
906 res = get_locint_f();
907 loc_a[0]=arg1;
908 loc_a[1]=arg2;
909 loc_a[2]=res;
910 #ifdef ADOLC_TAPE_DOC_VALUES
911 val_a[0]=dp_T0[arg1];
912 dp_T0[res] = asinh(dp_T0[arg1]);
913 ADOLC_OPENMP_RESTORE_THREAD_NUMBER;
914 val_a[1]=dp_T0[arg2];
915 val_a[2]=dp_T0[res];
916 #endif
917 filewrite(operation,"asinh op",3,loc_a,val_a,0,cst_d);
918 break;
919
920 /*--------------------------------------------------------------------------*/
921 case acosh_op: /* acosh_op */
922 arg1 = get_locint_f();
923 arg2 = get_locint_f();
924 res = get_locint_f();
925 loc_a[0]=arg1;
926 loc_a[1]=arg2;
927 loc_a[2]=res;
928 #ifdef ADOLC_TAPE_DOC_VALUES
929 val_a[0]=dp_T0[arg1];
930 dp_T0[res] = acosh(dp_T0[arg1]);
931 ADOLC_OPENMP_RESTORE_THREAD_NUMBER;
932 val_a[1]=dp_T0[arg2];
933 val_a[2]=dp_T0[res];
934 #endif
935 filewrite(operation,"acosh op",3,loc_a,val_a,0,cst_d);
936 break;
937
938 /*--------------------------------------------------------------------------*/
939 case atanh_op: /* atanh_op */
940 arg1 = get_locint_f();
941 arg2 = get_locint_f();
942 res = get_locint_f();
943 loc_a[0]=arg1;
944 loc_a[1]=arg2;
945 loc_a[2]=res;
946 #ifdef ADOLC_TAPE_DOC_VALUES
947 val_a[0]=dp_T0[arg1];
948 dp_T0[res] = atanh(dp_T0[arg1]);
949 ADOLC_OPENMP_RESTORE_THREAD_NUMBER;
950 val_a[1]=dp_T0[arg2];
951 val_a[2]=dp_T0[res];
952 #endif
953 filewrite(operation,"atanh op",3,loc_a,val_a,0,cst_d);
954 break;
955
956 /*--------------------------------------------------------------------------*/
957 case erf_op: /* erf_op */
958 arg1 = get_locint_f();
959 arg2 = get_locint_f();
960 res = get_locint_f();
961 loc_a[0]=arg1;
962 loc_a[1]=arg2;
963 loc_a[2]=res;
964 #ifdef ADOLC_TAPE_DOC_VALUES
965 val_a[0]=dp_T0[arg1];
966 dp_T0[res] = erf(dp_T0[arg1]);
967 ADOLC_OPENMP_RESTORE_THREAD_NUMBER;
968 val_a[1]=dp_T0[arg2];
969 val_a[2]=dp_T0[res];
970 #endif
971 filewrite(operation,"erf op",3,loc_a,val_a,0,cst_d);
972 break;
973
974 #endif
975 /*--------------------------------------------------------------------------*/
976 case log_op: /* log_op */
977 arg = get_locint_f();
978 res = get_locint_f();
979 loc_a[0]=arg;
980 loc_a[1]=res;
981 #ifdef ADOLC_TAPE_DOC_VALUES
982 val_a[0]=dp_T0[arg];
983 dp_T0[res]= log(dp_T0[arg]);
984 ADOLC_OPENMP_RESTORE_THREAD_NUMBER;
985 val_a[1]=dp_T0[res];
986 #endif
987 filewrite(operation,"log op",2,loc_a,val_a,0,cst_d);
988 break;
989
990 /*--------------------------------------------------------------------------*/
991 case pow_op: /* pow_op */
992 arg = get_locint_f();
993 res = get_locint_f();
994 coval = get_val_f();
995 cst_d[0]=coval;
996 loc_a[0]=arg;
997 loc_a[1]=res;
998 #ifdef ADOLC_TAPE_DOC_VALUES
999 val_a[0]=dp_T0[arg];
1000 dp_T0[res] = pow(dp_T0[arg],coval);
1001 ADOLC_OPENMP_RESTORE_THREAD_NUMBER;
1002 val_a[1]=dp_T0[res];
1003 #endif
1004 filewrite(operation,"pow op",2,loc_a,val_a,1,cst_d);
1005 break;
1006
1007 /*--------------------------------------------------------------------------*/
1008 case sqrt_op: /* sqrt_op */
1009 arg = get_locint_f();
1010 res = get_locint_f();
1011 loc_a[0]=arg;
1012 loc_a[1]=res;
1013 #ifdef ADOLC_TAPE_DOC_VALUES
1014 val_a[0]=dp_T0[arg];
1015 dp_T0[res]= sqrt(dp_T0[arg]);
1016 ADOLC_OPENMP_RESTORE_THREAD_NUMBER;
1017 val_a[1]=dp_T0[res];
1018 #endif
1019 filewrite(operation,"sqrt op",2,loc_a,val_a,0,cst_d);
1020 break;
1021
1022 /*--------------------------------------------------------------------------*/
1023 case cbrt_op: /* cbrt_op */
1024 arg = get_locint_f();
1025 res = get_locint_f();
1026 loc_a[0]=arg;
1027 loc_a[1]=res;
1028 #ifdef ADOLC_TAPE_DOC_VALUES
1029 val_a[0]=dp_T0[arg];
1030 dp_T0[res]= cbrt(dp_T0[arg]);
1031 ADOLC_OPENMP_RESTORE_THREAD_NUMBER;
1032 val_a[1]=dp_T0[res];
1033 #endif
1034 filewrite(operation,"cbrt op",2,loc_a,val_a,0,cst_d);
1035 break;
1036
1037 /*--------------------------------------------------------------------------*/
1038 case gen_quad: /* gen_quad */
1039 arg1 = get_locint_f();
1040 arg2 = get_locint_f();
1041 res = get_locint_f();
1042 cst_d[0] = get_val_f();
1043 cst_d[1] = get_val_f();
1044 loc_a[0]=arg1;
1045 loc_a[1]=arg2;
1046 loc_a[2]=res;
1047 #ifdef ADOLC_TAPE_DOC_VALUES
1048 val_a[0]=dp_T0[arg1];
1049 dp_T0[res] = cst_d[1];
1050 val_a[1]=dp_T0[arg2];
1051 val_a[2]=dp_T0[res];
1052 #endif
1053 filewrite(operation,"gen quad",3,loc_a,val_a,2,cst_d);
1054 break;
1055
1056 /*--------------------------------------------------------------------------*/
1057 case min_op: /* min_op */
1058 arg1 = get_locint_f();
1059 arg2 = get_locint_f();
1060 res = get_locint_f();
1061 coval = get_val_f();
1062 loc_a[0] = arg1;
1063 loc_a[1] = arg2;
1064 loc_a[2] = res;
1065 cst_d[0] = coval;
1066 #ifdef ADOLC_TAPE_DOC_VALUES
1067 val_a[0] = dp_T0[arg1];
1068 val_a[1] = dp_T0[arg2];
1069 if (dp_T0[arg1] > dp_T0[arg2])
1070 dp_T0[res] = dp_T0[arg2];
1071 else
1072 dp_T0[res] = dp_T0[arg1];
1073 val_a[2] = dp_T0[res];
1074 #endif
1075 filewrite(operation,"min op",3,loc_a,val_a,1,cst_d);
1076 break;
1077
1078 /*--------------------------------------------------------------------------*/
1079 case abs_val: /* abs_val */
1080 arg = get_locint_f();
1081 res = get_locint_f();
1082 coval = get_val_f();
1083 loc_a[0] = arg;
1084 loc_a[1] = res;
1085 cst_d[0] = coval;
1086 #ifdef ADOLC_TAPE_DOC_VALUES
1087 val_a[0] = dp_T0[arg];
1088 dp_T0[res] = fabs(dp_T0[arg]);
1089 val_a[1] = dp_T0[res];
1090 #endif
1091 filewrite(operation,"abs val",2,loc_a,val_a,1,cst_d);
1092 break;
1093
1094 /*--------------------------------------------------------------------------*/
1095 case ceil_op: /* ceil_op */
1096 arg = get_locint_f();
1097 res = get_locint_f();
1098 coval = get_val_f();
1099 loc_a[0] = arg;
1100 loc_a[1] = res;
1101 cst_d[0] = coval;
1102 #ifdef ADOLC_TAPE_DOC_VALUES
1103 val_a[0] = dp_T0[arg];
1104 dp_T0[res] = ceil(dp_T0[arg]);
1105 val_a[1] = dp_T0[res];
1106 #endif
1107 filewrite(operation,"ceil op",2,loc_a,val_a,1,cst_d);
1108 break;
1109
1110 /*--------------------------------------------------------------------------*/
1111 case floor_op: /* Compute ceil of adouble floor_op */
1112 arg = get_locint_f();
1113 res = get_locint_f();
1114 coval = get_val_f();
1115 loc_a[0] = arg;
1116 loc_a[1] = res;
1117 cst_d[0] = coval;
1118 #ifdef ADOLC_TAPE_DOC_VALUES
1119 val_a[0] = dp_T0[arg];
1120 dp_T0[res] = floor(dp_T0[arg]);
1121 val_a[1] = dp_T0[res];
1122 #endif
1123 filewrite(operation,"floor op",2,loc_a,val_a,1,cst_d);
1124 break;
1125
1126
1127 /****************************************************************************/
1128 /* CONDITIONALS */
1129
1130 /*--------------------------------------------------------------------------*/
1131 case cond_assign: /* cond_assign */
1132 arg = get_locint_f();
1133 arg1 = get_locint_f();
1134 arg2 = get_locint_f();
1135 res = get_locint_f();
1136 coval = get_val_f();
1137 loc_a[0]=arg;
1138 loc_a[1]=arg1;
1139 loc_a[2]=arg2 ;
1140 loc_a[3]=res;
1141 cst_d[0]=coval;
1142 #ifdef ADOLC_TAPE_DOC_VALUES
1143 val_a[0]=dp_T0[arg];
1144 val_a[1]=dp_T0[arg1];
1145 val_a[2]=dp_T0[arg2];
1146 if (dp_T0[arg]>0)
1147 dp_T0[res]=dp_T0[arg1];
1148 else
1149 dp_T0[res]=dp_T0[arg2];
1150 val_a[3]=dp_T0[res];
1151 #endif
1152 filewrite(operation,"cond assign $\\longrightarrow$",4,loc_a,val_a,1,cst_d);
1153 break;
1154
1155 /*--------------------------------------------------------------------------*/
1156 case cond_assign_s: /* cond_assign_s */
1157 arg = get_locint_f();
1158 arg1 = get_locint_f();
1159 res = get_locint_f();
1160 coval = get_val_f();
1161 loc_a[0]=arg;
1162 loc_a[1]=arg1;
1163 loc_a[2]=res;
1164 cst_d[0]=coval;
1165 #ifdef ADOLC_TAPE_DOC_VALUES
1166 val_a[0]=dp_T0[arg];
1167 val_a[1]=dp_T0[arg1];
1168 if (dp_T0[arg]>0)
1169 dp_T0[res]=dp_T0[arg1];
1170 val_a[2]=dp_T0[res];
1171 #endif
1172 filewrite(operation,"cond assign s $\\longrightarrow$",3,loc_a,val_a,1,cst_d);
1173 break;
1174
1175 case vec_copy:
1176 res = get_locint_f();
1177 arg = get_locint_f();
1178 size = get_locint_f();
1179 loc_a[0] = res;
1180 loc_a[1] = arg;
1181 loc_a[2] = size;
1182 #ifdef ADOLC_TAPE_DOC_VALUES
1183 for(qq=0;qq<size;qq++)
1184 dp_T0[res+qq] = dp_T0[arg+qq];
1185 #endif
1186 filewrite(operation,"vec copy $\\longrightarrow$",3,loc_a,val_a,0,cst_d);
1187 break;
1188
1189 case vec_dot:
1190 res = get_locint_f();
1191 arg1 = get_locint_f();
1192 arg2 = get_locint_f();
1193 size = get_locint_f();
1194 loc_a[0] = res;
1195 loc_a[1] = arg1;
1196 loc_a[2] = arg2;
1197 loc_a[3] = size;
1198 #ifdef ADOLC_TAPE_DOC_VALUES
1199 dp_T0[res] = 0;
1200 for(qq=0;qq<size;qq++)
1201 dp_T0[res] += dp_T0[arg1+qq] * dp_T0[arg2+qq];
1202 val_a[0] = dp_T0[res];
1203 #endif
1204 filewrite(operation,"vec dot $\\longrightarrow$",4,loc_a,val_a,0,cst_d);
1205 break;
1206
1207 case vec_axpy:
1208 res = get_locint_f();
1209 arg = get_locint_f();
1210 arg1 = get_locint_f();
1211 arg2 = get_locint_f();
1212 size = get_locint_f();
1213 loc_a[0] = res;
1214 loc_a[1] = arg;
1215 loc_a[1] = arg1;
1216 loc_a[2] = arg2;
1217 loc_a[3] = size;
1218 #ifdef ADOLC_TAPE_DOC_VALUES
1219 val_a[0] = dp_T0[arg];
1220 for(qq=0;qq<size;qq++)
1221 dp_T0[res+qq] = dp_T0[arg] * dp_T0[arg1+qq] + dp_T0[arg2+qq];
1222 #endif
1223 filewrite(operation,"vec axpy $\\longrightarrow$",4,loc_a,val_a,0,cst_d);
1224 break;
1225
1226
1227 /****************************************************************************/
1228 /* REMAINING STUFF */
1229
1230 /*--------------------------------------------------------------------------*/
1231 case take_stock_op: /* take_stock_op */
1232 size = get_locint_f();
1233 res = get_locint_f();
1234 d = get_val_v_f(size);
1235 loc_a[0] = size;
1236 loc_a[1] = res;
1237 cst_d[0] = d[0];
1238 #ifdef ADOLC_TAPE_DOC_VALUES
1239 for (l=0; l<size; l++)
1240 dp_T0[res+l] = d[l];
1241 val_a[0] = make_nan();
1242 val_a[1] = dp_T0[res];
1243 #endif
1244 filewrite(operation,"take stock op",2,loc_a,val_a,1,cst_d);
1245 break;
1246
1247 /*--------------------------------------------------------------------------*/
1248 case death_not: /* death_not */
1249 arg1 = get_locint_f();
1250 arg2 = get_locint_f();
1251 loc_a[0]=arg1;
1252 loc_a[1]=arg2;
1253 filewrite(operation,"death not",2,loc_a,val_a,0,cst_d);
1254 break;
1255
1256 /****************************************************************************/
1257 case ext_diff:
1258 loc_a[0] = get_locint_f() + 1; /* index */
1259 loc_a[1] = get_locint_f(); /* n */
1260 loc_a[2] = get_locint_f(); /* m */
1261 loc_a[3] = get_locint_f(); /* xa[0].loc */
1262 loc_a[3] = get_locint_f(); /* ya[0].loc */
1263 loc_a[3] = get_locint_f(); /* dummy */
1264 filewrite(operation, "extern diff",3, loc_a, val_a, 0, cst_d);
1265 break;
1266
1267 case ext_diff_iArr:
1268 loc_a[0] = get_locint_f(); /* iArr length */
1269 for (l=0; l<loc_a[0];++l) get_locint_f(); /* iArr */
1270 get_locint_f(); /* iArr length again */
1271 loc_a[0] = get_locint_f() + 1; /* index */
1272 loc_a[1] = get_locint_f(); /* n */
1273 loc_a[2] = get_locint_f(); /* m */
1274 loc_a[3] = get_locint_f(); /* xa[0].loc */
1275 loc_a[3] = get_locint_f(); /* ya[0].loc */
1276 loc_a[3] = get_locint_f(); /* dummy */
1277 filewrite(operation, "extern diff iArr",3, loc_a, val_a, 0, cst_d);
1278 break;
1279 case ext_diff_v2:
1280 loc_a[0] = get_locint_f(); /* index */
1281 loc_a[1] = get_locint_f(); /* iArr length */
1282 for (l=0; l<loc_a[1];++l) get_locint_f(); /* iArr */
1283 get_locint_f(); /* iArr length again */
1284 loc_a[1] = get_locint_f(); /* nin */
1285 loc_a[2] = get_locint_f(); /* nout */
1286 for (l=0; l<loc_a[1];++l) { get_locint_f(); get_locint_f(); }
1287 /* input vectors sizes and start locs */
1288 for (l=0; l<loc_a[2];++l) { get_locint_f(); get_locint_f(); }
1289 /* output vectors sizes and start locs */
1290 get_locint_f(); /* nin again */
1291 get_locint_f(); /* nout again */
1292 filewrite(operation, "extern diff v2",3, loc_a, val_a, 0, cst_d);
1293 break;
1294 #ifdef ADOLC_MEDIPACK_SUPPORT
1295 /*--------------------------------------------------------------------------*/
1296 case medi_call:
1297 loc_a[0] = get_locint_f();
1298
1299 /* currently not supported */
1300 break;
1301 #endif
1302 #ifdef ADOLC_AMPI_SUPPORT
1303 case ampi_send:
1304 loc_a[0] = get_locint_f(); /* start loc */
1305 TAPE_AMPI_read_int(loc_a+1); /* count */
1306 TAPE_AMPI_read_MPI_Datatype(&anMPI_Datatype);
1307 TAPE_AMPI_read_int(loc_a+2); /* endpoint */
1308 TAPE_AMPI_read_int(loc_a+3); /* tag */
1309 TAPE_AMPI_read_int(loc_a+4); /* pairedWith */
1310 TAPE_AMPI_read_MPI_Comm(&anMPI_Comm);
1311 filewrite_ampi(operation, "ampi send",5, loc_a);
1312 break;
1313
1314 case ampi_recv:
1315 loc_a[0] = get_locint_f(); /* start loc */
1316 TAPE_AMPI_read_int(loc_a+1); /* count */
1317 TAPE_AMPI_read_MPI_Datatype(&anMPI_Datatype);
1318 TAPE_AMPI_read_int(loc_a+2); /* endpoint */
1319 TAPE_AMPI_read_int(loc_a+3); /* tag */
1320 TAPE_AMPI_read_int(loc_a+4); /* pairedWith */
1321 TAPE_AMPI_read_MPI_Comm(&anMPI_Comm);
1322 filewrite_ampi(operation, "ampi recv",5, loc_a);
1323 break;
1324
1325 case ampi_isend:
1326 /* push is delayed to the accompanying completion */
1327 TAPE_AMPI_read_MPI_Request(&anMPI_Request);
1328 filewrite_ampi(operation, "ampi isend",0, loc_a);
1329 break;
1330
1331 case ampi_irecv:
1332 /* push is delayed to the accompanying completion */
1333 TAPE_AMPI_read_MPI_Request(&anMPI_Request);
1334 filewrite_ampi(operation, "ampi irecv",0, loc_a);
1335 break;
1336
1337 case ampi_wait:
1338 /* for the operation we had been waiting for */
1339 size=0;
1340 loc_a[size++] = get_locint_f(); /* start loc */
1341 TAPE_AMPI_read_int(loc_a+size++); /* count */
1342 TAPE_AMPI_read_MPI_Datatype(&anMPI_Datatype);
1343 TAPE_AMPI_read_int(loc_a+size++); /* endpoint */
1344 TAPE_AMPI_read_int(loc_a+size++); /* tag */
1345 TAPE_AMPI_read_int(loc_a+size++); /* pairedWith */
1346 TAPE_AMPI_read_MPI_Comm(&anMPI_Comm);
1347 TAPE_AMPI_read_MPI_Request(&anMPI_Request);
1348 TAPE_AMPI_read_int(loc_a+size++); /* origin */
1349 filewrite_ampi(operation, "ampi wait",size, loc_a);
1350 break;
1351
1352 case ampi_barrier:
1353 TAPE_AMPI_read_MPI_Comm(&anMPI_Comm);
1354 filewrite_ampi(operation, "ampi barrier",0, loc_a);
1355 break;
1356
1357 case ampi_bcast:
1358 loc_a[0] = get_locint_f(); /* start loc */
1359 TAPE_AMPI_read_int(loc_a+1); /* count */
1360 TAPE_AMPI_read_MPI_Datatype(&anMPI_Datatype);
1361 TAPE_AMPI_read_int(loc_a+2); /* root */
1362 TAPE_AMPI_read_MPI_Comm(&anMPI_Comm);
1363 filewrite_ampi(operation, "ampi bcast",3, loc_a);
1364 break;
1365
1366 case ampi_reduce:
1367 loc_a[0] = get_locint_f(); /* rbuf */
1368 loc_a[1] = get_locint_f(); /* sbuf */
1369 TAPE_AMPI_read_int(loc_a+2); /* count */
1370 TAPE_AMPI_read_int(loc_a+3); /* pushResultData */
1371 i=0; /* read stored double array into dummy variable */
1372 while (i<loc_a[2]) { TAPE_AMPI_read_double(&aDouble); i++; }
1373 if (loc_a[3]) {
1374 i=0; /* for root, also read stored reduction result */
1375 while (i<loc_a[2]) { TAPE_AMPI_read_double(&aDouble); i++; }
1376 }
1377 TAPE_AMPI_read_int(loc_a+3); /* pushResultData again */
1378 TAPE_AMPI_read_MPI_Op(&anMPI_Op);
1379 TAPE_AMPI_read_int(loc_a+4); /* root */
1380 TAPE_AMPI_read_MPI_Comm(&anMPI_Comm);
1381 TAPE_AMPI_read_MPI_Datatype(&anMPI_Datatype);
1382 TAPE_AMPI_read_int(loc_a+2); /* count again */
1383 filewrite_ampi(operation, "ampi reduce",5, loc_a);
1384 break;
1385
1386 case ampi_allreduce:
1387 loc_a[0] = get_locint_f(); /* rbuf */
1388 loc_a[1] = get_locint_f(); /* sbuf */
1389 TAPE_AMPI_read_int(loc_a+2); /* count */
1390 TAPE_AMPI_read_int(loc_a+3); /* pushResultData */
1391 i=0; /* read off stored double array into dummy variable */
1392 while (i<loc_a[2]) { TAPE_AMPI_read_double(&aDouble); i++; }
1393 if (loc_a[3]) {
1394 i=0; /* for root, also read off stored reduction result */
1395 while (i<loc_a[2]) { TAPE_AMPI_read_double(&aDouble); i++; }
1396 }
1397 TAPE_AMPI_read_int(loc_a+3); /* pushResultData again */
1398 TAPE_AMPI_read_MPI_Op(&anMPI_Op);
1399 TAPE_AMPI_read_int(loc_a+4); /* root */
1400 TAPE_AMPI_read_MPI_Comm(&anMPI_Comm);
1401 TAPE_AMPI_read_MPI_Datatype(&anMPI_Datatype);
1402 TAPE_AMPI_read_int(loc_a+2); /* count again */
1403 filewrite_ampi(operation, "ampi allreduce",5, loc_a);
1404 break;
1405
1406 case ampi_gather:
1407 size=0;
1408 TAPE_AMPI_read_int(loc_a+size++); /* commSizeForRootOrNull */
1409 if (*(loc_a+0)>0) {
1410 loc_a[size++] = get_locint_f(); /* rbuf loc */
1411 TAPE_AMPI_read_int(loc_a+size++); /* rcnt */
1412 TAPE_AMPI_read_MPI_Datatype(&anMPI_Datatype); /* rtype */
1413 }
1414 loc_a[size++]=get_locint_f(); /* buf loc */
1415 TAPE_AMPI_read_int(loc_a+size++); /* count */
1416 TAPE_AMPI_read_MPI_Datatype(&anMPI_Datatype); /* type */
1417 TAPE_AMPI_read_int(loc_a+size++); /* root */
1418 TAPE_AMPI_read_MPI_Comm(&anMPI_Comm);
1419 TAPE_AMPI_read_int(loc_a+0); /* commSizeForRootOrNull */
1420 filewrite_ampi(operation, "ampi gather",size, loc_a);
1421 break;
1422
1423 case ampi_scatter:
1424 size=0;
1425 TAPE_AMPI_read_int(loc_a+size++); /* commSizeForRootOrNull */
1426 if (*(loc_a+0)>0) {
1427 loc_a[size++] = get_locint_f(); /* rbuf loc */
1428 TAPE_AMPI_read_int(loc_a+size++); /* rcnt */
1429 TAPE_AMPI_read_MPI_Datatype(&anMPI_Datatype); /* rtype */
1430 }
1431 loc_a[size++]=get_locint_f(); /* buf loc */
1432 TAPE_AMPI_read_int(loc_a+size++); /* count */
1433 TAPE_AMPI_read_MPI_Datatype(&anMPI_Datatype); /* type */
1434 TAPE_AMPI_read_int(loc_a+size++); /* root */
1435 TAPE_AMPI_read_MPI_Comm(&anMPI_Comm);
1436 TAPE_AMPI_read_int(loc_a+0); /* commSizeForRootOrNull */
1437 filewrite_ampi(operation, "ampi scatter",size, loc_a);
1438 break;
1439
1440 case ampi_allgather:
1441 TAPE_AMPI_read_int(loc_a+1); /* commSizeForRootOrNull */
1442 if (*(loc_a+1)>0) {
1443 TAPE_AMPI_read_int(loc_a+2); /* rcnt */
1444 loc_a[2] = get_locint_f(); /* rbuf loc */
1445 TAPE_AMPI_read_MPI_Datatype(&anMPI_Datatype); /* rtype */
1446 }
1447 TAPE_AMPI_read_int(loc_a+3); /* count */
1448 TAPE_AMPI_read_MPI_Datatype(&anMPI_Datatype); /* type */
1449 TAPE_AMPI_read_MPI_Comm(&anMPI_Comm);
1450 TAPE_AMPI_read_int(loc_a+1); /* commSizeForRootOrNull */
1451 filewrite_ampi(operation, "ampi allgather",4, loc_a);
1452 break;
1453
1454 case ampi_gatherv:
1455 size=0;
1456 TAPE_AMPI_read_int(loc_a+size++); /* commSizeForRootOrNull */
1457 if (*(loc_a+0)>0) {
1458 loc_a[size++] = get_locint_f(); /* rbuf loc */
1459 TAPE_AMPI_read_int(loc_a+size++); /* rcnt[0] */
1460 TAPE_AMPI_read_int(loc_a+size++); /* displs[0] */
1461 }
1462 for (l=1;l<*(loc_a+0);++l) {
1463 TAPE_AMPI_read_int(loc_a+size);
1464 TAPE_AMPI_read_int(loc_a+size);
1465 }
1466 if (*(loc_a+0)>0) {
1467 TAPE_AMPI_read_MPI_Datatype(&anMPI_Datatype); /* rtype */
1468 }
1469 loc_a[size++] = get_locint_f(); /* buf loc */
1470 TAPE_AMPI_read_int(loc_a+size++); /* count */
1471 TAPE_AMPI_read_MPI_Datatype(&anMPI_Datatype); /* type */
1472 TAPE_AMPI_read_int(loc_a+size++); /* root */
1473 TAPE_AMPI_read_MPI_Comm(&anMPI_Comm);
1474 TAPE_AMPI_read_int(loc_a+0); /* commSizeForRootOrNull */
1475 filewrite_ampi(operation, "ampi gatherv",size, loc_a);
1476 break;
1477
1478 case ampi_scatterv:
1479 size=0;
1480 TAPE_AMPI_read_int(loc_a+size++); /* commSizeForRootOrNull */
1481 if (*(loc_a+0)>0) {
1482 loc_a[size++] = get_locint_f(); /* rbuf loc */
1483 TAPE_AMPI_read_int(loc_a+size++); /* rcnt[0] */
1484 TAPE_AMPI_read_int(loc_a+size++); /* displs[0] */
1485 }
1486 for (l=1;l<*(loc_a+0);++l) {
1487 TAPE_AMPI_read_int(loc_a+size);
1488 TAPE_AMPI_read_int(loc_a+size);
1489 }
1490 if (*(loc_a+0)>0) {
1491 TAPE_AMPI_read_MPI_Datatype(&anMPI_Datatype); /* rtype */
1492 }
1493 loc_a[size++] = get_locint_f(); /* buf loc */
1494 TAPE_AMPI_read_int(loc_a+size++); /* count */
1495 TAPE_AMPI_read_MPI_Datatype(&anMPI_Datatype); /* type */
1496 TAPE_AMPI_read_int(loc_a+size++); /* root */
1497 TAPE_AMPI_read_MPI_Comm(&anMPI_Comm);
1498 TAPE_AMPI_read_int(loc_a+0); /* commSizeForRootOrNull */
1499 filewrite_ampi(operation, "ampi scatterv",size, loc_a);
1500 break;
1501
1502 case ampi_allgatherv:
1503 size=0;
1504 TAPE_AMPI_read_int(loc_a+size++); /* commSizeForRootOrNull */
1505 for (l=0;l<*(loc_a);++l) {
1506 TAPE_AMPI_read_int(loc_a+size); /* rcnts */
1507 TAPE_AMPI_read_int(loc_a+size+1); /* displs */
1508 }
1509 if (*(loc_a)>0) {
1510 size+=2;
1511 loc_a[size++] = get_locint_f(); /* rbuf loc */
1512 TAPE_AMPI_read_MPI_Datatype(&anMPI_Datatype); /* rtype */
1513 }
1514 loc_a[size++] = get_locint_f(); /* buf loc */
1515 TAPE_AMPI_read_int(loc_a+size++); /* count */
1516 TAPE_AMPI_read_MPI_Datatype(&anMPI_Datatype); /* type */
1517 TAPE_AMPI_read_int(loc_a+size++); /* root */
1518 TAPE_AMPI_read_MPI_Comm(&anMPI_Comm);
1519 TAPE_AMPI_read_int(loc_a); /* commSizeForRootOrNull */
1520 filewrite_ampi(operation, "ampi allgatherv",size, loc_a);
1521 break;
1522 #endif
1523 /*--------------------------------------------------------------------------*/
1524 default: /* default */
1525 /* Die here, we screwed up */
1526 fprintf(DIAG_OUT,"ADOL-C error: Fatal error in tape_doc for op %d\n",
1527 operation);
1528 break;
1529
1530 } /* endswitch */
1531
1532 /* Read the next operation */
1533 operation=get_op_f();
1534 ++op_cnt;
1535 --rev_op_cnt;
1536 } /* endwhile */
1537
1538 if (operation == end_of_tape) {
1539 filewrite_end(operation);
1540 };
1541
1542 if (dp_T0) free(dp_T0);
1543 dp_T0 = NULL;
1544
1545 end_sweep();
1546 } /* end tape_doc */
1547
1548
1549 /****************************************************************************/
1550 /* THAT'S ALL */
1551
1552 END_C_DECLS
1553