/[MITgcm]/MITgcm_contrib/atnguyen/verification/lab_sea/code_ad/seaice_model.F
ViewVC logotype

Contents of /MITgcm_contrib/atnguyen/verification/lab_sea/code_ad/seaice_model.F

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


Revision 1.1 - (show annotations) (download)
Mon Jun 1 22:56:23 2015 UTC (10 years, 2 months ago) by atn
Branch: MAIN
CVS Tags: HEAD
latest working lab_sea seaice adjoint using IFenty code

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

  ViewVC Help
Powered by ViewVC 1.1.22