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

Contents of /MITgcm_contrib/heimbach/OpenAD/code_shallow_openad3/ad_inline.f

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


Revision 1.5 - (show annotations) (download)
Thu Dec 19 16:10:19 2013 UTC (12 years, 10 months ago) by utke
Branch: MAIN
CVS Tags: HEAD
Changes since 1.4: +0 -0 lines
FILE REMOVED
stale

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