/[MITgcm]/MITgcm_contrib/jscott/igsm/src/prland.F
ViewVC logotype

Contents of /MITgcm_contrib/jscott/igsm/src/prland.F

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


Revision 1.1 - (show annotations) (download)
Fri Aug 11 19:35:31 2006 UTC (18 years, 11 months ago) by jscott
Branch: MAIN
atm2d package

1
2 #include "ctrparam.h"
3
4 SUBROUTINE PRECIP_LAND(mndriver) 4001.
5 C**** 4001.5
6 C**** THIS SUBROUTINE USES THE PRECIPITATION TO CALCULATE THE GROUND 4002.
7 C**** WATER, GROUND ICE, SNOW COVER, AND RUNOFF 4002.5
8 C**** 4003.
9 C**** RUN1 IS NOT ACUMULATED IN ADAILY FOR DIAG6 4003.5
10 C**** 4004.
11
12 #include "BD2G04.COM" 4004.5
13 #if ( defined OCEAN_3D || defined ML_2D )
14 #include "AGRID.COM"
15 #endif
16
17 COMMON U,V,T,P,Q 4005.
18 COMMON/WORK1/CONV(IM0,JM0,LM0),PK(IM0,JM0,LM0),PREC(IM0,JM0),
19 & TPREC(IM0,JM0) 4005.5
20 COMMON/FRMIC/ FRMDICE(JM0)
21 DATA SHW/4185./,SHI/2060./,RHOI/916.6/ 4006.
22 DATA Z1I/.1/,Z1E/.1/,Z2LI/2.9/ 4006.5
23 DATA RHOW/1000./,Z2OIM/0.9/,TFO/-1.56/ 4007.
24 DATA TTRUNC/0./ 4007.5
25 DATA IFIRST/1/ 4008.
26 C**** 4008.5
27 C**** FDATA 2 LAND COVERAGE (1) 4009.
28 C**** 3 RATIO OF LAND ICE COVERAGE TO LAND COVERAGE (1) 4009.5
29 C**** 4010.
30 C**** ODATA 1 OCEAN TEMPERATURE (C) 4010.5
31 C**** 2 RATIO OF OCEAN ICE COVERAGE TO WATER COVERAGE (1) 4011.
32 C**** 3 OCEAN ICE AMOUNT OF SECOND LAYER (KG/M**2) 4011.5
33 C**** 4012.
34 C**** GDATA 1 OCEAN ICE SNOW AMOUNT (KG/M**2) 4012.5
35 C**** 2 EARTH SNOW AMOUNT (KG/M**2) 4013.
36 C**** 3 OCEAN ICE TEMPERATURE OF FIRST LAYER (C) 4013.5
37 C**** 4 EARTH TEMPERATURE OF FIRST LAYER (C) 4014.
38 C**** 5 EARTH WATER OF FIRST LAYER (KG/M**2) 4014.5
39 C**** 6 EARTH ICE OF FIRST LAYER (KG/M**2) 4015.
40 C**** 7 OCEAN ICE TEMPERATURE OF SECOND LAYER (C) 4015.5
41 C**** 12 LAND ICE SNOW AMOUNT (KG/M**2) 4016.
42 C**** 13 LAND ICE TEMPERATURE OF FIRST LAYER (C) 4016.5
43 C**** 14 LAND ICE TEMPERATURE OF SECOND LAYER (C) 4017.
44 C**** 4017.5
45 C**** VDATA 9 WATER FIELD CAPACITY OF FIRST LAYER (KG/M**2) 4018.
46 C**** 4018.5
47 IF(IFIRST.NE.1) GO TO 10 4019.
48 IFIRST=0 4019.5
49 SHA=RGAS/KAPA 4020.
50 ACE1I=Z1I*RHOI 4020.5
51 AC2OIM=Z2OIM*RHOI 4021.
52 ATRUNC=2.**(-13) 4021.5
53 ACE2LI=Z2LI*RHOI 4022.
54 HC1I=ACE1I*SHI 4022.5
55 HC1DE=Z1E*1129950. 4023.
56 DO J=1,JM
57 FRMDICE(j)=0.0
58 ENDDO
59 print *,'SNOWMAX=4*ACE1I (1m)'
60 C**** 4023.5
61 C**** OUTSIDE LOOP OVER J AND I, EXECUTED ONCE FOR EACH GRID POINT 4024.
62 C**** 4024.5
63 10 DO 980 J=1,JM 4025.
64 IMAX=IM 4025.5
65 IF(J.EQ.1.OR.J.EQ.JM) IMAX=1 4026.
66 BENRGP=0. 4027.
67 BEDIFS=0. 4028.
68 BERUN0=0. 4029.5
69 BERUN2=0. 4030.
70 BDIFS=0. 4032.
71 BRUN0=0. 4033.5
72 BRUNS0=0.
73 BRUN2=0. 4034.5
74 DO 960 I=1,IMAX 4036.5
75 IF(PREC(I,J).LE.0.) GO TO 960 4037.
76 C**** 4037.5
77 C**** DETERMINE SURFACE CONDITIONS 4038.
78 C**** 4038.5
79 PLAND=FDATA(I,J,2) 4039.
80 PWATER=1.-PLAND 4039.5
81 PLICE=FDATA(I,J,3)*PLAND 4040.
82 PEARTH=PLAND-PLICE 4040.5
83 ROICE=ODATA(I,J,2) 4041.
84 POICE=ROICE*PWATER 4041.5
85 POCEAN=PWATER-POICE 4042.
86 JR=J
87 DXYPJ=DXYP(J) 4043.
88 RUN0S=0. 4043.5
89 DIFSS=0. 4044.
90 C**** CALCULATE PRECIPITATION HEAT FLUX (FALLS AT 0 DEGREES CENTIGRADE) 4044.5
91 ! PRCP=PREC(I,J) 4045.
92 ! 07.18.2006
93 PRCP=PREC(I,J)*prlnd2total(j,mndriver)
94 TPRCP=TPREC(I,J) 4045.5
95 IF(TPRCP.LT.0.) GO TO 30 4046.
96 C EPRCP=PRCP*TPRCP*SHW 4046.5
97 EPRCP=0. 4047.
98 ENRGP=EPRCP 4047.5
99 GO TO 50 4048.
100 C EPRCP=PRCP*TPRCP*SHI 4048.5
101 30 EPRCP=0. 4049.
102 ENRGP=EPRCP-PRCP*LHM 4049.5
103 AIJ(I,J,70)=AIJ(I,J,70)+PRCP 4050.
104 C**** 4050.5
105 50 CONTINUE
106 C**** 4114.
107 400 IF(PLICE.LE.0.) GO TO 600 4114.5
108 C**** 4115.
109 C**** LAND ICE 4115.5
110 C**** 4116.
111 SNOW=GDATA(I,J,12) 4116.5
112 TG1=GDATA(I,J,13) 4117.
113 TG2=GDATA(I,J,14) 4117.5
114 BENRGP=BENRGP+ENRGP*PLICE 4118.
115 AIJ(I,J,67)=AIJ(I,J,67)+ENRGP 4118.5
116 HC1=HC1I+SNOW*SHI 4119.
117 RUN0=0. 4119.5
118 if(j.eq.-42)then
119 print *,' J=',J
120 print *,TPRCP,EPRCP,-TG1*HC1
121 endif
122 IF(TPRCP.LT.0.) GO TO 480 4120.
123 IF(EPRCP.LT.-TG1*HC1) GO TO 460 4120.5
124 C**** RAIN HEATS UP TG1 TO FREEZING POINT AND MELTS SOME SNOW OR ICE 4121.
125 DWATER=(TG1*HC1+EPRCP)/LHM 4121.5
126 TG1=0. 4122.
127 RUN0=DWATER+PRCP 4122.5
128 c
129 c RUNS0 does not include runoff due melting of land ice
130 RUNS0=DMIN1(DWATER,SNOW+FRMDICE(J))+PRCP
131 if(j.eq.-42)then
132 print *,'FRMDICE J=',J
133 print *,FRMDICE(J),SNOW,DWATER
134 endif
135 IF(DWATER.GT.SNOW) THEN
136 FRMDICE(j)=FRMDICE(j)-(DWATER-SNOW)
137 if( FRMDICE(j).lt.0.0) FRMDICE(j)=0.0
138 if(j.eq.-42)then
139 print *,'After melting',FRMDICE(J)
140 endif
141 ENDIF
142 c
143 IF(DWATER.GT.SNOW) GO TO 440 4123.
144 C**** RAIN MELTS SOME SNOW 4123.5
145 SNOW=SNOW-DWATER 4124.
146 GO TO 580 4124.5
147 C**** RAIN MELTS ALL SNOW AND SOME ICE, ICE MOVES UP THROUGH THE LAYERS 4125.
148 440 DIFS=SNOW-DWATER 4125.5
149 SNOW=0. 4126.
150 TG1=-TG2*DIFS/ACE1I 4126.5
151 EDIFS=DIFS*(TG2*SHI-LHM) 4127.
152 ERUN2=EDIFS 4127.5
153 GO TO 560 4128.
154 C**** RAIN COOLS TO FREEZING POINT AND HEATS UP TG1 4128.5
155 460 TG1=TG1+EPRCP/HC1 4129.
156 RUN0=PRCP 4129.5
157 if(j.eq.-42)then
158 print *,'After 460 TG1=',TG1,'PRCP=',PRCP
159 endif
160 c For runoff added on 7/30/03
161 RUNS0=RUN0
162 GO TO 590 4130.
163 C**** SNOW INCREASES SNOW AMOUNT AND SNOW TEMPERATURE RECOMPUTES TG1 4130.5
164 480 TG1=(TG1*HC1+EPRCP)/(HC1+PRCP*SHI) 4131.
165 SNOW=SNOW+PRCP 4131.5
166 if(j.eq.-42)then
167 print *,'After 480 TG1=',TG1,'SNOW=',SNOW
168 endif
169 c GO TO 580
170 c IF(SNOW.LE.ACE1I) GO TO 580 4132.
171 IF(SNOW.LE.4.0*ACE1I) GO TO 580
172 c 4.*ACE1I=360 kg/m^2 of snow, for used function for show density
173 c this corresponds to 1 m deep show.
174 C**** SNOW IS COMPACTED INTO ICE, ICE MOVES DOWN THROUGH THE LAYERS 4132.5
175 c DIFS=SNOW-.9*ACE1I 4133.
176 c SNOW=.9*ACE1I 4133.5
177 DIFS=SNOW-4.*ACE1I
178 SNOW=4.*ACE1I
179 FRMDICE(j)=FRMDICE(j)+DIFS
180 FRMDICE(j)=0.0
181 if(j.eq.-42)then
182 print *,'Before 560 DIFS=',DIFS,'SNOW=',SNOW
183 print *,'FRMDICE(j)=',FRMDICE(j)
184 endif
185 EDIFS=DIFS*(TG1*SHI-LHM) 4134.
186 ERUN2=DIFS*(TG2*SHI-LHM) 4134.5
187 GDATA(I,J,14)=TG2+(TG1-TG2)*DIFS/ACE2LI 4135.
188 560 BEDIFS=BEDIFS+EDIFS*PLICE 4135.5
189 AIJ(I,J,69)=AIJ(I,J,69)+EDIFS 4136.
190 BDIFS=BDIFS+DIFS*PLICE 4136.5
191 DIFSS=DIFSS+DIFS*PLICE 4137.
192 BERUN2=BERUN2+ERUN2*PLICE 4137.5
193 AIJ(I,J,72)=AIJ(I,J,72)+ERUN2 4138.
194 BRUN2=BRUN2+DIFS*PLICE 4138.5
195 580 GDATA(I,J,12)=SNOW 4139.
196 590 GDATA(I,J,13)=TG1 4139.5
197 BRUN0=BRUN0+RUN0*PLICE 4140.
198 BRUNS0=BRUNS0+RUNS0*PLICE
199 if(j.eq.-42)then
200 print *,'After 590 RUNS0=',RUNS0,'RUN0=',RUN0
201 endif
202 c
203 RUN0S=RUN0S+RUN0*PLICE 4140.5
204 AIJ(I,J,33)=AIJ(I,J,33)+RUN0 4141.
205 C**** 4141.5
206 600 IF(PEARTH.LE.0.) GO TO 940 4142.
207 C**** 4142.5
208 C**** EARTH 4143.
209 C**** 4143.5
210 SNOW=GDATA(I,J,2) 4144.
211 TG1=GDATA(I,J,4) 4144.5
212 WTR1=GDATA(I,J,5) 4145.
213 ACE1=GDATA(I,J,6) 4145.5
214 BENRGP=BENRGP+ENRGP*PEARTH 4146.
215 AIJ(I,J,68)=AIJ(I,J,68)+ENRGP 4146.5
216 WFC1=VDATA(I,J,9) 4147.
217 WFC2=VDATA(I,J,10)
218 CHI1=(WTR1+ACE1)/WFC1 4147.5
219 HC1=HC1DE+WTR1*SHW+(ACE1+SNOW)*SHI 4148.
220 RUN0=0. 4148.5
221 ERUN0=0. 4149.
222 IF(TPRCP.LT.0.) GO TO 660 4149.5
223 IF(TG1.LE.0.) GO TO 620 4150.
224 C**** RAIN ON GROUND ABOVE FREEZING POINT, RECOMPUTE TG1 4150.5
225 TG1=(TG1*HC1+EPRCP)/(HC1+PRCP*SHW) 4151.
226 RUN0=DMAX1(PRCP*.5*CHI1,PRCP+WTR1-WFC1) 4151.5
227 WTR1=WTR1+(PRCP-RUN0) 4152.
228 ERUN0=TG1*RUN0*SHW 4152.5
229 GO TO 890 4153.
230 620 IF(EPRCP.LT.-TG1*HC1) GO TO 640 4153.5
231 C**** RAIN HEATS UP TG1 TO FREEZING POINT 4154.
232 EPRCP=EPRCP+TG1*HC1 4154.5
233 TG1=0. 4155.
234 IF(EPRCP.LT.(ACE1+SNOW)*LHM) GO TO 630 4155.5
235 C**** RAIN MELTS SNOW AND ICE AND HEATS UP TG1 ABOVE FREEZING POINT 4156.
236 RUN0=DMAX1((PRCP+SNOW)*.5*CHI1,PRCP+SNOW+WTR1+ACE1-WFC1) 4156.5
237 WTR1=WTR1+ACE1+SNOW+(PRCP-RUN0) 4157.
238 TG1=(EPRCP-(ACE1+SNOW)*LHM)/(HC1DE+(WTR1+RUN0)*SHW) 4157.5
239 ACE1=0. 4158.
240 SNOW=0. 4158.5
241 ERUN0=TG1*RUN0*SHW 4159.
242 GO TO 880 4159.5
243 C**** RAIN MELTS SOME SNOW AND ICE, TG1 IS AT FREEZING POINT 4160.
244 630 DWATER=EPRCP/LHM 4160.5
245 DSNOW=DMIN1(SNOW,DWATER) 4161.
246 RUN0=DMAX1((PRCP+DSNOW)*.5*CHI1,PRCP+DSNOW+WTR1+ACE1-WFC1) 4161.5
247 WTR1=WTR1+DWATER+PRCP-RUN0 4162.
248 IF(WTR1.LT.0.) WTR1=0. 4162.1
249 SNOW=SNOW-DSNOW 4162.5
250 ACE1=ACE1-DWATER+DSNOW 4163.
251 GO TO 880 4163.5
252 C**** RAIN COOLS TO FREEZING POINT AND HEATS UP TG1 4164.
253 640 TG1=TG1+EPRCP/HC1 4164.5
254 RUN0=DMAX1(PRCP*.5*CHI1,PRCP+ACE1-WFC1) 4165.
255 PRCP=PRCP-RUN0 4165.5
256 IF(PRCP*LHM.LT.-TG1*HC1) GO TO 650 4166.
257 C**** SOME RAIN FREEZES AND TG1 HEATS UP TO FREEZING POINT 4166.5
258 DICE=-TG1*HC1/LHM 4167.
259 TG1=0. 4167.5
260 ACE1=ACE1+DICE 4168.
261 WTR1=PRCP-DICE 4168.5
262 GO TO 890 4169.
263 C**** RAIN FREEZES AND HEATS UP TG1, BUT STILL BELOW FREEZING POINT 4169.5
264 650 TG1=(TG1*HC1+PRCP*LHM)/(HC1+PRCP*SHI) 4170.
265 ACE1=ACE1+PRCP 4170.5
266 GO TO 890 4171.
267 660 IF(TG1.LE.0.) GO TO 690 4171.5
268 IF(-EPRCP.LT.TG1*HC1) GO TO 670 4172.
269 C**** NEW SNOW HEATS UP AND COOLS TG1 TO FREEZING POINT 4172.5
270 EPRCP=EPRCP+TG1*HC1 4173.
271 TG1=0. 4173.5
272 SNOW=PRCP 4174.
273 GO TO 700 4174.5
274 C**** NEW SNOW HEATS UP TO FREEZING POINT AND COOLS TG1 4175.
275 670 TG1=TG1+EPRCP/HC1 4175.5
276 IF(PRCP*LHM.LT.TG1*HC1) GO TO 680 4176.
277 C**** SOME NEW SNOW MELTS UNTIL TG1 COOLS TO FREEZING POINT 4176.5
278 DWATER=TG1*HC1/LHM 4177.
279 TG1=0. 4177.5
280 SNOW=PRCP-DWATER 4178.
281 RUN0=DMAX1(DWATER*.5*CHI1,DWATER+WTR1-WFC1) 4178.5
282 WTR1=WTR1+(DWATER-RUN0) 4179.
283 GO TO 880 4179.5
284 C**** ALL NEW SNOW MELTS, RECOMPUTE TG1 4180.
285 680 TG1=(TG1*HC1-PRCP*LHM)/(HC1+PRCP*SHW) 4180.5
286 RUN0=DMAX1(PRCP*.5*CHI1,PRCP+WTR1-WFC1) 4181.
287 WTR1=WTR1+(PRCP-RUN0) 4181.5
288 ERUN0=TG1*RUN0*SHW 4182.
289 GO TO 890 4182.5
290 690 SNOW=SNOW+PRCP 4183.
291 C Restriction of SNOW cover
292 c if(SNOW.gt.ACE1I)then
293 c SNOW=ACE1I
294 c endif
295 C
296 IF(WTR1.GT.0.) GO TO 700 4183.5
297 C**** NEW SNOW INCREASES SNOW AMOUNT AND SNOW TEMP RECOMPUTES TG1 4184.
298 TG1=(TG1*HC1+EPRCP)/(HC1+PRCP*SHI) 4184.5
299 GO TO 880 4185.
300 700 IF(-EPRCP.LT.WTR1*LHM) GO TO 710 4185.5
301 C**** GROUND WATER FREEZES, RECOMPUTE TG1 4186.
302 ACE1=ACE1+WTR1 4186.5
303 HC1=HC1DE+(ACE1+SNOW)*SHI 4187.
304 TG1=(EPRCP+WTR1*LHM)/HC1 4187.5
305 WTR1=0. 4188.
306 GO TO 880 4188.5
307 C**** SOME GROUND WATER FREEZES UNTIL SNOW TEMP HEATS TO FREEZING POINT 4189.
308 710 DICE=-EPRCP/LHM 4189.5
309 WTR1=WTR1-DICE 4190.
310 ACE1=ACE1+DICE 4190.5
311 IF(WTR1+ACE1.GT.WFC1) WTR1=.99999*WTR1 4190.6
312 IF(WTR1+ACE1.GT.WFC1) ACE1=.99999*ACE1 4190.7
313 880 GDATA(I,J,2)=SNOW 4191.
314 890 GDATA(I,J,4)=TG1 4191.5
315 GDATA(I,J,5)=WTR1 4192.
316 GDATA(I,J,6)=ACE1 4192.5
317 BERUN0=BERUN0+ERUN0*PEARTH 4193.
318 BRUN0=BRUN0+RUN0*PEARTH 4193.5
319 RUNS0=RUN0
320 BRUNS0=BRUNS0+RUNS0*PEARTH
321 RUN0S=RUN0S+RUN0*PEARTH 4194.
322 AIJ(I,J,32)=AIJ(I,J,32)+RUN0 4194.5
323 C**** 4195.
324 C**** ACCUMULATE DIAGNOSTICS 4195.5
325 C**** 4196.
326 940 DJ(JR,39)=DJ(JR,39)+ENRGP*DXYPJ 4196.5
327 DJ(JR,45)=DJ(JR,45)+DIFSS*DXYPJ 4197.
328 DJ(JR,54)=DJ(JR,54)+RUN0S*DXYPJ 4197.5
329 AIJ(I,J,5)=AIJ(I,J,5)+PREC(I,J)*prlnd2total(j,mndriver) 4198.
330 AIJ(I,J,23)=AIJ(I,J,23)+ENRGP 4198.5
331 960 CONTINUE 4199.
332 BJ(J,39)=BJ(J,39)+BENRGP 4200.
333 BJ(J,40)=BJ(J,40)+BERUN0 4201.
334 BJ(J,41)=BJ(J,41)+BEDIFS 4201.5
335 BJ(J,43)=BJ(J,43)+BERUN2 4203.
336 BJ(J,45)=BJ(J,45)+BDIFS 4204.
337 C Runoff from first layer of soil including ice melting
338 BJ(J,47)=BJ(J,47)+BRUN0
339 C Runoff from first layer of soil does not include ice melting
340 BJ(J,54)=BJ(J,54)+BRUNS0
341 BJ(J,46)=BJ(J,46)+BRUN2 4206.5
342 #if ( defined OCEAN_3D || defined ML_2D )
343 C Runoff from first layer of soil does not include ice melting
344 if(PLICE+PEARTH.gt.0.0)then
345 arunoff(j)=arunoff(j)+BRUNS0/(PLICE+PEARTH)
346 endif
347 #endif`
348 980 CONTINUE 4209.5
349 RETURN 4210.
350 END 4210.5

  ViewVC Help
Powered by ViewVC 1.1.22