/[MITgcm]/MITgcm/pkg/seaice/dynsolver.F
ViewVC logotype

Annotation of /MITgcm/pkg/seaice/dynsolver.F

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


Revision 1.7 - (hide annotations) (download)
Wed Apr 30 16:46:15 2003 UTC (21 years, 2 months ago) by dimitri
Branch: MAIN
CVS Tags: checkpoint50c_post, checkpoint50d_post, checkpoint50f_post, checkpoint50f_pre, checkpoint50e_pre, checkpoint50e_post, checkpoint50d_pre
Changes since 1.6: +36 -11 lines
Modified Files:	pkg/seaice/budget.F, dynsolver.F, and seaice_readparms.F

1 heimbach 1.2 C $Header:
2    
3     #include "SEAICE_OPTIONS.h"
4    
5     CStartOfInterface
6     SUBROUTINE dynsolver( myTime, myIter, myThid )
7     C /==========================================================\
8     C | SUBROUTINE dynsolver |
9     C | o Ice dynamics solver |
10 dimitri 1.6 C | See Zhang and Hibler, JGR, 102, 8691-8702, 1997 |
11     C | Zhang and Rothrock, JGR, 105, 3325-3338, 2000 |
12     C | and Hibler, JPO, 9, 815- 846, 1979 |
13 heimbach 1.2 C |==========================================================|
14     C \==========================================================/
15     IMPLICIT NONE
16    
17     C === Global variables ===
18     #include "SIZE.h"
19     #include "EEPARAMS.h"
20     #include "PARAMS.h"
21     #include "FFIELDS.h"
22     #include "SEAICE.h"
23     #include "SEAICE_GRID.h"
24     #include "SEAICE_PARAMS.h"
25     #include "SEAICE_FFIELDS.h"
26    
27 dimitri 1.3 #ifdef ALLOW_AUTODIFF_TAMC
28     # include "tamc.h"
29 dimitri 1.5 #endif
30 dimitri 1.3
31 heimbach 1.2 C === Routine arguments ===
32     C myTime - Simulation time
33     C myIter - Simulation timestep number
34     C myThid - Thread no. that called this routine.
35     _RL myTime
36     INTEGER myIter
37     INTEGER myThid
38     CEndOfInterface
39    
40     #ifdef ALLOW_SEAICE
41    
42     C === Local variables ===
43 dimitri 1.4 C i,j,bi,bj - Loop counters
44 heimbach 1.2
45 dimitri 1.4 INTEGER i, j, bi, bj, kii
46 dimitri 1.5 _RL DWAT, DAIR, RHOICE, RHOAIR, SINWIN, COSWIN, SINWAT, COSWAT
47     _RL GRAV, ECCEN, ECM2, GMIN, RADIUS, DELT1, DELT2, PSTAR, AAA
48 dimitri 1.7 _RL TEMPVAR
49 heimbach 1.2
50     _RL PRESS (1-OLx:sNx+OLx,1-OLy:sNy+OLy, nSx,nSy)
51 dimitri 1.5 _RL DAIRN (1-OLx:sNx+OLx,1-OLy:sNy+OLy, nSx,nSy)
52 heimbach 1.2 _RL DWATN (1-OLx:sNx+OLx,1-OLy:sNy+OLy, nSx,nSy)
53     _RL FORCEX0 (1-OLx:sNx+OLx,1-OLy:sNy+OLy, nSx,nSy)
54     _RL FORCEY0 (1-OLx:sNx+OLx,1-OLy:sNy+OLy, nSx,nSy)
55     _RL E11 (1-OLx:sNx+OLx,1-OLy:sNy+OLy, nSx,nSy)
56     _RL E22 (1-OLx:sNx+OLx,1-OLy:sNy+OLy, nSx,nSy)
57     _RL E12 (1-OLx:sNx+OLx,1-OLy:sNy+OLy, nSx,nSy)
58     _RL COR_ICE (1-OLx:sNx+OLx,1-OLy:sNy+OLy, nSx,nSy)
59     _RL ZMAX (1-OLx:sNx+OLx,1-OLy:sNy+OLy, nSx,nSy)
60     _RL ZMIN (1-OLx:sNx+OLx,1-OLy:sNy+OLy, nSx,nSy)
61    
62 dimitri 1.4 C-- FIRST SET UP BASIC CONSTANTS
63 dimitri 1.3 DWAT=0.59 _d 0
64     DAIR=0.01462 _d 0
65     RHOICE=0.91 _d +03
66     RHOAIR=1.3 _d 0
67 dimitri 1.4 GRAV=9.832 _d 0
68     ECCEN=TWO
69     ECM2=ONE/(ECCEN**2)
70     GMIN=1.0 _d -20
71     RADIUS=6370. _d 3
72     PSTAR=SEAICE_strength
73    
74     C-- 25 DEG GIVES SIN EQUAL TO 0.4226
75 dimitri 1.3 SINWIN=0.4226 _d 0
76     COSWIN=0.9063 _d 0
77     SINWAT=0.4226 _d 0
78     COSWAT=0.9063 _d 0
79 dimitri 1.4
80     C-- Do not introduce turning angle
81 dimitri 1.3 SINWIN=ZERO
82     COSWIN=ONE
83     SINWAT=ZERO
84     COSWAT=ONE
85    
86 dimitri 1.4 C-- NOW SET UP MASS PER UNIT AREA AND CORIOLIS TERM
87 heimbach 1.2 DO bj=myByLo(myThid),myByHi(myThid)
88     DO bi=myBxLo(myThid),myBxHi(myThid)
89     DO j=1,sNy
90     DO i=1,sNx
91 dimitri 1.3 AMASS(I,J,bi,bj)=RHOICE*QUART*(HEFF(i,j,1,bi,bj)
92 dimitri 1.6 & +HEFF(i-1,j,1,bi,bj)
93     & +HEFF(i,j-1,1,bi,bj)
94     & +HEFF(i-1,j-1,1,bi,bj))
95 heimbach 1.2 COR_ICE(I,J,bi,bj)=AMASS(I,J,bi,bj)
96 dimitri 1.4 & *TWO*OMEGA*SINEICE(I,J,bi,bj)
97     ENDDO
98     ENDDO
99     ENDDO
100     ENDDO
101    
102     C-- NOW SET UP FORCING FIELDS
103    
104     IF (SEAICEwindOnCgrid) THEN
105     C-- Wind stress computed here from wind on South-West C-grid
106     DO bj=myByLo(myThid),myByHi(myThid)
107     DO bi=myBxLo(myThid),myBxHi(myThid)
108     DO j=1,sNy
109     DO i=1,sNx
110 dimitri 1.6 AAA=(HALF*(UWIND(I,J,bi,bj)+UWIND(I,J-1,bi,bj)))**2+
111     & (HALF*(VWIND(I,J,bi,bj)+VWIND(I-1,J,bi,bj)))**2
112     IF ( AAA .LT. SEAICE_EPS_SQ ) THEN
113     AAA=SEAICE_EPS
114     ELSE
115     AAA=SQRT(AAA)
116     ENDIF
117 dimitri 1.4 DAIRN(I,J,bi,bj)=RHOAIR*SEAICE_drag*
118     & (2.70 _d 0+0.142 _d 0*AAA+0.0764 _d 0*AAA*AAA)
119     FORCEX(I,J,bi,bj)=DAIRN(I,J,bi,bj)*
120 dimitri 1.6 & (COSWIN*HALF*(UWIND(I,J,bi,bj)+UWIND(I,J-1,bi,bj))
121     & -SINWIN*HALF*(VWIND(I,J,bi,bj)+VWIND(I-1,J,bi,bj)))
122 dimitri 1.4 FORCEY(I,J,bi,bj)=DAIRN(I,J,bi,bj)*
123 dimitri 1.6 & (SINWIN*HALF*(UWIND(I,J,bi,bj)+UWIND(I,J-1,bi,bj))
124     & +COSWIN*HALF*(VWIND(I,J,bi,bj)+VWIND(I-1,J,bi,bj)))
125 dimitri 1.4 ENDDO
126     ENDDO
127     ENDDO
128     ENDDO
129    
130     ELSE
131     C-- Wind stress computed here from wind on South-West B-grid
132     DO bj=myByLo(myThid),myByHi(myThid)
133     DO bi=myBxLo(myThid),myBxHi(myThid)
134     DO j=1,sNy
135     DO i=1,sNx
136 dimitri 1.6 AAA=UWIND(I,J,bi,bj)**2+VWIND(I,J,bi,bj)**2
137     IF ( AAA .LT. SEAICE_EPS_SQ ) THEN
138     AAA=SEAICE_EPS
139     ELSE
140     AAA=SQRT(AAA)
141     ENDIF
142 dimitri 1.4 DAIRN(I,J,bi,bj)=RHOAIR*SEAICE_drag*
143     & (2.70 _d 0+0.142 _d 0*AAA+0.0764 _d 0*AAA*AAA)
144     FORCEX(I,J,bi,bj)=DAIRN(I,J,bi,bj)*(COSWIN*UWIND(I,J,bi,bj)
145     & -SINWIN*VWIND(I,J,bi,bj))
146     FORCEY(I,J,bi,bj)=DAIRN(I,J,bi,bj)*(SINWIN*UWIND(I,J,bi,bj)
147     & +COSWIN*VWIND(I,J,bi,bj))
148     ENDDO
149     ENDDO
150     ENDDO
151     ENDDO
152     ENDIF
153 heimbach 1.2
154 dimitri 1.4 DO bj=myByLo(myThid),myByHi(myThid)
155     DO bi=myBxLo(myThid),myBxHi(myThid)
156     DO j=1,sNy
157     DO i=1,sNx
158     C-- STORE WIND ONLY STRESS
159 heimbach 1.2 WINDX(I,J,bi,bj)=FORCEX(I,J,bi,bj)
160     WINDY(I,J,bi,bj)=FORCEY(I,J,bi,bj)
161 dimitri 1.4 C-- NOW ADD IN TILT
162 heimbach 1.2 FORCEX(I,J,bi,bj)=FORCEX(I,J,bi,bj)
163 dimitri 1.4 & -COR_ICE(I,J,bi,bj)*GWATY(I,J,bi,bj)
164 heimbach 1.2 FORCEY(I,J,bi,bj)=FORCEY(I,J,bi,bj)
165 dimitri 1.4 & +COR_ICE(I,J,bi,bj)*GWATX(I,J,bi,bj)
166     C-- NOW SET UP ICE PRESSURE AND VISCOSITIES
167 heimbach 1.2 PRESS(I,J,bi,bj)=PSTAR*HEFF(I,J,1,bi,bj)
168 dimitri 1.4 & *EXP(-20.0 _d 0*(ONE-AREA(I,J,1,bi,bj)))
169 dimitri 1.3 ZMAX(I,J,bi,bj)=(5.0 _d +12/(2.0 _d +04))*PRESS(I,J,bi,bj)
170     ZMIN(I,J,bi,bj)=4.0 _d +08
171 heimbach 1.2 PRESS(I,J,bi,bj)=PRESS(I,J,bi,bj)*HEFFM(I,J,bi,bj)
172     ENDDO
173     ENDDO
174     ENDDO
175     ENDDO
176    
177     #ifdef SEAICE_ALLOW_DYNAMICS
178     IF ( SEAICEuseDYNAMICS ) THEN
179    
180     C-- Update overlap regions for PRESS
181     _EXCH_XY_R8(PRESS, myThid)
182    
183     DO bj=myByLo(myThid),myByHi(myThid)
184     DO bi=myBxLo(myThid),myBxHi(myThid)
185     DO j=1,sNy
186     DO i=1,sNx
187     C NOW CALCULATE PRESSURE FORCE AND ADD TO EXTERNAL FORCE
188     FORCEX(I,J,bi,bj)=FORCEX(I,J,bi,bj)
189 dimitri 1.3 & -(QUART/(DXUICE(I,J,bi,bj)*CSUICE(I,J,bi,bj)))
190 dimitri 1.6 & *(PRESS(I,J,bi,bj)+PRESS(I,J-1,bi,bj)
191     & -PRESS(I-1,J,bi,bj)-PRESS(I-1,J-1,bi,bj))
192 dimitri 1.3 FORCEY(I,J,bi,bj)=FORCEY(I,J,bi,bj)-QUART/DYUICE(I,J,bi,bj)
193 dimitri 1.6 & *(PRESS(I,J,bi,bj)+PRESS(I-1,J,bi,bj)
194     & -PRESS(I,J-1,bi,bj)-PRESS(I-1,J-1,bi,bj))
195 heimbach 1.2 C NOW KEEP FORCEX0
196     FORCEX0(I,J,bi,bj)=FORCEX(I,J,bi,bj)
197     FORCEY0(I,J,bi,bj)=FORCEY(I,J,bi,bj)
198     ENDDO
199     ENDDO
200     ENDDO
201     ENDDO
202    
203     C DO PSEUDO-TIMESTEPS TO OBTAIN AN ACCURATE VISCOUS-PLASTIC SOLUTION
204 dimitri 1.6 C A RANGE OF 5-300 PSEUDO-TIMESTEPS IS SUGGESTED DEPENDING ON ACCURACY
205     C REQUIREMENTS OF SPECIFIC APPLICATION
206 heimbach 1.2 C NPSEUDO is now set in data.seaice input file
207     C TIMESTEP FOR PSEUDO-TIMESTEPPING
208 dimitri 1.3 SEAICE_DT = DELTAT/NPSEUDO
209    
210     crg what about DWAIN,DRAGS,DRAGA,ETA,ZETA
211    
212     crg later c$taf loop = iteration uice,vice
213    
214 heimbach 1.2 DO 5000 KII=1,NPSEUDO
215    
216 dimitri 1.7 cdmc$taf store uice,vice = comlev1_seaice_ds,
217     cdmc$taf& key = kii + (ikey_dynamics-1)*NPSEUDO
218 dimitri 1.3
219 heimbach 1.2 C NOW DO PREDICTOR TIME STEP
220     DO bj=myByLo(myThid),myByHi(myThid)
221     DO bi=myBxLo(myThid),myBxHi(myThid)
222     DO j=1-OLy,sNy+OLy
223     DO i=1-OLx,sNx+OLx
224     UICE(I,J,2,bi,bj)=UICE(I,J,1,bi,bj)
225     VICE(I,J,2,bi,bj)=VICE(I,J,1,bi,bj)
226     UICEC(I,J,bi,bj)=UICE(I,J,1,bi,bj)
227     VICEC(I,J,bi,bj)=VICE(I,J,1,bi,bj)
228     ENDDO
229     ENDDO
230     ENDDO
231     ENDDO
232    
233     DO bj=myByLo(myThid),myByHi(myThid)
234     DO bi=myBxLo(myThid),myBxHi(myThid)
235     DO j=1,sNy
236     DO i=1,sNx
237 dimitri 1.3 C NOW SET UP NON-LINEAR WATER DRAG, FORCEX, FORCEY
238 dimitri 1.7 TEMPVAR=(UICE(I,J,1,bi,bj)-GWATX(I,J,bi,bj))**2
239     & +(VICE(I,J,1,bi,bj)-GWATY(I,J,bi,bj))**2
240     IF ( TEMPVAR .LT. SEAICE_EPS_SQ ) THEN
241     DWATN(I,J,bi,bj)=SEAICE_waterDrag*SEAICE_EPS
242     ELSE
243     DWATN(I,J,bi,bj)=SEAICE_waterDrag*SQRT(TEMPVAR)
244     ENDIF
245 dimitri 1.3 DWATN(I,J,bi,bj)=MAX(DWATN(I,J,bi,bj),QUART)
246 heimbach 1.2 C NOW SET UP SYMMETTRIC DRAG
247     DRAGS(I,J,bi,bj)=DWATN(I,J,bi,bj)*COSWAT
248     C NOW SET UP ANTI SYMMETTRIC DRAG PLUS CORIOLIS
249     DRAGA(I,J,bi,bj)=DWATN(I,J,bi,bj)*SINWAT+COR_ICE(I,J,bi,bj)
250     C NOW ADD IN CURRENT FORCE
251     FORCEX(I,J,bi,bj)=FORCEX0(I,J,bi,bj)+DWATN(I,J,bi,bj)
252     & *(COSWAT*GWATX(I,J,bi,bj)
253     & -SINWAT*GWATY(I,J,bi,bj))
254     FORCEY(I,J,bi,bj)=FORCEY0(I,J,bi,bj)+DWATN(I,J,bi,bj)
255     & *(SINWAT*GWATX(I,J,bi,bj)
256     & +COSWAT*GWATY(I,J,bi,bj))
257     ENDDO
258     ENDDO
259     ENDDO
260     ENDDO
261    
262     DO bj=myByLo(myThid),myByHi(myThid)
263     DO bi=myBxLo(myThid),myBxHi(myThid)
264     DO j=1,sNy
265     DO i=1,sNx
266     C NOW EVALUATE STRAIN RATES
267 dimitri 1.3 E11(I,J,bi,bj)=HALF/(DXTICE(I,J,bi,bj)*CSTICE(I,J,bi,bj))
268 dimitri 1.6 & *(UICE(I+1,J+1,1,bi,bj)+UICE(I+1,J,1,bi,bj)
269     & -UICE(I,J+1,1,bi,bj)-UICE(I,J,1,bi,bj))
270     & -QUART*(VICE(I+1,J+1,1,bi,bj)
271     & +VICE(I,J+1,1,bi,bj)
272     & +VICE(I,J,1,bi,bj)+VICE(I+1,J,1,bi,bj))
273 heimbach 1.2 & *TNGTICE(I,J,bi,bj)/RADIUS
274 dimitri 1.3 E22(I,J,bi,bj)=HALF/DYTICE(I,J,bi,bj)
275 dimitri 1.6 & *(VICE(I+1,J+1,1,bi,bj)+VICE(I,J+1,1,bi,bj)
276     & -VICE(I+1,J,1,bi,bj)-VICE(I,J,1,bi,bj))
277 dimitri 1.3 E12(I,J,bi,bj)=HALF*(HALF/DYTICE(I,J,bi,bj)
278 dimitri 1.6 & *(UICE(I+1,J+1,1,bi,bj)+UICE(I,J+1,1,bi,bj)
279     & -UICE(I+1,J,1,bi,bj)-UICE(I,J,1,bi,bj))
280 dimitri 1.3 & +HALF/(DXTICE(I,J,bi,bj)*CSTICE(I,J,bi,bj))
281 dimitri 1.6 & *(VICE(I+1,J+1,1,bi,bj)+VICE(I+1,J,1,bi,bj)
282     & -VICE(I,J+1,1,bi,bj)-VICE(I,J,1,bi,bj))
283     & +QUART*(UICE(I+1,J+1,1,bi,bj)
284     & +UICE(I,J+1,1,bi,bj)
285     & +UICE(I,J,1,bi,bj)+UICE(I+1,J,1,bi,bj))
286 heimbach 1.2 & *TNGTICE(I,J,bi,bj)/RADIUS)
287     C NOW EVALUATE VISCOSITIES
288 dimitri 1.3 DELT1=(E11(I,J,bi,bj)**2+E22(I,J,bi,bj)**2)*(ONE+ECM2)
289     & +4.0 _d 0*ECM2*E12(I,J,bi,bj)**2
290     1 +TWO*E11(I,J,bi,bj)*E22(I,J,bi,bj)*(ONE-ECM2)
291 dimitri 1.7 IF ( DELT1 .LT. SEAICE_EPS_SQ ) THEN
292     DELT2=SEAICE_EPS
293     ELSE
294     DELT2=SQRT(DELT1)
295     ENDIF
296 heimbach 1.2 DELT2=MAX(GMIN,DELT2)
297 dimitri 1.3 ZETA(I,J,bi,bj)=HALF*PRESS(I,J,bi,bj)/DELT2
298 heimbach 1.2 C NOW PUT MIN AND MAX VISCOSITIES IN
299     ZETA(I,J,bi,bj)=MIN(ZMAX(I,J,bi,bj),ZETA(I,J,bi,bj))
300     ZETA(I,J,bi,bj)=MAX(ZMIN(I,J,bi,bj),ZETA(I,J,bi,bj))
301     C NOW SET VISCOSITIES TO ZERO AT HEFFMFLOW PTS
302     ZETA(I,J,bi,bj)=ZETA(I,J,bi,bj)*HEFFM(I,J,bi,bj)
303     ETA(I,J,bi,bj)=ECM2*ZETA(I,J,bi,bj)
304     ENDDO
305     ENDDO
306     ENDDO
307     ENDDO
308    
309     C-- Update overlap regions
310     _EXCH_XY_R8(ETA, myThid)
311     _EXCH_XY_R8(ZETA, myThid)
312    
313     C NOW ADI SCHEME (ZHANG-J/ROTHROCK 1999,bi,bj)
314 dimitri 1.7 #ifdef ALLOW_AUTODIFF_TAMC
315     CALL ADI( myThid )
316     #else /* ALLOW_AUTODIFF_TAMC */
317 heimbach 1.2 IF ( SEAICEuseLSR ) THEN
318     CALL LSR( myThid )
319     ELSE
320     CALL ADI( myThid )
321     ENDIF
322 dimitri 1.7 #endif /* ALLOW_AUTODIFF_TAMC */
323 heimbach 1.2
324     C NOW DO MODIFIED EULER STEP
325     DO bj=myByLo(myThid),myByHi(myThid)
326     DO bi=myBxLo(myThid),myBxHi(myThid)
327     DO j=1-OLy,sNy+OLy
328     DO i=1-OLx,sNx+OLx
329 dimitri 1.3 UICE(I,J,1,bi,bj)=HALF*(UICE(I,J,1,bi,bj)+UICE(I,J,2,bi,bj))
330     VICE(I,J,1,bi,bj)=HALF*(VICE(I,J,1,bi,bj)+VICE(I,J,2,bi,bj))
331 heimbach 1.2 UICEC(I,J,bi,bj)=UICE(I,J,1,bi,bj)
332     VICEC(I,J,bi,bj)=VICE(I,J,1,bi,bj)
333     ENDDO
334     ENDDO
335     ENDDO
336     ENDDO
337    
338     DO bj=myByLo(myThid),myByHi(myThid)
339     DO bi=myBxLo(myThid),myBxHi(myThid)
340     DO j=1,sNy
341     DO i=1,sNx
342     C NOW SET UP NON-LINEAR WATER DRAG
343 dimitri 1.7 TEMPVAR=(UICE(I,J,1,bi,bj)-GWATX(I,J,bi,bj))**2
344     & +(VICE(I,J,1,bi,bj)-GWATY(I,J,bi,bj))**2
345     IF ( TEMPVAR .LT. SEAICE_EPS_SQ ) THEN
346     DWATN(I,J,bi,bj)=SEAICE_waterDrag*SEAICE_EPS
347     ELSE
348     DWATN(I,J,bi,bj)=SEAICE_waterDrag*SQRT(TEMPVAR)
349     ENDIF
350 dimitri 1.3 DWATN(I,J,bi,bj)=MAX(DWATN(I,J,bi,bj),QUART)
351 heimbach 1.2 C NOW SET UP SYMMETTRIC DRAG
352     DRAGS(I,J,bi,bj)=DWATN(I,J,bi,bj)*COSWAT
353     C NOW SET UP ANTI SYMMETTRIC DRAG PLUS CORIOLIS
354     DRAGA(I,J,bi,bj)=DWATN(I,J,bi,bj)*SINWAT+COR_ICE(I,J,bi,bj)
355     C NOW ADD IN CURRENT FORCE
356     FORCEX(I,J,bi,bj)=FORCEX0(I,J,bi,bj)+DWATN(I,J,bi,bj)
357     & *(COSWAT*GWATX(I,J,bi,bj)
358     & -SINWAT*GWATY(I,J,bi,bj))
359     FORCEY(I,J,bi,bj)=FORCEY0(I,J,bi,bj)+DWATN(I,J,bi,bj)
360     & *(SINWAT*GWATX(I,J,bi,bj)
361     & +COSWAT*GWATY(I,J,bi,bj))
362     ENDDO
363     ENDDO
364     ENDDO
365     ENDDO
366    
367     DO bj=myByLo(myThid),myByHi(myThid)
368     DO bi=myBxLo(myThid),myBxHi(myThid)
369     DO j=1,sNy
370     DO i=1,sNx
371     C NOW EVALUATE STRAIN RATES
372 dimitri 1.3 E11(I,J,bi,bj)=HALF/(DXTICE(I,J,bi,bj)*CSTICE(I,J,bi,bj))
373 dimitri 1.6 & *(UICE(I+1,J+1,1,bi,bj)+UICE(I+1,J,1,bi,bj)
374     & -UICE(I,J+1,1,bi,bj)-UICE(I,J,1,bi,bj))
375     & -QUART*(VICE(I+1,J+1,1,bi,bj)
376     & +VICE(I,J+1,1,bi,bj)
377     & +VICE(I,J,1,bi,bj)+VICE(I+1,J,1,bi,bj))
378 heimbach 1.2 & *TNGTICE(I,J,bi,bj)/RADIUS
379 dimitri 1.3 E22(I,J,bi,bj)=HALF/DYTICE(I,J,bi,bj)
380 dimitri 1.6 & *(VICE(I+1,J+1,1,bi,bj)+VICE(I,J+1,1,bi,bj)
381     & -VICE(I+1,J,1,bi,bj)-VICE(I,J,1,bi,bj))
382 dimitri 1.3 E12(I,J,bi,bj)=HALF*(HALF/DYTICE(I,J,bi,bj)
383 dimitri 1.6 & *(UICE(I+1,J+1,1,bi,bj)+UICE(I,J+1,1,bi,bj)
384     & -UICE(I+1,J,1,bi,bj)-UICE(I,J,1,bi,bj))
385 dimitri 1.3 & +HALF/(DXTICE(I,J,bi,bj)*CSTICE(I,J,bi,bj))
386 dimitri 1.6 & *(VICE(I+1,J+1,1,bi,bj)+VICE(I+1,J,1,bi,bj)
387     & -VICE(I,J+1,1,bi,bj)-VICE(I,J,1,bi,bj))
388     & +QUART*(UICE(I+1,J+1,1,bi,bj)
389     & +UICE(I,J+1,1,bi,bj)
390     & +UICE(I,J,1,bi,bj)+UICE(I+1,J,1,bi,bj))
391 heimbach 1.2 & *TNGTICE(I,J,bi,bj)/RADIUS)
392     C NOW EVALUATE VISCOSITIES
393 dimitri 1.3 DELT1=(E11(I,J,bi,bj)**2+E22(I,J,bi,bj)**2)*(ONE+ECM2)
394     & +4. _d 0*ECM2*E12(I,J,bi,bj)**2
395     1 +TWO*E11(I,J,bi,bj)*E22(I,J,bi,bj)*(ONE-ECM2)
396 dimitri 1.7 IF ( DELT1 .LT. SEAICE_EPS_SQ ) THEN
397     DELT2=SEAICE_EPS
398     ELSE
399     DELT2=SQRT(DELT1)
400     ENDIF
401 heimbach 1.2 DELT2=MAX(GMIN,DELT2)
402 dimitri 1.3 ZETA(I,J,bi,bj)=HALF*PRESS(I,J,bi,bj)/DELT2
403 heimbach 1.2 C NOW PUT MIN AND MAX VISCOSITIES IN
404     ZETA(I,J,bi,bj)=MIN(ZMAX(I,J,bi,bj),ZETA(I,J,bi,bj))
405     ZETA(I,J,bi,bj)=MAX(ZMIN(I,J,bi,bj),ZETA(I,J,bi,bj))
406     C NOW SET VISCOSITIES TO ZERO AT HEFFMFLOW PTS
407     ZETA(I,J,bi,bj)=ZETA(I,J,bi,bj)*HEFFM(I,J,bi,bj)
408     ETA(I,J,bi,bj)=ECM2*ZETA(I,J,bi,bj)
409     ENDDO
410     ENDDO
411     ENDDO
412     ENDDO
413    
414     C-- Update overlap regions
415     _EXCH_XY_R8(ETA, myThid)
416     _EXCH_XY_R8(ZETA, myThid)
417    
418     C GET READY FOR SECOND CALL OF ADI
419     DO bj=myByLo(myThid),myByHi(myThid)
420     DO bi=myBxLo(myThid),myBxHi(myThid)
421     DO j=1-OLy,sNy+OLy
422     DO i=1-OLx,sNx+OLx
423     UICE(I,J,2,bi,bj)=UICEC(I,J,bi,bj)
424     VICE(I,J,2,bi,bj)=VICEC(I,J,bi,bj)
425     ENDDO
426     ENDDO
427     ENDDO
428     ENDDO
429    
430     C NOW ADI SCHEME (ZHANG-J/ROTHROCK 1999)
431 dimitri 1.7 #ifdef ALLOW_AUTODIFF_TAMC
432     CALL ADI( myThid )
433     #else /* ALLOW_AUTODIFF_TAMC */
434 heimbach 1.2 IF ( SEAICEuseLSR ) THEN
435     CALL LSR( myThid )
436     ELSE
437     CALL ADI( myThid )
438     ENDIF
439 dimitri 1.7 #endif /* ALLOW_AUTODIFF_TAMC */
440 heimbach 1.2
441     5000 CONTINUE
442    
443 dimitri 1.7 cdm c$taf store uice,vice = comlev1, key=ikey_dynamics
444 dimitri 1.3
445 heimbach 1.2 ENDIF
446 dimitri 1.5 #endif /* SEAICE_ALLOW_DYNAMICS */
447 heimbach 1.2
448     C Calculate ocean surface stress
449     CALL OSTRES ( DWATN, COR_ICE, myThid )
450    
451     #ifdef SEAICE_ALLOW_DYNAMICS
452     IF ( SEAICEuseDYNAMICS ) THEN
453    
454     c Put a cap on ice velocity
455     c limit velocity to 0.40 m s-1 to avoid potential CFL violations
456     c in open water areas (drift of zero thickness ice)
457     DO bj=myByLo(myThid),myByHi(myThid)
458     DO bi=myBxLo(myThid),myBxHi(myThid)
459     DO j=1-OLy,sNy+OLy
460     DO i=1-OLx,sNx+OLx
461     #ifdef SEAICE_DEBUG
462     c write(*,'(2i4,2i2,f7.1,7f12.3)')
463     c & i,j,bi,bj,UVM(I,J,bi,bj),amass(i,j,bi,bj)
464     c & ,gwatx(I,J,bi,bj),gwaty(i,j,bi,bj)
465     c & ,forcex(I,J,bi,bj),forcey(i,j,bi,bj)
466     c & ,uice(i,j,1,bi,bj)
467     c & ,vice(i,j,1,bi,bj)
468 dimitri 1.5 #endif /* SEAICE_DEBUG */
469 dimitri 1.3 UICE(i,j,1,bi,bj)=min(UICE(i,j,1,bi,bj),0.40 _d +00)
470     VICE(i,j,1,bi,bj)=min(VICE(i,j,1,bi,bj),0.40 _d +00)
471     UICE(i,j,1,bi,bj)=max(UICE(i,j,1,bi,bj),-0.40 _d +00)
472     VICE(i,j,1,bi,bj)=max(VICE(i,j,1,bi,bj),-0.40 _d +00)
473 heimbach 1.2 ENDDO
474     ENDDO
475     ENDDO
476     ENDDO
477    
478     ENDIF
479 dimitri 1.5 #endif /* SEAICE_ALLOW_DYNAMICS */
480 heimbach 1.2
481 dimitri 1.5 #endif /* ALLOW_SEAICE */
482 heimbach 1.2
483     RETURN
484     END

  ViewVC Help
Powered by ViewVC 1.1.22