/[MITgcm]/MITgcm_contrib/heimbach/OpenAD/OAD_support/ad_inline.F
ViewVC logotype

Annotation of /MITgcm_contrib/heimbach/OpenAD/OAD_support/ad_inline.F

Parent Directory Parent Directory | Revision Log Revision Log | View Revision Graph Revision Graph


Revision 1.4 - (hide annotations) (download)
Tue Apr 21 15:54:06 2009 UTC (17 years, 4 months ago) by utke
Branch: MAIN
Changes since 1.3: +5 -8 lines
extended propagation options

1 utke 1.1 C taping --------------------------------------------
2    
3     subroutine push(x)
4     C $OpenAD$ INLINE DECLS
5     use OpenAD_tape
6     implicit none
7     double precision :: x
8     C $OpenAD$ END DECLS
9     if(oad_dt_sz .lt. oad_dt_ptr) call oad_dt_grow()
10     oad_dt(oad_dt_ptr)=x; oad_dt_ptr=oad_dt_ptr+1
11     end subroutine
12    
13     subroutine pop(x)
14     C $OpenAD$ INLINE DECLS
15     use OpenAD_tape
16     implicit none
17     double precision :: x
18     C $OpenAD$ END DECLS
19     oad_dt_ptr=oad_dt_ptr-1
20     x=oad_dt(oad_dt_ptr)
21     end subroutine
22    
23     subroutine apush(x)
24     C $OpenAD$ INLINE DECLS
25     use OpenAD_tape
26     implicit none
27     double precision :: x
28     C $OpenAD$ END DECLS
29     if(oad_dt_sz .lt. oad_dt_ptr) call oad_dt_grow()
30     oad_dt(oad_dt_ptr)=x%v; oad_dt_ptr=oad_dt_ptr+1
31     end subroutine
32    
33     subroutine apop(x)
34     C $OpenAD$ INLINE DECLS
35     use OpenAD_tape
36     implicit none
37     type(active):: x
38     C $OpenAD$ END DECLS
39     oad_dt_ptr=oad_dt_ptr-1
40     x%v=oad_dt(oad_dt_ptr)
41     end subroutine
42    
43     subroutine push_i(x)
44     C $OpenAD$ INLINE DECLS
45     use OpenAD_tape
46     implicit none
47     integer :: x
48     C $OpenAD$ END DECLS
49     if(oad_it_sz .lt. oad_it_ptr) call oad_it_grow()
50     oad_it(oad_it_ptr)=x; oad_it_ptr=oad_it_ptr+1
51     end subroutine
52    
53     subroutine pop_i(x)
54     C $OpenAD$ INLINE DECLS
55     use OpenAD_tape
56     implicit none
57     integer :: x
58     C $OpenAD$ END DECLS
59     oad_it_ptr=oad_it_ptr-1
60     x=oad_it(oad_it_ptr)
61     end subroutine
62    
63     subroutine push_b(x)
64     C $OpenAD$ INLINE DECLS
65     use OpenAD_tape
66     implicit none
67     logical :: x
68     C $OpenAD$ END DECLS
69     if(oad_lt_sz .lt. oad_lt_ptr) call oad_lt_grow()
70     oad_lt(oad_lt_ptr)=x; oad_lt_ptr=oad_lt_ptr+1
71     end subroutine
72    
73     subroutine pop_b(x)
74     C $OpenAD$ INLINE DECLS
75     use OpenAD_tape
76     implicit none
77     logical :: x
78     C $OpenAD$ END DECLS
79     oad_lt_ptr=oad_lt_ptr-1
80     x=oad_lt(oad_lt_ptr)
81     end subroutine
82    
83     subroutine push_s(x)
84     C $OpenAD$ INLINE DECLS
85     use OpenAD_tape
86     implicit none
87     character*(80) :: x
88     C $OpenAD$ END DECLS
89     if(oad_st_sz .lt. oad_st_ptr) call oad_st_grow()
90     oad_st(oad_st_ptr)=x; oad_st_ptr=oad_st_ptr+1
91     end subroutine
92    
93     subroutine pop_s(x)
94     C $OpenAD$ INLINE DECLS
95     use OpenAD_tape
96     implicit none
97     character*(80) :: x
98     C $OpenAD$ END DECLS
99     oad_st_ptr=oad_st_ptr-1
100     x=oad_st(oad_st_ptr)
101     end subroutine
102    
103     subroutine saxpy(a,x,y)
104     C $OpenAD$ INLINE DECLS
105     double precision, intent(in) :: a
106     type(active), intent(in) :: x
107     type(active), intent(inout) :: y
108     C $OpenAD$ END DECLS
109     y%d=y%d+x%d*a
110     end subroutine
111    
112     subroutine zeroderiv(x)
113     C $OpenAD$ INLINE DECLS
114     type(active), intent(out) :: x
115     C $OpenAD$ END DECLS
116     x%d=0.0d0
117     end subroutine
118    
119     subroutine setderiv(y,x)
120     C $OpenAD$ INLINE DECLS
121     type(active), intent(out) :: x
122     type(active), intent(in) :: y
123     C $OpenAD$ END DECLS
124     x%d=y%d
125     end subroutine
126    
127     subroutine incderiv(y,x)
128     C $OpenAD$ INLINE DECLS
129     type(active), intent(out) :: x
130     type(active), intent(in) :: y
131     C $OpenAD$ END DECLS
132     x%d=x%d+y%d
133     end subroutine
134    
135 utke 1.4 subroutine decderiv(y,x)
136 utke 1.1 C $OpenAD$ INLINE DECLS
137 utke 1.4 type(active), intent(out) :: x
138     type(active), intent(in) :: y
139 utke 1.1 C $OpenAD$ END DECLS
140 utke 1.4 x%d = x%d - y%d
141     end subroutine decderiv
142 utke 1.1
143     C Checkpointing stuff ---------------------------------------
144    
145     C reals -----------------------------------------------------
146     subroutine cp_arg_store_real_scalar(x)
147     C $OpenAD$ INLINE DECLS
148     double precision :: x
149     C $OpenAD$ END DECLS
150 utke 1.2 #ifdef OAD_DEBUG_CP
151 utke 1.3 print standardmessageunit,'OAD: cp write x ', x
152 utke 1.2 #endif
153 utke 1.1 write(cp_io_unit) x
154     end subroutine
155    
156     subroutine cp_arg_restore_real_scalar(x)
157     C $OpenAD$ INLINE DECLS
158     implicit none
159     double precision :: x
160     C $OpenAD$ END DECLS
161     read(cp_io_unit) x
162 utke 1.2 #ifdef OAD_DEBUG_CP
163 utke 1.3 print standardmessageunit,'OAD: cp read x ', x
164 utke 1.2 #endif
165 utke 1.1 end subroutine
166    
167     subroutine cp_arg_store_real_scalar_a(x)
168     C $OpenAD$ INLINE DECLS
169     double precision :: x
170     C $OpenAD$ END DECLS
171 utke 1.2 #ifdef OAD_DEBUG_CP
172 utke 1.3 print standardmessageunit,'OAD: cp write x ', x%v
173 utke 1.2 #endif
174 utke 1.1 write(cp_io_unit) x%v
175     end subroutine
176    
177     subroutine cp_arg_restore_real_scalar_a(x)
178     C $OpenAD$ INLINE DECLS
179     implicit none
180     double precision :: x
181     C $OpenAD$ END DECLS
182     read(cp_io_unit) x%v
183 utke 1.2 #ifdef OAD_DEBUG_CP
184 utke 1.3 print standardmessageunit,'OAD: cp read x ', x%v
185 utke 1.2 #endif
186 utke 1.1 end subroutine
187    
188     subroutine cp_arg_store_real_vector(x)
189     C $OpenAD$ INLINE DECLS
190     implicit none
191     double precision, dimension(:) :: x
192     C $OpenAD$ END DECLS
193 utke 1.2 #ifdef OAD_DEBUG_CP
194 utke 1.3 print standardmessageunit,'OAD: cp write x ', x(1)
195 utke 1.2 #endif
196 utke 1.1 write(cp_io_unit) x
197     end subroutine
198    
199     subroutine cp_arg_restore_real_vector(x)
200     C $OpenAD$ INLINE DECLS
201     implicit none
202     double precision, dimension(:) :: x
203     C $OpenAD$ END DECLS
204     read(cp_io_unit) x
205 utke 1.2 #ifdef OAD_DEBUG_CP
206 utke 1.3 print standardmessageunit,'OAD: cp read x ', x(1)
207 utke 1.2 #endif
208 utke 1.1 end subroutine
209    
210     subroutine cp_arg_store_real_vector_a(x)
211     C $OpenAD$ INLINE DECLS
212     implicit none
213     double precision, dimension(:) :: x
214     C $OpenAD$ END DECLS
215 utke 1.2 #ifdef OAD_DEBUG_CP
216 utke 1.3 print standardmessageunit,'OAD: cp write x ', x(1)%v
217 utke 1.2 #endif
218 utke 1.1 write(cp_io_unit) x%v
219     end subroutine
220    
221     subroutine cp_arg_restore_real_vector_a(x)
222     C $OpenAD$ INLINE DECLS
223     implicit none
224     double precision, dimension(:) :: x
225     C $OpenAD$ END DECLS
226     read(cp_io_unit) x%v
227 utke 1.2 #ifdef OAD_DEBUG_CP
228 utke 1.3 print standardmessageunit,'OAD: cp read x ', x(1)%v
229 utke 1.2 #endif
230 utke 1.1 end subroutine
231    
232     subroutine cp_arg_store_real_matrix(x)
233     C $OpenAD$ INLINE DECLS
234     implicit none
235     double precision, dimension(::) :: x
236     C $OpenAD$ END DECLS
237 utke 1.2 #ifdef OAD_DEBUG_CP
238 utke 1.3 print standardmessageunit,'OAD: cp write x ', x(1,1)
239 utke 1.2 #endif
240 utke 1.1 write(cp_io_unit) x
241     end subroutine
242    
243     subroutine cp_arg_restore_real_matrix(x)
244     C $OpenAD$ INLINE DECLS
245     implicit none
246     double precision, dimension(::) :: x
247     C $OpenAD$ END DECLS
248     read(cp_io_unit) x
249 utke 1.2 #ifdef OAD_DEBUG_CP
250 utke 1.3 print standardmessageunit,'OAD: cp read x ', x(1,1)
251 utke 1.2 #endif
252 utke 1.1 end subroutine
253    
254     subroutine cp_arg_store_real_matrix_a(x)
255     C $OpenAD$ INLINE DECLS
256     implicit none
257     double precision, dimension(::) :: x
258     C $OpenAD$ END DECLS
259 utke 1.2 #ifdef OAD_DEBUG_CP
260 utke 1.3 print standardmessageunit,'OAD: cp write x ', x(1,1)%v
261 utke 1.2 #endif
262 utke 1.1 write(cp_io_unit) x%v
263     end subroutine
264    
265     subroutine cp_arg_restore_real_matrix_a(x)
266     C $OpenAD$ INLINE DECLS
267     implicit none
268     double precision, dimension(::) :: x
269     C $OpenAD$ END DECLS
270     read(cp_io_unit) x%v
271 utke 1.2 #ifdef OAD_DEBUG_CP
272 utke 1.3 print standardmessageunit,'OAD: cp read x ', x(1.1)%v
273 utke 1.2 #endif
274 utke 1.1 end subroutine
275    
276     subroutine cp_arg_store_real_three_tensor(x)
277     C $OpenAD$ INLINE DECLS
278     implicit none
279     double precision, dimension(::) :: x
280     C $OpenAD$ END DECLS
281 utke 1.2 #ifdef OAD_DEBUG_CP
282 utke 1.3 print standardmessageunit,'OAD: cp write x ', x(1,1,1)
283 utke 1.2 #endif
284 utke 1.1 write(cp_io_unit) x
285     end subroutine
286    
287     subroutine cp_arg_store_real_three_tensor_a(x)
288     C $OpenAD$ INLINE DECLS
289     implicit none
290     double precision, dimension(::) :: x
291     C $OpenAD$ END DECLS
292 utke 1.2 #ifdef OAD_DEBUG_CP
293 utke 1.3 print standardmessageunit,'OAD: cp write x ', x(1,1,1)%v
294 utke 1.2 #endif
295 utke 1.1 write(cp_io_unit) x%v
296     end subroutine
297    
298     subroutine cp_arg_restore_real_three_tensor(x)
299     C $OpenAD$ INLINE DECLS
300     implicit none
301     double precision, dimension(::) :: x
302     C $OpenAD$ END DECLS
303     read(cp_io_unit) x
304 utke 1.2 #ifdef OAD_DEBUG_CP
305 utke 1.3 print standardmessageunit,'OAD: cp read x ', x(1,1,1)
306 utke 1.2 #endif
307 utke 1.1 end subroutine
308    
309     subroutine cp_arg_restore_real_three_tensor_a(x)
310     C $OpenAD$ INLINE DECLS
311     implicit none
312     double precision, dimension(::) :: x
313     C $OpenAD$ END DECLS
314 utke 1.2 #ifdef OAD_DEBUG_CP
315 utke 1.3 print standardmessageunit,'OAD: cp read x ', x%v
316 utke 1.2 #endif
317 utke 1.1 read(cp_io_unit) x%v
318     end subroutine
319    
320     subroutine cp_arg_store_real_four_tensor(x)
321     C $OpenAD$ INLINE DECLS
322     implicit none
323     double precision, dimension(::) :: x
324     C $OpenAD$ END DECLS
325 utke 1.2 #ifdef OAD_DEBUG_CP
326 utke 1.3 print standardmessageunit,'OAD: cp write x ', x(1,1,1,1)
327 utke 1.2 #endif
328 utke 1.1 write(cp_io_unit) x
329     end subroutine
330    
331     subroutine cp_arg_store_real_four_tensor_a(x)
332     C $OpenAD$ INLINE DECLS
333     implicit none
334     double precision, dimension(::) :: x
335     C $OpenAD$ END DECLS
336 utke 1.2 #ifdef OAD_DEBUG_CP
337 utke 1.3 print standardmessageunit,'OAD: cp write x ', x(1,1,1,1)%v
338 utke 1.2 #endif
339 utke 1.1 write(cp_io_unit) x%v
340     end subroutine
341    
342     subroutine cp_arg_restore_real_four_tensor(x)
343     C $OpenAD$ INLINE DECLS
344     implicit none
345     double precision, dimension(::) :: x
346     C $OpenAD$ END DECLS
347     read(cp_io_unit) x
348 utke 1.2 #ifdef OAD_DEBUG_CP
349 utke 1.3 print standardmessageunit,'OAD: cp read x ', x(1,1,1,1)
350 utke 1.2 #endif
351 utke 1.1 end subroutine
352    
353     subroutine cp_arg_restore_real_four_tensor_a(x)
354     C $OpenAD$ INLINE DECLS
355     implicit none
356     double precision, dimension(::) :: x
357     C $OpenAD$ END DECLS
358     read(cp_io_unit) x%v
359 utke 1.2 #ifdef OAD_DEBUG_CP
360 utke 1.3 print standardmessageunit,'OAD: cp read x ', x(1,1,1,1)%v
361 utke 1.2 #endif
362 utke 1.1 end subroutine
363    
364     subroutine cp_arg_store_real_five_tensor(x)
365     C $OpenAD$ INLINE DECLS
366     implicit none
367     double precision, dimension(::) :: x
368     C $OpenAD$ END DECLS
369 utke 1.2 #ifdef OAD_DEBUG_CP
370 utke 1.3 print standardmessageunit,'OAD: cp write x ', x(1,1,1,1,1)
371 utke 1.2 #endif
372 utke 1.1 write(cp_io_unit) x
373     end subroutine
374    
375     subroutine cp_arg_store_real_five_tensor_a(x)
376     C $OpenAD$ INLINE DECLS
377     implicit none
378     double precision, dimension(::) :: x
379     C $OpenAD$ END DECLS
380 utke 1.2 #ifdef OAD_DEBUG_CP
381 utke 1.3 print standardmessageunit,'OAD: cp write x ', x(1,1,1,1,1)%v
382 utke 1.2 #endif
383 utke 1.1 write(cp_io_unit) x%v
384     end subroutine
385    
386     subroutine cp_arg_restore_real_five_tensor(x)
387     C $OpenAD$ INLINE DECLS
388     implicit none
389     double precision, dimension(::) :: x
390     C $OpenAD$ END DECLS
391     read(cp_io_unit) x
392 utke 1.2 #ifdef OAD_DEBUG_CP
393 utke 1.3 print standardmessageunit,'OAD: cp read x ', x(1,1,1,1,1)
394 utke 1.2 #endif
395 utke 1.1 end subroutine
396    
397     subroutine cp_arg_restore_real_five_tensor_a(x)
398     C $OpenAD$ INLINE DECLS
399     implicit none
400     double precision, dimension(::) :: x
401     C $OpenAD$ END DECLS
402     read(cp_io_unit) x%v
403 utke 1.2 #ifdef OAD_DEBUG_CP
404 utke 1.3 print standardmessageunit,'OAD: cp read x ', x(1,1,1,1,1)%v
405 utke 1.2 #endif
406 utke 1.1 end subroutine
407    
408    
409     C integers -----------------------------------------------------
410     subroutine cp_arg_store_integer_scalar(x)
411     C $OpenAD$ INLINE DECLS
412     implicit none
413     integer :: x
414     C $OpenAD$ END DECLS
415 utke 1.2 #ifdef OAD_DEBUG_CP
416 utke 1.3 print standardmessageunit,'OAD: cp write x ', x
417 utke 1.2 #endif
418 utke 1.1 write(cp_io_unit) x
419     end subroutine
420    
421     subroutine cp_arg_restore_integer_scalar(x)
422     C $OpenAD$ INLINE DECLS
423     implicit none
424     integer :: x
425     C $OpenAD$ END DECLS
426     read(cp_io_unit) x
427 utke 1.2 #ifdef OAD_DEBUG_CP
428 utke 1.3 print standardmessageunit,'OAD: cp read x ', x
429 utke 1.2 #endif
430 utke 1.1 end subroutine
431    
432     subroutine cp_arg_store_integer_vector(x)
433     C $OpenAD$ INLINE DECLS
434     implicit none
435     integer, dimension(:) :: x
436     C $OpenAD$ END DECLS
437 utke 1.2 #ifdef OAD_DEBUG_CP
438 utke 1.3 print standardmessageunit,'OAD: cp write x ', x(1)
439 utke 1.2 #endif
440 utke 1.1 write(cp_io_unit) x
441     end subroutine
442    
443     subroutine cp_arg_restore_integer_vector(x)
444     C $OpenAD$ INLINE DECLS
445     implicit none
446     integer, dimension(:) :: x
447     C $OpenAD$ END DECLS
448     read(cp_io_unit) x
449 utke 1.2 #ifdef OAD_DEBUG_CP
450 utke 1.3 print standardmessageunit,'OAD: cp read x ', x(1)
451 utke 1.2 #endif
452 utke 1.1 end subroutine
453    
454     subroutine cp_arg_store_integer_three_tensor(x)
455     C $OpenAD$ INLINE DECLS
456     implicit none
457     integer, dimension(::) :: x
458     C $OpenAD$ END DECLS
459 utke 1.2 #ifdef OAD_DEBUG_CP
460 utke 1.3 print standardmessageunit,'OAD: cp write x ', x(1,1,1)
461 utke 1.2 #endif
462 utke 1.1 write(cp_io_unit) x
463     end subroutine
464    
465     subroutine cp_arg_restore_integer_three_tensor(x)
466     C $OpenAD$ INLINE DECLS
467     implicit none
468     integer, dimension(::) :: x
469     C $OpenAD$ END DECLS
470     read(cp_io_unit) x
471 utke 1.2 #ifdef OAD_DEBUG_CP
472 utke 1.3 print standardmessageunit,'OAD: cp read x ', x(1,1,1)
473 utke 1.2 #endif
474 utke 1.1 end subroutine
475    
476     subroutine cp_arg_store_integer_four_tensor(x)
477     C $OpenAD$ INLINE DECLS
478     implicit none
479     integer, dimension(::) :: x
480     C $OpenAD$ END DECLS
481 utke 1.2 #ifdef OAD_DEBUG_CP
482 utke 1.3 print standardmessageunit,'OAD: cp write x ', x(1,1,1,1)
483 utke 1.2 #endif
484 utke 1.1 write(cp_io_unit) x
485     end subroutine
486    
487     subroutine cp_arg_restore_integer_four_tensor(x)
488     C $OpenAD$ INLINE DECLS
489     implicit none
490     integer, dimension(::) :: x
491     C $OpenAD$ END DECLS
492     read(cp_io_unit) x
493 utke 1.2 #ifdef OAD_DEBUG_CP
494 utke 1.3 print standardmessageunit,'OAD: cp read x ', x(1,1,1,1)
495 utke 1.2 #endif
496 utke 1.1 end subroutine
497    
498     subroutine cp_arg_store_integer_five_tensor(x)
499     C $OpenAD$ INLINE DECLS
500     implicit none
501     integer, dimension(::) :: x
502     C $OpenAD$ END DECLS
503 utke 1.2 #ifdef OAD_DEBUG_CP
504 utke 1.3 print standardmessageunit,'OAD: cp write x ', x(1,1,1,1,1)
505 utke 1.2 #endif
506 utke 1.1 write(cp_io_unit) x
507     end subroutine
508    
509     subroutine cp_arg_restore_integer_five_tensor(x)
510     C $OpenAD$ INLINE DECLS
511     implicit none
512     integer, dimension(::) :: x
513     C $OpenAD$ END DECLS
514     read (cp_io_unit) x
515 utke 1.2 #ifdef OAD_DEBUG_CP
516 utke 1.3 print standardmessageunit,'OAD: cp read x ', x(1,1,1,1,1)
517 utke 1.2 #endif
518 utke 1.1 end subroutine
519    
520     C strings -----------------------------------------------------
521     subroutine cp_arg_store_string_scalar(x)
522     C $OpenAD$ INLINE DECLS
523     implicit none
524     character*(80) :: x
525     C $OpenAD$ END DECLS
526 utke 1.2 #ifdef OAD_DEBUG_CP
527 utke 1.3 print standardmessageunit,'OAD: cp write x ', x
528 utke 1.2 #endif
529 utke 1.1 write(cp_io_unit) x
530     end subroutine
531    
532     subroutine cp_arg_restore_string_scalar(x)
533     C $OpenAD$ INLINE DECLS
534     implicit none
535     character*(80) :: x
536     C $OpenAD$ END DECLS
537     read (cp_io_unit) x
538 utke 1.2 #ifdef OAD_DEBUG_CP
539 utke 1.3 print standardmessageunit,'OAD: cp read x ', x
540 utke 1.2 #endif
541 utke 1.1 end subroutine
542    
543     C bools -----------------------------------------------------
544     subroutine cp_arg_store_bool_scalar(x)
545     C $OpenAD$ INLINE DECLS
546     implicit none
547     logical :: x
548     C $OpenAD$ END DECLS
549 utke 1.2 #ifdef OAD_DEBUG_CP
550 utke 1.3 print standardmessageunit,'OAD: cp write x ', x
551 utke 1.2 #endif
552 utke 1.1 write(cp_io_unit) x
553     end subroutine
554    
555     subroutine cp_arg_restore_bool_scalar(x)
556     C $OpenAD$ INLINE DECLS
557     implicit none
558     logical :: x
559     C $OpenAD$ END DECLS
560     read (cp_io_unit) x
561 utke 1.2 #ifdef OAD_DEBUG_CP
562 utke 1.3 print standardmessageunit,'OAD: cp read x ', x
563 utke 1.2 #endif
564 utke 1.1 end subroutine

  ViewVC Help
Powered by ViewVC 1.1.22