/[MITgcm]/MITgcm_contrib/torge/itd/code/seaice_model.F
ViewVC logotype

Contents of /MITgcm_contrib/torge/itd/code/seaice_model.F

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


Revision 1.1 - (show annotations) (download)
Fri Apr 27 22:22:17 2012 UTC (13 years, 3 months ago) by dimitri
Branch: MAIN
check-in original code, before itd modifications
seaice_advdiff.F,v 1.60 2012/02/16 01:22:02
seaice_check_pickup.F,v 1.7 2012/03/05 15:21:44
seaice_diagnostics_init.F,v 1.33 2012/02/16 01:22:02
seaice_growth.F,v 1.162 2012/03/15 03:07:31
seaice_init_fixed.F,v 1.19 2012/03/11 13:41:38
seaice_init_varia.F,v 1.72 2012/03/14 22:55:53
seaice_readparms.F,v 1.120 2012/03/14 22:55:53
seaice_write_pickup.F,v 1.14 2012/03/05 15:21:45
seaice_read_pickup.F,v 1.16 2012/03/05 15:21:44
seaice_model.F,v 1.100 2012/03/02 18:56:06
SEAICE.h,v 1.62 2012/03/06 16:51:21
SEAICE_OPTIONS.h,v 1.63 2012/03/08 01:15:02
SEAICE_PARAMS.h,v 1.91 2012/03/11 13:41:38
SEAICE_SIZE.h,v 1.5 2012/03/06 16:51:21
SIZE.h,v 1.28 2009/05/17 21:15:07

1 C $Header: /u/gcmpack/MITgcm/pkg/seaice/seaice_model.F,v 1.100 2012/03/02 18:56:06 heimbach Exp $
2 C $Name: $
3
4 #include "SEAICE_OPTIONS.h"
5
6 CBOP
7 C !ROUTINE: SEAICE_MODEL
8
9 C !INTERFACE: ==========================================================
10 SUBROUTINE SEAICE_MODEL( myTime, myIter, myThid )
11
12 C !DESCRIPTION: \bv
13 C *===========================================================*
14 C | SUBROUTINE SEAICE_MODEL |
15 C | o Time stepping of a dynamic/thermodynamic sea ice model. |
16 C | Dynamics solver: Zhang/Hibler, JGR, 102, 8691-8702, 1997 |
17 C | Thermodynamics: Hibler, MWR, 108, 1943-1973, 1980 |
18 C | Rheology: Hibler, JPO, 9, 815- 846, 1979 |
19 C | Snow: Zhang et al. , JPO, 28, 191- 217, 1998 |
20 C | Parallel forward ice model written by Jinlun Zhang PSC/UW|
21 C | & coupled into MITgcm by Dimitris Menemenlis (JPL) 2/2001|
22 C | zhang@apl.washington.edu / menemenlis@jpl.nasa.gov |
23 C *===========================================================*
24 C *===========================================================*
25 IMPLICIT NONE
26 C \ev
27
28 C !USES: ===============================================================
29 #include "SIZE.h"
30 #include "EEPARAMS.h"
31 #include "DYNVARS.h"
32 #include "PARAMS.h"
33 #include "GRID.h"
34 #include "FFIELDS.h"
35 #include "SEAICE_SIZE.h"
36 #include "SEAICE_PARAMS.h"
37 #include "SEAICE.h"
38 #include "SEAICE_TRACER.h"
39 #ifdef ALLOW_EXF
40 # include "EXF_OPTIONS.h"
41 # include "EXF_FIELDS.h"
42 #endif
43 #ifdef ALLOW_AUTODIFF_TAMC
44 # include "tamc.h"
45 #endif
46
47 C !INPUT PARAMETERS: ===================================================
48 C myTime - Simulation time
49 C myIter - Simulation timestep number
50 C myThid - Thread no. that called this routine.
51 _RL myTime
52 INTEGER myIter
53 INTEGER myThid
54 CEndOfInterface
55
56 C !LOCAL VARIABLES: ====================================================
57 C i,j,bi,bj :: Loop counters
58 #if defined(SEAICE_GROWTH_LEGACY) || defined(ALLOW_AUTODIFF_TAMC)
59 INTEGER i, j, bi, bj
60 #endif
61 #ifdef ALLOW_SITRACER
62 INTEGER iTr
63 #endif
64 CEOP
65
66 #ifdef ALLOW_DEBUG
67 IF (debugMode) CALL DEBUG_ENTER( 'SEAICE_MODEL', myThid )
68 #endif
69
70 C-- Winds are from pkg/exf, which does not update edges.
71 CALL EXCH_UV_AGRID_3D_RL( uwind, vwind, .TRUE., 1, myThid )
72
73 #ifdef ALLOW_THSICE
74 IF ( useThSice ) THEN
75 C-- Map thSice-variables to HEFF and AREA
76 CALL SEAICE_MAP_THSICE( myTime, myIter, myThid )
77 ENDIF
78 #endif /* ALLOW_THSICE */
79
80 #ifdef SEAICE_GROWTH_LEGACY
81 IF ( .NOT.useThSice ) THEN
82 #ifdef ALLOW_AUTODIFF_TAMC
83 CADJ STORE heff = comlev1, key=ikey_dynamics, kind=isbyte
84 CADJ STORE heffm = comlev1, key=ikey_dynamics, kind=isbyte
85 CADJ STORE area = comlev1, key=ikey_dynamics, kind=isbyte
86 CADJ STORE hsnow = comlev1, key=ikey_dynamics, kind=isbyte
87 CADJ STORE tice = comlev1, key=ikey_dynamics, kind=isbyte
88 #ifdef SEAICE_VARIABLE_SALINITY
89 CADJ STORE hsalt = comlev1, key=ikey_dynamics, kind=isbyte
90 #endif
91 #endif
92 DO bj=myByLo(myThid),myByHi(myThid)
93 DO bi=myBxLo(myThid),myBxHi(myThid)
94 DO j=1-OLy,sNy+OLy
95 DO i=1-OLx,sNx+OLx
96 IF ( (heff(i,j,bi,bj).EQ.0.)
97 & .OR.(area(i,j,bi,bj).EQ.0.)
98 & ) THEN
99 HEFF(i,j,bi,bj) = 0. _d 0
100 AREA(i,j,bi,bj) = 0. _d 0
101 HSNOW(i,j,bi,bj) = 0. _d 0
102 TICE(i,j,bi,bj) = celsius2K
103 #ifdef SEAICE_VARIABLE_SALINITY
104 HSALT(i,j,bi,bj) = 0. _d 0
105 #endif
106 ENDIF
107 ENDDO
108 ENDDO
109 ENDDO
110 ENDDO
111 ENDIF
112 #endif
113
114 #ifdef ALLOW_AUTODIFF_TAMC
115 DO bj=myByLo(myThid),myByHi(myThid)
116 DO bi=myBxLo(myThid),myBxHi(myThid)
117 DO j=1-OLy,sNy+OLy
118 DO i=1-OLx,sNx+OLx
119 # ifdef SEAICE_GROWTH_LEGACY
120 areaNm1(i,j,bi,bj) = 0. _d 0
121 hEffNm1(i,j,bi,bj) = 0. _d 0
122 # endif
123 uIceNm1(i,j,bi,bj) = 0. _d 0
124 vIceNm1(i,j,bi,bj) = 0. _d 0
125 # ifdef ALLOW_SITRACER
126 DO iTr = 1, SItrMaxNum
127 SItrBucket(i,j,bi,bj,iTr) = 0. _d 0
128 ENDDO
129 # endif
130 ENDDO
131 ENDDO
132 ENDDO
133 ENDDO
134 CADJ STORE uwind = comlev1, key=ikey_dynamics, kind=isbyte
135 CADJ STORE vwind = comlev1, key=ikey_dynamics, kind=isbyte
136 CADJ STORE heff = comlev1, key=ikey_dynamics, kind=isbyte
137 CADJ STORE heffm = comlev1, key=ikey_dynamics, kind=isbyte
138 CADJ STORE area = comlev1, key=ikey_dynamics, kind=isbyte
139 # ifdef SEAICE_ALLOW_DYNAMICS
140 # ifdef SEAICE_CGRID
141 CADJ STORE seaicemasku = comlev1, key=ikey_dynamics, kind=isbyte
142 CADJ STORE seaicemaskv = comlev1, key=ikey_dynamics, kind=isbyte
143 CADJ STORE fu = comlev1, key=ikey_dynamics, kind=isbyte
144 CADJ STORE fv = comlev1, key=ikey_dynamics, kind=isbyte
145 CADJ STORE uice = comlev1, key=ikey_dynamics, kind=isbyte
146 CADJ STORE vice = comlev1, key=ikey_dynamics, kind=isbyte
147 cphCADJ STORE eta = comlev1, key=ikey_dynamics, kind=isbyte
148 cphCADJ STORE zeta = comlev1, key=ikey_dynamics, kind=isbyte
149 cph(
150 CADJ STORE dwatn = comlev1, key=ikey_dynamics, kind=isbyte
151 cccCADJ STORE press0 = comlev1, key=ikey_dynamics, kind=isbyte
152 cccCADJ STORE taux = comlev1, key=ikey_dynamics, kind=isbyte
153 cccCADJ STORE tauy = comlev1, key=ikey_dynamics, kind=isbyte
154 cccCADJ STORE zmax = comlev1, key=ikey_dynamics, kind=isbyte
155 cccCADJ STORE zmin = comlev1, key=ikey_dynamics, kind=isbyte
156 cph)
157 # ifdef SEAICE_ALLOW_EVP
158 CADJ STORE seaice_sigma1 = comlev1, key=ikey_dynamics, kind=isbyte
159 CADJ STORE seaice_sigma2 = comlev1, key=ikey_dynamics, kind=isbyte
160 CADJ STORE seaice_sigma12 = comlev1, key=ikey_dynamics, kind=isbyte
161 # endif
162 # endif
163 # endif
164 # ifdef ALLOW_SITRACER
165 CADJ STORE siceload = comlev1, key=ikey_dynamics, kind=isbyte
166 CADJ STORE sitracer = comlev1, key=ikey_dynamics, kind=isbyte
167 # endif
168 #endif /* ALLOW_AUTODIFF_TAMC */
169
170 C solve ice momentum equations and calculate ocean surface stress
171 #ifdef ALLOW_DEBUG
172 IF (debugMode) CALL DEBUG_CALL( 'SEAICE_DYNSOLVER', myThid )
173 #endif
174 #ifdef SEAICE_CGRID
175 CALL TIMER_START('SEAICE_DYNSOLVER [SEAICE_MODEL]',myThid)
176 CALL SEAICE_DYNSOLVER ( myTime, myIter, myThid )
177 CALL TIMER_STOP ('SEAICE_DYNSOLVER [SEAICE_MODEL]',myThid)
178 #else
179 CALL TIMER_START('DYNSOLVER [SEAICE_MODEL]',myThid)
180 CALL DYNSOLVER ( myTime, myIter, myThid )
181 CALL TIMER_STOP ('DYNSOLVER [SEAICE_MODEL]',myThid)
182 #endif /* SEAICE_CGRID */
183
184 C-- Apply ice velocity open boundary conditions
185 #ifdef ALLOW_OBCS
186 # ifndef DISABLE_SEAICE_OBCS
187 IF ( useOBCS ) CALL OBCS_ADJUST_UVICE( uice, vice, myThid )
188 # endif /* DISABLE_SEAICE_OBCS */
189 #endif /* ALLOW_OBCS */
190
191 #ifdef ALLOW_THSICE
192 IF ( .NOT.useThSice ) THEN
193 #endif
194 C-- Only call advection of heff, area, snow, and salt and
195 C-- growth for the generic 0-layer thermodynamics of seaice
196 C-- if useThSice=.false., otherwise the 3-layer Winton thermodynamics
197 C-- (called from DO_OCEANIC_PHYSICS) take care of this
198
199 C NOW DO ADVECTION and DIFFUSION
200 IF ( SEAICEadvHeff .OR. SEAICEadvArea .OR. SEAICEadvSnow
201 & .OR. SEAICEadvSalt ) THEN
202 #ifdef ALLOW_DEBUG
203 IF (debugMode) CALL DEBUG_CALL( 'SEAICE_ADVDIFF', myThid )
204 #endif
205 CALL SEAICE_ADVDIFF( myTime, myIter, myThid )
206 #ifdef SEAICE_GROWTH_LEGACY
207 ELSE
208 DO bj=myByLo(myThid),myByHi(myThid)
209 DO bi=myBxLo(myThid),myBxHi(myThid)
210 DO j=1-OLy,sNy+OLy
211 DO i=1-OLx,sNx+OLx
212 areaNm1(i,j,bi,bj) = AREA(i,j,bi,bj)
213 hEffNm1(i,j,bi,bj) = HEFF(i,j,bi,bj)
214 ENDDO
215 ENDDO
216 ENDDO
217 ENDDO
218 #endif /* SEAICE_GROWTH_LEGACY */
219 ENDIF
220 #ifdef ALLOW_AUTODIFF_TAMC
221 CADJ STORE heffm = comlev1, key=ikey_dynamics, kind=isbyte
222 #endif /* ALLOW_AUTODIFF_TAMC */
223
224 #ifndef DISABLE_SEAICE_GROWTH
225 C thermodynamics growth
226 C must call growth after calling advection
227 C because of ugly time level business
228 IF ( usePW79thermodynamics ) THEN
229 #ifdef ALLOW_DEBUG
230 IF (debugMode) CALL DEBUG_CALL( 'SEAICE_GROWTH', myThid )
231 #endif
232 CALL SEAICE_GROWTH( myTime, myIter, myThid )
233 ENDIF
234 #endif /* DISABLE_SEAICE_GROWTH */
235
236 #ifdef ALLOW_SITRACER
237 # ifdef ALLOW_AUTODIFF_TAMC
238 CADJ STORE sitracer = comlev1, key=ikey_dynamics, kind=isbyte
239 # endif
240 CALL SEAICE_TRACER_PHYS ( myTime, myIter, myThid )
241 #endif
242
243 C-- Apply ice tracer open boundary conditions
244 #ifdef ALLOW_OBCS
245 # ifndef DISABLE_SEAICE_OBCS
246 IF ( useOBCS ) CALL OBCS_APPLY_SEAICE( myThid )
247 # endif /* DISABLE_SEAICE_OBCS */
248 #endif /* ALLOW_OBCS */
249
250 C-- Update overlap regions for a bunch of stuff
251 _EXCH_XY_RL( HEFF, myThid )
252 _EXCH_XY_RL( AREA, myThid )
253 _EXCH_XY_RL( HSNOW, myThid )
254 #ifdef SEAICE_VARIABLE_SALINITY
255 _EXCH_XY_RL( HSALT, myThid )
256 #endif
257 #ifdef ALLOW_SITRACER
258 DO iTr = 1, SItrNumInUse
259 _EXCH_XY_RL( SItracer(1-OLx,1-OLy,1,1,iTr),myThid )
260 ENDDO
261 #endif
262 _EXCH_XY_RS(EmPmR, myThid )
263 _EXCH_XY_RS(saltFlux, myThid )
264 _EXCH_XY_RS(Qnet , myThid )
265 #ifdef SHORTWAVE_HEATING
266 _EXCH_XY_RS(Qsw , myThid )
267 #endif /* SHORTWAVE_HEATING */
268 #ifdef ATMOSPHERIC_LOADING
269 IF ( useRealFreshWaterFlux )
270 & _EXCH_XY_RS( sIceLoad, myThid )
271 #endif
272
273 #ifdef ALLOW_OBCS
274 C-- In case we use scheme with a large stencil that extends into overlap:
275 C no longer needed with the right masking in advection & diffusion S/R.
276 c IF ( useOBCS ) THEN
277 c DO bj=myByLo(myThid),myByHi(myThid)
278 c DO bi=myBxLo(myThid),myBxHi(myThid)
279 c CALL OBCS_COPY_TRACER( HEFF(1-OLx,1-OLy,bi,bj),
280 c I 1, bi, bj, myThid )
281 c CALL OBCS_COPY_TRACER( AREA(1-OLx,1-OLy,bi,bj),
282 c I 1, bi, bj, myThid )
283 c CALL OBCS_COPY_TRACER( HSNOW(1-OLx,1-OLy,bi,bj),
284 c I 1, bi, bj, myThid )
285 #ifdef SEAICE_VARIABLE_SALINITY
286 c CALL OBCS_COPY_TRACER( HSALT(1-OLx,1-OLy,bi,bj),
287 c I 1, bi, bj, myThid )
288 #endif
289 c ENDDO
290 c ENDDO
291 c ENDIF
292 #endif /* ALLOW_OBCS */
293
294 #ifdef ALLOW_DIAGNOSTICS
295 IF ( useDiagnostics ) THEN
296 C diagnostics for "non-state variables" that are modified by
297 C the seaice model
298 # ifdef ALLOW_EXF
299 CALL DIAGNOSTICS_FILL(UWIND ,'SIuwind ',0,1 ,0,1,1,myThid)
300 CALL DIAGNOSTICS_FILL(VWIND ,'SIvwind ',0,1 ,0,1,1,myThid)
301 # endif
302 CALL DIAGNOSTICS_FILL_RS(FU ,'SIfu ',0,1 ,0,1,1,myThid)
303 CALL DIAGNOSTICS_FILL_RS(FV ,'SIfv ',0,1 ,0,1,1,myThid)
304 CALL DIAGNOSTICS_FILL_RS(EmPmR,'SIempmr ',0,1 ,0,1,1,myThid)
305 CALL DIAGNOSTICS_FILL_RS(Qnet ,'SIqnet ',0,1 ,0,1,1,myThid)
306 CALL DIAGNOSTICS_FILL_RS(Qsw ,'SIqsw ',0,1 ,0,1,1,myThid)
307 ENDIF
308 #endif /* ALLOW_DIAGNOSTICS */
309
310 #ifdef ALLOW_THSICE
311 C endif .not.useThSice
312 ENDIF
313 #endif /* ALLOW_THSICE */
314 CML This has already been done in seaice_ocean_stress/ostres, so why repeat?
315 CML CALL EXCH_UV_XY_RS(fu,fv,.TRUE.,myThid)
316
317 #ifdef ALLOW_EXF
318 # ifdef ALLOW_AUTODIFF_TAMC
319 # if (defined (ALLOW_AUTODIFF_MONITOR))
320 CALL EXF_ADJOINT_SNAPSHOTS( 3, myTime, myIter, myThid )
321 # endif
322 # endif
323 #endif
324
325 #ifdef ALLOW_DEBUG
326 IF (debugMode) CALL DEBUG_LEAVE( 'SEAICE_MODEL', myThid )
327 #endif
328
329 RETURN
330 END

  ViewVC Help
Powered by ViewVC 1.1.22