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

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

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


Revision 1.18 - (show annotations) (download)
Thu Apr 11 21:48:06 2013 UTC (12 years, 3 months ago) by torge
Branch: MAIN
Changes since 1.17: +63 -43 lines
1) limiting the AREA reduction by lateral melt so that the actual ice thickness does not increase
2) introducing local variables i_dbOut and j_dbOut for seaice_debug output at a specific coordinate

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

  ViewVC Help
Powered by ViewVC 1.1.22