/[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.6 - (hide annotations) (download)
Tue Oct 2 17:06:04 2012 UTC (12 years, 10 months ago) by torge
Branch: MAIN
Changes since 1.5: +4 -10 lines
reset declaration and initialization of latentHeatFluxMaxMult to original,
meaning only used in case of SEAICE_CAP_SUBLIM

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

  ViewVC Help
Powered by ViewVC 1.1.22