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

Contents of /MITgcm/pkg/seaice/seaice_init.F

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


Revision 1.24 - (show annotations) (download)
Mon May 3 21:13:07 2004 UTC (20 years, 2 months ago) by dimitri
Branch: MAIN
CVS Tags: checkpoint53b_pre, checkpoint52n_post, checkpoint53c_post, checkpoint53d_post, checkpoint53a_post, checkpoint53b_post, checkpoint53, checkpoint53d_pre
Changes since 1.23: +17 -1 lines
  - changed proxy for geostrophic velocity and updated
    verification/lab_sea/results/* accordingly

1 C $Header: /u/gcmpack/MITgcm/pkg/seaice/seaice_init.F,v 1.23 2004/04/28 12:35:00 mlosch Exp $
2 C $Name: $
3
4 #include "SEAICE_OPTIONS.h"
5
6 CStartOfInterface
7 SUBROUTINE SEAICE_INIT( myThid )
8 C /==========================================================\
9 C | SUBROUTINE SEAICE_INIT |
10 C | o Initialization of sea ice model. |
11 C |==========================================================|
12 C \==========================================================/
13 IMPLICIT NONE
14
15 C === Global variables ===
16 #include "SIZE.h"
17 #include "EEPARAMS.h"
18 #include "PARAMS.h"
19 #include "GRID.h"
20 #include "SEAICE.h"
21 #include "SEAICE_GRID.h"
22 #include "SEAICE_DIAGS.h"
23 #include "SEAICE_PARAMS.h"
24 #ifdef ALLOW_EXCH2
25 #include "W2_EXCH2_TOPOLOGY.h"
26 #include "W2_EXCH2_PARAMS.h"
27 #endif /* ALLOW_EXCH2 */
28
29 C === Routine arguments ===
30 C myThid - Thread no. that called this routine.
31 INTEGER myThid
32 CEndOfInterface
33
34 #ifdef ALLOW_SEAICE
35 C === Local variables ===
36 C i,j,k,bi,bj - Loop counters
37
38 INTEGER i, j, k, bi, bj
39 _RS mask_uice
40 INTEGER myIter, myTile
41
42 #ifdef ALLOW_TIMEAVE
43 C Initialize averages to zero
44 DO bj = myByLo(myThid), myByHi(myThid)
45 DO bi = myBxLo(myThid), myBxHi(myThid)
46 CALL TIMEAVE_RESET(FUtave ,1,bi,bj,myThid)
47 CALL TIMEAVE_RESET(FVtave ,1,bi,bj,myThid)
48 CALL TIMEAVE_RESET(EmPmRtave,1,bi,bj,myThid)
49 CALL TIMEAVE_RESET(QNETtave ,1,bi,bj,myThid)
50 CALL TIMEAVE_RESET(QSWtave ,1,bi,bj,myThid)
51 CALL TIMEAVE_RESET(UICEtave ,1,bi,bj,myThid)
52 CALL TIMEAVE_RESET(VICEtave ,1,bi,bj,myThid)
53 CALL TIMEAVE_RESET(HEFFtave ,1,bi,bj,myThid)
54 CALL TIMEAVE_RESET(AREAtave ,1,bi,bj,myThid)
55 DO k=1,Nr
56 SEAICE_TimeAve(k,bi,bj)=ZERO
57 ENDDO
58 ENDDO
59 ENDDO
60 #endif /* ALLOW_TIMEAVE */
61
62 cph(
63 cph make sure TAF sees proper initialisation
64 cph to avoid partial recomputation issues
65 DO bj=myByLo(myThid),myByHi(myThid)
66 DO bi=myBxLo(myThid),myBxHi(myThid)
67 c
68 DO K=1,3
69 DO J=1-OLy,sNy+OLy
70 DO I=1-OLx,sNx+OLx
71 HEFF(I,J,k,bi,bj)=ZERO
72 AREA(I,J,k,bi,bj)=ZERO
73 UICE(I,J,k,bi,bj)=ZERO
74 VICE(I,J,k,bi,bj)=ZERO
75 ENDDO
76 ENDDO
77 ENDDO
78 c
79 DO J=1-OLy,sNy+OLy
80 DO I=1-OLx,sNx+OLx
81 HSNOW(I,J,bi,bj)=ZERO
82 ZETA(I,J,bi,bj)=ZERO
83 ENDDO
84 ENDDO
85 c
86 ENDDO
87 ENDDO
88 cph)
89
90 C-- Initialize grid info
91 DO bj=myByLo(myThid),myByHi(myThid)
92 DO bi=myBxLo(myThid),myBxHi(myThid)
93 DO J=1-OLy,sNy+OLy
94 DO I=1-OLx,sNx+OLx
95 CSTICE(i,j,bi,bj) =cos(yC(I,J,bi,bj)*deg2rad)
96 CSUICE(i,j,bi,bj) =cos(yG(I,J,bi,bj)*deg2rad)
97 CML(
98 C inverses of CSTICE and CSUICE. Let's hope we are never
99 C at the poles
100 IF ( CSTICE(I,J,bi,bj) .ne. 0. _d 0 ) THEN
101 RECIP_CSTICE(I,J,bi,bj) = 1./CSTICE(I,J,bi,bj)
102 ELSE
103 RECIP_CSTICE(I,J,bi,bj) =0. _d 0
104 ENDIF
105 IF ( CSUICE(I,J,bi,bj) .ne. 0. _d 0 ) THEN
106 RECIP_CSUICE(I,J,bi,bj) = 1./CSUICE(I,J,bi,bj)
107 ELSE
108 RECIP_CSUICE(I,J,bi,bj) =0. _d 0
109 ENDIF
110 CML)
111 SINEICE(i,j,bi,bj)=sin(yC(I,J,bi,bj)*deg2rad)
112 TNGTICE(i,j,bi,bj)=SINEICE(i,j,bi,bj)*RECIP_CSTICE(i,j,bi,bj)
113 SINEICE(i,j,bi,bj)=sin(yG(I,J,bi,bj)*deg2rad)
114 TNGICE(i,j,bi,bj) =SINEICE(i,j,bi,bj)*RECIP_CSUICE(i,j,bi,bj)
115 DXTICE(i,j,bi,bj)=dxF(i,j,bi,bj)*RECIP_CSTICE(i,j,bi,bj)
116 DXUICE(i,j,bi,bj)=dxV(i,j,bi,bj)*RECIP_CSUICE(i,j,bi,bj)
117 DYTICE(i,j,bi,bj)=dyF(i,j,bi,bj)
118 DYUICE(i,j,bi,bj)=dyU(i,j,bi,bj)
119 ENDDO
120 ENDDO
121 DO j=1-OLy,sNy+OLy
122 DO i=1-OLx,sNx+OLx
123 HEFFM(i,j,bi,bj)=ONE
124 IF (_hFacC(i,j,1,bi,bj).eq.0.) HEFFM(i,j,bi,bj)=ZERO
125 ENDDO
126 ENDDO
127 DO J=2-OLy,sNy+OLy
128 DO I=2-OLx,sNx+OLx
129 UVM(i,j,bi,bj)=ZERO
130 mask_uice=HEFFM(I,J, bi,bj)+HEFFM(I-1,J-1,bi,bj)
131 & +HEFFM(I,J-1,bi,bj)+HEFFM(I-1,J, bi,bj)
132 IF(mask_uice.GT.3.5) UVM(I,J,bi,bj)=ONE
133 ENDDO
134 ENDDO
135
136 #ifdef ALLOW_EXCH2
137 C-- Special stuff for cubed sphere: assume grid is rectangular and
138 C set UV mask to zero except for Arctic and Antarctic cube faces.
139 IF (useCubedSphereExchange) THEN
140 DO J=1-OLy,sNy+OLy
141 DO I=1-OLx,sNx+OLx
142 CSTICE(i,j,bi,bj) = ONE
143 CSUICE(i,j,bi,bj) = ONE
144 CML(
145 RECIP_CSTICE(I,J,bi,bj) = ONE
146 RECIP_CSUICE(I,J,bi,bj) = ONE
147 CML)
148 TNGTICE(i,j,bi,bj)= ZERO
149 TNGICE(i,j,bi,bj) = ZERO
150 DXTICE(i,j,bi,bj) = dxF(i,j,bi,bj)
151 DXUICE(i,j,bi,bj) = dxV(i,j,bi,bj)
152 ENDDO
153 ENDDO
154 myTile = W2_myTileList(bi)
155 IF ( exch2_myFace(myTile) .EQ. 1 .OR.
156 & exch2_myFace(myTile) .EQ. 2 .OR.
157 & exch2_myFace(myTile) .EQ. 4 .OR.
158 & exch2_myFace(myTile) .EQ. 5 ) THEN
159 DO J=1-OLy,sNy+OLy
160 DO I=1-OLx,sNx+OLx
161 UVM(i,j,bi,bj)=ZERO
162 ENDDO
163 ENDDO
164 ELSEIF ( exch2_isWedge(myTile) .EQ. 1 ) THEN
165 I=1
166 DO J=1-OLy,sNy+OLy
167 UVM(i,j,bi,bj)=ZERO
168 ENDDO
169 ELSEIF ( exch2_isSedge(myTile) .EQ. 1 ) THEN
170 J=1
171 DO I=1-OLx,sNx+OLx
172 UVM(i,j,bi,bj)=ZERO
173 ENDDO
174 ENDIF
175 C-- Make sure that DXTICE and DYTICE do not contain any zeros
176 DO J=1,sNy
177 DO I=1-OLx,0
178 IF(DXTICE(i,j,bi,bj).EQ.0)
179 & DXTICE(i,j,bi,bj)=DXTICE(1,j,bi,bj)
180 IF(DYTICE(i,j,bi,bj).EQ.0)
181 & DYTICE(i,j,bi,bj)=DYTICE(1,j,bi,bj)
182 ENDDO
183 DO I=sNx+1,sNx+OLx
184 IF(DXTICE(i,j,bi,bj).EQ.0)
185 & DXTICE(i,j,bi,bj)=DXTICE(sNx,j,bi,bj)
186 IF(DYTICE(i,j,bi,bj).EQ.0)
187 & DYTICE(i,j,bi,bj)=DYTICE(sNx,j,bi,bj)
188 ENDDO
189 ENDDO
190 DO J=1-OLy,0
191 DO I=1-OLx,sNx+OLx
192 IF(DXTICE(i,j,bi,bj).EQ.0)
193 & DXTICE(i,j,bi,bj)=DXTICE(i,1,bi,bj)
194 IF(DYTICE(i,j,bi,bj).EQ.0)
195 & DYTICE(i,j,bi,bj)=DYTICE(i,1,bi,bj)
196 ENDDO
197 ENDDO
198 DO J=sNy+1,sNy+OLy
199 DO I=1-OLx,sNx+OLx
200 IF(DXTICE(i,j,bi,bj).EQ.0)
201 & DXTICE(i,j,bi,bj)=DXTICE(i,sNy,bi,bj)
202 IF(DYTICE(i,j,bi,bj).EQ.0)
203 & DYTICE(i,j,bi,bj)=DYTICE(i,sNy,bi,bj)
204 ENDDO
205 ENDDO
206 ENDIF
207 #endif /* ALLOW_EXCH2 */
208
209 DO j=1-OLy,sNy+OLy
210 DO i=1-OLx,sNx+OLx
211 TICE(I,J,bi,bj)=273.0 _d 0
212 #ifdef SEAICE_MULTILEVEL
213 DO k=1,MULTDIM
214 TICES(I,J,k,bi,bj)=273.0 _d 0
215 ENDDO
216 #endif
217 UICEC(I,J,bi,bj)=ZERO
218 VICEC(I,J,bi,bj)=ZERO
219 AMASS(I,J,bi,bj)=1000.0 _d 0
220 ENDDO
221 ENDDO
222
223 C-- Choose a proxy level for geostrophic velocity,
224 DO j=1-OLy,sNy+OLy
225 DO i=1-OLx,sNx+OLx
226 IF (klowc(i,j,bi,bj) .LT. 2) THEN
227 KGEO(I,J,bi,bj) = 1
228 ELSE
229 KGEO(I,J,bi,bj) = 2
230 DO WHILE ( abs(rC(KGEO(I,J,bi,bj))) .LT. 50.0 .AND.
231 & KGEO(I,J,bi,bj) .LT. (klowc(i,j,bi,bj)-1) )
232 KGEO(I,J,bi,bj) = KGEO(I,J,bi,bj) + 1
233 ENDDO
234 ENDIF
235 ENDDO
236 ENDDO
237
238 ENDDO
239 ENDDO
240
241 C-- Update overlap regions
242 _EXCH_XY_R8(UVM, myThid)
243
244 myIter=0
245 CALL PLOT_FIELD_XYRL( CSTICE , 'Current CSTICE ' ,
246 & myIter, myThid )
247 CALL PLOT_FIELD_XYRL( CSUICE , 'Current CSUICE ' ,
248 & myIter, myThid )
249 CALL PLOT_FIELD_XYRL( TNGTICE , 'Current TNGTICE ' ,
250 & myIter, myThid )
251 CALL PLOT_FIELD_XYRL( TNGICE , 'Current TNGICE ' ,
252 & myIter, myThid )
253 CALL PLOT_FIELD_XYRL( SINEICE , 'Current SINEICE ' ,
254 & myIter, myThid )
255 CALL PLOT_FIELD_XYRL( DXTICE , 'Current DXTICE ' ,
256 & myIter, myThid )
257 CALL PLOT_FIELD_XYRL( DXUICE , 'Current DXUICE ' ,
258 & myIter, myThid )
259 CALL PLOT_FIELD_XYRL( DYTICE , 'Current DYTICE ' ,
260 & myIter, myThid )
261 CALL PLOT_FIELD_XYRL( DYUICE , 'Current DYUICE ' ,
262 & myIter, myThid )
263 CALL PLOT_FIELD_XYRL( HEFFM , 'Current HEFFM ' ,
264 & myIter, myThid )
265 CALL PLOT_FIELD_XYRL( UVM , 'Current UVM ' ,
266 & myIter, myThid )
267
268 C-- Set model variables to initial/restart conditions
269 IF ( nIter0 .NE. 0 ) THEN
270
271 CALL SEAICE_READ_PICKUP ( myThid )
272
273 ELSE
274
275 DO bj=myByLo(myThid),myByHi(myThid)
276 DO bi=myBxLo(myThid),myBxHi(myThid)
277 DO j=1-OLy,sNy+OLy
278 DO i=1-OLx,sNx+OLx
279 HSNOW(I,J,bi,bj)=0.2*HEFFM(i,j,bi,bj)
280 YNEG(I,J,bi,bj)=ZERO
281 TMIX(I,J,bi,bj)=TICE(I,J,bi,bj)
282 DO k=1,3
283 HEFF(I,J,k,bi,bj)=SEAICE_initialHEFF*HEFFM(i,j,bi,bj)
284 UICE(I,J,k,bi,bj)=ZERO
285 VICE(I,J,k,bi,bj)=ZERO
286 ENDDO
287 ENDDO
288 ENDDO
289 ENDDO
290 ENDDO
291
292 C-- Read initial sea-ice thickness from file if available.
293 IF ( HeffFile .NE. ' ' ) THEN
294 _BEGIN_MASTER( myThid )
295 CALL READ_FLD_XY_RL( HeffFile, ' ', ZETA, 0, myThid )
296 _END_MASTER(myThid)
297 _EXCH_XY_R8(ZETA,myThid)
298 DO bj=myByLo(myThid),myByHi(myThid)
299 DO bi=myBxLo(myThid),myBxHi(myThid)
300 DO j=1-OLy,sNy+OLy
301 DO i=1-OLx,sNx+OLx
302 DO k=1,3
303 HEFF(I,J,k,bi,bj) = MAX(ZETA(i,j,bi,bj),ZERO)
304 ENDDO
305 ENDDO
306 ENDDO
307 ENDDO
308 ENDDO
309 ENDIF
310
311 DO bj=myByLo(myThid),myByHi(myThid)
312 DO bi=myBxLo(myThid),myBxHi(myThid)
313 DO j=1-OLy,sNy+OLy
314 DO i=1-OLx,sNx+OLx
315 DO k=1,3
316 IF(HEFF(I,J,k,bi,bj).GT.ZERO) AREA(I,J,k,bi,bj)=ONE
317 ENDDO
318 ENDDO
319 ENDDO
320 ENDDO
321 ENDDO
322
323 ENDIF
324
325 C--- Complete initialization
326 DO bj=myByLo(myThid),myByHi(myThid)
327 DO bi=myBxLo(myThid),myBxHi(myThid)
328 DO j=1-OLy,sNy+OLy
329 DO i=1-OLx,sNx+OLx
330 ZETA(I,J,bi,bj)=HEFF(I,J,1,bi,bj)*(1.0 _d 11)
331 ETA(I,J,bi,bj)=ZETA(I,J,bi,bj)/4.0 _d 0
332 ENDDO
333 ENDDO
334 ENDDO
335 ENDDO
336
337 #endif /* ALLOW_SEAICE */
338
339 RETURN
340 END

  ViewVC Help
Powered by ViewVC 1.1.22