/[MITgcm]/MITgcm_contrib/heimbach/OpenAD/code_shallow_openad2/ad_inline.f
ViewVC logotype

Annotation of /MITgcm_contrib/heimbach/OpenAD/code_shallow_openad2/ad_inline.f

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


Revision 1.4 - (hide annotations) (download)
Wed Nov 8 15:01:29 2006 UTC (20 years ago) by utke
Branch: MAIN
Changes since 1.3: +24 -24 lines
don't checkpoint the adjoint portion or else it gets overwritten on checkpoint read

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

  ViewVC Help
Powered by ViewVC 1.1.22