/[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.19 - (hide annotations) (download)
Fri May 3 18:59:40 2013 UTC (12 years, 3 months ago) by torge
Branch: MAIN
Changes since 1.18: +28 -33 lines
removing all "ToM" comments

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

  ViewVC Help
Powered by ViewVC 1.1.22