/[MITgcm]/MITgcm_contrib/dgoldberg/streamice/streamice_vel_solve.F
ViewVC logotype

Contents of /MITgcm_contrib/dgoldberg/streamice/streamice_vel_solve.F

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


Revision 1.3 - (show annotations) (download)
Thu Jul 19 18:46:56 2012 UTC (13 years ago) by dgoldberg
Branch: MAIN
Changes since 1.2: +42 -9 lines
TAF compatibility

1 C $Header: /u/gcmpack/MITgcm_contrib/dgoldberg/streamice/streamice_vel_solve.F,v 1.2 2012/05/02 02:36:01 heimbach Exp $
2 C $Name: $
3
4 #include "STREAMICE_OPTIONS.h"
5
6 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
7
8 CBOP
9 SUBROUTINE STREAMICE_VEL_SOLVE( myThid )
10 C /============================================================\
11 C | SUBROUTINE |
12 C | o |
13 C |============================================================|
14 C | |
15 C \============================================================/
16 IMPLICIT NONE
17
18 C === Global variables ===
19 #include "SIZE.h"
20 #include "EEPARAMS.h"
21 #include "PARAMS.h"
22 #include "STREAMICE.h"
23 #include "STREAMICE_CG.h"
24 #ifdef ALLOW_AUTODIFF_TAMC
25 # include "tamc.h"
26 #endif
27
28 C !INPUT/OUTPUT ARGUMENTS
29 INTEGER myThid
30
31 #ifdef ALLOW_STREAMICE
32
33 C LOCAL VARIABLES
34
35 ! real, dimension(:,:), pointer :: TAUDX, TAUDY, u_prev_iterate, v_prev_iterate, &
36 ! u_bdry_cont, v_bdry_cont, Au, Av, err_u, err_v, &
37 ! geolonq, geolatq, u_last, v_last, float_cond, H_node
38 ! type(ocean_grid_type), pointer :: G
39 ! integer :: conv_flag, i, j, k,l, iter, isym, &
40 ! isdq, iedq, jsdq, jedq, isd, ied, jsd, jed, isumstart, jsumstart, nodefloat, nsub
41 ! real :: err_max, err_tempu, err_tempv, err_init, area, max_vel, tempu, tempv, rhoi, rhow
42
43 INTEGER conv_flag, i, j, k, l, iter, cg_iters, bi, bj
44 INTEGER iter_numconv
45 INTEGER ikey_nl
46 _RL err_max, err_tempu, err_tempv, err_init, area
47 _RL max_vel, tempu, tempv, err_lastchange, cgtol
48 CHARACTER*(MAX_LEN_MBUF) msgBuf
49 ! _RL taudx (1-OLx:sNx+OLx,1-OLy:sNy+Oly,nSx,nSy)
50 ! _RL taudy (1-OLx:sNx+OLx,1-OLy:sNy+Oly,nSx,nSy)
51
52 CALL STREAMICE_DRIVING_STRESS (myThid)
53
54 cgtol = streamice_cg_tol
55
56 ! CALL WRITE_FULLARRAY_RL ("taudy_SI",taudy_SI,1,0,0,1,0,myThid)
57
58 _EXCH_XY_RL ( taudx_SI , myThid )
59 _EXCH_XY_RL ( taudy_SI , myThid )
60
61 ! CALL WRITE_FULLARRAY_RL ("taudy_SI_2",taudy_SI,1,0,0,1,0,myThid)
62
63 DO bj = myByLo(myThid), myByHi(myThid)
64 DO bi = myBxLo(myThid), myBxHi(myThid)
65 DO j=1-OLy,sNy+OLy
66 DO i=1-OLx,sNx+OLx
67 u_old_SI (i,j,bi,bj) = U_streamice (i,j,bi,bj)
68 v_old_SI (i,j,bi,bj) = V_streamice (i,j,bi,bj)
69 ENDDO
70 ENDDO
71 ENDDO
72 ENDDO
73
74 #ifdef ALLOW_AUTODIFF_TAMC
75 !$TAF STORE U_streamice = comlev1, key=ikey_dynamics
76 !$TAF STORE V_streamice = comlev1, key=ikey_dynamics
77 #endif
78
79 CALL STREAMICE_VISC_BETA ( myThid )
80
81 _EXCH_XY_RL ( tau_beta_eff_streamice , myThid )
82 _EXCH_XY_RL ( visc_streamice , myThid )
83
84 DO bj = myByLo(myThid), myByHi(myThid)
85 DO bi = myBxLo(myThid), myBxHi(myThid)
86 DO j=1,sNy
87 DO i=1,sNx
88 Au_SI (i,j,bi,bj) = 0. _d 0
89 Av_SI (i,j,bi,bj) = 0. _d 0
90 ubd_SI (i,j,bi,bj) = 0. _d 0
91 vbd_SI (i,j,bi,bj) = 0. _d 0
92 ENDDO
93 ENDDO
94 ENDDO
95 ENDDO
96
97
98 CALL STREAMICE_CG_BOUND_VALS( myThid,
99 O ubd_SI,
100 O vbd_SI)
101
102 #ifdef ALLOW_AUTODIFF_TAMC
103 !$TAF STORE U_streamice = comlev1, key=ikey_dynamics
104 !$TAF STORE V_streamice = comlev1, key=ikey_dynamics
105 #endif
106
107 CALL STREAMICE_CG_ACTION( myThid,
108 O Au_SI,
109 O Av_SI,
110 I U_streamice,
111 I V_streamice,
112 I 0, sNx+1, 0, sNy+1 )
113
114 err_init = 0. _d 0
115
116 DO bj = myByLo(myThid), myByHi(myThid)
117 DO bi = myBxLo(myThid), myBxHi(myThid)
118 #ifdef ALLOW_AUTODIFF_TAMC
119 !$TAF STORE err_init = comlev1, key=ikey_dynamics
120 #endif
121 DO j=1,sNy
122 DO i=1,sNx
123 err_tempu = 0. _d 0
124 err_tempv = 0. _d 0
125 IF (STREAMICE_umask(i,j,bi,bj).eq.1) THEN
126 err_tempu =
127 & ABS (Au_SI(i,j,bi,bj)+ubd_SI(i,j,bi,bj) -
128 & taudx_SI(i,j,bi,bj))
129 ENDIF
130 IF (STREAMICE_vmask(i,j,bi,bj).eq.1) THEN
131 err_tempv = MAX( err_tempu,
132 & ABS (Av_SI(i,j,bi,bj)+vbd_SI(i,j,bi,bj) -
133 & taudy_SI(i,j,bi,bj)))
134 ENDIF
135 IF (err_tempv .ge. err_init) err_init = err_tempv
136 ENDDO
137 ENDDO
138 ENDDO
139 ENDDO
140 #ifdef ALLOW_AUTODIFF_TAMC
141 !$TAF STORE err_init = comlev1, key=ikey_dynamics
142 #endif
143
144 CALL GLOBAL_MAX_R8 (err_init, myThid)
145
146 iter_numconv = 0
147 err_max = err_init
148 err_lastchange = err_init
149
150 C START NL ITER. LOOP
151 C-------------------------------------------------------------------
152
153 DO iter=1,streamice_max_nl_iter
154
155 C To avoid using "exit", loop goes through all iterations
156 C but after convergence loop does nothing
157
158 #ifdef ALLOW_AUTODIFF_TAMC
159 ikey_nl = (ikey_dynamics-1)*streamice_max_nl + iter
160 #endif
161 #ifdef ALLOW_AUTODIFF_TAMC
162 !$TAF STORE cgtol = comlev1_stream_nl, key=ikey_nl
163 !$TAF STORE err_max = comlev1_stream_nl, key=ikey_nl
164 !$TAF STORE err_tempu = comlev1_stream_nl, key=ikey_nl
165 !$TAF STORE err_tempv = comlev1_stream_nl, key=ikey_nl
166 !$TAF STORE err_lastchange = comlev1_stream_nl, key=ikey_nl
167 !$TAF STORE ru_old_si = comlev1_stream_nl, key=ikey_nl
168 !$TAF STORE rv_old_si = comlev1_stream_nl, key=ikey_nl
169 !$TAF STORE streamice_cg_a1 = comlev1_stream_nl, key=ikey_nl
170 !$TAF STORE streamice_cg_a2 = comlev1_stream_nl, key=ikey_nl
171 !$TAF STORE streamice_cg_a3 = comlev1_stream_nl, key=ikey_nl
172 !$TAF STORE streamice_cg_a4 = comlev1_stream_nl, key=ikey_nl
173 !$TAF STORE U_streamice = comlev1_stream_nl, key=ikey_nl
174 !$TAF STORE V_streamice = comlev1_stream_nl, key=ikey_nl
175 !$TAF STORE tau_beta_eff_streamice = comlev1_stream_nl, key=ikey_nl
176 !$TAF STORE visc_streamice = comlev1_stream_nl, key=ikey_nl
177 !$TAF STORE zu_old_si = comlev1_stream_nl, key=ikey_nl
178 !$TAF STORE zv_old_si = comlev1_stream_nl, key=ikey_nl
179 #endif
180
181 IF (err_max .GT. streamice_nonlin_tol * err_init) THEN
182
183 iter_numconv = iter_numconv + 1
184
185 #ifdef ALLOW_AUTODIFF_TAMC
186 !$TAF STORE cgtol = comlev1_stream_nl, key=ikey_nl
187 !$TAF STORE err_max = comlev1_stream_nl, key=ikey_nl
188 !$TAF STORE err_tempu = comlev1_stream_nl, key=ikey_nl
189 !$TAF STORE err_tempv = comlev1_stream_nl, key=ikey_nl
190 !$TAF STORE err_lastchange = comlev1_stream_nl, key=ikey_nl
191 !$TAF STORE ru_old_si = comlev1_stream_nl, key=ikey_nl
192 !$TAF STORE rv_old_si = comlev1_stream_nl, key=ikey_nl
193 !$TAF STORE streamice_cg_a1 = comlev1_stream_nl, key=ikey_nl
194 !$TAF STORE streamice_cg_a2 = comlev1_stream_nl, key=ikey_nl
195 !$TAF STORE streamice_cg_a3 = comlev1_stream_nl, key=ikey_nl
196 !$TAF STORE streamice_cg_a4 = comlev1_stream_nl, key=ikey_nl
197 !$TAF STORE U_streamice = comlev1_stream_nl, key=ikey_nl
198 !$TAF STORE V_streamice = comlev1_stream_nl, key=ikey_nl
199 !$TAF STORE tau_beta_eff_streamice = comlev1_stream_nl, key=ikey_nl
200 !$TAF STORE visc_streamice = comlev1_stream_nl, key=ikey_nl
201 !$TAF STORE zu_old_si = comlev1_stream_nl, key=ikey_nl
202 !$TAF STORE zv_old_si = comlev1_stream_nl, key=ikey_nl
203 #endif
204
205 DO bj = myByLo(myThid), myByHi(myThid)
206 DO bi = myBxLo(myThid), myBxHi(myThid)
207 DO j=1,sNy
208 DO i=1,sNx
209 U_streamice (i,j,bi,bj) = 0. _d 0
210 V_streamice (i,j,bi,bj) = 0. _d 0
211 ENDDO
212 ENDDO
213 ENDDO
214 ENDDO
215
216 CALL STREAMICE_CG_WRAPPER(
217 & U_streamice,
218 & V_streamice,
219 & taudx_SI,
220 & taudy_SI,
221 & cgtol,
222 & cg_iters,
223 & myThid )
224
225
226
227 WRITE(msgBuf,'(A,I5,A,I4,A)') 'streamice linear solve number',
228 & iter, " ",
229 & cg_iters,
230 & ' iterations '
231 CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
232 & SQUEEZE_RIGHT , 1)
233
234 #ifdef ALLOW_AUTODIFF_TAMC
235 !$TAF STORE U_streamice = comlev1_stream_nl, key=ikey_nl
236 !$TAF STORE V_streamice = comlev1_stream_nl, key=ikey_nl
237 #endif
238
239 CALL STREAMICE_VISC_BETA ( myThid )
240
241 #ifdef ALLOW_AUTODIFF_TAMC
242 !$TAF STORE U_streamice = comlev1_stream_nl, key=ikey_nl
243 !$TAF STORE V_streamice = comlev1_stream_nl, key=ikey_nl
244 #endif
245
246 _EXCH_XY_RL ( tau_beta_eff_streamice , myThid )
247 _EXCH_XY_RL ( visc_streamice , myThid )
248
249 DO bj = myByLo(myThid), myByHi(myThid)
250 DO bi = myBxLo(myThid), myBxHi(myThid)
251 DO j=1,sNy
252 DO i=1,sNx
253 Au_SI (i,j,bi,bj) = 0. _d 0
254 Av_SI (i,j,bi,bj) = 0. _d 0
255 ubd_SI (i,j,bi,bj) = 0. _d 0
256 vbd_SI (i,j,bi,bj) = 0. _d 0
257 ENDDO
258 ENDDO
259 ENDDO
260 ENDDO
261
262 CALL STREAMICE_CG_BOUND_VALS( myThid,
263 O ubd_SI,
264 O vbd_SI)
265
266 #ifdef ALLOW_AUTODIFF_TAMC
267 !$TAF STORE U_streamice = comlev1_stream_nl, key=ikey_nl
268 !$TAF STORE V_streamice = comlev1_stream_nl, key=ikey_nl
269 #endif
270
271 CALL STREAMICE_CG_ACTION( myThid,
272 O Au_SI,
273 O Av_SI,
274 I U_streamice,
275 I V_streamice,
276 I 0, sNx+1, 0, sNy+1 )
277
278 #ifdef ALLOW_AUTODIFF_TAMC
279 !$TAF STORE U_streamice = comlev1_stream_nl, key=ikey_nl
280 !$TAF STORE V_streamice = comlev1_stream_nl, key=ikey_nl
281 #endif
282
283 err_max = 0. _d 0
284
285 #ifdef ALLOW_AUTODIFF_TAMC
286 !$TAF STORE err_max = comlev1_stream_nl, key=ikey_nl
287 #endif
288 DO bj = myByLo(myThid), myByHi(myThid)
289 DO bi = myBxLo(myThid), myBxHi(myThid)
290 #ifdef ALLOW_AUTODIFF_TAMC
291 !$TAF STORE err_max = comlev1_stream_nl, key=ikey_nl
292 #endif
293 DO j=1,sNy
294 DO i=1,sNx
295 err_tempu = 0. _d 0
296 err_tempv = 0. _d 0
297 IF (STREAMICE_umask(i,j,bi,bj).eq.1) THEN
298 err_tempu =
299 & ABS (Au_SI(i,j,bi,bj)+ubd_SI(i,j,bi,bj) -
300 & taudx_SI(i,j,bi,bj))
301 ENDIF
302 IF (STREAMICE_vmask(i,j,bi,bj).eq.1) THEN
303 err_tempv = MAX( err_tempu,
304 & ABS (Av_SI(i,j,bi,bj)+vbd_SI(i,j,bi,bj) -
305 & taudy_SI(i,j,bi,bj)))
306 ENDIF
307 IF (err_tempv .ge. err_max) err_max = err_tempv
308 ENDDO
309 ENDDO
310 ENDDO
311 ENDDO
312
313 CALL GLOBAL_MAX_R8 (err_max, myThid)
314
315 WRITE(msgBuf,'(A,F11.7)') 'err/err_init',
316 & err_max/err_init
317 CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
318 & SQUEEZE_RIGHT , 1)
319
320 IF (err_max<err_lastchange*1.e-2 .and.
321 & STREAMICE_lower_cg_tol) THEN
322 cgtol = cgtol * 5.e-2
323 err_lastchange = err_max
324 WRITE(msgBuf,'(A,F11.7)') 'new cg tol: ',
325 & cgtol
326 CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
327 & SQUEEZE_RIGHT , 1)
328 ENDIF
329
330 ENDIF ! (err_max .GT. streamice_nonlin_tol * err_init)
331 ENDDO
332
333 C END NL ITER. LOOP
334 C-------------------------------------------------------------------
335
336 if (iter_numconv .lt. streamice_max_nl_iter) then
337 PRINT *, "VELOCITY SOLVE CONVERGED, ", iter_numconv,
338 & " iterations"
339 else
340 PRINT *, "VELOCITY SOLVE DID NOT CONVERGE IN ",
341 & iter, " iterations"
342 endif
343
344 ! DO bj = myByLo(myThid), myByHi(myThid)
345 ! DO bi = myBxLo(myThid), myBxHi(myThid)
346 ! DO j=1,sNy
347 ! DO i=1,sNx
348 ! U_streamice (i,j,bi,bj) = 0. _d 0
349 ! V_streamice (i,j,bi,bj) = 0. _d 0
350 ! ENDDO
351 ! ENDDO
352 ! ENDDO
353 ! ENDDO
354 !
355 ! CALL STREAMICE_CG_WRAPPER(
356 ! & U_streamice,
357 ! & V_streamice,
358 ! & taudx_SI,
359 ! & taudy_SI,
360 ! & cgtol,
361 ! & cg_iters,
362 ! & myThid )
363
364
365 _EXCH_XY_RL (U_streamice, myThid)
366 _EXCH_XY_RL (V_streamice, myThid)
367
368 #endif
369 RETURN
370 END
371

  ViewVC Help
Powered by ViewVC 1.1.22