/[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.1 - (hide annotations) (download)
Tue Nov 20 15:19:43 2007 UTC (18 years, 9 months ago) by utke
Branch: MAIN
common runtime support

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

  ViewVC Help
Powered by ViewVC 1.1.22