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

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

  ViewVC Help
Powered by ViewVC 1.1.22