/[MITgcm]/MITgcm_contrib/dgoldberg/CPL1/code/shelfice_thermodynamics.F
ViewVC logotype

Contents of /MITgcm_contrib/dgoldberg/CPL1/code/shelfice_thermodynamics.F

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


Revision 1.1 - (show annotations) (download)
Wed Jul 6 18:01:26 2016 UTC (9 years ago) by dgoldberg
Branch: MAIN
CVS Tags: HEAD
Error occurred while calculating annotation data.
moving experiment out of shelfice_remeshing to replace with vertical remeshing only

1 C $Header: /u/gcmpack/MITgcm_contrib/verification_other/shelfice_remeshing/code/shelfice_thermodynamics.F,v 1.18 2016/05/26 11:31:34 ksnow Exp $
2 C $Name: $
3
4 #include "SHELFICE_OPTIONS.h"
5 #ifdef ALLOW_AUTODIFF
6 # include "AUTODIFF_OPTIONS.h"
7 #endif
8 #ifdef ALLOW_CTRL
9 # include "CTRL_OPTIONS.h"
10 #endif
11
12 CBOP
13 C !ROUTINE: SHELFICE_THERMODYNAMICS
14 C !INTERFACE:
15 SUBROUTINE SHELFICE_THERMODYNAMICS(
16 I myTime, myIter, myThid )
17 C !DESCRIPTION: \bv
18 C *=============================================================*
19 C | S/R SHELFICE_THERMODYNAMICS
20 C | o shelf-ice main routine.
21 C | compute temperature and (virtual) salt flux at the
22 C | shelf-ice ocean interface
23 C |
24 C | stresses at the ice/water interface are computed in separate
25 C | routines that are called from mom_fluxform/mom_vecinv
26 C *=============================================================*
27 C \ev
28
29 C !USES:
30 IMPLICIT NONE
31
32 C === Global variables ===
33 #include "SIZE.h"
34 #include "EEPARAMS.h"
35 #include "PARAMS.h"
36 #include "GRID.h"
37 #include "DYNVARS.h"
38 #include "FFIELDS.h"
39 #include "SHELFICE.h"
40 #include "SHELFICE_COST.h"
41 #ifdef ALLOW_AUTODIFF
42 # include "CTRL_SIZE.h"
43 # include "ctrl.h"
44 # include "ctrl_dummy.h"
45 #endif /* ALLOW_AUTODIFF */
46 #ifdef ALLOW_AUTODIFF_TAMC
47 # ifdef SHI_ALLOW_GAMMAFRICT
48 # include "tamc.h"
49 # include "tamc_keys.h"
50 # endif /* SHI_ALLOW_GAMMAFRICT */
51 #endif /* ALLOW_AUTODIFF_TAMC */
52 #ifdef ALLOW_STREAMICE
53 # include "STREAMICE.h"
54 #endif /* ALLOW_STREAMICE */
55
56 C !INPUT/OUTPUT PARAMETERS:
57 C === Routine arguments ===
58 C myIter :: iteration counter for this thread
59 C myTime :: time counter for this thread
60 C myThid :: thread number for this instance of the routine.
61 _RL myTime
62 INTEGER myIter
63 INTEGER myThid
64
65 #ifdef ALLOW_SHELFICE
66 C !LOCAL VARIABLES :
67 C === Local variables ===
68 C I,J,K,Kp1,bi,bj :: loop counters
69 C tLoc, sLoc, pLoc :: local in-situ temperature, salinity, pressure
70 C theta/saltFreeze :: temperature and salinity of water at the
71 C ice-ocean interface (at the freezing point)
72 C freshWaterFlux :: local variable for fresh water melt flux due
73 C to melting in kg/m^2/s
74 C (negative density x melt rate)
75 C convertFW2SaltLoc:: local copy of convertFW2Salt
76 C cFac :: 1 for conservative form, 0, otherwise
77 C rFac :: realFreshWaterFlux factor
78 C dFac :: 0 for diffusive heat flux (Holland and Jenkins, 1999,
79 C eq21)
80 C 1 for advective and diffusive heat flux (eq22, 26, 31)
81 C fwflxFac :: only effective for dFac=1, 1 if we expect a melting
82 C fresh water flux, 0 otherwise
83 C auxiliary variables and abbreviations:
84 C a0, a1, a2, b, c0
85 C eps1, eps2, eps3, eps3a, eps4, eps5, eps6, eps7, eps8
86 C aqe, bqe, cqe, discrim, recip_aqe
87 C drKp1, recip_drLoc
88 INTEGER I,J,K,Kp1
89 INTEGER bi,bj
90 _RL tLoc(1:sNx,1:sNy)
91 _RL sLoc(1:sNx,1:sNy)
92 _RL pLoc(1:sNx,1:sNy)
93 #ifndef SHI_USTAR_WETPOINT
94 _RL uLoc(1:sNx,1:sNy)
95 _RL vLoc(1:sNx,1:sNy)
96 #endif
97 #ifdef SHI_USTAR_TOPDR
98 _RL u_topdr(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
99 _RL v_topdr(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
100 #endif
101 _RL velSq(1:sNx,1:sNy)
102 _RL thetaFreeze, saltFreeze, recip_Cp
103 _RL freshWaterFlux, convertFW2SaltLoc
104 _RL a0, a1, a2, b, c0
105 _RL eps1, eps2, eps3, eps3a, eps4, eps5, eps6, eps7, eps8
106 _RL cFac, rFac, dFac, fwflxFac, realfwFac
107 _RL aqe, bqe, cqe, discrim, recip_aqe
108 _RL drKp1, recip_drLoc
109 _RL recip_latentHeat
110 _RL tmpFac
111 C _RL massMin, mass, DELZ
112 _RL mass, DELZ
113 _RL SHA,FACTOR1,FACTOR2,FACTOR3
114 _RL ETA,SEALEVEL,oce_density
115 C KS_dens, add massMin and EFFR, R_min, and remove above
116 _RL EFFR(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
117 _RL massMin(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
118 _RL R_min(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
119
120 #ifdef SHI_ALLOW_GAMMAFRICT
121 _RL shiPr, shiSc, shiLo, recip_shiKarman, shiTwoThirds
122 _RL gammaTmoleT, gammaTmoleS, gammaTurb, gammaTurbConst
123 _RL ustar, ustarSq, etastar
124 PARAMETER ( shiTwoThirds = 0.66666666666666666666666666667D0 )
125 #ifdef ALLOW_DIAGNOSTICS
126 _RL uStarDiag(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
127 #endif /* ALLOW_DIAGNOSTICS */
128 #endif
129
130 #ifndef ALLOW_OPENAD
131 _RL SW_TEMP
132 EXTERNAL SW_TEMP
133 #endif
134
135 #ifdef ALLOW_SHIFWFLX_CONTROL
136 _RL xx_shifwflx_loc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy)
137 #endif
138
139 #ifdef ALLOW_SHELFICE_REMESHING
140 _RL GrdFactor(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy)
141 #endif
142 CEOP
143 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
144
145 #ifdef SHI_ALLOW_GAMMAFRICT
146 #ifdef ALLOW_AUTODIFF
147 C re-initialize here again, curtesy to TAF
148 DO bj = myByLo(myThid), myByHi(myThid)
149 DO bi = myBxLo(myThid), myBxHi(myThid)
150 DO J = 1-OLy,sNy+OLy
151 DO I = 1-OLx,sNx+OLx
152 shiTransCoeffT(i,j,bi,bj) = SHELFICEheatTransCoeff
153 shiTransCoeffS(i,j,bi,bj) = SHELFICEsaltTransCoeff
154 ENDDO
155 ENDDO
156 ENDDO
157 ENDDO
158 #endif /* ALLOW_AUTODIFF */
159 IF ( SHELFICEuseGammaFrict ) THEN
160 C Implement friction velocity-dependent transfer coefficient
161 C of Holland and Jenkins, JPO, 1999
162 recip_shiKarman= 1. _d 0 / 0.4 _d 0
163 shiLo = 0. _d 0
164 shiPr = shiPrandtl**shiTwoThirds
165 shiSc = shiSchmidt**shiTwoThirds
166 cph shiPr = (viscArNr(1)/diffKrNrT(1))**shiTwoThirds
167 cph shiSc = (viscArNr(1)/diffKrNrS(1))**shiTwoThirds
168 gammaTmoleT = 12.5 _d 0 * shiPr - 6. _d 0
169 gammaTmoleS = 12.5 _d 0 * shiSc - 6. _d 0
170 C instead of etastar = sqrt(1+zetaN*ustar./(f*Lo*Rc))
171 etastar = 1. _d 0
172 gammaTurbConst = 1. _d 0 / (2. _d 0 * shiZetaN*etastar)
173 & - recip_shiKarman
174 #ifdef ALLOW_AUTODIFF
175 DO bj = myByLo(myThid), myByHi(myThid)
176 DO bi = myBxLo(myThid), myBxHi(myThid)
177 DO J = 1-OLy,sNy+OLy
178 DO I = 1-OLx,sNx+OLx
179 shiTransCoeffT(i,j,bi,bj) = 0. _d 0
180 shiTransCoeffS(i,j,bi,bj) = 0. _d 0
181 ENDDO
182 ENDDO
183 ENDDO
184 ENDDO
185 #endif /* ALLOW_AUTODIFF */
186 ENDIF
187 #endif /* SHI_ALLOW_GAMMAFRICT */
188
189 recip_latentHeat = 0. _d 0
190 IF ( SHELFICElatentHeat .NE. 0. _d 0 )
191 & recip_latentHeat = 1. _d 0/SHELFICElatentHeat
192 C are we doing the conservative form of Jenkins et al. (2001)?
193 recip_Cp = 1. _d 0 / HeatCapacity_Cp
194 cFac = 0. _d 0
195 IF ( SHELFICEconserve ) cFac = 1. _d 0
196 C with "real fresh water flux" (affecting ETAN),
197 C there is more to modify
198 rFac = 1. _d 0
199 IF ( SHELFICEconserve .AND. useRealFreshWaterFlux ) rFac = 0. _d 0
200 C heat flux into the ice shelf, default is diffusive flux
201 C (Holland and Jenkins, 1999, eq.21)
202 dFac = 0. _d 0
203 IF ( SHELFICEadvDiffHeatFlux ) dFac = 1. _d 0
204 fwflxFac = 0. _d 0
205 C if shelficeboundarylayer is used with real freshwater flux,
206 c the T/S used for surface fluxes must be the cell T/S
207 realFWfac = 0. _d 0
208 IF ( SHELFICErealFWflux ) realFWfac = 1. _d 0
209
210 C linear dependence of freezing point on salinity
211 a0 = -0.0575 _d 0
212 a1 = 0.0 _d -0
213 a2 = 0.0 _d -0
214 c0 = 0.0901 _d 0
215 b = -7.61 _d -4
216 #ifdef ALLOW_ISOMIP_TD
217 IF ( useISOMIPTD ) THEN
218 C non-linear dependence of freezing point on salinity
219 a0 = -0.0575 _d 0
220 a1 = 1.710523 _d -3
221 a2 = -2.154996 _d -4
222 b = -7.53 _d -4
223 c0 = 0. _d 0
224 ENDIF
225 convertFW2SaltLoc = convertFW2Salt
226 C hardcoding this value here is OK because it only applies to ISOMIP
227 C where this value is part of the protocol
228 IF ( convertFW2SaltLoc .EQ. -1. ) convertFW2SaltLoc = 33.4 _d 0
229 #endif /* ALLOW_ISOMIP_TD */
230
231 DO bj = myByLo(myThid), myByHi(myThid)
232 DO bi = myBxLo(myThid), myBxHi(myThid)
233 DO J = 1-OLy,sNy+OLy
234 DO I = 1-OLx,sNx+OLx
235 shelfIceHeatFlux (I,J,bi,bj) = 0. _d 0
236 shelfIceFreshWaterFlux(I,J,bi,bj) = 0. _d 0
237 shelficeForcingT (I,J,bi,bj) = 0. _d 0
238 shelficeForcingS (I,J,bi,bj) = 0. _d 0
239 #if (defined SHI_ALLOW_GAMMAFRICT && defined ALLOW_DIAGNOSTICS)
240 uStarDiag (I,J,bi,bj) = 0. _d 0
241 #endif /* SHI_ALLOW_GAMMAFRICT and ALLOW_DIAGNOSTICS */
242 ENDDO
243 ENDDO
244 ENDDO
245 ENDDO
246 #ifdef ALLOW_SHIFWFLX_CONTROL
247 DO bj = myByLo(myThid), myByHi(myThid)
248 DO bi = myBxLo(myThid), myBxHi(myThid)
249 DO J = 1-OLy,sNy+OLy
250 DO I = 1-OLx,sNx+OLx
251 xx_shifwflx_loc(I,J,bi,bj) = 0. _d 0
252 ENDDO
253 ENDDO
254 ENDDO
255 ENDDO
256 #ifdef ALLOW_CTRL
257 if (useCTRL) CALL CTRL_GET_GEN (
258 & xx_shifwflx_file, xx_shifwflxstartdate, xx_shifwflxperiod,
259 & maskSHI, xx_shifwflx_loc, xx_shifwflx0, xx_shifwflx1,
260 & xx_shifwflx_dummy,
261 & xx_shifwflx_remo_intercept, xx_shifwflx_remo_slope,
262 & wshifwflx,
263 & myTime, myIter, myThid )
264 #endif
265 #endif /* ALLOW_SHIFWFLX_CONTROL */
266 DO bj = myByLo(myThid), myByHi(myThid)
267 DO bi = myBxLo(myThid), myBxHi(myThid)
268
269
270 IF (.not.usestreamice) THEN
271 oce_density = 1028.
272 ELSE
273 oce_density = streamice_density_ocean_avg
274 ENDIF
275
276 #ifdef ALLOW_SHELFICE_REMESHING
277
278 SEALEVEL = 0. _d 0
279 C KS16 ------ add ETA, initialize and in called S/R------
280 ETA = 0. _d 0
281 CALL SHELFICE_SEA_LEVEL_AVG( SEALEVEL, ETA, myThid )
282
283 C KS_dens
284 #ifdef ALLOW_STREAMICE
285 CALL SHELFICE_MASSMIN(R_min,massMin, myThid)
286
287 DO j = 1-OLy, sNy+OLy
288 DO i = 1-OLx, sNx+OLx
289
290 mass = shelficemass(i,j,bi,bj)
291
292 GrdFactor(i,j,bi,bj) = tanh((massMin(i,j,bi,bj)
293 & - mass)*1. _d 5)
294
295 SHA=massMin(i,j,bi,bj)/
296 & SQRT(.01+mass**2)
297 FACTOR1 = ((1-sha)/2.)
298 FACTOR2 = (1+sha)/2.
299
300 EFFMASS(I,J,BI,BJ)=
301 & (FACTOR1*GrdFactor(i,j,bi,bj) + FACTOR2)*mass
302
303 ENDDO
304 ENDDO
305 #endif /* ALLOW_STREAMICE */
306 C KS_dens -----------------------------------------------
307
308
309 #endif
310 ! allow shelfice_remeshing
311
312 #ifdef SHI_USTAR_TOPDR
313 IF ( SHELFICEBoundaryLayer ) THEN
314 C-- average over boundary layer width
315 DO J = 1, sNy+1
316 DO I = 1, sNx+1
317 u_topdr(I,J,bi,bj) = 0.0
318 v_topdr(I,J,bi,bj) = 0.0
319 ENDDO
320 ENDDO
321 ENDIF
322 #endif
323
324 #ifdef ALLOW_AUTODIFF_TAMC
325 # ifdef SHI_ALLOW_GAMMAFRICT
326 act1 = bi - myBxLo(myThid)
327 max1 = myBxHi(myThid) - myBxLo(myThid) + 1
328 act2 = bj - myByLo(myThid)
329 max2 = myByHi(myThid) - myByLo(myThid) + 1
330 act3 = myThid - 1
331 max3 = nTx*nTy
332 act4 = ikey_dynamics - 1
333 ikey = (act1 + 1) + act2*max1
334 & + act3*max1*max2
335 & + act4*max1*max2*max3
336 # endif /* SHI_ALLOW_GAMMAFRICT */
337 #endif /* ALLOW_AUTODIFF_TAMC */
338 DO J = 1, sNy
339 DO I = 1, sNx
340 C-- make local copies of temperature, salinity and depth (pressure in deci-bar)
341 C-- underneath the ice
342 K = MAX(1,kTopC(I,J,bi,bj))
343 pLoc(I,J) = ABS(R_shelfIce(I,J,bi,bj))
344 c pLoc(I,J) = shelficeMass(I,J,bi,bj)*gravity*1. _d -4
345 tLoc(I,J) = theta(I,J,K,bi,bj)
346 sLoc(I,J) = MAX(salt(I,J,K,bi,bj), zeroRL)
347 #ifdef SHI_USTAR_WETPOINT
348 velSq(I,J) = 0.
349 tmpFac = _hFacW(I, J,K,bi,bj) + _hFacW(I+1,J,K,bi,bj)
350 IF ( tmpFac.GT.0. _d 0 )
351 & velSq(I,J) = (
352 & uVel( I, J,K,bi,bj)*uVel( I, J,K,bi,bj)*_hFacW( I, J,K,bi,bj)
353 & + uVel(I+1,J,K,bi,bj)*uVel(I+1,J,K,bi,bj)*_hFacW(I+1,J,K,bi,bj)
354 & )/tmpFac
355 tmpFac = _hFacS(I,J, K,bi,bj) + _hFacS(I,J+1,K,bi,bj)
356 IF ( tmpFac.GT.0. _d 0 )
357 & velSq(I,J) = velSq(I,J) + (
358 & vVel(I, J, K,bi,bj)*vVel(I, J, K,bi,bj)*_hFacS(I, J, K,bi,bj)
359 & + vVel(I,J+1,K,bi,bj)*vVel(I,J+1,K,bi,bj)*_hFacS(I,J+1,K,bi,bj)
360 & )/tmpFac
361 #else /* SHI_USTAR_WETPOINT */
362 uLoc(I,J) = recip_hFacC(I,J,K,bi,bj) * halfRL *
363 & ( uVel(I, J,K,bi,bj) * _hFacW(I, J,K,bi,bj)
364 & + uVel(I+1,J,K,bi,bj) * _hFacW(I+1,J,K,bi,bj) )
365 vLoc(I,J) = recip_hFacC(I,J,K,bi,bj) * halfRL *
366 & ( vVel(I,J, K,bi,bj) * _hFacS(I,J, K,bi,bj)
367 & + vVel(I,J+1,K,bi,bj) * _hFacS(I,J+1,K,bi,bj) )
368 velSq(I,J) = uLoc(I,J)*uLoc(I,J)+vLoc(I,J)*vLoc(I,J)
369 #endif /* SHI_USTAR_WETPOINT */
370 ENDDO
371 ENDDO
372
373 #ifdef SHI_USTAR_TOPDR
374 IF ( SHELFICEBoundaryLayer ) THEN
375 DO J = 1, sNy+1
376 DO I = 1, sNx+1
377 K = ksurfW(I,J,bi,bj)
378 Kp1 = K+1
379 IF (K.lt.Nr) then
380 drKp1 = drF(K)*(1. _d 0-_hFacW(I,J,K,bi,bj))
381 drKp1 = max (drKp1, 0. _d 0)
382 recip_drLoc = 1.0 /
383 & (drF(K)*_hFacW(I,J,K,bi,bj)+drKp1)
384 u_topdr(I,J,bi,bj) =
385 & (drF(K)*_hFacW(I,J,K,bi,bj)*uVel(I,J,K,bi,bj) +
386 & drKp1*uVel(I,J,Kp1,bi,bj))
387 & * recip_drLoc
388 ELSE
389 u_topdr(I,J,bi,bj) = 0. _d 0
390 ENDIF
391
392 K = ksurfS(I,J,bi,bj)
393 Kp1 = K+1
394 IF (K.lt.Nr) then
395 drKp1 = drF(K)*(1. _d 0-_hFacS(I,J,K,bi,bj))
396 drKp1 = max (drKp1, 0. _d 0)
397 recip_drLoc = 1.0 /
398 & (drF(K)*_hFacS(I,J,K,bi,bj)+drKp1)
399 v_topdr(I,J,bi,bj) =
400 & (drF(K)*_hFacS(I,J,K,bi,bj)*vVel(I,J,K,bi,bj) +
401 & drKp1*vVel(I,J,Kp1,bi,bj))
402 & * recip_drLoc
403 ELSE
404 v_topdr(I,J,bi,bj) = 0. _d 0
405 ENDIF
406
407 ENDDO
408 ENDDO
409 ENDIF
410 #endif
411
412 IF ( SHELFICEBoundaryLayer ) THEN
413 C-- average over boundary layer width
414 DO J = 1, sNy
415 DO I = 1, sNx
416 K = kTopC(I,J,bi,bj)
417 IF ( K .NE. 0 .AND. K .LT. Nr ) THEN
418 Kp1 = MIN(Nr,K+1)
419 C-- overlap into lower cell
420 drKp1 = drF(K)*( 1. _d 0 - _hFacC(I,J,K,bi,bj) )
421 C-- lower cell may not be as thick as required
422 drKp1 = MIN( drKp1, drF(Kp1) * _hFacC(I,J,Kp1,bi,bj) )
423 drKp1 = MAX( drKp1, 0. _d 0 )
424 recip_drLoc = 1. _d 0 /
425 & ( drF(K)*_hFacC(I,J,K,bi,bj) + drKp1 )
426 tLoc(I,J) = ( tLoc(I,J) * drF(K)*_hFacC(I,J,K,bi,bj)
427 & + theta(I,J,Kp1,bi,bj) *drKp1 )
428 & * recip_drLoc
429 sLoc(I,J) = ( sLoc(I,J) * drF(K)*_hFacC(I,J,K,bi,bj)
430 & + MAX(salt(I,J,Kp1,bi,bj), zeroRL) * drKp1 )
431 & * recip_drLoc
432 #ifndef SHI_USTAR_WETPOINT
433 uLoc(I,J) = ( uLoc(I,J) * drF(K)*_hFacC(I,J,K,bi,bj)
434 & + drKp1 * recip_hFacC(I,J,Kp1,bi,bj) * halfRL *
435 & ( uVel(I, J,Kp1,bi,bj) * _hFacW(I, J,Kp1,bi,bj)
436 & + uVel(I+1,J,Kp1,bi,bj) * _hFacW(I+1,J,Kp1,bi,bj) )
437 & ) * recip_drLoc
438 vLoc(I,J) = ( vLoc(I,J) * drF(K)*_hFacC(I,J,K,bi,bj)
439 & + drKp1 * recip_hFacC(I,J,Kp1,bi,bj) * halfRL *
440 & ( vVel(I,J, Kp1,bi,bj) * _hFacS(I,J, Kp1,bi,bj)
441 & + vVel(I,J+1,Kp1,bi,bj) * _hFacS(I,J+1,Kp1,bi,bj) )
442 & ) * recip_drLoc
443 velSq(I,J) = uLoc(I,J)*uLoc(I,J)+vLoc(I,J)*vLoc(I,J)
444 #endif /* ndef SHI_USTAR_WETPOINT */
445 ENDIF
446 ENDDO
447 ENDDO
448 ENDIF
449
450
451
452 C-- turn potential temperature into in-situ temperature relative
453 C-- to the surface
454 DO J = 1, sNy
455 DO I = 1, sNx
456 #ifndef ALLOW_OPENAD
457 tLoc(I,J) = SW_TEMP(sLoc(I,J),tLoc(I,J),pLoc(I,J),zeroRL)
458 #else
459 CALL SW_TEMP(sLoc(I,J),tLoc(I,J),pLoc(I,J),zeroRL,tLoc(I,J))
460 #endif
461 ENDDO
462 ENDDO
463
464 #ifdef SHI_ALLOW_GAMMAFRICT
465 IF ( SHELFICEuseGammaFrict ) THEN
466 DO J = 1, sNy
467 DO I = 1, sNx
468 K = kTopC(I,J,bi,bj)
469 IF ( K .NE. 0 .AND. pLoc(I,J) .GT. 0. _d 0 ) THEN
470 ustarSq = shiCdrag * MAX( 1.D-6, velSq(I,J) )
471 ustar = SQRT(ustarSq)
472 #ifdef ALLOW_DIAGNOSTICS
473 uStarDiag(I,J,bi,bj) = ustar
474 #endif /* ALLOW_DIAGNOSTICS */
475 C instead of etastar = sqrt(1+zetaN*ustar./(f*Lo*Rc))
476 C etastar = 1. _d 0
477 C gammaTurbConst = 1. _d 0 / (2. _d 0 * shiZetaN*etastar)
478 C & - recip_shiKarman
479 IF ( fCori(I,J,bi,bj) .NE. 0. _d 0 ) THEN
480 gammaTurb = LOG( ustarSq * shiZetaN * etastar**2
481 & / ABS(fCori(I,J,bi,bj) * 5.0 _d 0 * shiKinVisc))
482 & * recip_shiKarman
483 & + gammaTurbConst
484 C Do we need to catch the unlikely case of very small ustar
485 C that can lead to negative gammaTurb?
486 C gammaTurb = MAX(0.D0, gammaTurb)
487 ELSE
488 gammaTurb = gammaTurbConst
489 ENDIF
490 shiTransCoeffT(i,j,bi,bj) = MAX( zeroRL,
491 & ustar/(gammaTurb + gammaTmoleT) )
492 shiTransCoeffS(i,j,bi,bj) = MAX( zeroRL,
493 & ustar/(gammaTurb + gammaTmoleS) )
494 ENDIF
495 ENDDO
496 ENDDO
497 ENDIF
498 #endif /* SHI_ALLOW_GAMMAFRICT */
499
500 #ifdef ALLOW_AUTODIFF_TAMC
501 # ifdef SHI_ALLOW_GAMMAFRICT
502 CADJ STORE shiTransCoeffS(:,:,bi,bj) = comlev1_bibj,
503 CADJ & key=ikey, byte=isbyte
504 CADJ STORE shiTransCoeffT(:,:,bi,bj) = comlev1_bibj,
505 CADJ & key=ikey, byte=isbyte
506 # endif /* SHI_ALLOW_GAMMAFRICT */
507 #endif /* ALLOW_AUTODIFF_TAMC */
508 #ifdef ALLOW_ISOMIP_TD
509 IF ( useISOMIPTD ) THEN
510 DO J = 1, sNy
511 DO I = 1, sNx
512 K = kTopC(I,J,bi,bj)
513 IF ( K .NE. 0 .AND. pLoc(I,J) .GT. 0. _d 0 ) THEN
514 C-- Calculate freezing temperature as a function of salinity and pressure
515 thetaFreeze =
516 & sLoc(I,J) * ( a0 + a1*sqrt(sLoc(I,J)) + a2*sLoc(I,J) )
517 & + b*pLoc(I,J) + c0
518 C-- Calculate the upward heat and fresh water fluxes
519 shelfIceHeatFlux(I,J,bi,bj) = maskC(I,J,K,bi,bj)
520 & * shiTransCoeffT(i,j,bi,bj)
521 & * ( tLoc(I,J) - thetaFreeze )
522 & * HeatCapacity_Cp*rUnit2mass
523 #ifdef ALLOW_SHIFWFLX_CONTROL
524 & - xx_shifwflx_loc(I,J,bi,bj)*SHELFICElatentHeat
525 #endif /* ALLOW_SHIFWFLX_CONTROL */
526 C upward heat flux into the shelf-ice implies basal melting,
527 C thus a downward (negative upward) fresh water flux (as a mass flux),
528 C and vice versa
529 shelfIceFreshWaterFlux(I,J,bi,bj) =
530 & - shelfIceHeatFlux(I,J,bi,bj)
531 & *recip_latentHeat
532 C-- compute surface tendencies
533 shelficeForcingT(i,j,bi,bj) =
534 & - shelfIceHeatFlux(I,J,bi,bj)
535 & *recip_Cp*mass2rUnit
536 & - cFac * shelfIceFreshWaterFlux(I,J,bi,bj)*mass2rUnit
537 & * ( thetaFreeze - tLoc(I,J) )
538 shelficeForcingS(i,j,bi,bj) =
539 & shelfIceFreshWaterFlux(I,J,bi,bj) * mass2rUnit
540 & * ( cFac*sLoc(I,J) + (1. _d 0-cFac)*convertFW2SaltLoc )
541 C-- stress at the ice/water interface is computed in separate
542 C routines that are called from mom_fluxform/mom_vecinv
543 ELSE
544 shelfIceHeatFlux (I,J,bi,bj) = 0. _d 0
545 shelfIceFreshWaterFlux(I,J,bi,bj) = 0. _d 0
546 shelficeForcingT (I,J,bi,bj) = 0. _d 0
547 shelficeForcingS (I,J,bi,bj) = 0. _d 0
548 ENDIF
549 ENDDO
550 ENDDO
551 ELSE
552 #else
553 IF ( .TRUE. ) THEN
554 #endif /* ALLOW_ISOMIP_TD */
555 C use BRIOS thermodynamics, following Hellmers PhD thesis:
556 C Hellmer, H., 1989, A two-dimensional model for the thermohaline
557 C circulation under an ice shelf, Reports on Polar Research, No. 60
558 C (in German).
559
560 DO J = 1, sNy
561 DO I = 1, sNx
562 K = kTopC(I,J,bi,bj)
563 IF ( K .NE. 0 .AND. pLoc(I,J) .GT. 0. _d 0 ) THEN
564 C heat flux into the ice shelf, default is diffusive flux
565 C (Holland and Jenkins, 1999, eq.21)
566 thetaFreeze = a0*sLoc(I,J)+c0+b*pLoc(I,J)
567 fwflxFac = 0. _d 0
568 IF ( tLoc(I,J) .GT. thetaFreeze ) fwflxFac = dFac
569 C a few abbreviations
570 eps1 = rUnit2mass*HeatCapacity_Cp
571 & *shiTransCoeffT(i,j,bi,bj)
572 eps2 = rUnit2mass*SHELFICElatentHeat
573 & *shiTransCoeffS(i,j,bi,bj)
574 eps5 = rUnit2mass*HeatCapacity_Cp
575 & *shiTransCoeffS(i,j,bi,bj)
576
577 C solve quadratic equation for salinity at shelfice-ocean interface
578 C note: this part of the code is not very intuitive as it involves
579 C many arbitrary abbreviations that were introduced to derive the
580 C correct form of the quadratic equation for salinity. The abbreviations
581 C only make sense in connection with my notes on this (M.Losch)
582 C
583 C eps3a was introduced as a constant variant of eps3 to avoid AD of
584 C code of typ (pLoc-const)/pLoc
585 eps3a = rhoShelfIce*SHELFICEheatCapacity_Cp
586 & * SHELFICEkappa * ( 1. _d 0 - dFac )
587 eps3 = eps3a/pLoc(I,J)
588 eps4 = b*pLoc(I,J) + c0
589 eps6 = eps4 - tLoc(I,J)
590 eps7 = eps4 - SHELFICEthetaSurface
591 eps8 = rUnit2mass*SHELFICEheatCapacity_Cp
592 & *shiTransCoeffS(i,j,bi,bj) * fwflxFac
593 aqe = a0 *(eps1+eps3-eps8)
594 recip_aqe = 0. _d 0
595 IF ( aqe .NE. 0. _d 0 ) recip_aqe = 0.5 _d 0/aqe
596 c bqe = eps1*eps6 + eps3*eps7 - eps2
597 bqe = eps1*eps6
598 & + eps3a*( b
599 & + ( c0 - SHELFICEthetaSurface )/pLoc(I,J) )
600 & - eps2
601 & + eps8*( a0*sLoc(I,J) - eps7 )
602 cqe = ( eps2 + eps8*eps7 )*sLoc(I,J)
603 discrim = bqe*bqe - 4. _d 0*aqe*cqe
604 #undef ALLOW_SHELFICE_DEBUG
605 #ifdef ALLOW_SHELFICE_DEBUG
606 IF ( discrim .LT. 0. _d 0 ) THEN
607 print *, 'ml-shelfice: discrim = ', discrim,aqe,bqe,cqe
608 print *, 'ml-shelfice: pLoc = ', pLoc(I,J)
609 print *, 'ml-shelfice: tLoc = ', tLoc(I,J)
610 print *, 'ml-shelfice: sLoc = ', sLoc(I,J)
611 print *, 'ml-shelfice: tsurface= ',
612 & SHELFICEthetaSurface
613 print *, 'ml-shelfice: eps1 = ', eps1
614 print *, 'ml-shelfice: eps2 = ', eps2
615 print *, 'ml-shelfice: eps3 = ', eps3
616 print *, 'ml-shelfice: eps4 = ', eps4
617 print *, 'ml-shelfice: eps5 = ', eps5
618 print *, 'ml-shelfice: eps6 = ', eps6
619 print *, 'ml-shelfice: eps7 = ', eps7
620 print *, 'ml-shelfice: eps8 = ', eps8
621 print *, 'ml-shelfice: rU2mass = ', rUnit2mass
622 print *, 'ml-shelfice: rhoIce = ', rhoShelfIce
623 print *, 'ml-shelfice: cFac = ', cFac
624 print *, 'ml-shelfice: Cp_W = ', HeatCapacity_Cp
625 print *, 'ml-shelfice: Cp_I = ',
626 & SHELFICEHeatCapacity_Cp
627 print *, 'ml-shelfice: gammaT = ',
628 & SHELFICEheatTransCoeff
629 print *, 'ml-shelfice: gammaS = ',
630 & SHELFICEsaltTransCoeff
631 print *, 'ml-shelfice: lat.heat= ',
632 & SHELFICElatentHeat
633 STOP 'ABNORMAL END in S/R SHELFICE_THERMODYNAMICS'
634 ENDIF
635 #endif /* ALLOW_SHELFICE_DEBUG */
636 saltFreeze = (- bqe - SQRT(discrim))*recip_aqe
637 IF ( saltFreeze .LT. 0. _d 0 )
638 & saltFreeze = (- bqe + SQRT(discrim))*recip_aqe
639 thetaFreeze = a0*saltFreeze + eps4
640 C-- upward fresh water flux due to melting (in kg/m^2/s)
641 cph change to identical form
642 cph freshWaterFlux = rUnit2mass
643 cph & * shiTransCoeffS(i,j,bi,bj)
644 cph & * ( saltFreeze - sLoc(I,J) ) / saltFreeze
645 freshWaterFlux = rUnit2mass
646 & * shiTransCoeffS(i,j,bi,bj)
647 & * ( 1. _d 0 - sLoc(I,J) / saltFreeze )
648 #ifdef ALLOW_SHIFWFLX_CONTROL
649 & + xx_shifwflx_loc(I,J,bi,bj)
650 #endif /* ALLOW_SHIFWFLX_CONTROL */
651
652
653 #ifdef ALLOW_SHELFICE_REMESHING
654 freshWaterFlux =
655 & freshWaterFlux*(GrdFactor(i,j,bi,bj)*0.5+0.5)
656 #endif
657
658 C-- Calculate the upward heat and fresh water fluxes;
659 C-- MITgcm sign conventions: downward (negative) fresh water flux
660 C-- implies melting and due to upward (positive) heat flux
661 shelfIceHeatFlux(I,J,bi,bj) =
662 & ( eps3
663 & - freshWaterFlux*SHELFICEheatCapacity_Cp*fwflxFac )
664 & * ( thetaFreeze - SHELFICEthetaSurface )
665 & - cFac*freshWaterFlux*( SHELFICElatentHeat
666 & - HeatCapacity_Cp*( thetaFreeze - rFac*tLoc(I,J) ) )
667 shelfIceFreshWaterFlux(I,J,bi,bj) = freshWaterFlux
668 C-- compute surface tendencies
669 shelficeForcingT(i,j,bi,bj) =
670 & ( shiTransCoeffT(i,j,bi,bj)
671 & - cFac*shelfIceFreshWaterFlux(I,J,bi,bj)*mass2rUnit )
672 & * ( thetaFreeze - tLoc(I,J) )
673 & - realFWfac*shelfIceFreshWaterFlux(I,J,bi,bj)*
674 & mass2rUnit*
675 & ( tLoc(I,J) - theta(I,J,K,bi,bj) )
676 shelficeForcingS(i,j,bi,bj) =
677 & ( shiTransCoeffS(i,j,bi,bj)
678 & - cFac*shelfIceFreshWaterFlux(I,J,bi,bj)*mass2rUnit )
679 & * ( saltFreeze - sLoc(I,J) )
680 & - realFWfac*shelfIceFreshWaterFlux(I,J,bi,bj)*
681 & mass2rUnit*
682 & ( sLoc(I,J) - salt(I,J,K,bi,bj) )
683 ELSE
684 shelfIceHeatFlux (I,J,bi,bj) = 0. _d 0
685 shelfIceFreshWaterFlux(I,J,bi,bj) = 0. _d 0
686 shelficeForcingT (I,J,bi,bj) = 0. _d 0
687 shelficeForcingS (I,J,bi,bj) = 0. _d 0
688 ENDIF
689 ENDDO
690 ENDDO
691 ENDIF
692 C endif (not) useISOMIPTD
693 ENDDO
694 ENDDO
695
696 IF (SHELFICEMassStepping) THEN
697 CALL SHELFICE_STEP_ICEMASS( myTime, myIter, myThid )
698 ENDIF
699
700 C-- Calculate new loading anomaly (in case the ice-shelf mass was updated)
701 #ifndef ALLOW_AUTODIFF
702 c IF ( SHELFICEloadAnomalyFile .EQ. ' ' ) THEN
703 DO bj = myByLo(myThid), myByHi(myThid)
704 DO bi = myBxLo(myThid), myBxHi(myThid)
705 DO j = 1-OLy, sNy+OLy
706 DO i = 1-OLx, sNx+OLx
707 #ifndef ALLOW_SHELFICE_REMESHING
708
709 shelficeLoadAnomaly(i,j,bi,bj) = gravity
710 & *( shelficeMass(i,j,bi,bj) + rhoConst*Ro_surf(i,j,bi,bj) )
711
712 #else
713
714 shelficeLoadAnomaly(i,j,bi,bj) = gravity
715 & *( EFFMASS(I,J,BI,BJ) + rhoConst*Ro_surf(i,j,bi,bj) )
716
717 #endif
718 ENDDO
719 ENDDO
720 ENDDO
721 ENDDO
722 c ENDIF
723 #endif /* ndef ALLOW_AUTODIFF */
724
725 #ifdef ALLOW_DIAGNOSTICS
726 IF ( useDiagnostics ) THEN
727 CALL DIAGNOSTICS_FILL_RS(shelfIceFreshWaterFlux,'SHIfwFlx',
728 & 0,1,0,1,1,myThid)
729 CALL DIAGNOSTICS_FILL_RS(shelfIceHeatFlux, 'SHIhtFlx',
730 & 0,1,0,1,1,myThid)
731 C SHIForcT (Ice shelf forcing for theta [W/m2], >0 increases theta)
732 tmpFac = HeatCapacity_Cp*rUnit2mass
733 CALL DIAGNOSTICS_SCALE_FILL(shelficeForcingT,tmpFac,1,
734 & 'SHIForcT',0,1,0,1,1,myThid)
735 C SHIForcS (Ice shelf forcing for salt [g/m2/s], >0 increases salt)
736 tmpFac = rUnit2mass
737 CALL DIAGNOSTICS_SCALE_FILL(shelficeForcingS,tmpFac,1,
738 & 'SHIForcS',0,1,0,1,1,myThid)
739 C Transfer coefficients
740 CALL DIAGNOSTICS_FILL(shiTransCoeffT,'SHIgammT',
741 & 0,1,0,1,1,myThid)
742 CALL DIAGNOSTICS_FILL(shiTransCoeffS,'SHIgammS',
743 & 0,1,0,1,1,myThid)
744 C Friction velocity
745 #ifdef SHI_ALLOW_GAMMAFRICT
746 IF ( SHELFICEuseGammaFrict )
747 & CALL DIAGNOSTICS_FILL(uStarDiag,'SHIuStar',0,1,0,1,1,myThid)
748 #endif /* SHI_ALLOW_GAMMAFRICT */
749 #ifdef ALLOW_SHELFICE_REMESHING
750 CALL DIAGNOSTICS_FILL(R_shelfice,'SHIRshel',
751 & 0,1,0,1,1,myThid)
752 CALL DIAGNOSTICS_FILL(EFFMASS,'SHI_MEff',
753 & 0,1,0,1,1,myThid)
754 #endif
755 ENDIF
756 #endif /* ALLOW_DIAGNOSTICS */
757
758 #endif /* ALLOW_SHELFICE */
759 RETURN
760 END

  ViewVC Help
Powered by ViewVC 1.1.22