/[MITgcm]/MITgcm_contrib/torge/grease/code/seaice_growth.F
ViewVC logotype

Contents of /MITgcm_contrib/torge/grease/code/seaice_growth.F

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


Revision 1.1 - (show annotations) (download)
Thu Jan 16 23:37:42 2014 UTC (11 years, 6 months ago) by torge
Branch: MAIN
CVS Tags: HEAD
introducing a grease ice category
by making use of the seaice_tracer infrastructure

1 C $Header: /u/gcmpack/MITgcm/pkg/seaice/seaice_growth.F,v 1.194 2013/12/03 22:11:01 torge Exp $
2 C $Name: $
3
4 #include "SEAICE_OPTIONS.h"
5 #ifdef ALLOW_EXF
6 # include "EXF_OPTIONS.h"
7 #endif
8
9 CBOP
10 C !ROUTINE: SEAICE_GROWTH
11 C !INTERFACE:
12 SUBROUTINE SEAICE_GROWTH( myTime, myIter, myThid )
13 C !DESCRIPTION: \bv
14 C *==========================================================*
15 C | SUBROUTINE seaice_growth
16 C | o Updata ice thickness and snow depth
17 C *==========================================================*
18 C \ev
19
20 C !USES:
21 IMPLICIT NONE
22 C === Global variables ===
23 #include "SIZE.h"
24 #include "EEPARAMS.h"
25 #include "PARAMS.h"
26 #include "DYNVARS.h"
27 #include "GRID.h"
28 #include "FFIELDS.h"
29 #include "SEAICE_SIZE.h"
30 #include "SEAICE_PARAMS.h"
31 #include "SEAICE.h"
32 #include "SEAICE_TRACER.h"
33 #ifdef ALLOW_EXF
34 # include "EXF_PARAM.h"
35 # include "EXF_FIELDS.h"
36 #endif
37 #ifdef ALLOW_SALT_PLUME
38 # include "SALT_PLUME.h"
39 #endif
40 #ifdef ALLOW_AUTODIFF_TAMC
41 # include "tamc.h"
42 #endif
43
44 C !INPUT/OUTPUT PARAMETERS:
45 C === Routine arguments ===
46 C myTime :: Simulation time
47 C myIter :: Simulation timestep number
48 C myThid :: Thread no. that called this routine.
49 _RL myTime
50 INTEGER myIter, myThid
51 CEOP
52
53 #if (defined ALLOW_EXF) && (defined ALLOW_ATM_TEMP)
54 C !FUNCTIONS:
55 #ifdef ALLOW_DIAGNOSTICS
56 LOGICAL DIAGNOSTICS_IS_ON
57 EXTERNAL DIAGNOSTICS_IS_ON
58 #endif
59
60 C !LOCAL VARIABLES:
61 C === Local variables ===
62 C
63 C unit/sign convention:
64 C Within the thermodynamic computation all stocks, except HSNOW,
65 C are in 'effective ice meters' units, and >0 implies more ice.
66 C This holds for stocks due to ocean and atmosphere heat,
67 C at the outset of 'PART 2: determine heat fluxes/stocks'
68 C and until 'PART 7: determine ocean model forcing'
69 C This strategy minimizes the need for multiplications/divisions
70 C by ice fraction, heat capacity, etc. The only conversions that
71 C occurs are for the HSNOW (in effective snow meters) and
72 C PRECIP (fresh water m/s).
73 C
74 C HEFF is effective Hice thickness (m3/m2)
75 C HSNOW is Heffective snow thickness (m3/m2)
76 C HSALT is Heffective salt content (g/m2)
77 C AREA is the seaice cover fraction (0<=AREA<=1)
78 C Q denotes heat stocks -- converted to ice stocks (m3/m2) early on
79 C
80 C For all other stocks/increments, such as d_HEFFbyATMonOCN
81 C or a_QbyATM_cover, the naming convention is as follows:
82 C The prefix 'a_' means available, the prefix 'd_' means delta
83 C (i.e. increment), and the prefix 'r_' means residual.
84 C The suffix '_cover' denotes a value for the ice covered fraction
85 C of the grid cell, whereas '_open' is for the open water fraction.
86 C The main part of the name states what ice/snow stock is concerned
87 C (e.g. QbyATM or HEFF), and how it is affected (e.g. d_HEFFbyATMonOCN
88 C is the increment of HEFF due to the ATMosphere extracting heat from the
89 C OCeaN surface, or providing heat to the OCeaN surface).
90
91 C i,j,bi,bj :: Loop counters
92 INTEGER i, j, bi, bj
93 C number of surface interface layer
94 INTEGER kSurface
95 C IT :: ice thickness category index (MULTICATEGORIES and ITD code)
96 INTEGER IT
97 C msgBuf :: Informational/error message buffer
98 #ifdef ALLOW_BALANCE_FLUXES
99 CHARACTER*(MAX_LEN_MBUF) msgBuf
100 #elif (defined (SEAICE_DEBUG))
101 CHARACTER*(MAX_LEN_MBUF) msgBuf
102 CHARACTER*12 msgBufForm
103 #endif
104 C constants
105 _RL tempFrz, ICE2SNOW, SNOW2ICE
106 _RL QI, QS, recip_QI
107 _RL lhSublim
108
109 C conversion factors to go from Q (W/m2) to HEFF (ice meters)
110 _RL convertQ2HI, convertHI2Q
111 C conversion factors to go from precip (m/s) unit to HEFF (ice meters)
112 _RL convertPRECIP2HI, convertHI2PRECIP
113 C Factor by which we increase the upper ocean friction velocity (u*) when
114 C ice is absent in a grid cell (dimensionless)
115 _RL MixedLayerTurbulenceFactor
116
117 C wind speed square
118 _RL SPEED_SQ
119
120 C Regularization values squared
121 _RL area_reg_sq, hice_reg_sq
122 C pathological cases thresholds
123 _RL heffTooHeavy
124
125 C Helper variables: reciprocal of some constants
126 _RL recip_multDim
127 _RL recip_deltaTtherm
128 _RL recip_rhoIce
129 C local value (=1/HO or 1/HO_south)
130 _RL recip_HO
131 C local value (=1/ice thickness)
132 _RL recip_HH
133 #ifndef SEAICE_ITD
134 C facilitate multi-category snow implementation
135 _RL pFac, pFacSnow
136 #endif
137
138 C temporary variables available for the various computations
139 _RL tmpscal0, tmpscal1, tmpscal2, tmpscal3, tmpscal4
140 #ifdef SEAICE_ITD
141 _RL tmpscal1itd(1:sNx,1:sNy), tmpscal2itd(1:sNx,1:sNy)
142 _RL tmpscal3itd(1:sNx,1:sNy)
143 #endif
144
145 #ifdef ALLOW_SITRACER
146 INTEGER iTr
147 #ifdef ALLOW_DIAGNOSTICS
148 CHARACTER*8 diagName
149 #endif
150 #ifdef SEAICE_GREASE
151 INTEGER iTrGrease
152 _RL greaseDecayTime
153 _RL greaseNewFrazil
154 _RL THIRD, TWOTHIRDS
155 PARAMETER (THIRD = 1.0 _d 0 / 3.0 _d 0)
156 PARAMETER (TWOTHIRDS = 2.0 _d 0 / 3.0 _d 0)
157 #endif
158 #endif /* ALLOW_SITRACER */
159 #ifdef ALLOW_AUTODIFF_TAMC
160 INTEGER ilockey
161 #endif
162
163 C== local arrays ==
164 C-- TmixLoc :: ocean surface/mixed-layer temperature (in K)
165 _RL TmixLoc (1:sNx,1:sNy)
166
167 #ifndef SEAICE_ITD
168 C actual ice thickness (with upper and lower limit)
169 _RL heffActual (1:sNx,1:sNy)
170 C actual snow thickness
171 _RL hsnowActual (1:sNx,1:sNy)
172 #endif
173 C actual ice thickness (with lower limit only) Reciprocal
174 _RL recip_heffActual (1:sNx,1:sNy)
175
176 C AREA_PRE :: hold sea-ice fraction field before any seaice-thermo update
177 _RL AREApreTH (1:sNx,1:sNy)
178 _RL HEFFpreTH (1:sNx,1:sNy)
179 _RL HSNWpreTH (1:sNx,1:sNy)
180 #ifdef SEAICE_ITD
181 _RL AREAITDpreTH (1:sNx,1:sNy,1:nITD)
182 _RL HEFFITDpreTH (1:sNx,1:sNy,1:nITD)
183 _RL HSNWITDpreTH (1:sNx,1:sNy,1:nITD)
184 _RL areaFracFactor (1:sNx,1:sNy,1:nITD)
185 #endif
186
187 C wind speed
188 _RL UG (1:sNx,1:sNy)
189
190 C temporary variables available for the various computations
191 _RL tmparr1 (1:sNx,1:sNy)
192 #ifdef SEAICE_VARIABLE_SALINITY
193 _RL saltFluxAdjust (1:sNx,1:sNy)
194 #endif
195 #ifdef SEAICE_GREASE
196 _RL greaseLayerThick (1:sNx,1:sNy)
197 _RL d_AREAbyGREASE (1:sNx,1:sNy)
198 #endif
199 _RL ticeInMult (1:sNx,1:sNy,MULTDIM)
200 _RL ticeOutMult (1:sNx,1:sNy,MULTDIM)
201 _RL heffActualMult (1:sNx,1:sNy,MULTDIM)
202 _RL hsnowActualMult (1:sNx,1:sNy,MULTDIM)
203 #ifdef SEAICE_ITD
204 _RL recip_heffActualMult(1:sNx,1:sNy,MULTDIM)
205 #endif
206 _RL a_QbyATMmult_cover (1:sNx,1:sNy,MULTDIM)
207 _RL a_QSWbyATMmult_cover(1:sNx,1:sNy,MULTDIM)
208 _RL a_FWbySublimMult (1:sNx,1:sNy,MULTDIM)
209 #ifdef SEAICE_ITD
210 _RL r_QbyATMmult_cover (1:sNx,1:sNy,MULTDIM)
211 _RL r_FWbySublimMult (1:sNx,1:sNy,MULTDIM)
212 C for lateral melt parameterization:
213 _RL latMeltFrac (1:sNx,1:sNy,MULTDIM)
214 _RL latMeltRate (1:sNx,1:sNy,MULTDIM)
215 _RL floeAlpha
216 _RL floeDiameter
217 _RL floeDiameterMin
218 _RL floeDiameterMax
219 #endif
220
221 C a_QbyATM_cover :: available heat (in W/m^2) due to the interaction of
222 C the atmosphere and the ocean surface - for ice covered water
223 C a_QbyATM_open :: same but for open water
224 C r_QbyATM_cover :: residual of a_QbyATM_cover after freezing/melting processes
225 C r_QbyATM_open :: same but for open water
226 _RL a_QbyATM_cover (1:sNx,1:sNy)
227 _RL a_QbyATM_open (1:sNx,1:sNy)
228 _RL r_QbyATM_cover (1:sNx,1:sNy)
229 _RL r_QbyATM_open (1:sNx,1:sNy)
230 C a_QSWbyATM_open - short wave heat flux over ocean in W/m^2
231 C a_QSWbyATM_cover - short wave heat flux under ice in W/m^2
232 _RL a_QSWbyATM_open (1:sNx,1:sNy)
233 _RL a_QSWbyATM_cover (1:sNx,1:sNy)
234 C a_QbyOCN :: available heat (in W/m^2) due to the
235 C interaction of the ice pack and the ocean surface
236 C r_QbyOCN :: residual of a_QbyOCN after freezing/melting
237 C processes have been accounted for
238 _RL a_QbyOCN (1:sNx,1:sNy)
239 _RL r_QbyOCN (1:sNx,1:sNy)
240
241 C The change of mean ice thickness due to out-of-bounds values following
242 C sea ice dyhnamics
243 _RL d_HEFFbyNEG (1:sNx,1:sNy)
244
245 C The change of mean ice thickness due to turbulent ocean-sea ice heat fluxes
246 _RL d_HEFFbyOCNonICE (1:sNx,1:sNy)
247
248 C The sum of mean ice thickness increments due to atmospheric fluxes over
249 C the open water fraction and ice-covered fractions of the grid cell
250 _RL d_HEFFbyATMonOCN (1:sNx,1:sNy)
251 C The change of mean ice thickness due to flooding by snow
252 _RL d_HEFFbyFLOODING (1:sNx,1:sNy)
253
254 C The mean ice thickness increments due to atmospheric fluxes over the open
255 C water fraction and ice-covered fractions of the grid cell, respectively
256 _RL d_HEFFbyATMonOCN_open(1:sNx,1:sNy)
257 _RL d_HEFFbyATMonOCN_cover(1:sNx,1:sNy)
258
259 _RL d_HSNWbyNEG (1:sNx,1:sNy)
260 _RL d_HSNWbyATMonSNW (1:sNx,1:sNy)
261 _RL d_HSNWbyOCNonSNW (1:sNx,1:sNy)
262 _RL d_HSNWbyRAIN (1:sNx,1:sNy)
263
264 _RL d_HFRWbyRAIN (1:sNx,1:sNy)
265
266 C a_FWbySublim :: fresh water flux implied by latent heat of
267 C sublimation to atmosphere, same sign convention
268 C as EVAP (positive upward)
269 _RL a_FWbySublim (1:sNx,1:sNy)
270 _RL r_FWbySublim (1:sNx,1:sNy)
271 _RL d_HEFFbySublim (1:sNx,1:sNy)
272 _RL d_HSNWbySublim (1:sNx,1:sNy)
273
274 #ifdef SEAICE_CAP_SUBLIM
275 C The latent heat flux which will sublimate all snow and ice
276 C over one time step
277 _RL latentHeatFluxMax (1:sNx,1:sNy)
278 _RL latentHeatFluxMaxMult(1:sNx,1:sNy,MULTDIM)
279 #endif
280
281 #ifdef EXF_SEAICE_FRACTION
282 C ICE/SNOW stocks tendency associated with relaxation towards observation
283 _RL d_AREAbyRLX (1:sNx,1:sNy)
284 C The change of mean ice thickness due to relaxation
285 _RL d_HEFFbyRLX (1:sNx,1:sNy)
286 #endif
287
288 #ifdef SEAICE_ITD
289 _RL d_HEFFbySublim_ITD (1:sNx,1:sNy,1:nITD)
290 _RL d_HSNWbySublim_ITD (1:sNx,1:sNy,1:nITD)
291 _RL d_HEFFbyOCNonICE_ITD (1:sNx,1:sNy,1:nITD)
292 _RL d_HSNWbyATMonSNW_ITD (1:sNx,1:sNy,1:nITD)
293 _RL d_HEFFbyATMonOCN_ITD (1:sNx,1:sNy,1:nITD)
294 _RL d_HEFFbyATMonOCN_cover_ITD (1:sNx,1:sNy,1:nITD)
295 _RL d_HEFFbyATMonOCN_open_ITD (1:sNx,1:sNy,1:nITD)
296 _RL d_HSNWbyRAIN_ITD (1:sNx,1:sNy,1:nITD)
297 _RL d_HSNWbyOCNonSNW_ITD (1:sNx,1:sNy,1:nITD)
298 _RL d_HEFFbyFLOODING_ITD (1:sNx,1:sNy,1:nITD)
299 #endif
300
301 #ifdef ALLOW_DIAGNOSTICS
302 C ICE/SNOW stocks tendencies associated with the various melt/freeze processes
303 _RL d_AREAbyATM (1:sNx,1:sNy)
304 _RL d_AREAbyOCN (1:sNx,1:sNy)
305 _RL d_AREAbyICE (1:sNx,1:sNy)
306 C Helper variables for diagnostics
307 _RL DIAGarrayA (1:sNx,1:sNy)
308 _RL DIAGarrayB (1:sNx,1:sNy)
309 _RL DIAGarrayC (1:sNx,1:sNy)
310 _RL DIAGarrayD (1:sNx,1:sNy)
311 #endif /* ALLOW_DIAGNOSTICS */
312
313 _RL SItflux (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
314 _RL SIatmQnt (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
315 _RL SIatmFW (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
316 #ifdef ALLOW_BALANCE_FLUXES
317 _RL FWFsiTile(nSx,nSy)
318 _RL FWFsiGlob
319 _RL HFsiTile(nSx,nSy)
320 _RL HFsiGlob
321 _RL FWF2HFsiTile(nSx,nSy)
322 _RL FWF2HFsiGlob
323 #endif
324
325 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
326
327 C ===================================================================
328 C =================PART 0: constants and initializations=============
329 C ===================================================================
330
331 IF ( buoyancyRelation .EQ. 'OCEANICP' ) THEN
332 kSurface = Nr
333 ELSE
334 kSurface = 1
335 ENDIF
336
337 C avoid unnecessary divisions in loops
338 recip_multDim = SEAICE_multDim
339 recip_multDim = ONE / recip_multDim
340 C above/below: double/single precision calculation of recip_multDim
341 c recip_multDim = 1./float(SEAICE_multDim)
342 recip_deltaTtherm = ONE / SEAICE_deltaTtherm
343 recip_rhoIce = ONE / SEAICE_rhoIce
344
345 C Cutoff for iceload
346 heffTooHeavy=drF(kSurface) / 5. _d 0
347
348 C RATIO OF SEA ICE DENSITY to SNOW DENSITY
349 ICE2SNOW = SEAICE_rhoIce/SEAICE_rhoSnow
350 SNOW2ICE = ONE / ICE2SNOW
351
352 C HEAT OF FUSION OF ICE (J/m^3)
353 QI = SEAICE_rhoIce*SEAICE_lhFusion
354 recip_QI = ONE / QI
355 C HEAT OF FUSION OF SNOW (J/m^3)
356 QS = SEAICE_rhoSnow*SEAICE_lhFusion
357
358 C ICE LATENT HEAT CONSTANT
359 lhSublim = SEAICE_lhEvap + SEAICE_lhFusion
360
361 C regularization constants
362 area_reg_sq = SEAICE_area_reg * SEAICE_area_reg
363 hice_reg_sq = SEAICE_hice_reg * SEAICE_hice_reg
364
365 C conversion factors to go from Q (W/m2) to HEFF (ice meters)
366 convertQ2HI=SEAICE_deltaTtherm/QI
367 convertHI2Q = ONE/convertQ2HI
368 C conversion factors to go from precip (m/s) unit to HEFF (ice meters)
369 convertPRECIP2HI=SEAICE_deltaTtherm*rhoConstFresh/SEAICE_rhoIce
370 convertHI2PRECIP = ONE/convertPRECIP2HI
371 #ifdef SEAICE_ITD
372 C constants for lateral melt parameterization:
373 C following Steele (1992), Equ. 2
374 floeAlpha = 0.66 _d 0
375 C typical mean diameter used in CICE 4.1:
376 C (this is currently computed as a function of ice concentration
377 C following a suggestion by Luepkes at al. (2012))
378 C floeDiameter = 300. _d 0
379 C parameters needed for variable floe diameter following Luepkes et al. (2012):
380 floeDiameterMin = 8. _d 0
381 floeDiameterMax = 300. _d 0
382 #endif
383
384 DO bj=myByLo(myThid),myByHi(myThid)
385 DO bi=myBxLo(myThid),myBxHi(myThid)
386
387 #ifdef ALLOW_AUTODIFF_TAMC
388 act1 = bi - myBxLo(myThid)
389 max1 = myBxHi(myThid) - myBxLo(myThid) + 1
390 act2 = bj - myByLo(myThid)
391 max2 = myByHi(myThid) - myByLo(myThid) + 1
392 act3 = myThid - 1
393 max3 = nTx*nTy
394 act4 = ikey_dynamics - 1
395 iicekey = (act1 + 1) + act2*max1
396 & + act3*max1*max2
397 & + act4*max1*max2*max3
398 #endif /* ALLOW_AUTODIFF_TAMC */
399
400 #ifdef SEAICE_GREASE
401 C time scale of grease ice decline by solidification,
402 C with 50% grease ice becoming solid pancake ice within 1 day:
403 greaseDecayTime=1.44*86400. _d 0
404 C memorize 'grease' tracer location in tracer array:
405 iTrGrease=-1
406 DO iTr = 1, SItrNumInUse
407 if (SItrName(iTr).EQ.'grease') iTrGrease=iTr
408 ENDDO
409 #endif
410
411 C array initializations
412 C =====================
413
414 DO J=1,sNy
415 DO I=1,sNx
416 a_QbyATM_cover (I,J) = 0.0 _d 0
417 a_QbyATM_open(I,J) = 0.0 _d 0
418 r_QbyATM_cover (I,J) = 0.0 _d 0
419 r_QbyATM_open (I,J) = 0.0 _d 0
420
421 a_QSWbyATM_open (I,J) = 0.0 _d 0
422 a_QSWbyATM_cover (I,J) = 0.0 _d 0
423
424 a_QbyOCN (I,J) = 0.0 _d 0
425 r_QbyOCN (I,J) = 0.0 _d 0
426
427 #ifdef ALLOW_DIAGNOSTICS
428 d_AREAbyATM(I,J) = 0.0 _d 0
429 d_AREAbyICE(I,J) = 0.0 _d 0
430 d_AREAbyOCN(I,J) = 0.0 _d 0
431 #endif
432
433 #ifdef EXF_SEAICE_FRACTION
434 d_AREAbyRLX(I,J) = 0.0 _d 0
435 d_HEFFbyRLX(I,J) = 0.0 _d 0
436 #endif
437
438 d_HEFFbyNEG(I,J) = 0.0 _d 0
439 d_HEFFbyOCNonICE(I,J) = 0.0 _d 0
440 d_HEFFbyATMonOCN(I,J) = 0.0 _d 0
441 d_HEFFbyFLOODING(I,J) = 0.0 _d 0
442
443 d_HEFFbyATMonOCN_open(I,J) = 0.0 _d 0
444 d_HEFFbyATMonOCN_cover(I,J) = 0.0 _d 0
445
446 d_HSNWbyNEG(I,J) = 0.0 _d 0
447 d_HSNWbyATMonSNW(I,J) = 0.0 _d 0
448 d_HSNWbyOCNonSNW(I,J) = 0.0 _d 0
449 d_HSNWbyRAIN(I,J) = 0.0 _d 0
450 a_FWbySublim(I,J) = 0.0 _d 0
451 r_FWbySublim(I,J) = 0.0 _d 0
452 d_HEFFbySublim(I,J) = 0.0 _d 0
453 d_HSNWbySublim(I,J) = 0.0 _d 0
454 #ifdef SEAICE_CAP_SUBLIM
455 latentHeatFluxMax(I,J) = 0.0 _d 0
456 #endif
457 d_HFRWbyRAIN(I,J) = 0.0 _d 0
458 tmparr1(I,J) = 0.0 _d 0
459 #ifdef SEAICE_VARIABLE_SALINITY
460 saltFluxAdjust(I,J) = 0.0 _d 0
461 #endif
462 #ifdef SEAICE_GREASE
463 greaseLayerThick(I,J) = 0.0 _d 0
464 d_AREAbyGREASE(I,J) = 0.0 _d 0
465 #endif
466 DO IT=1,SEAICE_multDim
467 ticeInMult(I,J,IT) = 0.0 _d 0
468 ticeOutMult(I,J,IT) = 0.0 _d 0
469 a_QbyATMmult_cover(I,J,IT) = 0.0 _d 0
470 a_QSWbyATMmult_cover(I,J,IT) = 0.0 _d 0
471 a_FWbySublimMult(I,J,IT) = 0.0 _d 0
472 #ifdef SEAICE_CAP_SUBLIM
473 latentHeatFluxMaxMult(I,J,IT) = 0.0 _d 0
474 #endif
475 #ifdef SEAICE_ITD
476 d_HEFFbySublim_ITD(I,J,IT) = 0.0 _d 0
477 d_HSNWbySublim_ITD(I,J,IT) = 0.0 _d 0
478 d_HEFFbyOCNonICE_ITD(I,J,IT) = 0.0 _d 0
479 d_HSNWbyATMonSNW_ITD(I,J,IT) = 0.0 _d 0
480 d_HEFFbyATMonOCN_ITD(I,J,IT) = 0.0 _d 0
481 d_HEFFbyATMonOCN_cover_ITD(I,J,IT) = 0.0 _d 0
482 d_HEFFbyATMonOCN_open_ITD(I,J,IT) = 0.0 _d 0
483 d_HSNWbyRAIN_ITD(I,J,IT) = 0.0 _d 0
484 d_HSNWbyOCNonSNW_ITD(I,J,IT) = 0.0 _d 0
485 d_HEFFbyFLOODING_ITD(I,J,IT) = 0.0 _d 0
486 r_QbyATMmult_cover(I,J,IT) = 0.0 _d 0
487 r_FWbySublimMult(I,J,IT) = 0.0 _d 0
488 C for lateral melt parameterization:
489 latMeltFrac(I,J,IT) = 0.0 _d 0
490 latMeltRate(I,J,IT) = 0.0 _d 0
491 #endif
492 ENDDO
493 ENDDO
494 ENDDO
495 #if (defined (ALLOW_MEAN_SFLUX_COST_CONTRIBUTION) || defined (ALLOW_SSH_GLOBMEAN_COST_CONTRIBUTION))
496 DO J=1-oLy,sNy+oLy
497 DO I=1-oLx,sNx+oLx
498 frWtrAtm(I,J,bi,bj) = 0.0 _d 0
499 ENDDO
500 ENDDO
501 #endif
502
503 C =====================================================================
504 C ===========PART 1: treat pathological cases (post advdiff)===========
505 C =====================================================================
506
507 #if (defined ALLOW_AUTODIFF_TAMC && defined SEAICE_MODIFY_GROWTH_ADJ)
508 Cgf no dependency through pathological cases treatment
509 IF ( SEAICEadjMODE.EQ.0 ) THEN
510 #endif
511
512 #ifdef EXF_SEAICE_FRACTION
513 CADJ STORE heff(:,:,bi,bj) = comlev1_bibj, key = iicekey,byte=isbyte
514 CADJ STORE area(:,:,bi,bj) = comlev1_bibj, key = iicekey,byte=isbyte
515 C 0) relax sea ice concentration towards observation
516 IF ( SEAICE_tauAreaObsRelax .GT. zeroRL ) THEN
517 DO J=1,sNy
518 DO I=1,sNx
519 C d_AREAbyRLX(i,j) = 0. _d 0
520 C d_HEFFbyRLX(i,j) = 0. _d 0
521 IF ( exf_iceFraction(I,J,bi,bj).GT.AREA(I,J,bi,bj) ) THEN
522 d_AREAbyRLX(i,j) =
523 & SEAICE_deltaTtherm/SEAICE_tauAreaObsRelax
524 & * (exf_iceFraction(I,J,bi,bj) - AREA(I,J,bi,bj))
525 ENDIF
526 IF ( exf_iceFraction(I,J,bi,bj).GT.zeroRS .AND.
527 & AREA(I,J,bi,bj).EQ.0. _d 0) THEN
528 C d_HEFFbyRLX(i,j) = 1. _d 1 * siEps * d_AREAbyRLX(i,j)
529 d_HEFFbyRLX(i,j) = 1. _d 1 * siEps
530 ENDIF
531 #ifdef SEAICE_ITD
532 AREAITD(I,J,1,bi,bj) = AREAITD(I,J,1,bi,bj)
533 & + d_AREAbyRLX(i,j)
534 HEFFITD(I,J,1,bi,bj) = HEFFITD(I,J,1,bi,bj)
535 & + d_HEFFbyRLX(i,j)
536 #endif
537 AREA(I,J,bi,bj) = AREA(I,J,bi,bj) + d_AREAbyRLX(i,j)
538 HEFF(I,J,bi,bj) = HEFF(I,J,bi,bj) + d_HEFFbyRLX(i,j)
539 ENDDO
540 ENDDO
541 ENDIF
542 #endif /* EXF_SEAICE_FRACTION */
543
544 C 1) treat the case of negative values:
545
546 #ifdef ALLOW_AUTODIFF_TAMC
547 CADJ STORE heff(:,:,bi,bj) = comlev1_bibj, key = iicekey,byte=isbyte
548 CADJ STORE hsnow(:,:,bi,bj) = comlev1_bibj, key = iicekey,byte=isbyte
549 CADJ STORE area(:,:,bi,bj) = comlev1_bibj, key = iicekey,byte=isbyte
550 #endif /* ALLOW_AUTODIFF_TAMC */
551 #ifdef SEAICE_ITD
552 DO IT=1,nITD
553 #endif
554 DO J=1,sNy
555 DO I=1,sNx
556 #ifdef SEAICE_ITD
557 tmpscal2=0. _d 0
558 tmpscal3=0. _d 0
559 tmpscal2=MAX(-HEFFITD(I,J,IT,bi,bj),0. _d 0)
560 HEFFITD(I,J,IT,bi,bj)=HEFFITD(I,J,IT,bi,bj)+tmpscal2
561 d_HEFFbyNEG(I,J)=d_HEFFbyNEG(I,J)+tmpscal2
562 tmpscal3=MAX(-HSNOWITD(I,J,IT,bi,bj),0. _d 0)
563 HSNOWITD(I,J,IT,bi,bj)=HSNOWITD(I,J,IT,bi,bj)+tmpscal3
564 d_HSNWbyNEG(I,J)=d_HSNWbyNEG(I,J)+tmpscal3
565 AREAITD(I,J,IT,bi,bj)=MAX(AREAITD(I,J,IT,bi,bj),0. _d 0)
566 C AREA, HEFF, and HSNOW will be updated at end of PART 1
567 C by calling SEAICE_ITD_SUM
568 #else
569 d_HEFFbyNEG(I,J)=MAX(-HEFF(I,J,bi,bj),0. _d 0)
570 HEFF(I,J,bi,bj)=HEFF(I,J,bi,bj)+d_HEFFbyNEG(I,J)
571 d_HSNWbyNEG(I,J)=MAX(-HSNOW(I,J,bi,bj),0. _d 0)
572 HSNOW(I,J,bi,bj)=HSNOW(I,J,bi,bj)+d_HSNWbyNEG(I,J)
573 AREA(I,J,bi,bj)=MAX(AREA(I,J,bi,bj),0. _d 0)
574 #endif
575 ENDDO
576 ENDDO
577 #ifdef SEAICE_ITD
578 ENDDO
579 #endif
580
581 C 1.25) treat the case of very thin ice:
582
583 #ifdef ALLOW_AUTODIFF_TAMC
584 CADJ STORE heff(:,:,bi,bj) = comlev1_bibj, key = iicekey,byte=isbyte
585 #endif /* ALLOW_AUTODIFF_TAMC */
586 #ifdef SEAICE_ITD
587 DO IT=1,nITD
588 #endif
589 DO J=1,sNy
590 DO I=1,sNx
591 tmpscal2=0. _d 0
592 tmpscal3=0. _d 0
593 #ifdef SEAICE_ITD
594 IF (HEFFITD(I,J,IT,bi,bj).LE.siEps) THEN
595 tmpscal2=-HEFFITD(I,J,IT,bi,bj)
596 tmpscal3=-HSNOWITD(I,J,IT,bi,bj)
597 TICES(I,J,IT,bi,bj)=celsius2K
598 C TICE will be updated at end of Part 1 together with AREA and HEFF
599 ENDIF
600 HEFFITD(I,J,IT,bi,bj) =HEFFITD(I,J,IT,bi,bj) +tmpscal2
601 HSNOWITD(I,J,IT,bi,bj)=HSNOWITD(I,J,IT,bi,bj)+tmpscal3
602 #else
603 IF (HEFF(I,J,bi,bj).LE.siEps) THEN
604 tmpscal2=-HEFF(I,J,bi,bj)
605 tmpscal3=-HSNOW(I,J,bi,bj)
606 TICE(I,J,bi,bj)=celsius2K
607 DO IT=1,SEAICE_multDim
608 TICES(I,J,IT,bi,bj)=celsius2K
609 ENDDO
610 ENDIF
611 HEFF(I,J,bi,bj)=HEFF(I,J,bi,bj)+tmpscal2
612 HSNOW(I,J,bi,bj)=HSNOW(I,J,bi,bj)+tmpscal3
613 #endif
614 d_HEFFbyNEG(I,J)=d_HEFFbyNEG(I,J)+tmpscal2
615 d_HSNWbyNEG(I,J)=d_HSNWbyNEG(I,J)+tmpscal3
616 ENDDO
617 ENDDO
618 #ifdef SEAICE_ITD
619 ENDDO
620 #endif
621
622 C 1.5) treat the case of area but no ice/snow:
623
624 #ifdef ALLOW_AUTODIFF_TAMC
625 CADJ STORE heff(:,:,bi,bj) = comlev1_bibj, key = iicekey,byte=isbyte
626 CADJ STORE hsnow(:,:,bi,bj) = comlev1_bibj, key = iicekey,byte=isbyte
627 #endif /* ALLOW_AUTODIFF_TAMC */
628 #ifdef SEAICE_ITD
629 DO IT=1,nITD
630 #endif
631 DO J=1,sNy
632 DO I=1,sNx
633 #ifdef SEAICE_ITD
634 IF ((HEFFITD(I,J,IT,bi,bj).EQ.0. _d 0).AND.
635 & (HSNOWITD(I,J,IT,bi,bj).EQ.0. _d 0))
636 & AREAITD(I,J,IT,bi,bj)=0. _d 0
637 #else
638 IF ((HEFF(i,j,bi,bj).EQ.0. _d 0).AND.
639 & (HSNOW(i,j,bi,bj).EQ.0. _d 0)) AREA(I,J,bi,bj)=0. _d 0
640 #endif
641 ENDDO
642 ENDDO
643 #ifdef SEAICE_ITD
644 ENDDO
645 #endif
646
647 C 2) treat the case of very small area:
648
649 #ifndef DISABLE_AREA_FLOOR
650 #ifdef ALLOW_AUTODIFF_TAMC
651 CADJ STORE area(:,:,bi,bj) = comlev1_bibj, key = iicekey,byte=isbyte
652 #endif /* ALLOW_AUTODIFF_TAMC */
653 #ifdef SEAICE_ITD
654 DO IT=1,nITD
655 #endif
656 DO J=1,sNy
657 DO I=1,sNx
658 #ifdef SEAICE_ITD
659 IF ((HEFFITD(I,J,IT,bi,bj).GT.0).OR.
660 & (HSNOWITD(I,J,IT,bi,bj).GT.0)) THEN
661 C SEAICE_area_floor*nITD cannot be allowed to exceed 1
662 C hence use SEAICE_area_floor devided by nITD
663 C (or install a warning in e.g. seaice_readparms.F)
664 AREAITD(I,J,IT,bi,bj)=
665 & MAX(AREAITD(I,J,IT,bi,bj),SEAICE_area_floor/float(nITD))
666 ENDIF
667 #else
668 IF ((HEFF(i,j,bi,bj).GT.0).OR.(HSNOW(i,j,bi,bj).GT.0)) THEN
669 AREA(I,J,bi,bj)=MAX(AREA(I,J,bi,bj),SEAICE_area_floor)
670 ENDIF
671 #endif
672 ENDDO
673 ENDDO
674 #ifdef SEAICE_ITD
675 ENDDO
676 #endif
677 #endif /* DISABLE_AREA_FLOOR */
678
679 C 2.5) treat case of excessive ice cover, e.g., due to ridging:
680
681 C for SEAICE_ITD this case is treated in SEAICE_ITD_REDIST,
682 C which is called at end of PART 1 below
683 #ifndef SEAICE_ITD
684 #ifdef ALLOW_AUTODIFF_TAMC
685 CADJ STORE area(:,:,bi,bj) = comlev1_bibj, key = iicekey,byte=isbyte
686 #endif /* ALLOW_AUTODIFF_TAMC */
687 DO J=1,sNy
688 DO I=1,sNx
689 #ifdef ALLOW_DIAGNOSTICS
690 DIAGarrayA(I,J) = AREA(I,J,bi,bj)
691 #endif
692 #ifdef ALLOW_SITRACER
693 SItrAREA(I,J,bi,bj,1)=AREA(I,J,bi,bj)
694 #endif
695 AREA(I,J,bi,bj)=MIN(AREA(I,J,bi,bj),SEAICE_area_max)
696 ENDDO
697 ENDDO
698 #endif /* notSEAICE_ITD */
699
700 #ifdef SEAICE_ITD
701 C catch up with items 1.25 and 2.5 involving category sums AREA and HEFF
702 DO IT=1,nITD
703 DO J=1,sNy
704 DO I=1,sNx
705 C TICES was changed above (item 1.25), now update TICE as ice volume
706 C weighted average of TICES
707 C also compute total of AREAITD (needed for finishing item 2.5, see below)
708 IF (IT .eq. 1) THEN
709 tmpscal1itd(i,j) = 0. _d 0
710 tmpscal2itd(i,j) = 0. _d 0
711 tmpscal3itd(i,j) = 0. _d 0
712 ENDIF
713 tmpscal1itd(i,j)=tmpscal1itd(i,j) + TICES(I,J,IT,bi,bj)
714 & * HEFFITD(I,J,IT,bi,bj)
715 tmpscal2itd(i,j)=tmpscal2itd(i,j) + HEFFITD(I,J,IT,bi,bj)
716 tmpscal3itd(i,j)=tmpscal3itd(i,j) + AREAITD(I,J,IT,bi,bj)
717 IF (IT .eq. nITD) THEN
718 IF ( tmpscal2itd(i,j).GT.zeroRL ) THEN
719 TICE(I,J,bi,bj)=tmpscal1itd(i,j)/tmpscal2itd(i,j)
720 ELSE
721 TICE(I,J,bi,bj)=celsius2K
722 ENDIF
723 C lines of item 2.5 that were omitted:
724 C in 2.5 these lines are executed before "ridging" is applied to AREA
725 C hence we execute them here before SEAICE_ITD_REDIST is called
726 C although this means that AREA has not been completely regularized
727 #ifdef ALLOW_DIAGNOSTICS
728 DIAGarrayA(I,J) = tmpscal3itd(i,j)
729 #endif
730 #ifdef ALLOW_SITRACER
731 SItrAREA(I,J,bi,bj,1)=tmpscal3itd(i,j)
732 #endif
733 ENDIF
734 ENDDO
735 ENDDO
736 ENDDO
737
738 C finally make sure that all categories meet their thickness limits
739 C which includes ridging as in item 2.5
740 C and update AREA, HEFF, and HSNOW
741 CALL SEAICE_ITD_REDIST(bi, bj, myTime, myIter, myThid)
742 CALL SEAICE_ITD_SUM(bi, bj, myTime, myIter, myThid)
743 #endif /* SEAICE_ITD */
744
745 #if (defined ALLOW_AUTODIFF_TAMC && defined SEAICE_MODIFY_GROWTH_ADJ)
746 C end SEAICEadjMODE.EQ.0 statement:
747 ENDIF
748 #endif
749
750 C 3) store regularized values of heff, hsnow, area at the onset of thermo.
751 DO J=1,sNy
752 DO I=1,sNx
753 HEFFpreTH(I,J)=HEFF(I,J,bi,bj)
754 HSNWpreTH(I,J)=HSNOW(I,J,bi,bj)
755 AREApreTH(I,J)=AREA(I,J,bi,bj)
756 #ifdef ALLOW_DIAGNOSTICS
757 DIAGarrayB(I,J) = AREA(I,J,bi,bj)
758 DIAGarrayC(I,J) = HEFF(I,J,bi,bj)
759 DIAGarrayD(I,J) = HSNOW(I,J,bi,bj)
760 #endif
761 #ifdef ALLOW_SITRACER
762 SItrHEFF(I,J,bi,bj,1)=HEFF(I,J,bi,bj)
763 SItrAREA(I,J,bi,bj,2)=AREA(I,J,bi,bj)
764 #endif
765 ENDDO
766 ENDDO
767 #ifdef SEAICE_ITD
768 DO IT=1,nITD
769 DO J=1,sNy
770 DO I=1,sNx
771 HEFFITDpreTH(I,J,IT)=HEFFITD(I,J,IT,bi,bj)
772 HSNWITDpreTH(I,J,IT)=HSNOWITD(I,J,IT,bi,bj)
773 AREAITDpreTH(I,J,IT)=AREAITD(I,J,IT,bi,bj)
774
775 C memorize areal and volume fraction of each ITD category
776 IF (AREA(I,J,bi,bj) .GT. ZERO) THEN
777 areaFracFactor(I,J,IT)=AREAITD(I,J,IT,bi,bj)/AREA(I,J,bi,bj)
778 ELSE
779 C if there is no ice, potential growth starts in 1st category
780 IF (IT .EQ. 1) THEN
781 areaFracFactor(I,J,IT)=ONE
782 ELSE
783 areaFracFactor(I,J,IT)=ZERO
784 ENDIF
785 ENDIF
786 ENDDO
787 ENDDO
788 ENDDO
789 #ifdef ALLOW_SITRACER
790 C prepare SItrHEFF to be computed as cumulative sum
791 DO iTr=2,5
792 DO J=1,sNy
793 DO I=1,sNx
794 SItrHEFF(I,J,bi,bj,iTr)=ZERO
795 ENDDO
796 ENDDO
797 ENDDO
798 C prepare SItrAREA to be computed as cumulative sum
799 DO J=1,sNy
800 DO I=1,sNx
801 SItrAREA(I,J,bi,bj,3)=ZERO
802 ENDDO
803 ENDDO
804 #endif
805 #endif /* SEAICE_ITD */
806
807 C 4) treat sea ice salinity pathological cases
808 #ifdef SEAICE_VARIABLE_SALINITY
809 #ifdef ALLOW_AUTODIFF_TAMC
810 CADJ STORE hsalt(:,:,bi,bj) = comlev1_bibj, key = iicekey,byte=isbyte
811 CADJ STORE heff(:,:,bi,bj) = comlev1_bibj, key = iicekey,byte=isbyte
812 #endif /* ALLOW_AUTODIFF_TAMC */
813 DO J=1,sNy
814 DO I=1,sNx
815 IF ( (HSALT(I,J,bi,bj) .LT. 0.0).OR.
816 & (HEFF(I,J,bi,bj) .EQ. 0.0) ) THEN
817 saltFluxAdjust(I,J) = - HEFFM(I,J,bi,bj) *
818 & HSALT(I,J,bi,bj) * recip_deltaTtherm
819 HSALT(I,J,bi,bj) = 0.0 _d 0
820 ENDIF
821 ENDDO
822 ENDDO
823 #endif /* SEAICE_VARIABLE_SALINITY */
824
825 #ifdef ALLOW_DIAGNOSTICS
826 IF ( useDiagnostics ) THEN
827 CALL DIAGNOSTICS_FILL(DIAGarrayA,'SIareaPR',0,1,3,bi,bj,myThid)
828 CALL DIAGNOSTICS_FILL(DIAGarrayB,'SIareaPT',0,1,3,bi,bj,myThid)
829 CALL DIAGNOSTICS_FILL(DIAGarrayC,'SIheffPT',0,1,3,bi,bj,myThid)
830 CALL DIAGNOSTICS_FILL(DIAGarrayD,'SIhsnoPT',0,1,3,bi,bj,myThid)
831 #ifdef ALLOW_SITRACER
832 DO iTr = 1, SItrNumInUse
833 WRITE(diagName,'(A4,I2.2,A2)') 'SItr',iTr,'PT'
834 IF (SItrMate(iTr).EQ.'HEFF') THEN
835 CALL DIAGNOSTICS_FRACT_FILL(
836 I SItracer(1-OLx,1-OLy,bi,bj,iTr),HEFF(1-OLx,1-OLy,bi,bj),
837 I ONE, 1, diagName,0,1,2,bi,bj,myThid )
838 ELSE
839 CALL DIAGNOSTICS_FRACT_FILL(
840 I SItracer(1-OLx,1-OLy,bi,bj,iTr),AREA(1-OLx,1-OLy,bi,bj),
841 I ONE, 1, diagName,0,1,2,bi,bj,myThid )
842 ENDIF
843 ENDDO
844 #endif /* ALLOW_SITRACER */
845 ENDIF
846 #endif /* ALLOW_DIAGNOSTICS */
847
848 #if (defined ALLOW_AUTODIFF_TAMC && defined SEAICE_MODIFY_GROWTH_ADJ)
849 Cgf no additional dependency of air-sea fluxes to ice
850 IF ( SEAICEadjMODE.GE.1 ) THEN
851 DO J=1,sNy
852 DO I=1,sNx
853 HEFFpreTH(I,J) = 0. _d 0
854 HSNWpreTH(I,J) = 0. _d 0
855 AREApreTH(I,J) = 0. _d 0
856 ENDDO
857 ENDDO
858 #ifdef SEAICE_ITD
859 DO IT=1,nITD
860 DO J=1,sNy
861 DO I=1,sNx
862 HEFFITDpreTH(I,J,IT) = 0. _d 0
863 HSNWITDpreTH(I,J,IT) = 0. _d 0
864 AREAITDpreTH(I,J,IT) = 0. _d 0
865 ENDDO
866 ENDDO
867 ENDDO
868 #endif
869 ENDIF
870 #endif
871
872 #if (defined (ALLOW_MEAN_SFLUX_COST_CONTRIBUTION) || defined (ALLOW_SSH_GLOBMEAN_COST_CONTRIBUTION))
873 DO J=1,sNy
874 DO I=1,sNx
875 AREAforAtmFW(I,J,bi,bj) = AREApreTH(I,J)
876 ENDDO
877 ENDDO
878 #endif
879
880 C 4) COMPUTE ACTUAL ICE/SNOW THICKNESS; USE MIN/MAX VALUES
881 C TO REGULARIZE SEAICE_SOLVE4TEMP/d_AREA COMPUTATIONS
882
883 #ifdef ALLOW_AUTODIFF_TAMC
884 CADJ STORE AREApreTH = comlev1_bibj, key = iicekey, byte = isbyte
885 CADJ STORE HEFFpreTH = comlev1_bibj, key = iicekey, byte = isbyte
886 CADJ STORE HSNWpreTH = comlev1_bibj, key = iicekey, byte = isbyte
887 #endif /* ALLOW_AUTODIFF_TAMC */
888 #ifdef SEAICE_ITD
889 DO IT=1,nITD
890 #endif
891 DO J=1,sNy
892 DO I=1,sNx
893
894 #ifdef SEAICE_ITD
895 IF (HEFFITDpreTH(I,J,IT) .GT. ZERO) THEN
896 Cif regularize AREA with SEAICE_area_reg
897 tmpscal1 = SQRT(AREAITDpreTH(I,J,IT) * AREAITDpreTH(I,J,IT)
898 & + area_reg_sq)
899 Cif heffActual calculated with the regularized AREA
900 tmpscal2 = HEFFITDpreTH(I,J,IT) / tmpscal1
901 Cif regularize heffActual with SEAICE_hice_reg (add lower bound)
902 heffActualMult(I,J,IT) = SQRT(tmpscal2 * tmpscal2
903 & + hice_reg_sq)
904 Cif hsnowActual calculated with the regularized AREA
905 hsnowActualMult(I,J,IT) = HSNWITDpreTH(I,J,IT) / tmpscal1
906 Cif regularize the inverse of heffActual by hice_reg
907 recip_heffActualMult(I,J,IT) = AREAITDpreTH(I,J,IT) /
908 & sqrt(HEFFITDpreTH(I,J,IT) * HEFFITDpreTH(I,J,IT)
909 & + hice_reg_sq)
910 Cif Do not regularize when HEFFpreTH = 0
911 ELSE
912 heffActualMult(I,J,IT) = ZERO
913 hsnowActualMult(I,J,IT) = ZERO
914 recip_heffActualMult(I,J,IT) = ZERO
915 ENDIF
916 #else /* SEAICE_ITD */
917 IF (HEFFpreTH(I,J) .GT. ZERO) THEN
918 Cif regularize AREA with SEAICE_area_reg
919 tmpscal1 = SQRT(AREApreTH(I,J)* AREApreTH(I,J) + area_reg_sq)
920 Cif heffActual calculated with the regularized AREA
921 tmpscal2 = HEFFpreTH(I,J) / tmpscal1
922 Cif regularize heffActual with SEAICE_hice_reg (add lower bound)
923 heffActual(I,J) = SQRT(tmpscal2 * tmpscal2 + hice_reg_sq)
924 Cif hsnowActual calculated with the regularized AREA
925 hsnowActual(I,J) = HSNWpreTH(I,J) / tmpscal1
926 Cif regularize the inverse of heffActual by hice_reg
927 recip_heffActual(I,J) = AREApreTH(I,J) /
928 & sqrt(HEFFpreTH(I,J)*HEFFpreTH(I,J) + hice_reg_sq)
929 Cif Do not regularize when HEFFpreTH = 0
930 ELSE
931 heffActual(I,J) = ZERO
932 hsnowActual(I,J) = ZERO
933 recip_heffActual(I,J) = ZERO
934 ENDIF
935 #endif /* SEAICE_ITD */
936
937 ENDDO
938 ENDDO
939 #ifdef SEAICE_ITD
940 ENDDO
941 #endif
942
943 #if (defined ALLOW_AUTODIFF_TAMC && defined SEAICE_MODIFY_GROWTH_ADJ)
944 CALL ZERO_ADJ_1D( sNx*sNy, heffActual, myThid)
945 CALL ZERO_ADJ_1D( sNx*sNy, hsnowActual, myThid)
946 CALL ZERO_ADJ_1D( sNx*sNy, recip_heffActual, myThid)
947 #endif
948
949 #ifdef SEAICE_CAP_SUBLIM
950 C 5) COMPUTE MAXIMUM LATENT HEAT FLUXES FOR THE CURRENT ICE
951 C AND SNOW THICKNESS
952 #ifdef SEAICE_ITD
953 DO IT=1,nITD
954 #endif
955 DO J=1,sNy
956 DO I=1,sNx
957 C The latent heat flux over the sea ice which
958 C will sublimate all of the snow and ice over one time
959 C step (W/m^2)
960 #ifdef SEAICE_ITD
961 IF (HEFFITDpreTH(I,J,IT) .GT. ZERO) THEN
962 latentHeatFluxMaxMult(I,J,IT) = lhSublim*recip_deltaTtherm *
963 & (HEFFITDpreTH(I,J,IT)*SEAICE_rhoIce +
964 & HSNWITDpreTH(I,J,IT)*SEAICE_rhoSnow)
965 & /AREAITDpreTH(I,J,IT)
966 ELSE
967 latentHeatFluxMaxMult(I,J,IT) = ZERO
968 ENDIF
969 #else
970 IF (HEFFpreTH(I,J) .GT. ZERO) THEN
971 latentHeatFluxMax(I,J) = lhSublim * recip_deltaTtherm *
972 & (HEFFpreTH(I,J) * SEAICE_rhoIce +
973 & HSNWpreTH(I,J) * SEAICE_rhoSnow)/AREApreTH(I,J)
974 ELSE
975 latentHeatFluxMax(I,J) = ZERO
976 ENDIF
977 #endif
978 ENDDO
979 ENDDO
980 #ifdef SEAICE_ITD
981 ENDDO
982 #endif
983 #endif /* SEAICE_CAP_SUBLIM */
984
985 C ===================================================================
986 C ================PART 2: determine heat fluxes/stocks===============
987 C ===================================================================
988
989 C determine available heat due to the atmosphere -- for open water
990 C ================================================================
991
992 DO j=1,sNy
993 DO i=1,sNx
994 C ocean surface/mixed layer temperature
995 TmixLoc(i,j) = theta(i,j,kSurface,bi,bj)+celsius2K
996 C wind speed from exf
997 UG(I,J) = MAX(SEAICE_EPS,wspeed(I,J,bi,bj))
998 ENDDO
999 ENDDO
1000
1001 #ifdef ALLOW_AUTODIFF_TAMC
1002 CADJ STORE qnet(:,:,bi,bj) = comlev1_bibj, key = iicekey,byte=isbyte
1003 CADJ STORE qsw(:,:,bi,bj) = comlev1_bibj, key = iicekey,byte=isbyte
1004 cCADJ STORE UG = comlev1_bibj, key = iicekey,byte=isbyte
1005 cCADJ STORE TmixLoc = comlev1_bibj, key = iicekey,byte=isbyte
1006 #endif /* ALLOW_AUTODIFF_TAMC */
1007
1008 CALL SEAICE_BUDGET_OCEAN(
1009 I UG,
1010 I TmixLoc,
1011 O a_QbyATM_open, a_QSWbyATM_open,
1012 I bi, bj, myTime, myIter, myThid )
1013
1014 C determine available heat due to the atmosphere -- for ice covered water
1015 C =======================================================================
1016
1017 IF (useRelativeWind.AND.useAtmWind) THEN
1018 C Compute relative wind speed over sea ice.
1019 DO J=1,sNy
1020 DO I=1,sNx
1021 SPEED_SQ =
1022 & (uWind(I,J,bi,bj)
1023 & +0.5 _d 0*(uVel(i,j,kSurface,bi,bj)
1024 & +uVel(i+1,j,kSurface,bi,bj))
1025 & -0.5 _d 0*(uice(i,j,bi,bj)+uice(i+1,j,bi,bj)))**2
1026 & +(vWind(I,J,bi,bj)
1027 & +0.5 _d 0*(vVel(i,j,kSurface,bi,bj)
1028 & +vVel(i,j+1,kSurface,bi,bj))
1029 & -0.5 _d 0*(vice(i,j,bi,bj)+vice(i,j+1,bi,bj)))**2
1030 IF ( SPEED_SQ .LE. SEAICE_EPS_SQ ) THEN
1031 UG(I,J)=SEAICE_EPS
1032 ELSE
1033 UG(I,J)=SQRT(SPEED_SQ)
1034 ENDIF
1035 ENDDO
1036 ENDDO
1037 ENDIF
1038
1039 #ifdef ALLOW_AUTODIFF_TAMC
1040 CADJ STORE tice(:,:,bi,bj)
1041 CADJ & = comlev1_bibj, key = iicekey, byte = isbyte
1042 CADJ STORE hsnowActual = comlev1_bibj, key = iicekey, byte = isbyte
1043 CADJ STORE heffActual = comlev1_bibj, key = iicekey, byte = isbyte
1044 CADJ STORE UG = comlev1_bibj, key = iicekey, byte = isbyte
1045 CADJ STORE tices(:,:,:,bi,bj)
1046 CADJ & = comlev1_bibj, key = iicekey, byte = isbyte
1047 CADJ STORE salt(:,:,kSurface,bi,bj) = comlev1_bibj,
1048 CADJ & key = iicekey, byte = isbyte
1049 #endif /* ALLOW_AUTODIFF_TAMC */
1050
1051 C-- Start loop over multi-categories
1052 #ifdef SEAICE_ITD
1053 DO IT=1,nITD
1054 DO J=1,sNy
1055 DO I=1,sNx
1056 C for SEAICE_ITD heffActualMult and latentHeatFluxMaxMult are calculated above
1057 C (instead of heffActual and latentHeatFluxMax)
1058 ticeInMult(I,J,IT)=TICES(I,J,IT,bi,bj)
1059 ticeOutMult(I,J,IT)=TICES(I,J,IT,bi,bj)
1060 TICE(I,J,bi,bj) = ZERO
1061 TICES(I,J,IT,bi,bj) = ZERO
1062 ENDDO
1063 ENDDO
1064 ENDDO
1065 #else
1066 DO IT=1,SEAICE_multDim
1067 C homogeneous distribution between 0 and 2 x heffActual
1068 pFac = (2.0 _d 0*IT - 1.0 _d 0)*recip_multDim
1069 pFacSnow = 1. _d 0
1070 IF ( SEAICE_useMultDimSnow ) pFacSnow=pFac
1071 DO J=1,sNy
1072 DO I=1,sNx
1073 heffActualMult(I,J,IT)= heffActual(I,J)*pFac
1074 hsnowActualMult(I,J,IT)=hsnowActual(I,J)*pFacSnow
1075 #ifdef SEAICE_CAP_SUBLIM
1076 latentHeatFluxMaxMult(I,J,IT) = latentHeatFluxMax(I,J)*pFac
1077 #endif
1078 ticeInMult(I,J,IT)=TICES(I,J,IT,bi,bj)
1079 ticeOutMult(I,J,IT)=TICES(I,J,IT,bi,bj)
1080 TICE(I,J,bi,bj) = ZERO
1081 TICES(I,J,IT,bi,bj) = ZERO
1082 ENDDO
1083 ENDDO
1084 ENDDO
1085 #endif
1086
1087 #ifdef ALLOW_AUTODIFF_TAMC
1088 CADJ STORE heffActualMult = comlev1_bibj, key = iicekey, byte = isbyte
1089 CADJ STORE hsnowActualMult= comlev1_bibj, key = iicekey, byte = isbyte
1090 CADJ STORE ticeInMult = comlev1_bibj, key = iicekey, byte = isbyte
1091 # ifdef SEAICE_CAP_SUBLIM
1092 CADJ STORE latentHeatFluxMaxMult
1093 CADJ & = comlev1_bibj, key = iicekey, byte = isbyte
1094 # endif
1095 CADJ STORE a_QbyATMmult_cover =
1096 CADJ & comlev1_bibj, key = iicekey, byte = isbyte
1097 CADJ STORE a_QSWbyATMmult_cover =
1098 CADJ & comlev1_bibj, key = iicekey, byte = isbyte
1099 CADJ STORE a_FWbySublimMult =
1100 CADJ & comlev1_bibj, key = iicekey, byte = isbyte
1101 #endif /* ALLOW_AUTODIFF_TAMC */
1102
1103 DO IT=1,SEAICE_multDim
1104 CALL SEAICE_SOLVE4TEMP(
1105 I UG, heffActualMult(1,1,IT), hsnowActualMult(1,1,IT),
1106 #ifdef SEAICE_CAP_SUBLIM
1107 I latentHeatFluxMaxMult(1,1,IT),
1108 #endif
1109 U ticeInMult(1,1,IT), ticeOutMult(1,1,IT),
1110 O a_QbyATMmult_cover(1,1,IT),
1111 O a_QSWbyATMmult_cover(1,1,IT),
1112 O a_FWbySublimMult(1,1,IT),
1113 I bi, bj, myTime, myIter, myThid )
1114 ENDDO
1115
1116 #ifdef ALLOW_AUTODIFF_TAMC
1117 CADJ STORE heffActualMult = comlev1_bibj, key = iicekey, byte = isbyte
1118 CADJ STORE hsnowActualMult= comlev1_bibj, key = iicekey, byte = isbyte
1119 CADJ STORE ticeOutMult = comlev1_bibj, key = iicekey, byte = isbyte
1120 # ifdef SEAICE_CAP_SUBLIM
1121 CADJ STORE latentHeatFluxMaxMult
1122 CADJ & = comlev1_bibj, key = iicekey, byte = isbyte
1123 # endif
1124 CADJ STORE a_QbyATMmult_cover =
1125 CADJ & comlev1_bibj, key = iicekey, byte = isbyte
1126 CADJ STORE a_QSWbyATMmult_cover =
1127 CADJ & comlev1_bibj, key = iicekey, byte = isbyte
1128 CADJ STORE a_FWbySublimMult =
1129 CADJ & comlev1_bibj, key = iicekey, byte = isbyte
1130 #endif /* ALLOW_AUTODIFF_TAMC */
1131
1132 DO IT=1,SEAICE_multDim
1133 DO J=1,sNy
1134 DO I=1,sNx
1135 C update TICE & TICES
1136 #ifdef SEAICE_ITD
1137 C calculate area weighted mean
1138 C (although the ice temperature relates to its energy content
1139 C and hence should be averaged weighted by ice volume,
1140 C the temperature here is a result of the fluxes through the ice surface
1141 C computed individually for each single category in SEAICE_SOLVE4TEMP
1142 C and hence is averaged area weighted [areaFracFactor])
1143 TICE(I,J,bi,bj) = TICE(I,J,bi,bj)
1144 & + ticeOutMult(I,J,IT)*areaFracFactor(I,J,IT)
1145 #else
1146 TICE(I,J,bi,bj) = TICE(I,J,bi,bj)
1147 & + ticeOutMult(I,J,IT)*recip_multDim
1148 #endif
1149 TICES(I,J,IT,bi,bj) = ticeOutMult(I,J,IT)
1150 C average over categories
1151 #ifdef SEAICE_ITD
1152 C calculate area weighted mean
1153 C (fluxes are per unit (ice surface) area and are thus area weighted)
1154 a_QbyATM_cover (I,J) = a_QbyATM_cover(I,J)
1155 & + a_QbyATMmult_cover(I,J,IT)*areaFracFactor(I,J,IT)
1156 a_QSWbyATM_cover (I,J) = a_QSWbyATM_cover(I,J)
1157 & + a_QSWbyATMmult_cover(I,J,IT)*areaFracFactor(I,J,IT)
1158 a_FWbySublim (I,J) = a_FWbySublim(I,J)
1159 & + a_FWbySublimMult(I,J,IT)*areaFracFactor(I,J,IT)
1160 #else
1161 a_QbyATM_cover (I,J) = a_QbyATM_cover(I,J)
1162 & + a_QbyATMmult_cover(I,J,IT)*recip_multDim
1163 a_QSWbyATM_cover (I,J) = a_QSWbyATM_cover(I,J)
1164 & + a_QSWbyATMmult_cover(I,J,IT)*recip_multDim
1165 a_FWbySublim (I,J) = a_FWbySublim(I,J)
1166 & + a_FWbySublimMult(I,J,IT)*recip_multDim
1167 #endif
1168 ENDDO
1169 ENDDO
1170 ENDDO
1171
1172 #ifdef SEAICE_CAP_SUBLIM
1173 # ifdef ALLOW_DIAGNOSTICS
1174 DO J=1,sNy
1175 DO I=1,sNx
1176 C The actual latent heat flux realized by SOLVE4TEMP
1177 DIAGarrayA(I,J) = a_FWbySublim(I,J) * lhSublim
1178 ENDDO
1179 ENDDO
1180 Cif The actual vs. maximum latent heat flux
1181 IF ( useDiagnostics ) THEN
1182 CALL DIAGNOSTICS_FILL(DIAGarrayA,
1183 & 'SIactLHF',0,1,3,bi,bj,myThid)
1184 CALL DIAGNOSTICS_FILL(latentHeatFluxMax,
1185 & 'SImaxLHF',0,1,3,bi,bj,myThid)
1186 ENDIF
1187 # endif /* ALLOW_DIAGNOSTICS */
1188 #endif /* SEAICE_CAP_SUBLIM */
1189
1190 #ifdef ALLOW_AUTODIFF_TAMC
1191 CADJ STORE AREApreTH = comlev1_bibj, key = iicekey, byte = isbyte
1192 CADJ STORE a_QbyATM_cover = comlev1_bibj, key = iicekey, byte = isbyte
1193 CADJ STORE a_QSWbyATM_cover= comlev1_bibj, key = iicekey, byte = isbyte
1194 CADJ STORE a_QbyATM_open = comlev1_bibj, key = iicekey, byte = isbyte
1195 CADJ STORE a_QSWbyATM_open = comlev1_bibj, key = iicekey, byte = isbyte
1196 CADJ STORE a_FWbySublim = comlev1_bibj, key = iicekey, byte = isbyte
1197 #endif /* ALLOW_AUTODIFF_TAMC */
1198
1199 C switch heat fluxes from W/m2 to 'effective' ice meters
1200 #ifdef SEAICE_ITD
1201 DO IT=1,nITD
1202 DO J=1,sNy
1203 DO I=1,sNx
1204 a_QbyATMmult_cover(I,J,IT) = a_QbyATMmult_cover(I,J,IT)
1205 & * convertQ2HI * AREAITDpreTH(I,J,IT)
1206 a_QSWbyATMmult_cover(I,J,IT) = a_QSWbyATMmult_cover(I,J,IT)
1207 & * convertQ2HI * AREAITDpreTH(I,J,IT)
1208 C and initialize r_QbyATMmult_cover
1209 r_QbyATMmult_cover(I,J,IT)=a_QbyATMmult_cover(I,J,IT)
1210 C Convert fresh water flux by sublimation to 'effective' ice meters.
1211 C Negative sublimation is resublimation and will be added as snow.
1212 #ifdef SEAICE_DISABLE_SUBLIM
1213 a_FWbySublimMult(I,J,IT) = ZERO
1214 #endif
1215 a_FWbySublimMult(I,J,IT) = SEAICE_deltaTtherm*recip_rhoIce
1216 & * a_FWbySublimMult(I,J,IT)*AREAITDpreTH(I,J,IT)
1217 r_FWbySublimMult(I,J,IT)=a_FWbySublimMult(I,J,IT)
1218 ENDDO
1219 ENDDO
1220 ENDDO
1221 DO J=1,sNy
1222 DO I=1,sNx
1223 a_QbyATM_open(I,J) = a_QbyATM_open(I,J)
1224 & * convertQ2HI * ( ONE - AREApreTH(I,J) )
1225 a_QSWbyATM_open(I,J) = a_QSWbyATM_open(I,J)
1226 & * convertQ2HI * ( ONE - AREApreTH(I,J) )
1227 C and initialize r_QbyATM_open
1228 r_QbyATM_open(I,J)=a_QbyATM_open(I,J)
1229 ENDDO
1230 ENDDO
1231 #else /* SEAICE_ITD */
1232 DO J=1,sNy
1233 DO I=1,sNx
1234 a_QbyATM_cover(I,J) = a_QbyATM_cover(I,J)
1235 & * convertQ2HI * AREApreTH(I,J)
1236 a_QSWbyATM_cover(I,J) = a_QSWbyATM_cover(I,J)
1237 & * convertQ2HI * AREApreTH(I,J)
1238 a_QbyATM_open(I,J) = a_QbyATM_open(I,J)
1239 & * convertQ2HI * ( ONE - AREApreTH(I,J) )
1240 a_QSWbyATM_open(I,J) = a_QSWbyATM_open(I,J)
1241 & * convertQ2HI * ( ONE - AREApreTH(I,J) )
1242 C and initialize r_QbyATM_cover/r_QbyATM_open
1243 r_QbyATM_cover(I,J)=a_QbyATM_cover(I,J)
1244 r_QbyATM_open(I,J)=a_QbyATM_open(I,J)
1245 C Convert fresh water flux by sublimation to 'effective' ice meters.
1246 C Negative sublimation is resublimation and will be added as snow.
1247 #ifdef SEAICE_DISABLE_SUBLIM
1248 Cgf just for those who may need to omit this term to reproduce old results
1249 a_FWbySublim(I,J) = ZERO
1250 #endif /* SEAICE_DISABLE_SUBLIM */
1251 a_FWbySublim(I,J) = SEAICE_deltaTtherm*recip_rhoIce
1252 & * a_FWbySublim(I,J)*AREApreTH(I,J)
1253 r_FWbySublim(I,J)=a_FWbySublim(I,J)
1254 ENDDO
1255 ENDDO
1256 #endif /* SEAICE_ITD */
1257
1258 #ifdef ALLOW_AUTODIFF_TAMC
1259 CADJ STORE AREApreTH = comlev1_bibj, key = iicekey, byte = isbyte
1260 CADJ STORE a_QbyATM_cover = comlev1_bibj, key = iicekey, byte = isbyte
1261 CADJ STORE a_QSWbyATM_cover= comlev1_bibj, key = iicekey, byte = isbyte
1262 CADJ STORE a_QbyATM_open = comlev1_bibj, key = iicekey, byte = isbyte
1263 CADJ STORE a_QSWbyATM_open = comlev1_bibj, key = iicekey, byte = isbyte
1264 CADJ STORE a_FWbySublim = comlev1_bibj, key = iicekey, byte = isbyte
1265 CADJ STORE r_QbyATM_cover = comlev1_bibj, key = iicekey, byte = isbyte
1266 CADJ STORE r_QbyATM_open = comlev1_bibj, key = iicekey, byte = isbyte
1267 CADJ STORE r_FWbySublim = comlev1_bibj, key = iicekey, byte = isbyte
1268 #endif /* ALLOW_AUTODIFF_TAMC */
1269
1270 #if (defined ALLOW_AUTODIFF_TAMC && defined SEAICE_MODIFY_GROWTH_ADJ)
1271 Cgf no additional dependency through ice cover
1272 IF ( SEAICEadjMODE.GE.3 ) THEN
1273 #ifdef SEAICE_ITD
1274 DO IT=1,nITD
1275 DO J=1,sNy
1276 DO I=1,sNx
1277 a_QbyATMmult_cover(I,J,IT) = 0. _d 0
1278 r_QbyATMmult_cover(I,J,IT) = 0. _d 0
1279 a_QSWbyATMmult_cover(I,J,IT) = 0. _d 0
1280 ENDDO
1281 ENDDO
1282 ENDDO
1283 #else
1284 DO J=1,sNy
1285 DO I=1,sNx
1286 a_QbyATM_cover(I,J) = 0. _d 0
1287 r_QbyATM_cover(I,J) = 0. _d 0
1288 a_QSWbyATM_cover(I,J) = 0. _d 0
1289 ENDDO
1290 ENDDO
1291 #endif
1292 ENDIF
1293 #endif
1294
1295 C determine available heat due to the ice pack tying the
1296 C underlying surface water temperature to freezing point
1297 C ======================================================
1298
1299 #ifdef ALLOW_AUTODIFF_TAMC
1300 CADJ STORE theta(:,:,kSurface,bi,bj) = comlev1_bibj,
1301 CADJ & key = iicekey, byte = isbyte
1302 CADJ STORE salt(:,:,kSurface,bi,bj) = comlev1_bibj,
1303 CADJ & key = iicekey, byte = isbyte
1304 #endif
1305
1306 DO J=1,sNy
1307 DO I=1,sNx
1308 C FREEZING TEMP. OF SEA WATER (deg C)
1309 tempFrz = SEAICE_tempFrz0 +
1310 & SEAICE_dTempFrz_dS *salt(I,J,kSurface,bi,bj)
1311 C efficiency of turbulent fluxes : dependency to sign of THETA-TBC
1312 IF ( theta(I,J,kSurface,bi,bj) .GE. tempFrz ) THEN
1313 tmpscal1 = SEAICE_mcPheePiston
1314 ELSE
1315 tmpscal1 =SEAICE_frazilFrac*drF(kSurface)/SEAICE_deltaTtherm
1316 ENDIF
1317 C efficiency of turbulent fluxes : dependency to AREA (McPhee cases)
1318 IF ( (AREApreTH(I,J) .GT. 0. _d 0).AND.
1319 & (.NOT.SEAICE_mcPheeStepFunc) ) THEN
1320 MixedLayerTurbulenceFactor = ONE -
1321 & SEAICE_mcPheeTaper * AREApreTH(I,J)
1322 ELSEIF ( (AREApreTH(I,J) .GT. 0. _d 0).AND.
1323 & (SEAICE_mcPheeStepFunc) ) THEN
1324 MixedLayerTurbulenceFactor = ONE - SEAICE_mcPheeTaper
1325 ELSE
1326 MixedLayerTurbulenceFactor = ONE
1327 ENDIF
1328 C maximum turbulent flux, in ice meters
1329 tmpscal2= - (HeatCapacity_Cp*rhoConst * recip_QI)
1330 & * (theta(I,J,kSurface,bi,bj)-tempFrz)
1331 & * SEAICE_deltaTtherm * maskC(i,j,kSurface,bi,bj)
1332 C available turbulent flux
1333 a_QbyOCN(i,j) =
1334 & tmpscal1 * tmpscal2 * MixedLayerTurbulenceFactor
1335 r_QbyOCN(i,j) = a_QbyOCN(i,j)
1336 ENDDO
1337 ENDDO
1338
1339 #ifdef SEAICE_ITD
1340 C determine lateral melt rate at floe edges based on an
1341 C average floe diameter or a floe size distribution
1342 C following Steele (1992, Tab. 2)
1343 C ======================================================
1344 DO J=1,sNy
1345 DO I=1,sNx
1346 tmpscal1=(theta(I,J,kSurface,bi,bj)-tempFrz)
1347 tmpscal2=sqrt(0.87 + 0.067*UG(i,j)) * UG(i,j)
1348
1349 C variable floe diameter following Luepkes et al. (2012, JGR, Equ. 26) with beta=1
1350 tmpscal3=ONE/(ONE-(floeDiameterMin/floeDiameterMax))
1351 floeDiameter = floeDiameterMin
1352 & * (tmpscal3 / (tmpscal3-AREApreTH(I,J)))
1353 DO IT=1,nITD
1354 C following the idea of SEAICE_areaLossFormula == 1:
1355 IF (a_QbyATMmult_cover(i,j,it).LT.ZERO .OR.
1356 & a_QbyATM_open(i,j) .LT.ZERO .OR.
1357 & a_QbyOCN(i,j) .LT.ZERO) THEN
1358 C lateral melt rate as suggested by Perovich, 1983 (PhD thesis)
1359 latMeltRate(i,j,it) = 1.6 _d -6 * tmpscal1**1.36
1360 C lateral melt rate as suggested by Maykut and Perovich, 1987 (JGR 92(C7)), Equ. 24
1361 c latMeltRate(i,j,it) = 13.5 _d -6 * tmpscal2 * tmpscal1**1.3
1362 C further suggestion by Maykut and Perovich to avoid latMeltRate -> 0 for UG -> 0
1363 c latMeltRate(i,j,it) = (1.6 _d -6 + 13.5 _d -6 * tmpscal2)
1364 c & * tmpscal1**1.3
1365 C factor determining fraction of area and ice volume reduction
1366 C due to lateral melt
1367 latMeltFrac(i,j,it) =
1368 & latMeltRate(i,j,it)*SEAICE_deltaTtherm*PI /
1369 & (floeAlpha * floeDiameter)
1370 latMeltFrac(i,j,it)=max(ZERO, min(latMeltFrac(i,j,it),ONE))
1371 ELSE
1372 latMeltRate(i,j,it)=0.0 _d 0
1373 latMeltFrac(i,j,it)=0.0 _d 0
1374 ENDIF
1375 ENDDO
1376 ENDDO
1377 ENDDO
1378 #endif
1379
1380 #if (defined ALLOW_AUTODIFF_TAMC && defined SEAICE_MODIFY_GROWTH_ADJ)
1381 CALL ZERO_ADJ_1D( sNx*sNy, r_QbyOCN, myThid)
1382 #endif
1383
1384 C ===================================================================
1385 C =========PART 3: determine effective thicknesses increments========
1386 C ===================================================================
1387
1388 #ifdef SEAICE_GREASE
1389 C convert SItracer 'grease' from ratio to grease ice volume:
1390 C ==========================================================
1391 DO J=1,sNy
1392 DO I=1,sNx
1393 SItracer(I,J,bi,bj,iTrGrease) =
1394 & SItracer(I,J,bi,bj,iTrGrease) * HEFF(I,J,bi,bj)
1395 ENDDO
1396 ENDDO
1397 C compute actual grease ice layer thickness
1398 C as a function of wind stress
1399 C =========================================
1400 DO J=1,sNy
1401 DO I=1,sNx
1402 C wind stress:
1403 tmpscal1 = SQRT(uWind(I,J,bi,bj)**2 + vWind(I,J,bi,bj)**2)
1404 tmpscal1 = SQRT( 1.4 _d 0 * 1.3 _d -3 / 100. _d 0)
1405 & * tmpscal1
1406 C water stress:
1407 tmpscal2 = SQRT(
1408 & + (0.5 _d 0*(uVel(i ,j,kSurface,bi,bj)
1409 & +uVel(i+1,j,kSurface,bi,bj)))**2
1410 & + (0.5 _d 0*(vVel(i,j ,kSurface,bi,bj)
1411 & +vVel(i,j+1,kSurface,bi,bj)))**2)
1412 tmpscal2 = SQRT(1027.0 _d 0 * 6.0 _d -3 / 100. _d 0)
1413 & * tmpscal2
1414 C lead width = mean grid cell width between tracer points
1415 C * open water fraction
1416 tmpscal3 = 0.5 _d 0 * (dxC(I,J,bi,bj)+dyC(I,J,bi,bj))
1417 & * (1. _d 0 - AREApreTH(I,J))
1418 C
1419 greaseLayerThick(I,J) = TWOTHIRDS
1420 & * ( SItracer(I,J,bi,bj,iTrGrease)
1421 C grease ice consists of 1 part frazil ice and 3 parts sea water:
1422 C rho_g = 0.25 * rho_i + 0.75 rho_w
1423 & * 4.4 _d 0
1424 & * tmpscal3 )**THIRD
1425 & * (tmpscal1 + tmpscal2)**TWOTHIRDS
1426 C assure a minimum thickness of 1 cm:
1427 greaseLayerThick(I,J)=max(1. _d -2, greaseLayerThick(I,J))
1428 C ... and a maximum thickness of 3 m:
1429 greaseLayerThick(I,J)=min(3. _d 0 , greaseLayerThick(I,J))
1430 ENDDO
1431 ENDDO
1432 #endif
1433
1434 C compute snow/ice tendency due to sublimation
1435 C ============================================
1436
1437 #ifdef ALLOW_AUTODIFF_TAMC
1438 CADJ STORE hsnow(:,:,bi,bj) = comlev1_bibj,key=iicekey,byte=isbyte
1439 CADJ STORE r_FWbySublim = comlev1_bibj,key=iicekey,byte=isbyte
1440 #endif /* ALLOW_AUTODIFF_TAMC */
1441 #ifdef SEAICE_ITD
1442 DO IT=1,nITD
1443 #endif
1444 DO J=1,sNy
1445 DO I=1,sNx
1446 C First sublimate/deposite snow
1447 tmpscal2 =
1448 #ifdef SEAICE_ITD
1449 & MAX(MIN(r_FWbySublimMult(I,J,IT),HSNOWITD(I,J,IT,bi,bj)
1450 & *SNOW2ICE),ZERO)
1451 d_HSNWbySublim_ITD(I,J,IT) = - tmpscal2 * ICE2SNOW
1452 C accumulate change over ITD categories
1453 d_HSNWbySublim(I,J) = d_HSNWbySublim(I,J) - tmpscal2
1454 & *ICE2SNOW
1455 r_FWbySublimMult(I,J,IT)= r_FWbySublimMult(I,J,IT) - tmpscal2
1456 #else
1457 & MAX(MIN(r_FWbySublim(I,J),HSNOW(I,J,bi,bj)*SNOW2ICE),ZERO)
1458 d_HSNWbySublim(I,J) = - tmpscal2 * ICE2SNOW
1459 HSNOW(I,J,bi,bj) = HSNOW(I,J,bi,bj) - tmpscal2*ICE2SNOW
1460 r_FWbySublim(I,J) = r_FWbySublim(I,J) - tmpscal2
1461 #endif
1462 ENDDO
1463 ENDDO
1464 #ifdef ALLOW_AUTODIFF_TAMC
1465 CADJ STORE heff(:,:,bi,bj) = comlev1_bibj,key=iicekey,byte=isbyte
1466 CADJ STORE r_FWbySublim = comlev1_bibj,key=iicekey,byte=isbyte
1467 #endif /* ALLOW_AUTODIFF_TAMC */
1468 DO J=1,sNy
1469 DO I=1,sNx
1470 C If anything is left, sublimate ice
1471 tmpscal2 =
1472 #ifdef SEAICE_ITD
1473 & MAX(MIN(r_FWbySublimMult(I,J,IT),HEFFITD(I,J,IT,bi,bj)),ZERO)
1474 d_HEFFbySublim_ITD(I,J,IT) = - tmpscal2
1475 C accumulate change over ITD categories
1476 d_HEFFbySublim(I,J) = d_HEFFbySublim(I,J) - tmpscal2
1477 r_FWbySublimMult(I,J,IT) = r_FWbySublimMult(I,J,IT) - tmpscal2
1478 #else
1479 & MAX(MIN(r_FWbySublim(I,J),HEFF(I,J,bi,bj)),ZERO)
1480 d_HEFFbySublim(I,J) = - tmpscal2
1481 HEFF(I,J,bi,bj) = HEFF(I,J,bi,bj) - tmpscal2
1482 r_FWbySublim(I,J) = r_FWbySublim(I,J) - tmpscal2
1483 #endif
1484 ENDDO
1485 ENDDO
1486 DO J=1,sNy
1487 DO I=1,sNx
1488 C If anything is left, it will be evaporated from the ocean rather than sublimated.
1489 C Since a_QbyATM_cover was computed for sublimation, not simple evaporation, we need to
1490 C remove the fusion part for the residual (that happens to be precisely r_FWbySublim).
1491 #ifdef SEAICE_ITD
1492 a_QbyATMmult_cover(I,J,IT) = a_QbyATMmult_cover(I,J,IT)
1493 & - r_FWbySublimMult(I,J,IT)
1494 r_QbyATMmult_cover(I,J,IT) = r_QbyATMmult_cover(I,J,IT)
1495 & - r_FWbySublimMult(I,J,IT)
1496 #else
1497 a_QbyATM_cover(I,J) = a_QbyATM_cover(I,J)-r_FWbySublim(I,J)
1498 r_QbyATM_cover(I,J) = r_QbyATM_cover(I,J)-r_FWbySublim(I,J)
1499 #endif
1500 ENDDO
1501 ENDDO
1502 #ifdef SEAICE_ITD
1503 C end IT loop
1504 ENDDO
1505 #endif
1506
1507 C compute ice thickness tendency due to ice-ocean interaction
1508 C ===========================================================
1509
1510 #ifdef ALLOW_AUTODIFF_TAMC
1511 CADJ STORE heff(:,:,bi,bj) = comlev1_bibj,key=iicekey,byte=isbyte
1512 CADJ STORE r_QbyOCN = comlev1_bibj,key=iicekey,byte=isbyte
1513 #endif /* ALLOW_AUTODIFF_TAMC */
1514
1515 IF (.NOT.SEAICE_growMeltByConv) THEN
1516
1517 #ifdef SEAICE_ITD
1518 DO IT=1,nITD
1519 DO J=1,sNy
1520 DO I=1,sNx
1521 C ice growth/melt due to ocean heat r_QbyOCN (W/m^2) is
1522 C equally distributed under the ice and hence weighted by
1523 C fractional area of each thickness category
1524 tmpscal1=MAX(r_QbyOCN(i,j)*areaFracFactor(I,J,IT),
1525 & -HEFFITD(I,J,IT,bi,bj))
1526 d_HEFFbyOCNonICE_ITD(I,J,IT)=tmpscal1
1527 d_HEFFbyOCNonICE(I,J) = d_HEFFbyOCNonICE(I,J) + tmpscal1
1528 ENDDO
1529 ENDDO
1530 ENDDO
1531 #ifdef ALLOW_SITRACER
1532 DO J=1,sNy
1533 DO I=1,sNx
1534 SItrHEFF(I,J,bi,bj,2) = HEFFpreTH(I,J)
1535 & + d_HEFFbySublim(I,J)
1536 & + d_HEFFbyOCNonICE(I,J)
1537 ENDDO
1538 ENDDO
1539 #endif
1540 DO J=1,sNy
1541 DO I=1,sNx
1542 r_QbyOCN(I,J)=r_QbyOCN(I,J)-d_HEFFbyOCNonICE(I,J)
1543 ENDDO
1544 ENDDO
1545 #else /* SEAICE_ITD */
1546 DO J=1,sNy
1547 DO I=1,sNx
1548 d_HEFFbyOCNonICE(I,J)=MAX(r_QbyOCN(i,j), -HEFF(I,J,bi,bj))
1549 r_QbyOCN(I,J)=r_QbyOCN(I,J)-d_HEFFbyOCNonICE(I,J)
1550 HEFF(I,J,bi,bj)=HEFF(I,J,bi,bj) + d_HEFFbyOCNonICE(I,J)
1551 #ifdef ALLOW_SITRACER
1552 SItrHEFF(I,J,bi,bj,2)=HEFF(I,J,bi,bj)
1553 #endif
1554 ENDDO
1555 ENDDO
1556 #endif /* SEAICE_ITD */
1557
1558 ENDIF !SEAICE_growMeltByConv
1559
1560 C compute snow melt tendency due to snow-atmosphere interaction
1561 C ==================================================================
1562
1563 #ifdef ALLOW_AUTODIFF_TAMC
1564 CADJ STORE hsnow(:,:,bi,bj) = comlev1_bibj,key=iicekey,byte=isbyte
1565 CADJ STORE r_QbyATM_cover = comlev1_bibj,key=iicekey,byte=isbyte
1566 #endif /* ALLOW_AUTODIFF_TAMC */
1567
1568 #ifdef SEAICE_ITD
1569 DO IT=1,nITD
1570 DO J=1,sNy
1571 DO I=1,sNx
1572 C Convert to standard units (meters of ice) rather than to meters
1573 C of snow. This appears to be more robust.
1574 tmpscal1=MAX(r_QbyATMmult_cover(I,J,IT),
1575 & -HSNOWITD(I,J,IT,bi,bj)*SNOW2ICE)
1576 tmpscal2=MIN(tmpscal1,0. _d 0)
1577 #ifdef SEAICE_MODIFY_GROWTH_ADJ
1578 Cgf no additional dependency through snow
1579 IF ( SEAICEadjMODE.GE.2 ) tmpscal2 = 0. _d 0
1580 #endif
1581 d_HSNWbyATMonSNW_ITD(I,J,IT) = tmpscal2*ICE2SNOW
1582 d_HSNWbyATMonSNW(I,J) = d_HSNWbyATMonSNW(I,J)
1583 & + tmpscal2*ICE2SNOW
1584 r_QbyATMmult_cover(I,J,IT)=r_QbyATMmult_cover(I,J,IT)
1585 & - tmpscal2
1586 ENDDO
1587 ENDDO
1588 ENDDO
1589 #else /* SEAICE_ITD */
1590 DO J=1,sNy
1591 DO I=1,sNx
1592 C Convert to standard units (meters of ice) rather than to meters
1593 C of snow. This appears to be more robust.
1594 tmpscal1=MAX(r_QbyATM_cover(I,J),-HSNOW(I,J,bi,bj)*SNOW2ICE)
1595 tmpscal2=MIN(tmpscal1,0. _d 0)
1596 #ifdef SEAICE_MODIFY_GROWTH_ADJ
1597 Cgf no additional dependency through snow
1598 IF ( SEAICEadjMODE.GE.2 ) tmpscal2 = 0. _d 0
1599 #endif
1600 d_HSNWbyATMonSNW(I,J)= tmpscal2*ICE2SNOW
1601 HSNOW(I,J,bi,bj) = HSNOW(I,J,bi,bj) + tmpscal2*ICE2SNOW
1602 r_QbyATM_cover(I,J)=r_QbyATM_cover(I,J) - tmpscal2
1603 ENDDO
1604 ENDDO
1605 #endif /* SEAICE_ITD */
1606
1607 C compute ice thickness tendency due to the atmosphere
1608 C ====================================================
1609
1610 #ifdef ALLOW_AUTODIFF_TAMC
1611 CADJ STORE heff(:,:,bi,bj) = comlev1_bibj,key=iicekey,byte=isbyte
1612 CADJ STORE r_QbyATM_cover = comlev1_bibj,key=iicekey,byte=isbyte
1613 #endif /* ALLOW_AUTODIFF_TAMC */
1614
1615 Cgf note: this block is not actually tested by lab_sea
1616 Cgf where all experiments start in January. So even though
1617 Cgf the v1.81=>v1.82 revision would change results in
1618 Cgf warming conditions, the lab_sea results were not changed.
1619
1620 #ifdef SEAICE_ITD
1621 DO IT=1,nITD
1622 DO J=1,sNy
1623 DO I=1,sNx
1624 tmpscal1 = HEFFITDpreTH(I,J,IT)
1625 & + d_HEFFbySublim_ITD(I,J,IT)
1626 & + d_HEFFbyOCNonICE_ITD(I,J,IT)
1627 tmpscal2 = MAX(-tmpscal1,
1628 & r_QbyATMmult_cover(I,J,IT)
1629 C Limit ice growth by potential melt by ocean
1630 & + AREAITDpreTH(I,J,IT) * r_QbyOCN(I,J))
1631 d_HEFFbyATMonOCN_cover_ITD(I,J,IT) = tmpscal2
1632 d_HEFFbyATMonOCN_cover(I,J) = d_HEFFbyATMonOCN_cover(I,J)
1633 & + tmpscal2
1634 d_HEFFbyATMonOCN_ITD(I,J,IT) = d_HEFFbyATMonOCN_ITD(I,J,IT)
1635 & + tmpscal2
1636 d_HEFFbyATMonOCN(I,J) = d_HEFFbyATMonOCN(I,J)
1637 & + tmpscal2
1638 r_QbyATMmult_cover(I,J,IT) = r_QbyATMmult_cover(I,J,IT)
1639 & - tmpscal2
1640 ENDDO
1641 ENDDO
1642 ENDDO
1643 #ifdef ALLOW_SITRACER
1644 DO J=1,sNy
1645 DO I=1,sNx
1646 SItrHEFF(I,J,bi,bj,3) = SItrHEFF(I,J,bi,bj,2)
1647 & + d_HEFFbyATMonOCN_cover(I,J)
1648 ENDDO
1649 ENDDO
1650 #endif
1651 #else /* SEAICE_ITD */
1652 DO J=1,sNy
1653 DO I=1,sNx
1654
1655 tmpscal2 = MAX(-HEFF(I,J,bi,bj),r_QbyATM_cover(I,J)+
1656 C Limit ice growth by potential melt by ocean
1657 & AREApreTH(I,J) * r_QbyOCN(I,J))
1658
1659 d_HEFFbyATMonOCN_cover(I,J)=tmpscal2
1660 d_HEFFbyATMonOCN(I,J)=d_HEFFbyATMonOCN(I,J)+tmpscal2
1661 r_QbyATM_cover(I,J)=r_QbyATM_cover(I,J)-tmpscal2
1662 HEFF(I,J,bi,bj) = HEFF(I,J,bi,bj) + tmpscal2
1663
1664 #ifdef ALLOW_SITRACER
1665 SItrHEFF(I,J,bi,bj,3)=HEFF(I,J,bi,bj)
1666 #endif
1667 ENDDO
1668 ENDDO
1669 #endif /* SEAICE_ITD */
1670
1671 C add snow precipitation to HSNOW.
1672 C =================================================
1673 #ifdef ALLOW_AUTODIFF_TAMC
1674 CADJ STORE a_QbyATM_cover = comlev1_bibj,key=iicekey,byte=isbyte
1675 CADJ STORE PRECIP(:,:,bi,bj) = comlev1_bibj,key=iicekey,byte=isbyte
1676 CADJ STORE AREApreTH = comlev1_bibj,key=iicekey,byte=isbyte
1677 #endif /* ALLOW_AUTODIFF_TAMC */
1678 IF ( snowPrecipFile .NE. ' ' ) THEN
1679 C add snowPrecip to HSNOW
1680 DO J=1,sNy
1681 DO I=1,sNx
1682 d_HSNWbyRAIN(I,J) = convertPRECIP2HI * ICE2SNOW *
1683 & snowPrecip(i,j,bi,bj) * AREApreTH(I,J)
1684 d_HFRWbyRAIN(I,J) = -convertPRECIP2HI *
1685 & ( PRECIP(I,J,bi,bj) - snowPrecip(I,J,bi,bj) ) *
1686 & AREApreTH(I,J)
1687 HSNOW(I,J,bi,bj) = HSNOW(I,J,bi,bj) + d_HSNWbyRAIN(I,J)
1688 ENDDO
1689 ENDDO
1690 ELSE
1691 C attribute precip to fresh water or snow stock,
1692 C depending on atmospheric conditions.
1693 DO J=1,sNy
1694 DO I=1,sNx
1695 C possible alternatives to the a_QbyATM_cover criterium
1696 c IF (TICE(I,J,bi,bj) .LT. TMIX) THEN
1697 c IF (atemp(I,J,bi,bj) .LT. celsius2K) THEN
1698 IF ( a_QbyATM_cover(I,J).GE. 0. _d 0 ) THEN
1699 C add precip as snow
1700 d_HFRWbyRAIN(I,J)=0. _d 0
1701 d_HSNWbyRAIN(I,J)=convertPRECIP2HI*ICE2SNOW*
1702 & PRECIP(I,J,bi,bj)*AREApreTH(I,J)
1703 ELSE
1704 C add precip to the fresh water bucket
1705 d_HFRWbyRAIN(I,J)=-convertPRECIP2HI*
1706 & PRECIP(I,J,bi,bj)*AREApreTH(I,J)
1707 d_HSNWbyRAIN(I,J)=0. _d 0
1708 ENDIF
1709 ENDDO
1710 ENDDO
1711 #ifdef SEAICE_ITD
1712 DO IT=1,nITD
1713 DO J=1,sNy
1714 DO I=1,sNx
1715 d_HSNWbyRAIN_ITD(I,J,IT)
1716 & = d_HSNWbyRAIN(I,J)*areaFracFactor(I,J,IT)
1717 ENDDO
1718 ENDDO
1719 ENDDO
1720 #else
1721 DO J=1,sNy
1722 DO I=1,sNx
1723 HSNOW(I,J,bi,bj) = HSNOW(I,J,bi,bj) + d_HSNWbyRAIN(I,J)
1724 ENDDO
1725 ENDDO
1726 #endif
1727 Cgf note: this does not affect air-sea heat flux,
1728 Cgf since the implied air heat gain to turn
1729 Cgf rain to snow is not a surface process.
1730 C end of IF statement snowPrecipFile:
1731 ENDIF
1732
1733 C compute snow melt due to heat available from ocean.
1734 C =================================================================
1735
1736 Cgf do we need to keep this comment and cpp bracket?
1737 Cph( very sensitive bit here by JZ
1738 #ifndef SEAICE_EXCLUDE_FOR_EXACT_AD_TESTING
1739 #ifdef ALLOW_AUTODIFF_TAMC
1740 CADJ STORE HSNOW(:,:,bi,bj) = comlev1_bibj,key=iicekey,byte=isbyte
1741 CADJ STORE r_QbyOCN = comlev1_bibj,key=iicekey,byte=isbyte
1742 #endif /* ALLOW_AUTODIFF_TAMC */
1743
1744 IF (.NOT.SEAICE_growMeltByConv) THEN
1745
1746 #ifdef SEAICE_ITD
1747 DO IT=1,nITD
1748 DO J=1,sNy
1749 DO I=1,sNx
1750 tmpscal4 = HSNWITDpreTH(I,J,IT)
1751 & + d_HSNWbySublim_ITD(I,J,IT)
1752 & + d_HSNWbyATMonSNW_ITD(I,J,IT)
1753 & + d_HSNWbyRAIN_ITD(I,J,IT)
1754 tmpscal1=MAX(r_QbyOCN(i,j)*ICE2SNOW*areaFracFactor(I,J,IT),
1755 & -tmpscal4)
1756 tmpscal2=MIN(tmpscal1,0. _d 0)
1757 #ifdef SEAICE_MODIFY_GROWTH_ADJ
1758 Cgf no additional dependency through snow
1759 if ( SEAICEadjMODE.GE.2 ) tmpscal2 = 0. _d 0
1760 #endif
1761 d_HSNWbyOCNonSNW_ITD(I,J,IT) = tmpscal2
1762 d_HSNWbyOCNonSNW(I,J) = d_HSNWbyOCNonSNW(I,J) + tmpscal2
1763 r_QbyOCN(I,J)=r_QbyOCN(I,J) - tmpscal2*SNOW2ICE
1764 ENDDO
1765 ENDDO
1766 ENDDO
1767 #else /* SEAICE_ITD */
1768 DO J=1,sNy
1769 DO I=1,sNx
1770 tmpscal1=MAX(r_QbyOCN(i,j)*ICE2SNOW, -HSNOW(I,J,bi,bj))
1771 tmpscal2=MIN(tmpscal1,0. _d 0)
1772 #ifdef SEAICE_MODIFY_GROWTH_ADJ
1773 Cgf no additional dependency through snow
1774 if ( SEAICEadjMODE.GE.2 ) tmpscal2 = 0. _d 0
1775 #endif
1776 d_HSNWbyOCNonSNW(I,J) = tmpscal2
1777 r_QbyOCN(I,J)=r_QbyOCN(I,J)
1778 & -d_HSNWbyOCNonSNW(I,J)*SNOW2ICE
1779 HSNOW(I,J,bi,bj) = HSNOW(I,J,bi,bj)+d_HSNWbyOCNonSNW(I,J)
1780 ENDDO
1781 ENDDO
1782 #endif /* SEAICE_ITD */
1783
1784 ENDIF !SEAICE_growMeltByConv
1785
1786 #endif /* SEAICE_EXCLUDE_FOR_EXACT_AD_TESTING */
1787 Cph)
1788
1789 C gain of new ice over open water
1790 C ===============================
1791 #ifdef ALLOW_AUTODIFF_TAMC
1792 CADJ STORE heff(:,:,bi,bj) = comlev1_bibj,key=iicekey,byte=isbyte
1793 CADJ STORE r_QbyATM_open = comlev1_bibj,key=iicekey,byte=isbyte
1794 CADJ STORE r_QbyOCN = comlev1_bibj,key=iicekey,byte=isbyte
1795 CADJ STORE a_QSWbyATM_cover = comlev1_bibj,key=iicekey,byte=isbyte
1796 CADJ STORE a_QSWbyATM_open = comlev1_bibj,key=iicekey,byte=isbyte
1797 #endif /* ALLOW_AUTODIFF_TAMC */
1798
1799 DO J=1,sNy
1800 DO I=1,sNx
1801 #ifdef SEAICE_ITD
1802 C HEFF will be updated at the end of PART 3,
1803 C hence sum of tendencies so far is needed
1804 tmpscal4 = HEFFpreTH(I,J)
1805 & + d_HEFFbySublim(I,J)
1806 & + d_HEFFbyOCNonICE(I,J)
1807 & + d_HEFFbyATMonOCN(I,J)
1808 #else
1809 C HEFF is updated step by step throughout seaice_growth
1810 tmpscal4 = HEFF(I,J,bi,bj)
1811 #endif
1812 C Initial ice growth is triggered by open water
1813 C heat flux overcoming potential melt by ocean
1814 tmpscal1=r_QbyATM_open(I,J)+r_QbyOCN(i,j) *
1815 & (1.0 _d 0 - AREApreTH(I,J))
1816 C Penetrative shortwave flux beyond first layer
1817 C that is therefore not available to ice growth/melt
1818 tmpscal2=SWFracB * a_QSWbyATM_open(I,J)
1819 C impose -HEFF as the maxmum melting if SEAICE_doOpenWaterMelt
1820 C or 0. otherwise (no melting if not SEAICE_doOpenWaterMelt)
1821 tmpscal3=facOpenGrow*MAX(tmpscal1-tmpscal2,
1822 & -tmpscal4*facOpenMelt)*HEFFM(I,J,bi,bj)
1823 #ifdef SEAICE_GREASE
1824 C Grease ice is a tracer or "bucket" for newly formed frazil ice
1825 C that instead of becoming solid sea ice instantly has a half-time
1826 C of 1 day (see greaseDecayTime) before solidifying.
1827 C The most important effect is that for fluxes the grease ice area/volume
1828 C acts like open water.
1829 C
1830 C memorize freezing/melting condition:
1831 greaseNewFrazil = max(0.0 _d 0, tmpscal3)
1832 C
1833 C 1) mechanical removal of grease by ridging:
1834 C if there is no open water left after advection, there cannot be any grease ice
1835 if ((1.0 _d 0 - AREApreTH(I,J)).LE.siEps) then
1836 tmpscal3 = tmpscal3 + SItracer(I,J,bi,bj,iTrGrease)
1837 SItracer(I,J,bi,bj,iTrGrease) = 0. _d 0
1838 endif
1839 if (greaseNewFrazil .GT. 0. _d 0) then
1840 C 2) solidification of "old" grease ice
1841 C (only when cold enough for ice growth)
1842 C
1843 C time scale dependent solidification
1844 C (50% of grease ice area become solid ice within 24h):
1845 tmpscal1=exp(-SEAICE_deltaTtherm/greaseDecayTime)
1846 C loss of grease ice (tracer) volume to solid sea ice
1847 tmpscal2 = SItracer(I,J,bi,bj,iTrGrease)
1848 & * (1.0 _d 0 - tmpscal1)
1849 SItracer(I,J,bi,bj,iTrGrease) =
1850 & SItracer(I,J,bi,bj,iTrGrease) * tmpscal1
1851 C the solidified grease ice volume needs to be added to HEFF:
1852 SItrBucket(I,J,bi,bj,iTrGrease) =
1853 & SItrBucket(I,J,bi,bj,iTrGrease) + tmpscal2
1854 C gain in solid sea ice area due to solidified grease:
1855 d_AREAbyGREASE(I,J) = tmpscal2 / greaseLayerThick(I,J)
1856 d_AREAbyGREASE(I,J) =
1857 & min(1.0 _d 0 - AREApreTH(I,J), d_AREAbyGREASE(I,J))
1858 C
1859 C 3) grease ice growth from new frazil ice:
1860 C
1861 SItracer(i,j,bi,bj,iTrGrease) =
1862 & SItracer(i,j,bi,bj,iTrGrease) + greaseNewFrazil
1863 c & SItracer(i,j,bi,bj,iTrGrease) + tmpscal3
1864 c tmpscal3=0. _d 0
1865 endif
1866 C 4) mapping SItrBucket to external variable, in this case HEFF, ...
1867 tmpscal3=tmpscal3+SItrBucket(I,J,bi,bj,iTrGrease)
1868 C ... and empty SItrBucket for tracer 'grease'
1869 SItrBucket(I,J,bi,bj,iTrGrease)=0. _d 0
1870 #endif
1871 #ifdef SEAICE_ITD
1872 C ice growth in open water adds to first category
1873 d_HEFFbyATMonOCN_open_ITD(I,J,1)=tmpscal3
1874 d_HEFFbyATMonOCN_ITD(I,J,1) =d_HEFFbyATMonOCN_ITD(I,J,1)
1875 & +tmpscal3
1876 #endif
1877 d_HEFFbyATMonOCN_open(I,J)=tmpscal3
1878 d_HEFFbyATMonOCN(I,J)=d_HEFFbyATMonOCN(I,J)+tmpscal3
1879 r_QbyATM_open(I,J)=r_QbyATM_open(I,J)-tmpscal3
1880 HEFF(I,J,bi,bj) = HEFF(I,J,bi,bj) + tmpscal3
1881 ENDDO
1882 ENDDO
1883
1884 #ifdef ALLOW_SITRACER
1885 DO J=1,sNy
1886 DO I=1,sNx
1887 C needs to be here to allow use also with LEGACY branch
1888 #ifdef SEAICE_ITD
1889 SItrHEFF(I,J,bi,bj,4)=SItrHEFF(I,J,bi,bj,3)
1890 & +d_HEFFbyATMonOCN_open(I,J)
1891 #else
1892 SItrHEFF(I,J,bi,bj,4)=HEFF(I,J,bi,bj)
1893 #endif
1894 ENDDO
1895 ENDDO
1896 #endif /* ALLOW_SITRACER */
1897
1898 C convert snow to ice if submerged.
1899 C =================================
1900
1901 C note: in legacy, this process is done at the end
1902 #ifdef ALLOW_AUTODIFF_TAMC
1903 CADJ STORE heff(:,:,bi,bj) = comlev1_bibj,key=iicekey,byte=isbyte
1904 CADJ STORE hsnow(:,:,bi,bj) = comlev1_bibj,key=iicekey,byte=isbyte
1905 #endif /* ALLOW_AUTODIFF_TAMC */
1906 IF ( SEAICEuseFlooding ) THEN
1907 #ifdef SEAICE_ITD
1908 DO IT=1,nITD
1909 DO J=1,sNy
1910 DO I=1,sNx
1911 tmpscal3 = HEFFITDpreTH(I,J,IT)
1912 & + d_HEFFbySublim_ITD(I,J,IT)
1913 & + d_HEFFbyOCNonICE_ITD(I,J,IT)
1914 & + d_HEFFbyATMonOCN_ITD(I,J,IT)
1915 tmpscal4 = HSNWITDpreTH(I,J,IT)
1916 & + d_HSNWbySublim_ITD(I,J,IT)
1917 & + d_HSNWbyATMonSNW_ITD(I,J,IT)
1918 & + d_HSNWbyRAIN_ITD(I,J,IT)
1919 tmpscal0 = (tmpscal4*SEAICE_rhoSnow
1920 & + tmpscal3*SEAICE_rhoIce)
1921 & * recip_rhoConst
1922 tmpscal1 = MAX( 0. _d 0, tmpscal0 - tmpscal3)
1923 d_HEFFbyFLOODING_ITD(I,J,IT) = tmpscal1
1924 d_HEFFbyFLOODING(I,J) = d_HEFFbyFLOODING(I,J) + tmpscal1
1925 ENDDO
1926 ENDDO
1927 ENDDO
1928 #else
1929 DO J=1,sNy
1930 DO I=1,sNx
1931 tmpscal0 = (HSNOW(I,J,bi,bj)*SEAICE_rhoSnow
1932 & +HEFF(I,J,bi,bj)*SEAICE_rhoIce)*recip_rhoConst
1933 tmpscal1 = MAX( 0. _d 0, tmpscal0 - HEFF(I,J,bi,bj))
1934 d_HEFFbyFLOODING(I,J)=tmpscal1
1935 HEFF(I,J,bi,bj) = HEFF(I,J,bi,bj)+d_HEFFbyFLOODING(I,J)
1936 HSNOW(I,J,bi,bj) = HSNOW(I,J,bi,bj)-
1937 & d_HEFFbyFLOODING(I,J)*ICE2SNOW
1938 ENDDO
1939 ENDDO
1940 #endif
1941 ENDIF
1942
1943 #ifdef SEAICE_ITD
1944 C apply ice and snow thickness changes
1945 C =================================================================
1946 DO IT=1,nITD
1947 DO J=1,sNy
1948 DO I=1,sNx
1949 HEFFITD(I,J,IT,bi,bj) = HEFFITD(I,J,IT,bi,bj)
1950 & + d_HEFFbySublim_ITD(I,J,IT)
1951 & + d_HEFFbyOCNonICE_ITD(I,J,IT)
1952 & + d_HEFFbyATMonOCN_ITD(I,J,IT)
1953 & + d_HEFFbyFLOODING_ITD(I,J,IT)
1954 HSNOWITD(I,J,IT,bi,bj) = HSNOWITD(I,J,IT,bi,bj)
1955 & + d_HSNWbySublim_ITD(I,J,IT)
1956 & + d_HSNWbyATMonSNW_ITD(I,J,IT)
1957 & + d_HSNWbyRAIN_ITD(I,J,IT)
1958 & + d_HSNWbyOCNonSNW_ITD(I,J,IT)
1959 & - d_HEFFbyFLOODING_ITD(I,J,IT)
1960 & * ICE2SNOW
1961 ENDDO
1962 ENDDO
1963 ENDDO
1964 #endif
1965
1966 C ===================================================================
1967 C ==========PART 4: determine ice cover fraction increments=========-
1968 C ===================================================================
1969
1970 #ifdef ALLOW_AUTODIFF_TAMC
1971 CADJ STORE d_HEFFbyATMonOCN = comlev1_bibj,key=iicekey,byte=isbyte
1972 CADJ STORE d_HEFFbyATMonOCN_cover = comlev1_bibj,key=iicekey,byte=isbyte
1973 CADJ STORE d_HEFFbyATMonOCN_open = comlev1_bibj,key=iicekey,byte=isbyte
1974 CADJ STORE d_HEFFbyOCNonICE = comlev1_bibj,key=iicekey,byte=isbyte
1975 CADJ STORE recip_heffActual = comlev1_bibj,key=iicekey,byte=isbyte
1976 CADJ STORE d_hsnwbyatmonsnw = comlev1_bibj,key=iicekey,byte=isbyte
1977 cph(
1978 cphCADJ STORE d_AREAbyATM = comlev1_bibj,key=iicekey,byte=isbyte
1979 cphCADJ STORE d_AREAbyICE = comlev1_bibj,key=iicekey,byte=isbyte
1980 cphCADJ STORE d_AREAbyOCN = comlev1_bibj,key=iicekey,byte=isbyte
1981 cph)
1982 CADJ STORE a_QbyATM_open = comlev1_bibj,key=iicekey,byte=isbyte
1983 CADJ STORE heffActual = comlev1_bibj,key=iicekey,byte=isbyte
1984 CADJ STORE AREApreTH = comlev1_bibj,key=iicekey,byte=isbyte
1985 CADJ STORE HEFF(:,:,bi,bj) = comlev1_bibj,key=iicekey,byte=isbyte
1986 CADJ STORE HSNOW(:,:,bi,bj) = comlev1_bibj,key=iicekey,byte=isbyte
1987 CADJ STORE AREA(:,:,bi,bj) = comlev1_bibj,key=iicekey,byte=isbyte
1988 #endif /* ALLOW_AUTODIFF_TAMC */
1989
1990 #ifdef SEAICE_ITD
1991 C-- in thinnest category account for lateral ice growth and melt the "non-ITD" way,
1992 C-- so that the ITD simulation with nITD=1 is identical with the non-ITD simulation;
1993 C-- use HEFF, ARE, HSNOW, etc. as temporal storage for 1st category
1994 DO J=1,sNy
1995 DO I=1,sNx
1996 HEFF(I,J,bi,bj)=HEFFITD(I,J,1,bi,bj)
1997 AREA(I,J,bi,bj)=AREAITD(I,J,1,bi,bj)
1998 HSNOW(I,J,bi,bj)=HSNOWITD(I,J,1,bi,bj)
1999 HEFFpreTH(I,J)=HEFFITDpreTH(I,J,1)
2000 AREApreTH(I,J)=AREAITDpreTH(I,J,1)
2001 recip_heffActual(I,J)=recip_heffActualMult(I,J,1)
2002 ENDDO
2003 ENDDO
2004 #endif
2005 DO J=1,sNy
2006 DO I=1,sNx
2007
2008 IF ( YC(I,J,bi,bj) .LT. ZERO ) THEN
2009 recip_HO=1. _d 0 / HO_south
2010 ELSE
2011 recip_HO=1. _d 0 / HO
2012 ENDIF
2013 recip_HH = recip_heffActual(I,J)
2014
2015 C gain of ice over open water : computed from
2016 C (SEAICE_areaGainFormula.EQ.1) from growth by ATM
2017 C (SEAICE_areaGainFormula.EQ.2) from predicted growth by ATM
2018 IF (SEAICE_areaGainFormula.EQ.1) THEN
2019 tmpscal4 = MAX(ZERO,d_HEFFbyATMonOCN_open(I,J))
2020 ELSE
2021 tmpscal4=MAX(ZERO,a_QbyATM_open(I,J))
2022 ENDIF
2023 #ifdef SEAICE_GREASE
2024 tmpscal4 = d_AREAbyGREASE(I,J)/recip_HO
2025 #endif
2026
2027 C loss of ice cover by melting : computed from
2028 C (SEAICE_areaLossFormula.EQ.1) from all but only melt conributions by ATM and OCN
2029 C (SEAICE_areaLossFormula.EQ.2) from net melt-growth>0 by ATM and OCN
2030 C (SEAICE_areaLossFormula.EQ.3) from predicted melt by ATM
2031 IF (SEAICE_areaLossFormula.EQ.1) THEN
2032 tmpscal3 = MIN( 0. _d 0 , d_HEFFbyATMonOCN_cover(I,J) )
2033 & + MIN( 0. _d 0 , d_HEFFbyATMonOCN_open(I,J) )
2034 & + MIN( 0. _d 0 , d_HEFFbyOCNonICE(I,J) )
2035 ELSEIF (SEAICE_areaLossFormula.EQ.2) THEN
2036 tmpscal3 = MIN( 0. _d 0 , d_HEFFbyATMonOCN_cover(I,J)
2037 & + d_HEFFbyATMonOCN_open(I,J) + d_HEFFbyOCNonICE(I,J) )
2038 ELSE
2039 C compute heff after ice melt by ocn:
2040 tmpscal0=HEFF(I,J,bi,bj) - d_HEFFbyATMonOCN(I,J)
2041 C compute available heat left after snow melt by atm:
2042 tmpscal1= a_QbyATM_open(I,J)+a_QbyATM_cover(I,J)
2043 & - d_HSNWbyATMonSNW(I,J)*SNOW2ICE
2044 C could not melt more than all the ice
2045 tmpscal2 = MAX(-tmpscal0,tmpscal1)
2046 tmpscal3 = MIN(ZERO,tmpscal2)
2047 ENDIF
2048
2049 C apply tendency
2050 IF ( (HEFF(i,j,bi,bj).GT.0. _d 0).OR.
2051 & (HSNOW(i,j,bi,bj).GT.0. _d 0) ) THEN
2052 AREA(I,J,bi,bj)=MAX(0. _d 0,
2053 & MIN( SEAICE_area_max, AREA(I,J,bi,bj)
2054 & + recip_HO*tmpscal4+HALF*recip_HH*tmpscal3 ))
2055 ELSE
2056 AREA(I,J,bi,bj)=0. _d 0
2057 ENDIF
2058 #ifdef ALLOW_SITRACER
2059 SItrAREA(I,J,bi,bj,3)=AREA(I,J,bi,bj)
2060 #endif /* ALLOW_SITRACER */
2061 #ifdef ALLOW_DIAGNOSTICS
2062 d_AREAbyATM(I,J)=
2063 & recip_HO*MAX(ZERO,d_HEFFbyATMonOCN_open(I,J))
2064 & +HALF*recip_HH*MIN(0. _d 0,d_HEFFbyATMonOCN_open(I,J))
2065 d_AREAbyICE(I,J)=
2066 & HALF*recip_HH*MIN(0. _d 0,d_HEFFbyATMonOCN_cover(I,J))
2067 d_AREAbyOCN(I,J)=
2068 & HALF*recip_HH*MIN( 0. _d 0,d_HEFFbyOCNonICE(I,J) )
2069 #endif /* ALLOW_DIAGNOSTICS */
2070 ENDDO
2071 ENDDO
2072 #ifdef SEAICE_ITD
2073 C transfer 1st category values back into ITD variables
2074 DO J=1,sNy
2075 DO I=1,sNx
2076 HEFFITD(I,J,1,bi,bj)=HEFF(I,J,bi,bj)
2077 AREAITD(I,J,1,bi,bj)=AREA(I,J,bi,bj)
2078 HSNOWITD(I,J,1,bi,bj)=HSNOW(I,J,bi,bj)
2079 ENDDO
2080 ENDDO
2081 C now melt ice laterally in all other thickness categories
2082 C (areal growth, i.e. new ice formation, only occurrs in 1st category)
2083 IF (nITD .gt. 1) THEN
2084 DO IT=2,nITD
2085 DO J=1,sNy
2086 DO I=1,sNx
2087 IF (HEFFITD(I,J,IT,bi,bj).LE.ZERO) THEN
2088 C when thickness is zero, area should be zero, too:
2089 AREAITD(I,J,IT,bi,bj)=ZERO
2090 ELSE
2091 C actual ice thickness from before thermodynamic changes:
2092 tmpscal1=HEFFITDpreTH(I,J,IT)/AREAITDpreTH(I,J,IT)
2093 C melt ice laterally based on an average floe sice
2094 C following Steele (1992)
2095 AREAITD(I,J,IT,bi,bj) = AREAITD(I,J,IT,bi,bj)
2096 & * (ONE - latMeltFrac(I,J,IT))
2097 AREAITD(I,J,IT,bi,bj) = max(ZERO,AREAITD(I,J,IT,bi,bj))
2098 C limit area reduction so that actual ice thickness does not increase
2099 AREAITD(I,J,IT,bi,bj) = max(AREAITD(I,J,IT,bi,bj),
2100 & HEFFITD(I,J,IT,bi,bj)/tmpscal1)
2101 ENDIF
2102 #ifdef ALLOW_SITRACER
2103 SItrAREA(I,J,bi,bj,3)=SItrAREA(I,J,bi,bj,3)
2104 & +AREAITD(I,J,IT,bi,bj)
2105 #endif /* ALLOW_SITRACER */
2106 ENDDO
2107 ENDDO
2108 ENDDO
2109 ENDIF
2110 #endif
2111
2112 #if (defined ALLOW_AUTODIFF_TAMC && defined SEAICE_MODIFY_GROWTH_ADJ)
2113 Cgf 'bulk' linearization of area=f(HEFF)
2114 IF ( SEAICEadjMODE.GE.1 ) THEN
2115 #ifdef SEAICE_ITD
2116 DO IT=1,nITD
2117 DO J=1,sNy
2118 DO I=1,sNx
2119 AREAITD(I,J,IT,bi,bj) = AREAITDpreTH(I,J,IT) + 0.1 _d 0 *
2120 & ( HEFFITD(I,J,IT,bi,bj) - HEFFITDpreTH(I,J,IT) )
2121 ENDDO
2122 ENDDO
2123 ENDDO
2124 #else
2125 DO J=1,sNy
2126 DO I=1,sNx
2127 C AREA(I,J,bi,bj) = 0.1 _d 0 * HEFF(I,J,bi,bj)
2128 AREA(I,J,bi,bj) = AREApreTH(I,J) + 0.1 _d 0 *
2129 & ( HEFF(I,J,bi,bj) - HEFFpreTH(I,J) )
2130 ENDDO
2131 ENDDO
2132 #endif
2133 ENDIF
2134 #endif
2135 #ifdef SEAICE_ITD
2136 C check categories for consistency with limits after growth/melt ...
2137 CALL SEAICE_ITD_REDIST(bi, bj, myTime, myIter, myThid)
2138 C ... and update total AREA, HEFF, HSNOW
2139 C (the updated HEFF is used below for ice salinity increments)
2140 CALL SEAICE_ITD_SUM(bi, bj, myTime, myIter, myThid)
2141 #endif
2142 #ifdef SEAICE_GREASE
2143 C convert SItracer 'grease' from grease ice volume back to ratio:
2144 C ===============================================================
2145 DO J=1,sNy
2146 DO I=1,sNx
2147 if (HEFF(I,J,bi,bj).GT.siEps) then
2148 SItracer(I,J,bi,bj,iTrGrease) =
2149 & SItracer(I,J,bi,bj,iTrGrease) / HEFF(I,J,bi,bj)
2150 else
2151 SItracer(I,J,bi,bj,iTrGrease) = 0. _d 0
2152 endif
2153 ENDDO
2154 ENDDO
2155 #endif
2156
2157 C ===================================================================
2158 C =============PART 5: determine ice salinity increments=============
2159 C ===================================================================
2160
2161 #ifndef SEAICE_VARIABLE_SALINITY
2162 # if (defined ALLOW_AUTODIFF_TAMC && defined ALLOW_SALT_PLUME)
2163 CADJ STORE d_HEFFbyNEG = comlev1_bibj,key=iicekey,byte=isbyte
2164 CADJ STORE d_HEFFbyOCNonICE = comlev1_bibj,key=iicekey,byte=isbyte
2165 CADJ STORE d_HEFFbyATMonOCN = comlev1_bibj,key=iicekey,byte=isbyte
2166 CADJ STORE d_HEFFbyATMonOCN_open = comlev1_bibj,key=iicekey,byte=isbyte
2167 CADJ STORE d_HEFFbyATMonOCN_cover = comlev1_bibj,key=iicekey,byte=isbyte
2168 CADJ STORE d_HEFFbyFLOODING = comlev1_bibj,key=iicekey,byte=isbyte
2169 CADJ STORE d_HEFFbySublim = comlev1_bibj,key=iicekey,byte=isbyte
2170 CADJ STORE salt(:,:,kSurface,bi,bj) = comlev1_bibj,
2171 CADJ & key = iicekey, byte = isbyte
2172 # endif /* ALLOW_AUTODIFF_TAMC and ALLOW_SALT_PLUME */
2173 DO J=1,sNy
2174 DO I=1,sNx
2175 tmpscal1 = d_HEFFbyNEG(I,J) + d_HEFFbyOCNonICE(I,J) +
2176 & d_HEFFbyATMonOCN(I,J) + d_HEFFbyFLOODING(I,J)
2177 & + d_HEFFbySublim(I,J)
2178 #ifdef EXF_SEAICE_FRACTION
2179 & + d_HEFFbyRLX(I,J)
2180 #endif
2181 tmpscal2 = tmpscal1 * SEAICE_salt0 * HEFFM(I,J,bi,bj)
2182 & * recip_deltaTtherm * SEAICE_rhoIce
2183 saltFlux(I,J,bi,bj) = tmpscal2
2184 #ifdef ALLOW_SALT_PLUME
2185 tmpscal3 = tmpscal1*salt(I,J,kSurface,bi,bj)*HEFFM(I,J,bi,bj)
2186 & * recip_deltaTtherm * SEAICE_rhoIce
2187 saltPlumeFlux(I,J,bi,bj) = MAX( tmpscal3-tmpscal2 , 0. _d 0)
2188 & *SPsalFRAC
2189 #endif /* ALLOW_SALT_PLUME */
2190 ENDDO
2191 ENDDO
2192 #endif /* ndef SEAICE_VARIABLE_SALINITY */
2193
2194 #ifdef SEAICE_VARIABLE_SALINITY
2195
2196 #ifdef ALLOW_AUTODIFF_TAMC
2197 CADJ STORE hsalt(:,:,bi,bj) = comlev1_bibj,key=iicekey,byte=isbyte
2198 #endif /* ALLOW_AUTODIFF_TAMC */
2199
2200 DO J=1,sNy
2201 DO I=1,sNx
2202 C sum up the terms that affect the salt content of the ice pack
2203 tmpscal1=d_HEFFbyOCNonICE(I,J)+d_HEFFbyATMonOCN(I,J)
2204
2205 C recompute HEFF before thermodynamic updates (which is not AREApreTH in legacy code)
2206 tmpscal2=HEFF(I,J,bi,bj)-tmpscal1-d_HEFFbyFLOODING(I,J)
2207 C tmpscal1 > 0 : m of sea ice that is created
2208 IF ( tmpscal1 .GE. 0.0 ) THEN
2209 saltFlux(I,J,bi,bj) =
2210 & HEFFM(I,J,bi,bj)*recip_deltaTtherm
2211 & *SEAICE_saltFrac*salt(I,J,kSurface,bi,bj)
2212 & *tmpscal1*SEAICE_rhoIce
2213 #ifdef ALLOW_SALT_PLUME
2214 C saltPlumeFlux is defined only during freezing:
2215 saltPlumeFlux(I,J,bi,bj)=
2216 & HEFFM(I,J,bi,bj)*recip_deltaTtherm
2217 & *(ONE-SEAICE_saltFrac)*salt(I,J,kSurface,bi,bj)
2218 & *tmpscal1*SEAICE_rhoIce
2219 & *SPsalFRAC
2220 C if SaltPlumeSouthernOcean=.FALSE. turn off salt plume in Southern Ocean
2221 IF ( .NOT. SaltPlumeSouthernOcean ) THEN
2222 IF ( YC(I,J,bi,bj) .LT. 0.0 _d 0 )
2223 & saltPlumeFlux(i,j,bi,bj) = 0.0 _d 0
2224 ENDIF
2225 #endif /* ALLOW_SALT_PLUME */
2226
2227 C tmpscal1 < 0 : m of sea ice that is melted
2228 ELSE
2229 saltFlux(I,J,bi,bj) =
2230 & HEFFM(I,J,bi,bj)*recip_deltaTtherm
2231 & *HSALT(I,J,bi,bj)
2232 & *tmpscal1/tmpscal2
2233 #ifdef ALLOW_SALT_PLUME
2234 saltPlumeFlux(i,j,bi,bj) = 0.0 _d 0
2235 #endif /* ALLOW_SALT_PLUME */
2236 ENDIF
2237 C update HSALT based on surface saltFlux
2238 HSALT(I,J,bi,bj) = HSALT(I,J,bi,bj) +
2239 & saltFlux(I,J,bi,bj) * SEAICE_deltaTtherm
2240 saltFlux(I,J,bi,bj) =
2241 & saltFlux(I,J,bi,bj) + saltFluxAdjust(I,J)
2242 ENDDO
2243 ENDDO
2244 #endif /* SEAICE_VARIABLE_SALINITY */
2245
2246 #ifdef ALLOW_SITRACER
2247 DO J=1,sNy
2248 DO I=1,sNx
2249 C needs to be here to allow use also with LEGACY branch
2250 SItrHEFF(I,J,bi,bj,5)=HEFF(I,J,bi,bj)
2251 ENDDO
2252 ENDDO
2253 #endif /* ALLOW_SITRACER */
2254
2255 C ===================================================================
2256 C ==============PART 7: determine ocean model forcing================
2257 C ===================================================================
2258
2259 C compute net heat flux leaving/entering the ocean,
2260 C accounting for the part used in melt/freeze processes
2261 C =====================================================
2262
2263 #ifdef SEAICE_ITD
2264 C compute total of "mult" fluxes for ocean forcing
2265 DO J=1,sNy
2266 DO I=1,sNx
2267 a_QbyATM_cover(I,J) = 0.0 _d 0
2268 r_QbyATM_cover(I,J) = 0.0 _d 0
2269 a_QSWbyATM_cover(I,J) = 0.0 _d 0
2270 r_FWbySublim(I,J) = 0.0 _d 0
2271 ENDDO
2272 ENDDO
2273 DO IT=1,nITD
2274 DO J=1,sNy
2275 DO I=1,sNx
2276 C if fluxes in W/m^2 then use:
2277 c a_QbyATM_cover(I,J)=a_QbyATM_cover(I,J)
2278 c & + a_QbyATMmult_cover(I,J,IT) * areaFracFactor(I,J,IT)
2279 c r_QbyATM_cover(I,J)=r_QbyATM_cover(I,J)
2280 c & + r_QbyATMmult_cover(I,J,IT) * areaFracFactor(I,J,IT)
2281 c a_QSWbyATM_cover(I,J)=a_QSWbyATM_cover(I,J)
2282 c & + a_QSWbyATMmult_cover(I,J,IT) * areaFracFactor(I,J,IT)
2283 c r_FWbySublim(I,J)=r_FWbySublim(I,J)
2284 c & + r_FWbySublimMult(I,J,IT) * areaFracFactor(I,J,IT)
2285 C if fluxes in effective ice meters, i.e. ice volume per area, then use:
2286 a_QbyATM_cover(I,J)=a_QbyATM_cover(I,J)
2287 & + a_QbyATMmult_cover(I,J,IT)
2288 r_QbyATM_cover(I,J)=r_QbyATM_cover(I,J)
2289 & + r_QbyATMmult_cover(I,J,IT)
2290 a_QSWbyATM_cover(I,J)=a_QSWbyATM_cover(I,J)
2291 & + a_QSWbyATMmult_cover(I,J,IT)
2292 r_FWbySublim(I,J)=r_FWbySublim(I,J)
2293 & + r_FWbySublimMult(I,J,IT)
2294 ENDDO
2295 ENDDO
2296 ENDDO
2297 #endif
2298
2299 #ifdef ALLOW_AUTODIFF_TAMC
2300 CADJ STORE d_hsnwbyneg = comlev1_bibj,key=iicekey,byte=isbyte
2301 CADJ STORE d_hsnwbyocnonsnw = comlev1_bibj,key=iicekey,byte=isbyte
2302 #endif /* ALLOW_AUTODIFF_TAMC */
2303
2304 DO J=1,sNy
2305 DO I=1,sNx
2306 QNET(I,J,bi,bj) = r_QbyATM_cover(I,J) + r_QbyATM_open(I,J)
2307 & + a_QSWbyATM_cover(I,J)
2308 & - ( d_HEFFbyOCNonICE(I,J)
2309 & + d_HSNWbyOCNonSNW(I,J)*SNOW2ICE
2310 & + d_HEFFbyNEG(I,J)
2311 #ifdef EXF_SEAICE_FRACTION
2312 & + d_HEFFbyRLX(I,J)
2313 #endif
2314 & + d_HSNWbyNEG(I,J)*SNOW2ICE
2315 & - convertPRECIP2HI *
2316 & snowPrecip(i,j,bi,bj) * (ONE-AREApreTH(I,J))
2317 & ) * maskC(I,J,kSurface,bi,bj)
2318 ENDDO
2319 ENDDO
2320 DO J=1,sNy
2321 DO I=1,sNx
2322 QSW(I,J,bi,bj) = a_QSWbyATM_cover(I,J) + a_QSWbyATM_open(I,J)
2323 ENDDO
2324 ENDDO
2325
2326 C switch heat fluxes from 'effective' ice meters to W/m2
2327 C ======================================================
2328
2329 DO J=1,sNy
2330 DO I=1,sNx
2331 QNET(I,J,bi,bj) = QNET(I,J,bi,bj)*convertHI2Q
2332 QSW(I,J,bi,bj) = QSW(I,J,bi,bj)*convertHI2Q
2333 ENDDO
2334 ENDDO
2335
2336 #ifndef SEAICE_DISABLE_HEATCONSFIX
2337 C treat advective heat flux by ocean to ice water exchange (at 0decC)
2338 C ===================================================================
2339 # ifdef ALLOW_AUTODIFF_TAMC
2340 CADJ STORE d_HEFFbyNEG = comlev1_bibj,key=iicekey,byte=isbyte
2341 CADJ STORE d_HEFFbyOCNonICE = comlev1_bibj,key=iicekey,byte=isbyte
2342 CADJ STORE d_HEFFbyATMonOCN = comlev1_bibj,key=iicekey,byte=isbyte
2343 CADJ STORE d_HSNWbyNEG = comlev1_bibj,key=iicekey,byte=isbyte
2344 CADJ STORE d_HSNWbyOCNonSNW = comlev1_bibj,key=iicekey,byte=isbyte
2345 CADJ STORE d_HSNWbyATMonSNW = comlev1_bibj,key=iicekey,byte=isbyte
2346 CADJ STORE theta(:,:,kSurface,bi,bj) = comlev1_bibj,
2347 CADJ & key = iicekey, byte = isbyte
2348 # endif /* ALLOW_AUTODIFF_TAMC */
2349 Cgf Unlike for evap and precip, the temperature of gained/lost
2350 C ocean liquid water due to melt/freeze of solid water cannot be chosen
2351 C arbitrarily to be e.g. the ocean SST. Indeed the present seaice model
2352 C implies a constant ice temperature of 0degC. If melt/freeze water is exchanged
2353 C at a different temperature, it leads to a loss of conservation in the
2354 C ocean+ice system. While this is mostly a serious issue in the
2355 C real fresh water + non linear free surface framework, a mismatch
2356 C between ice and ocean boundary condition can result in all cases.
2357 C Below we therefore anticipate on external_forcing_surf.F
2358 C to diagnoze and/or apply the correction to QNET.
2359 DO J=1,sNy
2360 DO I=1,sNx
2361 C ocean water going to ice/snow, in precip units
2362 tmpscal3=rhoConstFresh*maskC(I,J,kSurface,bi,bj)*(
2363 & ( d_HSNWbyATMonSNW(I,J)*SNOW2ICE
2364 & + d_HSNWbyOCNonSNW(I,J)*SNOW2ICE
2365 & + d_HEFFbyOCNonICE(I,J) + d_HEFFbyATMonOCN(I,J)
2366 & + d_HEFFbyNEG(I,J) + d_HSNWbyNEG(I,J)*SNOW2ICE )
2367 & * convertHI2PRECIP
2368 & - snowPrecip(i,j,bi,bj) * (ONE-AREApreTH(I,J)) )
2369 C factor in the heat content as done in external_forcing_surf.F
2370 IF ( (temp_EvPrRn.NE.UNSET_RL).AND.
2371 & useRealFreshWaterFlux.AND.(nonlinFreeSurf.NE.0) ) THEN
2372 tmpscal1 = - tmpscal3*
2373 & HeatCapacity_Cp * temp_EvPrRn
2374 ELSEIF ( (temp_EvPrRn.EQ.UNSET_RL).AND.
2375 & useRealFreshWaterFlux.AND.(nonlinFreeSurf.NE.0) ) THEN
2376 tmpscal1 = - tmpscal3*
2377 & HeatCapacity_Cp * theta(I,J,kSurface,bi,bj)
2378 ELSEIF ( (temp_EvPrRn.NE.UNSET_RL) ) THEN
2379 tmpscal1 = - tmpscal3*HeatCapacity_Cp*
2380 & ( temp_EvPrRn - theta(I,J,kSurface,bi,bj) )
2381 ELSEIF ( (temp_EvPrRn.EQ.UNSET_RL) ) THEN
2382 tmpscal1 = ZERO
2383 ENDIF
2384 #ifdef ALLOW_DIAGNOSTICS
2385 C in all cases, diagnoze the boundary condition mismatch to SIaaflux
2386 DIAGarrayA(I,J)=tmpscal1
2387 #endif
2388 C remove the mismatch when real fresh water is exchanged (at 0degC here)
2389 IF ( useRealFreshWaterFlux.AND.(nonlinFreeSurf.GT.0)
2390 & .AND.SEAICEheatConsFix )
2391 & QNET(I,J,bi,bj)=QNET(I,J,bi,bj)+tmpscal1
2392 ENDDO
2393 ENDDO
2394 #ifdef ALLOW_DIAGNOSTICS
2395 IF ( useDiagnostics ) THEN
2396 CALL DIAGNOSTICS_FILL(DIAGarrayA,
2397 & 'SIaaflux',0,1,3,bi,bj,myThid)
2398 ENDIF
2399 #endif
2400 #endif /* ndef SEAICE_DISABLE_HEATCONSFIX */
2401
2402 C compute the net heat flux, incl. adv. by water, entering ocean+ice
2403 C ===================================================================
2404 DO J=1,sNy
2405 DO I=1,sNx
2406 Cgf 1) SIatmQnt (analogous to qnet; excl. adv. by water exch.)
2407 CML If I consider the atmosphere above the ice, the surface flux
2408 CML which is relevant for the air temperature dT/dt Eq
2409 CML accounts for sensible and radiation (with different treatment
2410 CML according to wave-length) fluxes but not for "latent heat flux",
2411 CML since it does not contribute to heating the air.
2412 CML So this diagnostic is only good for heat budget calculations within
2413 CML the ice-ocean system.
2414 SIatmQnt(I,J,bi,bj) =
2415 & maskC(I,J,kSurface,bi,bj)*convertHI2Q*(
2416 & a_QSWbyATM_cover(I,J) +
2417 & a_QbyATM_cover(I,J) + a_QbyATM_open(I,J) )
2418 Cgf 2) SItflux (analogous to tflux; includes advection by water
2419 C exchanged between atmosphere and ocean+ice)
2420 C solid water going to atm, in precip units
2421 tmpscal1 = rhoConstFresh*maskC(I,J,kSurface,bi,bj)
2422 & * convertHI2PRECIP * ( - d_HSNWbyRAIN(I,J)*SNOW2ICE
2423 & + a_FWbySublim(I,J) - r_FWbySublim(I,J) )
2424 C liquid water going to atm, in precip units
2425 tmpscal2=rhoConstFresh*maskC(I,J,kSurface,bi,bj)*
2426 & ( ( EVAP(I,J,bi,bj)-PRECIP(I,J,bi,bj) )
2427 & * ( ONE - AREApreTH(I,J) )
2428 #ifdef ALLOW_RUNOFF
2429 & - RUNOFF(I,J,bi,bj)
2430 #endif /* ALLOW_RUNOFF */
2431 & + ( d_HFRWbyRAIN(I,J) + r_FWbySublim(I,J) )
2432 & *convertHI2PRECIP )
2433 C In real fresh water flux + nonlinFS, we factor in the advected specific
2434 C energy (referenced to 0 for 0deC liquid water). In virtual salt flux or
2435 C linFS, rain/evap get a special treatment (see external_forcing_surf.F).
2436 tmpscal1= - tmpscal1*
2437 & ( -SEAICE_lhFusion + HeatCapacity_Cp * ZERO )
2438 IF ( (temp_EvPrRn.NE.UNSET_RL).AND.
2439 & useRealFreshWaterFlux.AND.(nonlinFreeSurf.NE.0) ) THEN
2440 tmpscal2= - tmpscal2*
2441 & ( ZERO + HeatCapacity_Cp * temp_EvPrRn )
2442 ELSEIF ( (temp_EvPrRn.EQ.UNSET_RL).AND.
2443 & useRealFreshWaterFlux.AND.(nonlinFreeSurf.NE.0) ) THEN
2444 tmpscal2= - tmpscal2*
2445 & ( ZERO + HeatCapacity_Cp * theta(I,J,kSurface,bi,bj) )
2446 ELSEIF ( (temp_EvPrRn.NE.UNSET_RL) ) THEN
2447 tmpscal2= - tmpscal2*HeatCapacity_Cp*
2448 & ( temp_EvPrRn - theta(I,J,kSurface,bi,bj) )
2449 ELSEIF ( (temp_EvPrRn.EQ.UNSET_RL) ) THEN
2450 tmpscal2= ZERO
2451 ENDIF
2452 SItflux(I,J,bi,bj)= SIatmQnt(I,J,bi,bj)-tmpscal1-tmpscal2
2453 ENDDO
2454 ENDDO
2455
2456 C compute net fresh water flux leaving/entering
2457 C the ocean, accounting for fresh/salt water stocks.
2458 C ==================================================
2459
2460 DO J=1,sNy
2461 DO I=1,sNx
2462 tmpscal1= d_HSNWbyATMonSNW(I,J)*SNOW2ICE
2463 & +d_HFRWbyRAIN(I,J)
2464 & +d_HSNWbyOCNonSNW(I,J)*SNOW2ICE
2465 & +d_HEFFbyOCNonICE(I,J)
2466 & +d_HEFFbyATMonOCN(I,J)
2467 & +d_HEFFbyNEG(I,J)
2468 #ifdef EXF_SEAICE_FRACTION
2469 & +d_HEFFbyRLX(I,J)
2470 #endif
2471 & +d_HSNWbyNEG(I,J)*SNOW2ICE
2472 C If r_FWbySublim>0, then it is evaporated from ocean.
2473 & +r_FWbySublim(I,J)
2474 EmPmR(I,J,bi,bj) = maskC(I,J,kSurface,bi,bj)*(
2475 & ( EVAP(I,J,bi,bj)-PRECIP(I,J,bi,bj) )
2476 & * ( ONE - AREApreTH(I,J) )
2477 #ifdef ALLOW_RUNOFF
2478 & - RUNOFF(I,J,bi,bj)
2479 #endif /* ALLOW_RUNOFF */
2480 & + tmpscal1*convertHI2PRECIP
2481 & )*rhoConstFresh
2482 C and the flux leaving/entering the ocean+ice
2483 SIatmFW(I,J,bi,bj) = maskC(I,J,kSurface,bi,bj)*(
2484 & EVAP(I,J,bi,bj)*( ONE - AREApreTH(I,J) )
2485 & - PRECIP(I,J,bi,bj)
2486 #ifdef ALLOW_RUNOFF
2487 & - RUNOFF(I,J,bi,bj)
2488 #endif /* ALLOW_RUNOFF */
2489 & )*rhoConstFresh
2490 & + a_FWbySublim(I,J) * SEAICE_rhoIce * recip_deltaTtherm
2491
2492 ENDDO
2493 ENDDO
2494
2495 #ifdef ALLOW_SSH_GLOBMEAN_COST_CONTRIBUTION
2496 C--
2497 DO J=1,sNy
2498 DO I=1,sNx
2499 frWtrAtm(I,J,bi,bj) = maskC(I,J,kSurface,bi,bj)*(
2500 & PRECIP(I,J,bi,bj)
2501 & - EVAP(I,J,bi,bj)*( ONE - AREApreTH(I,J) )
2502 # ifdef ALLOW_RUNOFF
2503 & + RUNOFF(I,J,bi,bj)
2504 # endif /* ALLOW_RUNOFF */
2505 & )*rhoConstFresh
2506 # ifdef SEAICE_ADD_SUBLIMATION_TO_FWBUDGET
2507 & - a_FWbySublim(I,J)*AREApreTH(I,J)
2508 # endif /* SEAICE_ADD_SUBLIMATION_TO_FWBUDGET */
2509 ENDDO
2510 ENDDO
2511 C--
2512 #else /* ndef ALLOW_SSH_GLOBMEAN_COST_CONTRIBUTION */
2513 C--
2514 # ifdef ALLOW_MEAN_SFLUX_COST_CONTRIBUTION
2515 DO J=1,sNy
2516 DO I=1,sNx
2517 frWtrAtm(I,J,bi,bj) = maskC(I,J,kSurface,bi,bj)*(
2518 & PRECIP(I,J,bi,bj)
2519 & - EVAP(I,J,bi,bj)
2520 & *( ONE - AREApreTH(I,J) )
2521 # ifdef ALLOW_RUNOFF
2522 & + RUNOFF(I,J,bi,bj)
2523 # endif /* ALLOW_RUNOFF */
2524 & )*rhoConstFresh
2525 & - a_FWbySublim(I,J) * SEAICE_rhoIce * recip_deltaTtherm
2526 ENDDO
2527 ENDDO
2528 # endif
2529 C--
2530 #endif /* ALLOW_SSH_GLOBMEAN_COST_CONTRIBUTION */
2531
2532 #ifdef SEAICE_DEBUG
2533 CALL PLOT_FIELD_XYRL( QSW,'Current QSW ', myIter, myThid )
2534 CALL PLOT_FIELD_XYRL( QNET,'Current QNET ', myIter, myThid )
2535 CALL PLOT_FIELD_XYRL( EmPmR,'Current EmPmR ', myIter, myThid )
2536 #endif /* SEAICE_DEBUG */
2537
2538 C Sea Ice Load on the sea surface.
2539 C =================================
2540
2541 #ifdef ALLOW_AUTODIFF_TAMC
2542 CADJ STORE heff(:,:,bi,bj) = comlev1_bibj,key=iicekey,byte=isbyte
2543 CADJ STORE hsnow(:,:,bi,bj) = comlev1_bibj,key=iicekey,byte=isbyte
2544 #endif /* ALLOW_AUTODIFF_TAMC */
2545
2546 IF ( useRealFreshWaterFlux ) THEN
2547 DO J=1,sNy
2548 DO I=1,sNx
2549 #ifdef SEAICE_CAP_ICELOAD
2550 tmpscal1 = HEFF(I,J,bi,bj)*SEAICE_rhoIce
2551 & + HSNOW(I,J,bi,bj)*SEAICE_rhoSnow
2552 tmpscal2 = MIN(tmpscal1,heffTooHeavy*rhoConst)
2553 #else
2554 tmpscal2 = HEFF(I,J,bi,bj)*SEAICE_rhoIce
2555 & + HSNOW(I,J,bi,bj)*SEAICE_rhoSnow
2556 #endif
2557 sIceLoad(i,j,bi,bj) = tmpscal2
2558 ENDDO
2559 ENDDO
2560 ENDIF
2561
2562 #ifdef ALLOW_BALANCE_FLUXES
2563 C Compute tile integrals of heat/fresh water fluxes to/from atm.
2564 C ==============================================================
2565 FWFsiTile(bi,bj) = 0. _d 0
2566 IF ( balanceEmPmR ) THEN
2567 DO j=1,sNy
2568 DO i=1,sNx
2569 FWFsiTile(bi,bj) =
2570 & FWFsiTile(bi,bj) + SIatmFW(i,j,bi,bj)
2571 & * rA(i,j,bi,bj) * maskInC(i,j,bi,bj)
2572 ENDDO
2573 ENDDO
2574 ENDIF
2575 C to translate global mean FWF adjustements (see below) we may need :
2576 FWF2HFsiTile(bi,bj) = 0. _d 0
2577 IF ( balanceEmPmR.AND.(temp_EvPrRn.EQ.UNSET_RL) ) THEN
2578 DO j=1,sNy
2579 DO i=1,sNx
2580 FWF2HFsiTile(bi,bj) = FWF2HFsiTile(bi,bj) +
2581 & HeatCapacity_Cp * theta(I,J,kSurface,bi,bj)
2582 & * rA(i,j,bi,bj) * maskInC(i,j,bi,bj)
2583 ENDDO
2584 ENDDO
2585 ENDIF
2586 HFsiTile(bi,bj) = 0. _d 0
2587 IF ( balanceQnet ) THEN
2588 DO j=1,sNy
2589 DO i=1,sNx
2590 HFsiTile(bi,bj) =
2591 & HFsiTile(bi,bj) + SItflux(i,j,bi,bj)
2592 & * rA(i,j,bi,bj) * maskInC(i,j,bi,bj)
2593 ENDDO
2594 ENDDO
2595 ENDIF
2596 #endif /* ALLOW_BALANCE_FLUXES */
2597
2598 C ===================================================================
2599 C ======================PART 8: diagnostics==========================
2600 C ===================================================================
2601
2602 #ifdef ALLOW_DIAGNOSTICS
2603 IF ( useDiagnostics ) THEN
2604 tmpscal1=1. _d 0 * recip_deltaTtherm
2605 CALL DIAGNOSTICS_SCALE_FILL(a_QbyATM_cover,
2606 & tmpscal1,1,'SIaQbATC',0,1,3,bi,bj,myThid)
2607 CALL DIAGNOSTICS_SCALE_FILL(a_QbyATM_open,
2608 & tmpscal1,1,'SIaQbATO',0,1,3,bi,bj,myThid)
2609 CALL DIAGNOSTICS_SCALE_FILL(a_QbyOCN,
2610 & tmpscal1,1,'SIaQbOCN',0,1,3,bi,bj,myThid)
2611 CALL DIAGNOSTICS_SCALE_FILL(d_HEFFbyOCNonICE,
2612 & tmpscal1,1,'SIdHbOCN',0,1,3,bi,bj,myThid)
2613 CALL DIAGNOSTICS_SCALE_FILL(d_HEFFbyATMonOCN_cover,
2614 & tmpscal1,1,'SIdHbATC',0,1,3,bi,bj,myThid)
2615 CALL DIAGNOSTICS_SCALE_FILL(d_HEFFbyATMonOCN_open,
2616 & tmpscal1,1,'SIdHbATO',0,1,3,bi,bj,myThid)
2617 CALL DIAGNOSTICS_SCALE_FILL(d_HEFFbyFLOODING,
2618 & tmpscal1,1,'SIdHbFLO',0,1,3,bi,bj,myThid)
2619 CALL DIAGNOSTICS_SCALE_FILL(d_HSNWbyOCNonSNW,
2620 & tmpscal1,1,'SIdSbOCN',0,1,3,bi,bj,myThid)
2621 CALL DIAGNOSTICS_SCALE_FILL(d_HSNWbyATMonSNW,
2622 & tmpscal1,1,'SIdSbATC',0,1,3,bi,bj,myThid)
2623 CALL DIAGNOSTICS_SCALE_FILL(d_AREAbyATM,
2624 & tmpscal1,1,'SIdAbATO',0,1,3,bi,bj,myThid)
2625 CALL DIAGNOSTICS_SCALE_FILL(d_AREAbyICE,
2626 & tmpscal1,1,'SIdAbATC',0,1,3,bi,bj,myThid)
2627 CALL DIAGNOSTICS_SCALE_FILL(d_AREAbyOCN,
2628 & tmpscal1,1,'SIdAbOCN',0,1,3,bi,bj,myThid)
2629 CALL DIAGNOSTICS_SCALE_FILL(r_QbyATM_open,
2630 & convertHI2Q,1, 'SIqneto ',0,1,3,bi,bj,myThid)
2631 CALL DIAGNOSTICS_SCALE_FILL(r_QbyATM_cover,
2632 & convertHI2Q,1, 'SIqneti ',0,1,3,bi,bj,myThid)
2633 C three that actually need intermediate storage
2634 DO J=1,sNy
2635 DO I=1,sNx
2636 DIAGarrayA(I,J) = maskC(I,J,kSurface,bi,bj)
2637 & * d_HSNWbyRAIN(I,J)*SEAICE_rhoSnow*recip_deltaTtherm
2638 DIAGarrayB(I,J) = AREA(I,J,bi,bj)-AREApreTH(I,J)
2639 ENDDO
2640 ENDDO
2641 CALL DIAGNOSTICS_FILL(DIAGarrayA,
2642 & 'SIsnPrcp',0,1,3,bi,bj,myThid)
2643 CALL DIAGNOSTICS_SCALE_FILL(DIAGarrayB,
2644 & tmpscal1,1,'SIdA ',0,1,3,bi,bj,myThid)
2645 DO J=1,sNy
2646 DO I=1,sNx
2647 DIAGarrayB(I,J) = maskC(I,J,kSurface,bi,bj) *
2648 & a_FWbySublim(I,J) * SEAICE_rhoIce * recip_deltaTtherm
2649 ENDDO
2650 ENDDO
2651 CALL DIAGNOSTICS_FILL(DIAGarrayB,
2652 & 'SIfwSubl',0,1,3,bi,bj,myThid)
2653 C
2654 DO J=1,sNy
2655 DO I=1,sNx
2656 C the actual Freshwater flux of sublimated ice, >0 decreases ice
2657 DIAGarrayA(I,J) = maskC(I,J,kSurface,bi,bj)
2658 & * (a_FWbySublim(I,J)-r_FWbySublim(I,J))
2659 & * SEAICE_rhoIce * recip_deltaTtherm
2660 C the residual Freshwater flux of sublimated ice
2661 DIAGarrayC(I,J) = maskC(I,J,kSurface,bi,bj)
2662 & * r_FWbySublim(I,J)
2663 & * SEAICE_rhoIce * recip_deltaTtherm
2664 C the latent heat flux
2665 tmpscal1= EVAP(I,J,bi,bj)*( ONE - AREApreTH(I,J) )
2666 & + r_FWbySublim(I,J)*convertHI2PRECIP
2667 tmpscal2= ( a_FWbySublim(I,J)-r_FWbySublim(I,J) )
2668 & * convertHI2PRECIP
2669 tmpscal3= SEAICE_lhEvap+SEAICE_lhFusion
2670 DIAGarrayB(I,J) = -maskC(I,J,kSurface,bi,bj)*rhoConstFresh
2671 & * ( tmpscal1*SEAICE_lhEvap + tmpscal2*tmpscal3 )
2672 ENDDO
2673 ENDDO
2674 CALL DIAGNOSTICS_FILL(DIAGarrayA,'SIacSubl',0,1,3,bi,bj,myThid)
2675 CALL DIAGNOSTICS_FILL(DIAGarrayC,'SIrsSubl',0,1,3,bi,bj,myThid)
2676 CALL DIAGNOSTICS_FILL(DIAGarrayB,'SIhl ',0,1,3,bi,bj,myThid)
2677
2678 ENDIF
2679 #endif /* ALLOW_DIAGNOSTICS */
2680
2681 C close bi,bj loops
2682 ENDDO
2683 ENDDO
2684
2685 C ===================================================================
2686 C =========PART 9: HF/FWF global integrals and balancing=============
2687 C ===================================================================
2688
2689 #ifdef ALLOW_BALANCE_FLUXES
2690
2691 C 1) global sums
2692 # ifdef ALLOW_AUTODIFF_TAMC
2693 CADJ STORE FWFsiTile = comlev1, key=ikey_dynamics, kind=isbyte
2694 CADJ STORE HFsiTile = comlev1, key=ikey_dynamics, kind=isbyte
2695 CADJ STORE FWF2HFsiTile = comlev1, key=ikey_dynamics, kind=isbyte
2696 # endif /* ALLOW_AUTODIFF_TAMC */
2697 FWFsiGlob=0. _d 0
2698 IF ( balanceEmPmR )
2699 & CALL GLOBAL_SUM_TILE_RL( FWFsiTile, FWFsiGlob, myThid )
2700 FWF2HFsiGlob=0. _d 0
2701 IF ( balanceEmPmR.AND.(temp_EvPrRn.EQ.UNSET_RL) ) THEN
2702 CALL GLOBAL_SUM_TILE_RL(FWF2HFsiTile, FWF2HFsiGlob, myThid)
2703 ELSEIF ( balanceEmPmR ) THEN
2704 FWF2HFsiGlob=HeatCapacity_Cp * temp_EvPrRn * globalArea
2705 ENDIF
2706 HFsiGlob=0. _d 0
2707 IF ( balanceQnet )
2708 & CALL GLOBAL_SUM_TILE_RL( HFsiTile, HFsiGlob, myThid )
2709
2710 C 2) global means
2711 C mean SIatmFW
2712 tmpscal0=FWFsiGlob / globalArea
2713 C corresponding mean advection by atm to ocean+ice water exchange
2714 C (if mean SIatmFW was removed uniformely from ocean)
2715 tmpscal1=FWFsiGlob / globalArea * FWF2HFsiGlob / globalArea
2716 C mean SItflux (before potential adjustement due to SIatmFW)
2717 tmpscal2=HFsiGlob / globalArea
2718 C mean SItflux (after potential adjustement due to SIatmFW)
2719 IF ( balanceEmPmR ) tmpscal2=tmpscal2-tmpscal1
2720
2721 C 3) balancing adjustments
2722 IF ( balanceEmPmR ) THEN
2723 DO bj=myByLo(myThid),myByHi(myThid)
2724 DO bi=myBxLo(myThid),myBxHi(myThid)
2725 DO j=1-OLy,sNy+OLy
2726 DO i=1-OLx,sNx+OLx
2727 empmr(i,j,bi,bj) = empmr(i,j,bi,bj) - tmpscal0
2728 SIatmFW(i,j,bi,bj) = SIatmFW(i,j,bi,bj) - tmpscal0
2729 C adjust SItflux consistently
2730 IF ( (temp_EvPrRn.NE.UNSET_RL).AND.
2731 & useRealFreshWaterFlux.AND.(nonlinFreeSurf.NE.0) ) THEN
2732 tmpscal1=
2733 & ( ZERO + HeatCapacity_Cp * temp_EvPrRn )
2734 ELSEIF ( (temp_EvPrRn.EQ.UNSET_RL).AND.
2735 & useRealFreshWaterFlux.AND.(nonlinFreeSurf.NE.0) ) THEN
2736 tmpscal1=
2737 & ( ZERO + HeatCapacity_Cp * theta(I,J,kSurface,bi,bj) )
2738 ELSEIF ( (temp_EvPrRn.NE.UNSET_RL) ) THEN
2739 tmpscal1=
2740 & HeatCapacity_Cp*(temp_EvPrRn - theta(I,J,kSurface,bi,bj))
2741 ELSE
2742 tmpscal1=ZERO
2743 ENDIF
2744 SItflux(i,j,bi,bj) = SItflux(i,j,bi,bj) - tmpscal0*tmpscal1
2745 C no qnet or tflux adjustement is needed
2746 ENDDO
2747 ENDDO
2748 ENDDO
2749 ENDDO
2750 IF ( balancePrintMean ) THEN
2751 _BEGIN_MASTER( myThid )
2752 WRITE(msgBuf,'(a,a,e24.17)') 'rm Global mean of ',
2753 & 'SIatmFW = ', tmpscal0
2754 CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
2755 & SQUEEZE_RIGHT, myThid )
2756 _END_MASTER( myThid )
2757 ENDIF
2758 ENDIF
2759 IF ( balanceQnet ) THEN
2760 DO bj=myByLo(myThid),myByHi(myThid)
2761 DO bi=myBxLo(myThid),myBxHi(myThid)
2762 DO j=1-OLy,sNy+OLy
2763 DO i=1-OLx,sNx+OLx
2764 SItflux(i,j,bi,bj) = SItflux(i,j,bi,bj) - tmpscal2
2765 qnet(i,j,bi,bj) = qnet(i,j,bi,bj) - tmpscal2
2766 SIatmQnt(i,j,bi,bj) = SIatmQnt(i,j,bi,bj) - tmpscal2
2767 ENDDO
2768 ENDDO
2769 ENDDO
2770 ENDDO
2771 IF ( balancePrintMean ) THEN
2772 _BEGIN_MASTER( myThid )
2773 WRITE(msgBuf,'(a,a,e24.17)') 'rm Global mean of ',
2774 & 'SItflux = ', tmpscal2
2775 CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
2776 & SQUEEZE_RIGHT, myThid )
2777 _END_MASTER( myThid )
2778 ENDIF
2779 ENDIF
2780 #endif /* ALLOW_BALANCE_FLUXES */
2781
2782 #ifdef ALLOW_DIAGNOSTICS
2783 IF ( useDiagnostics ) THEN
2784 C these diags need to be done outside of the bi,bj loop so that
2785 C we may do potential global mean adjustement to them consistently.
2786 CALL DIAGNOSTICS_FILL(SItflux,
2787 & 'SItflux ',0,1,0,1,1,myThid)
2788 CALL DIAGNOSTICS_FILL(SIatmQnt,
2789 & 'SIatmQnt',0,1,0,1,1,myThid)
2790 C SIatmFW follows the same convention as empmr -- SIatmFW diag does not
2791 tmpscal1= - 1. _d 0
2792 CALL DIAGNOSTICS_SCALE_FILL(SIatmFW,
2793 & tmpscal1,1,'SIatmFW ',0,1,0,1,1,myThid)
2794 ENDIF
2795 #endif /* ALLOW_DIAGNOSTICS */
2796
2797 #else /* ALLOW_EXF and ALLOW_ATM_TEMP */
2798 STOP 'SEAICE_GROWTH not compiled without EXF and ALLOW_ATM_TEMP'
2799 #endif /* ALLOW_EXF and ALLOW_ATM_TEMP */
2800
2801 RETURN
2802 END

  ViewVC Help
Powered by ViewVC 1.1.22