/[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.131 - (hide annotations) (download)
Sun Jun 19 02:31:40 2011 UTC (12 years, 11 months ago) by ifenty
Branch: MAIN
CVS Tags: checkpoint62z
Changes since 1.130: +53 -21 lines
Minor changes to seaice package.

1) Retired old variables (A22, SEAICE_lhsublim, areaMax, areaMin, hiceMin) and
   added some new ones (SEAICE_area_reg, SEAICE_hice_reg, SEAICE_area_floor)

  - Differentiated "regularization variables" from "floor variables"
    * areaMin became SEAICE_area_reg (old A22) and SEAICE_area_floor
    * hiceMin became SEAICE_hice_reg (old hiceMin)
     (with _reg meaning regularization variable)

  - SEAICE_lhSublim becomes lhSublim, the sum of SEAICE_lhEvap and SEAICE_lhFusion
    so as to ensure energy conservation when going between phases

  - A22 was not used anywhere

2) Changed regularization procedure for heffActual and hsnowActual to ensure
   well-boundedness and smooth adjoint in seaice_growth.F

3) Fixed a bug where seaice_solve4temp would not recognize ice-free grid cells
   because the old regularization always set heffActual >= 0.05 cm

4) Changed the model so that the default behavior is to put a small (10^-5) "floor"
   on AREA when HEFF > 0.
   - went from requiring ALLOW_PRECLUDE_INFINITESIMAL_AREA to be defined to
     requiring that DISABLE_AREA_FLOOR *not* be defined

 Modified Files:
 	SEAICE_PARAMS.h seaice_check.F seaice_growth.F
 	seaice_readparms.F seaice_solve4temp.F seaice_summary.F

1 ifenty 1.131 C $Header: /u/gcmpack/MITgcm/pkg/seaice/seaice_growth.F,v 1.130 2011/06/15 01:31:07 gforget Exp $
2 jmc 1.91 C $Name: $
3    
4 dimitri 1.69 #include "SEAICE_OPTIONS.h"
5    
6     CBOP
7     C !ROUTINE: SEAICE_GROWTH
8     C !INTERFACE:
9     SUBROUTINE SEAICE_GROWTH( myTime, myIter, myThid )
10     C !DESCRIPTION: \bv
11     C *==========================================================*
12     C | SUBROUTINE seaice_growth
13     C | o Updata ice thickness and snow depth
14     C *==========================================================*
15     C \ev
16    
17     C !USES:
18     IMPLICIT NONE
19     C === Global variables ===
20     #include "SIZE.h"
21     #include "EEPARAMS.h"
22     #include "PARAMS.h"
23     #include "DYNVARS.h"
24     #include "GRID.h"
25     #include "FFIELDS.h"
26 heimbach 1.117 #include "SEAICE_SIZE.h"
27 dimitri 1.69 #include "SEAICE_PARAMS.h"
28     #include "SEAICE.h"
29 heimbach 1.117 #include "SEAICE_TRACER.h"
30 dimitri 1.69 #ifdef ALLOW_EXF
31     # include "EXF_OPTIONS.h"
32     # include "EXF_FIELDS.h"
33     # include "EXF_PARAM.h"
34     #endif
35     #ifdef ALLOW_SALT_PLUME
36     # include "SALT_PLUME.h"
37     #endif
38     #ifdef ALLOW_AUTODIFF_TAMC
39     # include "tamc.h"
40     #endif
41    
42     C !INPUT/OUTPUT PARAMETERS:
43     C === Routine arguments ===
44     C myTime :: Simulation time
45     C myIter :: Simulation timestep number
46     C myThid :: Thread no. that called this routine.
47     _RL myTime
48     INTEGER myIter, myThid
49    
50 jmc 1.104 C !FUNCTIONS:
51     #ifdef ALLOW_DIAGNOSTICS
52     LOGICAL DIAGNOSTICS_IS_ON
53     EXTERNAL DIAGNOSTICS_IS_ON
54     #endif
55    
56 dimitri 1.69 C !LOCAL VARIABLES:
57     C === Local variables ===
58 gforget 1.89 C
59 jmc 1.91 C unit/sign convention:
60     C Within the thermodynamic computation all stocks, except HSNOW,
61 gforget 1.89 C are in 'effective ice meters' units, and >0 implies more ice.
62 jmc 1.91 C This holds for stocks due to ocean and atmosphere heat,
63     C at the outset of 'PART 2: determine heat fluxes/stocks'
64 gforget 1.89 C and until 'PART 7: determine ocean model forcing'
65     C This strategy minimizes the need for multiplications/divisions
66 jmc 1.91 C by ice fraction, heat capacity, etc. The only conversions that
67     C occurs are for the HSNOW (in effective snow meters) and
68     C PRECIP (fresh water m/s).
69 jmc 1.104 C
70     C HEFF is effective Hice thickness (m3/m2)
71     C HSNOW is Heffective snow thickness (m3/m2)
72     C HSALT is Heffective salt content (g/m2)
73     C AREA is the seaice cover fraction (0<=AREA<=1)
74     C Q denotes heat stocks -- converted to ice stocks (m3/m2) early on
75     C
76     C For all other stocks/increments, such as d_HEFFbyATMonOCN
77     C or a_QbyATM_cover, the naming convention is as follows:
78     C The prefix 'a_' means available, the prefix 'd_' means delta
79     C (i.e. increment), and the prefix 'r_' means residual.
80     C The suffix '_cover' denotes a value for the ice covered fraction
81     C of the grid cell, whereas '_open' is for the open water fraction.
82     C The main part of the name states what ice/snow stock is concerned
83     C (e.g. QbyATM or HEFF), and how it is affected (e.g. d_HEFFbyATMonOCN
84     C is the increment of HEFF due to the ATMosphere extracting heat from the
85     C OCeaN surface, or providing heat to the OCeaN surface).
86 gforget 1.89
87     CEOP
88 dimitri 1.69 C i,j,bi,bj :: Loop counters
89     INTEGER i, j, bi, bj
90     C number of surface interface layer
91     INTEGER kSurface
92     C constants
93 gforget 1.80 _RL TBC, ICE2SNOW
94 mlosch 1.101 _RL QI, QS
95 dimitri 1.69
96 jmc 1.91 C a_QbyATM_cover :: available heat (in W/m^2) due to the interaction of
97 gforget 1.75 C the atmosphere and the ocean surface - for ice covered water
98 gforget 1.89 C a_QbyATM_open :: same but for open water
99 gforget 1.84 C r_QbyATM_cover :: residual of a_QbyATM_cover after freezing/melting processes
100 gforget 1.89 C r_QbyATM_open :: same but for open water
101 gforget 1.76 _RL a_QbyATM_cover (1:sNx,1:sNy)
102     _RL a_QbyATM_open (1:sNx,1:sNy)
103     _RL r_QbyATM_cover (1:sNx,1:sNy)
104 mlosch 1.109 _RL r_QbyATM_open (1:sNx,1:sNy)
105 gforget 1.75 C a_QSWbyATM_open - short wave heat flux over ocean in W/m^2
106     C a_QSWbyATM_cover - short wave heat flux under ice in W/m^2
107 gforget 1.76 _RL a_QSWbyATM_open (1:sNx,1:sNy)
108     _RL a_QSWbyATM_cover (1:sNx,1:sNy)
109 jmc 1.91 C a_QbyOCN :: available heat (in in W/m^2) due to the
110 gforget 1.76 C interaction of the ice pack and the ocean surface
111 jmc 1.91 C r_QbyOCN :: residual of a_QbyOCN after freezing/melting
112 gforget 1.75 C processes have been accounted for
113 gforget 1.84 _RL a_QbyOCN (1:sNx,1:sNy)
114     _RL r_QbyOCN (1:sNx,1:sNy)
115 gforget 1.76
116 jmc 1.104 C conversion factors to go from Q (W/m2) to HEFF (ice meters)
117 gforget 1.76 _RL convertQ2HI, convertHI2Q
118 jmc 1.104 C conversion factors to go from precip (m/s) unit to HEFF (ice meters)
119 gforget 1.76 _RL convertPRECIP2HI, convertHI2PRECIP
120 gforget 1.75
121 jmc 1.104 C ICE/SNOW stocks tendencies associated with the various melt/freeze processes
122 dimitri 1.113 _RL d_AREAbyATM (1:sNx,1:sNy)
123 gforget 1.112 _RL d_AREAbyOCN (1:sNx,1:sNy)
124 dimitri 1.113 _RL d_AREAbyICE (1:sNx,1:sNy)
125 jmc 1.104
126 dimitri 1.113 c The change of mean ice thickness due to out-of-bounds values following
127     c sea ice dyhnamics
128 gforget 1.87 _RL d_HEFFbyNEG (1:sNx,1:sNy)
129 dimitri 1.113
130     c The change of mean ice thickness due to turbulent ocean-sea ice heat fluxes
131     _RL d_HEFFbyOCNonICE (1:sNx,1:sNy)
132    
133 dimitri 1.114 c The sum of mean ice thickness increments due to atmospheric fluxes over the open water
134     c fraction and ice-covered fractions of the grid cell
135 dimitri 1.113 _RL d_HEFFbyATMonOCN (1:sNx,1:sNy)
136     c The change of mean ice thickness due to flooding by snow
137 gforget 1.84 _RL d_HEFFbyFLOODING (1:sNx,1:sNy)
138 jmc 1.104
139 dimitri 1.114 c The mean ice thickness increments due to atmospheric fluxes over the open water
140     c fraction and ice-covered fractions of the grid cell, respectively
141     _RL d_HEFFbyATMonOCN_open(1:sNx,1:sNy)
142     _RL d_HEFFbyATMonOCN_cover(1:sNx,1:sNy)
143    
144 gforget 1.87 _RL d_HSNWbyNEG (1:sNx,1:sNy)
145 dimitri 1.113 _RL d_HSNWbyATMonSNW (1:sNx,1:sNy)
146     _RL d_HSNWbyOCNonSNW (1:sNx,1:sNy)
147 gforget 1.84 _RL d_HSNWbyRAIN (1:sNx,1:sNy)
148 jmc 1.104
149 gforget 1.84 _RL d_HFRWbyRAIN (1:sNx,1:sNy)
150 mlosch 1.109 C
151     C a_FWbySublim :: fresh water flux implied by latent heat of
152     C sublimation to atmosphere, same sign convention
153     C as EVAP (positive upward)
154     _RL a_FWbySublim (1:sNx,1:sNy)
155 gforget 1.125 _RL r_FWbySublim (1:sNx,1:sNy)
156 mlosch 1.109 #ifdef SEAICE_ADD_SUBLIMATION_TO_FWBUDGET
157     _RL d_HEFFbySublim (1:sNx,1:sNy)
158     _RL d_HSNWbySublim (1:sNx,1:sNy)
159     #endif /* SEAICE_ADD_SUBLIMATION_TO_FWBUDGET */
160 gforget 1.71
161 gforget 1.122 C actual ice thickness (with upper and lower limit)
162 gforget 1.83 _RL heffActual (1:sNx,1:sNy)
163 dimitri 1.69 C actual snow thickness
164 gforget 1.83 _RL hsnowActual (1:sNx,1:sNy)
165 gforget 1.122 C actual ice thickness (with lower limit only) Reciprocal
166     _RL recip_heffActual (1:sNx,1:sNy)
167 gforget 1.123 C local value (=HO or HO_south)
168     _RL HO_loc
169 gforget 1.87
170     C AREA_PRE :: hold sea-ice fraction field before any seaice-thermo update
171     _RL AREApreTH (1:sNx,1:sNy)
172     _RL HEFFpreTH (1:sNx,1:sNy)
173     _RL HSNWpreTH (1:sNx,1:sNy)
174    
175 dimitri 1.69 C wind speed
176 gforget 1.76 _RL UG (1:sNx,1:sNy)
177 jmc 1.104 #ifdef ALLOW_ATM_WIND
178 dimitri 1.69 _RL SPEED_SQ
179 jmc 1.104 #endif
180 gforget 1.96
181 ifenty 1.131 C Regularization values squared
182     _RL area_reg_sq, hice_reg_sq
183    
184 gforget 1.96 C pathological cases thresholds
185 gforget 1.124 _RL heffTooHeavy
186 dimitri 1.69
187 jmc 1.104 C temporary variables available for the various computations
188 dimitri 1.113 #ifdef SEAICE_GROWTH_LEGACY
189     _RL tmpscal0
190     #endif
191     _RL tmpscal1, tmpscal2, tmpscal3, tmpscal4
192 gforget 1.76 _RL tmparr1 (1:sNx,1:sNy)
193 gforget 1.75
194     #ifdef ALLOW_SEAICE_FLOODING
195     _RL hDraft
196     #endif /* ALLOW_SEAICE_FLOODING */
197 jmc 1.91
198 ifenty 1.119 #ifdef SEAICE_VARIABLE_SALINITY
199 gforget 1.83 _RL saltFluxAdjust (1:sNx,1:sNy)
200 gforget 1.75 #endif
201    
202 mlosch 1.98 INTEGER nDim
203 dimitri 1.69 #ifdef SEAICE_MULTICATEGORY
204 mlosch 1.98 INTEGER ilockey
205     PARAMETER ( nDim = MULTDIM )
206 jmc 1.104 INTEGER it
207     _RL pFac
208     _RL heffActualP (1:sNx,1:sNy)
209 mlosch 1.109 _RL a_QbyATMmult_cover (1:sNx,1:sNy)
210     _RL a_QSWbyATMmult_cover(1:sNx,1:sNy)
211     _RL a_FWbySublimMult (1:sNx,1:sNy)
212 mlosch 1.98 #else
213     PARAMETER ( nDim = 1 )
214     #endif /* SEAICE_MULTICATEGORY */
215 dimitri 1.69
216 gforget 1.110 #ifdef MCPHEE_OCEAN_ICE_HEAT_FLUX
217 dimitri 1.113 C Factor by which we increase the upper ocean friction velocity (u*) when
218     C ice is absent in a grid cell (dimensionless)
219     _RL MixedLayerTurbulenceFactor
220    
221     c The Stanton number for the McPhee
222     c ocean-ice heat flux parameterization (dimensionless)
223 gforget 1.110 _RL STANTON_NUMBER
224 dimitri 1.113
225     c A typical friction velocity beneath sea ice for the
226     c McPhee heat flux parameterization (m/s)
227 gforget 1.110 _RL USTAR_BASE
228 dimitri 1.113
229     _RL surf_theta
230 gforget 1.110 #endif
231    
232 gforget 1.129 #ifdef ALLOW_SITRACER
233     INTEGER iTr
234     CHARACTER*8 diagName
235     #endif
236 dimitri 1.69 #ifdef ALLOW_DIAGNOSTICS
237 dimitri 1.113 c Helper variables for diagnostics
238     _RL DIAGarrayA (1:sNx,1:sNy)
239     _RL DIAGarrayB (1:sNx,1:sNy)
240     _RL DIAGarrayC (1:sNx,1:sNy)
241     _RL DIAGarrayD (1:sNx,1:sNy)
242 dimitri 1.69 #endif
243    
244 jmc 1.104 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
245    
246     C ===================================================================
247     C =================PART 0: constants and initializations=============
248     C ===================================================================
249 gforget 1.88
250 dimitri 1.69 IF ( buoyancyRelation .EQ. 'OCEANICP' ) THEN
251     kSurface = Nr
252     ELSE
253     kSurface = 1
254     ENDIF
255    
256 ifenty 1.131
257 jmc 1.104 C Cutoff for iceload
258 gforget 1.92 heffTooHeavy=dRf(kSurface) / 5. _d 0
259    
260 dimitri 1.69 C FREEZING TEMP. OF SEA WATER (deg C)
261     TBC = SEAICE_freeze
262 gforget 1.80
263 dimitri 1.69 C RATIO OF SEA ICE DENSITY to SNOW DENSITY
264 gforget 1.80 ICE2SNOW = SEAICE_rhoIce/SEAICE_rhoSnow
265 gforget 1.85
266 dimitri 1.69 C HEAT OF FUSION OF ICE (J/m^3)
267 mlosch 1.101 QI = SEAICE_rhoIce*SEAICE_lhFusion
268 dimitri 1.69 C HEAT OF FUSION OF SNOW (J/m^3)
269 mlosch 1.101 QS = SEAICE_rhoSnow*SEAICE_lhFusion
270 ifenty 1.131
271     C regularization constants
272     area_reg_sq = SEAICE_area_reg * SEAICE_area_reg
273     hice_reg_sq = SEAICE_hice_reg * SEAICE_hice_reg
274 gforget 1.85
275 dimitri 1.113 #ifdef MCPHEE_OCEAN_ICE_HEAT_FLUX
276     STANTON_NUMBER = 0.0056 _d 0
277     USTAR_BASE = 0.0125 _d 0
278     #endif
279    
280 jmc 1.104 C conversion factors to go from Q (W/m2) to HEFF (ice meters)
281 gforget 1.84 convertQ2HI=SEAICE_deltaTtherm/QI
282 gforget 1.76 convertHI2Q=1/convertQ2HI
283 jmc 1.104 C conversion factors to go from precip (m/s) unit to HEFF (ice meters)
284 gforget 1.76 convertPRECIP2HI=SEAICE_deltaTtherm*rhoConstFresh/SEAICE_rhoIce
285     convertHI2PRECIP=1./convertPRECIP2HI
286    
287 dimitri 1.69 DO bj=myByLo(myThid),myByHi(myThid)
288     DO bi=myBxLo(myThid),myBxHi(myThid)
289 jmc 1.104
290 dimitri 1.69 #ifdef ALLOW_AUTODIFF_TAMC
291 mlosch 1.109 act1 = bi - myBxLo(myThid)
292     max1 = myBxHi(myThid) - myBxLo(myThid) + 1
293     act2 = bj - myByLo(myThid)
294     max2 = myByHi(myThid) - myByLo(myThid) + 1
295     act3 = myThid - 1
296     max3 = nTx*nTy
297     act4 = ikey_dynamics - 1
298     iicekey = (act1 + 1) + act2*max1
299     & + act3*max1*max2
300     & + act4*max1*max2*max3
301 dimitri 1.69 #endif /* ALLOW_AUTODIFF_TAMC */
302 gforget 1.75
303    
304     C array initializations
305     C =====================
306    
307 dimitri 1.69 DO J=1,sNy
308     DO I=1,sNx
309 gforget 1.90 a_QbyATM_cover (I,J) = 0.0 _d 0
310     a_QbyATM_open(I,J) = 0.0 _d 0
311     r_QbyATM_cover (I,J) = 0.0 _d 0
312     r_QbyATM_open (I,J) = 0.0 _d 0
313 jmc 1.104
314 gforget 1.71 a_QSWbyATM_open (I,J) = 0.0 _d 0
315 gforget 1.90 a_QSWbyATM_cover (I,J) = 0.0 _d 0
316 jmc 1.104
317 gforget 1.90 a_QbyOCN (I,J) = 0.0 _d 0
318     r_QbyOCN (I,J) = 0.0 _d 0
319 jmc 1.104
320 dimitri 1.113 d_AREAbyATM(I,J) = 0.0 _d 0
321     d_AREAbyICE(I,J) = 0.0 _d 0
322 gforget 1.112 d_AREAbyOCN(I,J) = 0.0 _d 0
323 jmc 1.104
324 gforget 1.123 d_HEFFbyNEG(I,J) = 0.0 _d 0
325 dimitri 1.113 d_HEFFbyOCNonICE(I,J) = 0.0 _d 0
326     d_HEFFbyATMonOCN(I,J) = 0.0 _d 0
327 gforget 1.84 d_HEFFbyFLOODING(I,J) = 0.0 _d 0
328 jmc 1.104
329 dimitri 1.114 d_HEFFbyATMonOCN_open(I,J) = 0.0 _d 0
330     d_HEFFbyATMonOCN_cover(I,J) = 0.0 _d 0
331    
332 gforget 1.123 d_HSNWbyNEG(I,J) = 0.0 _d 0
333 dimitri 1.113 d_HSNWbyATMonSNW(I,J) = 0.0 _d 0
334     d_HSNWbyOCNonSNW(I,J) = 0.0 _d 0
335 gforget 1.90 d_HSNWbyRAIN(I,J) = 0.0 _d 0
336 mlosch 1.109 a_FWbySublim(I,J) = 0.0 _d 0
337 gforget 1.125 r_FWbySublim(I,J) = 0.0 _d 0
338 mlosch 1.109 #ifdef SEAICE_ADD_SUBLIMATION_TO_FWBUDGET
339     d_HEFFbySublim(I,J) = 0.0 _d 0
340     d_HSNWbySublim(I,J) = 0.0 _d 0
341     #endif /* SEAICE_ADD_SUBLIMATION_TO_FWBUDGET */
342     c
343 gforget 1.90 d_HFRWbyRAIN(I,J) = 0.0 _d 0
344 jmc 1.104
345 gforget 1.90 tmparr1(I,J) = 0.0 _d 0
346 jmc 1.104
347 ifenty 1.119 #ifdef SEAICE_VARIABLE_SALINITY
348 gforget 1.90 saltFluxAdjust(I,J) = 0.0 _d 0
349 dimitri 1.69 #endif
350 mlosch 1.109 #ifdef SEAICE_MULTICATEGORY
351 gforget 1.90 a_QbyATMmult_cover(I,J) = 0.0 _d 0
352     a_QSWbyATMmult_cover(I,J) = 0.0 _d 0
353 mlosch 1.109 a_FWbySublimMult(I,J) = 0.0 _d 0
354     #endif /* SEAICE_MULTICATEGORY */
355 dimitri 1.69 ENDDO
356     ENDDO
357 gforget 1.84 #ifdef ALLOW_MEAN_SFLUX_COST_CONTRIBUTION
358 dimitri 1.69 DO J=1-oLy,sNy+oLy
359     DO I=1-oLx,sNx+oLx
360 gforget 1.90 frWtrAtm(I,J,bi,bj) = 0.0 _d 0
361 dimitri 1.69 ENDDO
362     ENDDO
363 gforget 1.84 #endif
364 dimitri 1.69
365 gforget 1.87
366 jmc 1.104 C =====================================================================
367     C ===========PART 1: treat pathological cases (post advdiff)===========
368     C =====================================================================
369 gforget 1.88
370 jmc 1.104 #ifdef SEAICE_GROWTH_LEGACY
371 gforget 1.88
372 jmc 1.104 DO J=1,sNy
373     DO I=1,sNx
374     HEFFpreTH(I,J)=HEFFNM1(I,J,bi,bj)
375     HSNWpreTH(I,J)=HSNOW(I,J,bi,bj)
376     AREApreTH(I,J)=AREANM1(I,J,bi,bj)
377     d_HEFFbyNEG(I,J)=0. _d 0
378     d_HSNWbyNEG(I,J)=0. _d 0
379 gforget 1.128 #ifdef ALLOW_DIAGNOSTICS
380     DIAGarrayA(I,J) = AREANM1(I,J,bi,bj)
381     DIAGarrayB(I,J) = AREANM1(I,J,bi,bj)
382     DIAGarrayC(I,J) = HEFFNM1(I,J,bi,bj)
383     DIAGarrayD(I,J) = HSNOW(I,J,bi,bj)
384     #endif
385 jmc 1.104 ENDDO
386     ENDDO
387 gforget 1.88
388 jmc 1.104 #else /* SEAICE_GROWTH_LEGACY */
389 gforget 1.87
390 gforget 1.105 #ifdef ALLOW_AUTODIFF_TAMC
391     #ifdef SEAICE_MODIFY_GROWTH_ADJ
392     Cgf no dependency through pathological cases treatment
393     if ( SEAICEadjMODE.EQ.0 ) then
394     #endif
395     #endif
396    
397 jmc 1.104 C 1) treat the case of negative values:
398 gforget 1.87
399     #ifdef ALLOW_AUTODIFF_TAMC
400 gforget 1.105 CADJ STORE heff(:,:,bi,bj) = comlev1_bibj, key = iicekey,byte=isbyte
401     CADJ STORE hsnow(:,:,bi,bj) = comlev1_bibj, key = iicekey,byte=isbyte
402     CADJ STORE area(:,:,bi,bj) = comlev1_bibj, key = iicekey,byte=isbyte
403 gforget 1.87 #endif /* ALLOW_AUTODIFF_TAMC */
404     DO J=1,sNy
405     DO I=1,sNx
406 gforget 1.89 d_HEFFbyNEG(I,J)=MAX(-HEFF(I,J,bi,bj),0. _d 0)
407 gforget 1.87 HEFF(I,J,bi,bj)=HEFF(I,J,bi,bj)+d_HEFFbyNEG(I,J)
408 gforget 1.89 d_HSNWbyNEG(I,J)=MAX(-HSNOW(I,J,bi,bj),0. _d 0)
409 gforget 1.87 HSNOW(I,J,bi,bj)=HSNOW(I,J,bi,bj)+d_HSNWbyNEG(I,J)
410     AREA(I,J,bi,bj)=MAX(AREA(I,J,bi,bj),0. _d 0)
411     ENDDO
412     ENDDO
413    
414 jmc 1.104 C 1.25) treat the case of very thin ice:
415    
416 gforget 1.92 #ifdef ALLOW_AUTODIFF_TAMC
417 gforget 1.105 CADJ STORE heff(:,:,bi,bj) = comlev1_bibj, key = iicekey,byte=isbyte
418 gforget 1.92 #endif /* ALLOW_AUTODIFF_TAMC */
419     DO J=1,sNy
420     DO I=1,sNx
421 gforget 1.124 if (HEFF(I,J,bi,bj).LE.siEps) then
422 gforget 1.92 tmpscal2=-HEFF(I,J,bi,bj)
423     tmpscal3=-HSNOW(I,J,bi,bj)
424 gforget 1.96 TICE(I,J,bi,bj)=celsius2K
425 heimbach 1.120 #ifdef SEAICE_AGE
426     IceAgeTr(i,j,bi,bj,2)=0. _d 0
427     #endif /* SEAICE_AGE */
428 gforget 1.92 else
429     tmpscal2=0. _d 0
430     tmpscal3=0. _d 0
431     endif
432     HEFF(I,J,bi,bj)=HEFF(I,J,bi,bj)+tmpscal2
433     d_HEFFbyNEG(I,J)=d_HEFFbyNEG(I,J)+tmpscal2
434     HSNOW(I,J,bi,bj)=HSNOW(I,J,bi,bj)+tmpscal3
435     d_HSNWbyNEG(I,J)=d_HSNWbyNEG(I,J)+tmpscal3
436     ENDDO
437     ENDDO
438    
439 jmc 1.104 C 1.5) treat the case of area but no ice/snow:
440    
441 gforget 1.90 #ifdef ALLOW_AUTODIFF_TAMC
442 gforget 1.105 CADJ STORE heff(:,:,bi,bj) = comlev1_bibj, key = iicekey,byte=isbyte
443     CADJ STORE hsnow(:,:,bi,bj) = comlev1_bibj, key = iicekey,byte=isbyte
444 gforget 1.90 #endif /* ALLOW_AUTODIFF_TAMC */
445     DO J=1,sNy
446     DO I=1,sNx
447     IF ((HEFF(i,j,bi,bj).EQ.0. _d 0).AND.
448     & (HSNOW(i,j,bi,bj).EQ.0. _d 0)) AREA(I,J,bi,bj)=0. _d 0
449     ENDDO
450     ENDDO
451    
452 jmc 1.104 C 2) treat the case of very small area:
453    
454 ifenty 1.131 #ifndef DISABLE_AREA_FLOOR
455 gforget 1.87 #ifdef ALLOW_AUTODIFF_TAMC
456 gforget 1.105 CADJ STORE area(:,:,bi,bj) = comlev1_bibj, key = iicekey,byte=isbyte
457 gforget 1.87 #endif /* ALLOW_AUTODIFF_TAMC */
458     DO J=1,sNy
459     DO I=1,sNx
460 heimbach 1.120 IF ((HEFF(i,j,bi,bj).GT.0).OR.(HSNOW(i,j,bi,bj).GT.0)) THEN
461     #ifdef SEAICE_AGE
462 ifenty 1.131 IF (AREA(I,J,bi,bj).LT.SEAICE_area_floor) THEN
463 heimbach 1.120 IceAgeTr(i,j,bi,bj,1)=IceAgeTr(i,j,bi,bj,1)
464     & + IceAgeTr(i,j,bi,bj,1)
465 ifenty 1.131 & *(SEAICE_area_floor-AREA(I,J,bi,bj)) / SEAICE_area_floor
466 heimbach 1.120 ENDIF
467     #endif /* SEAICE_AGE */
468 ifenty 1.131 AREA(I,J,bi,bj)=MAX(AREA(I,J,bi,bj),SEAICE_area_floor)
469 heimbach 1.120 ENDIF
470 gforget 1.87 ENDDO
471     ENDDO
472 ifenty 1.131 #endif /* DISABLE_AREA_FLOOR */
473 gforget 1.87
474 dimitri 1.115 C 2.5) treat case of excessive ice cover, e.g., due to ridging:
475 jmc 1.104
476 gforget 1.89 #ifdef ALLOW_AUTODIFF_TAMC
477 gforget 1.105 CADJ STORE area(:,:,bi,bj) = comlev1_bibj, key = iicekey,byte=isbyte
478 gforget 1.89 #endif /* ALLOW_AUTODIFF_TAMC */
479     DO J=1,sNy
480     DO I=1,sNx
481 gforget 1.128 #ifdef ALLOW_DIAGNOSTICS
482     DIAGarrayA(I,J) = AREA(I,J,bi,bj)
483     #endif
484 gforget 1.127 #ifdef ALLOW_SITRACER
485     SItrAREA(I,J,bi,bj,1)=AREA(I,J,bi,bj)
486     #endif
487 heimbach 1.120 #ifdef SEAICE_AGE
488 ifenty 1.131 IF (AREA(I,J,bi,bj).GT.SEAICE_area_max) THEN
489 heimbach 1.120 IceAgeTr(i,j,bi,bj,1)=IceAgeTr(i,j,bi,bj,1)
490     & - IceAgeTr(i,j,bi,bj,1)
491 ifenty 1.131 & *(AREA(I,J,bi,bj)-SEAICE_area_max) / SEAICE_area_max
492 heimbach 1.120 ENDIF
493     #endif /* SEAICE_AGE */
494 ifenty 1.131 AREA(I,J,bi,bj)=MIN(AREA(I,J,bi,bj),SEAICE_area_max)
495 gforget 1.89 ENDDO
496     ENDDO
497    
498 gforget 1.105 #ifdef ALLOW_AUTODIFF_TAMC
499     #ifdef SEAICE_MODIFY_GROWTH_ADJ
500     endif
501     #endif
502     #endif
503    
504 jmc 1.104 C 3) store regularized values of heff, hsnow, area at the onset of thermo.
505 gforget 1.87 DO J=1,sNy
506     DO I=1,sNx
507     HEFFpreTH(I,J)=HEFF(I,J,bi,bj)
508     HSNWpreTH(I,J)=HSNOW(I,J,bi,bj)
509     AREApreTH(I,J)=AREA(I,J,bi,bj)
510 gforget 1.128 #ifdef ALLOW_DIAGNOSTICS
511     DIAGarrayB(I,J) = AREA(I,J,bi,bj)
512     DIAGarrayC(I,J) = HEFF(I,J,bi,bj)
513     DIAGarrayD(I,J) = HSNOW(I,J,bi,bj)
514     #endif
515 gforget 1.124 #ifdef ALLOW_SITRACER
516     SItrHEFF(I,J,bi,bj,1)=HEFF(I,J,bi,bj)
517 gforget 1.127 SItrAREA(I,J,bi,bj,2)=AREA(I,J,bi,bj)
518 gforget 1.124 #endif
519 gforget 1.87 ENDDO
520     ENDDO
521    
522 jmc 1.104 C 4) treat sea ice salinity pathological cases
523 ifenty 1.119 #ifdef SEAICE_VARIABLE_SALINITY
524 gforget 1.87 #ifdef ALLOW_AUTODIFF_TAMC
525 gforget 1.105 CADJ STORE hsalt(:,:,bi,bj) = comlev1_bibj, key = iicekey,byte=isbyte
526     CADJ STORE heff(:,:,bi,bj) = comlev1_bibj, key = iicekey,byte=isbyte
527 gforget 1.87 #endif /* ALLOW_AUTODIFF_TAMC */
528     DO J=1,sNy
529     DO I=1,sNx
530     IF ( (HSALT(I,J,bi,bj) .LT. 0.0).OR.
531     & (HEFF(I,J,bi,bj) .EQ. 0.0) ) THEN
532     saltFluxAdjust(I,J) = - HEFFM(I,J,bi,bj) *
533     & HSALT(I,J,bi,bj) / SEAICE_deltaTtherm
534     HSALT(I,J,bi,bj) = 0.0 _d 0
535     ENDIF
536     ENDDO
537     ENDDO
538 ifenty 1.119 #endif /* SEAICE_VARIABLE_SALINITY */
539 gforget 1.87
540 jmc 1.104 C 5) treat sea ice age pathological cases
541     C ...
542 heimbach 1.120
543     #ifdef SEAICE_AGE
544    
545     #ifdef ALLOW_AUTODIFF_TAMC
546     CADJ STORE IceAgeTr(:,:,bi,bj,1) = comlev1_bibj,
547     CADJ & key = iicekey,byte=isbyte
548     CADJ STORE IceAgeTr(:,:,bi,bj,2) = comlev1_bibj,
549     CADJ & key = iicekey,byte=isbyte
550     CADJ STORE heff(:,:,bi,bj) = comlev1_bibj,
551     CADJ & key = iicekey,byte=isbyte
552     #endif /* ALLOW_AUTODIFF_TAMC */
553     DO J=1,sNy
554     DO I=1,sNx
555     IF (HEFF(i,j,bi,bj).EQ.0.) THEN
556     IceAgeTr(i,j,bi,bj,1)=0. _d 0
557     IceAgeTr(i,j,bi,bj,2)=0. _d 0
558     ENDIF
559     IF (IceAgeTr(i,j,bi,bj,1).LT.0.) IceAgeTr(i,j,bi,bj,1)=0. _d 0
560     IF (IceAgeTr(i,j,bi,bj,2).LT.0.) IceAgeTr(i,j,bi,bj,2)=0. _d 0
561     ENDDO
562     ENDDO
563     #endif /* SEAICE_AGE */
564    
565 jmc 1.104 #endif /* SEAICE_GROWTH_LEGACY */
566 jmc 1.91
567 gforget 1.128 #ifdef ALLOW_DIAGNOSTICS
568     IF ( useDiagnostics ) THEN
569 gforget 1.129 CALL DIAGNOSTICS_FILL(DIAGarrayA,'SIareaPR',0,1,3,bi,bj,myThid)
570     CALL DIAGNOSTICS_FILL(DIAGarrayB,'SIareaPT',0,1,3,bi,bj,myThid)
571     CALL DIAGNOSTICS_FILL(DIAGarrayC,'SIheffPT',0,1,3,bi,bj,myThid)
572     CALL DIAGNOSTICS_FILL(DIAGarrayD,'SIhsnoPT',0,1,3,bi,bj,myThid)
573     #ifdef ALLOW_SITRACER
574     DO iTr = 1, SItrMaxNum
575     WRITE(diagName,'(A4,I2.2,A2)') 'SItr',iTr,'PT'
576     if (SItrMate(iTr).EQ.'HEFF') then
577     CALL DIAGNOSTICS_FRACT_FILL(
578     I SItracer(1-OLx,1-OLy,bi,bj,iTr),HEFF(1-OLx,1-OLy,bi,bj),
579     I ONE, 1, diagName,0,1,2,bi,bj,myThid )
580     else
581     CALL DIAGNOSTICS_FRACT_FILL(
582     I SItracer(1-OLx,1-OLy,bi,bj,iTr),AREA(1-OLx,1-OLy,bi,bj),
583     I ONE, 1, diagName,0,1,2,bi,bj,myThid )
584     endif
585     ENDDO
586     #endif
587 gforget 1.128 ENDIF
588     #endif
589    
590 gforget 1.105 #ifdef ALLOW_AUTODIFF_TAMC
591     #ifdef SEAICE_MODIFY_GROWTH_ADJ
592     Cgf no additional dependency of air-sea fluxes to ice
593     if ( SEAICEadjMODE.GE.1 ) then
594     DO J=1,sNy
595     DO I=1,sNx
596     HEFFpreTH(I,J) = 0. _d 0
597     HSNWpreTH(I,J) = 0. _d 0
598     AREApreTH(I,J) = 0. _d 0
599     ENDDO
600     ENDDO
601     endif
602     #endif
603     #endif
604 dimitri 1.69
605 jmc 1.104 C 4) COMPUTE ACTUAL ICE/SNOW THICKNESS; USE MIN/MAX VALUES
606     C TO REGULARIZE SEAICE_SOLVE4TEMP/d_AREA COMPUTATIONS
607 dimitri 1.69
608     #ifdef ALLOW_AUTODIFF_TAMC
609 gforget 1.105 CADJ STORE AREApreTH = comlev1_bibj, key = iicekey, byte = isbyte
610     CADJ STORE HEFFpreTH = comlev1_bibj, key = iicekey, byte = isbyte
611     CADJ STORE HSNWpreTH = comlev1_bibj, key = iicekey, byte = isbyte
612 dimitri 1.69 #endif /* ALLOW_AUTODIFF_TAMC */
613     DO J=1,sNy
614     DO I=1,sNx
615 ifenty 1.131
616     if (HEFFpreTH(I,J) .GT. ZERO) THEN
617 gforget 1.122 #ifdef SEAICE_GROWTH_LEGACY
618 ifenty 1.131 tmpscal1 = MAX(SEAICE_area_reg,AREApreTH(I,J))
619     hsnowActual(I,J) = HSNWpreTH(I,J)/tmpscal1
620     tmpscal2 = HEFFpreTH(I,J)/tmpscal1
621     heffActual(I,J) = MAX(tmpscal2,SEAICE_hice_reg)
622 gforget 1.122 #else
623 ifenty 1.131 cif regularize AREA with SEAICE_area_reg
624     tmpscal1 = SQRT(AREApreTH(I,J)* AREApreTH(I,J) + area_reg_sq)
625    
626     cif heffActual calculated with the regularized AREA
627     tmpscal2 = HEFFpreTH(I,J) / tmpscal1
628    
629     cif regularize heffActual with SEAICE_hice_reg (add lower bound)
630     heffActual(I,J) = SQRT(tmpscal2 * tmpscal2 + hice_reg_sq)
631    
632     cif hsnowActual calculated with the regularized AREA
633     hsnowActual(I,J) = HSNWpreTH(I,J) / tmpscal1
634 gforget 1.122 #endif
635 ifenty 1.131
636     cif regularize the inverse of heffActual by hice_reg
637     recip_heffActual(I,J) = AREApreTH(I,J) /
638     & sqrt(HEFFpreTH(I,J)*HEFFpreTH(I,J) + hice_reg_sq)
639    
640     cif Do not regularize when HEFFpreTH = 0
641     else
642     heffActual(I,J) = ZERO
643     hsnowActual(I,J) = ZERO
644     recip_heffActual(I,J) = ZERO
645     endif
646    
647 dimitri 1.69 ENDDO
648     ENDDO
649    
650 gforget 1.95 #ifdef ALLOW_AUTODIFF_TAMC
651 gforget 1.96 #ifdef SEAICE_SIMPLIFY_GROWTH_ADJ
652 gforget 1.95 CALL ZERO_ADJ_1D( sNx*sNy, heffActual, myThid)
653 gforget 1.96 CALL ZERO_ADJ_1D( sNx*sNy, hsnowActual, myThid)
654 gforget 1.122 CALL ZERO_ADJ_1D( sNx*sNy, recip_heffActual, myThid)
655 gforget 1.95 #endif
656     #endif
657 gforget 1.87
658 gforget 1.88
659 dimitri 1.113
660 jmc 1.104 C ===================================================================
661     C ================PART 2: determine heat fluxes/stocks===============
662     C ===================================================================
663 gforget 1.88
664 gforget 1.75 C determine available heat due to the atmosphere -- for open water
665     C ================================================================
666    
667     C ocean surface/mixed layer temperature
668 dimitri 1.69 DO J=1,sNy
669     DO I=1,sNx
670 gforget 1.83 TMIX(I,J,bi,bj)=theta(I,J,kSurface,bi,bj)+celsius2K
671 dimitri 1.69 ENDDO
672     ENDDO
673    
674 gforget 1.75 C wind speed from exf
675 dimitri 1.69 DO J=1,sNy
676     DO I=1,sNx
677     UG(I,J) = MAX(SEAICE_EPS,wspeed(I,J,bi,bj))
678     ENDDO
679     ENDDO
680    
681 gforget 1.105 #ifdef ALLOW_AUTODIFF_TAMC
682     CADJ STORE qnet(:,:,bi,bj) = comlev1_bibj, key = iicekey,byte=isbyte
683     CADJ STORE qsw(:,:,bi,bj) = comlev1_bibj, key = iicekey,byte=isbyte
684     cCADJ STORE UG = comlev1_bibj, key = iicekey,byte=isbyte
685     cCADJ STORE TMIX(:,:,bi,bj) = comlev1_bibj, key = iicekey,byte=isbyte
686     #endif /* ALLOW_AUTODIFF_TAMC */
687    
688 gforget 1.75 CALL SEAICE_BUDGET_OCEAN(
689     I UG,
690     U TMIX,
691     O a_QbyATM_open, a_QSWbyATM_open,
692     I bi, bj, myTime, myIter, myThid )
693    
694     C determine available heat due to the atmosphere -- for ice covered water
695     C =======================================================================
696 dimitri 1.69
697 gforget 1.89 #ifdef ALLOW_ATM_WIND
698 dimitri 1.69 IF (useRelativeWind) THEN
699     C Compute relative wind speed over sea ice.
700     DO J=1,sNy
701     DO I=1,sNx
702     SPEED_SQ =
703     & (uWind(I,J,bi,bj)
704     & +0.5 _d 0*(uVel(i,j,kSurface,bi,bj)
705     & +uVel(i+1,j,kSurface,bi,bj))
706     & -0.5 _d 0*(uice(i,j,bi,bj)+uice(i+1,j,bi,bj)))**2
707     & +(vWind(I,J,bi,bj)
708     & +0.5 _d 0*(vVel(i,j,kSurface,bi,bj)
709     & +vVel(i,j+1,kSurface,bi,bj))
710     & -0.5 _d 0*(vice(i,j,bi,bj)+vice(i,j+1,bi,bj)))**2
711     IF ( SPEED_SQ .LE. SEAICE_EPS_SQ ) THEN
712     UG(I,J)=SEAICE_EPS
713     ELSE
714     UG(I,J)=SQRT(SPEED_SQ)
715     ENDIF
716     ENDDO
717     ENDDO
718     ENDIF
719 gforget 1.89 #endif
720 gforget 1.75
721 mlosch 1.98 #ifdef ALLOW_AUTODIFF_TAMC
722     CADJ STORE tice = comlev1, key = ikey_dynamics, byte = isbyte
723 gforget 1.105 CADJ STORE hsnowActual = comlev1_bibj, key = iicekey, byte = isbyte
724     CADJ STORE heffActual = comlev1_bibj, key = iicekey, byte = isbyte
725     CADJ STORE UG = comlev1_bibj, key = iicekey, byte = isbyte
726 mlosch 1.98 # ifdef SEAICE_MULTICATEGORY
727     CADJ STORE tices = comlev1, key = ikey_dynamics, byte = isbyte
728     # endif /* SEAICE_MULTICATEGORY */
729     #endif /* ALLOW_AUTODIFF_TAMC */
730    
731 mlosch 1.109 C-- Start loop over multi-categories, if SEAICE_MULTICATEGORY is undefined
732     C nDim = 1, and there is only one loop iteration
733 gforget 1.99 #ifdef SEAICE_MULTICATEGORY
734 mlosch 1.98 DO IT=1,nDim
735     #ifdef ALLOW_AUTODIFF_TAMC
736 jmc 1.104 C Why do we need this store directive when we have just stored
737 mlosch 1.98 C TICES before the loop?
738     ilockey = (iicekey-1)*nDim + IT
739 dimitri 1.69 CADJ STORE tices(:,:,it,bi,bj) = comlev1_multdim,
740     CADJ & key = ilockey, byte = isbyte
741     #endif /* ALLOW_AUTODIFF_TAMC */
742 mlosch 1.98 pFac = (2.0 _d 0*real(IT)-1.0 _d 0)/nDim
743 dimitri 1.69 DO J=1,sNy
744     DO I=1,sNx
745 mlosch 1.98 heffActualP(I,J)= heffActual(I,J)*pFac
746 dimitri 1.69 TICE(I,J,bi,bj)=TICES(I,J,IT,bi,bj)
747     ENDDO
748     ENDDO
749 jmc 1.70 CALL SEAICE_SOLVE4TEMP(
750 gforget 1.83 I UG, heffActualP, hsnowActual,
751 dimitri 1.69 U TICE,
752 gforget 1.71 O a_QbyATMmult_cover, a_QSWbyATMmult_cover,
753 mlosch 1.109 O a_FWbySublimMult,
754 dimitri 1.69 I bi, bj, myTime, myIter, myThid )
755     DO J=1,sNy
756     DO I=1,sNx
757 gforget 1.75 C average over categories
758 mlosch 1.109 a_QbyATM_cover (I,J) = a_QbyATM_cover(I,J)
759 mlosch 1.98 & + a_QbyATMmult_cover(I,J)/nDim
760 jmc 1.104 a_QSWbyATM_cover (I,J) = a_QSWbyATM_cover(I,J)
761 mlosch 1.98 & + a_QSWbyATMmult_cover(I,J)/nDim
762 mlosch 1.109 a_FWbySublim (I,J) = a_FWbySublim(I,J)
763     & + a_FWbySublimMult(I,J)/nDim
764 dimitri 1.69 TICES(I,J,IT,bi,bj) = TICE(I,J,bi,bj)
765     ENDDO
766     ENDDO
767     ENDDO
768 gforget 1.99 #else
769     CALL SEAICE_SOLVE4TEMP(
770     I UG, heffActual, hsnowActual,
771     U TICE,
772 mlosch 1.109 O a_QbyATM_cover, a_QSWbyATM_cover, a_FWbySublim,
773 gforget 1.99 I bi, bj, myTime, myIter, myThid )
774     #endif /* SEAICE_MULTICATEGORY */
775 dimitri 1.69 C-- End loop over multi-categories
776    
777     #ifdef ALLOW_DIAGNOSTICS
778     IF ( useDiagnostics ) THEN
779     DO J=1,sNy
780     DO I=1,sNx
781 mlosch 1.109 CML If I consider the atmosphere above the ice, the surface flux
782     CML which is relevant for the air temperature dT/dt Eq
783     CML accounts for sensible and radiation (with different treatment
784     CML according to wave-length) fluxes but not for "latent heat flux",
785     CML since it does not contribute to heating the air.
786     CML So this diagnostic is only good for heat budget calculations within
787     CML the ice-ocean system.
788 gforget 1.125 DIAGarrayA(I,J) = maskC(I,J,kSurface,bi,bj) * (
789 mlosch 1.109 & a_QbyATM_cover(I,J) * AREApreTH(I,J)
790 gforget 1.121 #ifndef SEAICE_GROWTH_LEGACY
791     & + a_QSWbyATM_cover(I,J) * AREApreTH(I,J)
792     #endif /* SEAICE_GROWTH_LEGACY */
793 mlosch 1.109 & + a_QbyATM_open(I,J) * ( ONE - AREApreTH(I,J) ) )
794 gforget 1.125 C
795     DIAGarrayB(I,J) = maskC(I,J,kSurface,bi,bj) *
796 mlosch 1.109 & a_FWbySublim(I,J) * AREApreTH(I,J)
797 gforget 1.125 C
798     DIAGarrayC(I,J) = maskC(I,J,kSurface,bi,bj)*(
799 mlosch 1.109 & PRECIP(I,J,bi,bj)
800 gforget 1.125 & - EVAP(I,J,bi,bj)*( ONE - AREApreTH(I,J) )
801 mlosch 1.109 #ifdef ALLOW_RUNOFF
802     & + RUNOFF(I,J,bi,bj)
803     #endif /* ALLOW_RUNOFF */
804     & )*rhoConstFresh
805     #ifdef SEAICE_ADD_SUBLIMATION_TO_FWBUDGET
806     & - a_FWbySublim(I,J)*AREApreTH(I,J)
807     #endif /* SEAICE_ADD_SUBLIMATION_TO_FWBUDGET */
808     ENDDO
809     ENDDO
810 gforget 1.125 IF ( DIAGNOSTICS_IS_ON('SIatmQnt',myThid) ) CALL
811     & DIAGNOSTICS_FILL(DIAGarrayA,'SIatmQnt',0,1,3,bi,bj,myThid)
812     IF ( DIAGNOSTICS_IS_ON('SIfwSubl',myThid) ) CALL
813     & DIAGNOSTICS_FILL(DIAGarrayB,'SIfwSubl',0,1,3,bi,bj,myThid)
814     IF ( DIAGNOSTICS_IS_ON('SIatmFW ',myThid) ) CALL
815     & DIAGNOSTICS_FILL(DIAGarrayC,'SIatmFW ',0,1,3,bi,bj,myThid)
816 dimitri 1.69 ENDIF
817 mlosch 1.109 #endif /* ALLOW_DIAGNOSTICS */
818 dimitri 1.69
819 jmc 1.104 C switch heat fluxes from W/m2 to 'effective' ice meters
820 gforget 1.83 DO J=1,sNy
821     DO I=1,sNx
822 mlosch 1.109 a_QbyATM_cover(I,J) = a_QbyATM_cover(I,J)
823 gforget 1.87 & * convertQ2HI * AREApreTH(I,J)
824 mlosch 1.109 a_QSWbyATM_cover(I,J) = a_QSWbyATM_cover(I,J)
825 gforget 1.87 & * convertQ2HI * AREApreTH(I,J)
826 mlosch 1.109 a_QbyATM_open(I,J) = a_QbyATM_open(I,J)
827 gforget 1.87 & * convertQ2HI * ( ONE - AREApreTH(I,J) )
828 mlosch 1.109 a_QSWbyATM_open(I,J) = a_QSWbyATM_open(I,J)
829 gforget 1.87 & * convertQ2HI * ( ONE - AREApreTH(I,J) )
830 jmc 1.104 C and initialize r_QbyATM_cover/r_QbyATM_open
831 mlosch 1.109 r_QbyATM_cover(I,J)=a_QbyATM_cover(I,J)
832     r_QbyATM_open(I,J)=a_QbyATM_open(I,J)
833     #ifdef SEAICE_ADD_SUBLIMATION_TO_FWBUDGET
834     C Convert fresh water flux by sublimation to 'effective' ice meters.
835     C Negative sublimation is resublimation and will be added as snow.
836     a_FWbySublim(I,J) = SEAICE_deltaTtherm/SEAICE_rhoIce
837     & * a_FWbySublim(I,J)*AREApreTH(I,J)
838 gforget 1.125 r_FWbySublim(I,J)=a_FWbySublim(I,J)
839 mlosch 1.109 #endif /* SEAICE_ADD_SUBLIMATION_TO_FWBUDGET */
840 gforget 1.83 ENDDO
841     ENDDO
842 gforget 1.75
843 gforget 1.105 #ifdef ALLOW_AUTODIFF_TAMC
844     #ifdef SEAICE_MODIFY_GROWTH_ADJ
845     Cgf no additional dependency through ice cover
846     if ( SEAICEadjMODE.GE.3 ) then
847     DO J=1,sNy
848     DO I=1,sNx
849     a_QbyATM_cover(I,J) = 0. _d 0
850     r_QbyATM_cover(I,J) = 0. _d 0
851     a_QSWbyATM_cover(I,J) = 0. _d 0
852     ENDDO
853     ENDDO
854     endif
855     #endif
856     #endif
857    
858 jmc 1.91 C determine available heat due to the ice pack tying the
859 gforget 1.75 C underlying surface water temperature to freezing point
860     C ======================================================
861    
862 dimitri 1.69 #ifdef ALLOW_AUTODIFF_TAMC
863 gforget 1.105 CADJ STORE theta(:,:,:,bi,bj) = comlev1_bibj,key=iicekey,byte=isbyte
864 dimitri 1.69 #endif
865 gforget 1.72
866 dimitri 1.69 DO J=1,sNy
867     DO I=1,sNx
868 dimitri 1.113
869 dimitri 1.69 #ifdef SEAICE_VARIABLE_FREEZING_POINT
870     TBC = -0.0575 _d 0*salt(I,J,kSurface,bi,bj) + 0.0901 _d 0
871     #endif /* SEAICE_VARIABLE_FREEZING_POINT */
872 gforget 1.110
873     #ifdef MCPHEE_OCEAN_ICE_HEAT_FLUX
874 dimitri 1.113
875     c Bound the ocean temperature to be at or above the freezing point.
876     surf_theta = max(theta(I,J,kSurface,bi,bj), TBC)
877     #ifdef GRADIENT_MIXED_LAYER_TURBULENCE_FACTOR
878     MixedLayerTurbulenceFactor = 12.5 _d 0 -
879     & 11.5 _d 0 *AREApreTH(I,J)
880     #else
881     c If ice is present, MixedLayerTurbulenceFactor = 1.0, else 12.50
882     IF (AREApreTH(I,J) .GT. 0. _d 0) THEN
883     MixedLayerTurbulenceFactor = ONE
884     ELSE
885     MixedLayerTurbulenceFactor = 12.5 _d 0
886     ENDIF
887     #endif /* GRADIENT_MIXED_LAYER_TURBULENCE_FACTOR */
888    
889     c The turbulent ocean-ice heat flux
890     a_QbyOCN(I,J) = -STANTON_NUMBER * USTAR_BASE * rhoConst *
891     & HeatCapacity_Cp *(surf_theta - TBC)*
892 ifenty 1.118 & MixedLayerTurbulenceFactor*maskC(i,j,kSurface,bi,bj)
893 dimitri 1.113
894     c The turbulent ocean-ice heat flux converted to meters
895     c of potential ice melt
896     a_QbyOCN(I,J) = a_QbyOCN(I,J) * convertQ2HI
897    
898 gforget 1.123 c by design a_QbyOCN .LE. 0. so that initial ice growth cannot
899 gforget 1.121 c be triggered by this term, which Ian says is better for adjoint
900 dimitri 1.113 #else
901    
902 gforget 1.110 IF ( theta(I,J,kSurface,bi,bj) .GE. TBC ) THEN
903     tmpscal1 = SEAICE_availHeatFrac
904     ELSE
905     tmpscal1 = SEAICE_availHeatFracFrz
906     ENDIF
907     tmpscal1 = tmpscal1
908 ifenty 1.118 & * dRf(kSurface) * maskC(i,j,kSurface,bi,bj)
909 gforget 1.110
910     a_QbyOCN(i,j) = -tmpscal1 * (HeatCapacity_Cp*rhoConst/QI)
911     & * (theta(I,J,kSurface,bi,bj)-TBC)
912 dimitri 1.113
913     #endif /* MCPHEE_OCEAN_ICE_HEAT_FLUX */
914    
915     r_QbyOCN(i,j) = a_QbyOCN(i,j)
916    
917 gforget 1.72 ENDDO
918     ENDDO
919 dimitri 1.113
920 gforget 1.96 #ifdef ALLOW_AUTODIFF_TAMC
921     #ifdef SEAICE_SIMPLIFY_GROWTH_ADJ
922 gforget 1.105 CALL ZERO_ADJ_1D( sNx*sNy, r_QbyOCN, myThid)
923 gforget 1.96 #endif
924     #endif
925 gforget 1.88
926    
927 jmc 1.104 C ===================================================================
928     C =========PART 3: determine effective thicknesses increments========
929     C ===================================================================
930 gforget 1.88
931 gforget 1.75 C compute ice thickness tendency due to ice-ocean interaction
932     C ===========================================================
933    
934 gforget 1.105 #ifdef ALLOW_AUTODIFF_TAMC
935     CADJ STORE heff(:,:,bi,bj) = comlev1_bibj,key=iicekey,byte=isbyte
936     CADJ STORE r_QbyOCN = comlev1_bibj,key=iicekey,byte=isbyte
937     #endif /* ALLOW_AUTODIFF_TAMC */
938    
939 gforget 1.72 DO J=1,sNy
940     DO I=1,sNx
941 dimitri 1.113 d_HEFFbyOCNonICE(I,J)=MAX(r_QbyOCN(i,j), -HEFF(I,J,bi,bj))
942     r_QbyOCN(I,J)=r_QbyOCN(I,J)-d_HEFFbyOCNonICE(I,J)
943     HEFF(I,J,bi,bj)=HEFF(I,J,bi,bj) + d_HEFFbyOCNonICE(I,J)
944 gforget 1.124 #ifdef ALLOW_SITRACER
945     SItrHEFF(I,J,bi,bj,2)=HEFF(I,J,bi,bj)
946     #endif
947 dimitri 1.69 ENDDO
948     ENDDO
949    
950 gforget 1.125 C compute snow/ice tendency due to sublimation
951     C ============================================
952 gforget 1.75
953 mlosch 1.109 #ifdef SEAICE_ADD_SUBLIMATION_TO_FWBUDGET
954     #ifdef ALLOW_AUTODIFF_TAMC
955     CADJ STORE hsnow(:,:,bi,bj) = comlev1_bibj,key=iicekey,byte=isbyte
956 gforget 1.125 CADJ STORE r_FWbySublim = comlev1_bibj,key=iicekey,byte=isbyte
957 mlosch 1.109 #endif /* ALLOW_AUTODIFF_TAMC */
958     DO J=1,sNy
959     DO I=1,sNx
960 gforget 1.125 C First sublimate/deposite snow
961     tmpscal2 = MIN(r_FWbySublim(I,J),HSNOW(I,J,bi,bj)/ICE2SNOW)
962     d_HSNWbySublim(I,J) = - tmpscal2 * ICE2SNOW
963     HSNOW(I,J,bi,bj) = HSNOW(I,J,bi,bj) - tmpscal2*ICE2SNOW
964     r_FWbySublim(I,J) = r_FWbySublim(I,J) - tmpscal2
965     ENDDO
966     ENDDO
967     #ifdef ALLOW_AUTODIFF_TAMC
968     CADJ STORE heff(:,:,bi,bj) = comlev1_bibj,key=iicekey,byte=isbyte
969     CADJ STORE r_FWbySublim = comlev1_bibj,key=iicekey,byte=isbyte
970     #endif /* ALLOW_AUTODIFF_TAMC */
971     DO J=1,sNy
972     DO I=1,sNx
973     C If anything is left, sublimate ice
974     tmpscal2 = MIN(r_FWbySublim(I,J),HEFF(I,J,bi,bj))
975     d_HEFFbySublim(I,J) = - tmpscal2
976     HEFF(I,J,bi,bj) = HEFF(I,J,bi,bj) - tmpscal2
977     r_FWbySublim(I,J) = r_FWbySublim(I,J) - tmpscal2
978 mlosch 1.109 ENDDO
979     ENDDO
980 gforget 1.125 C If anything is left, evaporate ocean, and correct for Lfusion heat.
981 mlosch 1.109 #endif /* SEAICE_ADD_SUBLIMATION_TO_FWBUDGET */
982    
983 gforget 1.125 C compute snow melt tendency due to snow-atmosphere interaction
984     C ==================================================================
985    
986 dimitri 1.69 #ifdef ALLOW_AUTODIFF_TAMC
987 gforget 1.105 CADJ STORE hsnow(:,:,bi,bj) = comlev1_bibj,key=iicekey,byte=isbyte
988     CADJ STORE r_QbyATM_cover = comlev1_bibj,key=iicekey,byte=isbyte
989 dimitri 1.69 #endif /* ALLOW_AUTODIFF_TAMC */
990 gforget 1.75
991 dimitri 1.69 DO J=1,sNy
992     DO I=1,sNx
993 gforget 1.105 tmpscal1=MAX(r_QbyATM_cover(I,J)*ICE2SNOW,-HSNOW(I,J,bi,bj))
994     tmpscal2=MIN(tmpscal1,0. _d 0)
995     #ifdef SEAICE_MODIFY_GROWTH_ADJ
996     Cgf no additional dependency through snow
997     if ( SEAICEadjMODE.GE.2 ) tmpscal2 = 0. _d 0
998     #endif
999 dimitri 1.113 d_HSNWbyATMonSNW(I,J)= tmpscal2
1000 gforget 1.105 HSNOW(I,J,bi,bj) = HSNOW(I,J,bi,bj) + tmpscal2
1001     r_QbyATM_cover(I,J)=r_QbyATM_cover(I,J) - tmpscal2/ICE2SNOW
1002 dimitri 1.69 ENDDO
1003     ENDDO
1004    
1005 gforget 1.89 C compute ice thickness tendency due to the atmosphere
1006     C ====================================================
1007 gforget 1.75
1008 mlosch 1.109 #ifdef ALLOW_AUTODIFF_TAMC
1009     CADJ STORE heff(:,:,bi,bj) = comlev1_bibj,key=iicekey,byte=isbyte
1010     CADJ STORE r_QbyATM_cover = comlev1_bibj,key=iicekey,byte=isbyte
1011 gforget 1.105 #endif /* ALLOW_AUTODIFF_TAMC */
1012 gforget 1.75
1013 jmc 1.104 Cgf note: this block is not actually tested by lab_sea
1014     Cgf where all experiments start in January. So even though
1015     Cgf the v1.81=>v1.82 revision would change results in
1016     Cgf warming conditions, the lab_sea results were not changed.
1017 gforget 1.82
1018 dimitri 1.69 DO J=1,sNy
1019     DO I=1,sNx
1020 dimitri 1.113
1021 gforget 1.111 #ifdef SEAICE_GROWTH_LEGACY
1022 gforget 1.84 tmpscal2 = MAX(-HEFF(I,J,bi,bj),r_QbyATM_cover(I,J))
1023 gforget 1.111 #else
1024     tmpscal2 = MAX(-HEFF(I,J,bi,bj),r_QbyATM_cover(I,J)+
1025     c Limit ice growth by potential melt by ocean
1026     & AREApreTH(I,J) * r_QbyOCN(I,J))
1027 dimitri 1.113 #endif /* SEAICE_GROWTH_LEGACY */
1028    
1029 dimitri 1.114 d_HEFFbyATMonOCN_cover(I,J)=tmpscal2
1030     d_HEFFbyATMonOCN(I,J)=d_HEFFbyATMonOCN(I,J)+tmpscal2
1031 gforget 1.89 r_QbyATM_cover(I,J)=r_QbyATM_cover(I,J)-tmpscal2
1032     HEFF(I,J,bi,bj) = HEFF(I,J,bi,bj) + tmpscal2
1033 dimitri 1.113
1034 gforget 1.124 #ifdef ALLOW_SITRACER
1035     SItrHEFF(I,J,bi,bj,3)=HEFF(I,J,bi,bj)
1036     #endif
1037 gforget 1.74 ENDDO
1038     ENDDO
1039 dimitri 1.69
1040 jmc 1.91 C attribute precip to fresh water or snow stock,
1041 gforget 1.75 C depending on atmospheric conditions.
1042     C =================================================
1043 dimitri 1.69 #ifdef ALLOW_ATM_TEMP
1044 gforget 1.105 #ifdef ALLOW_AUTODIFF_TAMC
1045     CADJ STORE a_QbyATM_cover = comlev1_bibj,key=iicekey,byte=isbyte
1046     CADJ STORE PRECIP(:,:,bi,bj) = comlev1_bibj,key=iicekey,byte=isbyte
1047     CADJ STORE AREApreTH = comlev1_bibj,key=iicekey,byte=isbyte
1048     #endif /* ALLOW_AUTODIFF_TAMC */
1049 gforget 1.74 DO J=1,sNy
1050     DO I=1,sNx
1051 jmc 1.104 C possible alternatives to the a_QbyATM_cover criterium
1052 gforget 1.89 c IF (TICE(I,J,bi,bj) .LT. TMIX) THEN
1053     c IF (atemp(I,J,bi,bj) .LT. celsius2K) THEN
1054     IF ( a_QbyATM_cover(I,J).GE. 0. _d 0 ) THEN
1055 gforget 1.73 C add precip as snow
1056 gforget 1.84 d_HFRWbyRAIN(I,J)=0. _d 0
1057     d_HSNWbyRAIN(I,J)=convertPRECIP2HI*ICE2SNOW*
1058 gforget 1.87 & PRECIP(I,J,bi,bj)*AREApreTH(I,J)
1059 jmc 1.91 ELSE
1060 jmc 1.104 C add precip to the fresh water bucket
1061 gforget 1.84 d_HFRWbyRAIN(I,J)=-convertPRECIP2HI*
1062 gforget 1.87 & PRECIP(I,J,bi,bj)*AREApreTH(I,J)
1063 gforget 1.84 d_HSNWbyRAIN(I,J)=0. _d 0
1064 dimitri 1.69 ENDIF
1065 jmc 1.91 HSNOW(I,J,bi,bj) = HSNOW(I,J,bi,bj) + d_HSNWbyRAIN(I,J)
1066 dimitri 1.69 ENDDO
1067     ENDDO
1068 jmc 1.104 Cgf note: this does not affect air-sea heat flux,
1069     Cgf since the implied air heat gain to turn
1070     Cgf rain to snow is not a surface process.
1071 gforget 1.74 #endif /* ALLOW_ATM_TEMP */
1072 dimitri 1.69
1073 gforget 1.89 C compute snow melt due to heat available from ocean.
1074 gforget 1.75 C =================================================================
1075 dimitri 1.69
1076 jmc 1.104 Cgf do we need to keep this comment and cpp bracket?
1077     Cph( very sensitive bit here by JZ
1078 dimitri 1.69 #ifndef SEAICE_EXCLUDE_FOR_EXACT_AD_TESTING
1079 gforget 1.105 #ifdef ALLOW_AUTODIFF_TAMC
1080     CADJ STORE HSNOW(:,:,bi,bj) = comlev1_bibj,key=iicekey,byte=isbyte
1081     CADJ STORE r_QbyOCN = comlev1_bibj,key=iicekey,byte=isbyte
1082     #endif /* ALLOW_AUTODIFF_TAMC */
1083 dimitri 1.69 DO J=1,sNy
1084     DO I=1,sNx
1085 gforget 1.105 tmpscal1=MAX(r_QbyOCN(i,j)*ICE2SNOW, -HSNOW(I,J,bi,bj))
1086     tmpscal2=MIN(tmpscal1,0. _d 0)
1087     #ifdef SEAICE_MODIFY_GROWTH_ADJ
1088     Cgf no additional dependency through snow
1089     if ( SEAICEadjMODE.GE.2 ) tmpscal2 = 0. _d 0
1090     #endif
1091 dimitri 1.113 d_HSNWbyOCNonSNW(I,J) = tmpscal2
1092 gforget 1.84 r_QbyOCN(I,J)=r_QbyOCN(I,J)
1093 dimitri 1.113 & -d_HSNWbyOCNonSNW(I,J)/ICE2SNOW
1094     HSNOW(I,J,bi,bj) = HSNOW(I,J,bi,bj)+d_HSNWbyOCNonSNW(I,J)
1095 dimitri 1.69 ENDDO
1096     ENDDO
1097 gforget 1.75 #endif /* SEAICE_EXCLUDE_FOR_EXACT_AD_TESTING */
1098 jmc 1.104 Cph)
1099 gforget 1.90
1100     C gain of new ice over open water
1101     C ===============================
1102     #ifndef SEAICE_GROWTH_LEGACY
1103     #ifdef ALLOW_AUTODIFF_TAMC
1104 gforget 1.105 CADJ STORE heff(:,:,bi,bj) = comlev1_bibj,key=iicekey,byte=isbyte
1105     CADJ STORE r_QbyATM_open = comlev1_bibj,key=iicekey,byte=isbyte
1106     CADJ STORE r_QbyOCN = comlev1_bibj,key=iicekey,byte=isbyte
1107 dimitri 1.113 CADJ STORE a_QSWbyATM_cover = comlev1_bibj,key=iicekey,byte=isbyte
1108 gforget 1.105 CADJ STORE a_QSWbyATM_open = comlev1_bibj,key=iicekey,byte=isbyte
1109     #endif /* ALLOW_AUTODIFF_TAMC */
1110 gforget 1.90 DO J=1,sNy
1111     DO I=1,sNx
1112 dimitri 1.113 #ifdef SEAICE_DO_OPEN_WATER_GROWTH
1113 gforget 1.111 c Initial ice growth is triggered by open water
1114     c heat flux overcoming potential melt by ocean
1115     tmpscal1=r_QbyATM_open(I,J)+r_QbyOCN(i,j) *
1116     & (1.0 _d 0 - AREApreTH(i,J))
1117     c Penetrative shortwave flux beyond first layer
1118 gforget 1.121 c that is therefore not available to ice growth/melt
1119 gforget 1.111 tmpscal2=SWFRACB * a_QSWbyATM_open(I,J)
1120     #ifdef SEAICE_DO_OPEN_WATER_MELT
1121     C allow not only growth but also melt by open ocean heat flux
1122     tmpscal3=MAX(tmpscal1-tmpscal2, -HEFF(I,J,bi,bj))
1123     #else
1124     tmpscal3=MAX(tmpscal1-tmpscal2, 0. _d 0)
1125     #endif /* SEAICE_DO_OPEN_WATER_MELT */
1126 dimitri 1.114 d_HEFFbyATMonOCN_open(I,J)=tmpscal3
1127 dimitri 1.113 d_HEFFbyATMonOCN(I,J)=d_HEFFbyATMonOCN(I,J)+tmpscal3
1128 gforget 1.90 r_QbyATM_open(I,J)=r_QbyATM_open(I,J)-tmpscal3
1129 gforget 1.128 HEFF(I,J,bi,bj) = HEFF(I,J,bi,bj) + tmpscal3
1130 dimitri 1.113 #endif /* SEAICE_DO_OPEN_WATER_GROWTH */
1131 gforget 1.90 ENDDO
1132     ENDDO
1133     #endif /* SEAICE_GROWTH_LEGACY */
1134    
1135 gforget 1.124 #ifdef ALLOW_SITRACER
1136     DO J=1,sNy
1137     DO I=1,sNx
1138     c needs to be here to allow use also with LEGACY branch
1139     SItrHEFF(I,J,bi,bj,4)=HEFF(I,J,bi,bj)
1140     ENDDO
1141     ENDDO
1142     #endif
1143    
1144 gforget 1.87 C convert snow to ice if submerged.
1145     C =================================
1146    
1147 gforget 1.89 #ifndef SEAICE_GROWTH_LEGACY
1148 jmc 1.104 C note: in legacy, this process is done at the end
1149 gforget 1.87 #ifdef ALLOW_SEAICE_FLOODING
1150 gforget 1.105 #ifdef ALLOW_AUTODIFF_TAMC
1151     CADJ STORE heff(:,:,bi,bj) = comlev1_bibj,key=iicekey,byte=isbyte
1152     CADJ STORE hsnow(:,:,bi,bj) = comlev1_bibj,key=iicekey,byte=isbyte
1153     #endif /* ALLOW_AUTODIFF_TAMC */
1154 gforget 1.87 IF ( SEAICEuseFlooding ) THEN
1155     DO J=1,sNy
1156     DO I=1,sNx
1157 gforget 1.105 hDraft = (HSNOW(I,J,bi,bj)*SEAICE_rhoSnow
1158 gforget 1.87 & +HEFF(I,J,bi,bj)*SEAICE_rhoIce)/rhoConst
1159     tmpscal1 = MAX( 0. _d 0, hDraft - HEFF(I,J,bi,bj))
1160     d_HEFFbyFLOODING(I,J)=tmpscal1
1161     HEFF(I,J,bi,bj) = HEFF(I,J,bi,bj)+d_HEFFbyFLOODING(I,J)
1162     HSNOW(I,J,bi,bj) = HSNOW(I,J,bi,bj)-
1163 jmc 1.91 & d_HEFFbyFLOODING(I,J)*ICE2SNOW
1164 gforget 1.87 ENDDO
1165     ENDDO
1166     ENDIF
1167     #endif /* ALLOW_SEAICE_FLOODING */
1168     #endif /* SEAICE_GROWTH_LEGACY */
1169    
1170 jmc 1.104 C ===================================================================
1171     C ==========PART 4: determine ice cover fraction increments=========-
1172     C ===================================================================
1173 gforget 1.75
1174 dimitri 1.69 #ifdef ALLOW_AUTODIFF_TAMC
1175 dimitri 1.113 CADJ STORE d_HEFFbyATMonOCN = comlev1_bibj,key=iicekey,byte=isbyte
1176 dimitri 1.114 CADJ STORE d_HEFFbyATMonOCN_cover = comlev1_bibj,key=iicekey,byte=isbyte
1177     CADJ STORE d_HEFFbyATMonOCN_open = comlev1_bibj,key=iicekey,byte=isbyte
1178 dimitri 1.113 CADJ STORE d_HEFFbyOCNonICE = comlev1_bibj,key=iicekey,byte=isbyte
1179 ifenty 1.131 CADJ STORE recip_heffActual = comlev1_bibj,key=iicekey,byte=isbyte
1180     CADJ STORE d_AREAbyATM = comlev1_bibj,key=iicekey,byte=isbyte
1181     CADJ STORE d_AREAbyICE = comlev1_bibj,key=iicekey,byte=isbyte
1182     CADJ STORE d_AREAbyOCN = comlev1_bibj,key=iicekey,byte=isbyte
1183 gforget 1.105 CADJ STORE a_QbyATM_open = comlev1_bibj,key=iicekey,byte=isbyte
1184     CADJ STORE heffActual = comlev1_bibj,key=iicekey,byte=isbyte
1185     CADJ STORE AREApreTH = comlev1_bibj,key=iicekey,byte=isbyte
1186     CADJ STORE HEFF(:,:,bi,bj) = comlev1_bibj,key=iicekey,byte=isbyte
1187     CADJ STORE HSNOW(:,:,bi,bj) = comlev1_bibj,key=iicekey,byte=isbyte
1188     CADJ STORE AREA(:,:,bi,bj) = comlev1_bibj,key=iicekey,byte=isbyte
1189 dimitri 1.69 #endif /* ALLOW_AUTODIFF_TAMC */
1190    
1191     DO J=1,sNy
1192     DO I=1,sNx
1193 jmc 1.104
1194 gforget 1.123 IF ( YC(I,J,bi,bj) .LT. ZERO ) THEN
1195     HO_loc=HO_south
1196     ELSE
1197     HO_loc=HO
1198 dimitri 1.113 ENDIF
1199    
1200 gforget 1.123 C compute contraction/expansion from melt/growth
1201 dimitri 1.113 #ifdef SEAICE_GROWTH_LEGACY
1202    
1203 jmc 1.104 C compute heff after ice melt by ocn:
1204 gforget 1.123 tmpscal0=HEFF(I,J,bi,bj) - d_HEFFbyATMonOCN(I,J)
1205 jmc 1.104 C compute available heat left after snow melt by atm:
1206     tmpscal1= a_QbyATM_open(I,J)+a_QbyATM_cover(I,J)
1207 dimitri 1.113 & - d_HSNWbyATMonSNW(I,J)/ICE2SNOW
1208 jmc 1.104 C (cannot melt more than all the ice)
1209     tmpscal2 = MAX(-tmpscal0,tmpscal1)
1210     tmpscal3 = MIN(ZERO,tmpscal2)
1211     C gain of new ice over open water
1212 gforget 1.123 tmpscal4=MAX(ZERO,a_QbyATM_open(I,J))
1213     C compute cover fraction tendency
1214     d_AREAbyATM(I,J)=tmpscal4/HO_loc+HALF*tmpscal3
1215     & *AREApreTH(I,J) /(tmpscal0+.00001 _d 0)
1216 jmc 1.104
1217 dimitri 1.113 #else /* SEAICE_GROWTH_LEGACY */
1218    
1219 gforget 1.123 # ifdef FENTY_AREA_EXPANSION_CONTRACTION
1220    
1221     C the various volume tendency terms
1222     tmpscal1 = d_HEFFbyATMOnOCN_open(I,J)
1223     tmpscal2 = d_HEFFbyATMOnOCN_cover(I,J)
1224     tmpscal3 = d_HEFFbyOCNonICE(I,J)
1225    
1226     C Part 1: expansion/contraction of ice cover in open-water areas.
1227     IF (tmpscal1 .GT. ZERO) then
1228     C Ice cover is all created from open ocean-water air-sea heat fluxes
1229     d_AREAbyATM(I,J)=tmpscal1/HO_loc
1230     ELSEIF (AREApreTH(I,J) .GT. ZERO) THEN
1231     C that can also act to remove ice cover.
1232     d_AREAbyATM(i,J) = HALF*tmpscal1*recip_heffActual(I,J)
1233     ENDIF
1234    
1235     C Part 2: contraction from ice thinning from above
1236     if (tmpscal2 .LE. ZERO) d_AREAbyICE(I,J) =
1237     & HALF * tmpscal2 * recip_heffActual(I,J)
1238    
1239     C Part 3: contraction from ice thinning from below
1240     if (tmpscal3 .LE.ZERO) d_AREAbyOCN(I,J) =
1241     & HALF * tmpscal3* recip_heffActual(I,J)
1242    
1243     # else /* FENTY_AREA_EXPANSION_CONTRACTION */
1244    
1245     # ifdef SEAICE_OCN_MELT_ACT_ON_AREA
1246 jmc 1.104 C ice cover reduction by joint OCN+ATM melt
1247 dimitri 1.113 tmpscal3 = MIN( 0. _d 0 ,
1248 dimitri 1.114 & d_HEFFbyATMonOCN(I,J)+d_HEFFbyOCNonICE(I,J) )
1249 gforget 1.123 # else
1250 dimitri 1.113 C ice cover reduction by ATM melt only -- as in legacy code
1251 dimitri 1.114 tmpscal3 = MIN( 0. _d 0 , d_HEFFbyATMonOCN(I,J) )
1252 gforget 1.123 # endif
1253 gforget 1.89 C gain of new ice over open water
1254 dimitri 1.113
1255 gforget 1.123 # ifdef SEAICE_DO_OPEN_WATER_GROWTH
1256 jmc 1.104 C the one effectively used to increment HEFF
1257 gforget 1.123 tmpscal4 = MAX(ZERO,d_HEFFbyATMonOCN_open(I,J))
1258     # else
1259 jmc 1.104 C the virtual one -- as in legcy code
1260 gforget 1.90 tmpscal4 = MAX(ZERO,a_QbyATM_open(I,J))
1261 gforget 1.123 # endif
1262 dimitri 1.113
1263 jmc 1.104 C compute cover fraction tendency
1264 gforget 1.123 d_AREAbyATM(I,J)=tmpscal4/HO_loc+
1265     & HALF*tmpscal3*recip_heffActual(I,J)
1266    
1267     # endif /* FENTY_AREA_EXPANSION_CONTRACTION */
1268 gforget 1.112
1269 gforget 1.123 #endif /* SEAICE_GROWTH_LEGACY */
1270 gforget 1.112
1271 jmc 1.104 C apply tendency
1272 gforget 1.90 IF ( (HEFF(i,j,bi,bj).GT.0. _d 0).OR.
1273     & (HSNOW(i,j,bi,bj).GT.0. _d 0) ) THEN
1274 ifenty 1.131 AREA(I,J,bi,bj)=max(0. _d 0,
1275     & min( SEAICE_area_max, AREA(I,J,bi,bj)
1276     & +d_AREAbyATM(I,J) + d_AREAbyOCN(I,J) + d_AREAbyICE(I,J) ))
1277 gforget 1.90 ELSE
1278     AREA(I,J,bi,bj)=0. _d 0
1279     ENDIF
1280 gforget 1.127 #ifdef ALLOW_SITRACER
1281     SItrAREA(I,J,bi,bj,3)=AREA(I,J,bi,bj)
1282     #endif
1283 dimitri 1.69 ENDDO
1284     ENDDO
1285    
1286 gforget 1.105 #ifdef ALLOW_AUTODIFF_TAMC
1287     #ifdef SEAICE_MODIFY_GROWTH_ADJ
1288     Cgf 'bulk' linearization of area=f(HEFF)
1289     if ( SEAICEadjMODE.GE.1 ) then
1290     DO J=1,sNy
1291     DO I=1,sNx
1292     C AREA(I,J,bi,bj) = 0.1 _d 0 * HEFF(I,J,bi,bj)
1293     AREA(I,J,bi,bj) = AREApreTH(I,J) + 0.1 _d 0 *
1294     & ( HEFF(I,J,bi,bj) - HEFFpreTH(I,J) )
1295     ENDDO
1296     ENDDO
1297     endif
1298     #endif
1299     #endif
1300    
1301 jmc 1.104 C ===================================================================
1302     C =============PART 5: determine ice salinity increments=============
1303     C ===================================================================
1304 gforget 1.88
1305 ifenty 1.119 #ifndef SEAICE_VARIABLE_SALINITY
1306 gforget 1.107 # ifdef ALLOW_AUTODIFF_TAMC
1307     # ifdef ALLOW_SALT_PLUME
1308     CADJ STORE d_HEFFbyNEG = comlev1_bibj,key=iicekey,byte=isbyte
1309 dimitri 1.113 CADJ STORE d_HEFFbyOCNonICE = comlev1_bibj,key=iicekey,byte=isbyte
1310     CADJ STORE d_HEFFbyATMonOCN = comlev1_bibj,key=iicekey,byte=isbyte
1311 dimitri 1.114 CADJ STORE d_HEFFbyATMonOCN_open = comlev1_bibj,key=iicekey,byte=isbyte
1312     CADJ STORE d_HEFFbyATMonOCN_cover = comlev1_bibj,key=iicekey,byte=isbyte
1313 gforget 1.107 CADJ STORE d_HEFFbyFLOODING = comlev1_bibj,key=iicekey,byte=isbyte
1314     CADJ STORE salt(:,:,kSurface,bi,bj) = comlev1_bibj,
1315     CADJ & key = iicekey, byte = isbyte
1316     # endif /* ALLOW_SALT_PLUME */
1317     # endif /* ALLOW_AUTODIFF_TAMC */
1318 gforget 1.106 DO J=1,sNy
1319     DO I=1,sNx
1320     Cgf note: flooding does count negatively
1321 dimitri 1.113 tmpscal1 = d_HEFFbyNEG(I,J) + d_HEFFbyOCNonICE(I,J) +
1322     & d_HEFFbyATMonOCN(I,J) - d_HEFFbyFLOODING(I,J)
1323 gforget 1.106 tmpscal2 = tmpscal1 * SIsal0 * HEFFM(I,J,bi,bj)
1324 ifenty 1.118 & /SEAICE_deltaTtherm * SEAICE_rhoIce
1325 gforget 1.107 saltFlux(I,J,bi,bj) = tmpscal2
1326 gforget 1.106 #ifdef ALLOW_SALT_PLUME
1327     tmpscal3 = tmpscal1*salt(I,j,kSurface,bi,bj)*HEFFM(I,J,bi,bj)
1328 ifenty 1.118 & /SEAICE_deltaTtherm * SEAICE_rhoIce
1329 gforget 1.106 saltPlumeFlux(I,J,bi,bj) = MAX( tmpscal3-tmpscal2 , 0. _d 0)
1330 gforget 1.126 & *SPsalFRAC
1331 gforget 1.106 #endif /* ALLOW_SALT_PLUME */
1332     ENDDO
1333     ENDDO
1334     #endif
1335    
1336 gforget 1.88 #ifdef ALLOW_ATM_TEMP
1337 ifenty 1.119 #ifdef SEAICE_VARIABLE_SALINITY
1338 dimitri 1.69
1339 gforget 1.87 #ifdef SEAICE_GROWTH_LEGACY
1340 gforget 1.88 # ifdef ALLOW_AUTODIFF_TAMC
1341 gforget 1.105 CADJ STORE hsalt(:,:,bi,bj) = comlev1_bibj,key=iicekey,byte=isbyte
1342 gforget 1.88 # endif /* ALLOW_AUTODIFF_TAMC */
1343 dimitri 1.69 DO J=1,sNy
1344     DO I=1,sNx
1345     C set HSALT = 0 if HSALT < 0 and compute salt to remove from ocean
1346     IF ( HSALT(I,J,bi,bj) .LT. 0.0 ) THEN
1347     saltFluxAdjust(I,J) = - HEFFM(I,J,bi,bj) *
1348     & HSALT(I,J,bi,bj) / SEAICE_deltaTtherm
1349     HSALT(I,J,bi,bj) = 0.0 _d 0
1350     ENDIF
1351     ENDDO
1352     ENDDO
1353 gforget 1.87 #endif /* SEAICE_GROWTH_LEGACY */
1354 dimitri 1.69
1355     #ifdef ALLOW_AUTODIFF_TAMC
1356 gforget 1.105 CADJ STORE hsalt(:,:,bi,bj) = comlev1_bibj,key=iicekey,byte=isbyte
1357 dimitri 1.69 #endif /* ALLOW_AUTODIFF_TAMC */
1358    
1359     DO J=1,sNy
1360     DO I=1,sNx
1361 jmc 1.104 C sum up the terms that affect the salt content of the ice pack
1362 dimitri 1.114 tmpscal1=d_HEFFbyOCNonICE(I,J)+d_HEFFbyATMonOCN(I,J)
1363 dimitri 1.113
1364 jmc 1.104 C recompute HEFF before thermodyncamic updates (which is not AREApreTH in legacy code)
1365 gforget 1.87 tmpscal2=HEFF(I,J,bi,bj)-tmpscal1-d_HEFFbyFLOODING(I,J)
1366 gforget 1.84 C tmpscal1 > 0 : m of sea ice that is created
1367     IF ( tmpscal1 .GE. 0.0 ) THEN
1368 dimitri 1.69 saltFlux(I,J,bi,bj) =
1369 gforget 1.87 & HEFFM(I,J,bi,bj)/SEAICE_deltaTtherm
1370 ifenty 1.119 & *SIsalFRAC*salt(I,j,kSurface,bi,bj)
1371 ifenty 1.118 & *tmpscal1*SEAICE_rhoIce
1372 dimitri 1.69 #ifdef ALLOW_SALT_PLUME
1373     C saltPlumeFlux is defined only during freezing:
1374     saltPlumeFlux(I,J,bi,bj)=
1375 gforget 1.87 & HEFFM(I,J,bi,bj)/SEAICE_deltaTtherm
1376 ifenty 1.119 & *(1-SIsalFRAC)*salt(I,j,kSurface,bi,bj)
1377 ifenty 1.118 & *tmpscal1*SEAICE_rhoIce
1378 gforget 1.126 & *SPsalFRAC
1379 dimitri 1.69 C if SaltPlumeSouthernOcean=.FALSE. turn off salt plume in Southern Ocean
1380     IF ( .NOT. SaltPlumeSouthernOcean ) THEN
1381     IF ( YC(I,J,bi,bj) .LT. 0.0 _d 0 )
1382     & saltPlumeFlux(i,j,bi,bj) = 0.0 _d 0
1383     ENDIF
1384 jmc 1.104 #endif /* ALLOW_SALT_PLUME */
1385 dimitri 1.69
1386 gforget 1.84 C tmpscal1 < 0 : m of sea ice that is melted
1387 dimitri 1.69 ELSE
1388     saltFlux(I,J,bi,bj) =
1389 gforget 1.87 & HEFFM(I,J,bi,bj)/SEAICE_deltaTtherm
1390     & *HSALT(I,J,bi,bj)
1391     & *tmpscal1/tmpscal2
1392 dimitri 1.69 #ifdef ALLOW_SALT_PLUME
1393     saltPlumeFlux(i,j,bi,bj) = 0.0 _d 0
1394     #endif /* ALLOW_SALT_PLUME */
1395     ENDIF
1396     C update HSALT based on surface saltFlux
1397     HSALT(I,J,bi,bj) = HSALT(I,J,bi,bj) +
1398     & saltFlux(I,J,bi,bj) * SEAICE_deltaTtherm
1399     saltFlux(I,J,bi,bj) =
1400     & saltFlux(I,J,bi,bj) + saltFluxAdjust(I,J)
1401 gforget 1.87 #ifdef SEAICE_GROWTH_LEGACY
1402 dimitri 1.69 C set HSALT = 0 if HEFF = 0 and compute salt to dump into ocean
1403     IF ( HEFF(I,J,bi,bj) .EQ. 0.0 ) THEN
1404     saltFlux(I,J,bi,bj) = saltFlux(I,J,bi,bj) -
1405     & HEFFM(I,J,bi,bj) * HSALT(I,J,bi,bj) /
1406     & SEAICE_deltaTtherm
1407     HSALT(I,J,bi,bj) = 0.0 _d 0
1408     #ifdef ALLOW_SALT_PLUME
1409     saltPlumeFlux(i,j,bi,bj) = 0.0 _d 0
1410     #endif /* ALLOW_SALT_PLUME */
1411     ENDIF
1412 gforget 1.87 #endif /* SEAICE_GROWTH_LEGACY */
1413 dimitri 1.69 ENDDO
1414     ENDDO
1415 ifenty 1.119 #endif /* SEAICE_VARIABLE_SALINITY */
1416 dimitri 1.69 #endif /* ALLOW_ATM_TEMP */
1417    
1418 gforget 1.75
1419 jmc 1.104 C =======================================================================
1420     C =====LEGACY PART 5.5: treat pathological cases, then do flooding ======
1421     C =======================================================================
1422 gforget 1.72
1423 gforget 1.87 #ifdef SEAICE_GROWTH_LEGACY
1424    
1425 jmc 1.91 C treat values of ice cover fraction oustide
1426 gforget 1.75 C the [0 1] range, and other such issues.
1427     C ===========================================
1428    
1429 jmc 1.104 Cgf note: this part cannot be heat and water conserving
1430 gforget 1.76
1431 dimitri 1.69 #ifdef ALLOW_AUTODIFF_TAMC
1432     CADJ STORE area(:,:,bi,bj) = comlev1_bibj,
1433     CADJ & key = iicekey, byte = isbyte
1434     CADJ STORE heff(:,:,bi,bj) = comlev1_bibj,
1435     CADJ & key = iicekey, byte = isbyte
1436     #endif /* ALLOW_AUTODIFF_TAMC */
1437     DO J=1,sNy
1438     DO I=1,sNx
1439     C NOW SET AREA(I,J,bi,bj)=0 WHERE NO ICE IS
1440     AREA(I,J,bi,bj)=MIN(AREA(I,J,bi,bj)
1441     & ,HEFF(I,J,bi,bj)/.0001 _d 0)
1442     ENDDO
1443     ENDDO
1444 gforget 1.75
1445 dimitri 1.69 #ifdef ALLOW_AUTODIFF_TAMC
1446     CADJ STORE area(:,:,bi,bj) = comlev1_bibj,
1447     CADJ & key = iicekey, byte = isbyte
1448     #endif /* ALLOW_AUTODIFF_TAMC */
1449     DO J=1,sNy
1450     DO I=1,sNx
1451     C NOW TRUNCATE AREA
1452     AREA(I,J,bi,bj)=MIN(ONE,AREA(I,J,bi,bj))
1453     ENDDO
1454     ENDDO
1455 gforget 1.75
1456 dimitri 1.69 #ifdef ALLOW_AUTODIFF_TAMC
1457     CADJ STORE area(:,:,bi,bj) = comlev1_bibj,
1458     CADJ & key = iicekey, byte = isbyte
1459     CADJ STORE hsnow(:,:,bi,bj) = comlev1_bibj,
1460     CADJ & key = iicekey, byte = isbyte
1461     #endif /* ALLOW_AUTODIFF_TAMC */
1462     DO J=1,sNy
1463     DO I=1,sNx
1464     AREA(I,J,bi,bj) = MAX(ZERO,AREA(I,J,bi,bj))
1465     HSNOW(I,J,bi,bj) = MAX(ZERO,HSNOW(I,J,bi,bj))
1466     AREA(I,J,bi,bj) = AREA(I,J,bi,bj)*HEFFM(I,J,bi,bj)
1467     HEFF(I,J,bi,bj) = HEFF(I,J,bi,bj)*HEFFM(I,J,bi,bj)
1468     #ifdef SEAICE_CAP_HEFF
1469 mlosch 1.97 C This is not energy conserving, but at least it conserves fresh water
1470 mlosch 1.103 tmpscal0 = -MAX(HEFF(I,J,bi,bj)-MAX_HEFF,0. _d 0)
1471     d_HEFFbyNeg(I,J) = d_HEFFbyNeg(I,J) + tmpscal0
1472     HEFF(I,J,bi,bj) = HEFF(I,J,bi,bj) + tmpscal0
1473 dimitri 1.69 #endif /* SEAICE_CAP_HEFF */
1474     HSNOW(I,J,bi,bj) = HSNOW(I,J,bi,bj)*HEFFM(I,J,bi,bj)
1475     ENDDO
1476     ENDDO
1477    
1478 gforget 1.75 C convert snow to ice if submerged.
1479     C =================================
1480    
1481 dimitri 1.69 #ifdef ALLOW_SEAICE_FLOODING
1482     IF ( SEAICEuseFlooding ) THEN
1483     DO J=1,sNy
1484     DO I=1,sNx
1485     hDraft = (HSNOW(I,J,bi,bj)*SEAICE_rhoSnow
1486 gforget 1.85 & +HEFF(I,J,bi,bj)*SEAICE_rhoIce)/rhoConst
1487 jmc 1.86 tmpscal1 = MAX( 0. _d 0, hDraft - HEFF(I,J,bi,bj))
1488 gforget 1.84 d_HEFFbyFLOODING(I,J)=tmpscal1
1489     HEFF(I,J,bi,bj) = HEFF(I,J,bi,bj)+d_HEFFbyFLOODING(I,J)
1490     HSNOW(I,J,bi,bj) = HSNOW(I,J,bi,bj)-
1491 jmc 1.91 & d_HEFFbyFLOODING(I,J)*ICE2SNOW
1492 dimitri 1.69 ENDDO
1493     ENDDO
1494     ENDIF
1495     #endif /* ALLOW_SEAICE_FLOODING */
1496    
1497 gforget 1.87 #endif /* SEAICE_GROWTH_LEGACY */
1498 gforget 1.75
1499 gforget 1.124 #ifdef ALLOW_SITRACER
1500     DO J=1,sNy
1501     DO I=1,sNx
1502     c needs to be here to allow use also with LEGACY branch
1503     SItrHEFF(I,J,bi,bj,5)=HEFF(I,J,bi,bj)
1504     ENDDO
1505     ENDDO
1506     #endif
1507 gforget 1.75
1508 jmc 1.104 C ===================================================================
1509     C ===============PART 6: determine ice age increments================
1510     C ===================================================================
1511 gforget 1.75
1512 dimitri 1.69 #ifdef SEAICE_AGE
1513     C Sources and sinks for sea ice age:
1514     C assume that a) freezing: new ice fraction forms with zero age
1515     C b) melting: ice fraction vanishes with current age
1516     DO J=1,sNy
1517     DO I=1,sNx
1518 heimbach 1.120 C-- increase age as time passes
1519     IceAgeTr(i,j,bi,bj,1)=IceAgeTr(i,j,bi,bj,1)
1520     & +SEAICE_deltaTtherm*AREApreTH(i,j)
1521     IceAgeTr(i,j,bi,bj,2)=IceAgeTr(i,j,bi,bj,2)
1522     & +SEAICE_deltaTtherm*HEFFpreTH(i,j)
1523     C-- account for ice melt
1524     IF (AREApreTH(i,j).GT.AREA(i,j,bi,bj)) THEN
1525     IceAgeTr(i,j,bi,bj,1)=IceAgeTr(i,j,bi,bj,1)
1526     & *AREA(i,j,bi,bj)/AREApreTH(i,j)
1527     ENDIF
1528     IF (HEFFpreTH(i,j).GT.HEFF(i,j,bi,bj)) THEN
1529     IceAgeTr(i,j,bi,bj,2)=IceAgeTr(i,j,bi,bj,2)
1530     & *HEFF(i,j,bi,bj)/HEFFpreTH(i,j)
1531     ENDIF
1532 dimitri 1.69 ENDDO
1533     ENDDO
1534     #endif /* SEAICE_AGE */
1535    
1536 gforget 1.88
1537 jmc 1.104 C ===================================================================
1538     C ==============PART 7: determine ocean model forcing================
1539     C ===================================================================
1540 gforget 1.88
1541 jmc 1.91 C compute net heat flux leaving/entering the ocean,
1542 gforget 1.88 C accounting for the part used in melt/freeze processes
1543     C =====================================================
1544    
1545     DO J=1,sNy
1546     DO I=1,sNx
1547 gforget 1.89 QNET(I,J,bi,bj) = r_QbyATM_cover(I,J) + r_QbyATM_open(I,J)
1548 gforget 1.121 #ifndef SEAICE_GROWTH_LEGACY
1549 gforget 1.122 C in principle a_QSWbyATM_cover should always be included here, however
1550 gforget 1.121 C for backward compatibility it is left out of the LEGACY branch
1551 dimitri 1.113 & + a_QSWbyATM_cover(I,J)
1552 gforget 1.125 #endif /* SEAICE_GROWTH_LEGACY */
1553     #ifdef SEAICE_ADD_SUBLIMATION_TO_FWBUDGET
1554     C Tricky point: we have taken Lsub heat from the ocean but, by lack of snow/ice,
1555     C will take the fresh water from the ocean, which only requires Levap heat.
1556     C So we have taken an excess Lfusion heat from the ocean, which we need to put back.
1557     C Given the sign convention (QNET is upward) and current units (ice meters), that is:
1558     C & - r_FWbySublim(I,J)
1559     #endif /* SEAICE_ADD_SUBLIMATION_TO_FWBUDGET */
1560 dimitri 1.113 & - ( d_HEFFbyOCNonICE(I,J) +
1561     & d_HSNWbyOCNonSNW(I,J)/ICE2SNOW +
1562 jmc 1.91 & d_HEFFbyNEG(I,J) +
1563 gforget 1.88 & d_HSNWbyNEG(I,J)/ICE2SNOW )
1564     & * maskC(I,J,kSurface,bi,bj)
1565     QSW(I,J,bi,bj) = a_QSWbyATM_cover(I,J) + a_QSWbyATM_open(I,J)
1566     ENDDO
1567     ENDDO
1568    
1569 jmc 1.104 C switch heat fluxes from 'effective' ice meters to W/m2
1570 gforget 1.88 C ======================================================
1571 gforget 1.83
1572     DO J=1,sNy
1573     DO I=1,sNx
1574     QNET(I,J,bi,bj) = QNET(I,J,bi,bj)*convertHI2Q
1575     QSW(I,J,bi,bj) = QSW(I,J,bi,bj)*convertHI2Q
1576     ENDDO
1577     ENDDO
1578 jmc 1.91
1579     C compute net fresh water flux leaving/entering
1580 gforget 1.88 C the ocean, accounting for fresh/salt water stocks.
1581     C ==================================================
1582    
1583     #ifdef ALLOW_ATM_TEMP
1584     DO J=1,sNy
1585     DO I=1,sNx
1586 dimitri 1.113 tmpscal1= d_HSNWbyATMonSNW(I,J)/ICE2SNOW
1587 mlosch 1.109 & +d_HFRWbyRAIN(I,J)
1588 dimitri 1.113 & +d_HSNWbyOCNonSNW(I,J)/ICE2SNOW
1589     & +d_HEFFbyOCNonICE(I,J)
1590     & +d_HEFFbyATMonOCN(I,J)
1591 mlosch 1.109 & +d_HEFFbyNEG(I,J)
1592     & +d_HSNWbyNEG(I,J)/ICE2SNOW
1593     #ifdef SEAICE_ADD_SUBLIMATION_TO_FWBUDGET
1594 gforget 1.125 & +r_FWbySublim(I,J)
1595 mlosch 1.109 #endif /* SEAICE_ADD_SUBLIMATION_TO_FWBUDGET */
1596 gforget 1.88 EmPmR(I,J,bi,bj) = maskC(I,J,kSurface,bi,bj)*(
1597     & ( EVAP(I,J,bi,bj)-PRECIP(I,J,bi,bj) )
1598     & * ( ONE - AREApreTH(I,J) )
1599     #ifdef ALLOW_RUNOFF
1600     & - RUNOFF(I,J,bi,bj)
1601 mlosch 1.109 #endif /* ALLOW_RUNOFF */
1602 gforget 1.88 & + tmpscal1*convertHI2PRECIP
1603     & )*rhoConstFresh
1604     ENDDO
1605     ENDDO
1606    
1607     #ifdef ALLOW_MEAN_SFLUX_COST_CONTRIBUTION
1608     DO J=1,sNy
1609     DO I=1,sNx
1610     frWtrAtm(I,J,bi,bj) = maskC(I,J,kSurface,bi,bj)*(
1611     & PRECIP(I,J,bi,bj)
1612     & - EVAP(I,J,bi,bj)
1613     & *( ONE - AREApreTH(I,J) )
1614     & + RUNOFF(I,J,bi,bj)
1615     & )*rhoConstFresh
1616     ENDDO
1617     ENDDO
1618     #endif
1619     #endif /* ALLOW_ATM_TEMP */
1620    
1621 gforget 1.96 #ifdef SEAICE_DEBUG
1622     CALL PLOT_FIELD_XYRL( QSW,'Current QSW ', myIter, myThid )
1623     CALL PLOT_FIELD_XYRL( QNET,'Current QNET ', myIter, myThid )
1624     CALL PLOT_FIELD_XYRL( EmPmR,'Current EmPmR ', myIter, myThid )
1625     #endif /* SEAICE_DEBUG */
1626 gforget 1.88
1627     C Sea Ice Load on the sea surface.
1628     C =================================
1629    
1630 gforget 1.105 #ifdef ALLOW_AUTODIFF_TAMC
1631     CADJ STORE heff(:,:,bi,bj) = comlev1_bibj,key=iicekey,byte=isbyte
1632     CADJ STORE hsnow(:,:,bi,bj) = comlev1_bibj,key=iicekey,byte=isbyte
1633     #endif /* ALLOW_AUTODIFF_TAMC */
1634    
1635 gforget 1.88 IF ( useRealFreshWaterFlux ) THEN
1636     DO J=1,sNy
1637     DO I=1,sNx
1638 gforget 1.92 #ifdef SEAICE_CAP_ICELOAD
1639     tmpscal1 = HEFF(I,J,bi,bj)*SEAICE_rhoIce
1640     & + HSNOW(I,J,bi,bj)*SEAICE_rhoSnow
1641 jmc 1.94 tmpscal2 = min(tmpscal1,heffTooHeavy*rhoConst)
1642     #else
1643 gforget 1.92 tmpscal2 = HEFF(I,J,bi,bj)*SEAICE_rhoIce
1644     & + HSNOW(I,J,bi,bj)*SEAICE_rhoSnow
1645     #endif
1646     sIceLoad(i,j,bi,bj) = tmpscal2
1647 gforget 1.88 ENDDO
1648     ENDDO
1649     ENDIF
1650    
1651 gforget 1.125 C ===================================================================
1652     C ======================PART 8: diagnostics==========================
1653     C ===================================================================
1654    
1655     #ifdef ALLOW_DIAGNOSTICS
1656     IF ( useDiagnostics ) THEN
1657 gforget 1.130 tmpscal1=1. _d 0 / SEAICE_deltaTtherm
1658     CALL DIAGNOSTICS_SCALE_FILL(a_QbyATM_cover,
1659     & tmpscal1,1,'SIaQbATC',0,1,3,bi,bj,myThid)
1660     CALL DIAGNOSTICS_SCALE_FILL(a_QbyATM_open,
1661     & tmpscal1,1,'SIaQbATO',0,1,3,bi,bj,myThid)
1662     CALL DIAGNOSTICS_SCALE_FILL(a_QbyOCN,
1663     & tmpscal1,1,'SIaQbOCN',0,1,3,bi,bj,myThid)
1664     CALL DIAGNOSTICS_SCALE_FILL(d_HEFFbyOCNonICE,
1665     & tmpscal1,1,'SIdHbOCN',0,1,3,bi,bj,myThid)
1666     CALL DIAGNOSTICS_SCALE_FILL(d_HEFFbyATMonOCN_cover,
1667     & tmpscal1,1,'SIdHbATC',0,1,3,bi,bj,myThid)
1668     CALL DIAGNOSTICS_SCALE_FILL(d_HEFFbyATMonOCN_open,
1669     & tmpscal1,1,'SIdHbATO',0,1,3,bi,bj,myThid)
1670     CALL DIAGNOSTICS_SCALE_FILL(d_HEFFbyFLOODING,
1671     & tmpscal1,1,'SIdHbFLO',0,1,3,bi,bj,myThid)
1672     CALL DIAGNOSTICS_SCALE_FILL(d_HSNWbyOCNonSNW,
1673     & tmpscal1,1,'SIdSbOCN',0,1,3,bi,bj,myThid)
1674     CALL DIAGNOSTICS_SCALE_FILL(d_HSNWbyATMonSNW,
1675     & tmpscal1,1,'SIdSbATC',0,1,3,bi,bj,myThid)
1676     CALL DIAGNOSTICS_SCALE_FILL(d_AREAbyATM,
1677     & tmpscal1,1,'SIdAbATO',0,1,3,bi,bj,myThid)
1678     CALL DIAGNOSTICS_SCALE_FILL(d_AREAbyICE,
1679     & tmpscal1,1,'SIdAbATC',0,1,3,bi,bj,myThid)
1680     CALL DIAGNOSTICS_SCALE_FILL(d_AREAbyOCN,
1681     & tmpscal1,1,'SIdAbOCN',0,1,3,bi,bj,myThid)
1682 gforget 1.125 CALL DIAGNOSTICS_SCALE_FILL(r_QbyATM_open,
1683 gforget 1.130 & convertHI2Q,1, 'SIqneto ',0,1,3,bi,bj,myThid)
1684 gforget 1.125 CALL DIAGNOSTICS_SCALE_FILL(r_QbyATM_cover,
1685 gforget 1.130 & convertHI2Q,1, 'SIqneti ',0,1,3,bi,bj,myThid)
1686 gforget 1.125 C three that actually need intermediate storage
1687     DO J=1,sNy
1688     DO I=1,sNx
1689     DIAGarrayA(I,J) = maskC(I,J,kSurface,bi,bj)
1690     & * d_HSNWbyRAIN(I,J)*SEAICE_rhoSnow/SEAICE_deltaTtherm
1691 gforget 1.128 DIAGarrayB(I,J) = AREA(I,J,bi,bj)-AREApreTH(I,J)
1692 gforget 1.125 ENDDO
1693     ENDDO
1694 gforget 1.130 CALL DIAGNOSTICS_FILL(DIAGarrayA,
1695     & 'SIsnPrcp',0,1,3,bi,bj,myThid)
1696     CALL DIAGNOSTICS_SCALE_FILL(DIAGarrayB,
1697     & tmpscal1,1,'SIdA ',0,1,3,bi,bj,myThid)
1698 gforget 1.125 ENDIF
1699     #endif
1700    
1701 gforget 1.88 C close bi,bj loops
1702 dimitri 1.69 ENDDO
1703     ENDDO
1704    
1705     RETURN
1706     END

  ViewVC Help
Powered by ViewVC 1.1.22