/[MITgcm]/MITgcm/pkg/seaice/seaice_growth.F
ViewVC logotype

Contents of /MITgcm/pkg/seaice/seaice_growth.F

Parent Directory Parent Directory | Revision Log Revision Log | View Revision Graph Revision Graph


Revision 1.210 - (show annotations) (download)
Thu Nov 26 15:54:27 2015 UTC (8 years, 6 months ago) by mlosch
Branch: MAIN
CVS Tags: checkpoint66a, checkpoint65z, checkpoint65x, checkpoint65y, checkpoint65r, checkpoint65s, checkpoint65v, checkpoint65w, checkpoint65t, checkpoint65u
Changes since 1.209: +14 -5 lines
  - catch potential division by zero in ITD code, does not change
    verification results

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

  ViewVC Help
Powered by ViewVC 1.1.22