/[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.7 - (hide annotations) (download)
Tue Mar 1 05:58:48 2011 UTC (15 years, 6 months ago) by utke
Branch: MAIN
Changes since 1.6: +2 -2 lines
update following OpenAD change

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

  ViewVC Help
Powered by ViewVC 1.1.22