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

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

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


Revision 1.1 - (hide annotations) (download)
Tue Dec 13 15:15:28 2005 UTC (20 years, 10 months ago) by heimbach
Branch: MAIN
Adding new setups.

1 heimbach 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     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 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*2))
18     print *, "DT+"
19     double_tape(1:double_tape_size) = double_tmp_tape
20     deallocate(double_tmp_tape)
21     double_tape_size=double_tape_size*2
22     end if
23     double_tape(double_tape_pointer)=x
24     double_tape_pointer=double_tape_pointer+1
25     end subroutine
26    
27    
28     subroutine pop(x)
29     C $OpenAD$ INLINE DECLS
30     double precision :: x
31     C $OpenAD$ END DECLS
32     double_tape_pointer=double_tape_pointer-1
33     x=double_tape(double_tape_pointer)
34     end subroutine
35    
36    
37     subroutine push_i(x)
38     C $OpenAD$ INLINE DECLS
39     integer :: x
40     C $OpenAD$ END DECLS
41     if(integer_tape_size .lt. integer_tape_pointer) then
42     allocate(integer_tmp_tape(integer_tape_size))
43     integer_tmp_tape=integer_tape
44     deallocate(integer_tape)
45     allocate(integer_tape(integer_tape_size*2))
46     print *, "IT+"
47     integer_tape(1:integer_tape_size) = integer_tmp_tape
48     deallocate(integer_tmp_tape)
49     integer_tape_size=integer_tape_size*2
50     end if
51     integer_tape(integer_tape_pointer)=x
52     integer_tape_pointer=integer_tape_pointer+1
53     end subroutine
54    
55     subroutine pop_i(x)
56     C $OpenAD$ INLINE DECLS
57     use OpenAD_tape
58     implicit none
59     integer :: x
60     C $OpenAD$ END DECLS
61     integer_tape_pointer=integer_tape_pointer-1
62     x=integer_tape(integer_tape_pointer)
63     end subroutine
64    
65     subroutine saxpy(a,x,y)
66     C $OpenAD$ INLINE DECLS
67     double precision, intent(in) :: a
68     type(active), intent(in) :: x
69     type(active), intent(inout) :: y
70     C $OpenAD$ END DECLS
71     y%d=y%d+x%d*a
72     end subroutine
73    
74     subroutine zeroderiv(x)
75     C $OpenAD$ INLINE DECLS
76     type(active), intent(out) :: x
77     C $OpenAD$ END DECLS
78     x%d=0.0d0
79     end subroutine
80    
81     subroutine setderiv(y,x)
82     C $OpenAD$ INLINE DECLS
83     type(active), intent(out) :: x
84     type(active), intent(in) :: y
85     C $OpenAD$ END DECLS
86     x%d=y%d
87     end subroutine
88    
89    
90     subroutine incderiv(y,x)
91     C $OpenAD$ INLINE DECLS
92     type(active), intent(out) :: x
93     type(active), intent(in) :: y
94     C $OpenAD$ END DECLS
95     x%d=x%d+y%d
96     end subroutine
97    
98     subroutine condinczeroderiv(y,x)
99     C $OpenAD$ INLINE DECLS
100     type(active), intent(out) :: x
101     type(active), intent(in) :: y
102     C $OpenAD$ END DECLS
103     if (iaddr(y).ne.iaddr(x)) then
104     x%d=x%d+y%d
105     y%d=0
106     end if
107     end subroutine
108    
109     C Checkpointing stuff ---------------------------------------
110    
111     C reals -----------------------------------------------------
112     subroutine cp_arg_store_real_scalar(x)
113     C $OpenAD$ INLINE DECLS
114     double precision :: x
115     C $OpenAD$ END DECLS
116     if(cp_double_size .lt. cp_double_pointer+1) then
117     allocate(cp_double_tmp(cp_double_size))
118     cp_double_tmp=cp_double
119     deallocate(cp_double)
120     allocate(cp_double(cp_double_size*2))
121     print *,'CPD+'
122     cp_double(1:cp_double_size) = cp_double_tmp
123     deallocate(cp_double_tmp)
124     cp_double_size=cp_double_size*2
125     end if
126     cp_double_pointer=cp_double_pointer+1
127     cp_double(cp_double_pointer)=x
128     end subroutine
129    
130     subroutine cp_arg_restore_real_scalar(x)
131     C $OpenAD$ INLINE DECLS
132     implicit none
133     double precision :: x
134     C $OpenAD$ END DECLS
135     x=cp_double(cp_double_pointer)
136     cp_double_pointer=cp_double_pointer-1
137     end subroutine
138    
139     subroutine cp_arg_store_real_scalar_a(x)
140     C $OpenAD$ INLINE DECLS
141     double precision :: x
142     C $OpenAD$ END DECLS
143     if(cp_double_size .lt. cp_double_pointer+1) then
144     allocate(cp_double_tmp(cp_double_size))
145     cp_double_tmp=cp_double
146     deallocate(cp_double)
147     allocate(cp_double(cp_double_size*2))
148     print *,'CPD+'
149     cp_double(1:cp_double_size) = cp_double_tmp
150     deallocate(cp_double_tmp)
151     cp_double_size=cp_double_size*2
152     end if
153     cp_double_pointer=cp_double_pointer+1
154     cp_double(cp_double_pointer)=x%v
155     end subroutine
156    
157     subroutine cp_arg_restore_real_scalar_a(x)
158     C $OpenAD$ INLINE DECLS
159     implicit none
160     double precision :: x
161     C $OpenAD$ END DECLS
162     x%v=cp_double(cp_double_pointer)
163     cp_double_pointer=cp_double_pointer-1
164     end subroutine
165    
166     subroutine cp_arg_store_real_vector(x,cp_loop_variable_1)
167     C $OpenAD$ INLINE DECLS
168     implicit none
169     double precision, dimension(:) :: x
170     C $OpenAD$ END DECLS
171     do while (cp_double_size .lt.
172     +cp_double_pointer+ubound(x,1)-lbound(x,1))
173     allocate(cp_double_tmp(cp_double_size))
174     cp_double_tmp=cp_double
175     deallocate(cp_double)
176     allocate(cp_double(cp_double_size*2))
177     print *,'CPD+'
178     cp_double(1:cp_double_size) = cp_double_tmp
179     deallocate(cp_double_tmp)
180     cp_double_size=cp_double_size*2
181     end do
182     do cp_loop_variable_1=lbound(x,1), ubound(x,1), 1
183     cp_double_pointer=cp_double_pointer+1
184     cp_double(cp_double_pointer)=
185     +x(cp_loop_variable_1)
186     end do
187     end subroutine
188    
189     subroutine cp_arg_restore_real_vector(x,cp_loop_variable_1)
190     C $OpenAD$ INLINE DECLS
191     implicit none
192     double precision, dimension(:) :: x
193     C $OpenAD$ END DECLS
194     do cp_loop_variable_1=ubound(x,1),lbound(x,1),-1
195     x(cp_loop_variable_1)=cp_double(cp_double_pointer)
196     cp_double_pointer=cp_double_pointer-1
197     C write(*,'(A,EN26.16E3)') "restore(v) ",
198     C +x(cp_loop_variable_1)%v
199     end do
200     end subroutine
201    
202     subroutine cp_arg_store_real_vector_a(x,cp_loop_variable_1)
203     C $OpenAD$ INLINE DECLS
204     implicit none
205     double precision, dimension(:) :: x
206     C $OpenAD$ END DECLS
207     do while (cp_double_size .lt.
208     +cp_double_pointer+ubound(x,1)-lbound(x,1))
209     allocate(cp_double_tmp(cp_double_size))
210     cp_double_tmp=cp_double
211     deallocate(cp_double)
212     allocate(cp_double(cp_double_size*2))
213     print *,'CPD+'
214     cp_double(1:cp_double_size) = cp_double_tmp
215     deallocate(cp_double_tmp)
216     cp_double_size=cp_double_size*2
217     end do
218     do cp_loop_variable_1=lbound(x,1), ubound(x,1), 1
219     cp_double_pointer=cp_double_pointer+1
220     cp_double(cp_double_pointer)=
221     +x(cp_loop_variable_1)%v
222     end do
223     end subroutine
224    
225     subroutine cp_arg_restore_real_vector_a(x,cp_loop_variable_1)
226     C $OpenAD$ INLINE DECLS
227     implicit none
228     double precision, dimension(:) :: x
229     C $OpenAD$ END DECLS
230     do cp_loop_variable_1=ubound(x,1),lbound(x,1),-1
231     x(cp_loop_variable_1)%v=cp_double(cp_double_pointer)
232     cp_double_pointer=cp_double_pointer-1
233     C write(*,'(A,EN26.16E3)') "restore(v) ",
234     C +x(cp_loop_variable_1)%v
235     end do
236     end subroutine
237    
238     subroutine cp_arg_store_real_matrix(x,cp_loop_variable_1,
239     +cp_loop_variable_2)
240     C $OpenAD$ INLINE DECLS
241     implicit none
242     double precision, dimension(::) :: x
243     C $OpenAD$ END DECLS
244     do cp_loop_variable_1=lbound(x,1),ubound(x,1)
245     do while (cp_double_size .lt.
246     +cp_double_pointer+ubound(x,2)-lbound(x,2))
247     allocate(cp_double_tmp(cp_double_size))
248     cp_double_tmp=cp_double
249     deallocate(cp_double)
250     allocate(cp_double(cp_double_size*2))
251     print *,'CPD+'
252     cp_double(1:cp_double_size) = cp_double_tmp
253     deallocate(cp_double_tmp)
254     cp_double_size=cp_double_size*2
255     end do
256     do cp_loop_variable_2=lbound(x,2), ubound(x,2), 1
257     cp_double_pointer=cp_double_pointer+1
258     cp_double(cp_double_pointer)=
259     +x(cp_loop_variable_1,cp_loop_variable_2)
260     end do
261     end do
262     end subroutine
263    
264     subroutine cp_arg_restore_real_matrix(x,cp_loop_variable_1,
265     +cp_loop_variable_2)
266     C $OpenAD$ INLINE DECLS
267     implicit none
268     double precision, dimension(::) :: x
269     C $OpenAD$ END DECLS
270     do cp_loop_variable_1=ubound(x,1),lbound(x,1),-1
271     do cp_loop_variable_2=ubound(x,2),lbound(x,2),-1
272     x(cp_loop_variable_1,cp_loop_variable_2)=
273     +cp_double(cp_double_pointer)
274     cp_double_pointer=cp_double_pointer-1
275     end do
276     end do
277     end subroutine
278    
279     subroutine cp_arg_store_real_matrix_a(x,cp_loop_variable_1,
280     +cp_loop_variable_2)
281     C $OpenAD$ INLINE DECLS
282     implicit none
283     double precision, dimension(::) :: x
284     C $OpenAD$ END DECLS
285     do cp_loop_variable_1=lbound(x,1),ubound(x,1)
286     do while (cp_double_size .lt.
287     +cp_double_pointer+ubound(x,2)-lbound(x,2))
288     allocate(cp_double_tmp(cp_double_size))
289     cp_double_tmp=cp_double
290     deallocate(cp_double)
291     allocate(cp_double(cp_double_size*2))
292     print *,'CPD+'
293     cp_double(1:cp_double_size) = cp_double_tmp
294     deallocate(cp_double_tmp)
295     cp_double_size=cp_double_size*2
296     end do
297     do cp_loop_variable_2=lbound(x,2), ubound(x,2), 1
298     cp_double_pointer=cp_double_pointer+1
299     cp_double(cp_double_pointer)=
300     +x(cp_loop_variable_1,cp_loop_variable_2)%v
301     end do
302     end do
303     end subroutine
304    
305     subroutine cp_arg_restore_real_matrix_a(x,cp_loop_variable_1,
306     +cp_loop_variable_2)
307     C $OpenAD$ INLINE DECLS
308     implicit none
309     double precision, dimension(::) :: x
310     C $OpenAD$ END DECLS
311     do cp_loop_variable_1=ubound(x,1),lbound(x,1),-1
312     do cp_loop_variable_2=ubound(x,2),lbound(x,2),-1
313     x(cp_loop_variable_1,cp_loop_variable_2)%v=
314     +cp_double(cp_double_pointer)
315     cp_double_pointer=cp_double_pointer-1
316     end do
317     end do
318     end subroutine
319    
320     subroutine cp_arg_store_real_three_tensor(x,
321     +cp_loop_variable_1,
322     +cp_loop_variable_2,
323     +cp_loop_variable_3
324     +)
325     C $OpenAD$ INLINE DECLS
326     implicit none
327     double precision, dimension(::) :: x
328     C $OpenAD$ END DECLS
329     do cp_loop_variable_1=lbound(x,1),ubound(x,1)
330     do cp_loop_variable_2=lbound(x,2),ubound(x,2)
331     do while (cp_double_size .lt.
332     +cp_double_pointer+ubound(x,3)-lbound(x,3))
333     allocate(cp_double_tmp(cp_double_size))
334     cp_double_tmp=cp_double
335     deallocate(cp_double)
336     allocate(cp_double(cp_double_size*2))
337     print *,'CPD+'
338     cp_double(1:cp_double_size) = cp_double_tmp
339     deallocate(cp_double_tmp)
340     cp_double_size=cp_double_size*2
341     end do
342     do cp_loop_variable_3=lbound(x,3),ubound(x,3)
343     cp_double_pointer=cp_double_pointer+1
344     cp_double(cp_double_pointer)=
345     +x(
346     + cp_loop_variable_1,
347     + cp_loop_variable_2,
348     + cp_loop_variable_3
349     + )
350     end do
351     end do
352     end do
353     end subroutine
354    
355     subroutine cp_arg_restore_real_three_tensor(x,
356     +cp_loop_variable_1,
357     +cp_loop_variable_2,
358     +cp_loop_variable_3
359     +)
360     C $OpenAD$ INLINE DECLS
361     implicit none
362     double precision, dimension(::) :: x
363     C $OpenAD$ END DECLS
364     do cp_loop_variable_1=ubound(x,1),lbound(x,1),-1
365     do cp_loop_variable_2=ubound(x,2),lbound(x,2),-1
366     do cp_loop_variable_3=ubound(x,3),lbound(x,3),-1
367     x(
368     + cp_loop_variable_1,
369     + cp_loop_variable_2,
370     + cp_loop_variable_3
371     + )=
372     +cp_double(cp_double_pointer)
373     cp_double_pointer=cp_double_pointer-1
374     end do
375     end do
376     end do
377     end subroutine
378    
379     subroutine cp_arg_store_real_four_tensor(x,
380     +cp_loop_variable_1,
381     +cp_loop_variable_2,
382     +cp_loop_variable_3,
383     +cp_loop_variable_4
384     +)
385     C $OpenAD$ INLINE DECLS
386     implicit none
387     double precision, dimension(::) :: x
388     C $OpenAD$ END DECLS
389     do cp_loop_variable_1=lbound(x,1),ubound(x,1)
390     do cp_loop_variable_2=lbound(x,2),ubound(x,2)
391     do cp_loop_variable_3=lbound(x,3),ubound(x,3)
392     do while (cp_double_size .lt.
393     +cp_double_pointer+ubound(x,4)-lbound(x,4))
394     allocate(cp_double_tmp(cp_double_size))
395     cp_double_tmp=cp_double
396     deallocate(cp_double)
397     allocate(cp_double(cp_double_size*2))
398     print *,'CPD+'
399     cp_double(1:cp_double_size) = cp_double_tmp
400     deallocate(cp_double_tmp)
401     cp_double_size=cp_double_size*2
402     end do
403     do cp_loop_variable_4=lbound(x,4),ubound(x,4)
404     cp_double_pointer=cp_double_pointer+1
405     cp_double(cp_double_pointer)=
406     +x(
407     + cp_loop_variable_1,
408     + cp_loop_variable_2,
409     + cp_loop_variable_3,
410     + cp_loop_variable_4
411     + )
412     end do
413     end do
414     end do
415     end do
416     end subroutine
417    
418     subroutine cp_arg_restore_real_four_tensor(x,
419     +cp_loop_variable_1,
420     +cp_loop_variable_2,
421     +cp_loop_variable_3,
422     +cp_loop_variable_4
423     +)
424     C $OpenAD$ INLINE DECLS
425     implicit none
426     double precision, dimension(::) :: x
427     C $OpenAD$ END DECLS
428     do cp_loop_variable_1=ubound(x,1),lbound(x,1),-1
429     do cp_loop_variable_2=ubound(x,2),lbound(x,2),-1
430     do cp_loop_variable_3=ubound(x,3),lbound(x,3),-1
431     do cp_loop_variable_4=ubound(x,4),lbound(x,4),-1
432     x(
433     + cp_loop_variable_1,
434     + cp_loop_variable_2,
435     + cp_loop_variable_3,
436     + cp_loop_variable_4
437     + )=
438     +cp_double(cp_double_pointer)
439     cp_double_pointer=cp_double_pointer-1
440     end do
441     end do
442     end do
443     end do
444     end subroutine
445    
446     subroutine cp_arg_store_real_five_tensor(x,
447     +cp_loop_variable_1,
448     +cp_loop_variable_2,
449     +cp_loop_variable_3,
450     +cp_loop_variable_4,
451     +cp_loop_variable_5
452     +)
453     C $OpenAD$ INLINE DECLS
454     implicit none
455     double precision, dimension(::) :: x
456     C $OpenAD$ END DECLS
457     do cp_loop_variable_1=lbound(x,1),ubound(x,1)
458     do cp_loop_variable_2=lbound(x,2),ubound(x,2)
459     do cp_loop_variable_3=lbound(x,3),ubound(x,3)
460     do cp_loop_variable_4=lbound(x,4),ubound(x,4)
461     do while (cp_double_size .lt.
462     +cp_double_pointer+ubound(x,5)-lbound(x,5))
463     allocate(cp_double_tmp(cp_double_size))
464     cp_double_tmp=cp_double
465     deallocate(cp_double)
466     allocate(cp_double(cp_double_size*2))
467     print *,'CPD+'
468     cp_double(1:cp_double_size) = cp_double_tmp
469     deallocate(cp_double_tmp)
470     cp_double_size=cp_double_size*2
471     end do
472     do cp_loop_variable_5=lbound(x,5),ubound(x,5)
473     cp_double_pointer=cp_double_pointer+1
474     cp_double(cp_double_pointer)=
475     +x(
476     + cp_loop_variable_1,
477     + cp_loop_variable_2,
478     + cp_loop_variable_3,
479     + cp_loop_variable_4,
480     + cp_loop_variable_5
481     + )
482     end do
483     end do
484     end do
485     end do
486     end do
487     end subroutine
488    
489     subroutine cp_arg_restore_real_five_tensor(x,
490     +cp_loop_variable_1,
491     +cp_loop_variable_2,
492     +cp_loop_variable_3,
493     +cp_loop_variable_4,
494     +cp_loop_variable_5
495     +)
496     C $OpenAD$ INLINE DECLS
497     implicit none
498     double precision, dimension(::) :: x
499     C $OpenAD$ END DECLS
500     do cp_loop_variable_1=ubound(x,1),lbound(x,1),-1
501     do cp_loop_variable_2=ubound(x,2),lbound(x,2),-1
502     do cp_loop_variable_3=ubound(x,3),lbound(x,3),-1
503     do cp_loop_variable_4=ubound(x,4),lbound(x,4),-1
504     do cp_loop_variable_5=ubound(x,5),lbound(x,5),-1
505     x(
506     + cp_loop_variable_1,
507     + cp_loop_variable_2,
508     + cp_loop_variable_3,
509     + cp_loop_variable_4,
510     + cp_loop_variable_5
511     + )=
512     +cp_double(cp_double_pointer)
513     cp_double_pointer=cp_double_pointer-1
514     end do
515     end do
516     end do
517     end do
518     end do
519     end subroutine
520    
521    
522     C integers -----------------------------------------------------
523     subroutine cp_arg_store_integer_scalar(i)
524     C $OpenAD$ INLINE DECLS
525     implicit none
526     integer :: i
527     C $OpenAD$ END DECLS
528     if(cp_integer_size .lt. cp_integer_pointer+1) then
529     allocate(cp_integer_tmp(cp_integer_size))
530     cp_integer_tmp=cp_integer
531     deallocate(cp_integer)
532     allocate(cp_integer(cp_integer_size*2))
533     print *,'CPI+'
534     cp_integer(1:cp_integer_size) = cp_integer_tmp
535     deallocate(cp_integer_tmp)
536     cp_integer_size=cp_integer_size*2
537     end if
538     cp_integer_pointer=cp_integer_pointer+1
539     cp_integer(cp_integer_pointer)=i
540     end subroutine
541    
542     subroutine cp_arg_restore_integer_scalar(i)
543     C $OpenAD$ INLINE DECLS
544     implicit none
545     integer :: i
546     C $OpenAD$ END DECLS
547     i=cp_integer(cp_integer_pointer)
548     cp_integer_pointer=cp_integer_pointer-1
549     end subroutine
550    
551     subroutine cp_arg_store_integer_vector(x,cp_loop_variable_1)
552     C $OpenAD$ INLINE DECLS
553     implicit none
554     integer, dimension(:) :: x
555     C $OpenAD$ END DECLS
556     do while (cp_integer_size .lt.
557     +cp_integer_pointer+ubound(x,1)-lbound(x,1))
558     allocate(cp_integer_tmp(cp_integer_size))
559     cp_integer_tmp=cp_integer
560     deallocate(cp_integer)
561     allocate(cp_integer(cp_integer_size*2))
562     print *,'CPI+'
563     cp_integer(1:cp_integer_size) = cp_integer_tmp
564     deallocate(cp_integer_tmp)
565     cp_integer_size=cp_integer_size*2
566     end do
567     do cp_loop_variable_1=lbound(x,1), ubound(x,1), 1
568     cp_integer_pointer=cp_integer_pointer+1
569     cp_integer(cp_integer_pointer)=
570     +x(cp_loop_variable_1)
571     end do
572     end subroutine
573    
574     subroutine cp_arg_restore_integer_vector(x,cp_loop_variable_1)
575     C $OpenAD$ INLINE DECLS
576     implicit none
577     integer, dimension(:) :: x
578     C $OpenAD$ END DECLS
579     do cp_loop_variable_1=ubound(x,1),lbound(x,1),-1
580     x(cp_loop_variable_1)=cp_integer(cp_integer_pointer)
581     cp_integer_pointer=cp_integer_pointer-1
582     end do
583     end subroutine
584    
585     subroutine cp_arg_store_integer_three_tensor(x,
586     +cp_loop_variable_1,
587     +cp_loop_variable_2,
588     +cp_loop_variable_3
589     +)
590     C $OpenAD$ INLINE DECLS
591     implicit none
592     integer, dimension(::) :: x
593     C $OpenAD$ END DECLS
594     do cp_loop_variable_1=lbound(x,1),ubound(x,1)
595     do cp_loop_variable_2=lbound(x,2),ubound(x,2)
596     do while (cp_integer_size .lt.
597     +cp_integer_pointer+ubound(x,3)-lbound(x,3))
598     allocate(cp_integer_tmp(cp_integer_size))
599     cp_integer_tmp=cp_integer
600     deallocate(cp_integer)
601     allocate(cp_integer(cp_integer_size*2))
602     print *,'CPD+'
603     cp_integer(1:cp_integer_size) = cp_integer_tmp
604     deallocate(cp_integer_tmp)
605     cp_integer_size=cp_integer_size*2
606     end do
607     do cp_loop_variable_3=lbound(x,3),ubound(x,3)
608     cp_integer_pointer=cp_integer_pointer+1
609     cp_integer(cp_integer_pointer)=
610     +x(
611     + cp_loop_variable_1,
612     + cp_loop_variable_2,
613     + cp_loop_variable_3
614     + )
615     end do
616     end do
617     end do
618     end subroutine
619    
620     subroutine cp_arg_restore_integer_three_tensor(x,
621     +cp_loop_variable_1,
622     +cp_loop_variable_2,
623     +cp_loop_variable_3
624     +)
625     C $OpenAD$ INLINE DECLS
626     implicit none
627     integer, dimension(::) :: x
628     C $OpenAD$ END DECLS
629     do cp_loop_variable_1=ubound(x,1),lbound(x,1),-1
630     do cp_loop_variable_2=ubound(x,2),lbound(x,2),-1
631     do cp_loop_variable_3=ubound(x,3),lbound(x,3),-1
632     x(
633     + cp_loop_variable_1,
634     + cp_loop_variable_2,
635     + cp_loop_variable_3
636     + )=
637     +cp_integer(cp_integer_pointer)
638     cp_integer_pointer=cp_integer_pointer-1
639     end do
640     end do
641     end do
642     end subroutine
643    
644     subroutine cp_arg_store_integer_four_tensor(x,
645     +cp_loop_variable_1,
646     +cp_loop_variable_2,
647     +cp_loop_variable_3,
648     +cp_loop_variable_4
649     +)
650     C $OpenAD$ INLINE DECLS
651     implicit none
652     integer, dimension(::) :: x
653     C $OpenAD$ END DECLS
654     do cp_loop_variable_1=lbound(x,1),ubound(x,1)
655     do cp_loop_variable_2=lbound(x,2),ubound(x,2)
656     do cp_loop_variable_3=lbound(x,3),ubound(x,3)
657     do while (cp_integer_size .lt.
658     +cp_integer_pointer+ubound(x,4)-lbound(x,4))
659     allocate(cp_integer_tmp(cp_integer_size))
660     cp_integer_tmp=cp_integer
661     deallocate(cp_integer)
662     allocate(cp_integer(cp_integer_size*2))
663     print *,'CPD+'
664     cp_integer(1:cp_integer_size) = cp_integer_tmp
665     deallocate(cp_integer_tmp)
666     cp_integer_size=cp_integer_size*2
667     end do
668     do cp_loop_variable_4=lbound(x,4),ubound(x,4)
669     cp_integer_pointer=cp_integer_pointer+1
670     cp_integer(cp_integer_pointer)=
671     +x(
672     + cp_loop_variable_1,
673     + cp_loop_variable_2,
674     + cp_loop_variable_3,
675     + cp_loop_variable_4
676     + )
677     end do
678     end do
679     end do
680     end do
681     end subroutine
682    
683     subroutine cp_arg_restore_integer_four_tensor(x,
684     +cp_loop_variable_1,
685     +cp_loop_variable_2,
686     +cp_loop_variable_3,
687     +cp_loop_variable_4
688     +)
689     C $OpenAD$ INLINE DECLS
690     implicit none
691     integer, dimension(::) :: x
692     C $OpenAD$ END DECLS
693     do cp_loop_variable_1=ubound(x,1),lbound(x,1),-1
694     do cp_loop_variable_2=ubound(x,2),lbound(x,2),-1
695     do cp_loop_variable_3=ubound(x,3),lbound(x,3),-1
696     do cp_loop_variable_4=ubound(x,4),lbound(x,4),-1
697     x(
698     + cp_loop_variable_1,
699     + cp_loop_variable_2,
700     + cp_loop_variable_3,
701     + cp_loop_variable_4
702     + )=
703     +cp_integer(cp_integer_pointer)
704     cp_integer_pointer=cp_integer_pointer-1
705     end do
706     end do
707     end do
708     end do
709     end subroutine
710    
711     subroutine cp_arg_store_integer_five_tensor(x,
712     +cp_loop_variable_1,
713     +cp_loop_variable_2,
714     +cp_loop_variable_3,
715     +cp_loop_variable_4,
716     +cp_loop_variable_5
717     +)
718     C $OpenAD$ INLINE DECLS
719     implicit none
720     integer, dimension(::) :: x
721     C $OpenAD$ END DECLS
722     do cp_loop_variable_1=lbound(x,1),ubound(x,1)
723     do cp_loop_variable_2=lbound(x,2),ubound(x,2)
724     do cp_loop_variable_3=lbound(x,3),ubound(x,3)
725     do cp_loop_variable_4=lbound(x,4),ubound(x,4)
726     do while (cp_integer_size .lt.
727     +cp_integer_pointer+ubound(x,5)-lbound(x,5))
728     allocate(cp_integer_tmp(cp_integer_size))
729     cp_integer_tmp=cp_integer
730     deallocate(cp_integer)
731     allocate(cp_integer(cp_integer_size*2))
732     print *,'CPD+'
733     cp_integer(1:cp_integer_size) = cp_integer_tmp
734     deallocate(cp_integer_tmp)
735     cp_integer_size=cp_integer_size*2
736     end do
737     do cp_loop_variable_5=lbound(x,5),ubound(x,5)
738     cp_integer_pointer=cp_integer_pointer+1
739     cp_integer(cp_integer_pointer)=
740     +x(
741     + cp_loop_variable_1,
742     + cp_loop_variable_2,
743     + cp_loop_variable_3,
744     + cp_loop_variable_4,
745     + cp_loop_variable_5
746     + )
747     end do
748     end do
749     end do
750     end do
751     end do
752     end subroutine
753    
754     subroutine cp_arg_restore_integer_five_tensor(x,
755     +cp_loop_variable_1,
756     +cp_loop_variable_2,
757     +cp_loop_variable_3,
758     +cp_loop_variable_4,
759     +cp_loop_variable_5
760     +)
761     C $OpenAD$ INLINE DECLS
762     implicit none
763     integer, dimension(::) :: x
764     C $OpenAD$ END DECLS
765     do cp_loop_variable_1=ubound(x,1),lbound(x,1),-1
766     do cp_loop_variable_2=ubound(x,2),lbound(x,2),-1
767     do cp_loop_variable_3=ubound(x,3),lbound(x,3),-1
768     do cp_loop_variable_4=ubound(x,4),lbound(x,4),-1
769     do cp_loop_variable_5=ubound(x,5),lbound(x,5),-1
770     x(
771     + cp_loop_variable_1,
772     + cp_loop_variable_2,
773     + cp_loop_variable_3,
774     + cp_loop_variable_4,
775     + cp_loop_variable_5
776     + )=
777     +cp_integer(cp_integer_pointer)
778     cp_integer_pointer=cp_integer_pointer-1
779     end do
780     end do
781     end do
782     end do
783     end do
784     end subroutine
785    
786     C strings -----------------------------------------------------
787     subroutine cp_arg_store_string_scalar(s)
788     C $OpenAD$ INLINE DECLS
789     implicit none
790     character*(80) :: s
791     C $OpenAD$ END DECLS
792     if(cp_string_size .lt. cp_string_pointer+1) then
793     allocate(cp_string_tmp(cp_string_size))
794     cp_string_tmp=cp_string
795     deallocate(cp_string)
796     allocate(cp_string(cp_string_size*2))
797     print *,'CPS+'
798     cp_string(1:cp_string_size) = cp_string_tmp
799     deallocate(cp_string_tmp)
800     cp_string_size=cp_string_size*2
801     end if
802     cp_string_pointer=cp_string_pointer+1
803     cp_string(cp_string_pointer)=s
804     end subroutine
805    
806     subroutine cp_arg_restore_string_scalar(s)
807     C $OpenAD$ INLINE DECLS
808     implicit none
809     character*(80) :: s
810     C $OpenAD$ END DECLS
811     s=cp_string(cp_string_pointer)
812     cp_string_pointer=cp_string_pointer-1
813     end subroutine
814    
815     C bools -----------------------------------------------------
816     subroutine cp_arg_store_bool_scalar(b)
817     C $OpenAD$ INLINE DECLS
818     implicit none
819     logical :: b
820     C $OpenAD$ END DECLS
821     if(cp_boolean_size .lt. cp_boolean_pointer+1) then
822     allocate(cp_boolean_tmp(cp_boolean_size))
823     cp_boolean_tmp=cp_boolean
824     deallocate(cp_boolean)
825     allocate(cp_boolean(cp_boolean_size*2))
826     print *,'CPB+'
827     cp_boolean(1:cp_boolean_size) = cp_boolean_tmp
828     deallocate(cp_boolean_tmp)
829     cp_boolean_size=cp_boolean_size*2
830     end if
831     cp_boolean_pointer=cp_boolean_pointer+1
832     cp_boolean(cp_boolean_pointer)=b
833     end subroutine
834    
835     subroutine cp_arg_restore_bool_scalar(b)
836     C $OpenAD$ INLINE DECLS
837     implicit none
838     logical :: b
839     C $OpenAD$ END DECLS
840     b=cp_boolean(cp_boolean_pointer)
841     cp_boolean_pointer=cp_boolean_pointer-1
842     end subroutine

  ViewVC Help
Powered by ViewVC 1.1.22