/[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.16 - (show annotations) (download)
Wed Mar 27 18:59:52 2013 UTC (12 years, 4 months ago) by torge
Branch: MAIN
Changes since 1.15: +3 -178 lines
updating my MITgcm_contrib directory to include latest changes on main branch;
settings are to run a 1D test szenario with ITD code and 7 categories

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

  ViewVC Help
Powered by ViewVC 1.1.22