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

Contents of /MITgcm/pkg/seaice/budget.F

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

Revision 1.9 - (show annotations) (download)
Fri May 23 20:19:16 2003 UTC (21 years, 1 month ago) by dimitri
Branch: MAIN
CVS Tags: checkpoint50h_post, checkpoint50i_post, checkpoint50g_post
Changes since 1.8: +8 -5 lines 
checkpoint50g_post
o merged with release1_p17 (pkg/seaice and verification/lab_sea)
  - added SEAICE_MULTILEVEL for 8-category sea-ice thermodynamics
  - LSR sea-ice dynamic solver moved to SouthWest B-grid location and
    made the default because of faster convergence than ADI
1 C $Header:
2
3 #include "SEAICE_OPTIONS.h"
4
5 CStartOfInterface
6 SUBROUTINE BUDGET(UG, TICE, HICE1, FICE1, KOPEN, bi, bj)
7 C /==========================================================\
8 C | SUBROUTINE budget |
9 C | o Calculate ice growth rate |
10 C | see Hibler, MWR, 108, 1943-1973, 1980 |
11 C |==========================================================|
12 C \==========================================================/
13 IMPLICIT NONE
14
15 C === Global variables ===
16 #include "SIZE.h"
17 #include "EEPARAMS.h"
18 #include "FFIELDS.h"
19 #include "SEAICE_PARAMS.h"
20 #include "SEAICE_FFIELDS.h"
21
22 C Subset of variables from SEAICE.h
23 _RL HEFF (1-OLx:sNx+OLx,1-OLy:sNy+OLy,3,nSx,nSy)
24 _RL HSNOW (1-OLx:sNx+OLx,1-OLy:sNy+OLy, nSx,nSy)
25 _RL QNETO (1-OLx:sNx+OLx,1-OLy:sNy+OLy, nSx,nSy)
26 _RL QNETI (1-OLx:sNx+OLx,1-OLy:sNy+OLy, nSx,nSy)
27 _RL QSWO (1-OLx:sNx+OLx,1-OLy:sNy+OLy, nSx,nSy)
28 _RL QSWI (1-OLx:sNx+OLx,1-OLy:sNy+OLy, nSx,nSy)
29 COMMON/TRANS/HEFF,HSNOW
30 COMMON/QFLUX/QNETO,QNETI,QSWO,QSWI
31
32 C === Routine arguments ===
33 _RL UG (1-OLx:sNx+OLx, 1-OLy:sNy+OLy)
34 _RL TICE (1-OLx:sNx+OLx, 1-OLy:sNy+OLy, nSx,nSy)
35 _RL HICE1 (1-OLx:sNx+OLx, 1-OLy:sNy+OLy)
36 _RL FICE1 (1-OLx:sNx+OLx, 1-OLy:sNy+OLy, nSx,nSy)
37 INTEGER KOPEN
38 INTEGER bi, bj
39 CEndOfInterface
40
41 #ifdef ALLOW_SEAICE
42
43 C === Local variables ===
44 C i,j,k,bi,bj - Loop counters
45
46 INTEGER i, j
47 INTEGER ITER
48 _RL QS1, C1, C2, C3, C4, C5, TB, D1, D1W, D1I, D3
49 _RL TMELT, TMELTP, XKI, XKS, HCUT, ASNOW, XIO
50
51 _RL HICE (1-OLx:sNx+OLx, 1-OLy:sNy+OLy)
52 _RL ALB (1-OLx:sNx+OLx, 1-OLy:sNy+OLy)
53 _RL A1 (1-OLx:sNx+OLx, 1-OLy:sNy+OLy)
54 _RL A2 (1-OLx:sNx+OLx, 1-OLy:sNy+OLy)
55 _RL A3 (1-OLx:sNx+OLx, 1-OLy:sNy+OLy)
56 _RL B (1-OLx:sNx+OLx, 1-OLy:sNy+OLy)
57
58 C IF KOPEN LT 0, THEN DO OPEN WATER BUDGET
59 C NOW DEFINE ASSORTED CONSTANTS
60 C SATURATION VAPOR PRESSURE CONSTANT
61 QS1=0.622 _d +00/1013.0 _d +00
62 C MAYKUTS CONSTANTS FOR SAT. VAP. PRESSURE TEMP. POLYNOMIAL
63 C1=2.7798202 _d -06
64 C2=-2.6913393 _d -03
65 C3=0.97920849 _d +00
66 C4=-158.63779 _d +00
67 C5=9653.1925 _d +00
68 C FREEZING TEMPERATURE OF SEAWATER
69 TB=271.2 _d +00
70 C SENSIBLE HEAT CONSTANT
71 D1=SEAICE_sensHeat
72 C WATER LATENT HEAT CONSTANT
73 D1W=SEAICE_latentWater
74 C ICE LATENT HEAT CONSTANT
75 D1I=SEAICE_latentIce
76 C STEFAN BOLTZMAN CONSTANT TIMES 0.97 EMISSIVITY
77 D3=SEAICE_emissivity
78 C MELTING TEMPERATURE OF ICE
79 TMELT=273.16 _d +00
80 TMELTP=273.159 _d +00
81 C ICE CONDUCTIVITY
82 XKI=SEAICE_iceConduct
83 C SNOW CONDUCTIVITY
84 XKS=SEAICE_snowConduct
85 C CUTOFF SNOW THICKNESS
86 HCUT=SEAICE_snowThick
87 C PENETRATION SHORTWAVE RADIATION FACTOR
88 XIO=SEAICE_shortwave
89
90 DO J=1,sNy
91 DO I=1,sNx
92 TICE(I,J,bi,bj)=MIN(273.16 _d 0+MAX_TICE,TICE(I,J,bi,bj))
93 ATEMP(I,J,bi,bj)=MAX(273.16 _d 0+MIN_ATEMP,ATEMP(I,J,bi,bj))
94 LWDOWN(I,J,bi,bj)=MAX(MIN_LWDOWN,LWDOWN(I,J,bi,bj))
95 ENDDO
96 ENDDO
97
98 C NOW DECIDE IF OPEN WATER OR ICE
99 IF(KOPEN.LE.0) THEN
100
101 C NOW DETERMINE OPEN WATER HEAT BUD. ASSUMING TICE=WATER TEMP.
102 C WATER ALBEDO IS ASSUMED TO BE THE CONSTANT SEAICE_waterAlbedo
103 DO J=1,sNy
104 DO I=1,sNx
105 #ifdef SEAICE_EXTERNAL_FLUXES
106 FICE1(I,J,bi,bj)=QNET(I,J,bi,bj)+Qsw(I,J,bi,bj)
107 QSWO(I,J,bi,bj)=Qsw(I,J,bi,bj)
108 #else /* SEAICE_EXTERNAL_FLUXES undefined */
109 ALB(I,J)=SEAICE_waterAlbedo
110 A1(I,J)=(ONE-ALB(I,J))*SWDOWN(I,J,bi,bj)
111 & +LWDOWN(I,J,bi,bj)*0.97 _d 0
112 & +D1*UG(I,J)*ATEMP(I,J,bi,bj)+D1W*UG(I,J)*AQH(I,J,bi,bj)
113 B(I,J)=QS1*6.11 _d +00*EXP(17.2694 _d +00
114 & *(TICE(I,J,bi,bj)-TMELT)
115 & /(TICE(I,J,bi,bj)-TMELT+237.3 _d +00))
116 A2(I,J)=-D1*UG(I,J)*TICE(I,J,bi,bj)-D1W*UG(I,J)*B(I,J)
117 & -D3*(TICE(I,J,bi,bj)**4)
118 FICE1(I,J,bi,bj)=-A1(I,J)-A2(I,J)
119 QSWO(I,J,bi,bj)=-(ONE-ALB(I,J))*SWDOWN(I,J,bi,bj)
120 #endif /* SEAICE_EXTERNAL_FLUXES */
121 QNETO(I,J,bi,bj)=FICE1(I,J,bi,bj)-QSWO(I,J,bi,bj)
122 ENDDO
123 ENDDO
124
125 ELSE
126
127 C COME HERE IF ICE COVER
128 C FIRST PUT MINIMUM ON ICE THICKNESS
129 DO J=1,sNy
130 DO I=1,sNx
131 HICE(I,J)=MAX(HICE1(I,J),0.05 _d +00)
132 HICE(I,J)=MIN(HICE(I,J),9.0 _d +00)
133 ENDDO
134 ENDDO
135 C NOW DECIDE ON ALBEDO
136 DO J=1,sNy
137 DO I=1,sNx
138 ALB(I,J)=0.75 _d +00
139 IF(TICE(I,J,bi,bj).GT.TMELTP) ALB(I,J)=SEAICE_albedo
140 ASNOW=SEAICE_drySnowAlb
141 IF(TICE(I,J,bi,bj).GT.TMELTP) ASNOW=SEAICE_wetSnowAlb
142 IF(HSNOW(I,J,bi,bj).GT.HCUT) THEN
143 ALB(I,J)=ASNOW
144 ELSE
145 ALB(I,J)=ALB(I,J)+(HSNOW(I,J,bi,bj)/HCUT)*(ASNOW-ALB(I,J))
146 IF(ALB(I,J).GT.ASNOW) ALB(I,J)=ASNOW
147 END IF
148 ENDDO
149 ENDDO
150 C NOW DETERMINE FIXED FORCING TERM IN HEAT BUDGET
151 DO J=1,sNy
152 DO I=1,sNx
153 IF(HSNOW(I,J,bi,bj).GT.0.0) THEN
154 C NO SW PENETRATION WITH SNOW
155 A1(I,J)=(ONE-ALB(I,J))*SWDOWN(I,J,bi,bj)
156 & +LWDOWN(I,J,bi,bj)*0.97 _d 0
157 & +D1*UG(I,J)*ATEMP(I,J,bi,bj)+D1I*UG(I,J)*AQH(I,J,bi,bj)
158 ELSE
159 C SW PENETRATION UNDER ICE
160 A1(I,J)=(ONE-ALB(I,J))*SWDOWN(I,J,bi,bj)
161 & *(ONE-XIO*EXP(-1.5 _d 0*HICE(I,J)))
162 & +LWDOWN(I,J,bi,bj)*0.97 _d 0
163 & +D1*UG(I,J)*ATEMP(I,J,bi,bj)+D1I*UG(I,J)*AQH(I,J,bi,bj)
164 ENDIF
165 ENDDO
166 ENDDO
167 C NOW COMPUTE OTHER TERMS IN HEAT BUDGET
168 C COME HERE AT START OF ITERATION
169
170 crg check wether a2 is needed in the list of variables
171 cdm Ralf, the line below causes following error message
172 cdm INTERNAL ERROR: cannot find var clone to ada2
173 cdm c$taf loop = iteration TICE,A2
174 cdm iterative solver for ice growth rate
175 cdm inputs: TICE ice temperature
176 cdm UG forcing
177 cdm HSNOW snow thickness
178 cdm HICE ice thickness
179 cdm outputs: A2 is needed for FICE1, which is ice growth rate
180 cdm TICE
181 DO ITER=1,IMAX_TICE
182
183 DO J=1,sNy
184 DO I=1,sNx
185 B(I,J)=QS1*(C1*TICE(I,J,bi,bj)**4+C2*TICE(I,J,bi,bj)**3
186 & +C3*TICE(I,J,bi,bj)**2+C4*TICE(I,J,bi,bj)+C5)
187 A2(I,J)=-D1*UG(I,J)*TICE(I,J,bi,bj)-D1I*UG(I,J)*B(I,J)
188 & -D3*(TICE(I,J,bi,bj)**4)
189 B(I,J)=XKS/(HSNOW(I,J,bi,bj)/HICE(I,J)+XKS/XKI)/HICE(I,J)
190 A3(I,J)=4.0 _d +00*D3*(TICE(I,J,bi,bj)**3)+B(I,J)+D1*UG(I,J)
191 B(I,J)=B(I,J)*(TB-TICE(I,J,bi,bj))
192 cdm
193 cdm if(TICE(I,J,bi,bj).le.206.)
194 cdm & print '(A,3i4,f12.2)','### ITER,I,J,TICE',
195 cdm & ITER,I,J,TICE(I,J,bi,bj)
196 cdm
197 ENDDO
198 ENDDO
199 C NOW DECIDE IF IT IS TIME TO ESTIMATE GROWTH RATES
200 C NOW DETERMINE NEW ICE TEMPERATURE
201 DO J=1,sNy
202 DO I=1,sNx
203 TICE(I,J,bi,bj)=TICE(I,J,bi,bj)
204 & +(A1(I,J)+A2(I,J)+B(I,J))/A3(I,J)
205 TICE(I,J,bi,bj)=MAX(273.16 _d 0+MIN_TICE,TICE(I,J,bi,bj))
206 ENDDO
207 ENDDO
208 C NOW SET ICE TEMP TO MIN OF TMELT/ITERATION RESULT
209 DO J=1,sNy
210 DO I=1,sNx
211 TICE(I,J,bi,bj)=MIN(TICE(I,J,bi,bj),TMELT)
212 ENDDO
213 ENDDO
214
215 C END OF ITERATION
216 ENDDO
217
218 DO J=1,sNy
219 DO I=1,sNx
220 FICE1(I,J,bi,bj)=-A1(I,J)-A2(I,J)
221 IF(HSNOW(I,J,bi,bj).GT.0.0) THEN
222 C NO SW PENETRATION WITH SNOW
223 QSWI(I,J,bi,bj)=ZERO
224 ELSE
225 C SW PENETRATION UNDER ICE
226 QSWI(I,J,bi,bj)=-(ONE-ALB(I,J))*SWDOWN(I,J,bi,bj)
227 & *XIO*EXP(-1.5 _d 0*HICE(I,J))
228 ENDIF
229 ENDDO
230 ENDDO
231
232 END IF
233
234 #endif /* ALLOW_SEAICE */
235
236 RETURN
237 END
  ViewVC Help
Powered by ViewVC 1.1.22