/[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.13 - (hide annotations) (download)
Fri Nov 2 19:15:42 2012 UTC (12 years, 9 months ago) by torge
Branch: MAIN
Changes since 1.12: +46 -43 lines
this version yields (almost) identical results for the 1-D verification experiment using
a) no ITD and no MULTICATEGORIES
b) ITD with nITD=1
without any specific hacks in the code

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

  ViewVC Help
Powered by ViewVC 1.1.22