/[MITgcm]/MITgcm_contrib/dgoldberg/shelfice/shelfice_thermodynamics.F
ViewVC logotype

Annotation of /MITgcm_contrib/dgoldberg/shelfice/shelfice_thermodynamics.F

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


Revision 1.2 - (hide annotations) (download)
Sun Dec 14 18:48:40 2014 UTC (9 years, 5 months ago) by dgoldberg
Branch: MAIN
Changes since 1.1: +20 -11 lines
updates to branch of pkg/shelfice for dynamic ice mass

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

  ViewVC Help
Powered by ViewVC 1.1.22