/[MITgcm]/MITgcm/pkg/seaice/seaice_solve4temp.F
ViewVC logotype

Annotation of /MITgcm/pkg/seaice/seaice_solve4temp.F

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


Revision 1.36 - (hide annotations) (download)
Mon Apr 28 11:50:33 2014 UTC (10 years, 1 month ago) by mlosch
Branch: MAIN
CVS Tags: checkpoint64y, checkpoint64x, checkpoint64z, checkpoint64w, checkpoint65, checkpoint65b, checkpoint65c, checkpoint65a, checkpoint65f, checkpoint65d, checkpoint65e
Changes since 1.35: +2 -2 lines
adjust a comment

1 mlosch 1.36 C $Header: /u/gcmpack/MITgcm/pkg/seaice/seaice_solve4temp.F,v 1.35 2012/03/06 01:28:11 jmc Exp $
2 jmc 1.1 C $Name: $
3    
4     #include "SEAICE_OPTIONS.h"
5 jmc 1.19 #ifdef ALLOW_EXF
6     # include "EXF_OPTIONS.h"
7     #endif
8 jmc 1.1
9     CBOP
10     C !ROUTINE: SEAICE_SOLVE4TEMP
11     C !INTERFACE:
12     SUBROUTINE SEAICE_SOLVE4TEMP(
13     I UG, HICE_ACTUAL, HSNOW_ACTUAL,
14 gforget 1.30 #ifdef SEAICE_CAP_SUBLIM
15 ifenty 1.16 I F_lh_max,
16     #endif
17 gforget 1.34 I TSURFin,
18     O TSURFout,
19 jmc 1.21 O F_ia, IcePenetSW,
20 mlosch 1.10 O FWsublim,
21 jmc 1.1 I bi, bj, myTime, myIter, myThid )
22    
23     C !DESCRIPTION: \bv
24     C *==========================================================*
25     C | SUBROUTINE SOLVE4TEMP
26     C | o Calculate ice growth rate, surface fluxes and
27     C | temperature of ice surface.
28     C | see Hibler, MWR, 108, 1943-1973, 1980
29     C *==========================================================*
30     C \ev
31    
32     C !USES:
33     IMPLICIT NONE
34     C === Global variables ===
35     #include "SIZE.h"
36     #include "GRID.h"
37     #include "EEPARAMS.h"
38 jmc 1.3 #include "PARAMS.h"
39 jmc 1.1 #include "FFIELDS.h"
40 heimbach 1.13 #include "SEAICE_SIZE.h"
41     #include "SEAICE_PARAMS.h"
42 jmc 1.1 #include "SEAICE.h"
43     #include "DYNVARS.h"
44     #ifdef ALLOW_EXF
45     # include "EXF_FIELDS.h"
46     #endif
47 mlosch 1.8 #ifdef ALLOW_AUTODIFF_TAMC
48     # include "tamc.h"
49     #endif
50 jmc 1.1
51 jmc 1.21 C !INPUT PARAMETERS:
52     C UG :: atmospheric wind speed (m/s)
53 jmc 1.1 C HICE_ACTUAL :: actual ice thickness
54     C HSNOW_ACTUAL :: actual snow thickness
55 jmc 1.21 C TSURF :: surface temperature of ice/snow in Kelvin
56     C bi,bj :: tile indices
57     C myTime :: current time in simulation
58     C myIter :: iteration number in simulation
59     C myThid :: my Thread Id number
60     C !OUTPUT PARAMETERS:
61     C TSURF :: updated surface temperature of ice/snow in Kelvin
62     C F_ia :: upward seaice/snow surface heat flux to atmosphere (W/m^2)
63     C IcePenetSW :: short wave heat flux transmitted through ice (+=upward)
64     C FWsublim :: fresh water (mass) flux due to sublimation (+=up)(kg/m^2/s)
65 jmc 1.24 C---- Notes:
66     C 1) should add IcePenetSW to F_ia to get the net surface heat flux
67     C from the atmosphere (IcePenetSW not currently included in F_ia)
68     C 2) since zero ice/snow heat capacity is assumed, all the absorbed Short
69     C -Wave is used to warm the ice/snow surface (heating profile ignored).
70     C----------
71 jmc 1.21 _RL UG (1:sNx,1:sNy)
72     _RL HICE_ACTUAL (1:sNx,1:sNy)
73     _RL HSNOW_ACTUAL(1:sNx,1:sNy)
74 gforget 1.30 #ifdef SEAICE_CAP_SUBLIM
75 jmc 1.21 _RL F_lh_max (1:sNx,1:sNy)
76 ifenty 1.16 #endif
77 gforget 1.34 _RL TSURFin (1:sNx,1:sNy)
78     _RL TSURFout (1:sNx,1:sNy)
79 jmc 1.21 _RL F_ia (1:sNx,1:sNy)
80     _RL IcePenetSW (1:sNx,1:sNy)
81     _RL FWsublim (1:sNx,1:sNy)
82 jmc 1.1 INTEGER bi, bj
83     _RL myTime
84     INTEGER myIter, myThid
85 jmc 1.19 CEOP
86 jmc 1.1
87 jmc 1.19 #if defined(ALLOW_ATM_TEMP) && defined(ALLOW_DOWNWARD_RADIATION)
88 jmc 1.1 C !LOCAL VARIABLES:
89     C === Local variables ===
90 jmc 1.3 C i, j :: Loop counters
91 gforget 1.30 C kSurface :: vertical index of surface layer
92 jmc 1.1 INTEGER i, j
93 gforget 1.30 INTEGER kSurface
94 jmc 1.1 INTEGER ITER
95 gforget 1.30 C tempFrz :: ocean temperature in contact with ice (=seawater freezing point) (K)
96     _RL tempFrz (1:sNx,1:sNy)
97 mlosch 1.18 _RL D1, D1I
98     _RL D3(1:sNx,1:sNy)
99 mlosch 1.31 _RL TMELT, XKI, XKS, HCUT, recip_HCUT, XIO
100 jmc 1.27 C SurfMeltTemp :: Temp (K) above which wet-albedo values are used
101 mlosch 1.5 _RL SurfMeltTemp
102 jmc 1.21 C effConduct :: effective conductivity of combined ice and snow
103 mlosch 1.5 _RL effConduct(1:sNx,1:sNy)
104 jmc 1.21 C lhSublim :: latent heat of sublimation (SEAICE_lhEvap + SEAICE_lhFusion)
105     _RL lhSublim
106     C t1,t2,t3,t4 :: powers of temperature
107     _RL t1, t2, t3, t4
108 jmc 1.1
109 jmc 1.24 C- Constants to calculate Saturation Vapor Pressure
110 jmc 1.26 C Maykut Polynomial Coeff. for Sat. Vapor Press
111 jmc 1.21 _RL C1, C2, C3, C4, C5, QS1
112 jmc 1.24 C Extended temp-range expon. relation Coeff. for Sat. Vapor Press
113 jmc 1.21 _RL lnTEN
114 jmc 1.1 _RL aa1,aa2,bb1,bb2,Ppascals,cc0,cc1,cc2,cc3t
115     C specific humidity at ice surface variables
116 jmc 1.21 _RL mm_pi,mm_log10pi
117 jmc 1.1
118 jmc 1.22 C F_c :: conductive heat flux through seaice+snow (+=upward)
119 jmc 1.26 C F_lwu :: upward long-wave surface heat flux (+=upward)
120     C F_sens :: sensible surface heat flux (+=upward)
121 jmc 1.21 C F_lh :: latent heat flux (sublimation) (+=upward)
122 jmc 1.24 C qhice :: saturation vapor pressure of snow/ice surface
123     C dqh_dTs :: derivative of qhice w.r.t snow/ice surf. temp
124     C dFia_dTs :: derivative of surf heat flux (F_ia) w.r.t surf. temp
125 jmc 1.26 _RL F_c (1:sNx,1:sNy)
126 jmc 1.21 _RL F_lwu (1:sNx,1:sNy)
127     _RL F_sens (1:sNx,1:sNy)
128     _RL F_lh (1:sNx,1:sNy)
129     _RL qhice (1:sNx,1:sNy)
130 jmc 1.24 _RL dqh_dTs (1:sNx,1:sNy)
131 jmc 1.26 _RL dFia_dTs (1:sNx,1:sNy)
132 jmc 1.21 _RL absorbedSW (1:sNx,1:sNy)
133     _RL penetSWFrac
134 jmc 1.25 _RL delTsurf
135 jmc 1.21
136     C local copies of global variables
137     _RL tsurfLoc (1:sNx,1:sNy)
138 jmc 1.25 _RL tsurfPrev (1:sNx,1:sNy)
139 jmc 1.21 _RL atempLoc (1:sNx,1:sNy)
140     _RL lwdownLoc (1:sNx,1:sNy)
141     _RL ALB (1:sNx,1:sNy)
142     _RL ALB_ICE (1:sNx,1:sNy)
143     _RL ALB_SNOW (1:sNx,1:sNy)
144     C iceOrNot :: this is HICE_ACTUAL.GT.0.
145     LOGICAL iceOrNot(1:sNx,1:sNy)
146     #ifdef SEAICE_DEBUG
147     C F_io_net :: upward conductive heat flux through seaice+snow
148     C F_ia_net :: net heat flux divergence at the sea ice/snow surface:
149     C includes ice conductive fluxes and atmospheric fluxes (W/m^2)
150 jmc 1.25 _RL F_io_net
151     _RL F_ia_net
152 jmc 1.21 #endif /* SEAICE_DEBUG */
153 ifenty 1.14
154 jmc 1.21 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
155 jmc 1.1
156 mlosch 1.8 #ifdef ALLOW_AUTODIFF_TAMC
157     CADJ INIT comlev1_solve4temp = COMMON, sNx*sNy*NMAX_TICE
158     #endif /* ALLOW_AUTODIFF_TAMC */
159    
160 jmc 1.24 C- MAYKUT CONSTANTS FOR SAT. VAP. PRESSURE TEMP. POLYNOMIAL
161 mlosch 1.5 C1= 2.7798202 _d -06
162     C2= -2.6913393 _d -03
163     C3= 0.97920849 _d +00
164     C4= -158.63779 _d +00
165     C5= 9653.1925 _d +00
166 jmc 1.1 QS1=0.622 _d +00/1013.0 _d +00
167 jmc 1.24 C- Extended temp-range expon. relation Coeff. for Sat. Vapor Press
168 jmc 1.21 lnTEN = LOG(10.0 _d 0)
169 jmc 1.1 aa1 = 2663.5 _d 0
170     aa2 = 12.537 _d 0
171     bb1 = 0.622 _d 0
172 mlosch 1.5 bb2 = 1.0 _d 0 - bb1
173 jmc 1.1 Ppascals = 100000. _d 0
174 mlosch 1.5 C cc0 = TEN ** aa2
175 jmc 1.21 cc0 = EXP(aa2*lnTEN)
176 mlosch 1.5 cc1 = cc0*aa1*bb1*Ppascals*lnTEN
177 jmc 1.1 cc2 = cc0*bb2
178    
179 gforget 1.30 IF ( buoyancyRelation .EQ. 'OCEANICP' ) THEN
180     kSurface = Nr
181     ELSE
182     kSurface = 1
183     ENDIF
184 jmc 1.1
185     C SENSIBLE HEAT CONSTANT
186 mlosch 1.7 D1=SEAICE_dalton*SEAICE_cpAir*SEAICE_rhoAir
187 jmc 1.1
188     C ICE LATENT HEAT CONSTANT
189 ifenty 1.14 lhSublim = SEAICE_lhEvap + SEAICE_lhFusion
190     D1I=SEAICE_dalton*lhSublim*SEAICE_rhoAir
191 jmc 1.1
192     C MELTING TEMPERATURE OF ICE
193 mlosch 1.5 TMELT = celsius2K
194 jmc 1.1
195     C ICE CONDUCTIVITY
196     XKI=SEAICE_iceConduct
197    
198     C SNOW CONDUCTIVITY
199     XKS=SEAICE_snowConduct
200    
201     C CUTOFF SNOW THICKNESS
202 jmc 1.21 C Snow-Thickness above HCUT: SW optically thick snow (=> snow-albedo).
203     C Snow-Thickness below HCUT: linear transition to ice-albedo
204 jmc 1.24 HCUT = SEAICE_snowThick
205 jmc 1.32 recip_HCUT = 0. _d 0
206     IF ( HCUT.GT.0. _d 0 ) recip_HCUT = 1. _d 0 / HCUT
207 jmc 1.24
208     C PENETRATION SHORTWAVE RADIATION FACTOR
209     XIO=SEAICE_shortwave
210    
211 jmc 1.27 C Temperature Threshold for wet-albedo:
212     SurfMeltTemp = TMELT + SEAICE_wetAlbTemp
213 jmc 1.24 C old SOLVE4TEMP_LEGACY setting, consistent with former celsius2K value:
214     c TMELT = 273.16 _d +00
215     c SurfMeltTemp = 273.159 _d +00
216 jmc 1.1
217 jmc 1.3 C Initialize variables
218 jmc 1.1 DO J=1,sNy
219 mlosch 1.5 DO I=1,sNx
220 jmc 1.35 C initialise output arrays:
221     TSURFout (I,J) = TSURFin(I,J)
222     F_ia (I,J) = 0. _d 0
223     IcePenetSW(I,J)= 0. _d 0
224     FWsublim (I,J) = 0. _d 0
225 mlosch 1.5 C HICE_ACTUAL is modified in this routine, but at the same time
226     C used to decided where there is ice, therefore we save this information
227     C here in a separate array
228 jmc 1.21 iceOrNot (I,J) = HICE_ACTUAL(I,J) .GT. 0. _d 0
229     absorbedSW(I,J) = 0. _d 0
230 mlosch 1.5 qhice (I,J) = 0. _d 0
231 jmc 1.24 dqh_dTs (I,J) = 0. _d 0
232 mlosch 1.10 F_lh (I,J) = 0. _d 0
233 mlosch 1.5 F_lwu (I,J) = 0. _d 0
234     F_sens (I,J) = 0. _d 0
235 jmc 1.26 C Make a local copy of LW, surface & atmospheric temperatures
236 gforget 1.34 tsurfLoc (I,J) = TSURFin(I,J)
237     c tsurfLoc (I,J) = MIN( celsius2K+MAX_TICE, TSURFin(I,J) )
238 jmc 1.26 lwdownLoc(I,J) = MAX( MIN_LWDOWN, LWDOWN(I,J,bi,bj) )
239 jmc 1.24 atempLoc (I,J) = MAX( celsius2K+MIN_ATEMP, ATEMP(I,J,bi,bj) )
240 jmc 1.1
241 gforget 1.30 c FREEZING TEMP. OF SEA WATER (K)
242     tempFrz(I,J) = SEAICE_dTempFrz_dS *salt(I,J,kSurface,bi,bj)
243     & + SEAICE_tempFrz0 + celsius2K
244 jmc 1.32
245 jmc 1.26 C Now determine fixed (relative to tsurf) forcing term in heat budget
246    
247 mlosch 1.18 IF(HSNOW_ACTUAL(I,J).GT.0.0) THEN
248 jmc 1.21 C Stefan-Boltzmann constant times emissivity
249 mlosch 1.18 D3(I,J)=SEAICE_snow_emiss*SEAICE_boltzmann
250     #ifdef EXF_LWDOWN_WITH_EMISSIVITY
251     C This is now [(1-emiss)*lwdown - lwdown]
252 jmc 1.26 lwdownLoc(I,J) = SEAICE_snow_emiss*lwdownLoc(I,J)
253 mlosch 1.18 #else /* use the old hard wired inconsistent value */
254 jmc 1.26 lwdownLoc(I,J) = 0.97 _d 0*lwdownLoc(I,J)
255 mlosch 1.18 #endif /* EXF_LWDOWN_WITH_EMISSIVITY */
256     ELSE
257 jmc 1.21 C Stefan-Boltzmann constant times emissivity
258 mlosch 1.18 D3(I,J)=SEAICE_ice_emiss*SEAICE_boltzmann
259     #ifdef EXF_LWDOWN_WITH_EMISSIVITY
260     C This is now [(1-emiss)*lwdown - lwdown]
261 jmc 1.26 lwdownLoc(I,J) = SEAICE_ice_emiss*lwdownLoc(I,J)
262 mlosch 1.18 #else /* use the old hard wired inconsistent value */
263 jmc 1.26 lwdownLoc(I,J) = 0.97 _d 0*lwdownLoc(I,J)
264 mlosch 1.18 #endif /* EXF_LWDOWN_WITH_EMISSIVITY */
265     ENDIF
266 mlosch 1.5 ENDDO
267 jmc 1.1 ENDDO
268    
269     DO J=1,sNy
270 mlosch 1.5 DO I=1,sNx
271 jmc 1.1
272     C DECIDE ON ALBEDO
273 mlosch 1.5 IF ( iceOrNot(I,J) ) THEN
274 jmc 1.6
275 mlosch 1.5 IF ( YC(I,J,bi,bj) .LT. 0.0 _d 0 ) THEN
276     IF (tsurfLoc(I,J) .GE. SurfMeltTemp) THEN
277     ALB_ICE (I,J) = SEAICE_wetIceAlb_south
278     ALB_SNOW(I,J) = SEAICE_wetSnowAlb_south
279     ELSE ! no surface melting
280     ALB_ICE (I,J) = SEAICE_dryIceAlb_south
281     ALB_SNOW(I,J) = SEAICE_drySnowAlb_south
282     ENDIF
283     ELSE !/ Northern Hemisphere
284     IF (tsurfLoc(I,J) .GE. SurfMeltTemp) THEN
285     ALB_ICE (I,J) = SEAICE_wetIceAlb
286     ALB_SNOW(I,J) = SEAICE_wetSnowAlb
287     ELSE ! no surface melting
288     ALB_ICE (I,J) = SEAICE_dryIceAlb
289     ALB_SNOW(I,J) = SEAICE_drySnowAlb
290     ENDIF
291     ENDIF !/ Albedo for snow and ice
292    
293 jmc 1.21 C If actual snow thickness exceeds the cutoff thickness, use snow albedo
294 mlosch 1.5 IF (HSNOW_ACTUAL(I,J) .GT. HCUT) THEN
295     ALB(I,J) = ALB_SNOW(I,J)
296 jmc 1.21 ELSEIF ( HCUT.LE.ZERO ) THEN
297     ALB(I,J) = ALB_ICE(I,J)
298 mlosch 1.5 ELSE
299 jmc 1.21 C otherwise, use linear transition between ice and snow albedo
300 mlosch 1.31 ALB(I,J) = MIN( ALB_ICE(I,J) + HSNOW_ACTUAL(I,J)*recip_HCUT
301 jmc 1.21 & *(ALB_SNOW(I,J) -ALB_ICE(I,J))
302     & , ALB_SNOW(I,J) )
303 mlosch 1.5 ENDIF
304    
305 jmc 1.21 C Determine the fraction of shortwave radiative flux remaining
306     C at ocean interface after scattering through the snow and ice.
307     C If snow is present, no radiation penetrates through snow+ice
308 mlosch 1.5 IF (HSNOW_ACTUAL(I,J) .GT. 0.0 _d 0) THEN
309 jmc 1.21 penetSWFrac = 0.0 _d 0
310 mlosch 1.5 ELSE
311 jmc 1.21 penetSWFrac = XIO*EXP(-1.5 _d 0 * HICE_ACTUAL(I,J))
312 mlosch 1.5 ENDIF
313 jmc 1.21 C The shortwave radiative flux leaving ocean beneath ice (+=up).
314     IcePenetSW(I,J) = -(1.0 _d 0 - ALB(I,J))
315     & *penetSWFrac * SWDOWN(I,J,bi,bj)
316     C The shortwave radiative flux convergence in the seaice.
317     absorbedSW(I,J) = (1.0 _d 0 - ALB(I,J))
318     & *(1.0 _d 0 - penetSWFrac)* SWDOWN(I,J,bi,bj)
319 jmc 1.1
320 jmc 1.24 C The effective conductivity of the two-layer snow/ice system.
321 jmc 1.26 C Set a minimum sea ice thickness of 5 cm to bound
322 jmc 1.21 C the magnitude of conductive heat fluxes.
323     Cif * now taken care of by SEAICE_hice_reg in seaice_growth
324     c hice_tmp = max(HICE_ACTUAL(I,J),5. _d -2)
325 mlosch 1.5 effConduct(I,J) = XKI * XKS /
326 jmc 1.21 & (XKS * HICE_ACTUAL(I,J) + XKI * HSNOW_ACTUAL(I,J))
327 jmc 1.1
328     #ifdef SEAICE_DEBUG
329 jmc 1.21 IF ( (I .EQ. SEAICE_debugPointI) .AND.
330 ifenty 1.16 & (J .EQ. SEAICE_debugPointJ) ) THEN
331 mlosch 1.5 print '(A,i6)','-----------------------------------'
332     print '(A,i6)','ibi merged initialization ', myIter
333     print '(A,i6,4(1x,D24.15))',
334     & 'ibi iter, TSL, TS ',myIter,
335 gforget 1.34 & tsurfLoc(I,J), TSURFin(I,J)
336 mlosch 1.5 print '(A,i6,4(1x,D24.15))',
337     & 'ibi iter, TMELT ',myIter,TMELT
338     print '(A,i6,4(1x,D24.15))',
339     & 'ibi iter, HIA, EFKCON ',myIter,
340     & HICE_ACTUAL(I,J), effConduct(I,J)
341     print '(A,i6,4(1x,D24.15))',
342     & 'ibi iter, HSNOW ',myIter,
343     & HSNOW_ACTUAL(I,J), ALB(I,J)
344     print '(A,i6)','-----------------------------------'
345     print '(A,i6)','ibi energy balance iterat ', myIter
346     ENDIF
347 jmc 1.2 #endif /* SEAICE_DEBUG */
348 jmc 1.6
349 mlosch 1.5 ENDIF !/* iceOrNot */
350     ENDDO !/* i */
351     ENDDO !/* j */
352 jmc 1.21
353     C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
354 mlosch 1.5 DO ITER=1,IMAX_TICE
355     DO J=1,sNy
356     DO I=1,sNx
357 mlosch 1.8 #ifdef ALLOW_AUTODIFF_TAMC
358     iicekey = I + sNx*(J-1) + (ITER-1)*sNx*sNy
359 jmc 1.26 CADJ STORE tsurfLoc(i,j) = comlev1_solve4temp,
360 mlosch 1.8 CADJ & key = iicekey, byte = isbyte
361     #endif /* ALLOW_AUTODIFF_TAMC */
362    
363 jmc 1.25 C- save tsurf from previous iter
364     tsurfPrev(I,J) = tsurfLoc(I,J)
365 mlosch 1.5 IF ( iceOrNot(I,J) ) THEN
366 jmc 1.1
367 mlosch 1.5 t1 = tsurfLoc(I,J)
368     t2 = t1*t1
369     t3 = t2*t1
370     t4 = t2*t2
371 jmc 1.1
372 jmc 1.24 C-- Calculate the specific humidity in the BL above the snow/ice
373 jmc 1.25 IF ( useMaykutSatVapPoly ) THEN
374 jmc 1.24 C- Use the Maykut polynomial
375 jmc 1.25 qhice(I,J)=QS1*(C1*t4+C2*t3 +C3*t2+C4*t1+C5)
376     dqh_dTs(I,J) = 0. _d 0
377     ELSE
378 jmc 1.24 C- Use exponential relation approx., more accurate at low temperatures
379 mlosch 1.5 C log 10 of the sat vap pressure
380 jmc 1.25 mm_log10pi = -aa1 / t1 + aa2
381 mlosch 1.5 C The saturation vapor pressure (SVP) in the surface
382     C boundary layer (BL) above the snow/ice.
383 jmc 1.25 c mm_pi = TEN **(mm_log10pi)
384 jmc 1.6 C The following form does the same, but is faster
385 jmc 1.25 mm_pi = EXP(mm_log10pi*lnTEN)
386     qhice(I,J) = bb1*mm_pi/( Ppascals -(1.0 _d 0 - bb1)*mm_pi )
387 jmc 1.21 C A constant for SVP derivative w.r.t TICE
388 jmc 1.25 c cc3t = TEN **(aa1 / t1)
389 jmc 1.21 C The following form does the same, but is faster
390 jmc 1.25 cc3t = EXP(aa1 / t1 * lnTEN)
391 jmc 1.21 C d(qh)/d(TICE)
392 jmc 1.25 dqh_dTs(I,J) = cc1*cc3t/((cc2-cc3t*Ppascals)**2 *t2)
393     ENDIF
394 jmc 1.1
395 heimbach 1.33 #ifdef ALLOW_AUTODIFF_TAMC
396     CADJ STORE tsurfLoc(i,j) = comlev1_solve4temp,
397     CADJ & key = iicekey, byte = isbyte
398     #endif /* ALLOW_AUTODIFF_TAMC */
399 mlosch 1.10 C Calculate the flux terms based on the updated tsurfLoc
400 gforget 1.30 F_c(I,J) = effConduct(I,J)*(tempFrz(I,J)-tsurfLoc(I,J))
401 mlosch 1.10 F_lh(I,J) = D1I*UG(I,J)*(qhice(I,J)-AQH(I,J,bi,bj))
402 gforget 1.30 #ifdef SEAICE_CAP_SUBLIM
403 jmc 1.21 C if the latent heat flux implied by tsurfLoc exceeds
404 mlosch 1.36 C F_lh_max, cap F_lh and decouple the flux magnitude from tIce (tsurfLoc)
405 jmc 1.21 IF (F_lh(I,J) .GT. F_lh_max(I,J)) THEN
406 ifenty 1.16 F_lh(I,J) = F_lh_max(I,J)
407 jmc 1.24 dqh_dTs(I,J) = ZERO
408 jmc 1.21 ENDIF
409 gforget 1.30 #endif /* SEAICE_CAP_SUBLIM */
410 ifenty 1.16
411 jmc 1.21 F_lwu(I,J) = t4 * D3(I,J)
412 mlosch 1.5 F_sens(I,J)= D1 * UG(I,J) * (t1 - atempLoc(I,J))
413 jmc 1.21 F_ia(I,J) = -lwdownLoc(I,J) -absorbedSW(I,J) + F_lwu(I,J)
414 jmc 1.24 & + F_sens(I,J) + F_lh(I,J)
415 jmc 1.26 C d(F_ia)/d(Tsurf)
416     dFia_dTs(I,J) = 4.0 _d 0*D3(I,J)*t3 + D1*UG(I,J)
417     & + D1I*UG(I,J)*dqh_dTs(I,J)
418 jmc 1.1
419     #ifdef SEAICE_DEBUG
420 jmc 1.21 IF ( (I .EQ. SEAICE_debugPointI) .AND.
421 ifenty 1.16 & (J .EQ. SEAICE_debugPointJ) ) THEN
422 mlosch 1.5 print '(A,i6,4(1x,D24.15))',
423     & 'ice-iter qhICE, ', ITER,qhIce(I,J)
424     print '(A,i6,4(1x,D24.15))',
425 jmc 1.24 & 'ice-iter dFiDTs1 F_ia ', ITER,
426     & dFia_dTs(I,J)+effConduct(I,J), F_ia(I,J)-F_c(I,J)
427 mlosch 1.5 ENDIF
428 jmc 1.2 #endif /* SEAICE_DEBUG */
429 jmc 1.1
430 jmc 1.26 C- Update tsurf as solution of : Fc = Fia + d/dT(Fia - Fc) *delta.tsurf
431 jmc 1.24 tsurfLoc(I,J) = tsurfLoc(I,J)
432     & + ( F_c(I,J)-F_ia(I,J) ) / ( effConduct(I,J)+dFia_dTs(I,J) )
433 jmc 1.1
434 heimbach 1.33 #ifdef ALLOW_AUTODIFF_TAMC
435     CADJ STORE tsurfLoc(i,j) = comlev1_solve4temp,
436     CADJ & key = iicekey, byte = isbyte
437     #endif /* ALLOW_AUTODIFF_TAMC */
438 jmc 1.26 IF ( useMaykutSatVapPoly ) THEN
439     tsurfLoc(I,J) = MAX( celsius2K+MIN_TICE, tsurfLoc(I,J) )
440     ENDIF
441 jmc 1.21 C If the search leads to tsurfLoc < 50 Kelvin, restart the search
442     C at tsurfLoc = TMELT. Note that one solution to the energy balance problem
443     C is an extremely low temperature - a temperature far below realistic values.
444 jmc 1.26 c IF (tsurfLoc(I,J) .LT. 50.0 _d 0 ) tsurfLoc(I,J) = TMELT
445     C Comments & code above not relevant anymore (from older version, when
446     C trying Maykut-Polynomial & dqh_dTs > 0 ?): commented out
447 jmc 1.21 tsurfLoc(I,J) = MIN( tsurfLoc(I,J), TMELT )
448 jmc 1.1
449     #ifdef SEAICE_DEBUG
450 jmc 1.21 IF ( (I .EQ. SEAICE_debugPointI) .AND.
451 ifenty 1.16 & (J .EQ. SEAICE_debugPointJ) ) THEN
452 mlosch 1.5 print '(A,i6,4(1x,D24.15))',
453     & 'ice-iter tsurfLc,|dif|', ITER,
454     & tsurfLoc(I,J),
455 jmc 1.21 & LOG10(ABS(tsurfLoc(I,J) - t1))
456 mlosch 1.5 ENDIF
457 jmc 1.2 #endif /* SEAICE_DEBUG */
458 jmc 1.1
459 mlosch 1.5 ENDIF !/* iceOrNot */
460     ENDDO !/* i */
461     ENDDO !/* j */
462     ENDDO !/* Iterations */
463 jmc 1.21 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
464    
465 mlosch 1.5 DO J=1,sNy
466     DO I=1,sNx
467     IF ( iceOrNot(I,J) ) THEN
468 jmc 1.1
469 jmc 1.21 C Save updated tsurf and finalize the flux terms
470 gforget 1.34 TSURFout(I,J) = tsurfLoc(I,J)
471 jmc 1.21
472 jmc 1.25 #ifdef SEAICE_MODIFY_GROWTH_ADJ
473     Cgf no additional dependency through solver, snow, etc.
474     IF ( SEAICEadjMODE.GE.2 ) THEN
475 gforget 1.34 CALL ZERO_ADJ_1D( 1, TSURFin(I,J), myThid)
476 jmc 1.26 absorbedSW(I,J) = 0.3 _d 0 *SWDOWN(I,J,bi,bj)
477     IcePenetSW(I,J)= 0. _d 0
478     ENDIF
479     IF ( postSolvTempIter.EQ.2 .OR. SEAICEadjMODE.GE.2 ) THEN
480 gforget 1.34 t1 = TSURFin(I,J)
481 jmc 1.25 #else /* SEAICE_MODIFY_GROWTH_ADJ */
482    
483     IF ( postSolvTempIter.EQ.2 ) THEN
484 mlosch 1.5 C Recalculate the fluxes based on the (possibly) adjusted TSURF
485 jmc 1.25 t1 = tsurfLoc(I,J)
486 jmc 1.26 #endif /* SEAICE_MODIFY_GROWTH_ADJ */
487 jmc 1.25 t2 = t1*t1
488     t3 = t2*t1
489     t4 = t2*t2
490 jmc 1.1
491 jmc 1.25 IF ( useMaykutSatVapPoly ) THEN
492     qhice(I,J)=QS1*(C1*t4+C2*t3 +C3*t2+C4*t1+C5)
493     ELSE
494 mlosch 1.5 C log 10 of the sat vap pressure
495 jmc 1.25 mm_log10pi = -aa1 / t1 + aa2
496 mlosch 1.5 C saturation vapor pressure
497 jmc 1.25 c mm_pi = TEN **(mm_log10pi)
498 jmc 1.6 C The following form does the same, but is faster
499 jmc 1.25 mm_pi = EXP(mm_log10pi*lnTEN)
500 jmc 1.21 C over ice specific humidity
501 jmc 1.25 qhice(I,J) = bb1*mm_pi/( Ppascals -(1.0 _d 0 - bb1)*mm_pi )
502     ENDIF
503 gforget 1.30 F_c(I,J) = effConduct(I,J) * (tempFrz(I,J) - t1)
504 jmc 1.25 F_lh(I,J) = D1I * UG(I,J)*(qhice(I,J)-AQH(I,J,bi,bj))
505 gforget 1.30 #ifdef SEAICE_CAP_SUBLIM
506 jmc 1.25 IF (F_lh(I,J) .GT. F_lh_max(I,J)) THEN
507 ifenty 1.16 F_lh(I,J) = F_lh_max(I,J)
508 jmc 1.25 ENDIF
509 gforget 1.30 #endif /* SEAICE_CAP_SUBLIM */
510 jmc 1.25 F_lwu(I,J) = t4 * D3(I,J)
511     F_sens(I,J) = D1 * UG(I,J) * (t1 - atempLoc(I,J))
512 jmc 1.21 C The flux between the ice/snow surface and the atmosphere.
513 jmc 1.25 F_ia(I,J) = -lwdownLoc(I,J) -absorbedSW(I,J) + F_lwu(I,J)
514     & + F_sens(I,J) + F_lh(I,J)
515 jmc 1.1
516 jmc 1.25 ELSEIF ( postSolvTempIter.EQ.1 ) THEN
517     C Update fluxes (consistent with the linearized formulation)
518     delTsurf = tsurfLoc(I,J)-tsurfPrev(I,J)
519 gforget 1.30 F_c(I,J) = effConduct(I,J)*(tempFrz(I,J)-tsurfLoc(I,J))
520 jmc 1.25 F_ia(I,J) = F_ia(I,J) + dFia_dTs(I,J)*delTsurf
521     F_lh(I,J) = F_lh(I,J)
522     & + D1I*UG(I,J)*dqh_dTs(I,J)*delTsurf
523 jmc 1.26
524     c ELSEIF ( postSolvTempIter.EQ.0 ) THEN
525 jmc 1.25 C Take fluxes from last iteration
526 jmc 1.26
527 jmc 1.21 ENDIF
528    
529     C Fresh water flux (kg/m^2/s) from latent heat of sublimation.
530     C F_lh is positive upward (sea ice looses heat) and FWsublim
531     C is also positive upward (atmosphere gains freshwater)
532     FWsublim(I,J) = F_lh(I,J)/lhSublim
533 gforget 1.9
534 jmc 1.21 #ifdef SEAICE_DEBUG
535 jmc 1.26 C Calculate the net ice-ocean and ice-atmosphere fluxes
536 jmc 1.22 IF (F_c(I,J) .GT. 0.0 _d 0) THEN
537 jmc 1.25 F_io_net = F_c(I,J)
538     F_ia_net = 0.0 _d 0
539 mlosch 1.5 ELSE
540 jmc 1.25 F_io_net = 0.0 _d 0
541     F_ia_net = F_ia(I,J)
542 mlosch 1.5 ENDIF !/* conductive fluxes up or down */
543 jmc 1.1
544 jmc 1.21 IF ( (I .EQ. SEAICE_debugPointI) .AND.
545 ifenty 1.16 & (J .EQ. SEAICE_debugPointJ) ) THEN
546 mlosch 1.5 print '(A)','----------------------------------------'
547     print '(A,i6)','ibi complete ', myIter
548     print '(A,4(1x,D24.15))',
549     & 'ibi T(SURF, surfLoc,atmos) ',
550 gforget 1.34 & TSURFout(I,J), tsurfLoc(I,J),atempLoc(I,J)
551 mlosch 1.5 print '(A,4(1x,D24.15))',
552     & 'ibi LWL ', lwdownLoc(I,J)
553     print '(A,4(1x,D24.15))',
554     & 'ibi QSW(Total, Penetrating)',
555 jmc 1.21 & SWDOWN(I,J,bi,bj), IcePenetSW(I,J)
556 mlosch 1.5 print '(A,4(1x,D24.15))',
557     & 'ibi qh(ATM ICE) ',
558     & AQH(I,J,bi,bj),qhice(I,J)
559 ifenty 1.16 print '(A,4(1x,D24.15))',
560     & 'ibi F(lwd,swi,lwu) ',
561 jmc 1.21 & -lwdownLoc(I,J), -absorbedSW(I,J), F_lwu(I,J)
562 ifenty 1.16 print '(A,4(1x,D24.15))',
563     & 'ibi F(c,lh,sens) ',
564     & F_c(I,J), F_lh(I,J), F_sens(I,J)
565 gforget 1.30 #ifdef SEAICE_CAP_SUBLIM
566 ifenty 1.16 IF (F_lh_max(I,J) .GT. ZERO) THEN
567     print '(A,4(1x,D24.15))',
568     & 'ibi F_lh_max, F_lh/lhmax) ',
569     & F_lh_max(I,J), F_lh(I,J)/ F_lh_max(I,J)
570 jmc 1.19 ELSE
571 ifenty 1.16 print '(A,4(1x,D24.15))',
572     & 'ibi F_lh_max = ZERO! '
573     ENDIF
574     print '(A,4(1x,D24.15))',
575     & 'ibi FWsub, FWsubm*dT/rhoI ',
576     & FWsublim(I,J),
577     & FWsublim(I,J)*SEAICE_deltaTtherm/SEAICE_rhoICE
578 gforget 1.30 #endif /* SEAICE_CAP_SUBLIM */
579 mlosch 1.5 print '(A,4(1x,D24.15))',
580     & 'ibi F_ia, F_ia_net, F_c ',
581 jmc 1.25 & F_ia(I,J), F_ia_net, F_c(I,J)
582 mlosch 1.5 print '(A)','----------------------------------------'
583     ENDIF
584 jmc 1.2 #endif /* SEAICE_DEBUG */
585 jmc 1.6
586 mlosch 1.5 ENDIF !/* iceOrNot */
587     ENDDO !/* i */
588 jmc 1.1 ENDDO !/* j */
589    
590 jmc 1.19 #endif /* ALLOW_ATM_TEMP && ALLOW_DOWNWARD_RADIATION */
591     RETURN
592 jmc 1.1 END

  ViewVC Help
Powered by ViewVC 1.1.22