/[MITgcm]/MITgcm/pkg/seaice/seaice_growth.F
ViewVC logotype

Annotation of /MITgcm/pkg/seaice/seaice_growth.F

Parent Directory Parent Directory | Revision Log Revision Log | View Revision Graph Revision Graph


Revision 1.212 - (hide annotations) (download)
Tue Apr 4 23:31:27 2017 UTC (7 years, 1 month ago) by jmc
Branch: MAIN
CVS Tags: checkpoint66g, checkpoint66f, checkpoint66o, checkpoint66n, checkpoint66m, checkpoint66l, checkpoint66k, checkpoint66j, checkpoint66i, checkpoint66h, HEAD
Changes since 1.211: +5 -3 lines
- add specific run-time param to select level of printed plot-field-maps,
  set by default to debugLevel.

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

  ViewVC Help
Powered by ViewVC 1.1.22