/[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.8 - (hide annotations) (download)
Wed Dec 20 20:49:12 2006 UTC (17 years, 4 months ago) by mlosch
Branch: MAIN
Changes since 1.7: +143 -97 lines
rewritting parts of growth in an effort to make it comprehensable:
- give resonalbe variable names
- avoid reusing the same variable for different purposes (still some
  instances left for the next time around)
- lets hope for the adjoint (but that should actually be happier now)

1 mlosch 1.8 C $Header: /u/gcmpack/MITgcm/pkg/seaice/seaice_growth.F,v 1.7 2006/12/20 12:25:15 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     _RL TBC, salinity_ice, SDF, ICE_DENS, ICE2SNOW
45     _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     ICE_DENS = 0.920 _d 0
110 mlosch 1.8 C RATIO OF SEA ICE DENSITY to SNOW DENSITY
111     ICE2SNOW = SDF * ICE_DENS
112     C HEAT OF FUSION OF ICE (m^3/J)
113     QI = 302.0 _d +06
114     recip_QI = 1.0 _d 0 / QI
115 mlosch 1.3 C HEAT OF FUSION OF SNOW (J/m^3)
116     QS = 1.1 _d +08
117 mlosch 1.8 recip_QS = 1.1 _d 0 / QS
118 mlosch 1.1
119     DO bj=myByLo(myThid),myByHi(myThid)
120     DO bi=myBxLo(myThid),myBxHi(myThid)
121     c
122     #ifdef ALLOW_AUTODIFF_TAMC
123     act1 = bi - myBxLo(myThid)
124     max1 = myBxHi(myThid) - myBxLo(myThid) + 1
125     act2 = bj - myByLo(myThid)
126     max2 = myByHi(myThid) - myByLo(myThid) + 1
127     act3 = myThid - 1
128     max3 = nTx*nTy
129     act4 = ikey_dynamics - 1
130     iicekey = (act1 + 1) + act2*max1
131     & + act3*max1*max2
132     & + act4*max1*max2*max3
133     #endif /* ALLOW_AUTODIFF_TAMC */
134     C
135     C initialise a few fields
136     C
137 heimbach 1.2 #ifdef ALLOW_AUTODIFF_TAMC
138     CADJ STORE area(:,:,:,bi,bj) = comlev1_bibj,
139     CADJ & key = iicekey, byte = isbyte
140     CADJ STORE qnet(:,:,bi,bj) = comlev1_bibj,
141     CADJ & key = iicekey, byte = isbyte
142     CADJ STORE qsw(:,:,bi,bj) = comlev1_bibj,
143     CADJ & key = iicekey, byte = isbyte
144     #endif /* ALLOW_AUTODIFF_TAMC */
145 mlosch 1.1 DO J=1,sNy
146     DO I=1,sNx
147 mlosch 1.8 FHEFF(I,J) = 0.0 _d 0
148     FICE (I,J) = 0.0 _d 0
149 mlosch 1.7 #ifdef SEAICE_MULTICATEGORY
150 mlosch 1.8 FICEP(I,J) = 0.0 _d 0
151     QSWIP(I,J) = 0.0 _d 0
152 mlosch 1.1 #endif
153 mlosch 1.8 FHEFF(I,J) = 0.0 _d 0
154     FICE (I,J) = 0.0 _d 0
155     QNETO(I,J) = 0.0 _d 0
156     QNETI(I,J) = 0.0 _d 0
157     QSWO (I,J) = 0.0 _d 0
158     QSWI (I,J) = 0.0 _d 0
159     HCORR(I,J) = 0.0 _d 0
160     frWtrIce(I,J) = 0.0 _d 0
161     RESID_HEAT(I,J) = 0.0 _d 0
162 mlosch 1.1 ENDDO
163     ENDDO
164     #ifdef ALLOW_AUTODIFF_TAMC
165 heimbach 1.2 CADJ STORE heff(:,:,:,bi,bj) = comlev1_bibj,
166     CADJ & key = iicekey, byte = isbyte
167     CADJ STORE hsnow(:,:,bi,bj) = comlev1_bibj,
168     CADJ & key = iicekey, byte = isbyte
169 mlosch 1.1 #endif /* ALLOW_AUTODIFF_TAMC */
170 heimbach 1.2 DO J=1,sNy
171     DO I=1,sNx
172 dimitri 1.6 C COMPUTE ACTUAL ICE THICKNESS AND PUT MINIMUM/MAXIMUM
173     C ON ICE THICKNESS FOR BUDGET COMPUTATION
174 mlosch 1.8 C The default of A22 = 0.15 is a common threshold for defining
175     C the ice edge. This ice concentration usually does not occur
176     C due to thermodynamics but due to advection.
177 mlosch 1.7 areaLoc = MAX(A22,AREA(I,J,2,bi,bj))
178     HICE(I,J) = HEFF(I,J,2,bi,bj)/areaLoc
179 mlosch 1.8 C Do we know what this is for?
180 dimitri 1.6 HICE(I,J) = MAX(HICE(I,J),0.05 _d +00)
181 mlosch 1.8 C Capping the actual ice thickness effectively enforces a
182     C minimum of heat flux through the ice and helps getting rid of
183     C very thick ice.
184 dimitri 1.6 HICE(I,J) = MIN(HICE(I,J),9.0 _d +00)
185 mlosch 1.7 hSnwLoc(I,J) = HSNOW(I,J,bi,bj)/areaLoc
186 heimbach 1.2 ENDDO
187     ENDDO
188 mlosch 1.1
189     C NOW DETERMINE MIXED LAYER TEMPERATURE
190     DO J=1,sNy
191     DO I=1,sNx
192     TMIX(I,J,bi,bj)=theta(I,J,kSurface,bi,bj)+273.16 _d +00
193     #ifdef SEAICE_DEBUG
194     TMIX(I,J,bi,bj)=MAX(TMIX(I,J,bi,bj),271.2 _d +00)
195     #endif
196     ENDDO
197     ENDDO
198    
199     C THERMAL WIND OF ATMOSPHERE
200     DO J=1,sNy
201     DO I=1,sNx
202     CML#ifdef SEAICE_EXTERNAL_FORCING
203     CMLC this seems to be more natural as we do compute the wind speed in
204     CMLC pkg/exf/exf_wind.F, but it changes the results
205     CML UG(I,J) = MAX(SEAICE_EPS,wspeed(I,J,bi,bj))
206     CML#else
207     SPEED_SQ = UWIND(I,J,bi,bj)**2 + VWIND(I,J,bi,bj)**2
208     IF ( SPEED_SQ .LE. SEAICE_EPS_SQ ) THEN
209     UG(I,J)=SEAICE_EPS
210     ELSE
211     UG(I,J)=SQRT(SPEED_SQ)
212     ENDIF
213     CML#endif /* SEAICE_EXTERNAL_FORCING */
214     ENDDO
215     ENDDO
216    
217    
218     #ifdef ALLOW_AUTODIFF_TAMC
219 heimbach 1.2 cphCADJ STORE heff = comlev1, key = ikey_dynamics
220     cphCADJ STORE hsnow = comlev1, key = ikey_dynamics
221     cphCADJ STORE uwind = comlev1, key = ikey_dynamics
222     cphCADJ STORE vwind = comlev1, key = ikey_dynamics
223     c
224 mlosch 1.1 CADJ STORE tice = comlev1, key = ikey_dynamics
225 mlosch 1.7 # ifdef SEAICE_MULTICATEGORY
226 mlosch 1.1 CADJ STORE tices = comlev1, key = ikey_dynamics
227     # endif
228     #endif /* ALLOW_AUTODIFF_TAMC */
229    
230     C NOW DETERMINE GROWTH RATES
231     C FIRST DO OPEN WATER
232     CALL SEAICE_BUDGET_OCEAN(
233     I UG,
234     U TMIX,
235     O QNETO, QSWO,
236     I bi, bj)
237    
238     C NOW DO ICE
239 mlosch 1.7 #ifdef SEAICE_MULTICATEGORY
240     C-- Start loop over muli-categories
241 mlosch 1.1 DO IT=1,MULTDIM
242     #ifdef ALLOW_AUTODIFF_TAMC
243     ilockey = (iicekey-1)*MULTDIM + IT
244     CADJ STORE tices(:,:,it,bi,bj) = comlev1_multdim,
245     CADJ & key = ilockey, byte = isbyte
246     #endif /* ALLOW_AUTODIFF_TAMC */
247 mlosch 1.7 RK=REAL(IT)
248 mlosch 1.1 DO J=1,sNy
249     DO I=1,sNx
250 mlosch 1.7 HICEP(I,J)=(HICE(I,J)/MULTDIM)*((2.0 _d 0*RK)-1.0 _d 0)
251 mlosch 1.1 TICE(I,J,bi,bj)=TICES(I,J,IT,bi,bj)
252     ENDDO
253     ENDDO
254     CALL SEAICE_BUDGET_ICE(
255 mlosch 1.5 I UG, HICEP, hSnwLoc,
256 mlosch 1.1 U TICE,
257 mlosch 1.7 O FICEP, QSWIP,
258 mlosch 1.1 I bi, bj)
259     DO J=1,sNy
260     DO I=1,sNx
261 mlosch 1.7 C average surface heat fluxes/growth rates
262     FICE (I,J) = FICE(I,J) + FICEP(I,J)/MULTDIM
263     QSWI (I,J) = QSWI(I,J) + QSWIP(I,J)/MULTDIM
264     TICES(I,J,IT,bi,bj) = TICE(I,J,bi,bj)
265 mlosch 1.1 ENDDO
266     ENDDO
267     ENDDO
268 mlosch 1.7 C-- End loop over multi-categories
269     #else /* SEAICE_MULTICATEGORY */
270 mlosch 1.1 CALL SEAICE_BUDGET_ICE(
271     I UG, HICE, hSnwLoc,
272     U TICE,
273     O FICE, QSWI,
274     I bi, bj)
275 mlosch 1.7 #endif /* SEAICE_MULTICATEGORY */
276 mlosch 1.1
277 mlosch 1.3 #ifdef ALLOW_AUTODIFF_TAMC
278     CADJ STORE theta(:,:,:,bi,bj)= comlev1_bibj,
279     CADJ & key = iicekey, byte = isbyte
280     CADJ STORE heff(:,:,:,bi,bj) = comlev1_bibj,
281     CADJ & key = iicekey, byte = isbyte
282     #endif /* ALLOW_AUTODIFF_TAMC */
283 mlosch 1.8 C
284     C-- compute and apply ice growth due to oceanic heat flux from below
285     C
286 mlosch 1.3 DO J=1,sNy
287     DO I=1,sNx
288     C-- Create or melt sea-ice so that first-level oceanic temperature
289     C is approximately at the freezing point when there is sea-ice.
290 mlosch 1.8 C Initially the units of YNEG/availHeat are m of sea-ice.
291 mlosch 1.3 C The factor dRf(1)/72.0764, used to convert temperature
292     C change in deg K to m of sea-ice, is approximately:
293     C dRf(1) * (sea water heat capacity = 3996 J/kg/K)
294     C * (density of sea-water = 1026 kg/m^3)
295     C / (latent heat of fusion of sea-ice = 334000 J/kg)
296     C / (density of sea-ice = 910 kg/m^3)
297 mlosch 1.8 C Negative YNEG/availHeat leads to ice growth.
298     C Positive YNEG/availHeat leads to ice melting.
299 mlosch 1.3 IF ( .NOT. inAdMode ) THEN
300     #ifdef SEAICE_VARIABLE_FREEZING_POINT
301     TBC = -0.0575 _d 0*salt(I,J,kSurface,bi,bj) + 0.0901 _d 0
302     #endif /* SEAICE_VARIABLE_FREEZING_POINT */
303 mlosch 1.8 availHeat = (theta(I,J,kSurface,bi,bj)-TBC)
304 mlosch 1.3 & *dRf(1)/72.0764 _d 0
305     ELSE
306 mlosch 1.8 availHeat = 0.
307 mlosch 1.3 ENDIF
308 mlosch 1.8 C local copy of old effective ice thickness
309     hEffOld = HEFF(I,J,1,bi,bj)
310     C Melt (availHeat>0) or create (availHeat<0) sea ice
311     HEFF(I,J,1,bi,bj) = MAX(ZERO,HEFF(I,J,1,bi,bj)-availHeat)
312     C
313     YNEG(I,J,bi,bj) = hEffOld - HEFF(I,J,1,bi,bj)
314     C
315     frWtrIce(I,J) = frWtrIce(I,J) - YNEG(I,J,bi,bj)
316     RESID_HEAT(I,J) = availHeat - YNEG(I,J,bi,bj)
317 mlosch 1.3 C YNEG now contains m of ice melted (>0) or created (<0)
318 mlosch 1.8 C frWtrIce contains m of ice melted (<0) or created (>0)
319 mlosch 1.3 C RESID_HEAT is residual heat above freezing in equivalent m of ice
320     ENDDO
321     ENDDO
322    
323 mlosch 1.1 cph(
324     #ifdef ALLOW_AUTODIFF_TAMC
325     cphCADJ STORE heff = comlev1, key = ikey_dynamics
326     cphCADJ STORE hsnow = comlev1, key = ikey_dynamics
327     #endif
328     cph)
329     c
330     #ifdef ALLOW_AUTODIFF_TAMC
331     CADJ STORE area(:,:,:,bi,bj) = comlev1_bibj,
332     CADJ & key = iicekey, byte = isbyte
333     CADJ STORE hsnow(:,:,bi,bj) = comlev1_bibj,
334     CADJ & key = iicekey, byte = isbyte
335 heimbach 1.2 CADJ STORE fice(:,:) = comlev1_bibj,
336 mlosch 1.1 CADJ & key = iicekey, byte = isbyte
337     #endif /* ALLOW_AUTODIFF_TAMC */
338     cph)
339 mlosch 1.8 C
340     C-- compute and apply ice growth due to atmospheric fluxes from above
341     C
342 mlosch 1.1 DO J=1,sNy
343     DO I=1,sNx
344 mlosch 1.3 C NOW CALCULATE CORRECTED effective growth in J/m^2 (>0=melt)
345     GHEFF(I,J)=-SEAICE_deltaTtherm*FICE(I,J)*AREA(I,J,2,bi,bj)
346 mlosch 1.1 ENDDO
347     ENDDO
348 heimbach 1.2
349 mlosch 1.1 #ifdef ALLOW_AUTODIFF_TAMC
350 mlosch 1.3 CADJ STORE fice(:,:) = comlev1_bibj,
351     CADJ & key = iicekey, byte = isbyte
352 mlosch 1.1 #endif /* ALLOW_AUTODIFF_TAMC */
353    
354     DO J=1,sNy
355     DO I=1,sNx
356     IF(FICE(I,J).LT.ZERO.AND.AREA(I,J,2,bi,bj).GT.ZERO) THEN
357 mlosch 1.8 C use FICE to melt snow and CALCULATE CORRECTED GROWTH
358     C effective snow thickness in J/m^2
359     snowEnergy=HSNOW(I,J,bi,bj)*QS
360     IF(GHEFF(I,J).LE.snowEnergy) THEN
361     C not enough heat to melt all snow; use up all heat flux FICE
362 mlosch 1.1 HSNOW(I,J,bi,bj)=HSNOW(I,J,bi,bj)-GHEFF(I,J)/QS
363 mlosch 1.8 C SNOW CONVERTED INTO WATER AND THEN INTO equivalent m of ICE melt
364     C The factor 1/ICE2SNOW converts m of snow to m of sea-ice
365     frWtrIce(I,J) = frWtrIce(I,J) - GHEFF(I,J)/(QS*ICE2SNOW)
366     FICE (I,J) = ZERO
367 mlosch 1.1 ELSE
368 mlosch 1.8 C enought heat to melt snow completely;
369     C compute remaining heat flux that will melt ice
370     FICE(I,J)=-(GHEFF(I,J)-snowEnergy)/
371 mlosch 1.1 & SEAICE_deltaTtherm/AREA(I,J,2,bi,bj)
372     C convert all snow to melt water (fresh water flux)
373 mlosch 1.8 frWtrIce(I,J) = frWtrIce(I,J)
374     & -HSNOW(I,J,bi,bj)/ICE2SNOW
375 mlosch 1.1 HSNOW(I,J,bi,bj)=0.0
376     END IF
377     END IF
378 heimbach 1.2 ENDDO
379     ENDDO
380 mlosch 1.1
381 heimbach 1.2 #ifdef ALLOW_AUTODIFF_TAMC
382 mlosch 1.3 CADJ STORE fice(:,:) = comlev1_bibj,
383     CADJ & key = iicekey, byte = isbyte
384 heimbach 1.2 #endif /* ALLOW_AUTODIFF_TAMC */
385    
386     DO J=1,sNy
387     DO I=1,sNx
388 mlosch 1.8 C now get cell averaged growth rate in W/m^2, >0 causes ice growth
389 mlosch 1.1 FHEFF(I,J)= FICE(I,J) * AREA(I,J,2,bi,bj)
390     & + QNETO(I,J) * (ONE-AREA(I,J,2,bi,bj))
391     ENDDO
392     ENDDO
393     cph(
394     #ifdef ALLOW_AUTODIFF_TAMC
395     CADJ STORE heff(:,:,:,bi,bj) = comlev1_bibj,
396     CADJ & key = iicekey, byte = isbyte
397     CADJ STORE hsnow(:,:,bi,bj) = comlev1_bibj,
398     CADJ & key = iicekey, byte = isbyte
399 mlosch 1.3 CADJ STORE fice(:,:) = comlev1_bibj,
400 mlosch 1.1 CADJ & key = iicekey, byte = isbyte
401 mlosch 1.3 CADJ STORE fheff(:,:) = comlev1_bibj,
402 mlosch 1.1 CADJ & key = iicekey, byte = isbyte
403 mlosch 1.3 CADJ STORE qneto(:,:) = comlev1_bibj,
404 mlosch 1.1 CADJ & key = iicekey, byte = isbyte
405 mlosch 1.3 CADJ STORE qswi(:,:) = comlev1_bibj,
406 mlosch 1.1 CADJ & key = iicekey, byte = isbyte
407 mlosch 1.3 CADJ STORE qswo(:,:) = comlev1_bibj,
408 mlosch 1.1 CADJ & key = iicekey, byte = isbyte
409     #endif /* ALLOW_AUTODIFF_TAMC */
410     cph)
411     #ifdef ALLOW_AUTODIFF_TAMC
412     CADJ STORE area(:,:,:,bi,bj) = comlev1_bibj,
413     CADJ & key = iicekey, byte = isbyte
414     #endif
415 mlosch 1.8 C
416     C First update (freeze or melt) ice area
417     C
418 mlosch 1.1 DO J=1,sNy
419     DO I=1,sNx
420 mlosch 1.8 C negative growth in meters of ice (>0 for melting)
421     growthNeg = -SEAICE_deltaTtherm*FHEFF(I,J)*recip_QI
422     C negative growth must not exceed effective ice thickness (=volume)
423     C (that is, cannot melt more than all the ice)
424     growthHEFF = -ONE*MIN(HEFF(I,J,1,bi,bj),growthNeg)
425     C growthHEFF < 0 means melting
426     HCORR(I,J) = MIN(ZERO,growthHEFF)
427     C gain of new effective ice thickness over open water (>0 by definition)
428     GAREA(I,J) = MAX(ZERO,SEAICE_deltaTtherm*QNETO(I,J)*recip_QI)
429     CML removed these loops and moved TAMC store directive up
430     CML ENDDO
431     CML ENDDO
432     CML#ifdef ALLOW_AUTODIFF_TAMC
433     CMLCADJ STORE area(:,:,:,bi,bj) = comlev1_bibj,
434     CMLCADJ & key = iicekey, byte = isbyte
435     CML#endif
436     CML DO J=1,sNy
437     CML DO I=1,sNx
438     C Here we finally compute the new AREA
439     AREA(I,J,1,bi,bj)=AREA(I,J,1,bi,bj)+
440     & (ONE-AREA(I,J,2,bi,bj))*GAREA(I,J)/HO
441     & +HALF*HCORR(I,J)*AREA(I,J,2,bi,bj)
442     & /(HEFF(I,J,1,bi,bj)+.00001 _d 0)
443 mlosch 1.1 ENDDO
444     ENDDO
445     #ifdef ALLOW_AUTODIFF_TAMC
446     CADJ STORE area(:,:,:,bi,bj) = comlev1_bibj,
447     CADJ & key = iicekey, byte = isbyte
448     #endif
449 mlosch 1.8 C
450     C now update (freeze or melt) HEFF
451     C
452 mlosch 1.1 DO J=1,sNy
453     DO I=1,sNx
454 mlosch 1.8 C negative growth (>0 for melting) of existing ice in meters
455     growthNeg = -SEAICE_deltaTtherm*
456     & FICE(I,J)*recip_QI*AREA(I,J,2,bi,bj)
457     C negative growth must not exceed effective ice thickness (=volume)
458     C (that is, cannot melt more than all the ice)
459     growthHEFF = -ONE*MIN(HEFF(I,J,1,bi,bj),growthNeg)
460     C growthHEFF < 0 means melting
461     HEFF(I,J,1,bi,bj)= HEFF(I,J,1,bi,bj) + growthHEFF
462     C add effective growth to fresh water of ice
463     frWtrIce(I,J) = frWtrIce(I,J) + growthHEFF
464    
465     C now calculate QNETI under ice (if any) as the difference between
466     C the available "heat flux" growthNeg and the actual growthHEFF;
467     C keep in mind that growthNeg and growthHEFF have different signs
468     C by construction
469     QNETI(I,J) = (growthHEFF + growthNeg)*QI/SEAICE_deltaTtherm
470 mlosch 1.1
471 mlosch 1.8 C now update other things
472 mlosch 1.1
473     IF(FICE(I,J).GT.ZERO) THEN
474 mlosch 1.8 C freezing, add precip as snow
475 mlosch 1.3 HSNOW(I,J,bi,bj) = HSNOW(I,J,bi,bj)+SEAICE_deltaTtherm*
476 mlosch 1.1 & PRECIP(I,J,bi,bj)*AREA(I,J,2,bi,bj)*SDF
477     ELSE
478 mlosch 1.8 C add precip as rain, water converted into equivalent m of
479     C ice by 1/ICE_DENS.
480     C Sign issue? frWtrIce (>0 for more ice)
481     C has the opposite sign of precip (>0 for downward flux of water)
482     frWtrIce(I,J) = frWtrIce(I,J)
483 mlosch 1.1 & -PRECIP(I,J,bi,bj)*AREA(I,J,2,bi,bj)*
484     & SEAICE_deltaTtherm/ICE_DENS
485     ENDIF
486    
487 mlosch 1.8 C now add in precip over open water directly into ocean as negative salt
488     C Sign issue? frWtrIce (>0 for more ice)
489     C has the opposite sign of precip (>0 for downward flux of water)
490     frWtrIce(I,J) = frWtrIce(I,J)
491 mlosch 1.1 & -PRECIP(I,J,bi,bj)*(ONE-AREA(I,J,2,bi,bj))
492     & *SEAICE_deltaTtherm/ICE_DENS
493    
494 mlosch 1.8 C Now melt snow if there is residual heat left in surface level
495     C Note that units of YNEG and frWtrIce are m of ice
496 heimbach 1.4 cph( very sensitive bit here by JZ
497 mlosch 1.8 IF( RESID_HEAT(I,J) .GT. ZERO .AND.
498     & HSNOW(I,J,bi,bj) .GT. ZERO ) THEN
499 mlosch 1.3 GHEFF(I,J) = MIN( HSNOW(I,J,bi,bj)/SDF/ICE_DENS,
500     & RESID_HEAT(I,J) )
501 mlosch 1.8 YNEG(I,J,bi,bj) = YNEG(I,J,bi,bj) +GHEFF(I,J)
502 mlosch 1.3 HSNOW(I,J,bi,bj) = HSNOW(I,J,bi,bj)-GHEFF(I,J)*SDF*ICE_DENS
503 mlosch 1.8 frWtrIce(I,J) = frWtrIce(I,J) -GHEFF(I,J)
504 mlosch 1.1 ENDIF
505 heimbach 1.4 cph)
506 mlosch 1.1
507     C NOW GET FRESH WATER FLUX
508 mlosch 1.3 EmPmR(I,J,bi,bj) = maskC(I,J,kSurface,bi,bj)*(
509 mlosch 1.1 & EVAP(I,J,bi,bj)*(ONE-AREA(I,J,2,bi,bj))
510     & -RUNOFF(I,J,bi,bj)
511 mlosch 1.8 & +frWtrIce(I,J)*ICE_DENS/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.3 HSNOW(I,J,bi,bj) = MAX(0. _d 0,HSNOW(I,J,bi,bj)-hFlood/SDF)
622 mlosch 1.1 ENDDO
623     ENDDO
624     ENDIF
625     #endif /* ALLOW_SEAICE_FLOODING */
626    
627     #ifdef ATMOSPHERIC_LOADING
628     IF ( useRealFreshWaterFlux ) THEN
629     DO J=1,sNy
630     DO I=1,sNx
631     sIceLoad(i,j,bi,bj) = HEFF(I,J,1,bi,bj)*SEAICE_rhoIce
632     & + HSNOW(I,J,bi,bj)* 330. _d 0
633     ENDDO
634     ENDDO
635     ENDIF
636     #endif
637    
638     ENDDO
639     ENDDO
640    
641     RETURN
642     END

  ViewVC Help
Powered by ViewVC 1.1.22