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

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

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


Revision 1.17 - (hide annotations) (download)
Wed Apr 10 00:35:33 2013 UTC (12 years, 3 months ago) by torge
Branch: MAIN
Changes since 1.16: +74 -4 lines
1) removing unused variable leadIceThickMin
2) introducing floe size dependent lateral melt for ITD case
   following suggestions in Steele (1992) for lateral melt
   and Luepkes et al. (2012) for floe size parameterization

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

  ViewVC Help
Powered by ViewVC 1.1.22