/[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.13 - (show annotations) (download)
Fri Nov 2 19:15:42 2012 UTC (12 years, 9 months ago) by torge
Branch: MAIN
Changes since 1.12: +46 -43 lines
this version yields (almost) identical results for the 1-D verification experiment using
a) no ITD and no MULTICATEGORIES
b) ITD with nITD=1
without any specific hacks in the code

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

  ViewVC Help
Powered by ViewVC 1.1.22