/[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.8 - (hide annotations) (download)
Mon Oct 22 16:02:25 2012 UTC (12 years, 9 months ago) by torge
Branch: MAIN
Changes since 1.7: +281 -105 lines
seaice_model and seaice_growth adjusted to deliver runtime output for 1D_ocean_ice_column;
this version of seaice_growth finally works,
though it is particularly designed for the case nITD=1 and #undef SEAICE_MULTICATEGORY,
then running the 1D verification experiment over 365 deays with
1) #undef SEAICE_ITD and
2) #define SEAICE_ITD
results in no difference for AREA and HEFF

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

  ViewVC Help
Powered by ViewVC 1.1.22