/[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.10 - (hide annotations) (download)
Tue Jan 9 13:33:49 2007 UTC (17 years, 4 months ago) by mlosch
Branch: MAIN
CVS Tags: checkpoint58u_post, checkpoint58w_post, checkpoint58x_post, checkpoint58y_post, checkpoint58v_post
Changes since 1.9: +13 -10 lines
fix a bug in the flooding algorithm: turn off the snow machine

1 mlosch 1.10 C $Header: /u/gcmpack/MITgcm/pkg/seaice/seaice_growth.F,v 1.9 2006/12/21 10:50:46 mlosch Exp $
2 heimbach 1.2 C $Name: $
3 mlosch 1.1
4     #include "SEAICE_OPTIONS.h"
5    
6     CStartOfInterface
7     SUBROUTINE SEAICE_GROWTH( myTime, myIter, myThid )
8     C /==========================================================\
9     C | SUBROUTINE seaice_growth |
10     C | o Updata ice thickness and snow depth |
11     C |==========================================================|
12     C \==========================================================/
13     IMPLICIT NONE
14    
15     C === Global variables ===
16     #include "SIZE.h"
17     #include "EEPARAMS.h"
18     #include "PARAMS.h"
19     #include "DYNVARS.h"
20     #include "GRID.h"
21     #include "FFIELDS.h"
22     #include "SEAICE_PARAMS.h"
23     #include "SEAICE.h"
24     #include "SEAICE_FFIELDS.h"
25    
26     #ifdef ALLOW_AUTODIFF_TAMC
27     # include "tamc.h"
28     #endif
29     C === Routine arguments ===
30     C myTime - Simulation time
31     C myIter - Simulation timestep number
32     C myThid - Thread no. that called this routine.
33     _RL myTime
34     INTEGER myIter, myThid
35     CEndOfInterface
36    
37     C === Local variables ===
38     C i,j,bi,bj - Loop counters
39    
40     INTEGER i, j, bi, bj
41 mlosch 1.3 C number of surface interface layer
42     INTEGER kSurface
43 mlosch 1.8 C constants
44 mlosch 1.10 _RL TBC, salinity_ice, SDF, ICE2WATR, ICE2SNOW
45 mlosch 1.8 _RL QI, recip_QI, QS, recip_QS
46     C auxillary variables
47     _RL availHeat, hEffOld, snowEnergy, snowAsIce
48     _RL growthHEFF, growthNeg
49 mlosch 1.1 #ifdef ALLOW_SEAICE_FLOODING
50     _RL hDraft, hFlood
51     #endif /* ALLOW_SEAICE_FLOODING */
52     _RL GAREA ( 1-OLx:sNx+OLx, 1-OLy:sNy+OLy )
53     _RL GHEFF ( 1-OLx:sNx+OLx, 1-OLy:sNy+OLy )
54     C RESID_HEAT is residual heat above freezing in equivalent m of ice
55     _RL RESID_HEAT ( 1-OLx:sNx+OLx, 1-OLy:sNy+OLy )
56    
57     C FICE - thermodynamic ice growth rate over sea ice in W/m^2
58     C >0 causes ice growth, <0 causes snow and sea ice melt
59     C FHEFF - effective thermodynamic ice growth rate over sea ice in W/m^2
60     C >0 causes ice growth, <0 causes snow and sea ice melt
61     C QNETO - thermodynamic ice growth rate over open water in W/m^2
62     C ( = surface heat flux )
63     C >0 causes ice growth, <0 causes snow and sea ice melt
64     C QNETI - net surface heat flux under ice in W/m^2
65     C QSWO - short wave heat flux over ocean in W/m^2
66     C QSWI - short wave heat flux under ice in W/m^2
67     _RL FHEFF (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
68     _RL FICE (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
69     _RL QNETO (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
70     _RL QNETI (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
71     _RL QSWO (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
72     _RL QSWI (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
73     C
74     _RL HCORR (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
75 mlosch 1.8 C frWtrIce contains m of ice melted (<0) or created (>0)
76     _RL frWtrIce(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
77 dimitri 1.6 C actual ice thickness with upper and lower limit
78 mlosch 1.1 _RL HICE (1-OLx:sNx+OLx, 1-OLy:sNy+OLy)
79     C actual snow thickness
80     _RL hSnwLoc(1-OLx:sNx+OLx, 1-OLy:sNy+OLy)
81     C wind speed
82     _RL UG (1-OLx:sNx+OLx, 1-OLy:sNy+OLy)
83     _RL SPEED_SQ
84 mlosch 1.3 C local copy of AREA
85 mlosch 1.7 _RL areaLoc
86 mlosch 1.1
87 mlosch 1.7 #ifdef SEAICE_MULTICATEGORY
88 mlosch 1.1 INTEGER it
89     INTEGER ilockey
90     _RL RK
91     _RL HICEP(1-OLx:sNx+OLx, 1-OLy:sNy+OLy)
92     _RL FICEP(1-OLx:sNx+OLx, 1-OLy:sNy+OLy)
93 mlosch 1.7 _RL QSWIP(1-OLx:sNx+OLx, 1-OLy:sNy+OLy)
94 mlosch 1.1 #endif
95    
96     if ( buoyancyRelation .eq. 'OCEANICP' ) then
97     kSurface = Nr
98     else
99     kSurface = 1
100     endif
101    
102 mlosch 1.3 C ICE SALINITY (g/kg)
103     salinity_ice = 4.0 _d 0
104     C FREEZING TEMP. OF SEA WATER (deg C)
105     TBC = SEAICE_freeze
106     C RATIO OF WATER DESITY TO SNOW DENSITY
107     SDF = 1000.0 _d 0/330.0 _d 0
108     C RATIO OF SEA ICE DESITY TO WATER DENSITY
109 mlosch 1.10 ICE2WATR = 0.920 _d 0
110     C this makes more sense, but changes the results
111     C ICE2WATR = SEAICE_rhoIce * 1. _d -03
112 mlosch 1.8 C RATIO OF SEA ICE DENSITY to SNOW DENSITY
113 mlosch 1.10 ICE2SNOW = SDF * ICE2WATR
114 mlosch 1.8 C HEAT OF FUSION OF ICE (m^3/J)
115     QI = 302.0 _d +06
116     recip_QI = 1.0 _d 0 / QI
117 mlosch 1.3 C HEAT OF FUSION OF SNOW (J/m^3)
118     QS = 1.1 _d +08
119 mlosch 1.8 recip_QS = 1.1 _d 0 / QS
120 mlosch 1.1
121     DO bj=myByLo(myThid),myByHi(myThid)
122     DO bi=myBxLo(myThid),myBxHi(myThid)
123     c
124     #ifdef ALLOW_AUTODIFF_TAMC
125     act1 = bi - myBxLo(myThid)
126     max1 = myBxHi(myThid) - myBxLo(myThid) + 1
127     act2 = bj - myByLo(myThid)
128     max2 = myByHi(myThid) - myByLo(myThid) + 1
129     act3 = myThid - 1
130     max3 = nTx*nTy
131     act4 = ikey_dynamics - 1
132     iicekey = (act1 + 1) + act2*max1
133     & + act3*max1*max2
134     & + act4*max1*max2*max3
135     #endif /* ALLOW_AUTODIFF_TAMC */
136     C
137     C initialise a few fields
138     C
139 heimbach 1.2 #ifdef ALLOW_AUTODIFF_TAMC
140     CADJ STORE area(:,:,:,bi,bj) = comlev1_bibj,
141     CADJ & key = iicekey, byte = isbyte
142     CADJ STORE qnet(:,:,bi,bj) = comlev1_bibj,
143     CADJ & key = iicekey, byte = isbyte
144     CADJ STORE qsw(:,:,bi,bj) = comlev1_bibj,
145     CADJ & key = iicekey, byte = isbyte
146     #endif /* ALLOW_AUTODIFF_TAMC */
147 mlosch 1.1 DO J=1,sNy
148     DO I=1,sNx
149 mlosch 1.8 FHEFF(I,J) = 0.0 _d 0
150     FICE (I,J) = 0.0 _d 0
151 mlosch 1.7 #ifdef SEAICE_MULTICATEGORY
152 mlosch 1.8 FICEP(I,J) = 0.0 _d 0
153     QSWIP(I,J) = 0.0 _d 0
154 mlosch 1.1 #endif
155 mlosch 1.8 FHEFF(I,J) = 0.0 _d 0
156     FICE (I,J) = 0.0 _d 0
157     QNETO(I,J) = 0.0 _d 0
158     QNETI(I,J) = 0.0 _d 0
159     QSWO (I,J) = 0.0 _d 0
160     QSWI (I,J) = 0.0 _d 0
161     HCORR(I,J) = 0.0 _d 0
162     frWtrIce(I,J) = 0.0 _d 0
163     RESID_HEAT(I,J) = 0.0 _d 0
164 mlosch 1.1 ENDDO
165     ENDDO
166     #ifdef ALLOW_AUTODIFF_TAMC
167 heimbach 1.2 CADJ STORE heff(:,:,:,bi,bj) = comlev1_bibj,
168     CADJ & key = iicekey, byte = isbyte
169     CADJ STORE hsnow(:,:,bi,bj) = comlev1_bibj,
170     CADJ & key = iicekey, byte = isbyte
171 mlosch 1.1 #endif /* ALLOW_AUTODIFF_TAMC */
172 heimbach 1.2 DO J=1,sNy
173     DO I=1,sNx
174 dimitri 1.6 C COMPUTE ACTUAL ICE THICKNESS AND PUT MINIMUM/MAXIMUM
175     C ON ICE THICKNESS FOR BUDGET COMPUTATION
176 mlosch 1.8 C The default of A22 = 0.15 is a common threshold for defining
177     C the ice edge. This ice concentration usually does not occur
178     C due to thermodynamics but due to advection.
179 mlosch 1.7 areaLoc = MAX(A22,AREA(I,J,2,bi,bj))
180     HICE(I,J) = HEFF(I,J,2,bi,bj)/areaLoc
181 mlosch 1.8 C Do we know what this is for?
182 dimitri 1.6 HICE(I,J) = MAX(HICE(I,J),0.05 _d +00)
183 mlosch 1.8 C Capping the actual ice thickness effectively enforces a
184     C minimum of heat flux through the ice and helps getting rid of
185     C very thick ice.
186 dimitri 1.6 HICE(I,J) = MIN(HICE(I,J),9.0 _d +00)
187 mlosch 1.7 hSnwLoc(I,J) = HSNOW(I,J,bi,bj)/areaLoc
188 heimbach 1.2 ENDDO
189     ENDDO
190 mlosch 1.1
191     C NOW DETERMINE MIXED LAYER TEMPERATURE
192     DO J=1,sNy
193     DO I=1,sNx
194     TMIX(I,J,bi,bj)=theta(I,J,kSurface,bi,bj)+273.16 _d +00
195     #ifdef SEAICE_DEBUG
196     TMIX(I,J,bi,bj)=MAX(TMIX(I,J,bi,bj),271.2 _d +00)
197     #endif
198     ENDDO
199     ENDDO
200    
201     C THERMAL WIND OF ATMOSPHERE
202     DO J=1,sNy
203     DO I=1,sNx
204     CML#ifdef SEAICE_EXTERNAL_FORCING
205     CMLC this seems to be more natural as we do compute the wind speed in
206     CMLC pkg/exf/exf_wind.F, but it changes the results
207     CML UG(I,J) = MAX(SEAICE_EPS,wspeed(I,J,bi,bj))
208     CML#else
209     SPEED_SQ = UWIND(I,J,bi,bj)**2 + VWIND(I,J,bi,bj)**2
210     IF ( SPEED_SQ .LE. SEAICE_EPS_SQ ) THEN
211     UG(I,J)=SEAICE_EPS
212     ELSE
213     UG(I,J)=SQRT(SPEED_SQ)
214     ENDIF
215     CML#endif /* SEAICE_EXTERNAL_FORCING */
216     ENDDO
217     ENDDO
218    
219    
220     #ifdef ALLOW_AUTODIFF_TAMC
221 heimbach 1.2 cphCADJ STORE heff = comlev1, key = ikey_dynamics
222     cphCADJ STORE hsnow = comlev1, key = ikey_dynamics
223     cphCADJ STORE uwind = comlev1, key = ikey_dynamics
224     cphCADJ STORE vwind = comlev1, key = ikey_dynamics
225     c
226 mlosch 1.1 CADJ STORE tice = comlev1, key = ikey_dynamics
227 mlosch 1.7 # ifdef SEAICE_MULTICATEGORY
228 mlosch 1.1 CADJ STORE tices = comlev1, key = ikey_dynamics
229     # endif
230     #endif /* ALLOW_AUTODIFF_TAMC */
231    
232     C NOW DETERMINE GROWTH RATES
233     C FIRST DO OPEN WATER
234     CALL SEAICE_BUDGET_OCEAN(
235     I UG,
236     U TMIX,
237     O QNETO, QSWO,
238     I bi, bj)
239    
240     C NOW DO ICE
241 mlosch 1.7 #ifdef SEAICE_MULTICATEGORY
242     C-- Start loop over muli-categories
243 mlosch 1.1 DO IT=1,MULTDIM
244     #ifdef ALLOW_AUTODIFF_TAMC
245     ilockey = (iicekey-1)*MULTDIM + IT
246     CADJ STORE tices(:,:,it,bi,bj) = comlev1_multdim,
247     CADJ & key = ilockey, byte = isbyte
248     #endif /* ALLOW_AUTODIFF_TAMC */
249 mlosch 1.7 RK=REAL(IT)
250 mlosch 1.1 DO J=1,sNy
251     DO I=1,sNx
252 mlosch 1.7 HICEP(I,J)=(HICE(I,J)/MULTDIM)*((2.0 _d 0*RK)-1.0 _d 0)
253 mlosch 1.1 TICE(I,J,bi,bj)=TICES(I,J,IT,bi,bj)
254     ENDDO
255     ENDDO
256     CALL SEAICE_BUDGET_ICE(
257 mlosch 1.5 I UG, HICEP, hSnwLoc,
258 mlosch 1.1 U TICE,
259 mlosch 1.7 O FICEP, QSWIP,
260 mlosch 1.1 I bi, bj)
261     DO J=1,sNy
262     DO I=1,sNx
263 mlosch 1.7 C average surface heat fluxes/growth rates
264     FICE (I,J) = FICE(I,J) + FICEP(I,J)/MULTDIM
265     QSWI (I,J) = QSWI(I,J) + QSWIP(I,J)/MULTDIM
266     TICES(I,J,IT,bi,bj) = TICE(I,J,bi,bj)
267 mlosch 1.1 ENDDO
268     ENDDO
269     ENDDO
270 mlosch 1.7 C-- End loop over multi-categories
271     #else /* SEAICE_MULTICATEGORY */
272 mlosch 1.1 CALL SEAICE_BUDGET_ICE(
273     I UG, HICE, hSnwLoc,
274     U TICE,
275     O FICE, QSWI,
276     I bi, bj)
277 mlosch 1.7 #endif /* SEAICE_MULTICATEGORY */
278 mlosch 1.1
279 mlosch 1.3 #ifdef ALLOW_AUTODIFF_TAMC
280     CADJ STORE theta(:,:,:,bi,bj)= comlev1_bibj,
281     CADJ & key = iicekey, byte = isbyte
282     CADJ STORE heff(:,:,:,bi,bj) = comlev1_bibj,
283     CADJ & key = iicekey, byte = isbyte
284     #endif /* ALLOW_AUTODIFF_TAMC */
285 mlosch 1.8 C
286     C-- compute and apply ice growth due to oceanic heat flux from below
287     C
288 mlosch 1.3 DO J=1,sNy
289     DO I=1,sNx
290     C-- Create or melt sea-ice so that first-level oceanic temperature
291     C is approximately at the freezing point when there is sea-ice.
292 mlosch 1.8 C Initially the units of YNEG/availHeat are m of sea-ice.
293 mlosch 1.3 C The factor dRf(1)/72.0764, used to convert temperature
294     C change in deg K to m of sea-ice, is approximately:
295     C dRf(1) * (sea water heat capacity = 3996 J/kg/K)
296     C * (density of sea-water = 1026 kg/m^3)
297     C / (latent heat of fusion of sea-ice = 334000 J/kg)
298     C / (density of sea-ice = 910 kg/m^3)
299 mlosch 1.8 C Negative YNEG/availHeat leads to ice growth.
300     C Positive YNEG/availHeat leads to ice melting.
301 mlosch 1.3 IF ( .NOT. inAdMode ) THEN
302     #ifdef SEAICE_VARIABLE_FREEZING_POINT
303     TBC = -0.0575 _d 0*salt(I,J,kSurface,bi,bj) + 0.0901 _d 0
304     #endif /* SEAICE_VARIABLE_FREEZING_POINT */
305 mlosch 1.8 availHeat = (theta(I,J,kSurface,bi,bj)-TBC)
306 mlosch 1.3 & *dRf(1)/72.0764 _d 0
307     ELSE
308 mlosch 1.8 availHeat = 0.
309 mlosch 1.3 ENDIF
310 mlosch 1.8 C local copy of old effective ice thickness
311     hEffOld = HEFF(I,J,1,bi,bj)
312     C Melt (availHeat>0) or create (availHeat<0) sea ice
313     HEFF(I,J,1,bi,bj) = MAX(ZERO,HEFF(I,J,1,bi,bj)-availHeat)
314     C
315     YNEG(I,J,bi,bj) = hEffOld - HEFF(I,J,1,bi,bj)
316     C
317     frWtrIce(I,J) = frWtrIce(I,J) - YNEG(I,J,bi,bj)
318     RESID_HEAT(I,J) = availHeat - YNEG(I,J,bi,bj)
319 mlosch 1.3 C YNEG now contains m of ice melted (>0) or created (<0)
320 mlosch 1.8 C frWtrIce contains m of ice melted (<0) or created (>0)
321 mlosch 1.3 C RESID_HEAT is residual heat above freezing in equivalent m of ice
322     ENDDO
323     ENDDO
324    
325 mlosch 1.1 cph(
326     #ifdef ALLOW_AUTODIFF_TAMC
327     cphCADJ STORE heff = comlev1, key = ikey_dynamics
328     cphCADJ STORE hsnow = comlev1, key = ikey_dynamics
329     #endif
330     cph)
331     c
332     #ifdef ALLOW_AUTODIFF_TAMC
333     CADJ STORE area(:,:,:,bi,bj) = comlev1_bibj,
334     CADJ & key = iicekey, byte = isbyte
335     CADJ STORE hsnow(:,:,bi,bj) = comlev1_bibj,
336     CADJ & key = iicekey, byte = isbyte
337 heimbach 1.2 CADJ STORE fice(:,:) = comlev1_bibj,
338 mlosch 1.1 CADJ & key = iicekey, byte = isbyte
339     #endif /* ALLOW_AUTODIFF_TAMC */
340     cph)
341 mlosch 1.8 C
342     C-- compute and apply ice growth due to atmospheric fluxes from above
343     C
344 mlosch 1.1 DO J=1,sNy
345     DO I=1,sNx
346 mlosch 1.3 C NOW CALCULATE CORRECTED effective growth in J/m^2 (>0=melt)
347     GHEFF(I,J)=-SEAICE_deltaTtherm*FICE(I,J)*AREA(I,J,2,bi,bj)
348 mlosch 1.1 ENDDO
349     ENDDO
350 heimbach 1.2
351 mlosch 1.1 #ifdef ALLOW_AUTODIFF_TAMC
352 mlosch 1.3 CADJ STORE fice(:,:) = comlev1_bibj,
353     CADJ & key = iicekey, byte = isbyte
354 mlosch 1.1 #endif /* ALLOW_AUTODIFF_TAMC */
355    
356     DO J=1,sNy
357     DO I=1,sNx
358     IF(FICE(I,J).LT.ZERO.AND.AREA(I,J,2,bi,bj).GT.ZERO) THEN
359 mlosch 1.8 C use FICE to melt snow and CALCULATE CORRECTED GROWTH
360     C effective snow thickness in J/m^2
361     snowEnergy=HSNOW(I,J,bi,bj)*QS
362     IF(GHEFF(I,J).LE.snowEnergy) THEN
363     C not enough heat to melt all snow; use up all heat flux FICE
364 mlosch 1.1 HSNOW(I,J,bi,bj)=HSNOW(I,J,bi,bj)-GHEFF(I,J)/QS
365 mlosch 1.8 C SNOW CONVERTED INTO WATER AND THEN INTO equivalent m of ICE melt
366     C The factor 1/ICE2SNOW converts m of snow to m of sea-ice
367     frWtrIce(I,J) = frWtrIce(I,J) - GHEFF(I,J)/(QS*ICE2SNOW)
368     FICE (I,J) = ZERO
369 mlosch 1.1 ELSE
370 mlosch 1.8 C enought heat to melt snow completely;
371     C compute remaining heat flux that will melt ice
372     FICE(I,J)=-(GHEFF(I,J)-snowEnergy)/
373 mlosch 1.1 & SEAICE_deltaTtherm/AREA(I,J,2,bi,bj)
374     C convert all snow to melt water (fresh water flux)
375 mlosch 1.8 frWtrIce(I,J) = frWtrIce(I,J)
376     & -HSNOW(I,J,bi,bj)/ICE2SNOW
377 mlosch 1.1 HSNOW(I,J,bi,bj)=0.0
378     END IF
379     END IF
380 heimbach 1.2 ENDDO
381     ENDDO
382 mlosch 1.1
383 heimbach 1.2 #ifdef ALLOW_AUTODIFF_TAMC
384 mlosch 1.3 CADJ STORE fice(:,:) = comlev1_bibj,
385     CADJ & key = iicekey, byte = isbyte
386 heimbach 1.2 #endif /* ALLOW_AUTODIFF_TAMC */
387    
388     DO J=1,sNy
389     DO I=1,sNx
390 mlosch 1.8 C now get cell averaged growth rate in W/m^2, >0 causes ice growth
391 mlosch 1.1 FHEFF(I,J)= FICE(I,J) * AREA(I,J,2,bi,bj)
392     & + QNETO(I,J) * (ONE-AREA(I,J,2,bi,bj))
393     ENDDO
394     ENDDO
395     cph(
396     #ifdef ALLOW_AUTODIFF_TAMC
397     CADJ STORE heff(:,:,:,bi,bj) = comlev1_bibj,
398     CADJ & key = iicekey, byte = isbyte
399     CADJ STORE hsnow(:,:,bi,bj) = comlev1_bibj,
400     CADJ & key = iicekey, byte = isbyte
401 mlosch 1.3 CADJ STORE fice(:,:) = comlev1_bibj,
402 mlosch 1.1 CADJ & key = iicekey, byte = isbyte
403 mlosch 1.3 CADJ STORE fheff(:,:) = comlev1_bibj,
404 mlosch 1.1 CADJ & key = iicekey, byte = isbyte
405 mlosch 1.3 CADJ STORE qneto(:,:) = comlev1_bibj,
406 mlosch 1.1 CADJ & key = iicekey, byte = isbyte
407 mlosch 1.3 CADJ STORE qswi(:,:) = comlev1_bibj,
408 mlosch 1.1 CADJ & key = iicekey, byte = isbyte
409 mlosch 1.3 CADJ STORE qswo(:,:) = comlev1_bibj,
410 mlosch 1.1 CADJ & key = iicekey, byte = isbyte
411     #endif /* ALLOW_AUTODIFF_TAMC */
412     cph)
413     #ifdef ALLOW_AUTODIFF_TAMC
414     CADJ STORE area(:,:,:,bi,bj) = comlev1_bibj,
415     CADJ & key = iicekey, byte = isbyte
416     #endif
417 mlosch 1.8 C
418     C First update (freeze or melt) ice area
419     C
420 mlosch 1.1 DO J=1,sNy
421     DO I=1,sNx
422 mlosch 1.8 C negative growth in meters of ice (>0 for melting)
423     growthNeg = -SEAICE_deltaTtherm*FHEFF(I,J)*recip_QI
424     C negative growth must not exceed effective ice thickness (=volume)
425     C (that is, cannot melt more than all the ice)
426     growthHEFF = -ONE*MIN(HEFF(I,J,1,bi,bj),growthNeg)
427     C growthHEFF < 0 means melting
428     HCORR(I,J) = MIN(ZERO,growthHEFF)
429     C gain of new effective ice thickness over open water (>0 by definition)
430     GAREA(I,J) = MAX(ZERO,SEAICE_deltaTtherm*QNETO(I,J)*recip_QI)
431     CML removed these loops and moved TAMC store directive up
432     CML ENDDO
433     CML ENDDO
434     CML#ifdef ALLOW_AUTODIFF_TAMC
435     CMLCADJ STORE area(:,:,:,bi,bj) = comlev1_bibj,
436     CMLCADJ & key = iicekey, byte = isbyte
437     CML#endif
438     CML DO J=1,sNy
439     CML DO I=1,sNx
440     C Here we finally compute the new AREA
441     AREA(I,J,1,bi,bj)=AREA(I,J,1,bi,bj)+
442     & (ONE-AREA(I,J,2,bi,bj))*GAREA(I,J)/HO
443     & +HALF*HCORR(I,J)*AREA(I,J,2,bi,bj)
444     & /(HEFF(I,J,1,bi,bj)+.00001 _d 0)
445 mlosch 1.1 ENDDO
446     ENDDO
447     #ifdef ALLOW_AUTODIFF_TAMC
448     CADJ STORE area(:,:,:,bi,bj) = comlev1_bibj,
449     CADJ & key = iicekey, byte = isbyte
450     #endif
451 mlosch 1.8 C
452     C now update (freeze or melt) HEFF
453     C
454 mlosch 1.1 DO J=1,sNy
455     DO I=1,sNx
456 mlosch 1.8 C negative growth (>0 for melting) of existing ice in meters
457     growthNeg = -SEAICE_deltaTtherm*
458     & FICE(I,J)*recip_QI*AREA(I,J,2,bi,bj)
459     C negative growth must not exceed effective ice thickness (=volume)
460     C (that is, cannot melt more than all the ice)
461     growthHEFF = -ONE*MIN(HEFF(I,J,1,bi,bj),growthNeg)
462     C growthHEFF < 0 means melting
463     HEFF(I,J,1,bi,bj)= HEFF(I,J,1,bi,bj) + growthHEFF
464     C add effective growth to fresh water of ice
465     frWtrIce(I,J) = frWtrIce(I,J) + growthHEFF
466    
467     C now calculate QNETI under ice (if any) as the difference between
468     C the available "heat flux" growthNeg and the actual growthHEFF;
469     C keep in mind that growthNeg and growthHEFF have different signs
470     C by construction
471     QNETI(I,J) = (growthHEFF + growthNeg)*QI/SEAICE_deltaTtherm
472 mlosch 1.1
473 mlosch 1.8 C now update other things
474 mlosch 1.1
475     IF(FICE(I,J).GT.ZERO) THEN
476 mlosch 1.8 C freezing, add precip as snow
477 mlosch 1.3 HSNOW(I,J,bi,bj) = HSNOW(I,J,bi,bj)+SEAICE_deltaTtherm*
478 mlosch 1.1 & PRECIP(I,J,bi,bj)*AREA(I,J,2,bi,bj)*SDF
479     ELSE
480 mlosch 1.8 C add precip as rain, water converted into equivalent m of
481 mlosch 1.10 C ice by 1/ICE2WATR.
482 mlosch 1.9 C Do not get confused by the sign:
483     C precip > 0 for downward flux of fresh water
484     C frWtrIce > 0 for more ice (corresponds to an upward "fresh water flux"),
485     C so that here the rain is added *as if* it is melted ice (which is not
486     C true, but just a trick; physically the rain just runs as water
487     C through the ice into the ocean)
488 mlosch 1.8 frWtrIce(I,J) = frWtrIce(I,J)
489 mlosch 1.1 & -PRECIP(I,J,bi,bj)*AREA(I,J,2,bi,bj)*
490 mlosch 1.10 & SEAICE_deltaTtherm/ICE2WATR
491 mlosch 1.1 ENDIF
492    
493 mlosch 1.8 C Now melt snow if there is residual heat left in surface level
494     C Note that units of YNEG and frWtrIce are m of ice
495 heimbach 1.4 cph( very sensitive bit here by JZ
496 mlosch 1.8 IF( RESID_HEAT(I,J) .GT. ZERO .AND.
497     & HSNOW(I,J,bi,bj) .GT. ZERO ) THEN
498 mlosch 1.10 GHEFF(I,J) = MIN( HSNOW(I,J,bi,bj)/SDF/ICE2WATR,
499 mlosch 1.3 & RESID_HEAT(I,J) )
500 mlosch 1.8 YNEG(I,J,bi,bj) = YNEG(I,J,bi,bj) +GHEFF(I,J)
501 mlosch 1.10 HSNOW(I,J,bi,bj) = HSNOW(I,J,bi,bj)-GHEFF(I,J)*SDF*ICE2WATR
502 mlosch 1.8 frWtrIce(I,J) = frWtrIce(I,J) -GHEFF(I,J)
503 mlosch 1.1 ENDIF
504 heimbach 1.4 cph)
505 mlosch 1.1
506     C NOW GET FRESH WATER FLUX
507 mlosch 1.3 EmPmR(I,J,bi,bj) = maskC(I,J,kSurface,bi,bj)*(
508 mlosch 1.9 & ( EVAP(I,J,bi,bj)-PRECIP(I,J,bi,bj) )
509     & * ( ONE - AREA(I,J,2,bi,bj) )
510     & - RUNOFF(I,J,bi,bj)
511 mlosch 1.10 & + frWtrIce(I,J)*ICE2WATR/SEAICE_deltaTtherm
512 mlosch 1.1 & )
513    
514     C NOW GET TOTAL QNET AND QSW
515 mlosch 1.3 QNET(I,J,bi,bj) = QNETI(I,J) * AREA(I,J,2,bi,bj)
516     & +QNETO(I,J) * (ONE-AREA(I,J,2,bi,bj))
517     QSW(I,J,bi,bj) = QSWI(I,J) * AREA(I,J,2,bi,bj)
518     & +QSWO(I,J) * (ONE-AREA(I,J,2,bi,bj))
519 mlosch 1.1
520     C Now convert YNEG back to deg K.
521 mlosch 1.3 YNEG(I,J,bi,bj) = YNEG(I,J,bi,bj)*recip_dRf(1)*72.0764 _d 0
522 mlosch 1.1
523     C Add YNEG contribution to QNET
524 mlosch 1.3 QNET(I,J,bi,bj) = QNET(I,J,bi,bj)
525 mlosch 1.1 & +YNEG(I,J,bi,bj)/SEAICE_deltaTtherm
526     & *maskC(I,J,kSurface,bi,bj)
527     & *HeatCapacity_Cp*recip_horiVertRatio*rhoConst
528     & *drF(kSurface)*hFacC(i,j,kSurface,bi,bj)
529    
530     ENDDO
531     ENDDO
532    
533     #ifdef SEAICE_DEBUG
534     c CALL PLOT_FIELD_XYRS( UWIND,'Current UWIND ', myIter, myThid )
535     c CALL PLOT_FIELD_XYRS( VWIND,'Current VWIND ', myIter, myThid )
536     CALL PLOT_FIELD_XYRS( GWATX,'Current GWATX ', myIter, myThid )
537     CALL PLOT_FIELD_XYRS( GWATY,'Current GWATY ', myIter, myThid )
538     CML CALL PLOT_FIELD_XYRL( FO,'Current FO ', myIter, myThid )
539     CML CALL PLOT_FIELD_XYRL( FHEFF,'Current FHEFF ', myIter, myThid )
540     CALL PLOT_FIELD_XYRL( QSW,'Current QSW ', myIter, myThid )
541     CALL PLOT_FIELD_XYRL( QNET,'Current QNET ', myIter, myThid )
542     CALL PLOT_FIELD_XYRL( EmPmR,'Current EmPmR ', myIter, myThid )
543 mlosch 1.8 CML DO j=1-OLy,sNy+OLy
544     CML DO i=1-OLx,sNx+OLx
545     CML GHEFF(I,J)=SQRT(UICE(I,J,1,bi,bj)**2+VICE(I,J,1,bi,bj)**2)
546     CML GAREA(I,J)=HEFF(I,J,1,bi,bj)
547     CML print*,'I J QNET:',I, J, QNET(i,j,bi,bj), QSW(I,J,bi,bj)
548     CML ENDDO
549     CML ENDDO
550     CML CALL PLOT_FIELD_XYRL( GHEFF,'Current UICE ', myIter, myThid )
551     CML CALL PLOT_FIELD_XYRL( GAREA,'Current HEFF ', myIter, myThid )
552 mlosch 1.1 DO j=1-OLy,sNy+OLy
553     DO i=1-OLx,sNx+OLx
554     if(HEFF(i,j,1,bi,bj).gt.1.) then
555     print '(A,2i4,3f10.2)','#### i j heff theta yneg',i,j,
556     & HEFF(i,j,1,bi,bj),theta(I,J,1,bi,bj),yneg(I,J,bi,bj)
557     print '(A,3f10.2)','QSW, QNET before/after correction',
558     & QSW(I,J,bi,bj),QNETI(I,J)*AREA(I,J,2,bi,bj)+
559     & (ONE-AREA(I,J,2,bi,bj))*QNETO(I,J), QNET(I,J,bi,bj)
560     endif
561     ENDDO
562     ENDDO
563     #endif /* SEAICE_DEBUG */
564    
565     crg Added by Ralf Giering: do we need DO_WE_NEED_THIS ?
566     #define DO_WE_NEED_THIS
567     C NOW ZERO OUTSIDE POINTS
568     #ifdef ALLOW_AUTODIFF_TAMC
569     CADJ STORE area(:,:,:,bi,bj) = comlev1_bibj,
570     CADJ & key = iicekey, byte = isbyte
571     CADJ STORE heff(:,:,:,bi,bj) = comlev1_bibj,
572     CADJ & key = iicekey, byte = isbyte
573     #endif /* ALLOW_AUTODIFF_TAMC */
574     DO J=1,sNy
575     DO I=1,sNx
576     C NOW SET AREA(I,J,1,bi,bj)=0 WHERE NO ICE IS
577     AREA(I,J,1,bi,bj)=MIN(AREA(I,J,1,bi,bj)
578     & ,HEFF(I,J,1,bi,bj)/.0001 _d 0)
579     ENDDO
580     ENDDO
581     #ifdef ALLOW_AUTODIFF_TAMC
582     CADJ STORE area(:,:,:,bi,bj) = comlev1_bibj,
583     CADJ & key = iicekey, byte = isbyte
584     #endif /* ALLOW_AUTODIFF_TAMC */
585     DO J=1,sNy
586     DO I=1,sNx
587     C NOW TRUNCATE AREA
588     #ifdef DO_WE_NEED_THIS
589     AREA(I,J,1,bi,bj)=MIN(ONE,AREA(I,J,1,bi,bj))
590     ENDDO
591     ENDDO
592     #ifdef ALLOW_AUTODIFF_TAMC
593     CADJ STORE area(:,:,:,bi,bj) = comlev1_bibj,
594     CADJ & key = iicekey, byte = isbyte
595     CADJ STORE hsnow(:,:,bi,bj) = comlev1_bibj,
596     CADJ & key = iicekey, byte = isbyte
597     #endif /* ALLOW_AUTODIFF_TAMC */
598     DO J=1,sNy
599     DO I=1,sNx
600 mlosch 1.3 AREA(I,J,1,bi,bj) = MAX(ZERO,AREA(I,J,1,bi,bj))
601     HSNOW(I,J,bi,bj) = MAX(ZERO,HSNOW(I,J,bi,bj))
602 mlosch 1.1 #endif
603 mlosch 1.3 AREA(I,J,1,bi,bj) = AREA(I,J,1,bi,bj)*HEFFM(I,J,bi,bj)
604     HEFF(I,J,1,bi,bj) = HEFF(I,J,1,bi,bj)*HEFFM(I,J,bi,bj)
605 mlosch 1.1 #ifdef DO_WE_NEED_THIS
606     c HEFF(I,J,1,bi,bj)=MIN(MAX_HEFF,HEFF(I,J,1,bi,bj))
607     #endif
608 mlosch 1.3 HSNOW(I,J,bi,bj) = HSNOW(I,J,bi,bj)*HEFFM(I,J,bi,bj)
609 mlosch 1.1 ENDDO
610     ENDDO
611    
612     #ifdef ALLOW_SEAICE_FLOODING
613     IF ( SEAICEuseFlooding ) THEN
614     C convert snow to ice if submerged
615     DO J=1,sNy
616     DO I=1,sNx
617     hDraft = (HSNOW(I,J,bi,bj)*330. _d 0
618     & +HEFF(I,J,1,bi,bj)*SEAICE_rhoIce)/1000. _d 0
619     hFlood = hDraft - MIN(hDraft,HEFF(I,J,1,bi,bj))
620     HEFF(I,J,1,bi,bj) = HEFF(I,J,1,bi,bj) + hFlood
621 mlosch 1.10 HSNOW(I,J,bi,bj) = MAX(0. _d 0,
622     & HSNOW(I,J,bi,bj)-hFlood*ICE2SNOW)
623 mlosch 1.1 ENDDO
624     ENDDO
625     ENDIF
626     #endif /* ALLOW_SEAICE_FLOODING */
627    
628     #ifdef ATMOSPHERIC_LOADING
629     IF ( useRealFreshWaterFlux ) THEN
630     DO J=1,sNy
631     DO I=1,sNx
632     sIceLoad(i,j,bi,bj) = HEFF(I,J,1,bi,bj)*SEAICE_rhoIce
633     & + HSNOW(I,J,bi,bj)* 330. _d 0
634     ENDDO
635     ENDDO
636     ENDIF
637     #endif
638    
639     ENDDO
640     ENDDO
641    
642     RETURN
643     END

  ViewVC Help
Powered by ViewVC 1.1.22