/[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.14 - (show annotations) (download)
Mon Dec 10 22:19:49 2012 UTC (12 years, 7 months ago) by torge
Branch: MAIN
Changes since 1.13: +144 -145 lines
include updates from main branch

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

  ViewVC Help
Powered by ViewVC 1.1.22