/[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.17 - (show annotations) (download)
Wed Apr 10 00:35:33 2013 UTC (12 years, 4 months ago) by torge
Branch: MAIN
Changes since 1.16: +74 -4 lines
1) removing unused variable leadIceThickMin
2) introducing floe size dependent lateral melt for ITD case
   following suggestions in Steele (1992) for lateral melt
   and Luepkes et al. (2012) for floe size parameterization

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

  ViewVC Help
Powered by ViewVC 1.1.22