/[MITgcm]/MITgcm/tools/OAD_support/ad_inline.F
ViewVC logotype

Annotation of /MITgcm/tools/OAD_support/ad_inline.F

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

Revision 1.5 - (hide annotations) (download)
Fri Jul 3 21:33:55 2015 UTC (8 years, 9 months ago) by heimbach
Branch: MAIN
CVS Tags: checkpoint66g, checkpoint66f, checkpoint66e, checkpoint66d, checkpoint66c, checkpoint66b, checkpoint66a, checkpoint66o, checkpoint66n, checkpoint66m, checkpoint66l, checkpoint66k, checkpoint66j, checkpoint66i, checkpoint66h, checkpoint65z, checkpoint65x, checkpoint65y, checkpoint65r, checkpoint65s, checkpoint65p, checkpoint65q, checkpoint65v, checkpoint65w, checkpoint65t, checkpoint65u, checkpoint65n, checkpoint65o, HEAD
Changes since 1.4: +229 -46 lines 
Merge and update from Krishna Narayanan's contrib area:
o genmake2 flag -diva (but only for OpenAD)
o required modifs for OAD_support
1 heimbach 1.1 C taping --------------------------------------------
2    
3    
4     subroutine push_s0(x)
5     C $OpenAD$ INLINE DECLS
6 utke 1.2 use OAD_tape
7 heimbach 1.1 implicit none
8     double precision :: x
9     C $OpenAD$ END DECLS
10     if(oad_dt_sz .lt. oad_dt_ptr) call oad_dt_grow()
11     oad_dt(oad_dt_ptr)=x; oad_dt_ptr=oad_dt_ptr+1
12     end subroutine
13    
14     subroutine pop_s0(x)
15     C $OpenAD$ INLINE DECLS
16 utke 1.2 use OAD_tape
17 heimbach 1.1 implicit none
18     double precision :: x
19     C $OpenAD$ END DECLS
20     oad_dt_ptr=oad_dt_ptr-1
21     x=oad_dt(oad_dt_ptr)
22     end subroutine
23    
24 utke 1.2 subroutine push_s1(x)
25     C $OpenAD$ INLINE DECLS
26     use OAD_tape
27     implicit none
28     double precision :: x(:)
29     C $OpenAD$ END DECLS
30     oad_chunk_size=size(x,1)
31     if(oad_dt_sz .lt. oad_dt_ptr+oad_chunk_size)
32     + call oad_dt_grow()
33     oad_dt(oad_dt_ptr:oad_dt_ptr+oad_chunk_size-1)=
34     +x
35     oad_dt_ptr=oad_dt_ptr+oad_chunk_size
36     end subroutine
37    
38     subroutine pop_s1(x)
39     C $OpenAD$ INLINE DECLS
40     use OAD_tape
41     implicit none
42     double precision :: x(:)
43     C $OpenAD$ END DECLS
44     oad_chunk_size=size(x,1)
45     oad_dt_ptr=oad_dt_ptr-oad_chunk_size
46     x=oad_dt(oad_dt_ptr:oad_dt_ptr+oad_chunk_size-1)
47     end subroutine
48    
49     subroutine push_s2(x)
50     C $OpenAD$ INLINE DECLS
51     use OAD_tape
52     implicit none
53     double precision :: x(:,:)
54     C $OpenAD$ END DECLS
55     oad_chunk_size=size(x,1)*size(x,2)
56     if(oad_dt_sz .lt. oad_dt_ptr+oad_chunk_size)
57     + call oad_dt_grow()
58     oad_dt(oad_dt_ptr:oad_dt_ptr+oad_chunk_size-1)=
59     +reshape(x,(/oad_chunk_size/))
60     oad_dt_ptr=oad_dt_ptr+oad_chunk_size
61     end subroutine
62    
63     subroutine pop_s2(x)
64     C $OpenAD$ INLINE DECLS
65     use OAD_tape
66     implicit none
67     double precision :: x(:,:)
68     C $OpenAD$ END DECLS
69     oad_chunk_size=size(x,1)*size(x,2)
70     oad_dt_ptr=oad_dt_ptr-oad_chunk_size
71     x=reshape(oad_dt(oad_dt_ptr:oad_dt_ptr+oad_chunk_size-1),
72     +shape(x))
73     end subroutine
74    
75 heimbach 1.1 subroutine apush(x)
76     C $OpenAD$ INLINE DECLS
77 utke 1.2 use OAD_tape
78     use OAD_active
79 heimbach 1.1 implicit none
80     type(active) :: x
81     C $OpenAD$ END DECLS
82     if(oad_dt_sz .lt. oad_dt_ptr) call oad_dt_grow()
83     oad_dt(oad_dt_ptr)=x%v; oad_dt_ptr=oad_dt_ptr+1
84     end subroutine
85    
86     subroutine apop(x)
87     C $OpenAD$ INLINE DECLS
88 utke 1.2 use OAD_tape
89     use OAD_active
90 heimbach 1.1 implicit none
91     type(active) :: x
92     C $OpenAD$ END DECLS
93     oad_dt_ptr=oad_dt_ptr-1
94     x%v=oad_dt(oad_dt_ptr)
95     end subroutine
96    
97     subroutine push_i_s0(x)
98     C $OpenAD$ INLINE DECLS
99 utke 1.2 use OAD_tape
100 heimbach 1.1 implicit none
101     integer :: x
102     C $OpenAD$ END DECLS
103     if(oad_it_sz .lt. oad_it_ptr) call oad_it_grow()
104     oad_it(oad_it_ptr)=x; oad_it_ptr=oad_it_ptr+1
105     end subroutine
106    
107     subroutine pop_i_s0(x)
108     C $OpenAD$ INLINE DECLS
109 utke 1.2 use OAD_tape
110 heimbach 1.1 implicit none
111     integer :: x
112     C $OpenAD$ END DECLS
113     oad_it_ptr=oad_it_ptr-1
114     x=oad_it(oad_it_ptr)
115     end subroutine
116    
117 utke 1.2 subroutine push_i_s1(x)
118     C $OpenAD$ INLINE DECLS
119     use OAD_tape
120     implicit none
121     integer :: x(:)
122     C $OpenAD$ END DECLS
123     oad_chunk_size=size(x,1)
124     if(oad_it_sz .lt. oad_it_ptr+oad_chunk_size)
125     +call oad_it_grow()
126     oad_it(oad_it_ptr:oad_it_ptr+oad_chunk_size-1)=
127     +x
128     oad_it_ptr=oad_it_ptr+oad_chunk_size
129     end subroutine
130    
131     subroutine pop_i_s1(x)
132     C $OpenAD$ INLINE DECLS
133     use OAD_tape
134     implicit none
135     integer :: x(:)
136     C $OpenAD$ END DECLS
137     oad_chunk_size=size(x,1)
138     oad_it_ptr=oad_it_ptr-oad_chunk_size
139     x=oad_it(oad_it_ptr:oad_it_ptr+oad_chunk_size-1)
140     end subroutine
141    
142     subroutine push_i_s2(x)
143     C $OpenAD$ INLINE DECLS
144     use OAD_tape
145     implicit none
146     integer :: x(:,:)
147     C $OpenAD$ END DECLS
148     oad_chunk_size=size(x,1)*size(x,2)
149     if(oad_it_sz .lt. oad_it_ptr+oad_chunk_size)
150     + call oad_it_grow()
151     oad_it(oad_it_ptr:oad_it_ptr+oad_chunk_size-1)=
152     +reshape(x,(/oad_chunk_size/))
153     oad_it_ptr=oad_it_ptr+oad_chunk_size
154     end subroutine
155    
156     subroutine pop_i_s2(x)
157     C $OpenAD$ INLINE DECLS
158     use OAD_tape
159     implicit none
160     integer :: x(:,:)
161     C $OpenAD$ END DECLS
162     oad_chunk_size=size(x,1)*size(x,2)
163     oad_it_ptr=oad_it_ptr-oad_chunk_size
164     x=reshape(oad_it(oad_it_ptr:oad_it_ptr+oad_chunk_size-1),
165     +shape(x))
166     end subroutine
167    
168 heimbach 1.1 subroutine push_b(x)
169     C $OpenAD$ INLINE DECLS
170 utke 1.2 use OAD_tape
171 heimbach 1.1 implicit none
172     logical :: x
173     C $OpenAD$ END DECLS
174     if(oad_lt_sz .lt. oad_lt_ptr) call oad_lt_grow()
175     oad_lt(oad_lt_ptr)=x; oad_lt_ptr=oad_lt_ptr+1
176     end subroutine
177    
178     subroutine pop_b(x)
179     C $OpenAD$ INLINE DECLS
180 utke 1.2 use OAD_tape
181 heimbach 1.1 implicit none
182     logical :: x
183     C $OpenAD$ END DECLS
184     oad_lt_ptr=oad_lt_ptr-1
185     x=oad_lt(oad_lt_ptr)
186     end subroutine
187    
188 utke 1.3 subroutine push_s(s)
189 heimbach 1.1 C $OpenAD$ INLINE DECLS
190 utke 1.2 use OAD_tape
191 heimbach 1.1 implicit none
192 utke 1.3 character*(80) :: s
193 heimbach 1.1 C $OpenAD$ END DECLS
194     if(oad_st_sz .lt. oad_st_ptr) call oad_st_grow()
195 utke 1.3 oad_st(oad_st_ptr)=s; oad_st_ptr=oad_st_ptr+1
196 heimbach 1.1 end subroutine
197    
198 utke 1.3 subroutine pop_s(s)
199 heimbach 1.1 C $OpenAD$ INLINE DECLS
200 utke 1.2 use OAD_tape
201 heimbach 1.1 implicit none
202 utke 1.3 character*(80) :: s
203 heimbach 1.1 C $OpenAD$ END DECLS
204     oad_st_ptr=oad_st_ptr-1
205 utke 1.3 s=oad_st(oad_st_ptr)
206 heimbach 1.1 end subroutine
207 utke 1.2
208     C ----------------------- Propagation -----------------------
209    
210 heimbach 1.1 subroutine saxpy(a,x,y)
211     C $OpenAD$ INLINE DECLS
212 utke 1.2 use OAD_active
213 utke 1.3 implicit none
214 heimbach 1.1 double precision, intent(in) :: a
215     type(active), intent(in) :: x
216     type(active), intent(inout) :: y
217     C $OpenAD$ END DECLS
218     y%d=y%d+x%d*(a)
219     end subroutine
220    
221     subroutine zeroderiv(x)
222     C $OpenAD$ INLINE DECLS
223 utke 1.2 use OAD_active
224 utke 1.3 implicit none
225 heimbach 1.1 type(active), intent(out) :: x
226     C $OpenAD$ END DECLS
227     x%d=0.0d0
228     end subroutine
229    
230     subroutine setderiv(y,x)
231     C $OpenAD$ INLINE DECLS
232 utke 1.2 use OAD_active
233 utke 1.3 implicit none
234 heimbach 1.1 type(active), intent(out) :: x
235     type(active), intent(in) :: y
236     C $OpenAD$ END DECLS
237     x%d=y%d
238     end subroutine
239    
240     subroutine incderiv(y,x)
241     C $OpenAD$ INLINE DECLS
242 utke 1.2 use OAD_active
243 utke 1.3 implicit none
244 heimbach 1.1 type(active), intent(out) :: x
245     type(active), intent(in) :: y
246     C $OpenAD$ END DECLS
247     x%d=x%d+y%d
248     end subroutine
249    
250     subroutine decderiv(y,x)
251     C $OpenAD$ INLINE DECLS
252 utke 1.2 use OAD_active
253 utke 1.3 implicit none
254 heimbach 1.1 type(active), intent(out) :: x
255     type(active), intent(in) :: y
256     C $OpenAD$ END DECLS
257     x%d = x%d - y%d
258     end subroutine decderiv
259    
260     C Checkpointing stuff ---------------------------------------
261    
262     C reals -----------------------------------------------------
263     subroutine cp_arg_store_real_scalar(x)
264     C $OpenAD$ INLINE DECLS
265 utke 1.3 use OAD_cp
266     implicit none
267     double precision :: x
268 heimbach 1.1 C $OpenAD$ END DECLS
269     #ifdef OAD_DEBUG_CP
270 heimbach 1.5 !write(standardmessageunit,*)'OAD: cp write x ', x
271 heimbach 1.1 #endif
272 utke 1.2 write(unit=cp_io_unit) x
273 heimbach 1.1 end subroutine
274    
275     subroutine cp_arg_restore_real_scalar(x)
276     C $OpenAD$ INLINE DECLS
277 utke 1.3 use OAD_cp
278     implicit none
279     double precision :: x
280 heimbach 1.1 C $OpenAD$ END DECLS
281 utke 1.2 read(unit=cp_io_unit) x
282 heimbach 1.1 #ifdef OAD_DEBUG_CP
283 heimbach 1.5 !write(standardmessageunit,*)'OAD: cp read x ', x
284 heimbach 1.1 #endif
285     end subroutine
286    
287     subroutine cp_arg_store_real_scalar_a(x)
288     C $OpenAD$ INLINE DECLS
289 utke 1.3 use OAD_active
290     use OAD_cp
291     implicit none
292     type(active) :: x
293 heimbach 1.1 C $OpenAD$ END DECLS
294     #ifdef OAD_DEBUG_CP
295 heimbach 1.5 !write(standardmessageunit,*)'OAD: cp write x ', x%v
296 heimbach 1.1 #endif
297 utke 1.2 write(unit=cp_io_unit) x%v
298 heimbach 1.1 end subroutine
299    
300     subroutine cp_arg_restore_real_scalar_a(x)
301     C $OpenAD$ INLINE DECLS
302 utke 1.3 use OAD_active
303     use OAD_cp
304     implicit none
305     type(active) :: x
306 heimbach 1.1 C $OpenAD$ END DECLS
307 utke 1.2 read(unit=cp_io_unit) x%v
308 heimbach 1.1 #ifdef OAD_DEBUG_CP
309 heimbach 1.5 !write(standardmessageunit,*)'OAD: cp read x ', x%v
310 heimbach 1.1 #endif
311     end subroutine
312 utke 1.3
313 heimbach 1.1 subroutine cp_arg_store_real_vector(x)
314     C $OpenAD$ INLINE DECLS
315 utke 1.3 use OAD_cp
316     implicit none
317     double precision, dimension(:) :: x
318 heimbach 1.1 C $OpenAD$ END DECLS
319     #ifdef OAD_DEBUG_CP
320 heimbach 1.5 !write(standardmessageunit,*)'OAD: cp write x ', x(1)
321 heimbach 1.1 #endif
322 utke 1.2 write(unit=cp_io_unit) x
323 heimbach 1.1 end subroutine
324    
325     subroutine cp_arg_restore_real_vector(x)
326     C $OpenAD$ INLINE DECLS
327 utke 1.3 use OAD_cp
328     implicit none
329     double precision, dimension(:) :: x
330 heimbach 1.1 C $OpenAD$ END DECLS
331 utke 1.2 read(unit=cp_io_unit) x
332 heimbach 1.1 #ifdef OAD_DEBUG_CP
333 heimbach 1.5 !write(standardmessageunit,*)'OAD: cp read x ', x(1)
334 heimbach 1.1 #endif
335     end subroutine
336    
337     subroutine cp_arg_store_real_vector_a(x)
338     C $OpenAD$ INLINE DECLS
339 utke 1.3 use OAD_active
340     use OAD_cp
341     implicit none
342     type(active), dimension(:) :: x
343 heimbach 1.1 C $OpenAD$ END DECLS
344     #ifdef OAD_DEBUG_CP
345 heimbach 1.5 !write(standardmessageunit,*)'OAD: cp write x ', x(1)%v
346 heimbach 1.1 #endif
347 utke 1.2 write(unit=cp_io_unit) x%v
348 heimbach 1.1 end subroutine
349    
350     subroutine cp_arg_restore_real_vector_a(x)
351     C $OpenAD$ INLINE DECLS
352 utke 1.3 use OAD_active
353     use OAD_cp
354     implicit none
355     type(active), dimension(:) :: x
356 heimbach 1.1 C $OpenAD$ END DECLS
357 utke 1.2 read(unit=cp_io_unit) x%v
358 heimbach 1.1 #ifdef OAD_DEBUG_CP
359 heimbach 1.5 !write(standardmessageunit,*)'OAD: cp read x ', x(1)%v
360 heimbach 1.1 #endif
361     end subroutine
362    
363     subroutine cp_arg_store_real_matrix(x)
364     C $OpenAD$ INLINE DECLS
365 utke 1.3 use OAD_cp
366     implicit none
367     double precision, dimension(:,:) :: x
368 heimbach 1.1 C $OpenAD$ END DECLS
369     #ifdef OAD_DEBUG_CP
370 heimbach 1.5 !write(standardmessageunit,*)'OAD: cp write x ', x(1,1)
371 heimbach 1.1 #endif
372 utke 1.2 write(unit=cp_io_unit) x
373 heimbach 1.1 end subroutine
374    
375     subroutine cp_arg_restore_real_matrix(x)
376     C $OpenAD$ INLINE DECLS
377 utke 1.3 use OAD_cp
378     implicit none
379     double precision, dimension(:,:) :: x
380 heimbach 1.1 C $OpenAD$ END DECLS
381 utke 1.2 read(unit=cp_io_unit) x
382 heimbach 1.1 #ifdef OAD_DEBUG_CP
383 heimbach 1.5 !write(standardmessageunit,*)'OAD: cp read x ', x(1,1)
384 heimbach 1.1 #endif
385     end subroutine
386    
387     subroutine cp_arg_store_real_matrix_a(x)
388     C $OpenAD$ INLINE DECLS
389 utke 1.3 use OAD_active
390     use OAD_cp
391     implicit none
392     type(active), dimension(:,:) :: x
393 heimbach 1.1 C $OpenAD$ END DECLS
394     #ifdef OAD_DEBUG_CP
395 heimbach 1.5 !write(standardmessageunit,*)'OAD: cp write x ', x(1,1)%v
396 heimbach 1.1 #endif
397 utke 1.2 write(unit=cp_io_unit) x%v
398 heimbach 1.1 end subroutine
399    
400     subroutine cp_arg_restore_real_matrix_a(x)
401     C $OpenAD$ INLINE DECLS
402 utke 1.3 use OAD_active
403     use OAD_cp
404     implicit none
405     type(active), dimension(:,:) :: x
406 heimbach 1.1 C $OpenAD$ END DECLS
407 utke 1.2 read(unit=cp_io_unit) x%v
408 heimbach 1.1 #ifdef OAD_DEBUG_CP
409 heimbach 1.5 !write(standardmessageunit,*)'OAD: cp read x ', x(1,1)%v
410 heimbach 1.1 #endif
411     end subroutine
412    
413     subroutine cp_arg_store_real_three_tensor(x)
414     C $OpenAD$ INLINE DECLS
415 utke 1.3 use OAD_cp
416     implicit none
417     double precision, dimension(:,:,:) :: x
418 heimbach 1.1 C $OpenAD$ END DECLS
419     #ifdef OAD_DEBUG_CP
420 heimbach 1.5 !write(standardmessageunit,*)'OAD: cp write x ', x(1,1,1)
421 heimbach 1.1 #endif
422 utke 1.2 write(unit=cp_io_unit) x
423 heimbach 1.1 end subroutine
424    
425 utke 1.2 subroutine cp_arg_restore_real_three_tensor(x)
426 heimbach 1.1 C $OpenAD$ INLINE DECLS
427 utke 1.3 use OAD_cp
428     implicit none
429     double precision, dimension(:,:,:) :: x
430 heimbach 1.1 C $OpenAD$ END DECLS
431 utke 1.2 read(unit=cp_io_unit) x
432 heimbach 1.1 #ifdef OAD_DEBUG_CP
433 heimbach 1.5 !write(standardmessageunit,*)'OAD: cp read x ', x(1,1,1)
434 heimbach 1.1 #endif
435     end subroutine
436    
437 utke 1.2 subroutine cp_arg_store_real_three_tensor_a(x)
438 heimbach 1.1 C $OpenAD$ INLINE DECLS
439 utke 1.3 use OAD_active
440     use OAD_cp
441     implicit none
442     type(active), dimension(:,:,:) :: x
443 heimbach 1.1 C $OpenAD$ END DECLS
444     #ifdef OAD_DEBUG_CP
445 heimbach 1.5 !write(standardmessageunit,*)'OAD: cp write x ', x(1,1,1)%v
446 heimbach 1.1 #endif
447 utke 1.2 write(unit=cp_io_unit) x%v
448 heimbach 1.1 end subroutine
449    
450     subroutine cp_arg_restore_real_three_tensor_a(x)
451     C $OpenAD$ INLINE DECLS
452 utke 1.3 use OAD_active
453     use OAD_cp
454     implicit none
455     type(active), dimension(:,:,:) :: x
456 heimbach 1.1 C $OpenAD$ END DECLS
457 utke 1.3 read(unit=cp_io_unit) x%v
458 heimbach 1.1 #ifdef OAD_DEBUG_CP
459 heimbach 1.5 !write(standardmessageunit,*)'OAD: cp read x ', x(1,1,1)%v
460 heimbach 1.1 #endif
461     end subroutine
462    
463     subroutine cp_arg_store_real_four_tensor(x)
464     C $OpenAD$ INLINE DECLS
465 utke 1.3 use OAD_cp
466     implicit none
467     double precision, dimension(:,:,:,:) :: x
468 heimbach 1.1 C $OpenAD$ END DECLS
469     #ifdef OAD_DEBUG_CP
470 heimbach 1.5 !write(standardmessageunit,*)'OAD: cp write x ', x(1,1,1,1)
471 heimbach 1.1 #endif
472 utke 1.2 write(unit=cp_io_unit) x
473 heimbach 1.1 end subroutine
474    
475 utke 1.2 subroutine cp_arg_restore_real_four_tensor(x)
476 heimbach 1.1 C $OpenAD$ INLINE DECLS
477 utke 1.3 use OAD_cp
478     implicit none
479     double precision, dimension(:,:,:,:) :: x
480 heimbach 1.1 C $OpenAD$ END DECLS
481 utke 1.2 read(unit=cp_io_unit) x
482 heimbach 1.1 #ifdef OAD_DEBUG_CP
483 heimbach 1.5 !write(standardmessageunit,*)'OAD: cp read x ', x(1,1,1,1)
484 heimbach 1.1 #endif
485     end subroutine
486    
487 utke 1.2 subroutine cp_arg_store_real_four_tensor_a(x)
488 heimbach 1.1 C $OpenAD$ INLINE DECLS
489 utke 1.3 use OAD_active
490     use OAD_cp
491     implicit none
492     type(active), dimension(:,:,:,:) :: x
493 heimbach 1.1 C $OpenAD$ END DECLS
494     #ifdef OAD_DEBUG_CP
495 heimbach 1.5 !write(standardmessageunit,*)'OAD: cp write x ', x(1,1,1,1)%v
496 heimbach 1.1 #endif
497 utke 1.2 write(unit=cp_io_unit) x%v
498 heimbach 1.1 end subroutine
499    
500     subroutine cp_arg_restore_real_four_tensor_a(x)
501     C $OpenAD$ INLINE DECLS
502 utke 1.3 use OAD_active
503     use OAD_cp
504     implicit none
505     type(active), dimension(:,:,:,:) :: x
506 heimbach 1.1 C $OpenAD$ END DECLS
507 utke 1.2 read(unit=cp_io_unit) x%v
508 heimbach 1.1 #ifdef OAD_DEBUG_CP
509 heimbach 1.5 !write(standardmessageunit,*)'OAD: cp read x ', x(1,1,1,1)%v
510 utke 1.3 #endif
511     end subroutine
512 heimbach 1.1
513     subroutine cp_arg_store_real_five_tensor(x)
514     C $OpenAD$ INLINE DECLS
515 utke 1.3 use OAD_cp
516     implicit none
517     double precision, dimension(:,:,:,:,:) :: x
518 heimbach 1.1 C $OpenAD$ END DECLS
519     #ifdef OAD_DEBUG_CP
520 heimbach 1.5 !write(standardmessageunit,*)'OAD: cp write x ', x(1,1,1,1,1)
521 heimbach 1.1 #endif
522 utke 1.2 write(unit=cp_io_unit) x
523 heimbach 1.1 end subroutine
524    
525 utke 1.2 subroutine cp_arg_restore_real_five_tensor(x)
526 heimbach 1.1 C $OpenAD$ INLINE DECLS
527 utke 1.3 use OAD_cp
528     implicit none
529     double precision, dimension(:,:,:,:,:) :: x
530 heimbach 1.1 C $OpenAD$ END DECLS
531 utke 1.2 read(unit=cp_io_unit) x
532 heimbach 1.1 #ifdef OAD_DEBUG_CP
533 heimbach 1.5 !write(standardmessageunit,*)'OAD: cp read x ', x(1,1,1,1,1)
534 heimbach 1.1 #endif
535     end subroutine
536    
537 utke 1.2 subroutine cp_arg_store_real_five_tensor_a(x)
538 heimbach 1.1 C $OpenAD$ INLINE DECLS
539 utke 1.3 use OAD_active
540     use OAD_cp
541     implicit none
542     type(active), dimension(:,:,:,:,:) :: x
543 heimbach 1.1 C $OpenAD$ END DECLS
544     #ifdef OAD_DEBUG_CP
545 heimbach 1.5 !write(standardmessageunit,*)'OAD: cp write x ', x(1,1,1,1,1)%v
546 heimbach 1.1 #endif
547 utke 1.2 write(unit=cp_io_unit) x%v
548 heimbach 1.1 end subroutine
549    
550     subroutine cp_arg_restore_real_five_tensor_a(x)
551     C $OpenAD$ INLINE DECLS
552 utke 1.3 use OAD_active
553     use OAD_cp
554     implicit none
555     type(active), dimension(:,:,:,:,:) :: x
556 heimbach 1.1 C $OpenAD$ END DECLS
557 utke 1.2 read(unit=cp_io_unit) x%v
558 heimbach 1.1 #ifdef OAD_DEBUG_CP
559 heimbach 1.5 !write(standardmessageunit,*)'OAD: cp read x ', x(1,1,1,1,1)%v
560 heimbach 1.1 #endif
561     end subroutine
562    
563 utke 1.3 subroutine cp_arg_store_real_six_tensor(x)
564     C $OpenAD$ INLINE DECLS
565     use OAD_cp
566     implicit none
567     double precision, dimension(:,:,:,:,:,:) :: x
568     C $OpenAD$ END DECLS
569     #ifdef OAD_DEBUG_CP
570 heimbach 1.5 !write(standardmessageunit,*)'OAD: cp write x ', x(1,1,1,1,1,1)
571 utke 1.3 #endif
572     write(unit=cp_io_unit) x
573     end subroutine
574    
575     subroutine cp_arg_restore_real_six_tensor(x)
576     C $OpenAD$ INLINE DECLS
577     use OAD_cp
578     implicit none
579     double precision, dimension(:,:,:,:,:,:) :: x
580     C $OpenAD$ END DECLS
581     read(unit=cp_io_unit) x
582     #ifdef OAD_DEBUG_CP
583 heimbach 1.5 !write(standardmessageunit,*)'OAD: cp read x ', x(1,1,1,1,1,1)
584 utke 1.3 #endif
585     end subroutine
586    
587     subroutine cp_arg_store_real_six_tensor_a(x)
588     C $OpenAD$ INLINE DECLS
589     use OAD_active
590     use OAD_cp
591     implicit none
592     type(active), dimension(:,:,:,:,:,:) :: x
593     C $OpenAD$ END DECLS
594     #ifdef OAD_DEBUG_CP
595 heimbach 1.5 !write(standardmessageunit,*)'OAD: cp write x ', x(1,1,1,1,1,1)%v
596 utke 1.3 #endif
597     write(unit=cp_io_unit) x%v
598     end subroutine
599    
600     subroutine cp_arg_restore_real_six_tensor_a(x)
601     C $OpenAD$ INLINE DECLS
602     use OAD_active
603     use OAD_cp
604     implicit none
605     type(active), dimension(:,:,:,:,:,:) :: x
606     C $OpenAD$ END DECLS
607     read(unit=cp_io_unit) x%v
608     #ifdef OAD_DEBUG_CP
609 heimbach 1.5 !write(standardmessageunit,*)'OAD: cp read x ', x(1,1,1,1,1,1)%v
610 utke 1.3 #endif
611     end subroutine
612 heimbach 1.1
613     C integers -----------------------------------------------------
614 utke 1.3 subroutine cp_arg_store_integer_scalar(i)
615 heimbach 1.1 C $OpenAD$ INLINE DECLS
616 utke 1.3 use OAD_cp
617     implicit none
618     integer :: i
619 heimbach 1.1 C $OpenAD$ END DECLS
620     #ifdef OAD_DEBUG_CP
621 heimbach 1.5 !write(standardmessageunit,*)'OAD: cp write i ', i
622 heimbach 1.1 #endif
623 utke 1.3 write(unit=cp_io_unit) i
624 heimbach 1.1 end subroutine
625    
626 utke 1.3 subroutine cp_arg_restore_integer_scalar(i)
627 heimbach 1.1 C $OpenAD$ INLINE DECLS
628 utke 1.3 use OAD_cp
629     implicit none
630     integer :: i
631 heimbach 1.1 C $OpenAD$ END DECLS
632 utke 1.3 read(unit=cp_io_unit) i
633 heimbach 1.1 #ifdef OAD_DEBUG_CP
634 heimbach 1.5 !write(standardmessageunit,*)'OAD: cp read i ', i
635 heimbach 1.1 #endif
636     end subroutine
637    
638 utke 1.3 subroutine cp_arg_store_integer_vector(i)
639 heimbach 1.1 C $OpenAD$ INLINE DECLS
640 utke 1.3 use OAD_cp
641     implicit none
642     integer, dimension(:) :: i
643 heimbach 1.1 C $OpenAD$ END DECLS
644     #ifdef OAD_DEBUG_CP
645 heimbach 1.5 !write(standardmessageunit,*)'OAD: cp write i ', i(1)
646 heimbach 1.1 #endif
647 utke 1.3 write(unit=cp_io_unit) i
648 heimbach 1.1 end subroutine
649    
650 utke 1.3 subroutine cp_arg_restore_integer_vector(i)
651 heimbach 1.1 C $OpenAD$ INLINE DECLS
652 utke 1.3 use OAD_cp
653     implicit none
654     integer, dimension(:) :: i
655 heimbach 1.1 C $OpenAD$ END DECLS
656 utke 1.3 read(unit=cp_io_unit) i
657 heimbach 1.1 #ifdef OAD_DEBUG_CP
658 heimbach 1.5 !write(standardmessageunit,*)'OAD: cp read i ', i(1)
659 heimbach 1.1 #endif
660     end subroutine
661    
662 utke 1.3 subroutine cp_arg_store_integer_matrix(i)
663 heimbach 1.1 C $OpenAD$ INLINE DECLS
664 utke 1.3 use OAD_cp
665     implicit none
666     integer, dimension(:,:) :: i
667 heimbach 1.1 C $OpenAD$ END DECLS
668     #ifdef OAD_DEBUG_CP
669 heimbach 1.5 !write(standardmessageunit,*)'OAD: cp write i ', i(1,1)
670 heimbach 1.1 #endif
671 utke 1.3 write(unit=cp_io_unit) i
672 heimbach 1.1 end subroutine
673    
674 utke 1.3 subroutine cp_arg_restore_integer_matrix(i)
675 heimbach 1.1 C $OpenAD$ INLINE DECLS
676 utke 1.3 use OAD_cp
677     implicit none
678     integer, dimension(:,:) :: i
679 heimbach 1.1 C $OpenAD$ END DECLS
680 utke 1.3 read(unit=cp_io_unit) i
681 heimbach 1.1 #ifdef OAD_DEBUG_CP
682 heimbach 1.5 !write(standardmessageunit,*)'OAD: cp read i ', i(1,1)
683 heimbach 1.1 #endif
684     end subroutine
685    
686 utke 1.3 subroutine cp_arg_store_integer_three_tensor(i)
687 heimbach 1.1 C $OpenAD$ INLINE DECLS
688 utke 1.3 use OAD_cp
689     implicit none
690     integer, dimension(:,:,:) :: i
691 heimbach 1.1 C $OpenAD$ END DECLS
692     #ifdef OAD_DEBUG_CP
693 heimbach 1.5 !write(standardmessageunit,*)'OAD: cp write i ', i(1,1,1)
694 heimbach 1.1 #endif
695 utke 1.3 write(unit=cp_io_unit) i
696 heimbach 1.1 end subroutine
697    
698 utke 1.3 subroutine cp_arg_restore_integer_three_tensor(i)
699 heimbach 1.1 C $OpenAD$ INLINE DECLS
700 utke 1.3 use OAD_cp
701     implicit none
702     integer, dimension(:,:,:) :: i
703 heimbach 1.1 C $OpenAD$ END DECLS
704 utke 1.3 read(unit=cp_io_unit) i
705 heimbach 1.1 #ifdef OAD_DEBUG_CP
706 heimbach 1.5 !write(standardmessageunit,*)'OAD: cp read i ', i(1,1,1)
707 heimbach 1.1 #endif
708     end subroutine
709    
710 utke 1.3 subroutine cp_arg_store_integer_four_tensor(i)
711 heimbach 1.1 C $OpenAD$ INLINE DECLS
712 utke 1.3 use OAD_cp
713     implicit none
714     integer, dimension(:,:,:,:) :: i
715 heimbach 1.1 C $OpenAD$ END DECLS
716     #ifdef OAD_DEBUG_CP
717 heimbach 1.5 !write(standardmessageunit,*)'OAD: cp write i ', i(1,1,1,1)
718 heimbach 1.1 #endif
719 utke 1.3 write(unit=cp_io_unit) i
720 heimbach 1.1 end subroutine
721    
722 utke 1.3 subroutine cp_arg_restore_integer_four_tensor(i)
723 heimbach 1.1 C $OpenAD$ INLINE DECLS
724 utke 1.3 use OAD_cp
725     implicit none
726     integer, dimension(:,:,:,:) :: i
727 heimbach 1.1 C $OpenAD$ END DECLS
728 utke 1.3 read(unit=cp_io_unit) i
729 heimbach 1.1 #ifdef OAD_DEBUG_CP
730 heimbach 1.5 !write(standardmessageunit,*)'OAD: cp read i ', i(1,1,1,1)
731 heimbach 1.1 #endif
732     end subroutine
733    
734 utke 1.3 subroutine cp_arg_store_integer_five_tensor(i)
735 heimbach 1.1 C $OpenAD$ INLINE DECLS
736 utke 1.3 use OAD_cp
737     implicit none
738     integer, dimension(:,:,:,:,:) :: i
739 heimbach 1.1 C $OpenAD$ END DECLS
740     #ifdef OAD_DEBUG_CP
741 heimbach 1.5 !write(standardmessageunit,*)'OAD: cp write i ', i(1,1,1,1,1)
742 heimbach 1.1 #endif
743 utke 1.3 write(unit=cp_io_unit) i
744 heimbach 1.1 end subroutine
745    
746 utke 1.3 subroutine cp_arg_restore_integer_five_tensor(i)
747 heimbach 1.1 C $OpenAD$ INLINE DECLS
748 utke 1.3 use OAD_cp
749     implicit none
750     integer, dimension(:,:,:,:,:) :: i
751 heimbach 1.1 C $OpenAD$ END DECLS
752 utke 1.3 read (unit=cp_io_unit) i
753 heimbach 1.1 #ifdef OAD_DEBUG_CP
754 heimbach 1.5 !write(standardmessageunit,*)'OAD: cp read i ', i(1,1,1,1,1)
755 heimbach 1.1 #endif
756     end subroutine
757    
758     C strings -----------------------------------------------------
759 utke 1.3 subroutine cp_arg_store_string_scalar(s)
760 heimbach 1.1 C $OpenAD$ INLINE DECLS
761 utke 1.2 use OAD_cp
762 heimbach 1.1 implicit none
763 utke 1.3 character*(80) :: s
764 heimbach 1.1 C $OpenAD$ END DECLS
765     #ifdef OAD_DEBUG_CP
766 heimbach 1.5 !write(standardmessageunit,*)'OAD: cp write s ', s
767 heimbach 1.1 #endif
768 utke 1.3 write(unit=cp_io_unit) s
769 heimbach 1.1 end subroutine
770    
771 utke 1.3 subroutine cp_arg_restore_string_scalar(s)
772 heimbach 1.1 C $OpenAD$ INLINE DECLS
773 utke 1.2 use OAD_cp
774 heimbach 1.1 implicit none
775 utke 1.3 character*(80) :: s
776 heimbach 1.1 C $OpenAD$ END DECLS
777 utke 1.3 read (unit=cp_io_unit) s
778 heimbach 1.1 #ifdef OAD_DEBUG_CP
779 heimbach 1.5 !write(standardmessageunit,*)'OAD: cp read s ', s
780 heimbach 1.1 #endif
781     end subroutine
782    
783     C bools -----------------------------------------------------
784 utke 1.3 subroutine cp_arg_store_bool_scalar(b)
785 heimbach 1.1 C $OpenAD$ INLINE DECLS
786 utke 1.3 use OAD_cp
787     implicit none
788     logical :: b
789 heimbach 1.1 C $OpenAD$ END DECLS
790     #ifdef OAD_DEBUG_CP
791 heimbach 1.5 !write(standardmessageunit,*)'OAD: cp write b ', b
792 heimbach 1.1 #endif
793 utke 1.3 write(unit=cp_io_unit) b
794 heimbach 1.1 end subroutine
795    
796 utke 1.3 subroutine cp_arg_restore_bool_scalar(b)
797 heimbach 1.1 C $OpenAD$ INLINE DECLS
798 utke 1.3 use OAD_cp
799     implicit none
800     logical :: b
801 heimbach 1.1 C $OpenAD$ END DECLS
802 utke 1.3 read (unit=cp_io_unit) b
803 heimbach 1.1 #ifdef OAD_DEBUG_CP
804 heimbach 1.5 !write(standardmessageunit,*)'OAD: cp read b ', b
805 heimbach 1.1 #endif
806     end subroutine
807 utke 1.2
808 utke 1.3 subroutine cp_arg_store_bool_matrix(b)
809 utke 1.2 C $OpenAD$ INLINE DECLS
810 utke 1.3 use OAD_cp
811     implicit none
812     logical, dimension(:,:) :: b
813 utke 1.2 C $OpenAD$ END DECLS
814 jahn 1.4 #ifdef OAD_DEBUG_CP
815 heimbach 1.5 !write(standardmessageunit,*)'OAD: cp write b ', b(1,1)
816 utke 1.2 #endif
817 utke 1.3 write(unit=cp_io_unit) b
818 utke 1.2 end subroutine
819    
820 utke 1.3 subroutine cp_arg_restore_bool_matrix(b)
821 utke 1.2 C $OpenAD$ INLINE DECLS
822 utke 1.3 use OAD_cp
823     implicit none
824     logical, dimension(:,:) :: b
825 utke 1.2 C $OpenAD$ END DECLS
826 utke 1.3 read(unit=cp_io_unit) b
827 utke 1.2 #ifdef OAD_DEBUG_CP
828 heimbach 1.5 !write(standardmessageunit,*)'OAD: cp read b ', b(1,1)
829 utke 1.2 #endif
830 heimbach 1.5 end subroutine
831    
832     C adjoints of active reals ----------------------------------
833     subroutine cp_arg_store_real_scalar_a_d(x)
834     C $OpenAD$ INLINE DECLS
835     use OAD_active
836     use OAD_cp
837     implicit none
838     type(active) :: x
839     C $OpenAD$ END DECLS
840     #ifdef OAD_DEBUG_CP
841     !write(standardmessageunit,*)'OAD: cp write x%d ', x%d
842     #endif
843     write(unit=cp_io_unit) x%d
844     end subroutine
845    
846     subroutine cp_arg_restore_real_scalar_a_d(x)
847     C $OpenAD$ INLINE DECLS
848     use OAD_active
849     use OAD_cp
850     implicit none
851     type(active) :: x
852     C $OpenAD$ END DECLS
853     read(unit=cp_io_unit) x%d
854     #ifdef OAD_DEBUG_CP
855     !write(standardmessageunit,*)'OAD: cp read x%d ', x%d
856     #endif
857     end subroutine
858    
859     subroutine cp_arg_store_real_vector_a_d(x)
860     C $OpenAD$ INLINE DECLS
861     use OAD_active
862     use OAD_cp
863     implicit none
864     type(active), dimension(:) :: x
865     C $OpenAD$ END DECLS
866     #ifdef OAD_DEBUG_CP
867     !write(standardmessageunit,*)'OAD: cp write x%d ', x(1)%d
868     #endif
869     write(unit=cp_io_unit) x%d
870     end subroutine
871    
872     subroutine cp_arg_restore_real_vector_a_d(x)
873     C $OpenAD$ INLINE DECLS
874     use OAD_active
875     use OAD_cp
876     implicit none
877     type(active), dimension(:) :: x
878     C $OpenAD$ END DECLS
879     read(unit=cp_io_unit) x%d
880     #ifdef OAD_DEBUG_CP
881     !write(standardmessageunit,*)'OAD: cp read x%d ', x(1)%d
882     #endif
883     end subroutine
884    
885     subroutine cp_arg_store_real_matrix_a_d(x)
886     C $OpenAD$ INLINE DECLS
887     use OAD_active
888     use OAD_cp
889     implicit none
890     type(active), dimension(:,:) :: x
891     C $OpenAD$ END DECLS
892     #ifdef OAD_DEBUG_CP
893     !write(standardmessageunit,*)'OAD: cp write x%d ', x(1,1)%d
894     #endif
895     write(unit=cp_io_unit) x%d
896     end subroutine
897    
898     subroutine cp_arg_restore_real_matrix_a_d(x)
899     C $OpenAD$ INLINE DECLS
900     use OAD_active
901     use OAD_cp
902     implicit none
903     type(active), dimension(:,:) :: x
904     C $OpenAD$ END DECLS
905     read(unit=cp_io_unit) x%d
906     #ifdef OAD_DEBUG_CP
907     !write(standardmessageunit,*)'OAD: cp read x%d ', x(1,1)%d
908     #endif
909     end subroutine
910    
911     subroutine cp_arg_store_real_three_tensor_a_d(x)
912     C $OpenAD$ INLINE DECLS
913     use OAD_active
914     use OAD_cp
915     implicit none
916     type(active), dimension(:,:,:) :: x
917     C $OpenAD$ END DECLS
918     #ifdef OAD_DEBUG_CP
919     !write(standardmessageunit,*)'OAD: cp write x%d ', x(1,1,1)%d
920     #endif
921     write(unit=cp_io_unit) x%d
922 utke 1.2 end subroutine
923 heimbach 1.5
924     subroutine cp_arg_restore_real_three_tensor_a_d(x)
925     C $OpenAD$ INLINE DECLS
926     use OAD_active
927     use OAD_cp
928     implicit none
929     type(active), dimension(:,:,:) :: x
930     C $OpenAD$ END DECLS
931     read(unit=cp_io_unit) x%d
932     #ifdef OAD_DEBUG_CP
933     !write(standardmessageunit,*)'OAD: cp read x%d ', x(1,1,1)%d
934     #endif
935     end subroutine
936    
937     subroutine cp_arg_store_real_four_tensor_a_d(x)
938     C $OpenAD$ INLINE DECLS
939     use OAD_active
940     use OAD_cp
941     implicit none
942     type(active), dimension(:,:,:,:) :: x
943     C $OpenAD$ END DECLS
944     #ifdef OAD_DEBUG_CP
945     !write(standardmessageunit,*)'OAD: cp write x%d ', x(1,1,1,1)%d
946     #endif
947     write(unit=cp_io_unit) x%d
948     end subroutine
949    
950     subroutine cp_arg_restore_real_four_tensor_a_d(x)
951     C $OpenAD$ INLINE DECLS
952     use OAD_active
953     use OAD_cp
954     implicit none
955     type(active), dimension(:,:,:,:) :: x
956     C $OpenAD$ END DECLS
957     read(unit=cp_io_unit) x%d
958     #ifdef OAD_DEBUG_CP
959     !write(standardmessageunit,*)'OAD: cp read x%d ', x(1,1,1,1)%d
960     #endif
961     end subroutine
962    
963     subroutine cp_arg_store_real_five_tensor_a_d(x)
964     C $OpenAD$ INLINE DECLS
965     use OAD_active
966     use OAD_cp
967     implicit none
968     type(active), dimension(:,:,:,:,:) :: x
969     C $OpenAD$ END DECLS
970     #ifdef OAD_DEBUG_CP
971     !write(standardmessageunit,*)'OAD: cp write x%d ', x(1,1,1,1,1)%d
972     #endif
973     write(unit=cp_io_unit) x%d
974     end subroutine
975    
976     subroutine cp_arg_restore_real_five_tensor_a_d(x)
977     C $OpenAD$ INLINE DECLS
978     use OAD_active
979     use OAD_cp
980     implicit none
981     type(active), dimension(:,:,:,:,:) :: x
982     C $OpenAD$ END DECLS
983     read(unit=cp_io_unit) x%d
984     #ifdef OAD_DEBUG_CP
985     !write(standardmessageunit,*)'OAD: cp read x%d ', x(1,1,1,1,1)%d
986     #endif
987     end subroutine
988    
989     subroutine cp_arg_store_real_six_tensor_a_d(x)
990     C $OpenAD$ INLINE DECLS
991     use OAD_active
992     use OAD_cp
993     implicit none
994     type(active), dimension(:,:,:,:,:,:) :: x
995     C $OpenAD$ END DECLS
996     #ifdef OAD_DEBUG_CP
997     !write(standardmessageunit,*)'OAD: cp write x%d ', x(1,1,1,1,1,1)%d
998     #endif
999     write(unit=cp_io_unit) x%d
1000     end subroutine
1001    
1002     subroutine cp_arg_restore_real_six_tensor_a_d(x)
1003     C $OpenAD$ INLINE DECLS
1004     use OAD_active
1005     use OAD_cp
1006     implicit none
1007     type(active), dimension(:,:,:,:,:,:) :: x
1008     C $OpenAD$ END DECLS
1009     read(unit=cp_io_unit) x%d
1010     #ifdef OAD_DEBUG_CP
1011     !write(standardmessageunit,*)'OAD: cp read x%d ', x(1,1,1,1,1,1)%d
1012     #endif
1013     end subroutine
  ViewVC Help
Powered by ViewVC 1.1.22