/[MITgcm]/MITgcm_contrib/torge/itd/code/seaice_growth.F
ViewVC logotype

Contents of /MITgcm_contrib/torge/itd/code/seaice_growth.F

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


Revision 1.19 - (show annotations) (download)
Fri May 3 18:59:40 2013 UTC (12 years, 3 months ago) by torge
Branch: MAIN
Changes since 1.18: +28 -33 lines
removing all "ToM" comments

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

  ViewVC Help
Powered by ViewVC 1.1.22