/[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.14 - (hide annotations) (download)
Mon Dec 10 22:19:49 2012 UTC (12 years, 7 months ago) by torge
Branch: MAIN
Changes since 1.13: +144 -145 lines
include updates from main branch

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

  ViewVC Help
Powered by ViewVC 1.1.22