/[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.2 - (hide annotations) (download)
Fri Apr 27 22:25:23 2012 UTC (13 years, 3 months ago) by dimitri
Branch: MAIN
Changes since 1.1: +490 -9 lines
first check in of itd code

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

  ViewVC Help
Powered by ViewVC 1.1.22