/[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.10 - (show annotations) (download)
Mon Oct 22 21:12:47 2012 UTC (12 years, 9 months ago) by torge
Branch: MAIN
Changes since 1.9: +453 -265 lines
adopting latest changes in main branch

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 C prepare SItrHEFF to be computed as cumulative sum
754 DO iTr=2,5
755 DO J=1,sNy
756 DO I=1,sNx
757 SItrHEFF(I,J,bi,bj,iTr)=ZERO
758 ENDDO
759 ENDDO
760 ENDDO
761 C prepare SItrAREA to be computed as cumulative sum
762 DO J=1,sNy
763 DO I=1,sNx
764 SItrAREA(I,J,bi,bj,3)=ZERO
765 ENDDO
766 ENDDO
767 #endif
768
769 C 4) treat sea ice salinity pathological cases
770 #ifdef SEAICE_VARIABLE_SALINITY
771 #ifdef ALLOW_AUTODIFF_TAMC
772 CADJ STORE hsalt(:,:,bi,bj) = comlev1_bibj, key = iicekey,byte=isbyte
773 CADJ STORE heff(:,:,bi,bj) = comlev1_bibj, key = iicekey,byte=isbyte
774 #endif /* ALLOW_AUTODIFF_TAMC */
775 DO J=1,sNy
776 DO I=1,sNx
777 IF ( (HSALT(I,J,bi,bj) .LT. 0.0).OR.
778 & (HEFF(I,J,bi,bj) .EQ. 0.0) ) THEN
779 saltFluxAdjust(I,J) = - HEFFM(I,J,bi,bj) *
780 & HSALT(I,J,bi,bj) * recip_deltaTtherm
781 HSALT(I,J,bi,bj) = 0.0 _d 0
782 ENDIF
783 ENDDO
784 ENDDO
785 #endif /* SEAICE_VARIABLE_SALINITY */
786
787 #endif /* SEAICE_GROWTH_LEGACY */
788
789 #ifdef ALLOW_DIAGNOSTICS
790 IF ( useDiagnostics ) THEN
791 CALL DIAGNOSTICS_FILL(DIAGarrayA,'SIareaPR',0,1,3,bi,bj,myThid)
792 CALL DIAGNOSTICS_FILL(DIAGarrayB,'SIareaPT',0,1,3,bi,bj,myThid)
793 CALL DIAGNOSTICS_FILL(DIAGarrayC,'SIheffPT',0,1,3,bi,bj,myThid)
794 CALL DIAGNOSTICS_FILL(DIAGarrayD,'SIhsnoPT',0,1,3,bi,bj,myThid)
795 #ifdef ALLOW_SITRACER
796 DO iTr = 1, SItrNumInUse
797 WRITE(diagName,'(A4,I2.2,A2)') 'SItr',iTr,'PT'
798 IF (SItrMate(iTr).EQ.'HEFF') THEN
799 CALL DIAGNOSTICS_FRACT_FILL(
800 I SItracer(1-OLx,1-OLy,bi,bj,iTr),HEFF(1-OLx,1-OLy,bi,bj),
801 I ONE, 1, diagName,0,1,2,bi,bj,myThid )
802 ELSE
803 CALL DIAGNOSTICS_FRACT_FILL(
804 I SItracer(1-OLx,1-OLy,bi,bj,iTr),AREA(1-OLx,1-OLy,bi,bj),
805 I ONE, 1, diagName,0,1,2,bi,bj,myThid )
806 ENDIF
807 ENDDO
808 #endif /* ALLOW_SITRACER */
809 ENDIF
810 #endif /* ALLOW_DIAGNOSTICS */
811
812 #if (defined ALLOW_AUTODIFF_TAMC && defined SEAICE_MODIFY_GROWTH_ADJ)
813 Cgf no additional dependency of air-sea fluxes to ice
814 IF ( SEAICEadjMODE.GE.1 ) THEN
815 DO J=1,sNy
816 DO I=1,sNx
817 HEFFpreTH(I,J) = 0. _d 0
818 HSNWpreTH(I,J) = 0. _d 0
819 AREApreTH(I,J) = 0. _d 0
820 ENDDO
821 ENDDO
822 #ifdef SEAICE_ITD
823 DO IT=1,nITD
824 DO J=1,sNy
825 DO I=1,sNx
826 HEFFITDpreTH(I,J,IT) = 0. _d 0
827 HSNWITDpreTH(I,J,IT) = 0. _d 0
828 AREAITDpreTH(I,J,IT) = 0. _d 0
829 ENDDO
830 ENDDO
831 ENDDO
832 #endif
833 ENDIF
834 #endif
835
836 #if (defined (ALLOW_MEAN_SFLUX_COST_CONTRIBUTION) || defined (ALLOW_SSH_GLOBMEAN_COST_CONTRIBUTION))
837 DO J=1,sNy
838 DO I=1,sNx
839 AREAforAtmFW(I,J,bi,bj) = AREApreTH(I,J)
840 ENDDO
841 ENDDO
842 #endif
843
844 C 4) COMPUTE ACTUAL ICE/SNOW THICKNESS; USE MIN/MAX VALUES
845 C TO REGULARIZE SEAICE_SOLVE4TEMP/d_AREA COMPUTATIONS
846
847 #ifdef ALLOW_AUTODIFF_TAMC
848 CADJ STORE AREApreTH = comlev1_bibj, key = iicekey, byte = isbyte
849 CADJ STORE HEFFpreTH = comlev1_bibj, key = iicekey, byte = isbyte
850 CADJ STORE HSNWpreTH = comlev1_bibj, key = iicekey, byte = isbyte
851 #endif /* ALLOW_AUTODIFF_TAMC */
852 #ifdef SEAICE_ITD
853 DO IT=1,nITD
854 #endif
855 DO J=1,sNy
856 DO I=1,sNx
857
858 #ifdef SEAICE_ITD
859 IF (HEFFITDpreTH(I,J,IT) .GT. ZERO) THEN
860 #ifdef SEAICE_GROWTH_LEGACY
861 tmpscal1 = MAX(SEAICE_area_reg/float(nITD),
862 & AREAITDpreTH(I,J,IT))
863 hsnowActualMult(I,J,IT) = HSNWITDpreTH(I,J,IT)/tmpscal1
864 tmpscal2 = HEFFITDpreTH(I,J,IT)/tmpscal1
865 heffActualMult(I,J,IT) = MAX(tmpscal2,SEAICE_hice_reg)
866 #else /* SEAICE_GROWTH_LEGACY */
867 cif regularize AREA with SEAICE_area_reg
868 tmpscal1 = SQRT(AREAITDpreTH(I,J,IT) * AREAITDpreTH(I,J,IT)
869 & + area_reg_sq)
870 cif heffActual calculated with the regularized AREA
871 tmpscal2 = HEFFITDpreTH(I,J,IT) / tmpscal1
872 cif regularize heffActual with SEAICE_hice_reg (add lower bound)
873 heffActualMult(I,J,IT) = SQRT(tmpscal2 * tmpscal2
874 & + hice_reg_sq)
875 cif hsnowActual calculated with the regularized AREA
876 hsnowActualMult(I,J,IT) = HSNWITDpreTH(I,J,IT) / tmpscal1
877 #endif /* SEAICE_GROWTH_LEGACY */
878 cif regularize the inverse of heffActual by hice_reg
879 recip_heffActualMult(I,J,IT) = AREAITDpreTH(I,J,IT) /
880 & sqrt(HEFFITDpreTH(I,J,IT) * HEFFITDpreTH(I,J,IT)
881 & + hice_reg_sq)
882 cif Do not regularize when HEFFpreTH = 0
883 ELSE
884 heffActualMult(I,J,IT) = ZERO
885 hsnowActualMult(I,J,IT) = ZERO
886 recip_heffActualMult(I,J,IT) = ZERO
887 ENDIF
888 #else /* SEAICE_ITD */
889 IF (HEFFpreTH(I,J) .GT. ZERO) THEN
890 #ifdef SEAICE_GROWTH_LEGACY
891 tmpscal1 = MAX(SEAICE_area_reg,AREApreTH(I,J))
892 hsnowActual(I,J) = HSNWpreTH(I,J)/tmpscal1
893 tmpscal2 = HEFFpreTH(I,J)/tmpscal1
894 heffActual(I,J) = MAX(tmpscal2,SEAICE_hice_reg)
895 #else /* SEAICE_GROWTH_LEGACY */
896 Cif regularize AREA with SEAICE_area_reg
897 tmpscal1 = SQRT(AREApreTH(I,J)* AREApreTH(I,J) + area_reg_sq)
898 Cif heffActual calculated with the regularized AREA
899 tmpscal2 = HEFFpreTH(I,J) / tmpscal1
900 Cif regularize heffActual with SEAICE_hice_reg (add lower bound)
901 heffActual(I,J) = SQRT(tmpscal2 * tmpscal2 + hice_reg_sq)
902 Cif hsnowActual calculated with the regularized AREA
903 hsnowActual(I,J) = HSNWpreTH(I,J) / tmpscal1
904 #endif /* SEAICE_GROWTH_LEGACY */
905 Cif regularize the inverse of heffActual by hice_reg
906 recip_heffActual(I,J) = AREApreTH(I,J) /
907 & sqrt(HEFFpreTH(I,J)*HEFFpreTH(I,J) + hice_reg_sq)
908 Cif Do not regularize when HEFFpreTH = 0
909 ELSE
910 heffActual(I,J) = ZERO
911 hsnowActual(I,J) = ZERO
912 recip_heffActual(I,J) = ZERO
913 ENDIF
914 #endif /* SEAICE_ITD */
915
916 ENDDO
917 ENDDO
918 #ifdef SEAICE_ITD
919 ENDDO
920 #endif
921
922 #if (defined ALLOW_AUTODIFF_TAMC && defined SEAICE_MODIFY_GROWTH_ADJ)
923 CALL ZERO_ADJ_1D( sNx*sNy, heffActual, myThid)
924 CALL ZERO_ADJ_1D( sNx*sNy, hsnowActual, myThid)
925 CALL ZERO_ADJ_1D( sNx*sNy, recip_heffActual, myThid)
926 #endif
927
928 #ifdef SEAICE_CAP_SUBLIM
929 C 5) COMPUTE MAXIMUM LATENT HEAT FLUXES FOR THE CURRENT ICE
930 C AND SNOW THICKNESS
931 #ifdef SEAICE_ITD
932 DO IT=1,nITD
933 #endif
934 DO J=1,sNy
935 DO I=1,sNx
936 C The latent heat flux over the sea ice which
937 C will sublimate all of the snow and ice over one time
938 C step (W/m^2)
939 #ifdef SEAICE_ITD
940 IF (HEFFITDpreTH(I,J,IT) .GT. ZERO) THEN
941 latentHeatFluxMaxMult(I,J,IT) = lhSublim*recip_deltaTtherm *
942 & (HEFFITDpreTH(I,J,IT)*SEAICE_rhoIce +
943 & HSNWITDpreTH(I,J,IT)*SEAICE_rhoSnow)
944 & /AREAITDpreTH(I,J,IT)
945 ELSE
946 latentHeatFluxMaxMult(I,J,IT) = ZERO
947 ENDIF
948 #else
949 IF (HEFFpreTH(I,J) .GT. ZERO) THEN
950 latentHeatFluxMax(I,J) = lhSublim * recip_deltaTtherm *
951 & (HEFFpreTH(I,J) * SEAICE_rhoIce +
952 & HSNWpreTH(I,J) * SEAICE_rhoSnow)/AREApreTH(I,J)
953 ELSE
954 latentHeatFluxMax(I,J) = ZERO
955 ENDIF
956 #endif
957 ENDDO
958 ENDDO
959 #ifdef SEAICE_ITD
960 ENDDO
961 #endif
962 #endif /* SEAICE_CAP_SUBLIM */
963
964 C ===================================================================
965 C ================PART 2: determine heat fluxes/stocks===============
966 C ===================================================================
967
968 C determine available heat due to the atmosphere -- for open water
969 C ================================================================
970
971 DO j=1,sNy
972 DO i=1,sNx
973 C ocean surface/mixed layer temperature
974 TmixLoc(i,j) = theta(i,j,kSurface,bi,bj)+celsius2K
975 C wind speed from exf
976 UG(I,J) = MAX(SEAICE_EPS,wspeed(I,J,bi,bj))
977 ENDDO
978 ENDDO
979
980 #ifdef ALLOW_AUTODIFF_TAMC
981 CADJ STORE qnet(:,:,bi,bj) = comlev1_bibj, key = iicekey,byte=isbyte
982 CADJ STORE qsw(:,:,bi,bj) = comlev1_bibj, key = iicekey,byte=isbyte
983 cCADJ STORE UG = comlev1_bibj, key = iicekey,byte=isbyte
984 cCADJ STORE TmixLoc = comlev1_bibj, key = iicekey,byte=isbyte
985 #endif /* ALLOW_AUTODIFF_TAMC */
986
987 CALL SEAICE_BUDGET_OCEAN(
988 I UG,
989 I TmixLoc,
990 O a_QbyATM_open, a_QSWbyATM_open,
991 I bi, bj, myTime, myIter, myThid )
992
993 C determine available heat due to the atmosphere -- for ice covered water
994 C =======================================================================
995
996 IF (useRelativeWind.AND.useAtmWind) THEN
997 C Compute relative wind speed over sea ice.
998 DO J=1,sNy
999 DO I=1,sNx
1000 SPEED_SQ =
1001 & (uWind(I,J,bi,bj)
1002 & +0.5 _d 0*(uVel(i,j,kSurface,bi,bj)
1003 & +uVel(i+1,j,kSurface,bi,bj))
1004 & -0.5 _d 0*(uice(i,j,bi,bj)+uice(i+1,j,bi,bj)))**2
1005 & +(vWind(I,J,bi,bj)
1006 & +0.5 _d 0*(vVel(i,j,kSurface,bi,bj)
1007 & +vVel(i,j+1,kSurface,bi,bj))
1008 & -0.5 _d 0*(vice(i,j,bi,bj)+vice(i,j+1,bi,bj)))**2
1009 IF ( SPEED_SQ .LE. SEAICE_EPS_SQ ) THEN
1010 UG(I,J)=SEAICE_EPS
1011 ELSE
1012 UG(I,J)=SQRT(SPEED_SQ)
1013 ENDIF
1014 ENDDO
1015 ENDDO
1016 ENDIF
1017
1018 #ifdef ALLOW_AUTODIFF_TAMC
1019 CADJ STORE tice(:,:,bi,bj)
1020 CADJ & = comlev1_bibj, key = iicekey, byte = isbyte
1021 CADJ STORE hsnowActual = comlev1_bibj, key = iicekey, byte = isbyte
1022 CADJ STORE heffActual = comlev1_bibj, key = iicekey, byte = isbyte
1023 CADJ STORE UG = comlev1_bibj, key = iicekey, byte = isbyte
1024 CADJ STORE tices(:,:,:,bi,bj)
1025 CADJ & = comlev1_bibj, key = iicekey, byte = isbyte
1026 CADJ STORE salt(:,:,kSurface,bi,bj) = comlev1_bibj,
1027 CADJ & key = iicekey, byte = isbyte
1028 #endif /* ALLOW_AUTODIFF_TAMC */
1029
1030 C-- Start loop over multi-categories
1031 #ifdef SEAICE_ITD
1032 CToM SEAICE_multDim = nITD (see SEAICE_SIZE.h and seaice_readparms.F)
1033 #endif
1034 DO IT=1,SEAICE_multDim
1035 C homogeneous distribution between 0 and 2 x heffActual
1036 #ifndef SEAICE_ITD
1037 pFac = (2.0 _d 0*IT - 1.0 _d 0)*recip_multDim
1038 pFacSnow = 1. _d 0
1039 IF ( SEAICE_useMultDimSnow ) pFacSnow=pFac
1040 #endif
1041 DO J=1,sNy
1042 DO I=1,sNx
1043 #ifndef SEAICE_ITD
1044 CToM for SEAICE_ITD heffActualMult and latentHeatFluxMaxMult are calculated above
1045 C (instead of heffActual and latentHeatFluxMax)
1046 heffActualMult(I,J,IT)= heffActual(I,J)*pFac
1047 hsnowActualMult(I,J,IT)=hsnowActual(I,J)*pFacSnow
1048 #ifdef SEAICE_CAP_SUBLIM
1049 latentHeatFluxMaxMult(I,J,IT) = latentHeatFluxMax(I,J)*pFac
1050 #endif
1051 #endif
1052 ticeInMult(I,J,IT)=TICES(I,J,IT,bi,bj)
1053 ticeOutMult(I,J,IT)=TICES(I,J,IT,bi,bj)
1054 TICE(I,J,bi,bj) = ZERO
1055 TICES(I,J,IT,bi,bj) = ZERO
1056 ENDDO
1057 ENDDO
1058 ENDDO
1059
1060 #ifdef ALLOW_AUTODIFF_TAMC
1061 CADJ STORE heffActualMult = comlev1_bibj, key = iicekey, byte = isbyte
1062 CADJ STORE hsnowActualMult= comlev1_bibj, key = iicekey, byte = isbyte
1063 CADJ STORE ticeInMult = comlev1_bibj, key = iicekey, byte = isbyte
1064 # ifdef SEAICE_CAP_SUBLIM
1065 CADJ STORE latentHeatFluxMaxMult
1066 CADJ & = comlev1_bibj, key = iicekey, byte = isbyte
1067 # endif
1068 CADJ STORE a_QbyATMmult_cover =
1069 CADJ & comlev1_bibj, key = iicekey, byte = isbyte
1070 CADJ STORE a_QSWbyATMmult_cover =
1071 CADJ & comlev1_bibj, key = iicekey, byte = isbyte
1072 CADJ STORE a_FWbySublimMult =
1073 CADJ & comlev1_bibj, key = iicekey, byte = isbyte
1074 #endif /* ALLOW_AUTODIFF_TAMC */
1075
1076 DO IT=1,SEAICE_multDim
1077 CALL SEAICE_SOLVE4TEMP(
1078 I UG, heffActualMult(1,1,IT), hsnowActualMult(1,1,IT),
1079 #ifdef SEAICE_CAP_SUBLIM
1080 I latentHeatFluxMaxMult(1,1,IT),
1081 #endif
1082 U ticeInMult(1,1,IT), ticeOutMult(1,1,IT),
1083 O a_QbyATMmult_cover(1,1,IT),
1084 O a_QSWbyATMmult_cover(1,1,IT),
1085 O a_FWbySublimMult(1,1,IT),
1086 I bi, bj, myTime, myIter, myThid )
1087 ENDDO
1088
1089 #ifdef ALLOW_AUTODIFF_TAMC
1090 CADJ STORE heffActualMult = comlev1_bibj, key = iicekey, byte = isbyte
1091 CADJ STORE hsnowActualMult= comlev1_bibj, key = iicekey, byte = isbyte
1092 CADJ STORE ticeOutMult = comlev1_bibj, key = iicekey, byte = isbyte
1093 # ifdef SEAICE_CAP_SUBLIM
1094 CADJ STORE latentHeatFluxMaxMult
1095 CADJ & = comlev1_bibj, key = iicekey, byte = isbyte
1096 # endif
1097 CADJ STORE a_QbyATMmult_cover =
1098 CADJ & comlev1_bibj, key = iicekey, byte = isbyte
1099 CADJ STORE a_QSWbyATMmult_cover =
1100 CADJ & comlev1_bibj, key = iicekey, byte = isbyte
1101 CADJ STORE a_FWbySublimMult =
1102 CADJ & comlev1_bibj, key = iicekey, byte = isbyte
1103 #endif /* ALLOW_AUTODIFF_TAMC */
1104
1105 DO IT=1,SEAICE_multDim
1106 DO J=1,sNy
1107 DO I=1,sNx
1108 C update TICE & TICES
1109 #ifdef SEAICE_ITD
1110 C calculate area weighted mean
1111 C (although the ice's temperature relates to its energy content
1112 C and hence should be averaged weighted by ice volume,
1113 C the temperature here is a result of the fluxes through the ice surface
1114 C computed individually for each single category in SEAICE_SOLVE4TEMP
1115 C and hence is averaged area weighted [areaFracFactor])
1116 TICE(I,J,bi,bj) = TICE(I,J,bi,bj)
1117 & + ticeOutMult(I,J,IT)*areaFracFactor(I,J,IT)
1118 #else
1119 TICE(I,J,bi,bj) = TICE(I,J,bi,bj)
1120 & + ticeOutMult(I,J,IT)*recip_multDim
1121 #endif
1122 TICES(I,J,IT,bi,bj) = ticeOutMult(I,J,IT)
1123 C average over categories
1124 #ifdef SEAICE_ITD
1125 C calculate area weighted mean
1126 C (fluxes are per unit (ice surface) area and are thus area weighted)
1127 a_QbyATM_cover (I,J) = a_QbyATM_cover(I,J)
1128 & + a_QbyATMmult_cover(I,J,IT)*areaFracFactor(I,J,IT)
1129 a_QSWbyATM_cover (I,J) = a_QSWbyATM_cover(I,J)
1130 & + a_QSWbyATMmult_cover(I,J,IT)*areaFracFactor(I,J,IT)
1131 a_FWbySublim (I,J) = a_FWbySublim(I,J)
1132 & + a_FWbySublimMult(I,J,IT)*areaFracFactor(I,J,IT)
1133 #else
1134 a_QbyATM_cover (I,J) = a_QbyATM_cover(I,J)
1135 & + a_QbyATMmult_cover(I,J,IT)*recip_multDim
1136 a_QSWbyATM_cover (I,J) = a_QSWbyATM_cover(I,J)
1137 & + a_QSWbyATMmult_cover(I,J,IT)*recip_multDim
1138 a_FWbySublim (I,J) = a_FWbySublim(I,J)
1139 & + a_FWbySublimMult(I,J,IT)*recip_multDim
1140 #endif
1141 ENDDO
1142 ENDDO
1143 ENDDO
1144
1145 #ifdef SEAICE_CAP_SUBLIM
1146 # ifdef ALLOW_DIAGNOSTICS
1147 DO J=1,sNy
1148 DO I=1,sNx
1149 C The actual latent heat flux realized by SOLVE4TEMP
1150 DIAGarrayA(I,J) = a_FWbySublim(I,J) * lhSublim
1151 ENDDO
1152 ENDDO
1153 Cif The actual vs. maximum latent heat flux
1154 IF ( useDiagnostics ) THEN
1155 CALL DIAGNOSTICS_FILL(DIAGarrayA,
1156 & 'SIactLHF',0,1,3,bi,bj,myThid)
1157 CALL DIAGNOSTICS_FILL(latentHeatFluxMax,
1158 & 'SImaxLHF',0,1,3,bi,bj,myThid)
1159 ENDIF
1160 # endif /* ALLOW_DIAGNOSTICS */
1161 #endif /* SEAICE_CAP_SUBLIM */
1162
1163 #ifdef ALLOW_AUTODIFF_TAMC
1164 CADJ STORE AREApreTH = comlev1_bibj, key = iicekey, byte = isbyte
1165 CADJ STORE a_QbyATM_cover = comlev1_bibj, key = iicekey, byte = isbyte
1166 CADJ STORE a_QSWbyATM_cover= comlev1_bibj, key = iicekey, byte = isbyte
1167 CADJ STORE a_QbyATM_open = comlev1_bibj, key = iicekey, byte = isbyte
1168 CADJ STORE a_QSWbyATM_open = comlev1_bibj, key = iicekey, byte = isbyte
1169 CADJ STORE a_FWbySublim = comlev1_bibj, key = iicekey, byte = isbyte
1170 #endif /* ALLOW_AUTODIFF_TAMC */
1171
1172 C switch heat fluxes from W/m2 to 'effective' ice meters
1173 #ifdef SEAICE_ITD
1174 DO IT=1,nITD
1175 DO J=1,sNy
1176 DO I=1,sNx
1177 a_QbyATMmult_cover(I,J,IT) = a_QbyATMmult_cover(I,J,IT)
1178 & * convertQ2HI * AREAITDpreTH(I,J,IT)
1179 a_QSWbyATMmult_cover(I,J,IT) = a_QSWbyATMmult_cover(I,J,IT)
1180 & * convertQ2HI * AREAITDpreTH(I,J,IT)
1181 C and initialize r_QbyATMmult_cover
1182 r_QbyATMmult_cover(I,J,IT)=a_QbyATMmult_cover(I,J,IT)
1183 C Convert fresh water flux by sublimation to 'effective' ice meters.
1184 C Negative sublimation is resublimation and will be added as snow.
1185 #ifdef SEAICE_DISABLE_SUBLIM
1186 a_FWbySublimMult(I,J,IT) = ZERO
1187 #endif
1188 a_FWbySublimMult(I,J,IT) = SEAICE_deltaTtherm*recip_rhoIce
1189 & * a_FWbySublimMult(I,J,IT)*AREAITDpreTH(I,J,IT)
1190 r_FWbySublimMult(I,J,IT)=a_FWbySublimMult(I,J,IT)
1191 ENDDO
1192 ENDDO
1193 ENDDO
1194 DO J=1,sNy
1195 DO I=1,sNx
1196 a_QbyATM_open(I,J) = a_QbyATM_open(I,J)
1197 & * convertQ2HI * ( ONE - AREApreTH(I,J) )
1198 a_QSWbyATM_open(I,J) = a_QSWbyATM_open(I,J)
1199 & * convertQ2HI * ( ONE - AREApreTH(I,J) )
1200 C and initialize r_QbyATM_open
1201 r_QbyATM_open(I,J)=a_QbyATM_open(I,J)
1202 ENDDO
1203 ENDDO
1204 #else /* SEAICE_ITD */
1205 DO J=1,sNy
1206 DO I=1,sNx
1207 a_QbyATM_cover(I,J) = a_QbyATM_cover(I,J)
1208 & * convertQ2HI * AREApreTH(I,J)
1209 a_QSWbyATM_cover(I,J) = a_QSWbyATM_cover(I,J)
1210 & * convertQ2HI * AREApreTH(I,J)
1211 a_QbyATM_open(I,J) = a_QbyATM_open(I,J)
1212 & * convertQ2HI * ( ONE - AREApreTH(I,J) )
1213 a_QSWbyATM_open(I,J) = a_QSWbyATM_open(I,J)
1214 & * convertQ2HI * ( ONE - AREApreTH(I,J) )
1215 C and initialize r_QbyATM_cover/r_QbyATM_open
1216 r_QbyATM_cover(I,J)=a_QbyATM_cover(I,J)
1217 r_QbyATM_open(I,J)=a_QbyATM_open(I,J)
1218 C Convert fresh water flux by sublimation to 'effective' ice meters.
1219 C Negative sublimation is resublimation and will be added as snow.
1220 #ifdef SEAICE_DISABLE_SUBLIM
1221 Cgf just for those who may need to omit this term to reproduce old results
1222 a_FWbySublim(I,J) = ZERO
1223 #endif /* SEAICE_DISABLE_SUBLIM */
1224 a_FWbySublim(I,J) = SEAICE_deltaTtherm*recip_rhoIce
1225 & * a_FWbySublim(I,J)*AREApreTH(I,J)
1226 r_FWbySublim(I,J)=a_FWbySublim(I,J)
1227 ENDDO
1228 ENDDO
1229 #endif /* SEAICE_ITD */
1230
1231 #ifdef ALLOW_AUTODIFF_TAMC
1232 CADJ STORE AREApreTH = comlev1_bibj, key = iicekey, byte = isbyte
1233 CADJ STORE a_QbyATM_cover = comlev1_bibj, key = iicekey, byte = isbyte
1234 CADJ STORE a_QSWbyATM_cover= comlev1_bibj, key = iicekey, byte = isbyte
1235 CADJ STORE a_QbyATM_open = comlev1_bibj, key = iicekey, byte = isbyte
1236 CADJ STORE a_QSWbyATM_open = comlev1_bibj, key = iicekey, byte = isbyte
1237 CADJ STORE a_FWbySublim = comlev1_bibj, key = iicekey, byte = isbyte
1238 CADJ STORE r_QbyATM_cover = comlev1_bibj, key = iicekey, byte = isbyte
1239 CADJ STORE r_QbyATM_open = comlev1_bibj, key = iicekey, byte = isbyte
1240 CADJ STORE r_FWbySublim = comlev1_bibj, key = iicekey, byte = isbyte
1241 #endif /* ALLOW_AUTODIFF_TAMC */
1242
1243 #if (defined ALLOW_AUTODIFF_TAMC && defined SEAICE_MODIFY_GROWTH_ADJ)
1244 Cgf no additional dependency through ice cover
1245 IF ( SEAICEadjMODE.GE.3 ) THEN
1246 #ifdef SEAICE_ITD
1247 DO IT=1,nITD
1248 DO J=1,sNy
1249 DO I=1,sNx
1250 a_QbyATMmult_cover(I,J,IT) = 0. _d 0
1251 r_QbyATMmult_cover(I,J,IT) = 0. _d 0
1252 a_QSWbyATMmult_cover(I,J,IT) = 0. _d 0
1253 ENDDO
1254 ENDDO
1255 ENDDO
1256 #else
1257 DO J=1,sNy
1258 DO I=1,sNx
1259 a_QbyATM_cover(I,J) = 0. _d 0
1260 r_QbyATM_cover(I,J) = 0. _d 0
1261 a_QSWbyATM_cover(I,J) = 0. _d 0
1262 ENDDO
1263 ENDDO
1264 #endif
1265 ENDIF
1266 #endif
1267
1268 C determine available heat due to the ice pack tying the
1269 C underlying surface water temperature to freezing point
1270 C ======================================================
1271
1272 #ifdef ALLOW_AUTODIFF_TAMC
1273 CADJ STORE theta(:,:,kSurface,bi,bj) = comlev1_bibj,
1274 CADJ & key = iicekey, byte = isbyte
1275 CADJ STORE salt(:,:,kSurface,bi,bj) = comlev1_bibj,
1276 CADJ & key = iicekey, byte = isbyte
1277 #endif
1278
1279 DO J=1,sNy
1280 DO I=1,sNx
1281 C FREEZING TEMP. OF SEA WATER (deg C)
1282 tempFrz = SEAICE_tempFrz0 +
1283 & SEAICE_dTempFrz_dS *salt(I,J,kSurface,bi,bj)
1284 C efficiency of turbulent fluxes : dependency to sign of THETA-TBC
1285 IF ( theta(I,J,kSurface,bi,bj) .GE. tempFrz ) THEN
1286 tmpscal1 = SEAICE_mcPheePiston
1287 ELSE
1288 tmpscal1 =SEAICE_frazilFrac*drF(kSurface)/SEAICE_deltaTtherm
1289 ENDIF
1290 C efficiency of turbulent fluxes : dependency to AREA (McPhee cases)
1291 IF ( (AREApreTH(I,J) .GT. 0. _d 0).AND.
1292 & (.NOT.SEAICE_mcPheeStepFunc) ) THEN
1293 MixedLayerTurbulenceFactor = ONE -
1294 & SEAICE_mcPheeTaper * AREApreTH(I,J)
1295 ELSEIF ( (AREApreTH(I,J) .GT. 0. _d 0).AND.
1296 & (SEAICE_mcPheeStepFunc) ) THEN
1297 MixedLayerTurbulenceFactor = ONE - SEAICE_mcPheeTaper
1298 ELSE
1299 MixedLayerTurbulenceFactor = ONE
1300 ENDIF
1301 C maximum turbulent flux, in ice meters
1302 tmpscal2= - (HeatCapacity_Cp*rhoConst * recip_QI)
1303 & * (theta(I,J,kSurface,bi,bj)-tempFrz)
1304 & * SEAICE_deltaTtherm * maskC(i,j,kSurface,bi,bj)
1305 C available turbulent flux
1306 a_QbyOCN(i,j) =
1307 & tmpscal1 * tmpscal2 * MixedLayerTurbulenceFactor
1308 r_QbyOCN(i,j) = a_QbyOCN(i,j)
1309 ENDDO
1310 ENDDO
1311
1312 #if (defined ALLOW_AUTODIFF_TAMC && defined SEAICE_MODIFY_GROWTH_ADJ)
1313 CALL ZERO_ADJ_1D( sNx*sNy, r_QbyOCN, myThid)
1314 #endif
1315
1316 C ===================================================================
1317 C =========PART 3: determine effective thicknesses increments========
1318 C ===================================================================
1319
1320 C compute snow/ice tendency due to sublimation
1321 C ============================================
1322
1323 #ifdef ALLOW_AUTODIFF_TAMC
1324 CADJ STORE hsnow(:,:,bi,bj) = comlev1_bibj,key=iicekey,byte=isbyte
1325 CADJ STORE r_FWbySublim = comlev1_bibj,key=iicekey,byte=isbyte
1326 #endif /* ALLOW_AUTODIFF_TAMC */
1327 #ifdef SEAICE_ITD
1328 DO IT=1,nITD
1329 #endif
1330 DO J=1,sNy
1331 DO I=1,sNx
1332 C First sublimate/deposite snow
1333 tmpscal2 =
1334 #ifdef SEAICE_ITD
1335 & MAX(MIN(r_FWbySublimMult(I,J,IT),HSNOWITD(I,J,IT,bi,bj)
1336 & *SNOW2ICE),ZERO)
1337 C accumulate change over ITD categories
1338 d_HSNWbySublim(I,J) = d_HSNWbySublim(I,J) - tmpscal2
1339 & *ICE2SNOW
1340 HSNOWITD(I,J,IT,bi,bj) = HSNOWITD(I,J,IT,bi,bj) - tmpscal2
1341 & *ICE2SNOW
1342 r_FWbySublimMult(I,J,IT)= r_FWbySublimMult(I,J,IT) - tmpscal2
1343 #else
1344 & MAX(MIN(r_FWbySublim(I,J),HSNOW(I,J,bi,bj)*SNOW2ICE),ZERO)
1345 d_HSNWbySublim(I,J) = - tmpscal2 * ICE2SNOW
1346 HSNOW(I,J,bi,bj) = HSNOW(I,J,bi,bj) - tmpscal2*ICE2SNOW
1347 r_FWbySublim(I,J) = r_FWbySublim(I,J) - tmpscal2
1348 #endif
1349 ENDDO
1350 ENDDO
1351 #ifdef ALLOW_AUTODIFF_TAMC
1352 CADJ STORE heff(:,:,bi,bj) = comlev1_bibj,key=iicekey,byte=isbyte
1353 CADJ STORE r_FWbySublim = comlev1_bibj,key=iicekey,byte=isbyte
1354 #endif /* ALLOW_AUTODIFF_TAMC */
1355 DO J=1,sNy
1356 DO I=1,sNx
1357 C If anything is left, sublimate ice
1358 tmpscal2 =
1359 #ifdef SEAICE_ITD
1360 & MAX(MIN(r_FWbySublimMult(I,J,IT),HEFFITD(I,J,IT,bi,bj)),ZERO)
1361 C accumulate change over ITD categories
1362 d_HSNWbySublim(I,J) = d_HSNWbySublim(I,J) - tmpscal2
1363 HEFFITD(I,J,IT,bi,bj) = HEFFITD(I,J,IT,bi,bj) - tmpscal2
1364 r_FWbySublimMult(I,J,IT) = r_FWbySublimMult(I,J,IT) - tmpscal2
1365 #else
1366 & MAX(MIN(r_FWbySublim(I,J),HEFF(I,J,bi,bj)),ZERO)
1367 d_HEFFbySublim(I,J) = - tmpscal2
1368 HEFF(I,J,bi,bj) = HEFF(I,J,bi,bj) - tmpscal2
1369 r_FWbySublim(I,J) = r_FWbySublim(I,J) - tmpscal2
1370 #endif
1371 ENDDO
1372 ENDDO
1373 DO J=1,sNy
1374 DO I=1,sNx
1375 C If anything is left, it will be evaporated from the ocean rather than sublimated.
1376 C Since a_QbyATM_cover was computed for sublimation, not simple evaporation, we need to
1377 C remove the fusion part for the residual (that happens to be precisely r_FWbySublim).
1378 #ifdef SEAICE_ITD
1379 a_QbyATMmult_cover(I,J,IT) = a_QbyATMmult_cover(I,J,IT)
1380 & - r_FWbySublimMult(I,J,IT)
1381 r_QbyATMmult_cover(I,J,IT) = r_QbyATMmult_cover(I,J,IT)
1382 & - r_FWbySublimMult(I,J,IT)
1383 #else
1384 a_QbyATM_cover(I,J) = a_QbyATM_cover(I,J)-r_FWbySublim(I,J)
1385 r_QbyATM_cover(I,J) = r_QbyATM_cover(I,J)-r_FWbySublim(I,J)
1386 #endif
1387 ENDDO
1388 ENDDO
1389 #ifdef SEAICE_ITD
1390 C end IT loop
1391 ENDDO
1392 #endif
1393 #ifdef SEAICE_DEBUG
1394 c ToM<<< debug seaice_growth
1395 WRITE(msgBuf,'(A,7F8.4)')
1396 #ifdef SEAICE_ITD
1397 & ' SEAICE_GROWTH: Heff increments 1, HEFFITD = ',
1398 & HEFFITD(1,1,:,bi,bj)
1399 CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
1400 & SQUEEZE_RIGHT , myThid)
1401 WRITE(msgBuf,'(A,7F8.4)')
1402 & ' SEAICE_GROWTH: Area increments 1, AREAITD = ',
1403 & AREAITD(1,1,:,bi,bj)
1404 #else
1405 & ' SEAICE_GROWTH: Heff increments 1, HEFF = ',
1406 & HEFF(1,1,bi,bj)
1407 #endif
1408 CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
1409 & SQUEEZE_RIGHT , myThid)
1410 c ToM>>>
1411 #endif
1412
1413 C compute ice thickness tendency due to ice-ocean interaction
1414 C ===========================================================
1415
1416 #ifdef ALLOW_AUTODIFF_TAMC
1417 CADJ STORE heff(:,:,bi,bj) = comlev1_bibj,key=iicekey,byte=isbyte
1418 CADJ STORE r_QbyOCN = comlev1_bibj,key=iicekey,byte=isbyte
1419 #endif /* ALLOW_AUTODIFF_TAMC */
1420
1421 #ifdef SEAICE_ITD
1422 DO IT=1,nITD
1423 DO J=1,sNy
1424 DO I=1,sNx
1425 C ice growth/melt due to ocean heat r_QbyOCN (W/m^2) is
1426 C equally distributed under the ice and hence weighted by
1427 C fractional area of each thickness category
1428 tmpscal1=MAX(r_QbyOCN(i,j)*areaFracFactor(I,J,IT),
1429 & -HEFFITD(I,J,IT,bi,bj))
1430 d_HEFFbyOCNonICE(I,J) = d_HEFFbyOCNonICE(I,J) + tmpscal1
1431 HEFFITD(I,J,IT,bi,bj) = HEFFITD(I,J,IT,bi,bj) + tmpscal1
1432 #ifdef ALLOW_SITRACER
1433 SItrHEFF(I,J,bi,bj,2) = SItrHEFF(I,J,bi,bj,2)
1434 & + HEFFITD(I,J,IT,bi,bj)
1435 #endif
1436 ENDDO
1437 ENDDO
1438 ENDDO
1439 DO J=1,sNy
1440 DO I=1,sNx
1441 r_QbyOCN(I,J)=r_QbyOCN(I,J)-d_HEFFbyOCNonICE(I,J)
1442 ENDDO
1443 ENDDO
1444 #else /* SEAICE_ITD */
1445 DO J=1,sNy
1446 DO I=1,sNx
1447 d_HEFFbyOCNonICE(I,J)=MAX(r_QbyOCN(i,j), -HEFF(I,J,bi,bj))
1448 r_QbyOCN(I,J)=r_QbyOCN(I,J)-d_HEFFbyOCNonICE(I,J)
1449 HEFF(I,J,bi,bj)=HEFF(I,J,bi,bj) + d_HEFFbyOCNonICE(I,J)
1450 #ifdef ALLOW_SITRACER
1451 SItrHEFF(I,J,bi,bj,2)=HEFF(I,J,bi,bj)
1452 #endif
1453 ENDDO
1454 ENDDO
1455 #endif /* SEAICE_ITD */
1456 #ifdef SEAICE_DEBUG
1457 c ToM<<< debug seaice_growth
1458 WRITE(msgBuf,'(A,7F8.4)')
1459 #ifdef SEAICE_ITD
1460 & ' SEAICE_GROWTH: Heff increments 2, HEFFITD = ',
1461 & HEFFITD(1,1,:,bi,bj)
1462 CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
1463 & SQUEEZE_RIGHT , myThid)
1464 WRITE(msgBuf,'(A,7F8.4)')
1465 & ' SEAICE_GROWTH: Area increments 2, AREAITD = ',
1466 & AREAITD(1,1,:,bi,bj)
1467 #else
1468 & ' SEAICE_GROWTH: Heff increments 2, HEFF = ',
1469 & HEFF(1,1,bi,bj)
1470 #endif
1471 CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
1472 & SQUEEZE_RIGHT , myThid)
1473 c ToM>>>
1474 #endif
1475
1476 C compute snow melt tendency due to snow-atmosphere interaction
1477 C ==================================================================
1478
1479 #ifdef ALLOW_AUTODIFF_TAMC
1480 CADJ STORE hsnow(:,:,bi,bj) = comlev1_bibj,key=iicekey,byte=isbyte
1481 CADJ STORE r_QbyATM_cover = comlev1_bibj,key=iicekey,byte=isbyte
1482 #endif /* ALLOW_AUTODIFF_TAMC */
1483
1484 #ifdef SEAICE_ITD
1485 DO IT=1,nITD
1486 DO J=1,sNy
1487 DO I=1,sNx
1488 C Convert to standard units (meters of ice) rather than to meters
1489 C of snow. This appears to be more robust.
1490 tmpscal1=MAX(r_QbyATMmult_cover(I,J,IT),
1491 & -HSNOWITD(I,J,IT,bi,bj)*SNOW2ICE)
1492 tmpscal2=MIN(tmpscal1,0. _d 0)
1493 #ifdef SEAICE_MODIFY_GROWTH_ADJ
1494 Cgf no additional dependency through snow
1495 IF ( SEAICEadjMODE.GE.2 ) tmpscal2 = 0. _d 0
1496 #endif
1497 d_HSNWbyATMonSNW(I,J) = d_HSNWbyATMonSNW(I,J)
1498 & + tmpscal2*ICE2SNOW
1499 HSNOWITD(I,J,IT,bi,bj)= HSNOWITD(I,J,IT,bi,bj)
1500 & + tmpscal2*ICE2SNOW
1501 r_QbyATMmult_cover(I,J,IT)=r_QbyATMmult_cover(I,J,IT)
1502 & - tmpscal2
1503 ENDDO
1504 ENDDO
1505 ENDDO
1506 #else /* SEAICE_ITD */
1507 DO J=1,sNy
1508 DO I=1,sNx
1509 C Convert to standard units (meters of ice) rather than to meters
1510 C of snow. This appears to be more robust.
1511 tmpscal1=MAX(r_QbyATM_cover(I,J),-HSNOW(I,J,bi,bj)*SNOW2ICE)
1512 tmpscal2=MIN(tmpscal1,0. _d 0)
1513 #ifdef SEAICE_MODIFY_GROWTH_ADJ
1514 Cgf no additional dependency through snow
1515 IF ( SEAICEadjMODE.GE.2 ) tmpscal2 = 0. _d 0
1516 #endif
1517 d_HSNWbyATMonSNW(I,J)= tmpscal2*ICE2SNOW
1518 HSNOW(I,J,bi,bj) = HSNOW(I,J,bi,bj) + tmpscal2*ICE2SNOW
1519 r_QbyATM_cover(I,J)=r_QbyATM_cover(I,J) - tmpscal2
1520 ENDDO
1521 ENDDO
1522 #endif /* SEAICE_ITD */
1523 #ifdef SEAICE_DEBUG
1524 c ToM<<< debug seaice_growth
1525 WRITE(msgBuf,'(A,7F8.4)')
1526 #ifdef SEAICE_ITD
1527 & ' SEAICE_GROWTH: Heff increments 3, HEFFITD = ',
1528 & HEFFITD(1,1,:,bi,bj)
1529 CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
1530 & SQUEEZE_RIGHT , myThid)
1531 WRITE(msgBuf,'(A,7F8.4)')
1532 & ' SEAICE_GROWTH: Area increments 3, AREAITD = ',
1533 & AREAITD(1,1,:,bi,bj)
1534 #else
1535 & ' SEAICE_GROWTH: Heff increments 3, HEFF = ',
1536 & HEFF(1,1,bi,bj)
1537 #endif
1538 CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
1539 & SQUEEZE_RIGHT , myThid)
1540 c ToM>>>
1541 #endif
1542
1543 C compute ice thickness tendency due to the atmosphere
1544 C ====================================================
1545
1546 #ifdef ALLOW_AUTODIFF_TAMC
1547 CADJ STORE heff(:,:,bi,bj) = comlev1_bibj,key=iicekey,byte=isbyte
1548 CADJ STORE r_QbyATM_cover = comlev1_bibj,key=iicekey,byte=isbyte
1549 #endif /* ALLOW_AUTODIFF_TAMC */
1550
1551 Cgf note: this block is not actually tested by lab_sea
1552 Cgf where all experiments start in January. So even though
1553 Cgf the v1.81=>v1.82 revision would change results in
1554 Cgf warming conditions, the lab_sea results were not changed.
1555
1556 #ifdef SEAICE_ITD
1557 DO IT=1,nITD
1558 DO J=1,sNy
1559 DO I=1,sNx
1560 #ifdef SEAICE_GROWTH_LEGACY
1561 tmpscal2 = MAX(-HEFFITD(I,J,IT,bi,bj),
1562 & r_QbyATMmult_cover(I,J,IT))
1563 #else
1564 tmpscal2 = MAX(-HEFFITD(I,J,IT,bi,bj),
1565 & r_QbyATMmult_cover(I,J,IT)
1566 c Limit ice growth by potential melt by ocean
1567 & + AREAITDpreTH(I,J,IT) * r_QbyOCN(I,J))
1568 #endif /* SEAICE_GROWTH_LEGACY */
1569 d_HEFFbyATMonOCN_cover(I,J) = d_HEFFbyATMonOCN_cover(I,J)
1570 & + tmpscal2
1571 d_HEFFbyATMonOCN(I,J) = d_HEFFbyATMonOCN(I,J)
1572 & + tmpscal2
1573 r_QbyATMmult_cover(I,J,IT) = r_QbyATMmult_cover(I,J,IT)
1574 & - tmpscal2
1575 HEFFITD(I,J,IT,bi,bj) = HEFFITD(I,J,IT,bi,bj) + tmpscal2
1576
1577 #ifdef ALLOW_SITRACER
1578 SItrHEFF(I,J,bi,bj,3) = SItrHEFF(I,J,bi,bj,3)
1579 & + HEFFITD(I,J,IT,bi,bj)
1580 #endif
1581 ENDDO
1582 ENDDO
1583 ENDDO
1584 #else /* SEAICE_ITD */
1585 DO J=1,sNy
1586 DO I=1,sNx
1587
1588 #ifdef SEAICE_GROWTH_LEGACY
1589 tmpscal2 = MAX(-HEFF(I,J,bi,bj),r_QbyATM_cover(I,J))
1590 #else
1591 tmpscal2 = MAX(-HEFF(I,J,bi,bj),r_QbyATM_cover(I,J)+
1592 C Limit ice growth by potential melt by ocean
1593 & AREApreTH(I,J) * r_QbyOCN(I,J))
1594 #endif /* SEAICE_GROWTH_LEGACY */
1595
1596 d_HEFFbyATMonOCN_cover(I,J)=tmpscal2
1597 d_HEFFbyATMonOCN(I,J)=d_HEFFbyATMonOCN(I,J)+tmpscal2
1598 r_QbyATM_cover(I,J)=r_QbyATM_cover(I,J)-tmpscal2
1599 HEFF(I,J,bi,bj) = HEFF(I,J,bi,bj) + tmpscal2
1600
1601 #ifdef ALLOW_SITRACER
1602 SItrHEFF(I,J,bi,bj,3)=HEFF(I,J,bi,bj)
1603 #endif
1604 ENDDO
1605 ENDDO
1606 #endif /* SEAICE_ITD */
1607 #ifdef SEAICE_DEBUG
1608 c ToM<<< debug seaice_growth
1609 WRITE(msgBuf,'(A,7F8.4)')
1610 #ifdef SEAICE_ITD
1611 & ' SEAICE_GROWTH: Heff increments 4, HEFFITD = ',
1612 & HEFFITD(1,1,:,bi,bj)
1613 CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
1614 & SQUEEZE_RIGHT , myThid)
1615 WRITE(msgBuf,'(A,7F8.4)')
1616 & ' SEAICE_GROWTH: Area increments 4, AREAITD = ',
1617 & AREAITD(1,1,:,bi,bj)
1618 #else
1619 & ' SEAICE_GROWTH: Heff increments 4, HEFF = ',
1620 & HEFF(1,1,bi,bj)
1621 #endif
1622 CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
1623 & SQUEEZE_RIGHT , myThid)
1624 c ToM>>>
1625 #endif
1626
1627 C add snow precipitation to HSNOW.
1628 C =================================================
1629 #ifdef ALLOW_ATM_TEMP
1630 # ifdef ALLOW_AUTODIFF_TAMC
1631 CADJ STORE a_QbyATM_cover = comlev1_bibj,key=iicekey,byte=isbyte
1632 CADJ STORE PRECIP(:,:,bi,bj) = comlev1_bibj,key=iicekey,byte=isbyte
1633 CADJ STORE AREApreTH = comlev1_bibj,key=iicekey,byte=isbyte
1634 # endif /* ALLOW_AUTODIFF_TAMC */
1635 IF ( snowPrecipFile .NE. ' ' ) THEN
1636 C add snowPrecip to HSNOW
1637 DO J=1,sNy
1638 DO I=1,sNx
1639 d_HSNWbyRAIN(I,J) = convertPRECIP2HI * ICE2SNOW *
1640 & snowPrecip(i,j,bi,bj) * AREApreTH(I,J)
1641 d_HFRWbyRAIN(I,J) = -convertPRECIP2HI *
1642 & ( PRECIP(I,J,bi,bj) - snowPrecip(I,J,bi,bj) ) *
1643 & AREApreTH(I,J)
1644 HSNOW(I,J,bi,bj) = HSNOW(I,J,bi,bj) + d_HSNWbyRAIN(I,J)
1645 ENDDO
1646 ENDDO
1647 ELSE
1648 C attribute precip to fresh water or snow stock,
1649 C depending on atmospheric conditions.
1650 DO J=1,sNy
1651 DO I=1,sNx
1652 C possible alternatives to the a_QbyATM_cover criterium
1653 c IF (TICE(I,J,bi,bj) .LT. TMIX) THEN
1654 c IF (atemp(I,J,bi,bj) .LT. celsius2K) THEN
1655 IF ( a_QbyATM_cover(I,J).GE. 0. _d 0 ) THEN
1656 C add precip as snow
1657 d_HFRWbyRAIN(I,J)=0. _d 0
1658 d_HSNWbyRAIN(I,J)=convertPRECIP2HI*ICE2SNOW*
1659 & PRECIP(I,J,bi,bj)*AREApreTH(I,J)
1660 ELSE
1661 C add precip to the fresh water bucket
1662 d_HFRWbyRAIN(I,J)=-convertPRECIP2HI*
1663 & PRECIP(I,J,bi,bj)*AREApreTH(I,J)
1664 d_HSNWbyRAIN(I,J)=0. _d 0
1665 ENDIF
1666 ENDDO
1667 ENDDO
1668 #ifdef SEAICE_ITD
1669 DO IT=1,nITD
1670 DO J=1,sNy
1671 DO I=1,sNx
1672 HSNOWITD(I,J,IT,bi,bj) = HSNOWITD(I,J,IT,bi,bj)
1673 & + d_HSNWbyRAIN(I,J)*areaFracFactor(I,J,IT)
1674 ENDDO
1675 ENDDO
1676 ENDDO
1677 #else
1678 DO J=1,sNy
1679 DO I=1,sNx
1680 HSNOW(I,J,bi,bj) = HSNOW(I,J,bi,bj) + d_HSNWbyRAIN(I,J)
1681 ENDDO
1682 ENDDO
1683 #endif
1684 Cgf note: this does not affect air-sea heat flux,
1685 Cgf since the implied air heat gain to turn
1686 Cgf rain to snow is not a surface process.
1687 C end of IF statement snowPrecipFile:
1688 ENDIF
1689 #endif /* ALLOW_ATM_TEMP */
1690 #ifdef SEAICE_DEBUG
1691 c ToM<<< debug seaice_growth
1692 WRITE(msgBuf,'(A,7F8.4)')
1693 #ifdef SEAICE_ITD
1694 & ' SEAICE_GROWTH: Heff increments 5, HEFFITD = ',
1695 & HEFFITD(1,1,:,bi,bj)
1696 CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
1697 & SQUEEZE_RIGHT , myThid)
1698 WRITE(msgBuf,'(A,7F8.4)')
1699 & ' SEAICE_GROWTH: Area increments 5, AREAITD = ',
1700 & AREAITD(1,1,:,bi,bj)
1701 #else
1702 & ' SEAICE_GROWTH: Heff increments 5, HEFF = ',
1703 & HEFF(1,1,bi,bj)
1704 #endif
1705 CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
1706 & SQUEEZE_RIGHT , myThid)
1707 c ToM>>>
1708 #endif
1709
1710 C compute snow melt due to heat available from ocean.
1711 C =================================================================
1712
1713 Cgf do we need to keep this comment and cpp bracket?
1714 Cph( very sensitive bit here by JZ
1715 #ifndef SEAICE_EXCLUDE_FOR_EXACT_AD_TESTING
1716 #ifdef ALLOW_AUTODIFF_TAMC
1717 CADJ STORE HSNOW(:,:,bi,bj) = comlev1_bibj,key=iicekey,byte=isbyte
1718 CADJ STORE r_QbyOCN = comlev1_bibj,key=iicekey,byte=isbyte
1719 #endif /* ALLOW_AUTODIFF_TAMC */
1720
1721 #ifdef SEAICE_ITD
1722 DO IT=1,nITD
1723 DO J=1,sNy
1724 DO I=1,sNx
1725 tmpscal1=MAX(r_QbyOCN(i,j)*ICE2SNOW*areaFracFactor(I,J,IT),
1726 & -HSNOWITD(I,J,IT,bi,bj))
1727 tmpscal2=MIN(tmpscal1,0. _d 0)
1728 #ifdef SEAICE_MODIFY_GROWTH_ADJ
1729 Cgf no additional dependency through snow
1730 if ( SEAICEadjMODE.GE.2 ) tmpscal2 = 0. _d 0
1731 #endif
1732 d_HSNWbyOCNonSNW(I,J) = d_HSNWbyOCNonSNW(I,J) + tmpscal2
1733 r_QbyOCN(I,J)=r_QbyOCN(I,J) - tmpscal2*SNOW2ICE
1734 HSNOWITD(I,J,IT,bi,bj) = HSNOWITD(I,J,IT,bi,bj) + tmpscal2
1735 ENDDO
1736 ENDDO
1737 ENDDO
1738 #else /* SEAICE_ITD */
1739 DO J=1,sNy
1740 DO I=1,sNx
1741 tmpscal1=MAX(r_QbyOCN(i,j)*ICE2SNOW, -HSNOW(I,J,bi,bj))
1742 tmpscal2=MIN(tmpscal1,0. _d 0)
1743 #ifdef SEAICE_MODIFY_GROWTH_ADJ
1744 Cgf no additional dependency through snow
1745 if ( SEAICEadjMODE.GE.2 ) tmpscal2 = 0. _d 0
1746 #endif
1747 d_HSNWbyOCNonSNW(I,J) = tmpscal2
1748 r_QbyOCN(I,J)=r_QbyOCN(I,J)
1749 & -d_HSNWbyOCNonSNW(I,J)*SNOW2ICE
1750 HSNOW(I,J,bi,bj) = HSNOW(I,J,bi,bj)+d_HSNWbyOCNonSNW(I,J)
1751 ENDDO
1752 ENDDO
1753 #endif /* SEAICE_ITD */
1754 #endif /* SEAICE_EXCLUDE_FOR_EXACT_AD_TESTING */
1755 Cph)
1756 #ifdef SEAICE_DEBUG
1757 c ToM<<< debug seaice_growth
1758 WRITE(msgBuf,'(A,7F8.4)')
1759 #ifdef SEAICE_ITD
1760 & ' SEAICE_GROWTH: Heff increments 6, HEFFITD = ',
1761 & HEFFITD(1,1,:,bi,bj)
1762 CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
1763 & SQUEEZE_RIGHT , myThid)
1764 WRITE(msgBuf,'(A,7F8.4)')
1765 & ' SEAICE_GROWTH: Area increments 6, AREAITD = ',
1766 & AREAITD(1,1,:,bi,bj)
1767 #else
1768 & ' SEAICE_GROWTH: Heff increments 6, HEFF = ',
1769 & HEFF(1,1,bi,bj)
1770 #endif
1771 CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
1772 & SQUEEZE_RIGHT , myThid)
1773 c ToM>>>
1774 #endif
1775
1776 C gain of new ice over open water
1777 C ===============================
1778 #ifdef ALLOW_AUTODIFF_TAMC
1779 CADJ STORE heff(:,:,bi,bj) = comlev1_bibj,key=iicekey,byte=isbyte
1780 CADJ STORE r_QbyATM_open = comlev1_bibj,key=iicekey,byte=isbyte
1781 CADJ STORE r_QbyOCN = comlev1_bibj,key=iicekey,byte=isbyte
1782 CADJ STORE a_QSWbyATM_cover = comlev1_bibj,key=iicekey,byte=isbyte
1783 CADJ STORE a_QSWbyATM_open = comlev1_bibj,key=iicekey,byte=isbyte
1784 #endif /* ALLOW_AUTODIFF_TAMC */
1785
1786 DO J=1,sNy
1787 DO I=1,sNx
1788 C Initial ice growth is triggered by open water
1789 C heat flux overcoming potential melt by ocean
1790 tmpscal1=r_QbyATM_open(I,J)+r_QbyOCN(i,j) *
1791 & (1.0 _d 0 - AREApreTH(I,J))
1792 C Penetrative shortwave flux beyond first layer
1793 C that is therefore not available to ice growth/melt
1794 tmpscal2=SWFracB * a_QSWbyATM_open(I,J)
1795 C impose -HEFF as the maxmum melting if SEAICE_doOpenWaterMelt
1796 C or 0. otherwise (no melting if not SEAICE_doOpenWaterMelt)
1797 tmpscal3=facOpenGrow*MAX(tmpscal1-tmpscal2,
1798 & -HEFF(I,J,bi,bj)*facOpenMelt)*HEFFM(I,J,bi,bj)
1799 d_HEFFbyATMonOCN_open(I,J)=tmpscal3
1800 d_HEFFbyATMonOCN(I,J)=d_HEFFbyATMonOCN(I,J)+tmpscal3
1801 r_QbyATM_open(I,J)=r_QbyATM_open(I,J)-tmpscal3
1802 #ifdef SEAICE_ITD
1803 C open water area fraction
1804 tmpscal0 = ONE-AREApreTH(I,J)
1805 C determine thickness of new ice
1806 ctomC considering the entire open water area to refreeze
1807 ctom tmpscal1 = tmpscal3/tmpscal0
1808 C considering a minimum lead ice thickness of 10 cm
1809 C WATCH that leadIceThickMin is smaller that Hlimit(1)!
1810 leadIceThickMin = 0.1
1811 tmpscal1 = MAX(leadIceThickMin,tmpscal3/tmpscal0)
1812 C adjust ice area fraction covered by new ice
1813 tmpscal0 = tmpscal3/tmpscal1
1814 C then add new ice volume to appropriate thickness category
1815 DO IT=1,nITD
1816 IF (tmpscal1.LT.Hlimit(IT)) THEN
1817 HEFFITD(I,J,IT,bi,bj) = HEFFITD(I,J,IT,bi,bj) + tmpscal3
1818 tmpscal3=ZERO
1819 C not sure if AREAITD should be changed here since AREA is incremented
1820 C in PART 4 below in non-itd code
1821 C in this scenario all open water is covered by new ice instantaneously,
1822 C i.e. no delayed lead closing is concidered such as is associated with
1823 C Hibler's h_0 parameter
1824 AREAITD(I,J,IT,bi,bj) = AREAITD(I,J,IT,bi,bj)
1825 & + tmpscal0
1826 tmpscal0=ZERO
1827 ENDIF
1828 ENDDO
1829 #else
1830 HEFF(I,J,bi,bj) = HEFF(I,J,bi,bj) + tmpscal3
1831 #endif
1832 ENDDO
1833 ENDDO
1834
1835 #ifdef ALLOW_SITRACER
1836 #ifdef SEAICE_ITD
1837 DO IT=1,nITD
1838 DO J=1,sNy
1839 DO I=1,sNx
1840 c needs to be here to allow use also with LEGACY branch
1841 SItrHEFF(I,J,bi,bj,4) = SItrHEFF(I,J,bi,bj,4)
1842 & + HEFFITD(I,J,IT,bi,bj)
1843 ENDDO
1844 ENDDO
1845 ENDDO
1846 #else
1847 DO J=1,sNy
1848 DO I=1,sNx
1849 C needs to be here to allow use also with LEGACY branch
1850 SItrHEFF(I,J,bi,bj,4)=HEFF(I,J,bi,bj)
1851 ENDDO
1852 ENDDO
1853 #endif
1854 #endif /* ALLOW_SITRACER */
1855 #ifdef SEAICE_DEBUG
1856 c ToM<<< debug seaice_growth
1857 WRITE(msgBuf,'(A,7F8.4)')
1858 #ifdef SEAICE_ITD
1859 & ' SEAICE_GROWTH: Heff increments 7, HEFFITD = ',
1860 & HEFFITD(1,1,:,bi,bj)
1861 CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
1862 & SQUEEZE_RIGHT , myThid)
1863 WRITE(msgBuf,'(A,7F8.4)')
1864 & ' SEAICE_GROWTH: Area increments 7, AREAITD = ',
1865 & AREAITD(1,1,:,bi,bj)
1866 #else
1867 & ' SEAICE_GROWTH: Heff increments 7, HEFF = ',
1868 & HEFF(1,1,bi,bj)
1869 CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
1870 & SQUEEZE_RIGHT , myThid)
1871 WRITE(msgBuf,'(A,7F8.4)')
1872 & ' SEAICE_GROWTH: Area increments 7, AREA = ',
1873 & AREA(1,1,bi,bj)
1874 #endif
1875 CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
1876 & SQUEEZE_RIGHT , myThid)
1877 c ToM>>>
1878 #endif
1879
1880 C convert snow to ice if submerged.
1881 C =================================
1882
1883 #ifndef SEAICE_GROWTH_LEGACY
1884 C note: in legacy, this process is done at the end
1885 #ifdef ALLOW_AUTODIFF_TAMC
1886 CADJ STORE heff(:,:,bi,bj) = comlev1_bibj,key=iicekey,byte=isbyte
1887 CADJ STORE hsnow(:,:,bi,bj) = comlev1_bibj,key=iicekey,byte=isbyte
1888 #endif /* ALLOW_AUTODIFF_TAMC */
1889 IF ( SEAICEuseFlooding ) THEN
1890 #ifdef SEAICE_ITD
1891 DO IT=1,nITD
1892 DO J=1,sNy
1893 DO I=1,sNx
1894 tmpscal0 = (HSNOWITD(I,J,IT,bi,bj)*SEAICE_rhoSnow
1895 & + HEFFITD(I,J,IT,bi,bj) *SEAICE_rhoIce)
1896 & *recip_rhoConst
1897 tmpscal1 = MAX( 0. _d 0, tmpscal0 - HEFFITD(I,J,IT,bi,bj))
1898 d_HEFFbyFLOODING(I,J) = d_HEFFbyFLOODING(I,J) + tmpscal1
1899 HEFFITD(I,J,IT,bi,bj) = HEFFITD(I,J,IT,bi,bj) + tmpscal1
1900 HSNOWITD(I,J,IT,bi,bj)= HSNOWITD(I,J,IT,bi,bj) - tmpscal1
1901 & * ICE2SNOW
1902 ENDDO
1903 ENDDO
1904 ENDDO
1905 #else
1906 DO J=1,sNy
1907 DO I=1,sNx
1908 tmpscal0 = (HSNOW(I,J,bi,bj)*SEAICE_rhoSnow
1909 & +HEFF(I,J,bi,bj)*SEAICE_rhoIce)*recip_rhoConst
1910 tmpscal1 = MAX( 0. _d 0, tmpscal0 - HEFF(I,J,bi,bj))
1911 d_HEFFbyFLOODING(I,J)=tmpscal1
1912 HEFF(I,J,bi,bj) = HEFF(I,J,bi,bj)+d_HEFFbyFLOODING(I,J)
1913 HSNOW(I,J,bi,bj) = HSNOW(I,J,bi,bj)-
1914 & d_HEFFbyFLOODING(I,J)*ICE2SNOW
1915 ENDDO
1916 ENDDO
1917 #endif
1918 ENDIF
1919 #endif /* SEAICE_GROWTH_LEGACY */
1920 #ifdef SEAICE_DEBUG
1921 c ToM<<< debug seaice_growth
1922 WRITE(msgBuf,'(A,7F8.4)')
1923 #ifdef SEAICE_ITD
1924 & ' SEAICE_GROWTH: Heff increments 8, HEFFITD = ',
1925 & HEFFITD(1,1,:,bi,bj)
1926 CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
1927 & SQUEEZE_RIGHT , myThid)
1928 WRITE(msgBuf,'(A,7F8.4)')
1929 & ' SEAICE_GROWTH: Area increments 8, AREAITD = ',
1930 & AREAITD(1,1,:,bi,bj)
1931 #else
1932 & ' SEAICE_GROWTH: Heff increments 8, HEFF = ',
1933 & HEFF(1,1,bi,bj)
1934 CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
1935 & SQUEEZE_RIGHT , myThid)
1936 WRITE(msgBuf,'(A,7F8.4)')
1937 & ' SEAICE_GROWTH: Area increments 8, AREA = ',
1938 & AREA(1,1,bi,bj)
1939 #endif
1940 CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
1941 & SQUEEZE_RIGHT , myThid)
1942 c ToM>>>
1943 #endif
1944
1945 C ===================================================================
1946 C ==========PART 4: determine ice cover fraction increments=========-
1947 C ===================================================================
1948
1949 #ifdef ALLOW_AUTODIFF_TAMC
1950 CADJ STORE d_HEFFbyATMonOCN = comlev1_bibj,key=iicekey,byte=isbyte
1951 CADJ STORE d_HEFFbyATMonOCN_cover = comlev1_bibj,key=iicekey,byte=isbyte
1952 CADJ STORE d_HEFFbyATMonOCN_open = comlev1_bibj,key=iicekey,byte=isbyte
1953 CADJ STORE d_HEFFbyOCNonICE = comlev1_bibj,key=iicekey,byte=isbyte
1954 CADJ STORE recip_heffActual = comlev1_bibj,key=iicekey,byte=isbyte
1955 CADJ STORE d_hsnwbyatmonsnw = comlev1_bibj,key=iicekey,byte=isbyte
1956 cph(
1957 cphCADJ STORE d_AREAbyATM = comlev1_bibj,key=iicekey,byte=isbyte
1958 cphCADJ STORE d_AREAbyICE = comlev1_bibj,key=iicekey,byte=isbyte
1959 cphCADJ STORE d_AREAbyOCN = comlev1_bibj,key=iicekey,byte=isbyte
1960 cph)
1961 CADJ STORE a_QbyATM_open = comlev1_bibj,key=iicekey,byte=isbyte
1962 CADJ STORE heffActual = comlev1_bibj,key=iicekey,byte=isbyte
1963 CADJ STORE AREApreTH = comlev1_bibj,key=iicekey,byte=isbyte
1964 CADJ STORE HEFF(:,:,bi,bj) = comlev1_bibj,key=iicekey,byte=isbyte
1965 CADJ STORE HSNOW(:,:,bi,bj) = comlev1_bibj,key=iicekey,byte=isbyte
1966 CADJ STORE AREA(:,:,bi,bj) = comlev1_bibj,key=iicekey,byte=isbyte
1967 #endif /* ALLOW_AUTODIFF_TAMC */
1968
1969 #ifdef SEAICE_ITD
1970 C replaces Hibler '79 scheme and lead closing parameter
1971 C because ITD accounts explicitly for lead openings and
1972 C different melt rates due to varying ice thickness
1973 C
1974 C only consider ice area loss due to total ice thickness loss;
1975 C ice area gain due to freezing of open water is handled above
1976 C under "gain of new ice over open water"
1977 C
1978 C does not account for lateral melt of ice floes
1979 C
1980 C AREAITD is incremented in section "gain of new ice over open water" above
1981 C
1982 DO IT=1,nITD
1983 DO J=1,sNy
1984 DO I=1,sNx
1985 IF (HEFFITD(I,J,IT,bi,bj).LE.ZERO) THEN
1986 AREAITD(I,J,IT,bi,bj)=ZERO
1987 ENDIF
1988 #ifdef ALLOW_SITRACER
1989 SItrAREA(I,J,bi,bj,3) = SItrAREA(I,J,bi,bj,3)
1990 & + AREAITD(I,J,IT,bi,bj)
1991 #endif /* ALLOW_SITRACER */
1992 ENDDO
1993 ENDDO
1994 ENDDO
1995 #else /* SEAICE_ITD */
1996 DO J=1,sNy
1997 DO I=1,sNx
1998
1999 IF ( YC(I,J,bi,bj) .LT. ZERO ) THEN
2000 recip_HO=1. _d 0 / HO_south
2001 ELSE
2002 recip_HO=1. _d 0 / HO
2003 ENDIF
2004 #ifdef SEAICE_GROWTH_LEGACY
2005 tmpscal0=HEFF(I,J,bi,bj) - d_HEFFbyATMonOCN(I,J)
2006 recip_HH = AREApreTH(I,J) /(tmpscal0+.00001 _d 0)
2007 #else
2008 recip_HH = recip_heffActual(I,J)
2009 #endif
2010
2011 C gain of ice over open water : computed from
2012 C (SEAICE_areaGainFormula.EQ.1) from growth by ATM
2013 C (SEAICE_areaGainFormula.EQ.2) from predicted growth by ATM
2014 IF (SEAICE_areaGainFormula.EQ.1) THEN
2015 tmpscal4 = MAX(ZERO,d_HEFFbyATMonOCN_open(I,J))
2016 ELSE
2017 tmpscal4=MAX(ZERO,a_QbyATM_open(I,J))
2018 ENDIF
2019
2020 C loss of ice cover by melting : computed from
2021 C (SEAICE_areaLossFormula.EQ.1) from all but only melt conributions by ATM and OCN
2022 C (SEAICE_areaLossFormula.EQ.2) from net melt-growth>0 by ATM and OCN
2023 C (SEAICE_areaLossFormula.EQ.3) from predicted melt by ATM
2024 IF (SEAICE_areaLossFormula.EQ.1) THEN
2025 tmpscal3 = MIN( 0. _d 0 , d_HEFFbyATMonOCN_cover(I,J) )
2026 & + MIN( 0. _d 0 , d_HEFFbyATMonOCN_open(I,J) )
2027 & + MIN( 0. _d 0 , d_HEFFbyOCNonICE(I,J) )
2028 ELSEIF (SEAICE_areaLossFormula.EQ.2) THEN
2029 tmpscal3 = MIN( 0. _d 0 , d_HEFFbyATMonOCN_cover(I,J)
2030 & + d_HEFFbyATMonOCN_open(I,J) + d_HEFFbyOCNonICE(I,J) )
2031 ELSE
2032 C compute heff after ice melt by ocn:
2033 tmpscal0=HEFF(I,J,bi,bj) - d_HEFFbyATMonOCN(I,J)
2034 C compute available heat left after snow melt by atm:
2035 tmpscal1= a_QbyATM_open(I,J)+a_QbyATM_cover(I,J)
2036 & - d_HSNWbyATMonSNW(I,J)*SNOW2ICE
2037 C could not melt more than all the ice
2038 tmpscal2 = MAX(-tmpscal0,tmpscal1)
2039 tmpscal3 = MIN(ZERO,tmpscal2)
2040 ENDIF
2041
2042 C apply tendency
2043 IF ( (HEFF(i,j,bi,bj).GT.0. _d 0).OR.
2044 & (HSNOW(i,j,bi,bj).GT.0. _d 0) ) THEN
2045 AREA(I,J,bi,bj)=MAX(0. _d 0,
2046 & MIN( SEAICE_area_max, AREA(I,J,bi,bj)
2047 & + recip_HO*tmpscal4+HALF*recip_HH*tmpscal3 ))
2048 ELSE
2049 AREA(I,J,bi,bj)=0. _d 0
2050 ENDIF
2051 #ifdef ALLOW_SITRACER
2052 SItrAREA(I,J,bi,bj,3)=AREA(I,J,bi,bj)
2053 #endif /* ALLOW_SITRACER */
2054 #ifdef ALLOW_DIAGNOSTICS
2055 d_AREAbyATM(I,J)=
2056 & recip_HO*MAX(ZERO,d_HEFFbyATMonOCN_open(I,J))
2057 & +HALF*recip_HH*MIN(0. _d 0,d_HEFFbyATMonOCN_open(I,J))
2058 d_AREAbyICE(I,J)=
2059 & HALF*recip_HH*MIN(0. _d 0,d_HEFFbyATMonOCN_cover(I,J))
2060 d_AREAbyOCN(I,J)=
2061 & HALF*recip_HH*MIN( 0. _d 0,d_HEFFbyOCNonICE(I,J) )
2062 #endif /* ALLOW_DIAGNOSTICS */
2063 ENDDO
2064 ENDDO
2065 #endif /* SEAICE_ITD */
2066
2067 #if (defined ALLOW_AUTODIFF_TAMC && defined SEAICE_MODIFY_GROWTH_ADJ)
2068 Cgf 'bulk' linearization of area=f(HEFF)
2069 IF ( SEAICEadjMODE.GE.1 ) THEN
2070 #ifdef SEAICE_ITD
2071 DO IT=1,nITD
2072 DO J=1,sNy
2073 DO I=1,sNx
2074 AREAITD(I,J,IT,bi,bj) = AREAITDpreTH(I,J,IT) + 0.1 _d 0 *
2075 & ( HEFFITD(I,J,IT,bi,bj) - HEFFITDpreTH(I,J,IT) )
2076 ENDDO
2077 ENDDO
2078 ENDDO
2079 #else
2080 DO J=1,sNy
2081 DO I=1,sNx
2082 C AREA(I,J,bi,bj) = 0.1 _d 0 * HEFF(I,J,bi,bj)
2083 AREA(I,J,bi,bj) = AREApreTH(I,J) + 0.1 _d 0 *
2084 & ( HEFF(I,J,bi,bj) - HEFFpreTH(I,J) )
2085 ENDDO
2086 ENDDO
2087 #endif
2088 ENDIF
2089 #endif
2090 #ifdef SEAICE_ITD
2091 C check categories for consistency with limits after growth/melt
2092 CALL SEAICE_ITD_REDIST(bi, bj, myTime,myIter,myThid)
2093 C finally update total AREA, HEFF, HSNOW
2094 CALL SEAICE_ITD_SUM(bi, bj, myTime,myIter,myThid)
2095 #endif
2096
2097 C ===================================================================
2098 C =============PART 5: determine ice salinity increments=============
2099 C ===================================================================
2100
2101 #ifndef SEAICE_VARIABLE_SALINITY
2102 # if (defined ALLOW_AUTODIFF_TAMC && defined ALLOW_SALT_PLUME)
2103 CADJ STORE d_HEFFbyNEG = comlev1_bibj,key=iicekey,byte=isbyte
2104 CADJ STORE d_HEFFbyOCNonICE = comlev1_bibj,key=iicekey,byte=isbyte
2105 CADJ STORE d_HEFFbyATMonOCN = comlev1_bibj,key=iicekey,byte=isbyte
2106 CADJ STORE d_HEFFbyATMonOCN_open = comlev1_bibj,key=iicekey,byte=isbyte
2107 CADJ STORE d_HEFFbyATMonOCN_cover = comlev1_bibj,key=iicekey,byte=isbyte
2108 CADJ STORE d_HEFFbyFLOODING = comlev1_bibj,key=iicekey,byte=isbyte
2109 CADJ STORE d_HEFFbySublim = comlev1_bibj,key=iicekey,byte=isbyte
2110 CADJ STORE salt(:,:,kSurface,bi,bj) = comlev1_bibj,
2111 CADJ & key = iicekey, byte = isbyte
2112 # endif /* ALLOW_AUTODIFF_TAMC and ALLOW_SALT_PLUME */
2113 DO J=1,sNy
2114 DO I=1,sNx
2115 tmpscal1 = d_HEFFbyNEG(I,J) + d_HEFFbyOCNonICE(I,J) +
2116 & d_HEFFbyATMonOCN(I,J) + d_HEFFbyFLOODING(I,J)
2117 & + d_HEFFbySublim(I,J)
2118 #ifdef EXF_ALLOW_SEAICE_RELAX
2119 & + d_HEFFbyRLX(I,J)
2120 #endif
2121 tmpscal2 = tmpscal1 * SEAICE_salt0 * HEFFM(I,J,bi,bj)
2122 & * recip_deltaTtherm * SEAICE_rhoIce
2123 saltFlux(I,J,bi,bj) = tmpscal2
2124 #ifdef ALLOW_SALT_PLUME
2125 tmpscal3 = tmpscal1*salt(I,J,kSurface,bi,bj)*HEFFM(I,J,bi,bj)
2126 & * recip_deltaTtherm * SEAICE_rhoIce
2127 saltPlumeFlux(I,J,bi,bj) = MAX( tmpscal3-tmpscal2 , 0. _d 0)
2128 & *SPsalFRAC
2129 #endif /* ALLOW_SALT_PLUME */
2130 ENDDO
2131 ENDDO
2132 #endif /* ndef SEAICE_VARIABLE_SALINITY */
2133
2134 #ifdef SEAICE_VARIABLE_SALINITY
2135
2136 #ifdef SEAICE_GROWTH_LEGACY
2137 # ifdef ALLOW_AUTODIFF_TAMC
2138 CADJ STORE hsalt(:,:,bi,bj) = comlev1_bibj,key=iicekey,byte=isbyte
2139 # endif /* ALLOW_AUTODIFF_TAMC */
2140 DO J=1,sNy
2141 DO I=1,sNx
2142 C set HSALT = 0 if HSALT < 0 and compute salt to remove from ocean
2143 IF ( HSALT(I,J,bi,bj) .LT. 0.0 ) THEN
2144 saltFluxAdjust(I,J) = - HEFFM(I,J,bi,bj) *
2145 & HSALT(I,J,bi,bj) * recip_deltaTtherm
2146 HSALT(I,J,bi,bj) = 0.0 _d 0
2147 ENDIF
2148 ENDDO
2149 ENDDO
2150 #endif /* SEAICE_GROWTH_LEGACY */
2151
2152 #ifdef ALLOW_AUTODIFF_TAMC
2153 CADJ STORE hsalt(:,:,bi,bj) = comlev1_bibj,key=iicekey,byte=isbyte
2154 #endif /* ALLOW_AUTODIFF_TAMC */
2155
2156 DO J=1,sNy
2157 DO I=1,sNx
2158 C sum up the terms that affect the salt content of the ice pack
2159 tmpscal1=d_HEFFbyOCNonICE(I,J)+d_HEFFbyATMonOCN(I,J)
2160
2161 C recompute HEFF before thermodynamic updates (which is not AREApreTH in legacy code)
2162 tmpscal2=HEFF(I,J,bi,bj)-tmpscal1-d_HEFFbyFLOODING(I,J)
2163 C tmpscal1 > 0 : m of sea ice that is created
2164 IF ( tmpscal1 .GE. 0.0 ) THEN
2165 saltFlux(I,J,bi,bj) =
2166 & HEFFM(I,J,bi,bj)*recip_deltaTtherm
2167 & *SEAICE_saltFrac*salt(I,J,kSurface,bi,bj)
2168 & *tmpscal1*SEAICE_rhoIce
2169 #ifdef ALLOW_SALT_PLUME
2170 C saltPlumeFlux is defined only during freezing:
2171 saltPlumeFlux(I,J,bi,bj)=
2172 & HEFFM(I,J,bi,bj)*recip_deltaTtherm
2173 & *(ONE-SEAICE_saltFrac)*salt(I,J,kSurface,bi,bj)
2174 & *tmpscal1*SEAICE_rhoIce
2175 & *SPsalFRAC
2176 C if SaltPlumeSouthernOcean=.FALSE. turn off salt plume in Southern Ocean
2177 IF ( .NOT. SaltPlumeSouthernOcean ) THEN
2178 IF ( YC(I,J,bi,bj) .LT. 0.0 _d 0 )
2179 & saltPlumeFlux(i,j,bi,bj) = 0.0 _d 0
2180 ENDIF
2181 #endif /* ALLOW_SALT_PLUME */
2182
2183 C tmpscal1 < 0 : m of sea ice that is melted
2184 ELSE
2185 saltFlux(I,J,bi,bj) =
2186 & HEFFM(I,J,bi,bj)*recip_deltaTtherm
2187 & *HSALT(I,J,bi,bj)
2188 & *tmpscal1/tmpscal2
2189 #ifdef ALLOW_SALT_PLUME
2190 saltPlumeFlux(i,j,bi,bj) = 0.0 _d 0
2191 #endif /* ALLOW_SALT_PLUME */
2192 ENDIF
2193 C update HSALT based on surface saltFlux
2194 HSALT(I,J,bi,bj) = HSALT(I,J,bi,bj) +
2195 & saltFlux(I,J,bi,bj) * SEAICE_deltaTtherm
2196 saltFlux(I,J,bi,bj) =
2197 & saltFlux(I,J,bi,bj) + saltFluxAdjust(I,J)
2198 #ifdef SEAICE_GROWTH_LEGACY
2199 C set HSALT = 0 if HEFF = 0 and compute salt to dump into ocean
2200 IF ( HEFF(I,J,bi,bj) .EQ. 0.0 ) THEN
2201 saltFlux(I,J,bi,bj) = saltFlux(I,J,bi,bj) -
2202 & HEFFM(I,J,bi,bj) * HSALT(I,J,bi,bj) * recip_deltaTtherm
2203 HSALT(I,J,bi,bj) = 0.0 _d 0
2204 #ifdef ALLOW_SALT_PLUME
2205 saltPlumeFlux(i,j,bi,bj) = 0.0 _d 0
2206 #endif /* ALLOW_SALT_PLUME */
2207 ENDIF
2208 #endif /* SEAICE_GROWTH_LEGACY */
2209 ENDDO
2210 ENDDO
2211 #endif /* SEAICE_VARIABLE_SALINITY */
2212
2213 C =======================================================================
2214 C ==LEGACY PART 6 (LEGACY) treat pathological cases, then do flooding ===
2215 C =======================================================================
2216
2217 #ifdef SEAICE_GROWTH_LEGACY
2218
2219 C treat values of ice cover fraction oustide
2220 C the [0 1] range, and other such issues.
2221 C ===========================================
2222
2223 Cgf note: this part cannot be heat and water conserving
2224
2225 #ifdef ALLOW_AUTODIFF_TAMC
2226 CADJ STORE area(:,:,bi,bj) = comlev1_bibj,
2227 CADJ & key = iicekey, byte = isbyte
2228 CADJ STORE heff(:,:,bi,bj) = comlev1_bibj,
2229 CADJ & key = iicekey, byte = isbyte
2230 #endif /* ALLOW_AUTODIFF_TAMC */
2231 DO J=1,sNy
2232 DO I=1,sNx
2233 C NOW SET AREA(I,J,bi,bj)=0 WHERE THERE IS NO ICE
2234 CML replaced "/.0001 _d 0" by "*1. _d 4", 1e-4 is probably
2235 CML meant to be something like a minimum thickness
2236 AREA(I,J,bi,bj)=MIN(AREA(I,J,bi,bj),HEFF(I,J,bi,bj)*1. _d 4)
2237 ENDDO
2238 ENDDO
2239
2240 #ifdef ALLOW_AUTODIFF_TAMC
2241 CADJ STORE area(:,:,bi,bj) = comlev1_bibj,
2242 CADJ & key = iicekey, byte = isbyte
2243 #endif /* ALLOW_AUTODIFF_TAMC */
2244 DO J=1,sNy
2245 DO I=1,sNx
2246 C NOW TRUNCATE AREA
2247 AREA(I,J,bi,bj)=MIN(ONE,AREA(I,J,bi,bj))
2248 ENDDO
2249 ENDDO
2250
2251 #ifdef ALLOW_AUTODIFF_TAMC
2252 CADJ STORE area(:,:,bi,bj) = comlev1_bibj,
2253 CADJ & key = iicekey, byte = isbyte
2254 CADJ STORE hsnow(:,:,bi,bj) = comlev1_bibj,
2255 CADJ & key = iicekey, byte = isbyte
2256 #endif /* ALLOW_AUTODIFF_TAMC */
2257 DO J=1,sNy
2258 DO I=1,sNx
2259 AREA(I,J,bi,bj) = MAX(ZERO,AREA(I,J,bi,bj))
2260 HSNOW(I,J,bi,bj) = MAX(ZERO,HSNOW(I,J,bi,bj))
2261 AREA(I,J,bi,bj) = AREA(I,J,bi,bj)*HEFFM(I,J,bi,bj)
2262 HEFF(I,J,bi,bj) = HEFF(I,J,bi,bj)*HEFFM(I,J,bi,bj)
2263 #ifdef SEAICE_CAP_HEFF
2264 C This is not energy conserving, but at least it conserves fresh water
2265 tmpscal0 = -MAX(HEFF(I,J,bi,bj)-MAX_HEFF,0. _d 0)
2266 d_HEFFbyNeg(I,J) = d_HEFFbyNeg(I,J) + tmpscal0
2267 HEFF(I,J,bi,bj) = HEFF(I,J,bi,bj) + tmpscal0
2268 #endif /* SEAICE_CAP_HEFF */
2269 HSNOW(I,J,bi,bj) = HSNOW(I,J,bi,bj)*HEFFM(I,J,bi,bj)
2270 ENDDO
2271 ENDDO
2272
2273 C convert snow to ice if submerged.
2274 C =================================
2275
2276 IF ( SEAICEuseFlooding ) THEN
2277 DO J=1,sNy
2278 DO I=1,sNx
2279 tmpscal0 = (HSNOW(I,J,bi,bj)*SEAICE_rhoSnow
2280 & +HEFF(I,J,bi,bj)*SEAICE_rhoIce)*recip_rhoConst
2281 tmpscal1 = MAX( 0. _d 0, tmpscal0 - HEFF(I,J,bi,bj))
2282 d_HEFFbyFLOODING(I,J)=tmpscal1
2283 HEFF(I,J,bi,bj) = HEFF(I,J,bi,bj)+d_HEFFbyFLOODING(I,J)
2284 HSNOW(I,J,bi,bj) = HSNOW(I,J,bi,bj)-
2285 & d_HEFFbyFLOODING(I,J)*ICE2SNOW
2286 ENDDO
2287 ENDDO
2288 ENDIF
2289
2290 #endif /* SEAICE_GROWTH_LEGACY */
2291
2292 #ifdef ALLOW_SITRACER
2293 DO J=1,sNy
2294 DO I=1,sNx
2295 C needs to be here to allow use also with LEGACY branch
2296 SItrHEFF(I,J,bi,bj,5)=HEFF(I,J,bi,bj)
2297 ENDDO
2298 ENDDO
2299 #endif /* ALLOW_SITRACER */
2300
2301 C ===================================================================
2302 C ==============PART 7: determine ocean model forcing================
2303 C ===================================================================
2304
2305 C compute net heat flux leaving/entering the ocean,
2306 C accounting for the part used in melt/freeze processes
2307 C =====================================================
2308
2309 #ifdef SEAICE_ITD
2310 C compute total of "mult" fluxes for ocean forcing
2311 DO J=1,sNy
2312 DO I=1,sNx
2313 a_QbyATM_cover(I,J) = 0.0 _d 0
2314 r_QbyATM_cover(I,J) = 0.0 _d 0
2315 a_QSWbyATM_cover(I,J) = 0.0 _d 0
2316 r_FWbySublim(I,J) = 0.0 _d 0
2317 ENDDO
2318 ENDDO
2319 DO IT=1,nITD
2320 DO J=1,sNy
2321 DO I=1,sNx
2322 cToM if fluxes in W/m^2 then
2323 c a_QbyATM_cover(I,J)=a_QbyATM_cover(I,J)
2324 c & + a_QbyATMmult_cover(I,J,IT) * areaFracFactor(I,J,IT)
2325 c r_QbyATM_cover(I,J)=r_QbyATM_cover(I,J)
2326 c & + r_QbyATMmult_cover(I,J,IT) * areaFracFactor(I,J,IT)
2327 c a_QSWbyATM_cover(I,J)=a_QSWbyATM_cover(I,J)
2328 c & + a_QSWbyATMmult_cover(I,J,IT) * areaFracFactor(I,J,IT)
2329 c r_FWbySublim(I,J)=r_FWbySublim(I,J)
2330 c & + r_FWbySublimMult(I,J,IT) * areaFracFactor(I,J,IT)
2331 cToM if fluxes in effective ice meters, i.e. ice volume per area, then
2332 a_QbyATM_cover(I,J)=a_QbyATM_cover(I,J)
2333 & + a_QbyATMmult_cover(I,J,IT)
2334 r_QbyATM_cover(I,J)=r_QbyATM_cover(I,J)
2335 & + r_QbyATMmult_cover(I,J,IT)
2336 a_QSWbyATM_cover(I,J)=a_QSWbyATM_cover(I,J)
2337 & + a_QSWbyATMmult_cover(I,J,IT)
2338 r_FWbySublim(I,J)=r_FWbySublim(I,J)
2339 & + r_FWbySublimMult(I,J,IT)
2340 ENDDO
2341 ENDDO
2342 ENDDO
2343 #endif
2344
2345 #ifdef ALLOW_AUTODIFF_TAMC
2346 CADJ STORE d_hsnwbyneg = comlev1_bibj,key=iicekey,byte=isbyte
2347 CADJ STORE d_hsnwbyocnonsnw = comlev1_bibj,key=iicekey,byte=isbyte
2348 #endif /* ALLOW_AUTODIFF_TAMC */
2349
2350 DO J=1,sNy
2351 DO I=1,sNx
2352 QNET(I,J,bi,bj) = r_QbyATM_cover(I,J) + r_QbyATM_open(I,J)
2353 #ifndef SEAICE_GROWTH_LEGACY
2354 C in principle a_QSWbyATM_cover should always be included here, however
2355 C for backward compatibility it is left out of the LEGACY branch
2356 & + a_QSWbyATM_cover(I,J)
2357 #endif /* SEAICE_GROWTH_LEGACY */
2358 & - ( d_HEFFbyOCNonICE(I,J)
2359 & + d_HSNWbyOCNonSNW(I,J)*SNOW2ICE
2360 & + d_HEFFbyNEG(I,J)
2361 #ifdef EXF_ALLOW_SEAICE_RELAX
2362 & + d_HEFFbyRLX(I,J)
2363 #endif
2364 & + d_HSNWbyNEG(I,J)*SNOW2ICE
2365 & - convertPRECIP2HI *
2366 & snowPrecip(i,j,bi,bj) * (ONE-AREApreTH(I,J))
2367 & ) * maskC(I,J,kSurface,bi,bj)
2368 ENDDO
2369 ENDDO
2370 DO J=1,sNy
2371 DO I=1,sNx
2372 QSW(I,J,bi,bj) = a_QSWbyATM_cover(I,J) + a_QSWbyATM_open(I,J)
2373 ENDDO
2374 ENDDO
2375
2376 C switch heat fluxes from 'effective' ice meters to W/m2
2377 C ======================================================
2378
2379 DO J=1,sNy
2380 DO I=1,sNx
2381 QNET(I,J,bi,bj) = QNET(I,J,bi,bj)*convertHI2Q
2382 QSW(I,J,bi,bj) = QSW(I,J,bi,bj)*convertHI2Q
2383 ENDDO
2384 ENDDO
2385
2386 #ifndef SEAICE_DISABLE_HEATCONSFIX
2387 C treat advective heat flux by ocean to ice water exchange (at 0decC)
2388 C ===================================================================
2389 # ifdef ALLOW_AUTODIFF_TAMC
2390 CADJ STORE d_HEFFbyNEG = comlev1_bibj,key=iicekey,byte=isbyte
2391 CADJ STORE d_HEFFbyOCNonICE = comlev1_bibj,key=iicekey,byte=isbyte
2392 CADJ STORE d_HEFFbyATMonOCN = comlev1_bibj,key=iicekey,byte=isbyte
2393 CADJ STORE d_HSNWbyNEG = comlev1_bibj,key=iicekey,byte=isbyte
2394 CADJ STORE d_HSNWbyOCNonSNW = comlev1_bibj,key=iicekey,byte=isbyte
2395 CADJ STORE d_HSNWbyATMonSNW = comlev1_bibj,key=iicekey,byte=isbyte
2396 CADJ STORE theta(:,:,kSurface,bi,bj) = comlev1_bibj,
2397 CADJ & key = iicekey, byte = isbyte
2398 # endif /* ALLOW_AUTODIFF_TAMC */
2399 cgf Unlike for evap and precip, the temperature of gained/lost
2400 C ocean liquid water due to melt/freeze of solid water cannot be chosen
2401 C arbitrarily to be e.g. the ocean SST. Indeed the present seaice model
2402 C implies a constant ice temperature of 0degC. If melt/freeze water is exchanged
2403 C at a different temperature, it leads to a loss of conservation in the
2404 C ocean+ice system. While this is mostly a serious issue in the
2405 C real fresh water + non linear free surface framework, a mismatch
2406 C between ice and ocean boundary condition can result in all cases.
2407 C Below we therefore anticipate on external_forcing_surf.F
2408 C to diagnoze and/or apply the correction to QNET.
2409 DO J=1,sNy
2410 DO I=1,sNx
2411 C ocean water going to ice/snow, in precip units
2412 tmpscal3=rhoConstFresh*maskC(I,J,kSurface,bi,bj)*(
2413 & ( d_HSNWbyATMonSNW(I,J)*SNOW2ICE
2414 & + d_HSNWbyOCNonSNW(I,J)*SNOW2ICE
2415 & + d_HEFFbyOCNonICE(I,J) + d_HEFFbyATMonOCN(I,J)
2416 & + d_HEFFbyNEG(I,J) + d_HSNWbyNEG(I,J)*SNOW2ICE )
2417 & * convertHI2PRECIP
2418 & - snowPrecip(i,j,bi,bj) * (ONE-AREApreTH(I,J)) )
2419 C factor in the heat content as done in external_forcing_surf.F
2420 IF ( (temp_EvPrRn.NE.UNSET_RL).AND.useRealFreshWaterFlux
2421 & .AND.(nonlinFreeSurf.NE.0) ) THEN
2422 tmpscal1 = - tmpscal3*
2423 & HeatCapacity_Cp * temp_EvPrRn
2424 ELSEIF ( (temp_EvPrRn.EQ.UNSET_RL).AND.useRealFreshWaterFlux
2425 & .AND.(nonlinFreeSurf.NE.0) ) THEN
2426 tmpscal1 = - tmpscal3*
2427 & HeatCapacity_Cp * theta(I,J,kSurface,bi,bj)
2428 ELSEIF ( (temp_EvPrRn.NE.UNSET_RL) ) THEN
2429 tmpscal1 = - tmpscal3*HeatCapacity_Cp*
2430 & ( temp_EvPrRn - theta(I,J,kSurface,bi,bj) )
2431 ELSEIF ( (temp_EvPrRn.EQ.UNSET_RL) ) THEN
2432 tmpscal1 = ZERO
2433 ENDIF
2434 #ifdef ALLOW_DIAGNOSTICS
2435 C in all cases, diagnoze the boundary condition mismatch to SIaaflux
2436 DIAGarrayA(I,J)=tmpscal1
2437 #endif
2438 C remove the mismatch when real fresh water is exchanged (at 0degC here)
2439 IF ( useRealFreshWaterFlux.AND.(nonlinFreeSurf.GT.0).AND.
2440 & SEAICEheatConsFix ) QNET(I,J,bi,bj)=QNET(I,J,bi,bj)+tmpscal1
2441 ENDDO
2442 ENDDO
2443 #ifdef ALLOW_DIAGNOSTICS
2444 CALL DIAGNOSTICS_FILL(DIAGarrayA,
2445 & 'SIaaflux',0,1,3,bi,bj,myThid)
2446 #endif
2447 #endif /* ndef SEAICE_DISABLE_HEATCONSFIX */
2448
2449 C compute the net heat flux, incl. adv. by water, entering ocean+ice
2450 C ===================================================================
2451 DO J=1,sNy
2452 DO I=1,sNx
2453 cgf 1) SIatmQnt (analogous to qnet; excl. adv. by water exch.)
2454 CML If I consider the atmosphere above the ice, the surface flux
2455 CML which is relevant for the air temperature dT/dt Eq
2456 CML accounts for sensible and radiation (with different treatment
2457 CML according to wave-length) fluxes but not for "latent heat flux",
2458 CML since it does not contribute to heating the air.
2459 CML So this diagnostic is only good for heat budget calculations within
2460 CML the ice-ocean system.
2461 SIatmQnt(I,J,bi,bj) =
2462 & maskC(I,J,kSurface,bi,bj)*convertHI2Q*(
2463 #ifndef SEAICE_GROWTH_LEGACY
2464 & a_QSWbyATM_cover(I,J) +
2465 #endif /* SEAICE_GROWTH_LEGACY */
2466 & a_QbyATM_cover(I,J) + a_QbyATM_open(I,J) )
2467 cgf 2) SItflux (analogous to tflux; includes advection by water
2468 C exchanged between atmosphere and ocean+ice)
2469 C solid water going to atm, in precip units
2470 tmpscal1 = rhoConstFresh*maskC(I,J,kSurface,bi,bj)
2471 & * convertHI2PRECIP * ( - d_HSNWbyRAIN(I,J)*SNOW2ICE
2472 & + a_FWbySublim(I,J) - r_FWbySublim(I,J) )
2473 C liquid water going to atm, in precip units
2474 tmpscal2=rhoConstFresh*maskC(I,J,kSurface,bi,bj)*
2475 & ( ( EVAP(I,J,bi,bj)-PRECIP(I,J,bi,bj) )
2476 & * ( ONE - AREApreTH(I,J) )
2477 #ifdef ALLOW_RUNOFF
2478 & - RUNOFF(I,J,bi,bj)
2479 #endif /* ALLOW_RUNOFF */
2480 & + ( d_HFRWbyRAIN(I,J) + r_FWbySublim(I,J) )
2481 & *convertHI2PRECIP )
2482 C In real fresh water flux + nonlinFS, we factor in the advected specific
2483 C energy (referenced to 0 for 0deC liquid water). In virtual salt flux or
2484 C linFS, rain/evap get a special treatment (see external_forcing_surf.F).
2485 tmpscal1= - tmpscal1*
2486 & ( -SEAICE_lhFusion + HeatCapacity_Cp * ZERO )
2487 IF ( (temp_EvPrRn.NE.UNSET_RL).AND.useRealFreshWaterFlux
2488 & .AND.(nonlinFreeSurf.NE.0) ) THEN
2489 tmpscal2= - tmpscal2*
2490 & ( ZERO + HeatCapacity_Cp * temp_EvPrRn )
2491 ELSEIF ( (temp_EvPrRn.EQ.UNSET_RL).AND.useRealFreshWaterFlux
2492 & .AND.(nonlinFreeSurf.NE.0) ) THEN
2493 tmpscal2= - tmpscal2*
2494 & ( ZERO + HeatCapacity_Cp * theta(I,J,kSurface,bi,bj) )
2495 ELSEIF ( (temp_EvPrRn.NE.UNSET_RL) ) THEN
2496 tmpscal2= - tmpscal2*HeatCapacity_Cp*
2497 & ( temp_EvPrRn - theta(I,J,kSurface,bi,bj) )
2498 ELSEIF ( (temp_EvPrRn.EQ.UNSET_RL) ) THEN
2499 tmpscal2= ZERO
2500 ENDIF
2501 SItflux(I,J,bi,bj)=
2502 & SIatmQnt(I,J,bi,bj)-tmpscal1-tmpscal2
2503 ENDDO
2504 ENDDO
2505
2506 C compute net fresh water flux leaving/entering
2507 C the ocean, accounting for fresh/salt water stocks.
2508 C ==================================================
2509
2510 #ifdef ALLOW_ATM_TEMP
2511 DO J=1,sNy
2512 DO I=1,sNx
2513 tmpscal1= d_HSNWbyATMonSNW(I,J)*SNOW2ICE
2514 & +d_HFRWbyRAIN(I,J)
2515 & +d_HSNWbyOCNonSNW(I,J)*SNOW2ICE
2516 & +d_HEFFbyOCNonICE(I,J)
2517 & +d_HEFFbyATMonOCN(I,J)
2518 & +d_HEFFbyNEG(I,J)
2519 #ifdef EXF_ALLOW_SEAICE_RELAX
2520 & +d_HEFFbyRLX(I,J)
2521 #endif
2522 & +d_HSNWbyNEG(I,J)*SNOW2ICE
2523 C If r_FWbySublim>0, then it is evaporated from ocean.
2524 & +r_FWbySublim(I,J)
2525 EmPmR(I,J,bi,bj) = maskC(I,J,kSurface,bi,bj)*(
2526 & ( EVAP(I,J,bi,bj)-PRECIP(I,J,bi,bj) )
2527 & * ( ONE - AREApreTH(I,J) )
2528 #ifdef ALLOW_RUNOFF
2529 & - RUNOFF(I,J,bi,bj)
2530 #endif /* ALLOW_RUNOFF */
2531 & + tmpscal1*convertHI2PRECIP
2532 & )*rhoConstFresh
2533 c and the flux leaving/entering the ocean+ice
2534 SIatmFW(I,J,bi,bj) = maskC(I,J,kSurface,bi,bj)*(
2535 & EVAP(I,J,bi,bj)*( ONE - AREApreTH(I,J) )
2536 & - PRECIP(I,J,bi,bj)
2537 #ifdef ALLOW_RUNOFF
2538 & - RUNOFF(I,J,bi,bj)
2539 #endif /* ALLOW_RUNOFF */
2540 & )*rhoConstFresh
2541 & + a_FWbySublim(I,J) * SEAICE_rhoIce * recip_deltaTtherm
2542
2543 ENDDO
2544 ENDDO
2545
2546 #ifdef ALLOW_SSH_GLOBMEAN_COST_CONTRIBUTION
2547 C--
2548 DO J=1,sNy
2549 DO I=1,sNx
2550 frWtrAtm(I,J,bi,bj) = maskC(I,J,kSurface,bi,bj)*(
2551 & PRECIP(I,J,bi,bj)
2552 & - EVAP(I,J,bi,bj)*( ONE - AREApreTH(I,J) )
2553 # ifdef ALLOW_RUNOFF
2554 & + RUNOFF(I,J,bi,bj)
2555 # endif /* ALLOW_RUNOFF */
2556 & )*rhoConstFresh
2557 # ifdef SEAICE_ADD_SUBLIMATION_TO_FWBUDGET
2558 & - a_FWbySublim(I,J)*AREApreTH(I,J)
2559 # endif /* SEAICE_ADD_SUBLIMATION_TO_FWBUDGET */
2560 ENDDO
2561 ENDDO
2562 C--
2563 #else /* ndef ALLOW_SSH_GLOBMEAN_COST_CONTRIBUTION */
2564 C--
2565 # ifdef ALLOW_MEAN_SFLUX_COST_CONTRIBUTION
2566 DO J=1,sNy
2567 DO I=1,sNx
2568 frWtrAtm(I,J,bi,bj) = maskC(I,J,kSurface,bi,bj)*(
2569 & PRECIP(I,J,bi,bj)
2570 & - EVAP(I,J,bi,bj)
2571 & *( ONE - AREApreTH(I,J) )
2572 # ifdef ALLOW_RUNOFF
2573 & + RUNOFF(I,J,bi,bj)
2574 # endif /* ALLOW_RUNOFF */
2575 & )*rhoConstFresh
2576 & - a_FWbySublim(I,J) * SEAICE_rhoIce * recip_deltaTtherm
2577 ENDDO
2578 ENDDO
2579 # endif
2580 C--
2581 #endif /* ALLOW_SSH_GLOBMEAN_COST_CONTRIBUTION */
2582
2583 #endif /* ALLOW_ATM_TEMP */
2584
2585 #ifdef SEAICE_DEBUG
2586 CALL PLOT_FIELD_XYRL( QSW,'Current QSW ', myIter, myThid )
2587 CALL PLOT_FIELD_XYRL( QNET,'Current QNET ', myIter, myThid )
2588 CALL PLOT_FIELD_XYRL( EmPmR,'Current EmPmR ', myIter, myThid )
2589 #endif /* SEAICE_DEBUG */
2590
2591 C Sea Ice Load on the sea surface.
2592 C =================================
2593
2594 #ifdef ALLOW_AUTODIFF_TAMC
2595 CADJ STORE heff(:,:,bi,bj) = comlev1_bibj,key=iicekey,byte=isbyte
2596 CADJ STORE hsnow(:,:,bi,bj) = comlev1_bibj,key=iicekey,byte=isbyte
2597 #endif /* ALLOW_AUTODIFF_TAMC */
2598
2599 IF ( useRealFreshWaterFlux ) THEN
2600 DO J=1,sNy
2601 DO I=1,sNx
2602 #ifdef SEAICE_CAP_ICELOAD
2603 tmpscal1 = HEFF(I,J,bi,bj)*SEAICE_rhoIce
2604 & + HSNOW(I,J,bi,bj)*SEAICE_rhoSnow
2605 tmpscal2 = MIN(tmpscal1,heffTooHeavy*rhoConst)
2606 #else
2607 tmpscal2 = HEFF(I,J,bi,bj)*SEAICE_rhoIce
2608 & + HSNOW(I,J,bi,bj)*SEAICE_rhoSnow
2609 #endif
2610 sIceLoad(i,j,bi,bj) = tmpscal2
2611 ENDDO
2612 ENDDO
2613 ENDIF
2614
2615 #ifdef ALLOW_BALANCE_FLUXES
2616 C Compute tile integrals of heat/fresh water fluxes to/from atm.
2617 C ==============================================================
2618 FWFsiTile(bi,bj) = 0. _d 0
2619 IF ( balanceEmPmR ) THEN
2620 DO j=1,sNy
2621 DO i=1,sNx
2622 FWFsiTile(bi,bj) =
2623 & FWFsiTile(bi,bj) + SIatmFW(i,j,bi,bj)
2624 & * rA(i,j,bi,bj) * maskInC(i,j,bi,bj)
2625 ENDDO
2626 ENDDO
2627 ENDIF
2628 c to translate global mean FWF adjustements (see below) we may need :
2629 FWF2HFsiTile(bi,bj) = 0. _d 0
2630 IF ( balanceEmPmR.AND.(temp_EvPrRn.EQ.UNSET_RL) ) THEN
2631 DO j=1,sNy
2632 DO i=1,sNx
2633 FWF2HFsiTile(bi,bj) = FWF2HFsiTile(bi,bj) +
2634 & HeatCapacity_Cp * theta(I,J,kSurface,bi,bj)
2635 & * rA(i,j,bi,bj) * maskInC(i,j,bi,bj)
2636 ENDDO
2637 ENDDO
2638 ENDIF
2639 HFsiTile(bi,bj) = 0. _d 0
2640 IF ( balanceQnet ) THEN
2641 DO j=1,sNy
2642 DO i=1,sNx
2643 HFsiTile(bi,bj) =
2644 & HFsiTile(bi,bj) + SItflux(i,j,bi,bj)
2645 & * rA(i,j,bi,bj) * maskInC(i,j,bi,bj)
2646 ENDDO
2647 ENDDO
2648 ENDIF
2649 #endif
2650
2651 C ===================================================================
2652 C ======================PART 8: diagnostics==========================
2653 C ===================================================================
2654
2655 #ifdef ALLOW_DIAGNOSTICS
2656 IF ( useDiagnostics ) THEN
2657 tmpscal1=1. _d 0 * recip_deltaTtherm
2658 CALL DIAGNOSTICS_SCALE_FILL(a_QbyATM_cover,
2659 & tmpscal1,1,'SIaQbATC',0,1,3,bi,bj,myThid)
2660 CALL DIAGNOSTICS_SCALE_FILL(a_QbyATM_open,
2661 & tmpscal1,1,'SIaQbATO',0,1,3,bi,bj,myThid)
2662 CALL DIAGNOSTICS_SCALE_FILL(a_QbyOCN,
2663 & tmpscal1,1,'SIaQbOCN',0,1,3,bi,bj,myThid)
2664 CALL DIAGNOSTICS_SCALE_FILL(d_HEFFbyOCNonICE,
2665 & tmpscal1,1,'SIdHbOCN',0,1,3,bi,bj,myThid)
2666 CALL DIAGNOSTICS_SCALE_FILL(d_HEFFbyATMonOCN_cover,
2667 & tmpscal1,1,'SIdHbATC',0,1,3,bi,bj,myThid)
2668 CALL DIAGNOSTICS_SCALE_FILL(d_HEFFbyATMonOCN_open,
2669 & tmpscal1,1,'SIdHbATO',0,1,3,bi,bj,myThid)
2670 CALL DIAGNOSTICS_SCALE_FILL(d_HEFFbyFLOODING,
2671 & tmpscal1,1,'SIdHbFLO',0,1,3,bi,bj,myThid)
2672 CALL DIAGNOSTICS_SCALE_FILL(d_HSNWbyOCNonSNW,
2673 & tmpscal1,1,'SIdSbOCN',0,1,3,bi,bj,myThid)
2674 CALL DIAGNOSTICS_SCALE_FILL(d_HSNWbyATMonSNW,
2675 & tmpscal1,1,'SIdSbATC',0,1,3,bi,bj,myThid)
2676 CALL DIAGNOSTICS_SCALE_FILL(d_AREAbyATM,
2677 & tmpscal1,1,'SIdAbATO',0,1,3,bi,bj,myThid)
2678 CALL DIAGNOSTICS_SCALE_FILL(d_AREAbyICE,
2679 & tmpscal1,1,'SIdAbATC',0,1,3,bi,bj,myThid)
2680 CALL DIAGNOSTICS_SCALE_FILL(d_AREAbyOCN,
2681 & tmpscal1,1,'SIdAbOCN',0,1,3,bi,bj,myThid)
2682 CALL DIAGNOSTICS_SCALE_FILL(r_QbyATM_open,
2683 & convertHI2Q,1, 'SIqneto ',0,1,3,bi,bj,myThid)
2684 CALL DIAGNOSTICS_SCALE_FILL(r_QbyATM_cover,
2685 & convertHI2Q,1, 'SIqneti ',0,1,3,bi,bj,myThid)
2686 C three that actually need intermediate storage
2687 DO J=1,sNy
2688 DO I=1,sNx
2689 DIAGarrayA(I,J) = maskC(I,J,kSurface,bi,bj)
2690 & * d_HSNWbyRAIN(I,J)*SEAICE_rhoSnow*recip_deltaTtherm
2691 DIAGarrayB(I,J) = AREA(I,J,bi,bj)-AREApreTH(I,J)
2692 ENDDO
2693 ENDDO
2694 CALL DIAGNOSTICS_FILL(DIAGarrayA,
2695 & 'SIsnPrcp',0,1,3,bi,bj,myThid)
2696 CALL DIAGNOSTICS_SCALE_FILL(DIAGarrayB,
2697 & tmpscal1,1,'SIdA ',0,1,3,bi,bj,myThid)
2698 #ifdef ALLOW_ATM_TEMP
2699 DO J=1,sNy
2700 DO I=1,sNx
2701 DIAGarrayB(I,J) = maskC(I,J,kSurface,bi,bj) *
2702 & a_FWbySublim(I,J) * SEAICE_rhoIce * recip_deltaTtherm
2703 ENDDO
2704 ENDDO
2705 CALL DIAGNOSTICS_FILL(DIAGarrayB,
2706 & 'SIfwSubl',0,1,3,bi,bj,myThid)
2707 C
2708 DO J=1,sNy
2709 DO I=1,sNx
2710 C the actual Freshwater flux of sublimated ice, >0 decreases ice
2711 DIAGarrayA(I,J) = maskC(I,J,kSurface,bi,bj)
2712 & * (a_FWbySublim(I,J)-r_FWbySublim(I,J))
2713 & * SEAICE_rhoIce * recip_deltaTtherm
2714 C the residual Freshwater flux of sublimated ice
2715 DIAGarrayC(I,J) = maskC(I,J,kSurface,bi,bj)
2716 & * r_FWbySublim(I,J)
2717 & * SEAICE_rhoIce * recip_deltaTtherm
2718 C the latent heat flux
2719 tmpscal1= EVAP(I,J,bi,bj)*( ONE - AREApreTH(I,J) )
2720 & + r_FWbySublim(I,J)*convertHI2PRECIP
2721 tmpscal2= ( a_FWbySublim(I,J)-r_FWbySublim(I,J) )
2722 & * convertHI2PRECIP
2723 tmpscal3= SEAICE_lhEvap+SEAICE_lhFusion
2724 DIAGarrayB(I,J) = -maskC(I,J,kSurface,bi,bj)*rhoConstFresh
2725 & * ( tmpscal1*SEAICE_lhEvap + tmpscal2*tmpscal3 )
2726 ENDDO
2727 ENDDO
2728 CALL DIAGNOSTICS_FILL(DIAGarrayA,'SIacSubl',0,1,3,bi,bj,myThid)
2729 CALL DIAGNOSTICS_FILL(DIAGarrayC,'SIrsSubl',0,1,3,bi,bj,myThid)
2730 CALL DIAGNOSTICS_FILL(DIAGarrayB,'SIhl ',0,1,3,bi,bj,myThid)
2731 #endif /* ALLOW_ATM_TEMP */
2732
2733 ENDIF
2734 #endif /* ALLOW_DIAGNOSTICS */
2735
2736 C close bi,bj loops
2737 ENDDO
2738 ENDDO
2739
2740
2741 C ===================================================================
2742 C =========PART 9: HF/FWF global integrals and balancing=============
2743 C ===================================================================
2744
2745 #ifdef ALLOW_BALANCE_FLUXES
2746
2747 c 1) global sums
2748 # ifdef ALLOW_AUTODIFF_TAMC
2749 CADJ STORE FWFsiTile = comlev1, key=ikey_dynamics, kind=isbyte
2750 CADJ STORE HFsiTile = comlev1, key=ikey_dynamics, kind=isbyte
2751 CADJ STORE FWF2HFsiTile = comlev1, key=ikey_dynamics, kind=isbyte
2752 # endif /* ALLOW_AUTODIFF_TAMC */
2753 FWFsiGlob=0. _d 0
2754 IF ( balanceEmPmR )
2755 & CALL GLOBAL_SUM_TILE_RL( FWFsiTile, FWFsiGlob, myThid )
2756 FWF2HFsiGlob=0. _d 0
2757 IF ( balanceEmPmR.AND.(temp_EvPrRn.EQ.UNSET_RL) ) THEN
2758 CALL GLOBAL_SUM_TILE_RL(FWF2HFsiTile, FWF2HFsiGlob, myThid)
2759 ELSEIF ( balanceEmPmR ) THEN
2760 FWF2HFsiGlob=HeatCapacity_Cp * temp_EvPrRn * globalArea
2761 ENDIF
2762 HFsiGlob=0. _d 0
2763 IF ( balanceQnet )
2764 & CALL GLOBAL_SUM_TILE_RL( HFsiTile, HFsiGlob, myThid )
2765
2766 c 2) global means
2767 c mean SIatmFW
2768 tmpscal0=FWFsiGlob / globalArea
2769 c corresponding mean advection by atm to ocean+ice water exchange
2770 c (if mean SIatmFW was removed uniformely from ocean)
2771 tmpscal1=FWFsiGlob / globalArea * FWF2HFsiGlob / globalArea
2772 c mean SItflux (before potential adjustement due to SIatmFW)
2773 tmpscal2=HFsiGlob / globalArea
2774 c mean SItflux (after potential adjustement due to SIatmFW)
2775 IF ( balanceEmPmR ) tmpscal2=tmpscal2-tmpscal1
2776
2777 c 3) balancing adjustments
2778 IF ( balanceEmPmR ) THEN
2779 DO bj=myByLo(myThid),myByHi(myThid)
2780 DO bi=myBxLo(myThid),myBxHi(myThid)
2781 DO j=1-OLy,sNy+OLy
2782 DO i=1-OLx,sNx+OLx
2783 empmr(i,j,bi,bj) = empmr(i,j,bi,bj) - tmpscal0
2784 SIatmFW(i,j,bi,bj) = SIatmFW(i,j,bi,bj) - tmpscal0
2785 c adjust SItflux consistently
2786 IF ( (temp_EvPrRn.NE.UNSET_RL).AND.
2787 & useRealFreshWaterFlux.AND.(nonlinFreeSurf.NE.0) ) THEN
2788 tmpscal1=
2789 & ( ZERO + HeatCapacity_Cp * temp_EvPrRn )
2790 ELSEIF ( (temp_EvPrRn.EQ.UNSET_RL).AND.
2791 & useRealFreshWaterFlux.AND.(nonlinFreeSurf.NE.0) ) THEN
2792 tmpscal1=
2793 & ( ZERO + HeatCapacity_Cp * theta(I,J,kSurface,bi,bj) )
2794 ELSEIF ( (temp_EvPrRn.NE.UNSET_RL) ) THEN
2795 tmpscal1=
2796 & HeatCapacity_Cp*(temp_EvPrRn - theta(I,J,kSurface,bi,bj))
2797 ELSE
2798 tmpscal1=ZERO
2799 ENDIF
2800 SItflux(i,j,bi,bj) = SItflux(i,j,bi,bj) - tmpscal0*tmpscal1
2801 c no qnet or tflux adjustement is needed
2802 ENDDO
2803 ENDDO
2804 ENDDO
2805 ENDDO
2806 IF ( balancePrintMean ) THEN
2807 _BEGIN_MASTER( myThid )
2808 WRITE(msgbuf,'(a,a,e24.17)') 'rm Global mean of ',
2809 & 'SIatmFW = ', tmpscal0
2810 CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
2811 & SQUEEZE_RIGHT , myThid)
2812 _END_MASTER( myThid )
2813 ENDIF
2814 ENDIF
2815 IF ( balanceQnet ) THEN
2816 DO bj=myByLo(myThid),myByHi(myThid)
2817 DO bi=myBxLo(myThid),myBxHi(myThid)
2818 DO j=1-OLy,sNy+OLy
2819 DO i=1-OLx,sNx+OLx
2820 SItflux(i,j,bi,bj) = SItflux(i,j,bi,bj) - tmpscal2
2821 qnet(i,j,bi,bj) = qnet(i,j,bi,bj) - tmpscal2
2822 SIatmQnt(i,j,bi,bj) = SIatmQnt(i,j,bi,bj) - tmpscal2
2823 ENDDO
2824 ENDDO
2825 ENDDO
2826 ENDDO
2827 IF ( balancePrintMean ) THEN
2828 _BEGIN_MASTER( myThid )
2829 WRITE(msgbuf,'(a,a,e24.17)') 'rm Global mean of ',
2830 & 'SItflux = ', tmpscal2
2831 CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
2832 & SQUEEZE_RIGHT , myThid)
2833 _END_MASTER( myThid )
2834 ENDIF
2835 ENDIF
2836 #endif /* */
2837
2838 #ifdef ALLOW_DIAGNOSTICS
2839 c these diags need to be done outside of the bi,bj loop so that
2840 c we may do potential global mean adjustement to them consistently.
2841 CALL DIAGNOSTICS_FILL(SItflux,
2842 & 'SItflux ',0,1,0,1,1,myThid)
2843 CALL DIAGNOSTICS_FILL(SIatmQnt,
2844 & 'SIatmQnt',0,1,0,1,1,myThid)
2845 c SIatmFW follows the same convention as empmr -- SIatmFW diag does not
2846 tmpscal1= - 1. _d 0
2847 CALL DIAGNOSTICS_SCALE_FILL(SIatmFW,
2848 & tmpscal1,1,'SIatmFW ',0,1,0,1,1,myThid)
2849 #endif /* ALLOW_DIAGNOSTICS */
2850
2851 RETURN
2852 END

  ViewVC Help
Powered by ViewVC 1.1.22