/[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.11 - (show annotations) (download)
Mon Oct 22 22:18:09 2012 UTC (12 years, 9 months ago) by torge
Branch: MAIN
Changes since 1.10: +2 -0 lines
removing bugs

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

  ViewVC Help
Powered by ViewVC 1.1.22