/[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.5 - (hide annotations) (download)
Tue Oct 2 16:47:41 2012 UTC (12 years, 10 months ago) by torge
Branch: MAIN
Changes since 1.4: +171 -172 lines
eliminating loop index K, replaced by index IT (in one case by iTr);
cleaned out some coding mistakes with it

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

  ViewVC Help
Powered by ViewVC 1.1.22