/[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.15 - (show annotations) (download)
Mon Dec 10 22:41:54 2012 UTC (12 years, 7 months ago) by torge
Branch: MAIN
Changes since 1.14: +3 -1 lines
forgot SEAICE_DEBUG brackets with print statement 'increments 9'

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

  ViewVC Help
Powered by ViewVC 1.1.22