/[MITgcm]/MITgcm_contrib/heimbach/OpenAD/OAD_support/ad_template.sa_cg2d.f
ViewVC logotype

Contents of /MITgcm_contrib/heimbach/OpenAD/OAD_support/ad_template.sa_cg2d.f

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


Revision 1.5 - (show annotations) (download)
Fri Feb 20 21:07:18 2009 UTC (17 years, 6 months ago) by utke
Branch: MAIN
CVS Tags: HEAD
Changes since 1.4: +0 -0 lines
FILE REMOVED
rename to make it go through the preprocessor

1 subroutine template()
2 use OAD_cp
3 use OAD_tape
4 use OAD_rev
5
6 !$TEMPLATE_PRAGMA_DECLARATIONS
7
8 integer :: cp_loop_variable_1,cp_loop_variable_2,
9 + cp_loop_variable_3,cp_loop_variable_4
10
11 type(modeType) :: our_orig_mode
12
13 integer iaddr
14 external iaddr
15
16 INTEGER numItersHelper
17 INTEGER myThidHelper
18
19 Real*8 cg2d_b_p(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
20 Real*8 cg2d_x_p(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
21
22 character*(80):: indentation='
23 + '
24 our_indent=our_indent+1
25
26 write(*, '(A,A,A)', ADVANCE='NO')
27 +'JU:',indentation(1:our_indent), 'enter __SRNAME__:'
28 call oad_dump_revmod(); call oad_dump_tapestats()
29 write(*,*)
30
31 if (our_rev_mode%plain) then
32 write(*,'(A,A,A)')
33 +'JU:',indentation(1:our_indent),
34 +' __SRNAME__: entering plain'
35 c set up for plain execution
36 our_orig_mode=our_rev_mode
37 our_rev_mode%arg_store=.FALSE.
38 our_rev_mode%arg_restore=.FALSE.
39 our_rev_mode%plain=.TRUE.
40 our_rev_mode%tape=.FALSE.
41 our_rev_mode%adjoint=.FALSE.
42 write(*,'(A,A,A)')
43 +'JU:',indentation(1:our_indent),
44 +' __SRNAME__: runninng plain / down plain'
45 cg2d_b_p=cg2d_b%v
46 cg2d_x_p=cg2d_x%v
47 call cg2d (
48 I cg2d_b_p,
49 U cg2d_x_p,
50 O firstResidual,
51 O lastResidual,
52 U numIters,
53 I myThid)
54 cg2d_x%v=cg2d_x_p
55 c reset the mode
56 our_rev_mode=our_orig_mode
57 end if
58 if (our_rev_mode%tape) then
59
60 numItersHelper=numiters
61 mythidHelper=mythid
62
63 write(*,'(A,A,A)')
64 +'JU:',indentation(1:our_indent),
65 +' __SRNAME__: entering tape'
66 c set up for plain execution
67 our_orig_mode=our_rev_mode
68 our_rev_mode%arg_store=.FALSE.
69 our_rev_mode%arg_restore=.FALSE.
70 our_rev_mode%plain=.TRUE.
71 our_rev_mode%tape=.FALSE.
72 our_rev_mode%adjoint=.FALSE.
73 write(*,'(A,A,A)')
74 +'JU:',indentation(1:our_indent),
75 +' __SRNAME__: runninng plain / down plain'
76 cg2d_b_p=cg2d_b%v
77 cg2d_x_p=cg2d_x%v
78 call cg2d (
79 I cg2d_b_p,
80 U cg2d_x_p,
81 O firstResidual,
82 O lastResidual,
83 U numIters,
84 I myThid)
85 cg2d_x%v=cg2d_x_p
86 c reset the mode
87 our_rev_mode=our_orig_mode
88 c manually push two integers to the tape:
89 if(oad_it_sz.lt. oad_it_ptr) call oad_it_grow()
90 oad_it(oad_it_ptr)=numItersHelper; oad_it_ptr=oad_it_ptr+1
91 if(oad_it_sz.lt. oad_it_ptr) call oad_it_grow()
92 oad_it(oad_it_ptr)=mythidHelper; oad_it_ptr=oad_it_ptr+1
93 end if
94 if (our_rev_mode%adjoint) then
95 write(*,'(A,A,A)')
96 +'JU:',indentation(1:our_indent),
97 +' __SRNAME__: entering adjoint'
98 c manually pop two integers from the tape:
99 oad_it_ptr=oad_it_ptr-1
100 mythid=oad_it(oad_it_ptr)
101 oad_it_ptr=oad_it_ptr-1
102 numiters=oad_it(oad_it_ptr)
103 c selfadjoint:
104 c the original is called with
105 c cg2d(b,x,...)
106 c in the adjoint context if we
107 c use the same code base
108 c we call with
109 c cg2d(x_bar,bh,...
110 c where afterwards
111 c b_bar+=bh and x_bar=0
112 c the adjoint second formal argument cg2d_x should be
113 c the values of the first argument:
114 cg2d_b_p=cg2d_x%d
115 c the first formal argument cg2d_b should hold
116 c the increment, i.e. we nullify the second formal
117 c argument (cg2d_x) value:
118 cg2d_x_p=0.0
119 c set up for plain execution
120 our_orig_mode=our_rev_mode
121 our_rev_mode%arg_store=.FALSE.
122 our_rev_mode%arg_restore=.FALSE.
123 our_rev_mode%plain=.TRUE.
124 our_rev_mode%tape=.FALSE.
125 our_rev_mode%adjoint=.FALSE.
126 write(*,'(A,A,A)')
127 +'JU:',indentation(1:our_indent),
128 +' __SRNAME__: runninng self adjoint / down plain'
129 call cg2d (
130 I cg2d_b_p,
131 U cg2d_x_p,
132 O firstResidual,
133 O lastResidual,
134 U numIters,
135 I myThid)
136 c reset the mode
137 our_rev_mode=our_orig_mode
138 c now the adjoint result is the increment
139 c contained in the second formal argument
140 cg2d_b%d= cg2d_b%d+cg2d_x_p
141 cg2d_x%d=0.0
142 end if
143
144 write(*,'(A,A,A)', ADVANCE='NO')
145 +'JU:',indentation(1:our_indent), 'leave __SRNAME__:'
146 call oad_dump_revmod(); call oad_dump_tapestats()
147 write(*,*)
148
149 our_indent=our_indent-1
150 end subroutine template

  ViewVC Help
Powered by ViewVC 1.1.22