/[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.2 - (hide annotations) (download)
Tue Feb 24 07:00:34 2009 UTC (17 years, 6 months ago) by utke
Branch: MAIN
Changes since 1.1: +114 -38 lines
reducing progress message via preprocessor

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     subroutine condinczeroderiv(y,x)
136     C $OpenAD$ INLINE DECLS
137     type(active), intent(out) :: x
138     type(active), intent(in) :: y
139     C $OpenAD$ END DECLS
140     if (iaddr(y).ne.iaddr(x)) then
141     x%d=x%d+y%d
142     y%d=0
143     end if
144     end subroutine
145    
146     C Checkpointing stuff ---------------------------------------
147    
148     C reals -----------------------------------------------------
149     subroutine cp_arg_store_real_scalar(x)
150     C $OpenAD$ INLINE DECLS
151     double precision :: x
152     C $OpenAD$ END DECLS
153 utke 1.2 #ifdef OAD_DEBUG_CP
154     print *,'OAD: cp write x ', x
155     #endif
156 utke 1.1 write(cp_io_unit) x
157     end subroutine
158    
159     subroutine cp_arg_restore_real_scalar(x)
160     C $OpenAD$ INLINE DECLS
161     implicit none
162     double precision :: x
163     C $OpenAD$ END DECLS
164     read(cp_io_unit) x
165 utke 1.2 #ifdef OAD_DEBUG_CP
166     print *,'OAD: cp read x ', x
167     #endif
168 utke 1.1 end subroutine
169    
170     subroutine cp_arg_store_real_scalar_a(x)
171     C $OpenAD$ INLINE DECLS
172     double precision :: x
173     C $OpenAD$ END DECLS
174 utke 1.2 #ifdef OAD_DEBUG_CP
175     print *,'OAD: cp write x ', x%v
176     #endif
177 utke 1.1 write(cp_io_unit) x%v
178     end subroutine
179    
180     subroutine cp_arg_restore_real_scalar_a(x)
181     C $OpenAD$ INLINE DECLS
182     implicit none
183     double precision :: x
184     C $OpenAD$ END DECLS
185     read(cp_io_unit) x%v
186 utke 1.2 #ifdef OAD_DEBUG_CP
187     print *,'OAD: cp read x ', x%v
188     #endif
189 utke 1.1 end subroutine
190    
191     subroutine cp_arg_store_real_vector(x)
192     C $OpenAD$ INLINE DECLS
193     implicit none
194     double precision, dimension(:) :: x
195     C $OpenAD$ END DECLS
196 utke 1.2 #ifdef OAD_DEBUG_CP
197     print *,'OAD: cp write x ', x(1)
198     #endif
199 utke 1.1 write(cp_io_unit) x
200     end subroutine
201    
202     subroutine cp_arg_restore_real_vector(x)
203     C $OpenAD$ INLINE DECLS
204     implicit none
205     double precision, dimension(:) :: x
206     C $OpenAD$ END DECLS
207     read(cp_io_unit) x
208 utke 1.2 #ifdef OAD_DEBUG_CP
209     print *,'OAD: cp read x ', x(1)
210     #endif
211 utke 1.1 end subroutine
212    
213     subroutine cp_arg_store_real_vector_a(x)
214     C $OpenAD$ INLINE DECLS
215     implicit none
216     double precision, dimension(:) :: x
217     C $OpenAD$ END DECLS
218 utke 1.2 #ifdef OAD_DEBUG_CP
219     print *,'OAD: cp write x ', x(1)%v
220     #endif
221 utke 1.1 write(cp_io_unit) x%v
222     end subroutine
223    
224     subroutine cp_arg_restore_real_vector_a(x)
225     C $OpenAD$ INLINE DECLS
226     implicit none
227     double precision, dimension(:) :: x
228     C $OpenAD$ END DECLS
229     read(cp_io_unit) x%v
230 utke 1.2 #ifdef OAD_DEBUG_CP
231     print *,'OAD: cp read x ', x(1)%v
232     #endif
233 utke 1.1 end subroutine
234    
235     subroutine cp_arg_store_real_matrix(x)
236     C $OpenAD$ INLINE DECLS
237     implicit none
238     double precision, dimension(::) :: x
239     C $OpenAD$ END DECLS
240 utke 1.2 #ifdef OAD_DEBUG_CP
241     print *,'OAD: cp write x ', x(1,1)
242     #endif
243 utke 1.1 write(cp_io_unit) x
244     end subroutine
245    
246     subroutine cp_arg_restore_real_matrix(x)
247     C $OpenAD$ INLINE DECLS
248     implicit none
249     double precision, dimension(::) :: x
250     C $OpenAD$ END DECLS
251     read(cp_io_unit) x
252 utke 1.2 #ifdef OAD_DEBUG_CP
253     print *,'OAD: cp read x ', x(1,1)
254     #endif
255 utke 1.1 end subroutine
256    
257     subroutine cp_arg_store_real_matrix_a(x)
258     C $OpenAD$ INLINE DECLS
259     implicit none
260     double precision, dimension(::) :: x
261     C $OpenAD$ END DECLS
262 utke 1.2 #ifdef OAD_DEBUG_CP
263     print *,'OAD: cp write x ', x(1,1)%v
264     #endif
265 utke 1.1 write(cp_io_unit) x%v
266     end subroutine
267    
268     subroutine cp_arg_restore_real_matrix_a(x)
269     C $OpenAD$ INLINE DECLS
270     implicit none
271     double precision, dimension(::) :: x
272     C $OpenAD$ END DECLS
273     read(cp_io_unit) x%v
274 utke 1.2 #ifdef OAD_DEBUG_CP
275     print *,'OAD: cp read x ', x(1.1)%v
276     #endif
277 utke 1.1 end subroutine
278    
279     subroutine cp_arg_store_real_three_tensor(x)
280     C $OpenAD$ INLINE DECLS
281     implicit none
282     double precision, dimension(::) :: x
283     C $OpenAD$ END DECLS
284 utke 1.2 #ifdef OAD_DEBUG_CP
285     print *,'OAD: cp write x ', x(1,1,1)
286     #endif
287 utke 1.1 write(cp_io_unit) x
288     end subroutine
289    
290     subroutine cp_arg_store_real_three_tensor_a(x)
291     C $OpenAD$ INLINE DECLS
292     implicit none
293     double precision, dimension(::) :: x
294     C $OpenAD$ END DECLS
295 utke 1.2 #ifdef OAD_DEBUG_CP
296     print *,'OAD: cp write x ', x(1,1,1)%v
297     #endif
298 utke 1.1 write(cp_io_unit) x%v
299     end subroutine
300    
301     subroutine cp_arg_restore_real_three_tensor(x)
302     C $OpenAD$ INLINE DECLS
303     implicit none
304     double precision, dimension(::) :: x
305     C $OpenAD$ END DECLS
306     read(cp_io_unit) x
307 utke 1.2 #ifdef OAD_DEBUG_CP
308     print *,'OAD: cp read x ', x(1,1,1)
309     #endif
310 utke 1.1 end subroutine
311    
312     subroutine cp_arg_restore_real_three_tensor_a(x)
313     C $OpenAD$ INLINE DECLS
314     implicit none
315     double precision, dimension(::) :: x
316     C $OpenAD$ END DECLS
317 utke 1.2 #ifdef OAD_DEBUG_CP
318     print *,'OAD: cp read x ', x%v
319     #endif
320 utke 1.1 read(cp_io_unit) x%v
321     end subroutine
322    
323     subroutine cp_arg_store_real_four_tensor(x)
324     C $OpenAD$ INLINE DECLS
325     implicit none
326     double precision, dimension(::) :: x
327     C $OpenAD$ END DECLS
328 utke 1.2 #ifdef OAD_DEBUG_CP
329     print *,'OAD: cp write x ', x(1,1,1,1)
330     #endif
331 utke 1.1 write(cp_io_unit) x
332     end subroutine
333    
334     subroutine cp_arg_store_real_four_tensor_a(x)
335     C $OpenAD$ INLINE DECLS
336     implicit none
337     double precision, dimension(::) :: x
338     C $OpenAD$ END DECLS
339 utke 1.2 #ifdef OAD_DEBUG_CP
340     print *,'OAD: cp write x ', x(1,1,1,1)%v
341     #endif
342 utke 1.1 write(cp_io_unit) x%v
343     end subroutine
344    
345     subroutine cp_arg_restore_real_four_tensor(x)
346     C $OpenAD$ INLINE DECLS
347     implicit none
348     double precision, dimension(::) :: x
349     C $OpenAD$ END DECLS
350     read(cp_io_unit) x
351 utke 1.2 #ifdef OAD_DEBUG_CP
352     print *,'OAD: cp read x ', x(1,1,1,1)
353     #endif
354 utke 1.1 end subroutine
355    
356     subroutine cp_arg_restore_real_four_tensor_a(x)
357     C $OpenAD$ INLINE DECLS
358     implicit none
359     double precision, dimension(::) :: x
360     C $OpenAD$ END DECLS
361     read(cp_io_unit) x%v
362 utke 1.2 #ifdef OAD_DEBUG_CP
363     print *,'OAD: cp read x ', x(1,1,1,1)%v
364     #endif
365 utke 1.1 end subroutine
366    
367     subroutine cp_arg_store_real_five_tensor(x)
368     C $OpenAD$ INLINE DECLS
369     implicit none
370     double precision, dimension(::) :: x
371     C $OpenAD$ END DECLS
372 utke 1.2 #ifdef OAD_DEBUG_CP
373     print *,'OAD: cp write x ', x(1,1,1,1,1)
374     #endif
375 utke 1.1 write(cp_io_unit) x
376     end subroutine
377    
378     subroutine cp_arg_store_real_five_tensor_a(x)
379     C $OpenAD$ INLINE DECLS
380     implicit none
381     double precision, dimension(::) :: x
382     C $OpenAD$ END DECLS
383 utke 1.2 #ifdef OAD_DEBUG_CP
384     print *,'OAD: cp write x ', x(1,1,1,1,1)%v
385     #endif
386 utke 1.1 write(cp_io_unit) x%v
387     end subroutine
388    
389     subroutine cp_arg_restore_real_five_tensor(x)
390     C $OpenAD$ INLINE DECLS
391     implicit none
392     double precision, dimension(::) :: x
393     C $OpenAD$ END DECLS
394     read(cp_io_unit) x
395 utke 1.2 #ifdef OAD_DEBUG_CP
396     print *,'OAD: cp read x ', x(1,1,1,1,1)
397     #endif
398 utke 1.1 end subroutine
399    
400     subroutine cp_arg_restore_real_five_tensor_a(x)
401     C $OpenAD$ INLINE DECLS
402     implicit none
403     double precision, dimension(::) :: x
404     C $OpenAD$ END DECLS
405     read(cp_io_unit) x%v
406 utke 1.2 #ifdef OAD_DEBUG_CP
407     print *,'OAD: cp read x ', x(1,1,1,1,1)%v
408     #endif
409 utke 1.1 end subroutine
410    
411    
412     C integers -----------------------------------------------------
413     subroutine cp_arg_store_integer_scalar(x)
414     C $OpenAD$ INLINE DECLS
415     implicit none
416     integer :: x
417     C $OpenAD$ END DECLS
418 utke 1.2 #ifdef OAD_DEBUG_CP
419     print *,'OAD: cp write x ', x
420     #endif
421 utke 1.1 write(cp_io_unit) x
422     end subroutine
423    
424     subroutine cp_arg_restore_integer_scalar(x)
425     C $OpenAD$ INLINE DECLS
426     implicit none
427     integer :: x
428     C $OpenAD$ END DECLS
429     read(cp_io_unit) x
430 utke 1.2 #ifdef OAD_DEBUG_CP
431     print *,'OAD: cp read x ', x
432     #endif
433 utke 1.1 end subroutine
434    
435     subroutine cp_arg_store_integer_vector(x)
436     C $OpenAD$ INLINE DECLS
437     implicit none
438     integer, dimension(:) :: x
439     C $OpenAD$ END DECLS
440 utke 1.2 #ifdef OAD_DEBUG_CP
441     print *,'OAD: cp write x ', x(1)
442     #endif
443 utke 1.1 write(cp_io_unit) x
444     end subroutine
445    
446     subroutine cp_arg_restore_integer_vector(x)
447     C $OpenAD$ INLINE DECLS
448     implicit none
449     integer, dimension(:) :: x
450     C $OpenAD$ END DECLS
451     read(cp_io_unit) x
452 utke 1.2 #ifdef OAD_DEBUG_CP
453     print *,'OAD: cp read x ', x(1)
454     #endif
455 utke 1.1 end subroutine
456    
457     subroutine cp_arg_store_integer_three_tensor(x)
458     C $OpenAD$ INLINE DECLS
459     implicit none
460     integer, dimension(::) :: x
461     C $OpenAD$ END DECLS
462 utke 1.2 #ifdef OAD_DEBUG_CP
463     print *,'OAD: cp write x ', x(1,1,1)
464     #endif
465 utke 1.1 write(cp_io_unit) x
466     end subroutine
467    
468     subroutine cp_arg_restore_integer_three_tensor(x)
469     C $OpenAD$ INLINE DECLS
470     implicit none
471     integer, dimension(::) :: x
472     C $OpenAD$ END DECLS
473     read(cp_io_unit) x
474 utke 1.2 #ifdef OAD_DEBUG_CP
475     print *,'OAD: cp read x ', x(1,1,1)
476     #endif
477 utke 1.1 end subroutine
478    
479     subroutine cp_arg_store_integer_four_tensor(x)
480     C $OpenAD$ INLINE DECLS
481     implicit none
482     integer, dimension(::) :: x
483     C $OpenAD$ END DECLS
484 utke 1.2 #ifdef OAD_DEBUG_CP
485     print *,'OAD: cp write x ', x(1,1,1,1)
486     #endif
487 utke 1.1 write(cp_io_unit) x
488     end subroutine
489    
490     subroutine cp_arg_restore_integer_four_tensor(x)
491     C $OpenAD$ INLINE DECLS
492     implicit none
493     integer, dimension(::) :: x
494     C $OpenAD$ END DECLS
495     read(cp_io_unit) x
496 utke 1.2 #ifdef OAD_DEBUG_CP
497     print *,'OAD: cp read x ', x(1,1,1,1)
498     #endif
499 utke 1.1 end subroutine
500    
501     subroutine cp_arg_store_integer_five_tensor(x)
502     C $OpenAD$ INLINE DECLS
503     implicit none
504     integer, dimension(::) :: x
505     C $OpenAD$ END DECLS
506 utke 1.2 #ifdef OAD_DEBUG_CP
507     print *,'OAD: cp write x ', x(1,1,1,1,1)
508     #endif
509 utke 1.1 write(cp_io_unit) x
510     end subroutine
511    
512     subroutine cp_arg_restore_integer_five_tensor(x)
513     C $OpenAD$ INLINE DECLS
514     implicit none
515     integer, dimension(::) :: x
516     C $OpenAD$ END DECLS
517     read (cp_io_unit) x
518 utke 1.2 #ifdef OAD_DEBUG_CP
519     print *,'OAD: cp read x ', x(1,1,1,1,1)
520     #endif
521 utke 1.1 end subroutine
522    
523     C strings -----------------------------------------------------
524     subroutine cp_arg_store_string_scalar(x)
525     C $OpenAD$ INLINE DECLS
526     implicit none
527     character*(80) :: x
528     C $OpenAD$ END DECLS
529 utke 1.2 #ifdef OAD_DEBUG_CP
530     print *,'OAD: cp write x ', x
531     #endif
532 utke 1.1 write(cp_io_unit) x
533     end subroutine
534    
535     subroutine cp_arg_restore_string_scalar(x)
536     C $OpenAD$ INLINE DECLS
537     implicit none
538     character*(80) :: x
539     C $OpenAD$ END DECLS
540     read (cp_io_unit) x
541 utke 1.2 #ifdef OAD_DEBUG_CP
542     print *,'OAD: cp read x ', x
543     #endif
544 utke 1.1 end subroutine
545    
546     C bools -----------------------------------------------------
547     subroutine cp_arg_store_bool_scalar(x)
548     C $OpenAD$ INLINE DECLS
549     implicit none
550     logical :: x
551     C $OpenAD$ END DECLS
552 utke 1.2 #ifdef OAD_DEBUG_CP
553     print *,'OAD: cp write x ', x
554     #endif
555 utke 1.1 write(cp_io_unit) x
556     end subroutine
557    
558     subroutine cp_arg_restore_bool_scalar(x)
559     C $OpenAD$ INLINE DECLS
560     implicit none
561     logical :: x
562     C $OpenAD$ END DECLS
563     read (cp_io_unit) x
564 utke 1.2 #ifdef OAD_DEBUG_CP
565     print *,'OAD: cp read x ', x
566     #endif
567 utke 1.1 end subroutine

  ViewVC Help
Powered by ViewVC 1.1.22