1 |
#include "STREAMICE_OPTIONS.h" |
2 |
|
3 |
subroutine template() |
4 |
use OAD_cp |
5 |
use OAD_tape |
6 |
use OAD_rev |
7 |
|
8 |
!$TEMPLATE_PRAGMA_DECLARATIONS |
9 |
|
10 |
integer myi |
11 |
! Temporaries to hold the stack pointers |
12 |
integer temp_double_tape_pointer, temp_integer_tape_pointer, temp_logical_tape_pointer, temp_character_tape_pointer, temp_string_tape_pointer |
13 |
type(modeType) :: our_orig_mode |
14 |
|
15 |
integer iaddr |
16 |
external iaddr |
17 |
!<------------------Begin user declarations ---------------------->! |
18 |
! Insert declarations of dummy variables for calling adjoint computation |
19 |
! without side effects, and storing adjoint variable iterates |
20 |
|
21 |
#if (defined (ALLOW_OPENAD) && defined (ALLOW_STREAMICE_OAD_FP)) |
22 |
|
23 |
#ifdef STREAMICE_ALLOW_FRIC_CONTROL |
24 |
Real*8 C_basal_dummy_d (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy) |
25 |
#endif |
26 |
#ifdef STREAMICE_ALLOW_BGLEN_CONTROL |
27 |
Real*8 B_glen_dummy_d (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy) |
28 |
#endif |
29 |
#ifdef STREAMICE_ALLOW_DEPTH_CONTROL |
30 |
Real*8 R_low_si_dummy_d (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy) |
31 |
#endif |
32 |
Real*8 H_streamice_dummy_d (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy) |
33 |
Real*8 taudx_dummy_d (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy) |
34 |
Real*8 taudy_dummy_d (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy) |
35 |
Real*8 u_dummy_d (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy) |
36 |
Real*8 v_dummy_d (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy) |
37 |
Real*8 u_new_dummy_d (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy) |
38 |
Real*8 v_new_dummy_d (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy) |
39 |
#ifdef STREAMICE_HYBRID_STRESS |
40 |
Real*8 taubx_dummy_d (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy) |
41 |
Real*8 tauby_dummy_d (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy) |
42 |
Real*8 visc_full_dummy_d (1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr,nSx,nSy) |
43 |
Real*8 taubx_new_dummy (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy) |
44 |
Real*8 tauby_new_dummy (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy) |
45 |
Real*8 visc_new_dummy (1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr,nSx,nSy) |
46 |
#endif |
47 |
|
48 |
!<------------------End user declarations ------------------------>! |
49 |
if (our_rev_mode%plain) then |
50 |
our_orig_mode=our_rev_mode |
51 |
IF(ISINLOOP .eq. 0) THEN |
52 |
CONVERGED = .FALSE. |
53 |
ADJ_CONVERGED = .FALSE. |
54 |
!ERR_LAST_CHANGE = 10. |
55 |
end if |
56 |
IF(ISINLOOP .ne. 0) THEN |
57 |
IF(.NOT. CONVERGED) THEN |
58 |
NL_ITER = (NL_ITER + 1) |
59 |
CALL OpenAD_streamice_vel_phi(MYTHID,MAXNLITER,MAXCGITER,CGTOL |
60 |
+,CG_ITERS,err_max) |
61 |
|
62 |
WRITE(MSGBUF,'(A,I5,A,I4,A)') 'streamice linear solve number', |
63 |
+NL_ITER,' ',CG_ITERS,' iterations ' |
64 |
|
65 |
CALL print_message(MSGBUF,STANDARDMESSAGEUNIT,'R',1) |
66 |
|
67 |
!!!!!!!!!!!! conv check |
68 |
|
69 |
if (STREAMICE_chkresidconvergence) then |
70 |
|
71 |
|
72 |
WRITE(msgBuf,'(A,E15.7)') 'err/err_init', |
73 |
& err_max/err_init |
74 |
CALL PRINT_MESSAGE( msgBuf, standardMessageUnit, |
75 |
& SQUEEZE_RIGHT , 1) |
76 |
|
77 |
IF (err_max .LE. streamice_nonlin_tol * err_init) THEN |
78 |
CONVERGED = .true. |
79 |
ENDIF |
80 |
|
81 |
IF (err_max<err_last_change*1.e-2 .and. |
82 |
& STREAMICE_lower_cg_tol) THEN |
83 |
cgtol = cgtol * 5.e-2 |
84 |
err_last_change = err_max |
85 |
WRITE(msgBuf,'(A,E15.7)') 'new cg tol: ', |
86 |
& cgtol |
87 |
CALL PRINT_MESSAGE( msgBuf, standardMessageUnit, |
88 |
& SQUEEZE_RIGHT , 1) |
89 |
ENDIF |
90 |
|
91 |
endif |
92 |
|
93 |
if (STREAMICE_chkfixedptconvergence) then |
94 |
|
95 |
CALL openad_STREAMICE_GET_FP_ERR_OAD ( err_max_fp, myThid ) |
96 |
|
97 |
WRITE(msgBuf,'(A,1PE22.14)') 'STREAMICE_FP_ERROR =', |
98 |
& err_max_fp |
99 |
CALL PRINT_MESSAGE( msgBuf, standardMessageUnit, |
100 |
& SQUEEZE_RIGHT , 1) |
101 |
|
102 |
IF (err_max_fp .LE. streamice_nonlin_tol_fp) THEN |
103 |
CONVERGED = .true. |
104 |
ENDIF |
105 |
|
106 |
|
107 |
endif |
108 |
|
109 |
|
110 |
DO bj = myByLo(myThid), myByHi(myThid) |
111 |
DO bi = myBxLo(myThid), myBxHi(myThid) |
112 |
DO j=1-OLy,sNy+OLy |
113 |
DO i=1-OLx,sNx+OLx |
114 |
U_streamice (i,j,bi,bj)=u_new_SI (i,j,bi,bj) |
115 |
V_streamice (i,j,bi,bj)=v_new_SI (i,j,bi,bj) |
116 |
#ifdef STREAMICE_HYBRID_STRESS |
117 |
streamice_taubx(i,j,bi,bj)=taubx_new_si(i,j,bi,bj) |
118 |
streamice_tauby(i,j,bi,bj)=tauby_new_si(i,j,bi,bj) |
119 |
DO m=Nr,1,-1 |
120 |
visc_streamice_full(i,j,m,bi,bj)= |
121 |
& visc_full_new_si(i,j,m,bi,bj) |
122 |
ENDDO |
123 |
#endif |
124 |
ENDDO |
125 |
ENDDO |
126 |
ENDDO |
127 |
ENDDO |
128 |
|
129 |
!!!!!!!!!!!! end conv check |
130 |
|
131 |
|
132 |
end if |
133 |
end if |
134 |
|
135 |
our_rev_mode=our_orig_mode |
136 |
end if |
137 |
|
138 |
|
139 |
!!!!!!!!!!!! TAPE MODE !!!!!!!!!!!!!! |
140 |
|
141 |
|
142 |
|
143 |
|
144 |
|
145 |
if (our_rev_mode%tape) then |
146 |
our_orig_mode=our_rev_mode |
147 |
if(isinloop.eq.0) then |
148 |
CONVERGED = .false. |
149 |
nl_iter = 0 |
150 |
end if |
151 |
|
152 |
if(isinloop.eq.1) then |
153 |
|
154 |
CALL TIMER_START('STREAMICE TAPE FIXED POINT LOOP',myThid) |
155 |
|
156 |
IF (.not. (CONVERGED).AND. nl_iter.lt.MAXNLITER) THEN |
157 |
NL_ITER = (NL_ITER+1) |
158 |
!Run in plain mode while not converged |
159 |
our_rev_mode%plain=.true. |
160 |
our_rev_mode%tape=.false. |
161 |
our_rev_mode%adjoint=.false. |
162 |
CALL OpenAD_streamice_vel_phi(MYTHID,MAXNLITER,MAXCGITER,CGTOL |
163 |
+,CG_ITERS,err_max) |
164 |
|
165 |
!---- write out number of cg iters |
166 |
|
167 |
WRITE(MSGBUF,'(A,I5,A,I4,A)') 'streamice linear solve number', |
168 |
+NL_ITER,' ',CG_ITERS,' iterations ' |
169 |
! OAD_CTMP0 = 1 |
170 |
CALL print_message(MSGBUF,STANDARDMESSAGEUNIT,'R',1) |
171 |
|
172 |
!---- conv check |
173 |
|
174 |
if (STREAMICE_chkresidconvergence) then |
175 |
|
176 |
|
177 |
WRITE(msgBuf,'(A,E15.7)') 'err/err_init', |
178 |
& err_max/err_init |
179 |
CALL PRINT_MESSAGE( msgBuf, standardMessageUnit, |
180 |
& SQUEEZE_RIGHT , 1) |
181 |
|
182 |
IF (err_max .LE. streamice_nonlin_tol * err_init) THEN |
183 |
CONVERGED = .true. |
184 |
ENDIF |
185 |
|
186 |
IF (err_max<err_last_change*1.e-2 .and. |
187 |
& STREAMICE_lower_cg_tol) THEN |
188 |
cgtol = cgtol * 5.e-2 |
189 |
err_last_change = err_max |
190 |
WRITE(msgBuf,'(A,E15.7)') 'new cg tol: ', |
191 |
& cgtol |
192 |
CALL PRINT_MESSAGE( msgBuf, standardMessageUnit, |
193 |
& SQUEEZE_RIGHT , 1) |
194 |
ENDIF |
195 |
|
196 |
endif |
197 |
|
198 |
if (STREAMICE_chkfixedptconvergence) then |
199 |
|
200 |
CALL openad_STREAMICE_GET_FP_ERR_OAD ( err_max_fp, myThid ) |
201 |
|
202 |
WRITE(msgBuf,'(A,1PE22.14)') 'STREAMICE_FP_ERROR =', |
203 |
& err_max_fp |
204 |
CALL PRINT_MESSAGE( msgBuf, standardMessageUnit, |
205 |
& SQUEEZE_RIGHT , 1) |
206 |
|
207 |
IF (err_max_fp .LE. streamice_nonlin_tol_fp) THEN |
208 |
CONVERGED = .true. |
209 |
ENDIF |
210 |
|
211 |
endif |
212 |
|
213 |
DO bj = myByLo(myThid), myByHi(myThid) |
214 |
DO bi = myBxLo(myThid), myBxHi(myThid) |
215 |
DO j=1-OLy,sNy+OLy |
216 |
DO i=1-OLx,sNx+OLx |
217 |
U_streamice (i,j,bi,bj)%v=u_new_SI (i,j,bi,bj)%v |
218 |
V_streamice (i,j,bi,bj)%v=v_new_SI (i,j,bi,bj)%v |
219 |
#ifdef STREAMICE_HYBRID_STRESS |
220 |
streamice_taubx(i,j,bi,bj)%v= |
221 |
& taubx_new_si(i,j,bi,bj)%v |
222 |
streamice_tauby(i,j,bi,bj)%v= |
223 |
& tauby_new_si(i,j,bi,bj)%v |
224 |
DO m=Nr,1,-1 |
225 |
visc_streamice_full(i,j,m,bi,bj)%v= |
226 |
& visc_full_new_si(i,j,m,bi,bj)%v |
227 |
ENDDO |
228 |
#endif |
229 |
ENDDO |
230 |
ENDDO |
231 |
ENDDO |
232 |
ENDDO |
233 |
|
234 |
|
235 |
|
236 |
|
237 |
|
238 |
!--------conv check done |
239 |
|
240 |
if (converged .OR. nl_iter.eq.MAXNLITER) then |
241 |
!Run once in tape mode if this is the last time |
242 |
our_rev_mode%plain=.false. |
243 |
our_rev_mode%tape=.true. |
244 |
our_rev_mode%adjoint=.false. |
245 |
CALL OpenAD_streamice_vel_phi(MYTHID,MAXNLITER,MAXCGITER,CG |
246 |
+TOL,CG_ITERS,err_max) |
247 |
end if |
248 |
end if |
249 |
CALL TIMER_STOP('STREAMICE TAPE FIXED POINT LOOP',myThid) |
250 |
end if |
251 |
if(isinloop.eq.2 ) then |
252 |
|
253 |
CALL OpenAD_streamice_vel_phi(MYTHID,MAXNLITER,MAXCGITER,CGTOL |
254 |
+,CG_ITERS,err_max) |
255 |
|
256 |
DO bj = myByLo(myThid), myByHi(myThid) |
257 |
DO bi = myBxLo(myThid), myBxHi(myThid) |
258 |
DO j=1-OLy,sNy+OLy |
259 |
DO i=1-OLx,sNx+OLx |
260 |
U_streamice (i,j,bi,bj)%v=u_new_SI (i,j,bi,bj)%v |
261 |
V_streamice (i,j,bi,bj)%v=v_new_SI (i,j,bi,bj)%v |
262 |
#ifdef STREAMICE_HYBRID_STRESS |
263 |
streamice_taubx(i,j,bi,bj)%v= |
264 |
& taubx_new_si(i,j,bi,bj)%v |
265 |
streamice_tauby(i,j,bi,bj)%v= |
266 |
& tauby_new_si(i,j,bi,bj)%v |
267 |
DO m=Nr,1,-1 |
268 |
visc_streamice_full(i,j,m,bi,bj)%v= |
269 |
& visc_full_new_si(i,j,m,bi,bj)%v |
270 |
ENDDO |
271 |
#endif |
272 |
ENDDO |
273 |
ENDDO |
274 |
ENDDO |
275 |
ENDDO |
276 |
end if |
277 |
our_rev_mode=our_orig_mode |
278 |
end if |
279 |
|
280 |
|
281 |
!!!!!!!!!!!! ADJOINT MODE !!!!!!!!!!!!!! |
282 |
|
283 |
|
284 |
|
285 |
if (our_rev_mode%adjoint) then |
286 |
our_orig_mode=our_rev_mode |
287 |
|
288 |
if(isinloop.eq.2) then |
289 |
|
290 |
ADJ_CONVERGED = .false. |
291 |
adj_iter = 0 |
292 |
|
293 |
DO bj = myByLo(myThid), myByHi(myThid) |
294 |
DO bi = myBxLo(myThid), myBxHi(myThid) |
295 |
DO j=1-OLy,sNy+OLy |
296 |
DO i=1-OLx,sNx+OLx |
297 |
v_new_SI (i,j,bi,bj)%d= V_streamice(i,j,bi,bj)%d |
298 |
V_streamice (i,j,bi,bj)%d = 0.0 |
299 |
u_new_SI (i,j,bi,bj)%d= U_streamice(i,j,bi,bj)%d |
300 |
U_streamice (i,j,bi,bj)%d = 0.0 |
301 |
#ifdef STREAMICE_HYBRID_STRESS |
302 |
taubx_new_si(i,j,bi,bj)%d= |
303 |
& streamice_taubx(i,j,bi,bj)%d |
304 |
streamice_taubx(i,j,bi,bj)%d = 0.0 |
305 |
tauby_new_si(i,j,bi,bj)%d= |
306 |
& streamice_tauby(i,j,bi,bj)%d |
307 |
streamice_tauby(i,j,bi,bj)%d = 0.0 |
308 |
DO m=Nr,1,-1 |
309 |
visc_full_new_si(i,j,m,bi,bj)%d= |
310 |
& visc_streamice_full(i,j,m,bi,bj)%d |
311 |
visc_streamice_full(i,j,m,bi,bj)%d = 0.0 |
312 |
ENDDO |
313 |
#endif |
314 |
ENDDO |
315 |
ENDDO |
316 |
ENDDO |
317 |
ENDDO |
318 |
|
319 |
CALL OpenAD_streamice_vel_phi(MYTHID,MAXNLITER,MAXCGITER,CGTOL |
320 |
+,CG_ITERS,err_max) |
321 |
|
322 |
DO BJ = MYBYLO(MYTHID), MYBYHI(MYTHID), 1 |
323 |
DO BI = MYBXLO(MYTHID), MYBXHI(MYTHID), 1 |
324 |
DO J = 1-OLy,sNy+OLy |
325 |
DO I = 1-OLx,sNx+OLx |
326 |
|
327 |
U_streamice_dvals(I,J,BI,BJ) = |
328 |
+U_STREAMICE(INT(I),INT(J),INT(BI),INT(BJ))%d |
329 |
V_streamice_dvals(I,J,BI,BJ) = |
330 |
+V_STREAMICE(INT(I),INT(J),INT(BI),INT(BJ))%d |
331 |
#ifdef STREAMICE_HYBRID_STRESS |
332 |
taubx_dvals(I,J,BI,BJ) = |
333 |
+streamice_taubx(INT(I),INT(J),INT(BI),INT(BJ))%d |
334 |
tauby_dvals(I,J,BI,BJ) = |
335 |
+streamice_tauby(INT(I),INT(J),INT(BI),INT(BJ))%d |
336 |
DO m=Nr,1,-1 |
337 |
visc_full_dvals(I,J,m,BI,BJ) = |
338 |
+VISC_STREAMICE_FULL(INT(I),INT(J),m,INT(BI),INT(BJ))%d |
339 |
ENDDO |
340 |
#endif |
341 |
|
342 |
U_new_si(I,J,BI,BJ)%d = |
343 |
+U_STREAMICE(INT(I),INT(J),INT(BI),INT(BJ))%d |
344 |
V_new_si(I,J,BI,BJ)%d = |
345 |
+V_STREAMICE(INT(I),INT(J),INT(BI),INT(BJ))%d |
346 |
#ifdef STREAMICE_HYBRID_STRESS |
347 |
taubx_new_si(I,J,BI,BJ)%d = |
348 |
+streamice_taubx(INT(I),INT(J),INT(BI),INT(BJ))%d |
349 |
tauby_new_si(I,J,BI,BJ)%d = |
350 |
+streamice_tauby(INT(I),INT(J),INT(BI),INT(BJ))%d |
351 |
DO m=Nr,1,-1 |
352 |
visc_full_new_si(I,J,m,BI,BJ)%d = |
353 |
+VISC_STREAMICE_FULL(INT(I),INT(J),m,INT(BI),INT(BJ))%d |
354 |
ENDDO |
355 |
#endif |
356 |
|
357 |
END DO |
358 |
END DO |
359 |
END DO |
360 |
END DO |
361 |
|
362 |
end if |
363 |
|
364 |
|
365 |
|
366 |
if(isinloop.eq.1) then |
367 |
if((.NOT.ADJ_CONVERGED).AND.(adj_iter.lt.MAXNLITER)) then |
368 |
|
369 |
adj_iter = adj_iter + 1 |
370 |
if (adj_iter.eq.1) then |
371 |
CALL TIMER_START('STREAMICE ADJ FIXED POINT LOOP0',myThid) |
372 |
else |
373 |
CALL TIMER_START('STREAMICE ADJ FIXED POINT LOOP',myThid) |
374 |
endif |
375 |
|
376 |
DO BJ = MYBYLO(MYTHID), MYBYHI(MYTHID), 1 |
377 |
DO BI = MYBXLO(MYTHID), MYBXHI(MYTHID), 1 |
378 |
DO J = 1-OLy,sNy+OLy |
379 |
DO I = 1-OLx,sNx+OLx |
380 |
|
381 |
|
382 |
|
383 |
U_DUMMY_D(INT(I),INT(J),INT(BI),INT(BJ)) = |
384 |
+U_streamice(INT(I),INT(J),INT(BI),INT(BJ))%d |
385 |
V_DUMMY_D(INT(I),INT(J),INT(BI),INT(BJ)) = |
386 |
+V_streamice(INT(I),INT(J),INT(BI),INT(BJ))%d |
387 |
#ifdef STREAMICE_HYBRID_STRESS |
388 |
TAUBX_DUMMY_D(INT(I),INT(J),INT(BI),INT(BJ)) = |
389 |
+streamice_taubx(INT(I),INT(J),INT(BI),INT(BJ))%d |
390 |
TAUBY_DUMMY_D(INT(I),INT(J),INT(BI),INT(BJ)) = |
391 |
+streamice_tauby(INT(I),INT(J),INT(BI),INT(BJ))%d |
392 |
DO m=Nr,1,-1 |
393 |
VISC_FULL_DUMMY_D(INT(I),INT(J),m,INT(BI),INT(BJ))= |
394 |
+VISC_STREAMICE_FULL(INT(I),INT(J),m,INT(BI),INT(BJ))%d |
395 |
ENDDO |
396 |
#endif |
397 |
|
398 |
|
399 |
U_NEW_DUMMY_D(INT(I),INT(J),INT(BI),INT(BJ)) = |
400 |
+U_NEW_SI(INT(I),INT(J),INT(BI),INT(BJ))%d |
401 |
V_NEW_DUMMY_D(INT(I),INT(J),INT(BI),INT(BJ)) = |
402 |
+V_NEW_SI(INT(I),INT(J),INT(BI),INT(BJ))%d |
403 |
#ifdef STREAMICE_HYBRID_STRESS |
404 |
TAUBX_new_DUMMY(INT(I),INT(J),INT(BI),INT(BJ)) = |
405 |
+TAUBX_new_si(INT(I),INT(J),INT(BI),INT(BJ))%d |
406 |
TAUBY_new_DUMMY(INT(I),INT(J),INT(BI),INT(BJ)) = |
407 |
+TAUBY_new_si(INT(I),INT(J),INT(BI),INT(BJ))%d |
408 |
DO m=Nr,1,-1 |
409 |
VISC_new_DUMMY(INT(I),INT(J),m,INT(BI),INT(BJ))= |
410 |
+visc_full_new_si(INT(I),INT(J),m,INT(BI),INT(BJ))%d |
411 |
ENDDO |
412 |
#endif |
413 |
|
414 |
|
415 |
|
416 |
U_STREAMICE(INT(I),INT(J),INT(BI),INT(BJ))%d = |
417 |
+U_streamice_dvals(I,J,BI,BJ) |
418 |
V_STREAMICE(INT(I),INT(J),INT(BI),INT(BJ))%d = |
419 |
+V_STREAMICE_dvals(I,J,BI,BJ) |
420 |
#ifdef STREAMICE_HYBRID_STRESS |
421 |
streamice_taubx(INT(I),INT(J),INT(BI),INT(BJ))%d = |
422 |
+taubx_dvals(I,J,BI,BJ) |
423 |
streamice_tauby(INT(I),INT(J),INT(BI),INT(BJ))%d = |
424 |
+tauby_dvals(I,J,BI,BJ) |
425 |
DO m=Nr,1,-1 |
426 |
VISC_STREAMICE_FULL(INT(I),INT(J),m,INT(BI),INT(BJ))%d |
427 |
+=visc_full_dvals(I,J,m,BI,BJ) |
428 |
ENDDO |
429 |
#endif |
430 |
|
431 |
|
432 |
|
433 |
#ifdef STREAMICE_ALLOW_FRIC_CONTROL |
434 |
C_basal_dummy_d(INT(I),INT(J),INT(BI),INT(BJ)) = |
435 |
+C_basal_friction(INT(I),INT(J),INT(BI),INT(BJ))%d |
436 |
#endif |
437 |
#ifdef STREAMICE_ALLOW_BGLEN_CONTROL |
438 |
b_glen_dummy_d(INT(I),INT(J),INT(BI),INT(BJ)) = |
439 |
+B_glen(INT(I),INT(J),INT(BI),INT(BJ))%d |
440 |
#endif |
441 |
#ifdef STREAMICE_ALLOW_DEPTH_CONTROL |
442 |
R_low_si_dummy_d(INT(I),INT(J),INT(BI),INT(BJ)) = |
443 |
+R_low_si(INT(I),INT(J),INT(BI),INT(BJ))%d |
444 |
#endif |
445 |
H_streamice_dummy_d(INT(I),INT(J),INT(BI),INT(BJ)) = |
446 |
+H_streamice(INT(I),INT(J),INT(BI),INT(BJ))%d |
447 |
taudx_dummy_d(INT(I),INT(J),INT(BI),INT(BJ)) = |
448 |
+taudx_si(INT(I),INT(J),INT(BI),INT(BJ))%d |
449 |
taudy_dummy_d(INT(I),INT(J),INT(BI),INT(BJ)) = |
450 |
+taudy_si(INT(I),INT(J),INT(BI),INT(BJ))%d |
451 |
|
452 |
END DO |
453 |
END DO |
454 |
END DO |
455 |
END DO |
456 |
|
457 |
!Store the stack pointers |
458 |
temp_double_tape_pointer = oad_dt_ptr |
459 |
temp_integer_tape_pointer = oad_it_ptr |
460 |
temp_logical_tape_pointer = oad_lt_ptr |
461 |
temp_string_tape_pointer = oad_st_ptr |
462 |
|
463 |
|
464 |
#ifdef ALLOW_PETSC |
465 |
IF (STREAMICE_OAD_petsc_reuse) then |
466 |
if (adj_iter.eq.1) then |
467 |
STREAMICE_need2createmat=.true. |
468 |
STREAMICE_need2destroymat=.false. |
469 |
PETSC_PRECOND_TMP = PETSC_PRECOND_TYPE |
470 |
PETSC_PRECOND_TYPE = PETSC_PRECOND_OAD |
471 |
else |
472 |
STREAMICE_need2createmat=.false. |
473 |
STREAMICE_need2destroymat=.false. |
474 |
endif |
475 |
ENDIF |
476 |
#endif |
477 |
|
478 |
CALL OpenAD_streamice_vel_phi(MYTHID,MAXNLITER,MAXCGITER,CGTOL |
479 |
+,CG_ITERS,err_max) |
480 |
|
481 |
#ifdef ALLOW_PETSC |
482 |
IF (STREAMICE_OAD_petsc_reuse) then |
483 |
if (adj_iter.eq.MAXNLITER) then |
484 |
STREAMICE_need2createmat=.true. |
485 |
STREAMICE_need2destroymat=.true. |
486 |
CALL streamice_petscmatdestroy(mythid) |
487 |
PETSC_PRECOND_TYPE = PETSC_PRECOND_TMP |
488 |
endif |
489 |
ENDIF |
490 |
#endif |
491 |
|
492 |
DO BJ = MYBYLO(MYTHID), MYBYHI(MYTHID), 1 |
493 |
DO BI = MYBXLO(MYTHID), MYBXHI(MYTHID), 1 |
494 |
DO J = 1-OLy,sNy+OLy |
495 |
DO I = 1-OLx,sNx+OLx |
496 |
|
497 |
U_NEW_SI(INT(I),INT(J),INT(BI),INT(BJ))%d = |
498 |
+U_NEW_DUMMY_D(INT(I),INT(J),INT(BI),INT(BJ)) |
499 |
V_NEW_SI(INT(I),INT(J),INT(BI),INT(BJ))%d = |
500 |
+V_NEW_DUMMY_D(INT(I),INT(J),INT(BI),INT(BJ)) |
501 |
#ifdef STREAMICE_HYBRID_STRESS |
502 |
TAUBX_new_si(INT(I),INT(J),INT(BI),INT(BJ))%d = |
503 |
+TAUBX_new_DUMMY(INT(I),INT(J),INT(BI),INT(BJ)) |
504 |
TAUBY_new_si(INT(I),INT(J),INT(BI),INT(BJ))%d = |
505 |
+TAUBY_new_DUMMY(INT(I),INT(J),INT(BI),INT(BJ)) |
506 |
DO m=Nr,1,-1 |
507 |
visc_full_new_si(INT(I),INT(J),m,INT(BI),INT(BJ))%d= |
508 |
+VISC_new_DUMMY(INT(I),INT(J),m,INT(BI),INT(BJ)) |
509 |
ENDDO |
510 |
#endif |
511 |
|
512 |
END DO |
513 |
END DO |
514 |
END DO |
515 |
END DO |
516 |
|
517 |
!---- write out number of cg iters |
518 |
|
519 |
WRITE(MSGBUF,'(A,I5)') 'streamice adjoint solve number' |
520 |
+,ADJ_ITER |
521 |
! OAD_CTMP0 = 1 |
522 |
CALL print_message(MSGBUF,STANDARDMESSAGEUNIT,'R',1) |
523 |
|
524 |
!---- end write out number of cg iters |
525 |
|
526 |
!---- conv check |
527 |
|
528 |
if (STREAMICE_chkfixedptconvergence) then |
529 |
|
530 |
CALL openad_STREAMICE_GET_FP_ERR_OAD ( err_max_fp, myThid ) |
531 |
|
532 |
WRITE(msgBuf,'(A,1PE22.14)') 'STREAMICE_FP_ADJ_ERROR =', |
533 |
& err_max_fp |
534 |
CALL PRINT_MESSAGE( msgBuf, standardMessageUnit, |
535 |
& SQUEEZE_RIGHT , 1) |
536 |
|
537 |
IF(adj_iter.eq.1) then |
538 |
err_init = err_max_fp |
539 |
ELSEIF (err_max_fp .LE. |
540 |
& streamice_nonlin_tol_adjoint*err_init) THEN |
541 |
ADJ_CONVERGED = .true. |
542 |
#ifdef ALLOW_PETSC |
543 |
IF (STREAMICE_OAD_petsc_reuse) THEN |
544 |
STREAMICE_need2createmat=.true. |
545 |
STREAMICE_need2destroymat=.true. |
546 |
CALL streamice_petscmatdestroy(mythid) |
547 |
PETSC_PRECOND_TYPE = PETSC_PRECOND_TMP |
548 |
ENDIF |
549 |
#endif |
550 |
ENDIF |
551 |
|
552 |
endif |
553 |
|
554 |
!--------conv check done |
555 |
|
556 |
DO BJ = MYBYLO(MYTHID), MYBYHI(MYTHID), 1 |
557 |
DO BI = MYBXLO(MYTHID), MYBXHI(MYTHID), 1 |
558 |
DO J = 1-OLy,sNy+OLy |
559 |
DO I = 1-OLx,sNx+OLx |
560 |
|
561 |
U_NEW_SI(INT(I),INT(J),INT(BI),INT(BJ))%d = U_STREAMICE( |
562 |
+I,J,BI,BJ)%d |
563 |
V_NEW_SI(INT(I),INT(J),INT(BI),INT(BJ))%d = V_STREAMICE( |
564 |
+I,J,BI,BJ)%d |
565 |
#ifdef STREAMICE_HYBRID_STRESS |
566 |
TAUBX_NEW_SI(INT(I),INT(J),INT(BI),INT(BJ))%d = STREAMIC |
567 |
+E_TAUBX(I,J,BI,BJ)%d |
568 |
TAUBY_NEW_SI(INT(I),INT(J),INT(BI),INT(BJ))%d = STREAMIC |
569 |
+E_TAUBY(I,J,BI,BJ)%d |
570 |
DO m=Nr,1,-1 |
571 |
VISC_FULL_NEW_SI(INT(I),INT(J),m,INT(BI),INT(BJ))%d = |
572 |
+VISC_STREAMICE_FULL(I,J,m,BI,BJ)%d |
573 |
ENDDO |
574 |
#endif |
575 |
|
576 |
U_streamice(INT(I),INT(J),INT(BI),INT(BJ))%d = |
577 |
+U_dummy_d(INT(I),INT(J),INT(BI),INT(BJ)) |
578 |
V_streamice(INT(I),INT(J),INT(BI),INT(BJ))%d = |
579 |
+V_dummy_d(INT(I),INT(J),INT(BI),INT(BJ)) |
580 |
#ifdef STREAMICE_HYBRID_STRESS |
581 |
streamice_taubx(INT(I),INT(J),INT(BI),INT(BJ))%d = |
582 |
+taubx_dummy_d(INT(I),INT(J),INT(BI),INT(BJ)) |
583 |
streamice_tauby(INT(I),INT(J),INT(BI),INT(BJ))%d = |
584 |
+tauby_dummy_d(INT(I),INT(J),INT(BI),INT(BJ)) |
585 |
DO m=Nr,1,-1 |
586 |
visc_streamice_full(I,J,m,BI,BJ)%d = |
587 |
+visc_full_dummy_d(I,J,m,BI,BJ) |
588 |
ENDDO |
589 |
#endif |
590 |
|
591 |
#ifdef STREAMICE_ALLOW_FRIC_CONTROL |
592 |
C_basal_friction(INT(I),INT(J),INT(BI),INT(BJ))%d = |
593 |
+C_basal_dummy_d(INT(I),INT(J),INT(BI),INT(BJ)) |
594 |
#endif |
595 |
#ifdef STREAMICE_ALLOW_BGLEN_CONTROL |
596 |
b_glen(INT(I),INT(J),INT(BI),INT(BJ))%d = |
597 |
+B_glen_dummy_d(INT(I),INT(J),INT(BI),INT(BJ)) |
598 |
#endif |
599 |
#ifdef STREAMICE_ALLOW_DEPTH_CONTROL |
600 |
R_low_si(INT(I),INT(J),INT(BI),INT(BJ))%d = |
601 |
+R_low_si_dummy_d(INT(I),INT(J),INT(BI),INT(BJ)) |
602 |
#endif |
603 |
H_streamice(INT(I),INT(J),INT(BI),INT(BJ))%d = |
604 |
+H_streamice_dummy_d(INT(I),INT(J),INT(BI),INT(BJ)) |
605 |
taudx_si(INT(I),INT(J),INT(BI),INT(BJ))%d = |
606 |
+taudx_dummy_d(INT(I),INT(J),INT(BI),INT(BJ)) |
607 |
taudy_si(INT(I),INT(J),INT(BI),INT(BJ))%d = |
608 |
+taudy_dummy_d(INT(I),INT(J),INT(BI),INT(BJ)) |
609 |
|
610 |
END DO |
611 |
END DO |
612 |
END DO |
613 |
END DO |
614 |
|
615 |
oad_dt_ptr = temp_double_tape_pointer |
616 |
oad_it_ptr = temp_integer_tape_pointer |
617 |
oad_lt_ptr = temp_logical_tape_pointer |
618 |
oad_st_ptr = temp_string_tape_pointer |
619 |
|
620 |
if (adj_iter.eq.1) then |
621 |
CALL TIMER_STOP('STREAMICE ADJ FIXED POINT LOOP0',myThid) |
622 |
else |
623 |
CALL TIMER_STOP('STREAMICE ADJ FIXED POINT LOOP',myThid) |
624 |
endif |
625 |
end if |
626 |
end if |
627 |
|
628 |
if(isinloop.eq.0) then |
629 |
|
630 |
CALL OpenAD_streamice_vel_phi(MYTHID,MAXNLITER,MAXCGITER,CGTOL |
631 |
+,CG_ITERS,err_max) |
632 |
|
633 |
DO BJ = MYBYLO(MYTHID), MYBYHI(MYTHID), 1 |
634 |
DO BI = MYBXLO(MYTHID), MYBXHI(MYTHID), 1 |
635 |
DO J = 1-OLy,sNy+OLy |
636 |
DO I = 1-OLx,sNx+OLx |
637 |
|
638 |
U_streamice(INT(I),INT(J),INT(BI),INT(BJ))%d = 0. _d 0 |
639 |
V_streamice(INT(I),INT(J),INT(BI),INT(BJ))%d = 0. _d 0 |
640 |
#ifdef STREAMICE_HYBRID_STRESS |
641 |
streamice_taubx(INT(I),INT(J),INT(BI),INT(BJ))%d = 0. _d 0 |
642 |
streamice_tauby(INT(I),INT(J),INT(BI),INT(BJ))%d = 0. _d 0 |
643 |
DO m=Nr,1,-1 |
644 |
visc_streamice_full(INT(I),INT(J),m,INT(BI),INT(BJ))%d = 0. _d 0 |
645 |
ENDDO |
646 |
#endif |
647 |
|
648 |
END DO |
649 |
END DO |
650 |
END DO |
651 |
END DO |
652 |
|
653 |
end if |
654 |
|
655 |
|
656 |
our_rev_mode=our_orig_mode |
657 |
end if |
658 |
|
659 |
#endif |
660 |
|
661 |
end subroutine template |
662 |
|