1 |
|
2 |
subroutine template() |
3 |
use OAD_cp |
4 |
use OAD_tape |
5 |
use OAD_rev |
6 |
|
7 |
!$TEMPLATE_PRAGMA_DECLARATIONS |
8 |
|
9 |
! LOGICAL ADJ_CONVERGED |
10 |
integer myi |
11 |
! integer iter |
12 |
! Temporaries to hold the stack pointers |
13 |
integer temp_double_tape_pointer, temp_integer_tape_pointer, temp_logical_tape_pointer, temp_character_tape_pointer, temp_string_tape_pointer |
14 |
type(modeType) :: our_orig_mode |
15 |
|
16 |
integer iaddr |
17 |
external iaddr |
18 |
!<------------------Begin user declarations ---------------------->! |
19 |
! Insert declarations of dummy variables for calling adjoint computation |
20 |
! without side effects, and storing adjoint variable iterates |
21 |
!TO DO: Fix the sizes of variables and names |
22 |
! type(active) :: B_DUMMY(1:79) |
23 |
! type(active) :: H_DUMMY(1:79) |
24 |
! type(active) :: U_DUMMY(1:80) |
25 |
! type(active) :: U_TEMP(1:80) |
26 |
|
27 |
Real*8 C_basal_dummy_d (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy) |
28 |
Real*8 B_glen_dummy_d (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy) |
29 |
Real*8 H_streamice_dummy_d (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy) |
30 |
Real*8 taudx_dummy_d (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy) |
31 |
Real*8 taudy_dummy_d (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy) |
32 |
Real*8 u_dummy_d (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy) |
33 |
Real*8 v_dummy_d (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy) |
34 |
|
35 |
! double precision, save :: U_0_d(1:80) |
36 |
! type(active) :: U_IP1_PRE(1:80) |
37 |
!<------------------End user declarations ------------------------>! |
38 |
!print *, 'STREAMICE START ', oad_dt_ptr,' ',oad_it_ptr,' ',oad_lt_ptr,' ',oad_st_ptr |
39 |
if (our_rev_mode%plain) then |
40 |
our_orig_mode=our_rev_mode |
41 |
IF(ISINLOOP .eq. 0) THEN |
42 |
CONVERGED = .FALSE. |
43 |
ADJ_CONVERGED = .FALSE. |
44 |
ERR_LAST_CHANGE = 10. |
45 |
end if |
46 |
IF(ISINLOOP .ne. 0) THEN |
47 |
IF(.NOT. CONVERGED) THEN |
48 |
NL_ITER = (NL_ITER + 1) |
49 |
CALL OpenAD_streamice_vel_phi(MYTHID,MAXNLITER,MAXCGITER,CGTOL |
50 |
+,CG_ITERS) |
51 |
WRITE(MSGBUF,'(A,I5,A,I4,A)') 'streamice linear solve number', |
52 |
+NL_ITER,' ',CG_ITERS,' iterations ' |
53 |
OAD_CTMP0 = 1 |
54 |
CALL print_message(MSGBUF,STANDARDMESSAGEUNIT,'R',OAD_CTMP0) |
55 |
!IF(STREAMICE_CHKFIXEDPTCONVERGENCE) THEN |
56 |
IF(.FALSE.) THEN |
57 |
CALL OpenAD_streamice_get_vel_fp_err(ERR_MAX_FP,MYTHID) |
58 |
WRITE(MSGBUF,'(A,1PE22.14)') 'STREAMICE_FP_ERROR =',ERR_MAX_ |
59 |
+FP |
60 |
OAD_CTMP1 = 1 |
61 |
CALL print_message(MSGBUF,STANDARDMESSAGEUNIT,'R',OAD_CTMP1) |
62 |
IF(ERR_MAX_FP .LE. STREAMICE_NONLIN_TOL_FP) THEN |
63 |
CONVERGED = .TRUE. |
64 |
end if |
65 |
IF(STREAMICE_LOWER_CG_TOL .AND.(ERR_MAX_FP .LT.( ERR_LAST_CH |
66 |
+ANGE * 1.00000000000000002082D-02))) THEN |
67 |
CGTOL = (CGTOL * 5.00000000000000027756D-02) |
68 |
ERR_LAST_CHANGE = ERR_MAX_FP |
69 |
WRITE(MSGBUF,'(A,E15.7)') 'new cg tol: ',CGTOL |
70 |
OAD_CTMP2 = 1 |
71 |
CALL print_message(MSGBUF,STANDARDMESSAGEUNIT,'R',OAD_CTMP |
72 |
+2) |
73 |
end if |
74 |
end if |
75 |
end if |
76 |
end if |
77 |
DO bj = myByLo(myThid), myByHi(myThid) |
78 |
DO bi = myBxLo(myThid), myBxHi(myThid) |
79 |
DO j=1-OLy,sNy+OLy |
80 |
DO i=1-OLx,sNx+OLx |
81 |
U_streamice (i,j,bi,bj)=u_new_SI (i,j,bi,bj) |
82 |
V_streamice (i,j,bi,bj)=v_new_SI (i,j,bi,bj) |
83 |
ENDDO |
84 |
ENDDO |
85 |
ENDDO |
86 |
ENDDO |
87 |
our_rev_mode=our_orig_mode |
88 |
end if |
89 |
|
90 |
|
91 |
!!!!!!!!!!!! TAPE MODE !!!!!!!!!!!!!! |
92 |
|
93 |
|
94 |
|
95 |
|
96 |
|
97 |
if (our_rev_mode%tape) then |
98 |
our_orig_mode=our_rev_mode |
99 |
if(isinloop.eq.0) then |
100 |
CONVERGED = .false. |
101 |
nl_iter = 0 |
102 |
end if |
103 |
|
104 |
if(isinloop.eq.1) then |
105 |
IF (.not. (CONVERGED).AND. nl_iter.lt.MAXNLITER) THEN |
106 |
NL_ITER = (NL_ITER+1) |
107 |
!Run in plain mode while not converged |
108 |
our_rev_mode%plain=.true. |
109 |
our_rev_mode%tape=.false. |
110 |
our_rev_mode%adjoint=.false. |
111 |
CALL OpenAD_streamice_vel_phi(MYTHID,MAXNLITER,MAXCGITER,CGTOL |
112 |
+,CG_ITERS) |
113 |
|
114 |
!---- write out number of cg iters |
115 |
|
116 |
WRITE(MSGBUF,'(A,I5,A,I4,A)') 'streamice linear solve number', |
117 |
+NL_ITER,' ',CG_ITERS,' iterations ' |
118 |
OAD_CTMP0 = 1 |
119 |
CALL print_message(MSGBUF,STANDARDMESSAGEUNIT,'R',OAD_CTMP0) |
120 |
|
121 |
!---- conv check |
122 |
|
123 |
|
124 |
|
125 |
!--------conv check done |
126 |
|
127 |
DO bj = myByLo(myThid), myByHi(myThid) |
128 |
DO bi = myBxLo(myThid), myBxHi(myThid) |
129 |
DO j=1-OLy,sNy+OLy |
130 |
DO i=1-OLx,sNx+OLx |
131 |
U_streamice (i,j,bi,bj)%v=u_new_SI (i,j,bi,bj)%v |
132 |
V_streamice (i,j,bi,bj)%v=v_new_SI (i,j,bi,bj)%v |
133 |
ENDDO |
134 |
ENDDO |
135 |
ENDDO |
136 |
ENDDO |
137 |
if (converged .OR. nl_iter.eq.MAXNLITER) then |
138 |
!Run once in tape mode if this is the last time |
139 |
our_rev_mode%plain=.false. |
140 |
our_rev_mode%tape=.true. |
141 |
our_rev_mode%adjoint=.false. |
142 |
CALL OpenAD_streamice_vel_phi(MYTHID,MAXNLITER,MAXCGITER,CGTOL |
143 |
+,CG_ITERS) |
144 |
end if |
145 |
end if |
146 |
end if |
147 |
if(isinloop.eq.2 ) then |
148 |
|
149 |
CALL OpenAD_streamice_vel_phi(MYTHID,MAXNLITER,MAXCGITER,CGTOL |
150 |
+,CG_ITERS) |
151 |
|
152 |
DO bj = myByLo(myThid), myByHi(myThid) |
153 |
DO bi = myBxLo(myThid), myBxHi(myThid) |
154 |
DO j=1-OLy,sNy+OLy |
155 |
DO i=1-OLx,sNx+OLx |
156 |
U_streamice (i,j,bi,bj)%v=u_new_SI (i,j,bi,bj)%v |
157 |
V_streamice (i,j,bi,bj)%v=v_new_SI (i,j,bi,bj)%v |
158 |
ENDDO |
159 |
ENDDO |
160 |
ENDDO |
161 |
ENDDO |
162 |
end if |
163 |
our_rev_mode=our_orig_mode |
164 |
end if |
165 |
|
166 |
|
167 |
!!!!!!!!!!!! ADJOINT MODE !!!!!!!!!!!!!! |
168 |
|
169 |
|
170 |
|
171 |
if (our_rev_mode%adjoint) then |
172 |
our_orig_mode=our_rev_mode |
173 |
|
174 |
if(isinloop.eq.2) then |
175 |
|
176 |
ADJ_CONVERGED = .false. |
177 |
adj_iter = 0 |
178 |
|
179 |
DO bj = myByLo(myThid), myByHi(myThid) |
180 |
DO bi = myBxLo(myThid), myBxHi(myThid) |
181 |
DO j=1-OLy,sNy+OLy |
182 |
DO i=1-OLx,sNx+OLx |
183 |
v_new_SI (i,j,bi,bj)%d= V_streamice(i,j,bi,bj)%d |
184 |
V_streamice (i,j,bi,bj)%d = 0.0 |
185 |
u_new_SI (i,j,bi,bj)%d= U_streamice(i,j,bi,bj)%d |
186 |
U_streamice (i,j,bi,bj)%d = 0.0 |
187 |
ENDDO |
188 |
ENDDO |
189 |
ENDDO |
190 |
ENDDO |
191 |
|
192 |
CALL OpenAD_streamice_vel_phi(MYTHID,MAXNLITER,MAXCGITER,CGTOL |
193 |
+,CG_ITERS) |
194 |
|
195 |
DO BJ = MYBYLO(MYTHID), MYBYHI(MYTHID), 1 |
196 |
DO BI = MYBXLO(MYTHID), MYBXHI(MYTHID), 1 |
197 |
DO J = 1-OLy,sNy+OLy |
198 |
DO I = 1-OLx,sNx+OLx |
199 |
|
200 |
U_streamice_dvals(I,J,BI,BJ) = |
201 |
+U_STREAMICE(INT(I),INT(J),INT(BI),INT(BJ))%d |
202 |
V_streamice_dvals(I,J,BI,BJ) = |
203 |
+V_STREAMICE(INT(I),INT(J),INT(BI),INT(BJ))%d |
204 |
|
205 |
U_new_si(I,J,BI,BJ)%d = |
206 |
+U_STREAMICE(INT(I),INT(J),INT(BI),INT(BJ))%d |
207 |
V_new_si(I,J,BI,BJ)%d = |
208 |
+V_STREAMICE(INT(I),INT(J),INT(BI),INT(BJ))%d |
209 |
|
210 |
END DO |
211 |
END DO |
212 |
END DO |
213 |
END DO |
214 |
|
215 |
end if |
216 |
|
217 |
|
218 |
|
219 |
if(isinloop.eq.1) then |
220 |
if((.NOT.ADJ_CONVERGED).AND.(adj_iter.lt.MAXNLITER)) then |
221 |
|
222 |
adj_iter = adj_iter + 1 |
223 |
|
224 |
DO BJ = MYBYLO(MYTHID), MYBYHI(MYTHID), 1 |
225 |
DO BI = MYBXLO(MYTHID), MYBXHI(MYTHID), 1 |
226 |
DO J = 1-OLy,sNy+OLy |
227 |
DO I = 1-OLx,sNx+OLx |
228 |
|
229 |
U_DUMMY_D(INT(I),INT(J),INT(BI),INT(BJ)) = |
230 |
+U_streamice(INT(I),INT(J),INT(BI),INT(BJ))%d |
231 |
V_DUMMY_D(INT(I),INT(J),INT(BI),INT(BJ)) = |
232 |
+V_streamice(INT(I),INT(J),INT(BI),INT(BJ))%d |
233 |
|
234 |
U_STREAMICE(INT(I),INT(J),INT(BI),INT(BJ))%d = |
235 |
+U_streamice_dvals(I,J,BI,BJ) |
236 |
V_STREAMICE(INT(I),INT(J),INT(BI),INT(BJ))%d = |
237 |
+V_STREAMICE_dvals(I,J,BI,BJ) |
238 |
|
239 |
C_basal_dummy_d(INT(I),INT(J),INT(BI),INT(BJ)) = |
240 |
+C_basal_friction(INT(I),INT(J),INT(BI),INT(BJ))%d |
241 |
b_glen_dummy_d(INT(I),INT(J),INT(BI),INT(BJ)) = |
242 |
+B_glen(INT(I),INT(J),INT(BI),INT(BJ))%d |
243 |
H_streamice_dummy_d(INT(I),INT(J),INT(BI),INT(BJ)) = |
244 |
+H_streamice(INT(I),INT(J),INT(BI),INT(BJ))%d |
245 |
taudx_dummy_d(INT(I),INT(J),INT(BI),INT(BJ)) = |
246 |
+taudx_si(INT(I),INT(J),INT(BI),INT(BJ))%d |
247 |
taudy_dummy_d(INT(I),INT(J),INT(BI),INT(BJ)) = |
248 |
+taudy_si(INT(I),INT(J),INT(BI),INT(BJ))%d |
249 |
|
250 |
END DO |
251 |
END DO |
252 |
END DO |
253 |
END DO |
254 |
|
255 |
!Store the stack pointers |
256 |
temp_double_tape_pointer = oad_dt_ptr |
257 |
temp_integer_tape_pointer = oad_it_ptr |
258 |
temp_logical_tape_pointer = oad_lt_ptr |
259 |
temp_string_tape_pointer = oad_st_ptr |
260 |
|
261 |
!---- conv check |
262 |
|
263 |
|
264 |
|
265 |
!--------conv check done |
266 |
|
267 |
CALL OpenAD_streamice_vel_phi(MYTHID,MAXNLITER,MAXCGITER,CGTOL |
268 |
+,CG_ITERS) |
269 |
|
270 |
!---- write out number of cg iters |
271 |
|
272 |
WRITE(MSGBUF,'(A,I5,A,I4,A)') 'streamice adjoint solve number' |
273 |
+,NL_ITER,' ',CG_ITERS,' iterations ' |
274 |
OAD_CTMP0 = 1 |
275 |
CALL print_message(MSGBUF,STANDARDMESSAGEUNIT,'R',OAD_CTMP0) |
276 |
|
277 |
!---- end write out number of cg iters |
278 |
|
279 |
DO BJ = MYBYLO(MYTHID), MYBYHI(MYTHID), 1 |
280 |
DO BI = MYBXLO(MYTHID), MYBXHI(MYTHID), 1 |
281 |
DO J = 1-OLy,sNy+OLy |
282 |
DO I = 1-OLx,sNx+OLx |
283 |
U_NEW_SI(INT(I),INT(J),INT(BI),INT(BJ))%d = U_STREAMICE( |
284 |
+I,J,BI,BJ)%d |
285 |
V_NEW_SI(INT(I),INT(J),INT(BI),INT(BJ))%d = V_STREAMICE( |
286 |
+I,J,BI,BJ)%d |
287 |
|
288 |
U_streamice(INT(I),INT(J),INT(BI),INT(BJ))%d = |
289 |
+U_dummy_d(INT(I),INT(J),INT(BI),INT(BJ)) |
290 |
V_streamice(INT(I),INT(J),INT(BI),INT(BJ))%d = |
291 |
+V_dummy_d(INT(I),INT(J),INT(BI),INT(BJ)) |
292 |
|
293 |
C_basal_friction(INT(I),INT(J),INT(BI),INT(BJ))%d = |
294 |
+C_basal_dummy_d(INT(I),INT(J),INT(BI),INT(BJ)) |
295 |
b_glen(INT(I),INT(J),INT(BI),INT(BJ))%d = |
296 |
+B_glen_dummy_d(INT(I),INT(J),INT(BI),INT(BJ)) |
297 |
H_streamice(INT(I),INT(J),INT(BI),INT(BJ))%d = |
298 |
+H_streamice_dummy_d(INT(I),INT(J),INT(BI),INT(BJ)) |
299 |
taudx_si(INT(I),INT(J),INT(BI),INT(BJ))%d = |
300 |
+taudx_dummy_d(INT(I),INT(J),INT(BI),INT(BJ)) |
301 |
taudy_si(INT(I),INT(J),INT(BI),INT(BJ))%d = |
302 |
+taudy_dummy_d(INT(I),INT(J),INT(BI),INT(BJ)) |
303 |
|
304 |
END DO |
305 |
END DO |
306 |
END DO |
307 |
END DO |
308 |
|
309 |
oad_dt_ptr = temp_double_tape_pointer |
310 |
oad_it_ptr = temp_integer_tape_pointer |
311 |
oad_lt_ptr = temp_logical_tape_pointer |
312 |
oad_st_ptr = temp_string_tape_pointer |
313 |
|
314 |
end if |
315 |
end if |
316 |
|
317 |
if(isinloop.eq.0) then |
318 |
|
319 |
CALL OpenAD_streamice_vel_phi(MYTHID,MAXNLITER,MAXCGITER,CGTOL,CG_ITERS) |
320 |
|
321 |
DO BJ = MYBYLO(MYTHID), MYBYHI(MYTHID), 1 |
322 |
DO BI = MYBXLO(MYTHID), MYBXHI(MYTHID), 1 |
323 |
DO J = 1-OLy,sNy+OLy |
324 |
DO I = 1-OLx,sNx+OLx |
325 |
|
326 |
U_streamice(INT(I),INT(J),INT(BI),INT(BJ))%d = 0. _d 0 |
327 |
V_streamice(INT(I),INT(J),INT(BI),INT(BJ))%d = 0. _d 0 |
328 |
|
329 |
END DO |
330 |
END DO |
331 |
END DO |
332 |
END DO |
333 |
|
334 |
end if |
335 |
|
336 |
|
337 |
our_rev_mode=our_orig_mode |
338 |
end if |
339 |
|
340 |
|
341 |
end subroutine template |
342 |
|