/[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.16 - (hide annotations) (download)
Wed Mar 27 18:59:52 2013 UTC (12 years, 4 months ago) by torge
Branch: MAIN
Changes since 1.15: +3 -178 lines
updating my MITgcm_contrib directory to include latest changes on main branch;
settings are to run a 1D test szenario with ITD code and 7 categories

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

  ViewVC Help
Powered by ViewVC 1.1.22