/[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.3 - (hide annotations) (download)
Wed Sep 26 17:50:17 2012 UTC (12 years, 10 months ago) by torge
Branch: MAIN
Changes since 1.2: +330 -157 lines
preliminary code with lots of output to standard out;
seaice_growth is not working in this version!!!

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

  ViewVC Help
Powered by ViewVC 1.1.22