/[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.3 - (hide annotations) (download)
Fri Feb 20 21:07:17 2009 UTC (17 years, 6 months ago) by utke
Branch: MAIN
CVS Tags: HEAD
Changes since 1.2: +0 -0 lines
FILE REMOVED
rename to make it go through the preprocessor

1 utke 1.1 C taping --------------------------------------------
2    
3     subroutine push(x)
4     C $OpenAD$ INLINE DECLS
5 utke 1.2 use OpenAD_tape
6     implicit none
7 utke 1.1 double precision :: x
8     C $OpenAD$ END DECLS
9 utke 1.2 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 utke 1.1 end subroutine
12    
13     subroutine pop(x)
14     C $OpenAD$ INLINE DECLS
15 utke 1.2 use OpenAD_tape
16     implicit none
17 utke 1.1 double precision :: x
18     C $OpenAD$ END DECLS
19 utke 1.2 oad_dt_ptr=oad_dt_ptr-1
20     x=oad_dt(oad_dt_ptr)
21 utke 1.1 end subroutine
22    
23     subroutine apush(x)
24     C $OpenAD$ INLINE DECLS
25 utke 1.2 use OpenAD_tape
26     implicit none
27 utke 1.1 double precision :: x
28     C $OpenAD$ END DECLS
29 utke 1.2 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 utke 1.1 end subroutine
32    
33     subroutine apop(x)
34     C $OpenAD$ INLINE DECLS
35 utke 1.2 use OpenAD_tape
36     implicit none
37 utke 1.1 type(active):: x
38     C $OpenAD$ END DECLS
39 utke 1.2 oad_dt_ptr=oad_dt_ptr-1
40     x%v=oad_dt(oad_dt_ptr)
41 utke 1.1 end subroutine
42    
43     subroutine push_i(x)
44     C $OpenAD$ INLINE DECLS
45 utke 1.2 use OpenAD_tape
46     implicit none
47 utke 1.1 integer :: x
48     C $OpenAD$ END DECLS
49 utke 1.2 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 utke 1.1 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 utke 1.2 oad_it_ptr=oad_it_ptr-1
60     x=oad_it(oad_it_ptr)
61 utke 1.1 end subroutine
62    
63     subroutine push_b(x)
64     C $OpenAD$ INLINE DECLS
65 utke 1.2 use OpenAD_tape
66     implicit none
67 utke 1.1 logical :: x
68     C $OpenAD$ END DECLS
69 utke 1.2 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 utke 1.1 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 utke 1.2 oad_lt_ptr=oad_lt_ptr-1
80     x=oad_lt(oad_lt_ptr)
81 utke 1.1 end subroutine
82    
83     subroutine push_s(x)
84     C $OpenAD$ INLINE DECLS
85 utke 1.2 use OpenAD_tape
86     implicit none
87 utke 1.1 character*(80) :: x
88     C $OpenAD$ END DECLS
89 utke 1.2 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 utke 1.1 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 utke 1.2 oad_st_ptr=oad_st_ptr-1
100     x=oad_st(oad_st_ptr)
101 utke 1.1 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     print *,'JU: cp write x ', x
154     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     print *,'JU: cp read x ', x
164     end subroutine
165    
166     subroutine cp_arg_store_real_scalar_a(x)
167     C $OpenAD$ INLINE DECLS
168     double precision :: x
169     C $OpenAD$ END DECLS
170     print *,'JU: cp write x ', x%v
171     write(cp_io_unit) x%v
172     end subroutine
173    
174     subroutine cp_arg_restore_real_scalar_a(x)
175     C $OpenAD$ INLINE DECLS
176     implicit none
177     double precision :: x
178     C $OpenAD$ END DECLS
179     read(cp_io_unit) x%v
180     print *,'JU: cp read x ', x%v
181     end subroutine
182    
183     subroutine cp_arg_store_real_vector(x)
184     C $OpenAD$ INLINE DECLS
185     implicit none
186     double precision, dimension(:) :: x
187     C $OpenAD$ END DECLS
188     print *,'JU: cp write x ', x(1)
189     write(cp_io_unit) x
190     end subroutine
191    
192     subroutine cp_arg_restore_real_vector(x)
193     C $OpenAD$ INLINE DECLS
194     implicit none
195     double precision, dimension(:) :: x
196     C $OpenAD$ END DECLS
197     read(cp_io_unit) x
198     print *,'JU: cp read x ', x(1)
199     end subroutine
200    
201     subroutine cp_arg_store_real_vector_a(x)
202     C $OpenAD$ INLINE DECLS
203     implicit none
204     double precision, dimension(:) :: x
205     C $OpenAD$ END DECLS
206     print *,'JU: cp write x ', x(1)%v
207     write(cp_io_unit) x%v
208     end subroutine
209    
210     subroutine cp_arg_restore_real_vector_a(x)
211     C $OpenAD$ INLINE DECLS
212     implicit none
213     double precision, dimension(:) :: x
214     C $OpenAD$ END DECLS
215     read(cp_io_unit) x%v
216     print *,'JU: cp read x ', x(1)%v
217     end subroutine
218    
219     subroutine cp_arg_store_real_matrix(x)
220     C $OpenAD$ INLINE DECLS
221     implicit none
222     double precision, dimension(::) :: x
223     C $OpenAD$ END DECLS
224     print *,'JU: cp write x ', x(1,1)
225     write(cp_io_unit) x
226     end subroutine
227    
228     subroutine cp_arg_restore_real_matrix(x)
229     C $OpenAD$ INLINE DECLS
230     implicit none
231     double precision, dimension(::) :: x
232     C $OpenAD$ END DECLS
233     read(cp_io_unit) x
234     print *,'JU: cp read x ', x(1,1)
235     end subroutine
236    
237     subroutine cp_arg_store_real_matrix_a(x)
238     C $OpenAD$ INLINE DECLS
239     implicit none
240     double precision, dimension(::) :: x
241     C $OpenAD$ END DECLS
242     print *,'JU: cp write x ', x(1,1)%v
243     write(cp_io_unit) x%v
244     end subroutine
245    
246     subroutine cp_arg_restore_real_matrix_a(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%v
252     print *,'JU: cp read x ', x(1.1)%v
253     end subroutine
254    
255     subroutine cp_arg_store_real_three_tensor(x)
256     C $OpenAD$ INLINE DECLS
257     implicit none
258     double precision, dimension(::) :: x
259     C $OpenAD$ END DECLS
260     print *,'JU: cp write x ', x(1,1,1)
261     write(cp_io_unit) x
262     end subroutine
263    
264     subroutine cp_arg_store_real_three_tensor_a(x)
265     C $OpenAD$ INLINE DECLS
266     implicit none
267     double precision, dimension(::) :: x
268     C $OpenAD$ END DECLS
269     print *,'JU: cp write x ', x(1,1,1)%v
270     write(cp_io_unit) x%v
271     end subroutine
272    
273     subroutine cp_arg_restore_real_three_tensor(x)
274     C $OpenAD$ INLINE DECLS
275     implicit none
276     double precision, dimension(::) :: x
277     C $OpenAD$ END DECLS
278     read(cp_io_unit) x
279     print *,'JU: cp read x ', x(1,1,1)
280     end subroutine
281    
282     subroutine cp_arg_restore_real_three_tensor_a(x)
283     C $OpenAD$ INLINE DECLS
284     implicit none
285     double precision, dimension(::) :: x
286     C $OpenAD$ END DECLS
287     print *,'JU: cp read x ', x%v
288     read(cp_io_unit) x%v
289     end subroutine
290    
291     subroutine cp_arg_store_real_four_tensor(x)
292     C $OpenAD$ INLINE DECLS
293     implicit none
294     double precision, dimension(::) :: x
295     C $OpenAD$ END DECLS
296     print *,'JU: cp write x ', x(1,1,1,1)
297     write(cp_io_unit) x
298     end subroutine
299    
300     subroutine cp_arg_store_real_four_tensor_a(x)
301     C $OpenAD$ INLINE DECLS
302     implicit none
303     double precision, dimension(::) :: x
304     C $OpenAD$ END DECLS
305     print *,'JU: cp write x ', x(1,1,1,1)%v
306     write(cp_io_unit) x%v
307     end subroutine
308    
309     subroutine cp_arg_restore_real_four_tensor(x)
310     C $OpenAD$ INLINE DECLS
311     implicit none
312     double precision, dimension(::) :: x
313     C $OpenAD$ END DECLS
314     read(cp_io_unit) x
315     print *,'JU: cp read x ', x(1,1,1,1)
316     end subroutine
317    
318     subroutine cp_arg_restore_real_four_tensor_a(x)
319     C $OpenAD$ INLINE DECLS
320     implicit none
321     double precision, dimension(::) :: x
322     C $OpenAD$ END DECLS
323     read(cp_io_unit) x%v
324     print *,'JU: cp read x ', x(1,1,1,1)%v
325     end subroutine
326    
327     subroutine cp_arg_store_real_five_tensor(x)
328     C $OpenAD$ INLINE DECLS
329     implicit none
330     double precision, dimension(::) :: x
331     C $OpenAD$ END DECLS
332     print *,'JU: cp write x ', x(1,1,1,1,1)
333     write(cp_io_unit) x
334     end subroutine
335    
336     subroutine cp_arg_store_real_five_tensor_a(x)
337     C $OpenAD$ INLINE DECLS
338     implicit none
339     double precision, dimension(::) :: x
340     C $OpenAD$ END DECLS
341     print *,'JU: cp write x ', x(1,1,1,1,1)%v
342     write(cp_io_unit) x%v
343     end subroutine
344    
345     subroutine cp_arg_restore_real_five_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     print *,'JU: cp read x ', x(1,1,1,1,1)
352     end subroutine
353    
354     subroutine cp_arg_restore_real_five_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     print *,'JU: cp read x ', x(1,1,1,1,1)%v
361     end subroutine
362    
363    
364     C integers -----------------------------------------------------
365     subroutine cp_arg_store_integer_scalar(x)
366     C $OpenAD$ INLINE DECLS
367     implicit none
368     integer :: x
369     C $OpenAD$ END DECLS
370     print *,'JU: cp write x ', x
371     write(cp_io_unit) x
372     end subroutine
373    
374     subroutine cp_arg_restore_integer_scalar(x)
375     C $OpenAD$ INLINE DECLS
376     implicit none
377     integer :: x
378     C $OpenAD$ END DECLS
379     read(cp_io_unit) x
380     print *,'JU: cp read x ', x
381     end subroutine
382    
383     subroutine cp_arg_store_integer_vector(x)
384     C $OpenAD$ INLINE DECLS
385     implicit none
386     integer, dimension(:) :: x
387     C $OpenAD$ END DECLS
388     print *,'JU: cp write x ', x(1)
389     write(cp_io_unit) x
390     end subroutine
391    
392     subroutine cp_arg_restore_integer_vector(x)
393     C $OpenAD$ INLINE DECLS
394     implicit none
395     integer, dimension(:) :: x
396     C $OpenAD$ END DECLS
397     read(cp_io_unit) x
398     print *,'JU: cp read x ', x(1)
399     end subroutine
400    
401     subroutine cp_arg_store_integer_three_tensor(x)
402     C $OpenAD$ INLINE DECLS
403     implicit none
404     integer, dimension(::) :: x
405     C $OpenAD$ END DECLS
406     print *,'JU: cp write x ', x(1,1,1)
407     write(cp_io_unit) x
408     end subroutine
409    
410     subroutine cp_arg_restore_integer_three_tensor(x)
411     C $OpenAD$ INLINE DECLS
412     implicit none
413     integer, dimension(::) :: x
414     C $OpenAD$ END DECLS
415     read(cp_io_unit) x
416     print *,'JU: cp read x ', x(1,1,1)
417     end subroutine
418    
419     subroutine cp_arg_store_integer_four_tensor(x)
420     C $OpenAD$ INLINE DECLS
421     implicit none
422     integer, dimension(::) :: x
423     C $OpenAD$ END DECLS
424     print *,'JU: cp write x ', x(1,1,1,1)
425     write(cp_io_unit) x
426     end subroutine
427    
428     subroutine cp_arg_restore_integer_four_tensor(x)
429     C $OpenAD$ INLINE DECLS
430     implicit none
431     integer, dimension(::) :: x
432     C $OpenAD$ END DECLS
433     read(cp_io_unit) x
434     print *,'JU: cp read x ', x(1,1,1,1)
435     end subroutine
436    
437     subroutine cp_arg_store_integer_five_tensor(x)
438     C $OpenAD$ INLINE DECLS
439     implicit none
440     integer, dimension(::) :: x
441     C $OpenAD$ END DECLS
442     print *,'JU: cp write x ', x(1,1,1,1,1)
443     write(cp_io_unit) x
444     end subroutine
445    
446     subroutine cp_arg_restore_integer_five_tensor(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     print *,'JU: cp read x ', x(1,1,1,1,1)
453     end subroutine
454    
455     C strings -----------------------------------------------------
456     subroutine cp_arg_store_string_scalar(x)
457     C $OpenAD$ INLINE DECLS
458     implicit none
459     character*(80) :: x
460     C $OpenAD$ END DECLS
461     print *,'JU: cp write x ', x
462     write(cp_io_unit) x
463     end subroutine
464    
465     subroutine cp_arg_restore_string_scalar(x)
466     C $OpenAD$ INLINE DECLS
467     implicit none
468     character*(80) :: x
469     C $OpenAD$ END DECLS
470     read (cp_io_unit) x
471     print *,'JU: cp read x ', x
472     end subroutine
473    
474     C bools -----------------------------------------------------
475     subroutine cp_arg_store_bool_scalar(x)
476     C $OpenAD$ INLINE DECLS
477     implicit none
478     logical :: x
479     C $OpenAD$ END DECLS
480     print *,'JU: cp write x ', x
481     write(cp_io_unit) x
482     end subroutine
483    
484     subroutine cp_arg_restore_bool_scalar(x)
485     C $OpenAD$ INLINE DECLS
486     implicit none
487     logical :: x
488     C $OpenAD$ END DECLS
489     read (cp_io_unit) x
490     print *,'JU: cp read x ', x
491     end subroutine

  ViewVC Help
Powered by ViewVC 1.1.22