/[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.11 - (hide annotations) (download)
Mon Oct 22 22:18:09 2012 UTC (12 years, 9 months ago) by torge
Branch: MAIN
Changes since 1.10: +2 -0 lines
removing bugs

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 torge 1.11 #ifdef ALLOW_SITRACER
754 torge 1.3 C prepare SItrHEFF to be computed as cumulative sum
755 torge 1.5 DO iTr=2,5
756 torge 1.3 DO J=1,sNy
757     DO I=1,sNx
758 torge 1.5 SItrHEFF(I,J,bi,bj,iTr)=ZERO
759 dimitri 1.2 ENDDO
760     ENDDO
761     ENDDO
762 torge 1.3 C prepare SItrAREA to be computed as cumulative sum
763     DO J=1,sNy
764     DO I=1,sNx
765     SItrAREA(I,J,bi,bj,3)=ZERO
766     ENDDO
767     ENDDO
768 dimitri 1.2 #endif
769 torge 1.11 #endif /* SEAICE_ITD */
770 dimitri 1.1
771     C 4) treat sea ice salinity pathological cases
772     #ifdef SEAICE_VARIABLE_SALINITY
773     #ifdef ALLOW_AUTODIFF_TAMC
774     CADJ STORE hsalt(:,:,bi,bj) = comlev1_bibj, key = iicekey,byte=isbyte
775     CADJ STORE heff(:,:,bi,bj) = comlev1_bibj, key = iicekey,byte=isbyte
776     #endif /* ALLOW_AUTODIFF_TAMC */
777     DO J=1,sNy
778     DO I=1,sNx
779     IF ( (HSALT(I,J,bi,bj) .LT. 0.0).OR.
780     & (HEFF(I,J,bi,bj) .EQ. 0.0) ) THEN
781     saltFluxAdjust(I,J) = - HEFFM(I,J,bi,bj) *
782     & HSALT(I,J,bi,bj) * recip_deltaTtherm
783     HSALT(I,J,bi,bj) = 0.0 _d 0
784     ENDIF
785     ENDDO
786     ENDDO
787     #endif /* SEAICE_VARIABLE_SALINITY */
788    
789     #endif /* SEAICE_GROWTH_LEGACY */
790    
791     #ifdef ALLOW_DIAGNOSTICS
792     IF ( useDiagnostics ) THEN
793     CALL DIAGNOSTICS_FILL(DIAGarrayA,'SIareaPR',0,1,3,bi,bj,myThid)
794     CALL DIAGNOSTICS_FILL(DIAGarrayB,'SIareaPT',0,1,3,bi,bj,myThid)
795     CALL DIAGNOSTICS_FILL(DIAGarrayC,'SIheffPT',0,1,3,bi,bj,myThid)
796     CALL DIAGNOSTICS_FILL(DIAGarrayD,'SIhsnoPT',0,1,3,bi,bj,myThid)
797     #ifdef ALLOW_SITRACER
798     DO iTr = 1, SItrNumInUse
799     WRITE(diagName,'(A4,I2.2,A2)') 'SItr',iTr,'PT'
800     IF (SItrMate(iTr).EQ.'HEFF') THEN
801     CALL DIAGNOSTICS_FRACT_FILL(
802     I SItracer(1-OLx,1-OLy,bi,bj,iTr),HEFF(1-OLx,1-OLy,bi,bj),
803     I ONE, 1, diagName,0,1,2,bi,bj,myThid )
804     ELSE
805     CALL DIAGNOSTICS_FRACT_FILL(
806     I SItracer(1-OLx,1-OLy,bi,bj,iTr),AREA(1-OLx,1-OLy,bi,bj),
807     I ONE, 1, diagName,0,1,2,bi,bj,myThid )
808     ENDIF
809     ENDDO
810     #endif /* ALLOW_SITRACER */
811     ENDIF
812     #endif /* ALLOW_DIAGNOSTICS */
813    
814     #if (defined ALLOW_AUTODIFF_TAMC && defined SEAICE_MODIFY_GROWTH_ADJ)
815     Cgf no additional dependency of air-sea fluxes to ice
816     IF ( SEAICEadjMODE.GE.1 ) THEN
817     DO J=1,sNy
818     DO I=1,sNx
819     HEFFpreTH(I,J) = 0. _d 0
820     HSNWpreTH(I,J) = 0. _d 0
821     AREApreTH(I,J) = 0. _d 0
822     ENDDO
823     ENDDO
824 dimitri 1.2 #ifdef SEAICE_ITD
825 torge 1.5 DO IT=1,nITD
826 dimitri 1.2 DO J=1,sNy
827     DO I=1,sNx
828 torge 1.5 HEFFITDpreTH(I,J,IT) = 0. _d 0
829     HSNWITDpreTH(I,J,IT) = 0. _d 0
830     AREAITDpreTH(I,J,IT) = 0. _d 0
831 dimitri 1.2 ENDDO
832     ENDDO
833     ENDDO
834     #endif
835 dimitri 1.1 ENDIF
836     #endif
837    
838     #if (defined (ALLOW_MEAN_SFLUX_COST_CONTRIBUTION) || defined (ALLOW_SSH_GLOBMEAN_COST_CONTRIBUTION))
839     DO J=1,sNy
840     DO I=1,sNx
841     AREAforAtmFW(I,J,bi,bj) = AREApreTH(I,J)
842     ENDDO
843     ENDDO
844     #endif
845    
846     C 4) COMPUTE ACTUAL ICE/SNOW THICKNESS; USE MIN/MAX VALUES
847     C TO REGULARIZE SEAICE_SOLVE4TEMP/d_AREA COMPUTATIONS
848    
849     #ifdef ALLOW_AUTODIFF_TAMC
850     CADJ STORE AREApreTH = comlev1_bibj, key = iicekey, byte = isbyte
851     CADJ STORE HEFFpreTH = comlev1_bibj, key = iicekey, byte = isbyte
852     CADJ STORE HSNWpreTH = comlev1_bibj, key = iicekey, byte = isbyte
853     #endif /* ALLOW_AUTODIFF_TAMC */
854 dimitri 1.2 #ifdef SEAICE_ITD
855 torge 1.5 DO IT=1,nITD
856 dimitri 1.2 #endif
857 dimitri 1.1 DO J=1,sNy
858     DO I=1,sNx
859    
860 dimitri 1.2 #ifdef SEAICE_ITD
861 torge 1.5 IF (HEFFITDpreTH(I,J,IT) .GT. ZERO) THEN
862 dimitri 1.2 #ifdef SEAICE_GROWTH_LEGACY
863 torge 1.3 tmpscal1 = MAX(SEAICE_area_reg/float(nITD),
864 torge 1.5 & AREAITDpreTH(I,J,IT))
865     hsnowActualMult(I,J,IT) = HSNWITDpreTH(I,J,IT)/tmpscal1
866     tmpscal2 = HEFFITDpreTH(I,J,IT)/tmpscal1
867     heffActualMult(I,J,IT) = MAX(tmpscal2,SEAICE_hice_reg)
868 dimitri 1.2 #else /* SEAICE_GROWTH_LEGACY */
869     cif regularize AREA with SEAICE_area_reg
870 torge 1.5 tmpscal1 = SQRT(AREAITDpreTH(I,J,IT) * AREAITDpreTH(I,J,IT)
871 dimitri 1.2 & + area_reg_sq)
872     cif heffActual calculated with the regularized AREA
873 torge 1.5 tmpscal2 = HEFFITDpreTH(I,J,IT) / tmpscal1
874 dimitri 1.2 cif regularize heffActual with SEAICE_hice_reg (add lower bound)
875 torge 1.5 heffActualMult(I,J,IT) = SQRT(tmpscal2 * tmpscal2
876 dimitri 1.2 & + hice_reg_sq)
877     cif hsnowActual calculated with the regularized AREA
878 torge 1.5 hsnowActualMult(I,J,IT) = HSNWITDpreTH(I,J,IT) / tmpscal1
879 dimitri 1.2 #endif /* SEAICE_GROWTH_LEGACY */
880     cif regularize the inverse of heffActual by hice_reg
881 torge 1.5 recip_heffActualMult(I,J,IT) = AREAITDpreTH(I,J,IT) /
882     & sqrt(HEFFITDpreTH(I,J,IT) * HEFFITDpreTH(I,J,IT)
883 dimitri 1.2 & + hice_reg_sq)
884     cif Do not regularize when HEFFpreTH = 0
885     ELSE
886 torge 1.5 heffActualMult(I,J,IT) = ZERO
887     hsnowActualMult(I,J,IT) = ZERO
888     recip_heffActualMult(I,J,IT) = ZERO
889 dimitri 1.2 ENDIF
890 torge 1.3 #else /* SEAICE_ITD */
891 dimitri 1.1 IF (HEFFpreTH(I,J) .GT. ZERO) THEN
892     #ifdef SEAICE_GROWTH_LEGACY
893     tmpscal1 = MAX(SEAICE_area_reg,AREApreTH(I,J))
894     hsnowActual(I,J) = HSNWpreTH(I,J)/tmpscal1
895     tmpscal2 = HEFFpreTH(I,J)/tmpscal1
896     heffActual(I,J) = MAX(tmpscal2,SEAICE_hice_reg)
897     #else /* SEAICE_GROWTH_LEGACY */
898 torge 1.10 Cif regularize AREA with SEAICE_area_reg
899 dimitri 1.1 tmpscal1 = SQRT(AREApreTH(I,J)* AREApreTH(I,J) + area_reg_sq)
900 torge 1.10 Cif heffActual calculated with the regularized AREA
901 dimitri 1.1 tmpscal2 = HEFFpreTH(I,J) / tmpscal1
902 torge 1.10 Cif regularize heffActual with SEAICE_hice_reg (add lower bound)
903 dimitri 1.1 heffActual(I,J) = SQRT(tmpscal2 * tmpscal2 + hice_reg_sq)
904 torge 1.10 Cif hsnowActual calculated with the regularized AREA
905 dimitri 1.1 hsnowActual(I,J) = HSNWpreTH(I,J) / tmpscal1
906     #endif /* SEAICE_GROWTH_LEGACY */
907 torge 1.10 Cif regularize the inverse of heffActual by hice_reg
908 dimitri 1.1 recip_heffActual(I,J) = AREApreTH(I,J) /
909     & sqrt(HEFFpreTH(I,J)*HEFFpreTH(I,J) + hice_reg_sq)
910 torge 1.10 Cif Do not regularize when HEFFpreTH = 0
911 dimitri 1.1 ELSE
912     heffActual(I,J) = ZERO
913     hsnowActual(I,J) = ZERO
914     recip_heffActual(I,J) = ZERO
915     ENDIF
916 torge 1.3 #endif /* SEAICE_ITD */
917 dimitri 1.1
918     ENDDO
919     ENDDO
920 dimitri 1.2 #ifdef SEAICE_ITD
921     ENDDO
922     #endif
923 dimitri 1.1
924     #if (defined ALLOW_AUTODIFF_TAMC && defined SEAICE_MODIFY_GROWTH_ADJ)
925     CALL ZERO_ADJ_1D( sNx*sNy, heffActual, myThid)
926     CALL ZERO_ADJ_1D( sNx*sNy, hsnowActual, myThid)
927     CALL ZERO_ADJ_1D( sNx*sNy, recip_heffActual, myThid)
928     #endif
929    
930     #ifdef SEAICE_CAP_SUBLIM
931     C 5) COMPUTE MAXIMUM LATENT HEAT FLUXES FOR THE CURRENT ICE
932     C AND SNOW THICKNESS
933 dimitri 1.2 #ifdef SEAICE_ITD
934 torge 1.5 DO IT=1,nITD
935 dimitri 1.2 #endif
936 dimitri 1.1 DO J=1,sNy
937     DO I=1,sNx
938 torge 1.10 C The latent heat flux over the sea ice which
939     C will sublimate all of the snow and ice over one time
940     C step (W/m^2)
941 dimitri 1.2 #ifdef SEAICE_ITD
942 torge 1.5 IF (HEFFITDpreTH(I,J,IT) .GT. ZERO) THEN
943     latentHeatFluxMaxMult(I,J,IT) = lhSublim*recip_deltaTtherm *
944     & (HEFFITDpreTH(I,J,IT)*SEAICE_rhoIce +
945     & HSNWITDpreTH(I,J,IT)*SEAICE_rhoSnow)
946     & /AREAITDpreTH(I,J,IT)
947 dimitri 1.2 ELSE
948 torge 1.5 latentHeatFluxMaxMult(I,J,IT) = ZERO
949 dimitri 1.2 ENDIF
950     #else
951 dimitri 1.1 IF (HEFFpreTH(I,J) .GT. ZERO) THEN
952     latentHeatFluxMax(I,J) = lhSublim * recip_deltaTtherm *
953     & (HEFFpreTH(I,J) * SEAICE_rhoIce +
954     & HSNWpreTH(I,J) * SEAICE_rhoSnow)/AREApreTH(I,J)
955     ELSE
956     latentHeatFluxMax(I,J) = ZERO
957     ENDIF
958 dimitri 1.2 #endif
959 dimitri 1.1 ENDDO
960     ENDDO
961 dimitri 1.2 #ifdef SEAICE_ITD
962     ENDDO
963     #endif
964 dimitri 1.1 #endif /* SEAICE_CAP_SUBLIM */
965    
966     C ===================================================================
967     C ================PART 2: determine heat fluxes/stocks===============
968     C ===================================================================
969    
970     C determine available heat due to the atmosphere -- for open water
971     C ================================================================
972    
973     DO j=1,sNy
974     DO i=1,sNx
975     C ocean surface/mixed layer temperature
976     TmixLoc(i,j) = theta(i,j,kSurface,bi,bj)+celsius2K
977     C wind speed from exf
978     UG(I,J) = MAX(SEAICE_EPS,wspeed(I,J,bi,bj))
979     ENDDO
980     ENDDO
981    
982     #ifdef ALLOW_AUTODIFF_TAMC
983     CADJ STORE qnet(:,:,bi,bj) = comlev1_bibj, key = iicekey,byte=isbyte
984     CADJ STORE qsw(:,:,bi,bj) = comlev1_bibj, key = iicekey,byte=isbyte
985     cCADJ STORE UG = comlev1_bibj, key = iicekey,byte=isbyte
986     cCADJ STORE TmixLoc = comlev1_bibj, key = iicekey,byte=isbyte
987     #endif /* ALLOW_AUTODIFF_TAMC */
988    
989     CALL SEAICE_BUDGET_OCEAN(
990     I UG,
991     I TmixLoc,
992     O a_QbyATM_open, a_QSWbyATM_open,
993     I bi, bj, myTime, myIter, myThid )
994    
995     C determine available heat due to the atmosphere -- for ice covered water
996     C =======================================================================
997    
998 torge 1.10 IF (useRelativeWind.AND.useAtmWind) THEN
999 dimitri 1.1 C Compute relative wind speed over sea ice.
1000     DO J=1,sNy
1001     DO I=1,sNx
1002     SPEED_SQ =
1003     & (uWind(I,J,bi,bj)
1004     & +0.5 _d 0*(uVel(i,j,kSurface,bi,bj)
1005     & +uVel(i+1,j,kSurface,bi,bj))
1006     & -0.5 _d 0*(uice(i,j,bi,bj)+uice(i+1,j,bi,bj)))**2
1007     & +(vWind(I,J,bi,bj)
1008     & +0.5 _d 0*(vVel(i,j,kSurface,bi,bj)
1009     & +vVel(i,j+1,kSurface,bi,bj))
1010     & -0.5 _d 0*(vice(i,j,bi,bj)+vice(i,j+1,bi,bj)))**2
1011     IF ( SPEED_SQ .LE. SEAICE_EPS_SQ ) THEN
1012     UG(I,J)=SEAICE_EPS
1013     ELSE
1014     UG(I,J)=SQRT(SPEED_SQ)
1015     ENDIF
1016     ENDDO
1017     ENDDO
1018     ENDIF
1019    
1020     #ifdef ALLOW_AUTODIFF_TAMC
1021     CADJ STORE tice(:,:,bi,bj)
1022     CADJ & = comlev1_bibj, key = iicekey, byte = isbyte
1023     CADJ STORE hsnowActual = comlev1_bibj, key = iicekey, byte = isbyte
1024     CADJ STORE heffActual = comlev1_bibj, key = iicekey, byte = isbyte
1025     CADJ STORE UG = comlev1_bibj, key = iicekey, byte = isbyte
1026     CADJ STORE tices(:,:,:,bi,bj)
1027     CADJ & = comlev1_bibj, key = iicekey, byte = isbyte
1028     CADJ STORE salt(:,:,kSurface,bi,bj) = comlev1_bibj,
1029     CADJ & key = iicekey, byte = isbyte
1030     #endif /* ALLOW_AUTODIFF_TAMC */
1031    
1032     C-- Start loop over multi-categories
1033 torge 1.3 #ifdef SEAICE_ITD
1034     CToM SEAICE_multDim = nITD (see SEAICE_SIZE.h and seaice_readparms.F)
1035     #endif
1036 dimitri 1.1 DO IT=1,SEAICE_multDim
1037 torge 1.10 C homogeneous distribution between 0 and 2 x heffActual
1038 dimitri 1.2 #ifndef SEAICE_ITD
1039 torge 1.10 pFac = (2.0 _d 0*IT - 1.0 _d 0)*recip_multDim
1040     pFacSnow = 1. _d 0
1041     IF ( SEAICE_useMultDimSnow ) pFacSnow=pFac
1042 dimitri 1.2 #endif
1043 dimitri 1.1 DO J=1,sNy
1044     DO I=1,sNx
1045 dimitri 1.2 #ifndef SEAICE_ITD
1046     CToM for SEAICE_ITD heffActualMult and latentHeatFluxMaxMult are calculated above
1047     C (instead of heffActual and latentHeatFluxMax)
1048 dimitri 1.1 heffActualMult(I,J,IT)= heffActual(I,J)*pFac
1049 torge 1.10 hsnowActualMult(I,J,IT)=hsnowActual(I,J)*pFacSnow
1050 dimitri 1.1 #ifdef SEAICE_CAP_SUBLIM
1051     latentHeatFluxMaxMult(I,J,IT) = latentHeatFluxMax(I,J)*pFac
1052     #endif
1053 dimitri 1.2 #endif
1054 dimitri 1.1 ticeInMult(I,J,IT)=TICES(I,J,IT,bi,bj)
1055     ticeOutMult(I,J,IT)=TICES(I,J,IT,bi,bj)
1056     TICE(I,J,bi,bj) = ZERO
1057     TICES(I,J,IT,bi,bj) = ZERO
1058     ENDDO
1059     ENDDO
1060     ENDDO
1061    
1062     #ifdef ALLOW_AUTODIFF_TAMC
1063     CADJ STORE heffActualMult = comlev1_bibj, key = iicekey, byte = isbyte
1064 torge 1.10 CADJ STORE hsnowActualMult= comlev1_bibj, key = iicekey, byte = isbyte
1065 dimitri 1.1 CADJ STORE ticeInMult = comlev1_bibj, key = iicekey, byte = isbyte
1066     # ifdef SEAICE_CAP_SUBLIM
1067     CADJ STORE latentHeatFluxMaxMult
1068     CADJ & = comlev1_bibj, key = iicekey, byte = isbyte
1069     # endif
1070     CADJ STORE a_QbyATMmult_cover =
1071     CADJ & comlev1_bibj, key = iicekey, byte = isbyte
1072     CADJ STORE a_QSWbyATMmult_cover =
1073     CADJ & comlev1_bibj, key = iicekey, byte = isbyte
1074     CADJ STORE a_FWbySublimMult =
1075     CADJ & comlev1_bibj, key = iicekey, byte = isbyte
1076     #endif /* ALLOW_AUTODIFF_TAMC */
1077    
1078     DO IT=1,SEAICE_multDim
1079     CALL SEAICE_SOLVE4TEMP(
1080 dimitri 1.2 I UG, heffActualMult(1,1,IT), hsnowActualMult(1,1,IT),
1081 dimitri 1.1 #ifdef SEAICE_CAP_SUBLIM
1082     I latentHeatFluxMaxMult(1,1,IT),
1083     #endif
1084     U ticeInMult(1,1,IT), ticeOutMult(1,1,IT),
1085 torge 1.10 O a_QbyATMmult_cover(1,1,IT),
1086     O a_QSWbyATMmult_cover(1,1,IT),
1087 dimitri 1.1 O a_FWbySublimMult(1,1,IT),
1088     I bi, bj, myTime, myIter, myThid )
1089     ENDDO
1090    
1091     #ifdef ALLOW_AUTODIFF_TAMC
1092     CADJ STORE heffActualMult = comlev1_bibj, key = iicekey, byte = isbyte
1093 torge 1.10 CADJ STORE hsnowActualMult= comlev1_bibj, key = iicekey, byte = isbyte
1094 dimitri 1.1 CADJ STORE ticeOutMult = comlev1_bibj, key = iicekey, byte = isbyte
1095     # ifdef SEAICE_CAP_SUBLIM
1096     CADJ STORE latentHeatFluxMaxMult
1097     CADJ & = comlev1_bibj, key = iicekey, byte = isbyte
1098     # endif
1099     CADJ STORE a_QbyATMmult_cover =
1100     CADJ & comlev1_bibj, key = iicekey, byte = isbyte
1101     CADJ STORE a_QSWbyATMmult_cover =
1102     CADJ & comlev1_bibj, key = iicekey, byte = isbyte
1103     CADJ STORE a_FWbySublimMult =
1104     CADJ & comlev1_bibj, key = iicekey, byte = isbyte
1105     #endif /* ALLOW_AUTODIFF_TAMC */
1106    
1107     DO IT=1,SEAICE_multDim
1108     DO J=1,sNy
1109     DO I=1,sNx
1110     C update TICE & TICES
1111 dimitri 1.2 #ifdef SEAICE_ITD
1112     C calculate area weighted mean
1113 torge 1.3 C (although the ice's temperature relates to its energy content
1114 torge 1.7 C and hence should be averaged weighted by ice volume,
1115 torge 1.3 C the temperature here is a result of the fluxes through the ice surface
1116     C computed individually for each single category in SEAICE_SOLVE4TEMP
1117     C and hence is averaged area weighted [areaFracFactor])
1118 dimitri 1.2 TICE(I,J,bi,bj) = TICE(I,J,bi,bj)
1119 torge 1.5 & + ticeOutMult(I,J,IT)*areaFracFactor(I,J,IT)
1120 dimitri 1.2 #else
1121 dimitri 1.1 TICE(I,J,bi,bj) = TICE(I,J,bi,bj)
1122     & + ticeOutMult(I,J,IT)*recip_multDim
1123 dimitri 1.2 #endif
1124 dimitri 1.1 TICES(I,J,IT,bi,bj) = ticeOutMult(I,J,IT)
1125     C average over categories
1126 dimitri 1.2 #ifdef SEAICE_ITD
1127     C calculate area weighted mean
1128 torge 1.3 C (fluxes are per unit (ice surface) area and are thus area weighted)
1129 dimitri 1.2 a_QbyATM_cover (I,J) = a_QbyATM_cover(I,J)
1130 torge 1.5 & + a_QbyATMmult_cover(I,J,IT)*areaFracFactor(I,J,IT)
1131 dimitri 1.2 a_QSWbyATM_cover (I,J) = a_QSWbyATM_cover(I,J)
1132 torge 1.5 & + a_QSWbyATMmult_cover(I,J,IT)*areaFracFactor(I,J,IT)
1133 dimitri 1.2 a_FWbySublim (I,J) = a_FWbySublim(I,J)
1134 torge 1.5 & + a_FWbySublimMult(I,J,IT)*areaFracFactor(I,J,IT)
1135 dimitri 1.2 #else
1136 dimitri 1.1 a_QbyATM_cover (I,J) = a_QbyATM_cover(I,J)
1137     & + a_QbyATMmult_cover(I,J,IT)*recip_multDim
1138     a_QSWbyATM_cover (I,J) = a_QSWbyATM_cover(I,J)
1139     & + a_QSWbyATMmult_cover(I,J,IT)*recip_multDim
1140     a_FWbySublim (I,J) = a_FWbySublim(I,J)
1141     & + a_FWbySublimMult(I,J,IT)*recip_multDim
1142 dimitri 1.2 #endif
1143 dimitri 1.1 ENDDO
1144     ENDDO
1145     ENDDO
1146    
1147     #ifdef SEAICE_CAP_SUBLIM
1148     # ifdef ALLOW_DIAGNOSTICS
1149     DO J=1,sNy
1150     DO I=1,sNx
1151 torge 1.10 C The actual latent heat flux realized by SOLVE4TEMP
1152 dimitri 1.1 DIAGarrayA(I,J) = a_FWbySublim(I,J) * lhSublim
1153     ENDDO
1154     ENDDO
1155 torge 1.10 Cif The actual vs. maximum latent heat flux
1156 dimitri 1.1 IF ( useDiagnostics ) THEN
1157     CALL DIAGNOSTICS_FILL(DIAGarrayA,
1158     & 'SIactLHF',0,1,3,bi,bj,myThid)
1159     CALL DIAGNOSTICS_FILL(latentHeatFluxMax,
1160     & 'SImaxLHF',0,1,3,bi,bj,myThid)
1161     ENDIF
1162     # endif /* ALLOW_DIAGNOSTICS */
1163     #endif /* SEAICE_CAP_SUBLIM */
1164    
1165     #ifdef ALLOW_AUTODIFF_TAMC
1166     CADJ STORE AREApreTH = comlev1_bibj, key = iicekey, byte = isbyte
1167     CADJ STORE a_QbyATM_cover = comlev1_bibj, key = iicekey, byte = isbyte
1168     CADJ STORE a_QSWbyATM_cover= comlev1_bibj, key = iicekey, byte = isbyte
1169     CADJ STORE a_QbyATM_open = comlev1_bibj, key = iicekey, byte = isbyte
1170     CADJ STORE a_QSWbyATM_open = comlev1_bibj, key = iicekey, byte = isbyte
1171     CADJ STORE a_FWbySublim = comlev1_bibj, key = iicekey, byte = isbyte
1172     #endif /* ALLOW_AUTODIFF_TAMC */
1173    
1174     C switch heat fluxes from W/m2 to 'effective' ice meters
1175 torge 1.3 #ifdef SEAICE_ITD
1176 torge 1.5 DO IT=1,nITD
1177 torge 1.3 DO J=1,sNy
1178     DO I=1,sNx
1179 torge 1.5 a_QbyATMmult_cover(I,J,IT) = a_QbyATMmult_cover(I,J,IT)
1180     & * convertQ2HI * AREAITDpreTH(I,J,IT)
1181     a_QSWbyATMmult_cover(I,J,IT) = a_QSWbyATMmult_cover(I,J,IT)
1182     & * convertQ2HI * AREAITDpreTH(I,J,IT)
1183 torge 1.8 C and initialize r_QbyATMmult_cover
1184 torge 1.5 r_QbyATMmult_cover(I,J,IT)=a_QbyATMmult_cover(I,J,IT)
1185 torge 1.3 C Convert fresh water flux by sublimation to 'effective' ice meters.
1186     C Negative sublimation is resublimation and will be added as snow.
1187     #ifdef SEAICE_DISABLE_SUBLIM
1188 torge 1.5 a_FWbySublimMult(I,J,IT) = ZERO
1189 torge 1.3 #endif
1190 torge 1.5 a_FWbySublimMult(I,J,IT) = SEAICE_deltaTtherm*recip_rhoIce
1191     & * a_FWbySublimMult(I,J,IT)*AREAITDpreTH(I,J,IT)
1192     r_FWbySublimMult(I,J,IT)=a_FWbySublimMult(I,J,IT)
1193 torge 1.3 ENDDO
1194     ENDDO
1195     ENDDO
1196     DO J=1,sNy
1197     DO I=1,sNx
1198 torge 1.4 a_QbyATM_open(I,J) = a_QbyATM_open(I,J)
1199     & * convertQ2HI * ( ONE - AREApreTH(I,J) )
1200     a_QSWbyATM_open(I,J) = a_QSWbyATM_open(I,J)
1201     & * convertQ2HI * ( ONE - AREApreTH(I,J) )
1202 torge 1.3 C and initialize r_QbyATM_open
1203     r_QbyATM_open(I,J)=a_QbyATM_open(I,J)
1204     ENDDO
1205     ENDDO
1206     #else /* SEAICE_ITD */
1207 dimitri 1.1 DO J=1,sNy
1208     DO I=1,sNx
1209     a_QbyATM_cover(I,J) = a_QbyATM_cover(I,J)
1210     & * convertQ2HI * AREApreTH(I,J)
1211     a_QSWbyATM_cover(I,J) = a_QSWbyATM_cover(I,J)
1212     & * convertQ2HI * AREApreTH(I,J)
1213     a_QbyATM_open(I,J) = a_QbyATM_open(I,J)
1214     & * convertQ2HI * ( ONE - AREApreTH(I,J) )
1215     a_QSWbyATM_open(I,J) = a_QSWbyATM_open(I,J)
1216     & * convertQ2HI * ( ONE - AREApreTH(I,J) )
1217     C and initialize r_QbyATM_cover/r_QbyATM_open
1218     r_QbyATM_cover(I,J)=a_QbyATM_cover(I,J)
1219     r_QbyATM_open(I,J)=a_QbyATM_open(I,J)
1220     C Convert fresh water flux by sublimation to 'effective' ice meters.
1221     C Negative sublimation is resublimation and will be added as snow.
1222     #ifdef SEAICE_DISABLE_SUBLIM
1223 torge 1.10 Cgf just for those who may need to omit this term to reproduce old results
1224 dimitri 1.1 a_FWbySublim(I,J) = ZERO
1225 torge 1.10 #endif /* SEAICE_DISABLE_SUBLIM */
1226 dimitri 1.1 a_FWbySublim(I,J) = SEAICE_deltaTtherm*recip_rhoIce
1227     & * a_FWbySublim(I,J)*AREApreTH(I,J)
1228     r_FWbySublim(I,J)=a_FWbySublim(I,J)
1229     ENDDO
1230     ENDDO
1231 torge 1.3 #endif /* SEAICE_ITD */
1232 dimitri 1.1
1233     #ifdef ALLOW_AUTODIFF_TAMC
1234     CADJ STORE AREApreTH = comlev1_bibj, key = iicekey, byte = isbyte
1235     CADJ STORE a_QbyATM_cover = comlev1_bibj, key = iicekey, byte = isbyte
1236     CADJ STORE a_QSWbyATM_cover= comlev1_bibj, key = iicekey, byte = isbyte
1237     CADJ STORE a_QbyATM_open = comlev1_bibj, key = iicekey, byte = isbyte
1238     CADJ STORE a_QSWbyATM_open = comlev1_bibj, key = iicekey, byte = isbyte
1239     CADJ STORE a_FWbySublim = comlev1_bibj, key = iicekey, byte = isbyte
1240     CADJ STORE r_QbyATM_cover = comlev1_bibj, key = iicekey, byte = isbyte
1241     CADJ STORE r_QbyATM_open = comlev1_bibj, key = iicekey, byte = isbyte
1242     CADJ STORE r_FWbySublim = comlev1_bibj, key = iicekey, byte = isbyte
1243     #endif /* ALLOW_AUTODIFF_TAMC */
1244    
1245     #if (defined ALLOW_AUTODIFF_TAMC && defined SEAICE_MODIFY_GROWTH_ADJ)
1246     Cgf no additional dependency through ice cover
1247     IF ( SEAICEadjMODE.GE.3 ) THEN
1248 dimitri 1.2 #ifdef SEAICE_ITD
1249 torge 1.5 DO IT=1,nITD
1250 dimitri 1.2 DO J=1,sNy
1251     DO I=1,sNx
1252 torge 1.5 a_QbyATMmult_cover(I,J,IT) = 0. _d 0
1253     r_QbyATMmult_cover(I,J,IT) = 0. _d 0
1254     a_QSWbyATMmult_cover(I,J,IT) = 0. _d 0
1255 dimitri 1.2 ENDDO
1256     ENDDO
1257     ENDDO
1258 torge 1.3 #else
1259     DO J=1,sNy
1260     DO I=1,sNx
1261     a_QbyATM_cover(I,J) = 0. _d 0
1262     r_QbyATM_cover(I,J) = 0. _d 0
1263     a_QSWbyATM_cover(I,J) = 0. _d 0
1264     ENDDO
1265     ENDDO
1266 dimitri 1.2 #endif
1267 dimitri 1.1 ENDIF
1268     #endif
1269    
1270     C determine available heat due to the ice pack tying the
1271     C underlying surface water temperature to freezing point
1272     C ======================================================
1273    
1274     #ifdef ALLOW_AUTODIFF_TAMC
1275     CADJ STORE theta(:,:,kSurface,bi,bj) = comlev1_bibj,
1276     CADJ & key = iicekey, byte = isbyte
1277     CADJ STORE salt(:,:,kSurface,bi,bj) = comlev1_bibj,
1278     CADJ & key = iicekey, byte = isbyte
1279     #endif
1280    
1281     DO J=1,sNy
1282     DO I=1,sNx
1283 torge 1.10 C FREEZING TEMP. OF SEA WATER (deg C)
1284 dimitri 1.1 tempFrz = SEAICE_tempFrz0 +
1285     & SEAICE_dTempFrz_dS *salt(I,J,kSurface,bi,bj)
1286 torge 1.10 C efficiency of turbulent fluxes : dependency to sign of THETA-TBC
1287 dimitri 1.1 IF ( theta(I,J,kSurface,bi,bj) .GE. tempFrz ) THEN
1288     tmpscal1 = SEAICE_mcPheePiston
1289     ELSE
1290     tmpscal1 =SEAICE_frazilFrac*drF(kSurface)/SEAICE_deltaTtherm
1291     ENDIF
1292 torge 1.10 C efficiency of turbulent fluxes : dependency to AREA (McPhee cases)
1293 dimitri 1.1 IF ( (AREApreTH(I,J) .GT. 0. _d 0).AND.
1294     & (.NOT.SEAICE_mcPheeStepFunc) ) THEN
1295     MixedLayerTurbulenceFactor = ONE -
1296     & SEAICE_mcPheeTaper * AREApreTH(I,J)
1297     ELSEIF ( (AREApreTH(I,J) .GT. 0. _d 0).AND.
1298     & (SEAICE_mcPheeStepFunc) ) THEN
1299     MixedLayerTurbulenceFactor = ONE - SEAICE_mcPheeTaper
1300     ELSE
1301     MixedLayerTurbulenceFactor = ONE
1302     ENDIF
1303 torge 1.10 C maximum turbulent flux, in ice meters
1304 dimitri 1.1 tmpscal2= - (HeatCapacity_Cp*rhoConst * recip_QI)
1305     & * (theta(I,J,kSurface,bi,bj)-tempFrz)
1306     & * SEAICE_deltaTtherm * maskC(i,j,kSurface,bi,bj)
1307 torge 1.10 C available turbulent flux
1308 dimitri 1.1 a_QbyOCN(i,j) =
1309     & tmpscal1 * tmpscal2 * MixedLayerTurbulenceFactor
1310     r_QbyOCN(i,j) = a_QbyOCN(i,j)
1311     ENDDO
1312     ENDDO
1313    
1314     #if (defined ALLOW_AUTODIFF_TAMC && defined SEAICE_MODIFY_GROWTH_ADJ)
1315     CALL ZERO_ADJ_1D( sNx*sNy, r_QbyOCN, myThid)
1316     #endif
1317    
1318     C ===================================================================
1319     C =========PART 3: determine effective thicknesses increments========
1320     C ===================================================================
1321    
1322     C compute snow/ice tendency due to sublimation
1323     C ============================================
1324    
1325     #ifdef ALLOW_AUTODIFF_TAMC
1326     CADJ STORE hsnow(:,:,bi,bj) = comlev1_bibj,key=iicekey,byte=isbyte
1327     CADJ STORE r_FWbySublim = comlev1_bibj,key=iicekey,byte=isbyte
1328     #endif /* ALLOW_AUTODIFF_TAMC */
1329 dimitri 1.2 #ifdef SEAICE_ITD
1330 torge 1.5 DO IT=1,nITD
1331 dimitri 1.2 #endif
1332 dimitri 1.1 DO J=1,sNy
1333     DO I=1,sNx
1334     C First sublimate/deposite snow
1335     tmpscal2 =
1336 dimitri 1.2 #ifdef SEAICE_ITD
1337 torge 1.5 & MAX(MIN(r_FWbySublimMult(I,J,IT),HSNOWITD(I,J,IT,bi,bj)
1338 dimitri 1.2 & *SNOW2ICE),ZERO)
1339     C accumulate change over ITD categories
1340 torge 1.5 d_HSNWbySublim(I,J) = d_HSNWbySublim(I,J) - tmpscal2
1341 dimitri 1.2 & *ICE2SNOW
1342 torge 1.5 HSNOWITD(I,J,IT,bi,bj) = HSNOWITD(I,J,IT,bi,bj) - tmpscal2
1343 dimitri 1.2 & *ICE2SNOW
1344 torge 1.5 r_FWbySublimMult(I,J,IT)= r_FWbySublimMult(I,J,IT) - tmpscal2
1345 dimitri 1.2 #else
1346 dimitri 1.1 & MAX(MIN(r_FWbySublim(I,J),HSNOW(I,J,bi,bj)*SNOW2ICE),ZERO)
1347     d_HSNWbySublim(I,J) = - tmpscal2 * ICE2SNOW
1348     HSNOW(I,J,bi,bj) = HSNOW(I,J,bi,bj) - tmpscal2*ICE2SNOW
1349     r_FWbySublim(I,J) = r_FWbySublim(I,J) - tmpscal2
1350 dimitri 1.2 #endif
1351 dimitri 1.1 ENDDO
1352     ENDDO
1353     #ifdef ALLOW_AUTODIFF_TAMC
1354     CADJ STORE heff(:,:,bi,bj) = comlev1_bibj,key=iicekey,byte=isbyte
1355     CADJ STORE r_FWbySublim = comlev1_bibj,key=iicekey,byte=isbyte
1356     #endif /* ALLOW_AUTODIFF_TAMC */
1357     DO J=1,sNy
1358     DO I=1,sNx
1359     C If anything is left, sublimate ice
1360     tmpscal2 =
1361 dimitri 1.2 #ifdef SEAICE_ITD
1362 torge 1.5 & MAX(MIN(r_FWbySublimMult(I,J,IT),HEFFITD(I,J,IT,bi,bj)),ZERO)
1363 torge 1.3 C accumulate change over ITD categories
1364 torge 1.8 d_HSNWbySublim(I,J) = d_HSNWbySublim(I,J) - tmpscal2
1365 torge 1.5 HEFFITD(I,J,IT,bi,bj) = HEFFITD(I,J,IT,bi,bj) - tmpscal2
1366     r_FWbySublimMult(I,J,IT) = r_FWbySublimMult(I,J,IT) - tmpscal2
1367 dimitri 1.2 #else
1368 dimitri 1.1 & MAX(MIN(r_FWbySublim(I,J),HEFF(I,J,bi,bj)),ZERO)
1369     d_HEFFbySublim(I,J) = - tmpscal2
1370     HEFF(I,J,bi,bj) = HEFF(I,J,bi,bj) - tmpscal2
1371     r_FWbySublim(I,J) = r_FWbySublim(I,J) - tmpscal2
1372 dimitri 1.2 #endif
1373 dimitri 1.1 ENDDO
1374     ENDDO
1375     DO J=1,sNy
1376     DO I=1,sNx
1377     C If anything is left, it will be evaporated from the ocean rather than sublimated.
1378 dimitri 1.2 C Since a_QbyATM_cover was computed for sublimation, not simple evaporation, we need to
1379 dimitri 1.1 C remove the fusion part for the residual (that happens to be precisely r_FWbySublim).
1380 dimitri 1.2 #ifdef SEAICE_ITD
1381 torge 1.5 a_QbyATMmult_cover(I,J,IT) = a_QbyATMmult_cover(I,J,IT)
1382     & - r_FWbySublimMult(I,J,IT)
1383     r_QbyATMmult_cover(I,J,IT) = r_QbyATMmult_cover(I,J,IT)
1384     & - r_FWbySublimMult(I,J,IT)
1385 torge 1.8 #else
1386     a_QbyATM_cover(I,J) = a_QbyATM_cover(I,J)-r_FWbySublim(I,J)
1387     r_QbyATM_cover(I,J) = r_QbyATM_cover(I,J)-r_FWbySublim(I,J)
1388     #endif
1389 dimitri 1.2 ENDDO
1390     ENDDO
1391 torge 1.8 #ifdef SEAICE_ITD
1392 torge 1.5 C end IT loop
1393 dimitri 1.2 ENDDO
1394     #endif
1395 torge 1.9 #ifdef SEAICE_DEBUG
1396 torge 1.3 c ToM<<< debug seaice_growth
1397 torge 1.8 WRITE(msgBuf,'(A,7F8.4)')
1398 torge 1.4 #ifdef SEAICE_ITD
1399 torge 1.3 & ' SEAICE_GROWTH: Heff increments 1, HEFFITD = ',
1400 torge 1.8 & HEFFITD(1,1,:,bi,bj)
1401     CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
1402     & SQUEEZE_RIGHT , myThid)
1403     WRITE(msgBuf,'(A,7F8.4)')
1404     & ' SEAICE_GROWTH: Area increments 1, AREAITD = ',
1405     & AREAITD(1,1,:,bi,bj)
1406 torge 1.4 #else
1407     & ' SEAICE_GROWTH: Heff increments 1, HEFF = ',
1408 torge 1.8 & HEFF(1,1,bi,bj)
1409 torge 1.4 #endif
1410 torge 1.3 CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
1411     & SQUEEZE_RIGHT , myThid)
1412     c ToM>>>
1413 torge 1.9 #endif
1414 dimitri 1.1
1415     C compute ice thickness tendency due to ice-ocean interaction
1416     C ===========================================================
1417    
1418     #ifdef ALLOW_AUTODIFF_TAMC
1419     CADJ STORE heff(:,:,bi,bj) = comlev1_bibj,key=iicekey,byte=isbyte
1420     CADJ STORE r_QbyOCN = comlev1_bibj,key=iicekey,byte=isbyte
1421     #endif /* ALLOW_AUTODIFF_TAMC */
1422    
1423 dimitri 1.2 #ifdef SEAICE_ITD
1424 torge 1.5 DO IT=1,nITD
1425 dimitri 1.2 DO J=1,sNy
1426     DO I=1,sNx
1427 torge 1.7 C ice growth/melt due to ocean heat r_QbyOCN (W/m^2) is
1428     C equally distributed under the ice and hence weighted by
1429     C fractional area of each thickness category
1430 torge 1.5 tmpscal1=MAX(r_QbyOCN(i,j)*areaFracFactor(I,J,IT),
1431     & -HEFFITD(I,J,IT,bi,bj))
1432 torge 1.7 d_HEFFbyOCNonICE(I,J) = d_HEFFbyOCNonICE(I,J) + tmpscal1
1433     HEFFITD(I,J,IT,bi,bj) = HEFFITD(I,J,IT,bi,bj) + tmpscal1
1434 torge 1.3 #ifdef ALLOW_SITRACER
1435     SItrHEFF(I,J,bi,bj,2) = SItrHEFF(I,J,bi,bj,2)
1436 torge 1.5 & + HEFFITD(I,J,IT,bi,bj)
1437 torge 1.3 #endif
1438 dimitri 1.2 ENDDO
1439     ENDDO
1440     ENDDO
1441 torge 1.7 DO J=1,sNy
1442     DO I=1,sNx
1443     r_QbyOCN(I,J)=r_QbyOCN(I,J)-d_HEFFbyOCNonICE(I,J)
1444     ENDDO
1445     ENDDO
1446 torge 1.3 #else /* SEAICE_ITD */
1447 dimitri 1.1 DO J=1,sNy
1448     DO I=1,sNx
1449     d_HEFFbyOCNonICE(I,J)=MAX(r_QbyOCN(i,j), -HEFF(I,J,bi,bj))
1450     r_QbyOCN(I,J)=r_QbyOCN(I,J)-d_HEFFbyOCNonICE(I,J)
1451     HEFF(I,J,bi,bj)=HEFF(I,J,bi,bj) + d_HEFFbyOCNonICE(I,J)
1452     #ifdef ALLOW_SITRACER
1453     SItrHEFF(I,J,bi,bj,2)=HEFF(I,J,bi,bj)
1454     #endif
1455     ENDDO
1456     ENDDO
1457 torge 1.3 #endif /* SEAICE_ITD */
1458 torge 1.9 #ifdef SEAICE_DEBUG
1459 torge 1.3 c ToM<<< debug seaice_growth
1460 torge 1.8 WRITE(msgBuf,'(A,7F8.4)')
1461 torge 1.4 #ifdef SEAICE_ITD
1462 torge 1.3 & ' SEAICE_GROWTH: Heff increments 2, HEFFITD = ',
1463 torge 1.8 & HEFFITD(1,1,:,bi,bj)
1464     CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
1465     & SQUEEZE_RIGHT , myThid)
1466     WRITE(msgBuf,'(A,7F8.4)')
1467     & ' SEAICE_GROWTH: Area increments 2, AREAITD = ',
1468     & AREAITD(1,1,:,bi,bj)
1469 torge 1.4 #else
1470     & ' SEAICE_GROWTH: Heff increments 2, HEFF = ',
1471 torge 1.8 & HEFF(1,1,bi,bj)
1472 torge 1.4 #endif
1473 torge 1.3 CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
1474     & SQUEEZE_RIGHT , myThid)
1475     c ToM>>>
1476 torge 1.9 #endif
1477 dimitri 1.1
1478     C compute snow melt tendency due to snow-atmosphere interaction
1479     C ==================================================================
1480    
1481     #ifdef ALLOW_AUTODIFF_TAMC
1482     CADJ STORE hsnow(:,:,bi,bj) = comlev1_bibj,key=iicekey,byte=isbyte
1483     CADJ STORE r_QbyATM_cover = comlev1_bibj,key=iicekey,byte=isbyte
1484     #endif /* ALLOW_AUTODIFF_TAMC */
1485    
1486 dimitri 1.2 #ifdef SEAICE_ITD
1487 torge 1.5 DO IT=1,nITD
1488 dimitri 1.2 DO J=1,sNy
1489     DO I=1,sNx
1490     C Convert to standard units (meters of ice) rather than to meters
1491     C of snow. This appears to be more robust.
1492 torge 1.5 tmpscal1=MAX(r_QbyATMmult_cover(I,J,IT),
1493     & -HSNOWITD(I,J,IT,bi,bj)*SNOW2ICE)
1494     tmpscal2=MIN(tmpscal1,0. _d 0)
1495 dimitri 1.2 #ifdef SEAICE_MODIFY_GROWTH_ADJ
1496     Cgf no additional dependency through snow
1497 torge 1.5 IF ( SEAICEadjMODE.GE.2 ) tmpscal2 = 0. _d 0
1498 dimitri 1.2 #endif
1499 torge 1.5 d_HSNWbyATMonSNW(I,J) = d_HSNWbyATMonSNW(I,J)
1500     & + tmpscal2*ICE2SNOW
1501     HSNOWITD(I,J,IT,bi,bj)= HSNOWITD(I,J,IT,bi,bj)
1502     & + tmpscal2*ICE2SNOW
1503     r_QbyATMmult_cover(I,J,IT)=r_QbyATMmult_cover(I,J,IT)
1504     & - tmpscal2
1505 dimitri 1.2 ENDDO
1506     ENDDO
1507     ENDDO
1508 torge 1.3 #else /* SEAICE_ITD */
1509 dimitri 1.1 DO J=1,sNy
1510     DO I=1,sNx
1511     C Convert to standard units (meters of ice) rather than to meters
1512     C of snow. This appears to be more robust.
1513     tmpscal1=MAX(r_QbyATM_cover(I,J),-HSNOW(I,J,bi,bj)*SNOW2ICE)
1514     tmpscal2=MIN(tmpscal1,0. _d 0)
1515     #ifdef SEAICE_MODIFY_GROWTH_ADJ
1516     Cgf no additional dependency through snow
1517     IF ( SEAICEadjMODE.GE.2 ) tmpscal2 = 0. _d 0
1518     #endif
1519     d_HSNWbyATMonSNW(I,J)= tmpscal2*ICE2SNOW
1520 torge 1.3 HSNOW(I,J,bi,bj) = HSNOW(I,J,bi,bj) + tmpscal2*ICE2SNOW
1521 dimitri 1.1 r_QbyATM_cover(I,J)=r_QbyATM_cover(I,J) - tmpscal2
1522     ENDDO
1523     ENDDO
1524 dimitri 1.2 #endif /* SEAICE_ITD */
1525 torge 1.9 #ifdef SEAICE_DEBUG
1526 torge 1.3 c ToM<<< debug seaice_growth
1527 torge 1.8 WRITE(msgBuf,'(A,7F8.4)')
1528 torge 1.4 #ifdef SEAICE_ITD
1529 torge 1.3 & ' SEAICE_GROWTH: Heff increments 3, HEFFITD = ',
1530 torge 1.8 & HEFFITD(1,1,:,bi,bj)
1531     CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
1532     & SQUEEZE_RIGHT , myThid)
1533     WRITE(msgBuf,'(A,7F8.4)')
1534     & ' SEAICE_GROWTH: Area increments 3, AREAITD = ',
1535     & AREAITD(1,1,:,bi,bj)
1536 torge 1.4 #else
1537     & ' SEAICE_GROWTH: Heff increments 3, HEFF = ',
1538 torge 1.8 & HEFF(1,1,bi,bj)
1539 torge 1.4 #endif
1540 torge 1.3 CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
1541     & SQUEEZE_RIGHT , myThid)
1542     c ToM>>>
1543 torge 1.9 #endif
1544 dimitri 1.1
1545     C compute ice thickness tendency due to the atmosphere
1546     C ====================================================
1547    
1548     #ifdef ALLOW_AUTODIFF_TAMC
1549     CADJ STORE heff(:,:,bi,bj) = comlev1_bibj,key=iicekey,byte=isbyte
1550     CADJ STORE r_QbyATM_cover = comlev1_bibj,key=iicekey,byte=isbyte
1551     #endif /* ALLOW_AUTODIFF_TAMC */
1552    
1553     Cgf note: this block is not actually tested by lab_sea
1554     Cgf where all experiments start in January. So even though
1555     Cgf the v1.81=>v1.82 revision would change results in
1556     Cgf warming conditions, the lab_sea results were not changed.
1557    
1558 dimitri 1.2 #ifdef SEAICE_ITD
1559 torge 1.5 DO IT=1,nITD
1560 dimitri 1.2 DO J=1,sNy
1561     DO I=1,sNx
1562     #ifdef SEAICE_GROWTH_LEGACY
1563 torge 1.5 tmpscal2 = MAX(-HEFFITD(I,J,IT,bi,bj),
1564     & r_QbyATMmult_cover(I,J,IT))
1565 dimitri 1.2 #else
1566 torge 1.5 tmpscal2 = MAX(-HEFFITD(I,J,IT,bi,bj),
1567     & r_QbyATMmult_cover(I,J,IT)
1568 dimitri 1.2 c Limit ice growth by potential melt by ocean
1569 torge 1.5 & + AREAITDpreTH(I,J,IT) * r_QbyOCN(I,J))
1570 dimitri 1.2 #endif /* SEAICE_GROWTH_LEGACY */
1571     d_HEFFbyATMonOCN_cover(I,J) = d_HEFFbyATMonOCN_cover(I,J)
1572     & + tmpscal2
1573     d_HEFFbyATMonOCN(I,J) = d_HEFFbyATMonOCN(I,J)
1574     & + tmpscal2
1575 torge 1.8 r_QbyATMmult_cover(I,J,IT) = r_QbyATMmult_cover(I,J,IT)
1576 dimitri 1.2 & - tmpscal2
1577 torge 1.5 HEFFITD(I,J,IT,bi,bj) = HEFFITD(I,J,IT,bi,bj) + tmpscal2
1578 torge 1.3
1579     #ifdef ALLOW_SITRACER
1580     SItrHEFF(I,J,bi,bj,3) = SItrHEFF(I,J,bi,bj,3)
1581 torge 1.5 & + HEFFITD(I,J,IT,bi,bj)
1582 torge 1.3 #endif
1583 dimitri 1.2 ENDDO
1584     ENDDO
1585     ENDDO
1586 torge 1.3 #else /* SEAICE_ITD */
1587 dimitri 1.1 DO J=1,sNy
1588     DO I=1,sNx
1589    
1590     #ifdef SEAICE_GROWTH_LEGACY
1591     tmpscal2 = MAX(-HEFF(I,J,bi,bj),r_QbyATM_cover(I,J))
1592     #else
1593     tmpscal2 = MAX(-HEFF(I,J,bi,bj),r_QbyATM_cover(I,J)+
1594 torge 1.10 C Limit ice growth by potential melt by ocean
1595 dimitri 1.1 & AREApreTH(I,J) * r_QbyOCN(I,J))
1596     #endif /* SEAICE_GROWTH_LEGACY */
1597    
1598     d_HEFFbyATMonOCN_cover(I,J)=tmpscal2
1599     d_HEFFbyATMonOCN(I,J)=d_HEFFbyATMonOCN(I,J)+tmpscal2
1600     r_QbyATM_cover(I,J)=r_QbyATM_cover(I,J)-tmpscal2
1601 torge 1.3 HEFF(I,J,bi,bj) = HEFF(I,J,bi,bj) + tmpscal2
1602 dimitri 1.1
1603     #ifdef ALLOW_SITRACER
1604     SItrHEFF(I,J,bi,bj,3)=HEFF(I,J,bi,bj)
1605     #endif
1606 torge 1.10 ENDDO
1607     ENDDO
1608 torge 1.3 #endif /* SEAICE_ITD */
1609 torge 1.9 #ifdef SEAICE_DEBUG
1610 torge 1.3 c ToM<<< debug seaice_growth
1611 torge 1.8 WRITE(msgBuf,'(A,7F8.4)')
1612 torge 1.4 #ifdef SEAICE_ITD
1613 torge 1.3 & ' SEAICE_GROWTH: Heff increments 4, HEFFITD = ',
1614 torge 1.8 & HEFFITD(1,1,:,bi,bj)
1615     CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
1616     & SQUEEZE_RIGHT , myThid)
1617     WRITE(msgBuf,'(A,7F8.4)')
1618     & ' SEAICE_GROWTH: Area increments 4, AREAITD = ',
1619     & AREAITD(1,1,:,bi,bj)
1620 torge 1.4 #else
1621     & ' SEAICE_GROWTH: Heff increments 4, HEFF = ',
1622 torge 1.8 & HEFF(1,1,bi,bj)
1623 torge 1.4 #endif
1624 torge 1.3 CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
1625     & SQUEEZE_RIGHT , myThid)
1626     c ToM>>>
1627 torge 1.9 #endif
1628 dimitri 1.1
1629 torge 1.10 C add snow precipitation to HSNOW.
1630 dimitri 1.1 C =================================================
1631     #ifdef ALLOW_ATM_TEMP
1632 torge 1.10 # ifdef ALLOW_AUTODIFF_TAMC
1633 dimitri 1.1 CADJ STORE a_QbyATM_cover = comlev1_bibj,key=iicekey,byte=isbyte
1634     CADJ STORE PRECIP(:,:,bi,bj) = comlev1_bibj,key=iicekey,byte=isbyte
1635     CADJ STORE AREApreTH = comlev1_bibj,key=iicekey,byte=isbyte
1636 torge 1.10 # endif /* ALLOW_AUTODIFF_TAMC */
1637     IF ( snowPrecipFile .NE. ' ' ) THEN
1638     C add snowPrecip to HSNOW
1639     DO J=1,sNy
1640     DO I=1,sNx
1641     d_HSNWbyRAIN(I,J) = convertPRECIP2HI * ICE2SNOW *
1642     & snowPrecip(i,j,bi,bj) * AREApreTH(I,J)
1643     d_HFRWbyRAIN(I,J) = -convertPRECIP2HI *
1644     & ( PRECIP(I,J,bi,bj) - snowPrecip(I,J,bi,bj) ) *
1645     & AREApreTH(I,J)
1646     HSNOW(I,J,bi,bj) = HSNOW(I,J,bi,bj) + d_HSNWbyRAIN(I,J)
1647     ENDDO
1648     ENDDO
1649     ELSE
1650     C attribute precip to fresh water or snow stock,
1651     C depending on atmospheric conditions.
1652     DO J=1,sNy
1653     DO I=1,sNx
1654 dimitri 1.1 C possible alternatives to the a_QbyATM_cover criterium
1655     c IF (TICE(I,J,bi,bj) .LT. TMIX) THEN
1656     c IF (atemp(I,J,bi,bj) .LT. celsius2K) THEN
1657 torge 1.10 IF ( a_QbyATM_cover(I,J).GE. 0. _d 0 ) THEN
1658 dimitri 1.1 C add precip as snow
1659     d_HFRWbyRAIN(I,J)=0. _d 0
1660     d_HSNWbyRAIN(I,J)=convertPRECIP2HI*ICE2SNOW*
1661     & PRECIP(I,J,bi,bj)*AREApreTH(I,J)
1662 torge 1.10 ELSE
1663 dimitri 1.1 C add precip to the fresh water bucket
1664     d_HFRWbyRAIN(I,J)=-convertPRECIP2HI*
1665     & PRECIP(I,J,bi,bj)*AREApreTH(I,J)
1666     d_HSNWbyRAIN(I,J)=0. _d 0
1667 torge 1.10 ENDIF
1668 dimitri 1.1 ENDDO
1669     ENDDO
1670 dimitri 1.2 #ifdef SEAICE_ITD
1671 torge 1.5 DO IT=1,nITD
1672 dimitri 1.2 DO J=1,sNy
1673     DO I=1,sNx
1674 torge 1.5 HSNOWITD(I,J,IT,bi,bj) = HSNOWITD(I,J,IT,bi,bj)
1675     & + d_HSNWbyRAIN(I,J)*areaFracFactor(I,J,IT)
1676 dimitri 1.2 ENDDO
1677     ENDDO
1678     ENDDO
1679 torge 1.3 #else
1680     DO J=1,sNy
1681     DO I=1,sNx
1682     HSNOW(I,J,bi,bj) = HSNOW(I,J,bi,bj) + d_HSNWbyRAIN(I,J)
1683     ENDDO
1684     ENDDO
1685 dimitri 1.2 #endif
1686 dimitri 1.1 Cgf note: this does not affect air-sea heat flux,
1687     Cgf since the implied air heat gain to turn
1688     Cgf rain to snow is not a surface process.
1689 torge 1.10 C end of IF statement snowPrecipFile:
1690     ENDIF
1691 dimitri 1.1 #endif /* ALLOW_ATM_TEMP */
1692 torge 1.9 #ifdef SEAICE_DEBUG
1693 torge 1.3 c ToM<<< debug seaice_growth
1694 torge 1.8 WRITE(msgBuf,'(A,7F8.4)')
1695 torge 1.4 #ifdef SEAICE_ITD
1696 torge 1.3 & ' SEAICE_GROWTH: Heff increments 5, HEFFITD = ',
1697 torge 1.8 & HEFFITD(1,1,:,bi,bj)
1698     CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
1699     & SQUEEZE_RIGHT , myThid)
1700     WRITE(msgBuf,'(A,7F8.4)')
1701     & ' SEAICE_GROWTH: Area increments 5, AREAITD = ',
1702     & AREAITD(1,1,:,bi,bj)
1703 torge 1.4 #else
1704     & ' SEAICE_GROWTH: Heff increments 5, HEFF = ',
1705 torge 1.8 & HEFF(1,1,bi,bj)
1706 torge 1.4 #endif
1707 torge 1.3 CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
1708     & SQUEEZE_RIGHT , myThid)
1709     c ToM>>>
1710 torge 1.9 #endif
1711 dimitri 1.1
1712     C compute snow melt due to heat available from ocean.
1713     C =================================================================
1714    
1715     Cgf do we need to keep this comment and cpp bracket?
1716     Cph( very sensitive bit here by JZ
1717     #ifndef SEAICE_EXCLUDE_FOR_EXACT_AD_TESTING
1718     #ifdef ALLOW_AUTODIFF_TAMC
1719     CADJ STORE HSNOW(:,:,bi,bj) = comlev1_bibj,key=iicekey,byte=isbyte
1720     CADJ STORE r_QbyOCN = comlev1_bibj,key=iicekey,byte=isbyte
1721     #endif /* ALLOW_AUTODIFF_TAMC */
1722 dimitri 1.2
1723     #ifdef SEAICE_ITD
1724 torge 1.5 DO IT=1,nITD
1725 dimitri 1.2 DO J=1,sNy
1726     DO I=1,sNx
1727 torge 1.5 tmpscal1=MAX(r_QbyOCN(i,j)*ICE2SNOW*areaFracFactor(I,J,IT),
1728     & -HSNOWITD(I,J,IT,bi,bj))
1729 dimitri 1.2 tmpscal2=MIN(tmpscal1,0. _d 0)
1730     #ifdef SEAICE_MODIFY_GROWTH_ADJ
1731     Cgf no additional dependency through snow
1732     if ( SEAICEadjMODE.GE.2 ) tmpscal2 = 0. _d 0
1733     #endif
1734 torge 1.3 d_HSNWbyOCNonSNW(I,J) = d_HSNWbyOCNonSNW(I,J) + tmpscal2
1735     r_QbyOCN(I,J)=r_QbyOCN(I,J) - tmpscal2*SNOW2ICE
1736 torge 1.5 HSNOWITD(I,J,IT,bi,bj) = HSNOWITD(I,J,IT,bi,bj) + tmpscal2
1737 dimitri 1.2 ENDDO
1738     ENDDO
1739     ENDDO
1740 torge 1.3 #else /* SEAICE_ITD */
1741 dimitri 1.1 DO J=1,sNy
1742     DO I=1,sNx
1743     tmpscal1=MAX(r_QbyOCN(i,j)*ICE2SNOW, -HSNOW(I,J,bi,bj))
1744     tmpscal2=MIN(tmpscal1,0. _d 0)
1745     #ifdef SEAICE_MODIFY_GROWTH_ADJ
1746     Cgf no additional dependency through snow
1747     if ( SEAICEadjMODE.GE.2 ) tmpscal2 = 0. _d 0
1748     #endif
1749     d_HSNWbyOCNonSNW(I,J) = tmpscal2
1750     r_QbyOCN(I,J)=r_QbyOCN(I,J)
1751     & -d_HSNWbyOCNonSNW(I,J)*SNOW2ICE
1752     HSNOW(I,J,bi,bj) = HSNOW(I,J,bi,bj)+d_HSNWbyOCNonSNW(I,J)
1753     ENDDO
1754     ENDDO
1755 torge 1.3 #endif /* SEAICE_ITD */
1756 dimitri 1.1 #endif /* SEAICE_EXCLUDE_FOR_EXACT_AD_TESTING */
1757     Cph)
1758 torge 1.9 #ifdef SEAICE_DEBUG
1759 torge 1.3 c ToM<<< debug seaice_growth
1760 torge 1.8 WRITE(msgBuf,'(A,7F8.4)')
1761 torge 1.4 #ifdef SEAICE_ITD
1762 torge 1.3 & ' SEAICE_GROWTH: Heff increments 6, HEFFITD = ',
1763 torge 1.8 & HEFFITD(1,1,:,bi,bj)
1764     CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
1765     & SQUEEZE_RIGHT , myThid)
1766     WRITE(msgBuf,'(A,7F8.4)')
1767     & ' SEAICE_GROWTH: Area increments 6, AREAITD = ',
1768     & AREAITD(1,1,:,bi,bj)
1769 torge 1.4 #else
1770     & ' SEAICE_GROWTH: Heff increments 6, HEFF = ',
1771 torge 1.8 & HEFF(1,1,bi,bj)
1772 torge 1.4 #endif
1773 torge 1.3 CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
1774     & SQUEEZE_RIGHT , myThid)
1775     c ToM>>>
1776 torge 1.9 #endif
1777 dimitri 1.1
1778     C gain of new ice over open water
1779     C ===============================
1780     #ifdef ALLOW_AUTODIFF_TAMC
1781     CADJ STORE heff(:,:,bi,bj) = comlev1_bibj,key=iicekey,byte=isbyte
1782     CADJ STORE r_QbyATM_open = comlev1_bibj,key=iicekey,byte=isbyte
1783     CADJ STORE r_QbyOCN = comlev1_bibj,key=iicekey,byte=isbyte
1784     CADJ STORE a_QSWbyATM_cover = comlev1_bibj,key=iicekey,byte=isbyte
1785     CADJ STORE a_QSWbyATM_open = comlev1_bibj,key=iicekey,byte=isbyte
1786     #endif /* ALLOW_AUTODIFF_TAMC */
1787    
1788     DO J=1,sNy
1789     DO I=1,sNx
1790 torge 1.10 C Initial ice growth is triggered by open water
1791     C heat flux overcoming potential melt by ocean
1792 dimitri 1.1 tmpscal1=r_QbyATM_open(I,J)+r_QbyOCN(i,j) *
1793     & (1.0 _d 0 - AREApreTH(I,J))
1794 torge 1.10 C Penetrative shortwave flux beyond first layer
1795     C that is therefore not available to ice growth/melt
1796 dimitri 1.1 tmpscal2=SWFracB * a_QSWbyATM_open(I,J)
1797     C impose -HEFF as the maxmum melting if SEAICE_doOpenWaterMelt
1798     C or 0. otherwise (no melting if not SEAICE_doOpenWaterMelt)
1799     tmpscal3=facOpenGrow*MAX(tmpscal1-tmpscal2,
1800     & -HEFF(I,J,bi,bj)*facOpenMelt)*HEFFM(I,J,bi,bj)
1801     d_HEFFbyATMonOCN_open(I,J)=tmpscal3
1802     d_HEFFbyATMonOCN(I,J)=d_HEFFbyATMonOCN(I,J)+tmpscal3
1803     r_QbyATM_open(I,J)=r_QbyATM_open(I,J)-tmpscal3
1804 dimitri 1.2 #ifdef SEAICE_ITD
1805 torge 1.9 C open water area fraction
1806     tmpscal0 = ONE-AREApreTH(I,J)
1807     C determine thickness of new ice
1808     ctomC considering the entire open water area to refreeze
1809     ctom tmpscal1 = tmpscal3/tmpscal0
1810     C considering a minimum lead ice thickness of 10 cm
1811     C WATCH that leadIceThickMin is smaller that Hlimit(1)!
1812     leadIceThickMin = 0.1
1813     tmpscal1 = MAX(leadIceThickMin,tmpscal3/tmpscal0)
1814     C adjust ice area fraction covered by new ice
1815     tmpscal0 = tmpscal3/tmpscal1
1816     C then add new ice volume to appropriate thickness category
1817     DO IT=1,nITD
1818     IF (tmpscal1.LT.Hlimit(IT)) THEN
1819     HEFFITD(I,J,IT,bi,bj) = HEFFITD(I,J,IT,bi,bj) + tmpscal3
1820     tmpscal3=ZERO
1821     C not sure if AREAITD should be changed here since AREA is incremented
1822     C in PART 4 below in non-itd code
1823     C in this scenario all open water is covered by new ice instantaneously,
1824     C i.e. no delayed lead closing is concidered such as is associated with
1825     C Hibler's h_0 parameter
1826     AREAITD(I,J,IT,bi,bj) = AREAITD(I,J,IT,bi,bj)
1827     & + tmpscal0
1828     tmpscal0=ZERO
1829     ENDIF
1830     ENDDO
1831 torge 1.3 #else
1832     HEFF(I,J,bi,bj) = HEFF(I,J,bi,bj) + tmpscal3
1833 dimitri 1.2 #endif
1834 dimitri 1.1 ENDDO
1835     ENDDO
1836    
1837     #ifdef ALLOW_SITRACER
1838 torge 1.3 #ifdef SEAICE_ITD
1839 torge 1.5 DO IT=1,nITD
1840 torge 1.3 DO J=1,sNy
1841     DO I=1,sNx
1842     c needs to be here to allow use also with LEGACY branch
1843     SItrHEFF(I,J,bi,bj,4) = SItrHEFF(I,J,bi,bj,4)
1844 torge 1.5 & + HEFFITD(I,J,IT,bi,bj)
1845 torge 1.3 ENDDO
1846     ENDDO
1847     ENDDO
1848     #else
1849 dimitri 1.1 DO J=1,sNy
1850     DO I=1,sNx
1851 torge 1.10 C needs to be here to allow use also with LEGACY branch
1852 dimitri 1.1 SItrHEFF(I,J,bi,bj,4)=HEFF(I,J,bi,bj)
1853     ENDDO
1854     ENDDO
1855 torge 1.3 #endif
1856 dimitri 1.1 #endif /* ALLOW_SITRACER */
1857 torge 1.9 #ifdef SEAICE_DEBUG
1858 torge 1.3 c ToM<<< debug seaice_growth
1859 torge 1.8 WRITE(msgBuf,'(A,7F8.4)')
1860 torge 1.4 #ifdef SEAICE_ITD
1861 torge 1.3 & ' SEAICE_GROWTH: Heff increments 7, HEFFITD = ',
1862 torge 1.8 & HEFFITD(1,1,:,bi,bj)
1863     CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
1864     & SQUEEZE_RIGHT , myThid)
1865     WRITE(msgBuf,'(A,7F8.4)')
1866     & ' SEAICE_GROWTH: Area increments 7, AREAITD = ',
1867     & AREAITD(1,1,:,bi,bj)
1868 torge 1.4 #else
1869     & ' SEAICE_GROWTH: Heff increments 7, HEFF = ',
1870 torge 1.8 & HEFF(1,1,bi,bj)
1871     CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
1872     & SQUEEZE_RIGHT , myThid)
1873     WRITE(msgBuf,'(A,7F8.4)')
1874     & ' SEAICE_GROWTH: Area increments 7, AREA = ',
1875     & AREA(1,1,bi,bj)
1876 torge 1.4 #endif
1877 torge 1.3 CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
1878     & SQUEEZE_RIGHT , myThid)
1879     c ToM>>>
1880 torge 1.9 #endif
1881 dimitri 1.1
1882     C convert snow to ice if submerged.
1883     C =================================
1884    
1885     #ifndef SEAICE_GROWTH_LEGACY
1886     C note: in legacy, this process is done at the end
1887     #ifdef ALLOW_AUTODIFF_TAMC
1888     CADJ STORE heff(:,:,bi,bj) = comlev1_bibj,key=iicekey,byte=isbyte
1889     CADJ STORE hsnow(:,:,bi,bj) = comlev1_bibj,key=iicekey,byte=isbyte
1890     #endif /* ALLOW_AUTODIFF_TAMC */
1891     IF ( SEAICEuseFlooding ) THEN
1892 dimitri 1.2 #ifdef SEAICE_ITD
1893 torge 1.5 DO IT=1,nITD
1894 dimitri 1.2 DO J=1,sNy
1895     DO I=1,sNx
1896 torge 1.5 tmpscal0 = (HSNOWITD(I,J,IT,bi,bj)*SEAICE_rhoSnow
1897     & + HEFFITD(I,J,IT,bi,bj) *SEAICE_rhoIce)
1898     & *recip_rhoConst
1899     tmpscal1 = MAX( 0. _d 0, tmpscal0 - HEFFITD(I,J,IT,bi,bj))
1900     d_HEFFbyFLOODING(I,J) = d_HEFFbyFLOODING(I,J) + tmpscal1
1901     HEFFITD(I,J,IT,bi,bj) = HEFFITD(I,J,IT,bi,bj) + tmpscal1
1902     HSNOWITD(I,J,IT,bi,bj)= HSNOWITD(I,J,IT,bi,bj) - tmpscal1
1903 dimitri 1.2 & * ICE2SNOW
1904     ENDDO
1905     ENDDO
1906     ENDDO
1907     #else
1908 dimitri 1.1 DO J=1,sNy
1909     DO I=1,sNx
1910     tmpscal0 = (HSNOW(I,J,bi,bj)*SEAICE_rhoSnow
1911     & +HEFF(I,J,bi,bj)*SEAICE_rhoIce)*recip_rhoConst
1912     tmpscal1 = MAX( 0. _d 0, tmpscal0 - HEFF(I,J,bi,bj))
1913     d_HEFFbyFLOODING(I,J)=tmpscal1
1914 torge 1.3 HEFF(I,J,bi,bj) = HEFF(I,J,bi,bj)+d_HEFFbyFLOODING(I,J)
1915     HSNOW(I,J,bi,bj) = HSNOW(I,J,bi,bj)-
1916     & d_HEFFbyFLOODING(I,J)*ICE2SNOW
1917 torge 1.10 ENDDO
1918     ENDDO
1919 dimitri 1.2 #endif
1920 dimitri 1.1 ENDIF
1921     #endif /* SEAICE_GROWTH_LEGACY */
1922 torge 1.9 #ifdef SEAICE_DEBUG
1923 torge 1.3 c ToM<<< debug seaice_growth
1924 torge 1.8 WRITE(msgBuf,'(A,7F8.4)')
1925 torge 1.4 #ifdef SEAICE_ITD
1926 torge 1.3 & ' SEAICE_GROWTH: Heff increments 8, HEFFITD = ',
1927 torge 1.8 & HEFFITD(1,1,:,bi,bj)
1928 torge 1.7 CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
1929     & SQUEEZE_RIGHT , myThid)
1930 torge 1.8 WRITE(msgBuf,'(A,7F8.4)')
1931 torge 1.7 & ' SEAICE_GROWTH: Area increments 8, AREAITD = ',
1932 torge 1.8 & AREAITD(1,1,:,bi,bj)
1933 torge 1.4 #else
1934     & ' SEAICE_GROWTH: Heff increments 8, HEFF = ',
1935 torge 1.8 & HEFF(1,1,bi,bj)
1936 torge 1.7 CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
1937     & SQUEEZE_RIGHT , myThid)
1938 torge 1.8 WRITE(msgBuf,'(A,7F8.4)')
1939 torge 1.7 & ' SEAICE_GROWTH: Area increments 8, AREA = ',
1940 torge 1.8 & AREA(1,1,bi,bj)
1941 torge 1.4 #endif
1942 torge 1.3 CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
1943     & SQUEEZE_RIGHT , myThid)
1944     c ToM>>>
1945 torge 1.9 #endif
1946 dimitri 1.1
1947     C ===================================================================
1948     C ==========PART 4: determine ice cover fraction increments=========-
1949     C ===================================================================
1950    
1951     #ifdef ALLOW_AUTODIFF_TAMC
1952     CADJ STORE d_HEFFbyATMonOCN = comlev1_bibj,key=iicekey,byte=isbyte
1953     CADJ STORE d_HEFFbyATMonOCN_cover = comlev1_bibj,key=iicekey,byte=isbyte
1954     CADJ STORE d_HEFFbyATMonOCN_open = comlev1_bibj,key=iicekey,byte=isbyte
1955     CADJ STORE d_HEFFbyOCNonICE = comlev1_bibj,key=iicekey,byte=isbyte
1956     CADJ STORE recip_heffActual = comlev1_bibj,key=iicekey,byte=isbyte
1957     CADJ STORE d_hsnwbyatmonsnw = comlev1_bibj,key=iicekey,byte=isbyte
1958     cph(
1959     cphCADJ STORE d_AREAbyATM = comlev1_bibj,key=iicekey,byte=isbyte
1960     cphCADJ STORE d_AREAbyICE = comlev1_bibj,key=iicekey,byte=isbyte
1961     cphCADJ STORE d_AREAbyOCN = comlev1_bibj,key=iicekey,byte=isbyte
1962     cph)
1963     CADJ STORE a_QbyATM_open = comlev1_bibj,key=iicekey,byte=isbyte
1964     CADJ STORE heffActual = comlev1_bibj,key=iicekey,byte=isbyte
1965     CADJ STORE AREApreTH = comlev1_bibj,key=iicekey,byte=isbyte
1966     CADJ STORE HEFF(:,:,bi,bj) = comlev1_bibj,key=iicekey,byte=isbyte
1967     CADJ STORE HSNOW(:,:,bi,bj) = comlev1_bibj,key=iicekey,byte=isbyte
1968     CADJ STORE AREA(:,:,bi,bj) = comlev1_bibj,key=iicekey,byte=isbyte
1969     #endif /* ALLOW_AUTODIFF_TAMC */
1970    
1971 torge 1.9 #ifdef SEAICE_ITD
1972     C replaces Hibler '79 scheme and lead closing parameter
1973     C because ITD accounts explicitly for lead openings and
1974     C different melt rates due to varying ice thickness
1975     C
1976     C only consider ice area loss due to total ice thickness loss;
1977     C ice area gain due to freezing of open water is handled above
1978     C under "gain of new ice over open water"
1979     C
1980     C does not account for lateral melt of ice floes
1981     C
1982     C AREAITD is incremented in section "gain of new ice over open water" above
1983     C
1984     DO IT=1,nITD
1985     DO J=1,sNy
1986     DO I=1,sNx
1987     IF (HEFFITD(I,J,IT,bi,bj).LE.ZERO) THEN
1988     AREAITD(I,J,IT,bi,bj)=ZERO
1989     ENDIF
1990     #ifdef ALLOW_SITRACER
1991     SItrAREA(I,J,bi,bj,3) = SItrAREA(I,J,bi,bj,3)
1992     & + AREAITD(I,J,IT,bi,bj)
1993     #endif /* ALLOW_SITRACER */
1994     ENDDO
1995     ENDDO
1996     ENDDO
1997     #else /* SEAICE_ITD */
1998 dimitri 1.1 DO J=1,sNy
1999     DO I=1,sNx
2000    
2001     IF ( YC(I,J,bi,bj) .LT. ZERO ) THEN
2002     recip_HO=1. _d 0 / HO_south
2003     ELSE
2004     recip_HO=1. _d 0 / HO
2005     ENDIF
2006     #ifdef SEAICE_GROWTH_LEGACY
2007     tmpscal0=HEFF(I,J,bi,bj) - d_HEFFbyATMonOCN(I,J)
2008     recip_HH = AREApreTH(I,J) /(tmpscal0+.00001 _d 0)
2009     #else
2010     recip_HH = recip_heffActual(I,J)
2011     #endif
2012    
2013     C gain of ice over open water : computed from
2014     C (SEAICE_areaGainFormula.EQ.1) from growth by ATM
2015     C (SEAICE_areaGainFormula.EQ.2) from predicted growth by ATM
2016     IF (SEAICE_areaGainFormula.EQ.1) THEN
2017     tmpscal4 = MAX(ZERO,d_HEFFbyATMonOCN_open(I,J))
2018     ELSE
2019     tmpscal4=MAX(ZERO,a_QbyATM_open(I,J))
2020     ENDIF
2021    
2022     C loss of ice cover by melting : computed from
2023     C (SEAICE_areaLossFormula.EQ.1) from all but only melt conributions by ATM and OCN
2024     C (SEAICE_areaLossFormula.EQ.2) from net melt-growth>0 by ATM and OCN
2025     C (SEAICE_areaLossFormula.EQ.3) from predicted melt by ATM
2026     IF (SEAICE_areaLossFormula.EQ.1) THEN
2027     tmpscal3 = MIN( 0. _d 0 , d_HEFFbyATMonOCN_cover(I,J) )
2028     & + MIN( 0. _d 0 , d_HEFFbyATMonOCN_open(I,J) )
2029     & + MIN( 0. _d 0 , d_HEFFbyOCNonICE(I,J) )
2030     ELSEIF (SEAICE_areaLossFormula.EQ.2) THEN
2031     tmpscal3 = MIN( 0. _d 0 , d_HEFFbyATMonOCN_cover(I,J)
2032     & + d_HEFFbyATMonOCN_open(I,J) + d_HEFFbyOCNonICE(I,J) )
2033     ELSE
2034     C compute heff after ice melt by ocn:
2035     tmpscal0=HEFF(I,J,bi,bj) - d_HEFFbyATMonOCN(I,J)
2036     C compute available heat left after snow melt by atm:
2037     tmpscal1= a_QbyATM_open(I,J)+a_QbyATM_cover(I,J)
2038     & - d_HSNWbyATMonSNW(I,J)*SNOW2ICE
2039     C could not melt more than all the ice
2040     tmpscal2 = MAX(-tmpscal0,tmpscal1)
2041     tmpscal3 = MIN(ZERO,tmpscal2)
2042     ENDIF
2043    
2044     C apply tendency
2045     IF ( (HEFF(i,j,bi,bj).GT.0. _d 0).OR.
2046     & (HSNOW(i,j,bi,bj).GT.0. _d 0) ) THEN
2047     AREA(I,J,bi,bj)=MAX(0. _d 0,
2048     & MIN( SEAICE_area_max, AREA(I,J,bi,bj)
2049     & + recip_HO*tmpscal4+HALF*recip_HH*tmpscal3 ))
2050     ELSE
2051     AREA(I,J,bi,bj)=0. _d 0
2052     ENDIF
2053     #ifdef ALLOW_SITRACER
2054     SItrAREA(I,J,bi,bj,3)=AREA(I,J,bi,bj)
2055     #endif /* ALLOW_SITRACER */
2056     #ifdef ALLOW_DIAGNOSTICS
2057     d_AREAbyATM(I,J)=
2058     & recip_HO*MAX(ZERO,d_HEFFbyATMonOCN_open(I,J))
2059     & +HALF*recip_HH*MIN(0. _d 0,d_HEFFbyATMonOCN_open(I,J))
2060     d_AREAbyICE(I,J)=
2061     & HALF*recip_HH*MIN(0. _d 0,d_HEFFbyATMonOCN_cover(I,J))
2062     d_AREAbyOCN(I,J)=
2063     & HALF*recip_HH*MIN( 0. _d 0,d_HEFFbyOCNonICE(I,J) )
2064     #endif /* ALLOW_DIAGNOSTICS */
2065     ENDDO
2066     ENDDO
2067 torge 1.9 #endif /* SEAICE_ITD */
2068 dimitri 1.1
2069     #if (defined ALLOW_AUTODIFF_TAMC && defined SEAICE_MODIFY_GROWTH_ADJ)
2070     Cgf 'bulk' linearization of area=f(HEFF)
2071     IF ( SEAICEadjMODE.GE.1 ) THEN
2072 dimitri 1.2 #ifdef SEAICE_ITD
2073 torge 1.5 DO IT=1,nITD
2074 dimitri 1.2 DO J=1,sNy
2075     DO I=1,sNx
2076 torge 1.5 AREAITD(I,J,IT,bi,bj) = AREAITDpreTH(I,J,IT) + 0.1 _d 0 *
2077     & ( HEFFITD(I,J,IT,bi,bj) - HEFFITDpreTH(I,J,IT) )
2078 dimitri 1.2 ENDDO
2079     ENDDO
2080     ENDDO
2081     #else
2082 dimitri 1.1 DO J=1,sNy
2083     DO I=1,sNx
2084     C AREA(I,J,bi,bj) = 0.1 _d 0 * HEFF(I,J,bi,bj)
2085     AREA(I,J,bi,bj) = AREApreTH(I,J) + 0.1 _d 0 *
2086     & ( HEFF(I,J,bi,bj) - HEFFpreTH(I,J) )
2087     ENDDO
2088     ENDDO
2089 dimitri 1.2 #endif
2090 dimitri 1.1 ENDIF
2091     #endif
2092 torge 1.3 #ifdef SEAICE_ITD
2093     C check categories for consistency with limits after growth/melt
2094     CALL SEAICE_ITD_REDIST(bi, bj, myTime,myIter,myThid)
2095     C finally update total AREA, HEFF, HSNOW
2096     CALL SEAICE_ITD_SUM(bi, bj, myTime,myIter,myThid)
2097     #endif
2098 dimitri 1.1
2099     C ===================================================================
2100     C =============PART 5: determine ice salinity increments=============
2101     C ===================================================================
2102    
2103     #ifndef SEAICE_VARIABLE_SALINITY
2104     # if (defined ALLOW_AUTODIFF_TAMC && defined ALLOW_SALT_PLUME)
2105     CADJ STORE d_HEFFbyNEG = comlev1_bibj,key=iicekey,byte=isbyte
2106     CADJ STORE d_HEFFbyOCNonICE = comlev1_bibj,key=iicekey,byte=isbyte
2107     CADJ STORE d_HEFFbyATMonOCN = comlev1_bibj,key=iicekey,byte=isbyte
2108     CADJ STORE d_HEFFbyATMonOCN_open = comlev1_bibj,key=iicekey,byte=isbyte
2109     CADJ STORE d_HEFFbyATMonOCN_cover = comlev1_bibj,key=iicekey,byte=isbyte
2110     CADJ STORE d_HEFFbyFLOODING = comlev1_bibj,key=iicekey,byte=isbyte
2111     CADJ STORE d_HEFFbySublim = comlev1_bibj,key=iicekey,byte=isbyte
2112     CADJ STORE salt(:,:,kSurface,bi,bj) = comlev1_bibj,
2113     CADJ & key = iicekey, byte = isbyte
2114     # endif /* ALLOW_AUTODIFF_TAMC and ALLOW_SALT_PLUME */
2115     DO J=1,sNy
2116     DO I=1,sNx
2117     tmpscal1 = d_HEFFbyNEG(I,J) + d_HEFFbyOCNonICE(I,J) +
2118     & d_HEFFbyATMonOCN(I,J) + d_HEFFbyFLOODING(I,J)
2119     & + d_HEFFbySublim(I,J)
2120 torge 1.10 #ifdef EXF_ALLOW_SEAICE_RELAX
2121     & + d_HEFFbyRLX(I,J)
2122 dimitri 1.1 #endif
2123     tmpscal2 = tmpscal1 * SEAICE_salt0 * HEFFM(I,J,bi,bj)
2124     & * recip_deltaTtherm * SEAICE_rhoIce
2125     saltFlux(I,J,bi,bj) = tmpscal2
2126     #ifdef ALLOW_SALT_PLUME
2127     tmpscal3 = tmpscal1*salt(I,J,kSurface,bi,bj)*HEFFM(I,J,bi,bj)
2128     & * recip_deltaTtherm * SEAICE_rhoIce
2129     saltPlumeFlux(I,J,bi,bj) = MAX( tmpscal3-tmpscal2 , 0. _d 0)
2130     & *SPsalFRAC
2131     #endif /* ALLOW_SALT_PLUME */
2132     ENDDO
2133     ENDDO
2134     #endif /* ndef SEAICE_VARIABLE_SALINITY */
2135    
2136     #ifdef SEAICE_VARIABLE_SALINITY
2137    
2138     #ifdef SEAICE_GROWTH_LEGACY
2139     # ifdef ALLOW_AUTODIFF_TAMC
2140     CADJ STORE hsalt(:,:,bi,bj) = comlev1_bibj,key=iicekey,byte=isbyte
2141     # endif /* ALLOW_AUTODIFF_TAMC */
2142     DO J=1,sNy
2143     DO I=1,sNx
2144     C set HSALT = 0 if HSALT < 0 and compute salt to remove from ocean
2145     IF ( HSALT(I,J,bi,bj) .LT. 0.0 ) THEN
2146     saltFluxAdjust(I,J) = - HEFFM(I,J,bi,bj) *
2147     & HSALT(I,J,bi,bj) * recip_deltaTtherm
2148     HSALT(I,J,bi,bj) = 0.0 _d 0
2149     ENDIF
2150     ENDDO
2151     ENDDO
2152     #endif /* SEAICE_GROWTH_LEGACY */
2153    
2154     #ifdef ALLOW_AUTODIFF_TAMC
2155     CADJ STORE hsalt(:,:,bi,bj) = comlev1_bibj,key=iicekey,byte=isbyte
2156     #endif /* ALLOW_AUTODIFF_TAMC */
2157    
2158     DO J=1,sNy
2159     DO I=1,sNx
2160     C sum up the terms that affect the salt content of the ice pack
2161     tmpscal1=d_HEFFbyOCNonICE(I,J)+d_HEFFbyATMonOCN(I,J)
2162    
2163     C recompute HEFF before thermodynamic updates (which is not AREApreTH in legacy code)
2164     tmpscal2=HEFF(I,J,bi,bj)-tmpscal1-d_HEFFbyFLOODING(I,J)
2165     C tmpscal1 > 0 : m of sea ice that is created
2166     IF ( tmpscal1 .GE. 0.0 ) THEN
2167     saltFlux(I,J,bi,bj) =
2168     & HEFFM(I,J,bi,bj)*recip_deltaTtherm
2169     & *SEAICE_saltFrac*salt(I,J,kSurface,bi,bj)
2170     & *tmpscal1*SEAICE_rhoIce
2171     #ifdef ALLOW_SALT_PLUME
2172     C saltPlumeFlux is defined only during freezing:
2173     saltPlumeFlux(I,J,bi,bj)=
2174     & HEFFM(I,J,bi,bj)*recip_deltaTtherm
2175     & *(ONE-SEAICE_saltFrac)*salt(I,J,kSurface,bi,bj)
2176     & *tmpscal1*SEAICE_rhoIce
2177     & *SPsalFRAC
2178     C if SaltPlumeSouthernOcean=.FALSE. turn off salt plume in Southern Ocean
2179     IF ( .NOT. SaltPlumeSouthernOcean ) THEN
2180     IF ( YC(I,J,bi,bj) .LT. 0.0 _d 0 )
2181     & saltPlumeFlux(i,j,bi,bj) = 0.0 _d 0
2182     ENDIF
2183     #endif /* ALLOW_SALT_PLUME */
2184    
2185     C tmpscal1 < 0 : m of sea ice that is melted
2186     ELSE
2187     saltFlux(I,J,bi,bj) =
2188     & HEFFM(I,J,bi,bj)*recip_deltaTtherm
2189     & *HSALT(I,J,bi,bj)
2190     & *tmpscal1/tmpscal2
2191     #ifdef ALLOW_SALT_PLUME
2192     saltPlumeFlux(i,j,bi,bj) = 0.0 _d 0
2193     #endif /* ALLOW_SALT_PLUME */
2194     ENDIF
2195     C update HSALT based on surface saltFlux
2196     HSALT(I,J,bi,bj) = HSALT(I,J,bi,bj) +
2197     & saltFlux(I,J,bi,bj) * SEAICE_deltaTtherm
2198     saltFlux(I,J,bi,bj) =
2199     & saltFlux(I,J,bi,bj) + saltFluxAdjust(I,J)
2200     #ifdef SEAICE_GROWTH_LEGACY
2201     C set HSALT = 0 if HEFF = 0 and compute salt to dump into ocean
2202     IF ( HEFF(I,J,bi,bj) .EQ. 0.0 ) THEN
2203     saltFlux(I,J,bi,bj) = saltFlux(I,J,bi,bj) -
2204     & HEFFM(I,J,bi,bj) * HSALT(I,J,bi,bj) * recip_deltaTtherm
2205     HSALT(I,J,bi,bj) = 0.0 _d 0
2206     #ifdef ALLOW_SALT_PLUME
2207     saltPlumeFlux(i,j,bi,bj) = 0.0 _d 0
2208     #endif /* ALLOW_SALT_PLUME */
2209     ENDIF
2210     #endif /* SEAICE_GROWTH_LEGACY */
2211     ENDDO
2212     ENDDO
2213     #endif /* SEAICE_VARIABLE_SALINITY */
2214    
2215     C =======================================================================
2216     C ==LEGACY PART 6 (LEGACY) treat pathological cases, then do flooding ===
2217     C =======================================================================
2218    
2219     #ifdef SEAICE_GROWTH_LEGACY
2220    
2221     C treat values of ice cover fraction oustide
2222     C the [0 1] range, and other such issues.
2223     C ===========================================
2224    
2225     Cgf note: this part cannot be heat and water conserving
2226    
2227     #ifdef ALLOW_AUTODIFF_TAMC
2228     CADJ STORE area(:,:,bi,bj) = comlev1_bibj,
2229     CADJ & key = iicekey, byte = isbyte
2230     CADJ STORE heff(:,:,bi,bj) = comlev1_bibj,
2231     CADJ & key = iicekey, byte = isbyte
2232     #endif /* ALLOW_AUTODIFF_TAMC */
2233     DO J=1,sNy
2234     DO I=1,sNx
2235     C NOW SET AREA(I,J,bi,bj)=0 WHERE THERE IS NO ICE
2236     CML replaced "/.0001 _d 0" by "*1. _d 4", 1e-4 is probably
2237     CML meant to be something like a minimum thickness
2238     AREA(I,J,bi,bj)=MIN(AREA(I,J,bi,bj),HEFF(I,J,bi,bj)*1. _d 4)
2239     ENDDO
2240     ENDDO
2241    
2242     #ifdef ALLOW_AUTODIFF_TAMC
2243     CADJ STORE area(:,:,bi,bj) = comlev1_bibj,
2244     CADJ & key = iicekey, byte = isbyte
2245     #endif /* ALLOW_AUTODIFF_TAMC */
2246     DO J=1,sNy
2247     DO I=1,sNx
2248     C NOW TRUNCATE AREA
2249     AREA(I,J,bi,bj)=MIN(ONE,AREA(I,J,bi,bj))
2250     ENDDO
2251     ENDDO
2252    
2253     #ifdef ALLOW_AUTODIFF_TAMC
2254     CADJ STORE area(:,:,bi,bj) = comlev1_bibj,
2255     CADJ & key = iicekey, byte = isbyte
2256     CADJ STORE hsnow(:,:,bi,bj) = comlev1_bibj,
2257     CADJ & key = iicekey, byte = isbyte
2258     #endif /* ALLOW_AUTODIFF_TAMC */
2259     DO J=1,sNy
2260     DO I=1,sNx
2261     AREA(I,J,bi,bj) = MAX(ZERO,AREA(I,J,bi,bj))
2262     HSNOW(I,J,bi,bj) = MAX(ZERO,HSNOW(I,J,bi,bj))
2263     AREA(I,J,bi,bj) = AREA(I,J,bi,bj)*HEFFM(I,J,bi,bj)
2264     HEFF(I,J,bi,bj) = HEFF(I,J,bi,bj)*HEFFM(I,J,bi,bj)
2265     #ifdef SEAICE_CAP_HEFF
2266     C This is not energy conserving, but at least it conserves fresh water
2267     tmpscal0 = -MAX(HEFF(I,J,bi,bj)-MAX_HEFF,0. _d 0)
2268     d_HEFFbyNeg(I,J) = d_HEFFbyNeg(I,J) + tmpscal0
2269     HEFF(I,J,bi,bj) = HEFF(I,J,bi,bj) + tmpscal0
2270     #endif /* SEAICE_CAP_HEFF */
2271     HSNOW(I,J,bi,bj) = HSNOW(I,J,bi,bj)*HEFFM(I,J,bi,bj)
2272     ENDDO
2273     ENDDO
2274    
2275     C convert snow to ice if submerged.
2276     C =================================
2277    
2278     IF ( SEAICEuseFlooding ) THEN
2279     DO J=1,sNy
2280     DO I=1,sNx
2281     tmpscal0 = (HSNOW(I,J,bi,bj)*SEAICE_rhoSnow
2282     & +HEFF(I,J,bi,bj)*SEAICE_rhoIce)*recip_rhoConst
2283     tmpscal1 = MAX( 0. _d 0, tmpscal0 - HEFF(I,J,bi,bj))
2284     d_HEFFbyFLOODING(I,J)=tmpscal1
2285     HEFF(I,J,bi,bj) = HEFF(I,J,bi,bj)+d_HEFFbyFLOODING(I,J)
2286     HSNOW(I,J,bi,bj) = HSNOW(I,J,bi,bj)-
2287     & d_HEFFbyFLOODING(I,J)*ICE2SNOW
2288     ENDDO
2289     ENDDO
2290     ENDIF
2291    
2292     #endif /* SEAICE_GROWTH_LEGACY */
2293    
2294     #ifdef ALLOW_SITRACER
2295     DO J=1,sNy
2296     DO I=1,sNx
2297 torge 1.10 C needs to be here to allow use also with LEGACY branch
2298 dimitri 1.1 SItrHEFF(I,J,bi,bj,5)=HEFF(I,J,bi,bj)
2299     ENDDO
2300     ENDDO
2301     #endif /* ALLOW_SITRACER */
2302    
2303     C ===================================================================
2304     C ==============PART 7: determine ocean model forcing================
2305     C ===================================================================
2306    
2307     C compute net heat flux leaving/entering the ocean,
2308     C accounting for the part used in melt/freeze processes
2309     C =====================================================
2310    
2311 torge 1.8 #ifdef SEAICE_ITD
2312     C compute total of "mult" fluxes for ocean forcing
2313     DO J=1,sNy
2314     DO I=1,sNx
2315     a_QbyATM_cover(I,J) = 0.0 _d 0
2316     r_QbyATM_cover(I,J) = 0.0 _d 0
2317     a_QSWbyATM_cover(I,J) = 0.0 _d 0
2318     r_FWbySublim(I,J) = 0.0 _d 0
2319     ENDDO
2320     ENDDO
2321     DO IT=1,nITD
2322     DO J=1,sNy
2323     DO I=1,sNx
2324     cToM if fluxes in W/m^2 then
2325     c a_QbyATM_cover(I,J)=a_QbyATM_cover(I,J)
2326     c & + a_QbyATMmult_cover(I,J,IT) * areaFracFactor(I,J,IT)
2327     c r_QbyATM_cover(I,J)=r_QbyATM_cover(I,J)
2328     c & + r_QbyATMmult_cover(I,J,IT) * areaFracFactor(I,J,IT)
2329     c a_QSWbyATM_cover(I,J)=a_QSWbyATM_cover(I,J)
2330     c & + a_QSWbyATMmult_cover(I,J,IT) * areaFracFactor(I,J,IT)
2331     c r_FWbySublim(I,J)=r_FWbySublim(I,J)
2332     c & + r_FWbySublimMult(I,J,IT) * areaFracFactor(I,J,IT)
2333     cToM if fluxes in effective ice meters, i.e. ice volume per area, then
2334     a_QbyATM_cover(I,J)=a_QbyATM_cover(I,J)
2335     & + a_QbyATMmult_cover(I,J,IT)
2336     r_QbyATM_cover(I,J)=r_QbyATM_cover(I,J)
2337     & + r_QbyATMmult_cover(I,J,IT)
2338     a_QSWbyATM_cover(I,J)=a_QSWbyATM_cover(I,J)
2339     & + a_QSWbyATMmult_cover(I,J,IT)
2340     r_FWbySublim(I,J)=r_FWbySublim(I,J)
2341     & + r_FWbySublimMult(I,J,IT)
2342     ENDDO
2343     ENDDO
2344     ENDDO
2345     #endif
2346    
2347 dimitri 1.1 #ifdef ALLOW_AUTODIFF_TAMC
2348     CADJ STORE d_hsnwbyneg = comlev1_bibj,key=iicekey,byte=isbyte
2349     CADJ STORE d_hsnwbyocnonsnw = comlev1_bibj,key=iicekey,byte=isbyte
2350     #endif /* ALLOW_AUTODIFF_TAMC */
2351    
2352     DO J=1,sNy
2353     DO I=1,sNx
2354     QNET(I,J,bi,bj) = r_QbyATM_cover(I,J) + r_QbyATM_open(I,J)
2355     #ifndef SEAICE_GROWTH_LEGACY
2356     C in principle a_QSWbyATM_cover should always be included here, however
2357     C for backward compatibility it is left out of the LEGACY branch
2358     & + a_QSWbyATM_cover(I,J)
2359     #endif /* SEAICE_GROWTH_LEGACY */
2360 torge 1.10 & - ( d_HEFFbyOCNonICE(I,J)
2361     & + d_HSNWbyOCNonSNW(I,J)*SNOW2ICE
2362     & + d_HEFFbyNEG(I,J)
2363     #ifdef EXF_ALLOW_SEAICE_RELAX
2364     & + d_HEFFbyRLX(I,J)
2365     #endif
2366     & + d_HSNWbyNEG(I,J)*SNOW2ICE
2367     & - convertPRECIP2HI *
2368     & snowPrecip(i,j,bi,bj) * (ONE-AREApreTH(I,J))
2369     & ) * maskC(I,J,kSurface,bi,bj)
2370     ENDDO
2371     ENDDO
2372     DO J=1,sNy
2373     DO I=1,sNx
2374 dimitri 1.1 QSW(I,J,bi,bj) = a_QSWbyATM_cover(I,J) + a_QSWbyATM_open(I,J)
2375     ENDDO
2376     ENDDO
2377    
2378     C switch heat fluxes from 'effective' ice meters to W/m2
2379     C ======================================================
2380    
2381     DO J=1,sNy
2382     DO I=1,sNx
2383     QNET(I,J,bi,bj) = QNET(I,J,bi,bj)*convertHI2Q
2384     QSW(I,J,bi,bj) = QSW(I,J,bi,bj)*convertHI2Q
2385     ENDDO
2386     ENDDO
2387    
2388     #ifndef SEAICE_DISABLE_HEATCONSFIX
2389     C treat advective heat flux by ocean to ice water exchange (at 0decC)
2390     C ===================================================================
2391     # ifdef ALLOW_AUTODIFF_TAMC
2392     CADJ STORE d_HEFFbyNEG = comlev1_bibj,key=iicekey,byte=isbyte
2393     CADJ STORE d_HEFFbyOCNonICE = comlev1_bibj,key=iicekey,byte=isbyte
2394     CADJ STORE d_HEFFbyATMonOCN = comlev1_bibj,key=iicekey,byte=isbyte
2395     CADJ STORE d_HSNWbyNEG = comlev1_bibj,key=iicekey,byte=isbyte
2396     CADJ STORE d_HSNWbyOCNonSNW = comlev1_bibj,key=iicekey,byte=isbyte
2397     CADJ STORE d_HSNWbyATMonSNW = comlev1_bibj,key=iicekey,byte=isbyte
2398     CADJ STORE theta(:,:,kSurface,bi,bj) = comlev1_bibj,
2399     CADJ & key = iicekey, byte = isbyte
2400     # endif /* ALLOW_AUTODIFF_TAMC */
2401 torge 1.10 cgf Unlike for evap and precip, the temperature of gained/lost
2402     C ocean liquid water due to melt/freeze of solid water cannot be chosen
2403     C arbitrarily to be e.g. the ocean SST. Indeed the present seaice model
2404     C implies a constant ice temperature of 0degC. If melt/freeze water is exchanged
2405     C at a different temperature, it leads to a loss of conservation in the
2406     C ocean+ice system. While this is mostly a serious issue in the
2407     C real fresh water + non linear free surface framework, a mismatch
2408     C between ice and ocean boundary condition can result in all cases.
2409     C Below we therefore anticipate on external_forcing_surf.F
2410     C to diagnoze and/or apply the correction to QNET.
2411 dimitri 1.1 DO J=1,sNy
2412     DO I=1,sNx
2413 torge 1.10 C ocean water going to ice/snow, in precip units
2414     tmpscal3=rhoConstFresh*maskC(I,J,kSurface,bi,bj)*(
2415 dimitri 1.1 & ( d_HSNWbyATMonSNW(I,J)*SNOW2ICE
2416     & + d_HSNWbyOCNonSNW(I,J)*SNOW2ICE
2417     & + d_HEFFbyOCNonICE(I,J) + d_HEFFbyATMonOCN(I,J)
2418     & + d_HEFFbyNEG(I,J) + d_HSNWbyNEG(I,J)*SNOW2ICE )
2419     & * convertHI2PRECIP
2420 torge 1.10 & - snowPrecip(i,j,bi,bj) * (ONE-AREApreTH(I,J)) )
2421     C factor in the heat content as done in external_forcing_surf.F
2422     IF ( (temp_EvPrRn.NE.UNSET_RL).AND.useRealFreshWaterFlux
2423     & .AND.(nonlinFreeSurf.NE.0) ) THEN
2424     tmpscal1 = - tmpscal3*
2425 dimitri 1.1 & HeatCapacity_Cp * temp_EvPrRn
2426 torge 1.10 ELSEIF ( (temp_EvPrRn.EQ.UNSET_RL).AND.useRealFreshWaterFlux
2427     & .AND.(nonlinFreeSurf.NE.0) ) THEN
2428     tmpscal1 = - tmpscal3*
2429 dimitri 1.1 & HeatCapacity_Cp * theta(I,J,kSurface,bi,bj)
2430 torge 1.10 ELSEIF ( (temp_EvPrRn.NE.UNSET_RL) ) THEN
2431     tmpscal1 = - tmpscal3*HeatCapacity_Cp*
2432     & ( temp_EvPrRn - theta(I,J,kSurface,bi,bj) )
2433     ELSEIF ( (temp_EvPrRn.EQ.UNSET_RL) ) THEN
2434     tmpscal1 = ZERO
2435     ENDIF
2436 dimitri 1.1 #ifdef ALLOW_DIAGNOSTICS
2437 torge 1.10 C in all cases, diagnoze the boundary condition mismatch to SIaaflux
2438     DIAGarrayA(I,J)=tmpscal1
2439 dimitri 1.1 #endif
2440 torge 1.10 C remove the mismatch when real fresh water is exchanged (at 0degC here)
2441     IF ( useRealFreshWaterFlux.AND.(nonlinFreeSurf.GT.0).AND.
2442     & SEAICEheatConsFix ) QNET(I,J,bi,bj)=QNET(I,J,bi,bj)+tmpscal1
2443 dimitri 1.1 ENDDO
2444     ENDDO
2445     #ifdef ALLOW_DIAGNOSTICS
2446     CALL DIAGNOSTICS_FILL(DIAGarrayA,
2447     & 'SIaaflux',0,1,3,bi,bj,myThid)
2448     #endif
2449 torge 1.10 #endif /* ndef SEAICE_DISABLE_HEATCONSFIX */
2450    
2451     C compute the net heat flux, incl. adv. by water, entering ocean+ice
2452     C ===================================================================
2453     DO J=1,sNy
2454     DO I=1,sNx
2455     cgf 1) SIatmQnt (analogous to qnet; excl. adv. by water exch.)
2456     CML If I consider the atmosphere above the ice, the surface flux
2457     CML which is relevant for the air temperature dT/dt Eq
2458     CML accounts for sensible and radiation (with different treatment
2459     CML according to wave-length) fluxes but not for "latent heat flux",
2460     CML since it does not contribute to heating the air.
2461     CML So this diagnostic is only good for heat budget calculations within
2462     CML the ice-ocean system.
2463     SIatmQnt(I,J,bi,bj) =
2464     & maskC(I,J,kSurface,bi,bj)*convertHI2Q*(
2465     #ifndef SEAICE_GROWTH_LEGACY
2466     & a_QSWbyATM_cover(I,J) +
2467     #endif /* SEAICE_GROWTH_LEGACY */
2468     & a_QbyATM_cover(I,J) + a_QbyATM_open(I,J) )
2469     cgf 2) SItflux (analogous to tflux; includes advection by water
2470     C exchanged between atmosphere and ocean+ice)
2471     C solid water going to atm, in precip units
2472     tmpscal1 = rhoConstFresh*maskC(I,J,kSurface,bi,bj)
2473     & * convertHI2PRECIP * ( - d_HSNWbyRAIN(I,J)*SNOW2ICE
2474     & + a_FWbySublim(I,J) - r_FWbySublim(I,J) )
2475     C liquid water going to atm, in precip units
2476     tmpscal2=rhoConstFresh*maskC(I,J,kSurface,bi,bj)*
2477     & ( ( EVAP(I,J,bi,bj)-PRECIP(I,J,bi,bj) )
2478     & * ( ONE - AREApreTH(I,J) )
2479     #ifdef ALLOW_RUNOFF
2480     & - RUNOFF(I,J,bi,bj)
2481     #endif /* ALLOW_RUNOFF */
2482     & + ( d_HFRWbyRAIN(I,J) + r_FWbySublim(I,J) )
2483     & *convertHI2PRECIP )
2484     C In real fresh water flux + nonlinFS, we factor in the advected specific
2485     C energy (referenced to 0 for 0deC liquid water). In virtual salt flux or
2486     C linFS, rain/evap get a special treatment (see external_forcing_surf.F).
2487     tmpscal1= - tmpscal1*
2488     & ( -SEAICE_lhFusion + HeatCapacity_Cp * ZERO )
2489     IF ( (temp_EvPrRn.NE.UNSET_RL).AND.useRealFreshWaterFlux
2490     & .AND.(nonlinFreeSurf.NE.0) ) THEN
2491     tmpscal2= - tmpscal2*
2492     & ( ZERO + HeatCapacity_Cp * temp_EvPrRn )
2493     ELSEIF ( (temp_EvPrRn.EQ.UNSET_RL).AND.useRealFreshWaterFlux
2494     & .AND.(nonlinFreeSurf.NE.0) ) THEN
2495     tmpscal2= - tmpscal2*
2496     & ( ZERO + HeatCapacity_Cp * theta(I,J,kSurface,bi,bj) )
2497     ELSEIF ( (temp_EvPrRn.NE.UNSET_RL) ) THEN
2498     tmpscal2= - tmpscal2*HeatCapacity_Cp*
2499     & ( temp_EvPrRn - theta(I,J,kSurface,bi,bj) )
2500     ELSEIF ( (temp_EvPrRn.EQ.UNSET_RL) ) THEN
2501     tmpscal2= ZERO
2502 dimitri 1.1 ENDIF
2503 torge 1.10 SItflux(I,J,bi,bj)=
2504     & SIatmQnt(I,J,bi,bj)-tmpscal1-tmpscal2
2505     ENDDO
2506     ENDDO
2507 dimitri 1.1
2508     C compute net fresh water flux leaving/entering
2509     C the ocean, accounting for fresh/salt water stocks.
2510     C ==================================================
2511    
2512     #ifdef ALLOW_ATM_TEMP
2513     DO J=1,sNy
2514     DO I=1,sNx
2515     tmpscal1= d_HSNWbyATMonSNW(I,J)*SNOW2ICE
2516     & +d_HFRWbyRAIN(I,J)
2517     & +d_HSNWbyOCNonSNW(I,J)*SNOW2ICE
2518     & +d_HEFFbyOCNonICE(I,J)
2519     & +d_HEFFbyATMonOCN(I,J)
2520     & +d_HEFFbyNEG(I,J)
2521 torge 1.10 #ifdef EXF_ALLOW_SEAICE_RELAX
2522 dimitri 1.1 & +d_HEFFbyRLX(I,J)
2523     #endif
2524     & +d_HSNWbyNEG(I,J)*SNOW2ICE
2525     C If r_FWbySublim>0, then it is evaporated from ocean.
2526     & +r_FWbySublim(I,J)
2527     EmPmR(I,J,bi,bj) = maskC(I,J,kSurface,bi,bj)*(
2528     & ( EVAP(I,J,bi,bj)-PRECIP(I,J,bi,bj) )
2529     & * ( ONE - AREApreTH(I,J) )
2530     #ifdef ALLOW_RUNOFF
2531     & - RUNOFF(I,J,bi,bj)
2532     #endif /* ALLOW_RUNOFF */
2533     & + tmpscal1*convertHI2PRECIP
2534     & )*rhoConstFresh
2535 torge 1.10 c and the flux leaving/entering the ocean+ice
2536     SIatmFW(I,J,bi,bj) = maskC(I,J,kSurface,bi,bj)*(
2537     & EVAP(I,J,bi,bj)*( ONE - AREApreTH(I,J) )
2538     & - PRECIP(I,J,bi,bj)
2539     #ifdef ALLOW_RUNOFF
2540     & - RUNOFF(I,J,bi,bj)
2541     #endif /* ALLOW_RUNOFF */
2542     & )*rhoConstFresh
2543     & + a_FWbySublim(I,J) * SEAICE_rhoIce * recip_deltaTtherm
2544    
2545 dimitri 1.1 ENDDO
2546 torge 1.10 ENDDO
2547 dimitri 1.1
2548     #ifdef ALLOW_SSH_GLOBMEAN_COST_CONTRIBUTION
2549     C--
2550     DO J=1,sNy
2551     DO I=1,sNx
2552     frWtrAtm(I,J,bi,bj) = maskC(I,J,kSurface,bi,bj)*(
2553     & PRECIP(I,J,bi,bj)
2554     & - EVAP(I,J,bi,bj)*( ONE - AREApreTH(I,J) )
2555     # ifdef ALLOW_RUNOFF
2556     & + RUNOFF(I,J,bi,bj)
2557     # endif /* ALLOW_RUNOFF */
2558     & )*rhoConstFresh
2559     # ifdef SEAICE_ADD_SUBLIMATION_TO_FWBUDGET
2560     & - a_FWbySublim(I,J)*AREApreTH(I,J)
2561     # endif /* SEAICE_ADD_SUBLIMATION_TO_FWBUDGET */
2562     ENDDO
2563     ENDDO
2564     C--
2565     #else /* ndef ALLOW_SSH_GLOBMEAN_COST_CONTRIBUTION */
2566     C--
2567     # ifdef ALLOW_MEAN_SFLUX_COST_CONTRIBUTION
2568     DO J=1,sNy
2569     DO I=1,sNx
2570     frWtrAtm(I,J,bi,bj) = maskC(I,J,kSurface,bi,bj)*(
2571     & PRECIP(I,J,bi,bj)
2572     & - EVAP(I,J,bi,bj)
2573     & *( ONE - AREApreTH(I,J) )
2574     # ifdef ALLOW_RUNOFF
2575     & + RUNOFF(I,J,bi,bj)
2576     # endif /* ALLOW_RUNOFF */
2577     & )*rhoConstFresh
2578     & - a_FWbySublim(I,J) * SEAICE_rhoIce * recip_deltaTtherm
2579     ENDDO
2580     ENDDO
2581     # endif
2582     C--
2583     #endif /* ALLOW_SSH_GLOBMEAN_COST_CONTRIBUTION */
2584    
2585     #endif /* ALLOW_ATM_TEMP */
2586    
2587     #ifdef SEAICE_DEBUG
2588     CALL PLOT_FIELD_XYRL( QSW,'Current QSW ', myIter, myThid )
2589     CALL PLOT_FIELD_XYRL( QNET,'Current QNET ', myIter, myThid )
2590     CALL PLOT_FIELD_XYRL( EmPmR,'Current EmPmR ', myIter, myThid )
2591     #endif /* SEAICE_DEBUG */
2592    
2593     C Sea Ice Load on the sea surface.
2594     C =================================
2595    
2596     #ifdef ALLOW_AUTODIFF_TAMC
2597     CADJ STORE heff(:,:,bi,bj) = comlev1_bibj,key=iicekey,byte=isbyte
2598     CADJ STORE hsnow(:,:,bi,bj) = comlev1_bibj,key=iicekey,byte=isbyte
2599     #endif /* ALLOW_AUTODIFF_TAMC */
2600    
2601     IF ( useRealFreshWaterFlux ) THEN
2602     DO J=1,sNy
2603     DO I=1,sNx
2604     #ifdef SEAICE_CAP_ICELOAD
2605     tmpscal1 = HEFF(I,J,bi,bj)*SEAICE_rhoIce
2606     & + HSNOW(I,J,bi,bj)*SEAICE_rhoSnow
2607     tmpscal2 = MIN(tmpscal1,heffTooHeavy*rhoConst)
2608     #else
2609     tmpscal2 = HEFF(I,J,bi,bj)*SEAICE_rhoIce
2610     & + HSNOW(I,J,bi,bj)*SEAICE_rhoSnow
2611     #endif
2612     sIceLoad(i,j,bi,bj) = tmpscal2
2613     ENDDO
2614     ENDDO
2615     ENDIF
2616    
2617 torge 1.10 #ifdef ALLOW_BALANCE_FLUXES
2618     C Compute tile integrals of heat/fresh water fluxes to/from atm.
2619     C ==============================================================
2620     FWFsiTile(bi,bj) = 0. _d 0
2621     IF ( balanceEmPmR ) THEN
2622     DO j=1,sNy
2623     DO i=1,sNx
2624     FWFsiTile(bi,bj) =
2625     & FWFsiTile(bi,bj) + SIatmFW(i,j,bi,bj)
2626     & * rA(i,j,bi,bj) * maskInC(i,j,bi,bj)
2627     ENDDO
2628     ENDDO
2629     ENDIF
2630     c to translate global mean FWF adjustements (see below) we may need :
2631     FWF2HFsiTile(bi,bj) = 0. _d 0
2632     IF ( balanceEmPmR.AND.(temp_EvPrRn.EQ.UNSET_RL) ) THEN
2633     DO j=1,sNy
2634     DO i=1,sNx
2635     FWF2HFsiTile(bi,bj) = FWF2HFsiTile(bi,bj) +
2636     & HeatCapacity_Cp * theta(I,J,kSurface,bi,bj)
2637     & * rA(i,j,bi,bj) * maskInC(i,j,bi,bj)
2638     ENDDO
2639     ENDDO
2640     ENDIF
2641     HFsiTile(bi,bj) = 0. _d 0
2642     IF ( balanceQnet ) THEN
2643     DO j=1,sNy
2644     DO i=1,sNx
2645     HFsiTile(bi,bj) =
2646     & HFsiTile(bi,bj) + SItflux(i,j,bi,bj)
2647     & * rA(i,j,bi,bj) * maskInC(i,j,bi,bj)
2648     ENDDO
2649     ENDDO
2650     ENDIF
2651     #endif
2652    
2653 dimitri 1.1 C ===================================================================
2654     C ======================PART 8: diagnostics==========================
2655     C ===================================================================
2656    
2657     #ifdef ALLOW_DIAGNOSTICS
2658     IF ( useDiagnostics ) THEN
2659     tmpscal1=1. _d 0 * recip_deltaTtherm
2660     CALL DIAGNOSTICS_SCALE_FILL(a_QbyATM_cover,
2661     & tmpscal1,1,'SIaQbATC',0,1,3,bi,bj,myThid)
2662     CALL DIAGNOSTICS_SCALE_FILL(a_QbyATM_open,
2663     & tmpscal1,1,'SIaQbATO',0,1,3,bi,bj,myThid)
2664     CALL DIAGNOSTICS_SCALE_FILL(a_QbyOCN,
2665     & tmpscal1,1,'SIaQbOCN',0,1,3,bi,bj,myThid)
2666     CALL DIAGNOSTICS_SCALE_FILL(d_HEFFbyOCNonICE,
2667     & tmpscal1,1,'SIdHbOCN',0,1,3,bi,bj,myThid)
2668     CALL DIAGNOSTICS_SCALE_FILL(d_HEFFbyATMonOCN_cover,
2669     & tmpscal1,1,'SIdHbATC',0,1,3,bi,bj,myThid)
2670     CALL DIAGNOSTICS_SCALE_FILL(d_HEFFbyATMonOCN_open,
2671     & tmpscal1,1,'SIdHbATO',0,1,3,bi,bj,myThid)
2672     CALL DIAGNOSTICS_SCALE_FILL(d_HEFFbyFLOODING,
2673     & tmpscal1,1,'SIdHbFLO',0,1,3,bi,bj,myThid)
2674     CALL DIAGNOSTICS_SCALE_FILL(d_HSNWbyOCNonSNW,
2675     & tmpscal1,1,'SIdSbOCN',0,1,3,bi,bj,myThid)
2676     CALL DIAGNOSTICS_SCALE_FILL(d_HSNWbyATMonSNW,
2677     & tmpscal1,1,'SIdSbATC',0,1,3,bi,bj,myThid)
2678     CALL DIAGNOSTICS_SCALE_FILL(d_AREAbyATM,
2679     & tmpscal1,1,'SIdAbATO',0,1,3,bi,bj,myThid)
2680     CALL DIAGNOSTICS_SCALE_FILL(d_AREAbyICE,
2681     & tmpscal1,1,'SIdAbATC',0,1,3,bi,bj,myThid)
2682     CALL DIAGNOSTICS_SCALE_FILL(d_AREAbyOCN,
2683     & tmpscal1,1,'SIdAbOCN',0,1,3,bi,bj,myThid)
2684     CALL DIAGNOSTICS_SCALE_FILL(r_QbyATM_open,
2685     & convertHI2Q,1, 'SIqneto ',0,1,3,bi,bj,myThid)
2686     CALL DIAGNOSTICS_SCALE_FILL(r_QbyATM_cover,
2687     & convertHI2Q,1, 'SIqneti ',0,1,3,bi,bj,myThid)
2688     C three that actually need intermediate storage
2689     DO J=1,sNy
2690     DO I=1,sNx
2691     DIAGarrayA(I,J) = maskC(I,J,kSurface,bi,bj)
2692     & * d_HSNWbyRAIN(I,J)*SEAICE_rhoSnow*recip_deltaTtherm
2693     DIAGarrayB(I,J) = AREA(I,J,bi,bj)-AREApreTH(I,J)
2694     ENDDO
2695     ENDDO
2696     CALL DIAGNOSTICS_FILL(DIAGarrayA,
2697     & 'SIsnPrcp',0,1,3,bi,bj,myThid)
2698     CALL DIAGNOSTICS_SCALE_FILL(DIAGarrayB,
2699     & tmpscal1,1,'SIdA ',0,1,3,bi,bj,myThid)
2700     #ifdef ALLOW_ATM_TEMP
2701     DO J=1,sNy
2702     DO I=1,sNx
2703     DIAGarrayB(I,J) = maskC(I,J,kSurface,bi,bj) *
2704     & a_FWbySublim(I,J) * SEAICE_rhoIce * recip_deltaTtherm
2705     ENDDO
2706     ENDDO
2707     CALL DIAGNOSTICS_FILL(DIAGarrayB,
2708     & 'SIfwSubl',0,1,3,bi,bj,myThid)
2709     C
2710     DO J=1,sNy
2711     DO I=1,sNx
2712     C the actual Freshwater flux of sublimated ice, >0 decreases ice
2713     DIAGarrayA(I,J) = maskC(I,J,kSurface,bi,bj)
2714     & * (a_FWbySublim(I,J)-r_FWbySublim(I,J))
2715     & * SEAICE_rhoIce * recip_deltaTtherm
2716 torge 1.10 C the residual Freshwater flux of sublimated ice
2717 dimitri 1.1 DIAGarrayC(I,J) = maskC(I,J,kSurface,bi,bj)
2718     & * r_FWbySublim(I,J)
2719     & * SEAICE_rhoIce * recip_deltaTtherm
2720     C the latent heat flux
2721     tmpscal1= EVAP(I,J,bi,bj)*( ONE - AREApreTH(I,J) )
2722     & + r_FWbySublim(I,J)*convertHI2PRECIP
2723     tmpscal2= ( a_FWbySublim(I,J)-r_FWbySublim(I,J) )
2724     & * convertHI2PRECIP
2725     tmpscal3= SEAICE_lhEvap+SEAICE_lhFusion
2726     DIAGarrayB(I,J) = -maskC(I,J,kSurface,bi,bj)*rhoConstFresh
2727     & * ( tmpscal1*SEAICE_lhEvap + tmpscal2*tmpscal3 )
2728     ENDDO
2729     ENDDO
2730     CALL DIAGNOSTICS_FILL(DIAGarrayA,'SIacSubl',0,1,3,bi,bj,myThid)
2731     CALL DIAGNOSTICS_FILL(DIAGarrayC,'SIrsSubl',0,1,3,bi,bj,myThid)
2732     CALL DIAGNOSTICS_FILL(DIAGarrayB,'SIhl ',0,1,3,bi,bj,myThid)
2733     #endif /* ALLOW_ATM_TEMP */
2734    
2735     ENDIF
2736     #endif /* ALLOW_DIAGNOSTICS */
2737    
2738     C close bi,bj loops
2739     ENDDO
2740     ENDDO
2741    
2742 torge 1.10
2743     C ===================================================================
2744     C =========PART 9: HF/FWF global integrals and balancing=============
2745     C ===================================================================
2746    
2747     #ifdef ALLOW_BALANCE_FLUXES
2748    
2749     c 1) global sums
2750     # ifdef ALLOW_AUTODIFF_TAMC
2751     CADJ STORE FWFsiTile = comlev1, key=ikey_dynamics, kind=isbyte
2752     CADJ STORE HFsiTile = comlev1, key=ikey_dynamics, kind=isbyte
2753     CADJ STORE FWF2HFsiTile = comlev1, key=ikey_dynamics, kind=isbyte
2754     # endif /* ALLOW_AUTODIFF_TAMC */
2755     FWFsiGlob=0. _d 0
2756     IF ( balanceEmPmR )
2757     & CALL GLOBAL_SUM_TILE_RL( FWFsiTile, FWFsiGlob, myThid )
2758     FWF2HFsiGlob=0. _d 0
2759     IF ( balanceEmPmR.AND.(temp_EvPrRn.EQ.UNSET_RL) ) THEN
2760     CALL GLOBAL_SUM_TILE_RL(FWF2HFsiTile, FWF2HFsiGlob, myThid)
2761     ELSEIF ( balanceEmPmR ) THEN
2762     FWF2HFsiGlob=HeatCapacity_Cp * temp_EvPrRn * globalArea
2763     ENDIF
2764     HFsiGlob=0. _d 0
2765     IF ( balanceQnet )
2766     & CALL GLOBAL_SUM_TILE_RL( HFsiTile, HFsiGlob, myThid )
2767    
2768     c 2) global means
2769     c mean SIatmFW
2770     tmpscal0=FWFsiGlob / globalArea
2771     c corresponding mean advection by atm to ocean+ice water exchange
2772     c (if mean SIatmFW was removed uniformely from ocean)
2773     tmpscal1=FWFsiGlob / globalArea * FWF2HFsiGlob / globalArea
2774     c mean SItflux (before potential adjustement due to SIatmFW)
2775     tmpscal2=HFsiGlob / globalArea
2776     c mean SItflux (after potential adjustement due to SIatmFW)
2777     IF ( balanceEmPmR ) tmpscal2=tmpscal2-tmpscal1
2778    
2779     c 3) balancing adjustments
2780     IF ( balanceEmPmR ) THEN
2781     DO bj=myByLo(myThid),myByHi(myThid)
2782     DO bi=myBxLo(myThid),myBxHi(myThid)
2783     DO j=1-OLy,sNy+OLy
2784     DO i=1-OLx,sNx+OLx
2785     empmr(i,j,bi,bj) = empmr(i,j,bi,bj) - tmpscal0
2786     SIatmFW(i,j,bi,bj) = SIatmFW(i,j,bi,bj) - tmpscal0
2787     c adjust SItflux consistently
2788     IF ( (temp_EvPrRn.NE.UNSET_RL).AND.
2789     & useRealFreshWaterFlux.AND.(nonlinFreeSurf.NE.0) ) THEN
2790     tmpscal1=
2791     & ( ZERO + HeatCapacity_Cp * temp_EvPrRn )
2792     ELSEIF ( (temp_EvPrRn.EQ.UNSET_RL).AND.
2793     & useRealFreshWaterFlux.AND.(nonlinFreeSurf.NE.0) ) THEN
2794     tmpscal1=
2795     & ( ZERO + HeatCapacity_Cp * theta(I,J,kSurface,bi,bj) )
2796     ELSEIF ( (temp_EvPrRn.NE.UNSET_RL) ) THEN
2797     tmpscal1=
2798     & HeatCapacity_Cp*(temp_EvPrRn - theta(I,J,kSurface,bi,bj))
2799     ELSE
2800     tmpscal1=ZERO
2801     ENDIF
2802     SItflux(i,j,bi,bj) = SItflux(i,j,bi,bj) - tmpscal0*tmpscal1
2803     c no qnet or tflux adjustement is needed
2804     ENDDO
2805     ENDDO
2806     ENDDO
2807     ENDDO
2808     IF ( balancePrintMean ) THEN
2809     _BEGIN_MASTER( myThid )
2810     WRITE(msgbuf,'(a,a,e24.17)') 'rm Global mean of ',
2811     & 'SIatmFW = ', tmpscal0
2812     CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
2813     & SQUEEZE_RIGHT , myThid)
2814     _END_MASTER( myThid )
2815     ENDIF
2816     ENDIF
2817     IF ( balanceQnet ) THEN
2818     DO bj=myByLo(myThid),myByHi(myThid)
2819     DO bi=myBxLo(myThid),myBxHi(myThid)
2820     DO j=1-OLy,sNy+OLy
2821     DO i=1-OLx,sNx+OLx
2822     SItflux(i,j,bi,bj) = SItflux(i,j,bi,bj) - tmpscal2
2823     qnet(i,j,bi,bj) = qnet(i,j,bi,bj) - tmpscal2
2824     SIatmQnt(i,j,bi,bj) = SIatmQnt(i,j,bi,bj) - tmpscal2
2825     ENDDO
2826     ENDDO
2827     ENDDO
2828     ENDDO
2829     IF ( balancePrintMean ) THEN
2830     _BEGIN_MASTER( myThid )
2831     WRITE(msgbuf,'(a,a,e24.17)') 'rm Global mean of ',
2832     & 'SItflux = ', tmpscal2
2833     CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
2834     & SQUEEZE_RIGHT , myThid)
2835     _END_MASTER( myThid )
2836     ENDIF
2837     ENDIF
2838     #endif /* */
2839    
2840     #ifdef ALLOW_DIAGNOSTICS
2841     c these diags need to be done outside of the bi,bj loop so that
2842     c we may do potential global mean adjustement to them consistently.
2843     CALL DIAGNOSTICS_FILL(SItflux,
2844     & 'SItflux ',0,1,0,1,1,myThid)
2845     CALL DIAGNOSTICS_FILL(SIatmQnt,
2846     & 'SIatmQnt',0,1,0,1,1,myThid)
2847     c SIatmFW follows the same convention as empmr -- SIatmFW diag does not
2848     tmpscal1= - 1. _d 0
2849     CALL DIAGNOSTICS_SCALE_FILL(SIatmFW,
2850     & tmpscal1,1,'SIatmFW ',0,1,0,1,1,myThid)
2851     #endif /* ALLOW_DIAGNOSTICS */
2852    
2853 dimitri 1.1 RETURN
2854     END

  ViewVC Help
Powered by ViewVC 1.1.22