/[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.1 - (hide annotations) (download)
Wed Aug 27 19:26:17 2014 UTC (10 years, 10 months ago) by dgoldberg
Branch: MAIN
contrib repo for changes to shelfice files for coupling

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

  ViewVC Help
Powered by ViewVC 1.1.22