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

Annotation 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 - (hide 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 dimitri 1.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