/[MITgcm]/MITgcm/tools/OAD_support/ad_template.streamice_cg_solve.F
ViewVC logotype

Contents of /MITgcm/tools/OAD_support/ad_template.streamice_cg_solve.F

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


Revision 1.1 - (show annotations) (download)
Wed Dec 18 20:02:17 2013 UTC (10 years, 3 months ago) by utke
Branch: MAIN
CVS Tags: checkpoint64s
CG solve template - shouldn't have to create copy arrays but passing through directly with sliced arrays had occasionally led to problems

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 Real*8 cg_Uin_p (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
17 Real*8 cg_Vin_p (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
18 Real*8 cg_Bu_p (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
19 Real*8 cg_Bv_p (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
20 Real*8 A_uu_p (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy,-1:1,-1:1)
21 Real*8 A_vu_p (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy,-1:1,-1:1)
22 Real*8 A_uv_p (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy,-1:1,-1:1)
23 Real*8 A_vv_p (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy,-1:1,-1:1)
24 Real*8 cg_Uin_d (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
25 Real*8 cg_Vin_d (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
26 Real*8 cg_Bu_d (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
27 Real*8 cg_Bv_d (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
28 Real*8 A_uu_d (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy,-1:1,-1:1)
29 Real*8 A_vu_d (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy,-1:1,-1:1)
30 Real*8 A_uv_d (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy,-1:1,-1:1)
31 Real*8 A_vv_d (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy,-1:1,-1:1)
32
33 #ifdef OAD_DEBUG_JOINT
34 character*(80):: indentation='
35 + '
36 our_indent=our_indent+1
37
38 write(standardmessageunit, '(A,A,A)', ADVANCE='NO')
39 +'OAD:',indentation(1:our_indent), 'enter __SRNAME__:'
40 call oad_dump_revmod(); call oad_dump_tapestats()
41 write(standardmessageunit,*)
42 #endif
43 if (our_rev_mode%plain) then
44 #ifdef OAD_DEBUG_JOINT
45 write(standardmessageunit,'(A,A,A)')
46 +'OAD:',indentation(1:our_indent),
47 +' __SRNAME__: entering plain'
48 #endif
49 c set up for plain execution
50 our_orig_mode=our_rev_mode
51 our_rev_mode%arg_store=.FALSE.
52 our_rev_mode%arg_restore=.FALSE.
53 our_rev_mode%plain=.TRUE.
54 our_rev_mode%tape=.FALSE.
55 our_rev_mode%adjoint=.FALSE.
56 #ifdef OAD_DEBUG_JOINT
57 write(standardmessageunit,'(A,A,A)')
58 +'OAD:',indentation(1:our_indent),
59 +' __SRNAME__: runninng plain / down plain'
60 #endif
61 cg_Uin_p = cg_Uin%v
62 cg_Vin_p = cg_Vin%v
63 cg_Bu_p = cg_Bu%v
64 cg_Bv_p = cg_Bv%v
65 A_uu_p = A_uu%v
66 A_uv_p = A_uv%v
67 A_vu_p = A_vu%v
68 A_vv_p = A_vv%v
69 call STREAMICE_CG_SOLVE(
70 U cg_Uin_p,
71 U cg_Vin_p,
72 I cg_Bu_p,
73 I cg_Bv_p,
74 I A_uu_p,
75 I A_uv_p,
76 I A_vu_p,
77 I A_vv_p,
78 I tolerance,
79 O iters,
80 I myThid )
81 cg_Uin%v = cg_Uin_p
82 cg_Vin%v = cg_Vin_p
83 c reset the mode
84 our_rev_mode=our_orig_mode
85 end if
86 if (our_rev_mode%tape) then
87
88 #ifdef OAD_DEBUG_JOINT
89 write(standardmessageunit,'(A,A,A)')
90 +'OAD:',indentation(1:our_indent),
91 +' __SRNAME__: entering tape'
92 #endif
93 c set up for plain execution
94 our_orig_mode=our_rev_mode
95 our_rev_mode%arg_store=.FALSE.
96 our_rev_mode%arg_restore=.FALSE.
97 our_rev_mode%plain=.TRUE.
98 our_rev_mode%tape=.FALSE.
99 our_rev_mode%adjoint=.FALSE.
100 #ifdef OAD_DEBUG_JOINT
101 write(standardmessageunit,'(A,A,A)')
102 +'OAD:',indentation(1:our_indent),
103 +' __SRNAME__: runninng plain / down plain'
104 #endif
105 cg_Uin_p = cg_Uin%v
106 cg_Vin_p = cg_Vin%v
107 cg_Bu_p = cg_Bu%v
108 cg_Bv_p = cg_Bv%v
109 A_uu_p = A_uu%v
110 A_uv_p = A_uv%v
111 A_vu_p = A_vu%v
112 A_vv_p = A_vv%v
113 call oad_tape_push(cg_Bu_p)
114 call oad_tape_push(cg_Bv_p)
115 call oad_tape_push(A_uu_p)
116 call oad_tape_push(A_uv_p)
117 call oad_tape_push(A_vu_p)
118 call oad_tape_push(A_vv_p)
119 call oad_tape_push(mythid)
120 call STREAMICE_CG_SOLVE(
121 U cg_Uin_p,
122 U cg_Vin_p,
123 I cg_Bu_p,
124 I cg_Bv_p,
125 I A_uu_p,
126 I A_uv_p,
127 I A_vu_p,
128 I A_vv_p,
129 I tolerance,
130 O iters,
131 I myThid )
132 call oad_tape_push(cg_Uin_p)
133 call oad_tape_push(cg_Vin_p)
134 cg_Uin%v = cg_Uin_p
135 cg_Vin%v = cg_Vin_p
136 c reset the mode
137 our_rev_mode=our_orig_mode
138 end if
139 if (our_rev_mode%adjoint) then
140 #ifdef OAD_DEBUG_JOINT
141 write(standardmessageunit,'(A,A,A)')
142 +'OAD:',indentation(1:our_indent),
143 +' __SRNAME__: entering adjoint'
144 #endif
145 call oad_tape_pop(cg_Vin_p)
146 call oad_tape_pop(cg_Uin_p)
147 call oad_tape_pop(mythid)
148 call oad_tape_pop(A_vv_p)
149 call oad_tape_pop(A_vu_p)
150 call oad_tape_pop(A_uv_p)
151 call oad_tape_pop(A_uu_p)
152 call oad_tape_pop(cg_Bv_p)
153 call oad_tape_pop(cg_Bu_p)
154 c set up for plain execution
155 our_orig_mode=our_rev_mode
156 our_rev_mode%arg_store=.FALSE.
157 our_rev_mode%arg_restore=.FALSE.
158 our_rev_mode%plain=.TRUE.
159 our_rev_mode%tape=.FALSE.
160 our_rev_mode%adjoint=.FALSE.
161 #ifdef OAD_DEBUG_JOINT
162 write(standardmessageunit,'(A,A,A)')
163 +'OAD:',indentation(1:our_indent),
164 +' __SRNAME__: runninng self adjoint / down plain'
165 #endif
166 cg_Uin_d = cg_Uin%d
167 cg_Vin_d = cg_Vin%d
168 cg_Bu_d = cg_Bu%d
169 cg_Bv_d = cg_Bv%d
170 A_uu_d = A_uu%d
171 A_uv_d = A_uv%d
172 A_vu_d = A_vu%d
173 A_vv_d = A_vv%d
174 call ADSTREAMICE_CG_SOLVE(
175 U cg_Uin_p, ! velocities - solution
176 I cg_Bu_d, ! adjoint of vel (input)
177 U cg_Vin_p, ! velocities - solution
178 I cg_Bv_d, ! adjoint of vel (input)
179 I cg_Bu_p, ! to recalc velocities
180 U cg_Uin_d, ! adjoint of RHS (output)
181 I cg_Bv_p, ! to recalc velocities
182 U cg_Vin_d, ! adjoint of RHS (output)
183 I A_uu_p, ! section of matrix that multiplies u and projects on u
184 U A_uu_d, ! adjoint of matrix coeffs (output)
185 I A_uv_p, ! section of matrix that multiplies v and projects on u
186 U A_uv_d, ! adjoint of matrix coeffs (output)
187 I A_vu_p, ! section of matrix that multiplies u and projects on v
188 U A_vu_d, ! adjoint of matrix coeffs (output)
189 I A_vv_p, ! section of matrix that multiplies v and projects on v
190 U A_vv_d, ! adjoint of matrix coeffs (output)
191 I tolerance,
192 c I iters,
193 I myThid )
194 c reset the mode
195 cg_Uin%d = cg_Uin_d
196 cg_Vin%d = cg_Vin_d
197 cg_Bu%d = cg_Bu_d
198 cg_Bv%d = cg_Bv_d
199 A_uu%d = A_uu_d
200 A_uv%d = A_uv_d
201 A_vu%d = A_vu_d
202 A_vv%d = A_vv_d
203 our_rev_mode=our_orig_mode
204 end if
205 #ifdef OAD_DEBUG_JOINT
206 write(standardmessageunit,'(A,A,A)', ADVANCE='NO')
207 +'OAD:',indentation(1:our_indent), 'leave __SRNAME__:'
208 call oad_dump_revmod(); call oad_dump_tapestats()
209 write(standardmessageunit,*)
210
211 our_indent=our_indent-1
212 #endif
213
214 end subroutine template

  ViewVC Help
Powered by ViewVC 1.1.22