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

Annotation of /MITgcm_contrib/jscott/igsm/src/grland.F

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


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

1 jscott 1.1
2     #include "ctrparam.h"
3    
4     ! ==========================================================
5     !
6     ! GROUND.F: THIS SUBROUTINE USES THE SURFACE FLUXES TO
7     ! PREDICT IN TIME THE GROUND TEMPERATURE, GROUND
8     ! WATER AND ICE, AND SNOW MELTING.
9     !
10     ! ----------------------------------------------------------
11     !
12     ! Revision History:
13     !
14     ! When Who What
15     ! ---- ---------- -------
16     ! 073100 Chien Wang add cpp & dmax dmin -> max, min
17     !
18     ! ==========================================================
19    
20     SUBROUTINE GRLAND 7001.
21     C**** 7001.5
22     C**** THIS SUBROUTINE USES THE SURFACE FLUXES TO PREDICT IN TIME THE 7002.
23     C**** GROUND TEMPERATURE, GROUND WATER AND ICE, AND SNOW MELTING. 7002.5
24     C**** 7003.
25    
26     #include "BD2G04.COM" 7003.5
27    
28     #if ( defined OCEAN_3D || defined ML_2D )
29     #include "AGRID.COM"
30     #endif
31    
32     COMMON U,V,T,P,Q 7004.
33     COMMON/WORK1/CONV(IM0,JM0,LM0),PK(IM0,JM0,LM0),PREC(IM0,JM0),
34     & TPREC(IM0,JM0)
35     COMMON/WORK3/E0(IO0,JM0,4),E1(IO0,JM0,4),EVAPOR(IO0,JM0,4) 7004.5
36     COMMON/OT/OTA(IO0,JM0),OTB(IO0,JM0),OTC(IO0,JM0) 7005.
37     COMMON/SPEC2/KM,KINC,COEK,C3LAND(IO0,JM0),C3OICE(IO0,JM0) 7005.1
38     * ,C3LICE(IO0,JM0),WMGE(IO0,JM0),TSSFC(1,JM0,4) 7005.2
39     common/qfl/QFLUX(JM0,0:13),ZOAV(JM0),QFLUXT(JM0)
40     COMMON/OLDZO/Z1OOLD(IO0,JM0)
41     DIMENSION FWATER(JM0),TOBS(JM0),TF68(JM0),DELR(JM0) 7005.3
42     COMMON/FRMIC/ FRMDICE(JM0)
43     DATA SHV/0./,SHW/4185./,SHI/2060./,RHOW/1000./,RHOI/916.6/, 7005.9
44     * ALAMI/2.1762/,TFO/-1.56/,Z1I/.1/,Z2LI/2.9/,Z1E/.1/,Z2E/4./ 7006.
45     INTEGER JDOFM(13) 7006.1
46     DATA JDOFM/0,31,59,90,120,151,181,212,243,273,304,334,365/ 7006.2
47     DATA Z2OIM/0.9/,Z2OIX/4.9/ 7006.5
48     DATA TTRUNC/0./ 7007.
49     DATA IFIRST/1/ 7007.5
50     ROSNOW(X)=0.54*X/LOG(1.+0.54*X/275.)
51     C**** 7008.
52     C**** FDATA 2 LAND COVERAGE (1) 7008.5
53     C**** 3 RATIO OF LAND ICE COVERAGE TO LAND COVERAGE (1) 7009.
54     C**** 7009.5
55     C**** ODATA 1 OCEAN TEMPERATURE (C) 7010.
56     C**** 2 RATIO OF OCEAN ICE COVERAGE TO WATER COVERAGE (1) 7010.5
57     C**** 3 OCEAN ICE AMOUNT OF SECOND LAYER (KG/M**2) 7011.
58     C**** 7011.5
59     C**** GDATA 1 OCEAN ICE SNOW AMOUNT (KG/M**2) 7012.
60     C**** 2 EARTH SNOW AMOUNT (KG/M**2) 7012.5
61     C**** 3 OCEAN ICE TEMPERATURE OF FIRST LAYER (C) 7013.
62     C**** 4 EARTH TEMPERATURE OF FIRST LAYER (C) 7013.5
63     C**** 5 EARTH WATER OF FIRST LAYER (KG/M**2) 7014.
64     C**** 6 EARTH ICE OF FIRST LAYER (KG/M**2) 7014.5
65     C**** 7 OCEAN ICE TEMPERATURE OF SECOND LAYER (C) 7015.
66     C**** 8 EARTH TEMPERATURE OF SECOND LAYER (C) 7015.5
67     C**** 9 EARTH WATER OF SECOND LAYER (KG/M**2) 7016.
68     C**** 10 EARTH ICE OF SECOND LAYER (KG/M**2) 7016.5
69     C**** 12 LAND ICE SNOW AMOUNT (KG/M**2) 7017.
70     C**** 13 LAND ICE TEMPERATURE OF FIRST LAYER (C) 7017.5
71     C**** 14 LAND ICE TEMPERATURE OF SECOND LAYER (C) 7018.
72     C**** 7018.5
73     C**** VDATA 9 WATER FIELD CAPACITY OF FIRST LAYER (KG/M**2) 7019.
74     C**** 10 WATER FIELD CAPACITY OF SECOND LAYER (KG/M**2) 7019.5
75     C**** 7020.
76     IF(IFIRST.NE.1) GO TO 50 7020.5
77     IFIRST=0 7021.
78     FIO=IO 7021.1
79     JDAYPR=0
80     10 DTSRCE=NDYN*DT 7023.
81     ACE1I=Z1I*RHOI 7023.5
82     AC2OIM=Z2OIM*RHOI 7024.
83     ATRUNC=2.**(-13) 7024.5
84     BYZICX=1./(Z1I+Z2OIX) 7024.6
85     HC1I=ACE1I*SHI 7025.
86     HC2LI=Z2LI*RHOI*SHI 7025.5
87     HC1DE=Z1E*1129950. 7026.
88     HC2DE=Z2E*1129950.+3.5*.125*RHOW*3100. 7026.5
89     DIFFUS=DTSRCE/SDAY 7027.
90     C OTCOR=-.927E18 7027.1
91     print *,'E0(1,j,1)'
92     print *,(E0(1,j,1),j=1,JM0)
93     COEFSN=1.
94     print *,' COEFSN=',COEFSN
95     50 ANGLE=TWOPI*JDAY/365. 7027.5
96     DO 55 MONTH=1,12 7027.6
97     IF(JDAY.LE.JDOFM(MONTH+1)) GO TO 56 7027.7
98     55 CONTINUE 7027.8
99     56 CONTINUE 7027.9
100     SINANG=SIN(ANGLE) 7028.
101     COSANG=COS(ANGLE) 7028.5
102     C**** 7029.
103     C**** OUTSIDE LOOP OVER J AND I, EXECUTED ONCE FOR EACH GRID POINT 7029.5
104     C**** 7030.
105     JRPR=0
106     DO 980 J=1,JM 7030.5
107     IMAX=IM 7031.
108     IF((J.EQ.1).OR.(J.EQ.JM)) IMAX=1 7031.5
109     C DELR(J)=(TF68(J)-TOBS(J))*Z1O(1,J)*RHOW*SHW/(365.*SDAY) 7031.6
110     BF1DT=0. 7032.
111     CF1DT=0. 7032.5
112     AOTDT=0. 7033.
113     COTDT=0. 7033.5
114     AEFO=0. 7034.
115     CEFI=0. 7034.5
116     BEDIFS=0. 7035.
117     CEDIFS=0. 7035.5
118     BERUN0=0. 7036.
119     CF2DT=0. 7036.5
120     BERUN2=0. 7037.
121     CERUN2=0. 7037.5
122     AERUN4=0. 7038.
123     CERUN4=0. 7038.5
124     ATG1=0. 7039.
125     BTG1=0. 7039.5
126     CTG1=0. 7040.
127     ATG2=0. 7040.5
128     BTG2=0. 7041.
129     CTG2=0. 7041.5
130     ATG3=0. 7042.
131     AEVAP=0. 7042.5
132     BEVAP=0. 7043.
133     CEVAP=0. 7043.5
134     BDIFS=0. 7044.
135     CDIFS=0. 7044.5
136     AIFO=0. 7045.
137     CIFI=0. 7045.5
138     BRUN0=0. 7046.
139     BRUNS0=0.
140     CRUN0=0. 7046.5
141     BRUN2=0. 7047.
142     CRUN2=0. 7047.5
143     ARUN4=0. 7048.
144     CRUN4=0. 7048.5
145     BWTR1=0. 7049.
146     BACE1=0. 7049.5
147     BWTR2=0. 7050.
148     BACE2=0. 7050.5
149     CACE2=0. 7051.
150     BSNOW=0. 7051.5
151     CSNOW=0. 7052.
152     CICOV=0. 7052.5
153     DO 960 I=1,IMAX 7053.
154     C**** 7053.5
155     C**** DETERMINE SURFACE CONDITIONS 7054.
156     C**** 7054.5
157     PLAND=FDATA(I,J,2) 7055.
158     PWATER=1.-PLAND 7055.5
159     PLICE=FDATA(I,J,3)*PLAND 7056.
160     PEARTH=PLAND-PLICE 7056.5
161     ROICE=ODATA(I,J,2) 7057.
162     POICE=ROICE*PWATER 7057.5
163     POCEAN=PWATER-POICE 7058.
164     if(POCEAN.LE.1.E-5)then
165     POCEAN=0.
166     POICE=PWATER
167     endif
168     JR=J
169     DXYPJ=DXYP(J) 7059.
170     SNOWS=0. 7059.5
171     WTR1S=0. 7060.
172     ACE1S=0. 7060.5
173     WTR2S=0. 7061.
174     ACE2S=0. 7061.5
175     TG1S=0. 7062.
176     TG2S=0. 7062.5
177     EVAPS=0. 7063.
178     RUN0S=0. 7063.5
179     RUNS0=0. 7063.5
180     DIFSS=0. 7064.
181     C**** 7064.5
182     C**** 7167.5
183     400 IF(PLICE.LE.1.E-5) GO TO 600 7168.
184     C**** 7168.5
185     C**** LAND ICE 7169.
186     C**** 7169.5
187     SNOW=GDATA(I,J,12) 7170.
188     TG1=GDATA(I,J,13) 7170.5
189     TG2=GDATA(I,J,14) 7171.
190     F0DT=E0(I,J,3) 7171.5
191     AIJ(I,J,67)=AIJ(I,J,67)+F0DT 7172.
192     F1DT=E1(I,J,3) 7172.5
193     EVAP=EVAPOR(I,J,3) 7173.
194     AIJ(I,J,63)=AIJ(I,J,63)+EVAP 7173.5
195     C**** CALCULATE TG1 7174.
196     SNANDI=SNOW+ACE1I-EVAP 7174.5
197     c if (SNANDI.le.0.0)then
198     c print *,' After 7174.5 TAU=',TAU,' J=',J
199     c endif
200     HC1=SNANDI*SHI 7175.
201     ENRG1=F0DT+EVAP*(TG1*SHI-LHM)-F1DT 7175.5
202     IF(ENRG1.LE.-TG1*HC1) GO TO 420 7176.
203     C**** FLUXES HEAT UP TG1 TO FREEZING POINT AND MELT SOME SNOW AND ICE 7176.5
204     RUN0=(ENRG1+TG1*HC1)/LHM 7177.
205     c RUNS0 does not include runoff due melting of land ice
206     c RUNS0 includes runoff due melting of land ice formed from snow
207     c during the run.
208     RUNS0=DMIN1(RUN0,SNOW+FRMDICE(J))
209     if(RUN0.gt.SNOW)then
210     FRMDICE(j)=FRMDICE(j)-(RUN0-SNOW)
211     if( FRMDICE(j).lt.0.0) FRMDICE(j)=0.0
212     endif
213     c
214     TG1=0. 7177.5
215     SNANDI=SNANDI-RUN0 7178.
216     c if (SNANDI.le.0.0)then
217     c print *,' After 7178 TAU=',TAU,' J=',J
218     c endif
219     BRUN0=BRUN0+RUN0*PLICE 7178.5
220     BRUNS0=BRUNS0+RUNS0*PLICE
221     RUN0S=RUN0S+RUN0*PLICE 7179.
222     AIJ(I,J,33)=AIJ(I,J,33)+RUN0 7179.5
223     GO TO 440 7180.
224     C**** FLUXES RECOMPUTE TG1 WHICH IS BELOW FREEZING POINT 7180.5
225     420 TG1=TG1+ENRG1/HC1 7181.
226     440 IF(SNANDI.GE.ACE1I) GO TO 460 7181.5
227     C**** SOME ICE HAS MELTED OR EVAPORATED, TAKE IT FROM G2 7182.
228     SNOW=0. 7182.5
229     DIFS=SNANDI-ACE1I 7183.
230     TG1=(TG1*SNANDI-TG2*DIFS)/ACE1I 7183.5
231     c if (DIFS.le.0.0)then
232     c print *,' After 7183.5 TAU=',TAU,' J=',J
233     c print *,'SNANDI=',SNANDI,' DIFS=',DIFS
234     c print *,'TG1=',TG1,' TG2=',TG2
235     c endif
236     EDIFS=DIFS*(TG2*SHI-LHM) 7184.
237     BEDIFS=BEDIFS+EDIFS*PLICE 7184.5
238     AIJ(I,J,69)=AIJ(I,J,69)+EDIFS 7185.
239     BDIFS=BDIFS+DIFS*PLICE 7185.5
240     DIFSS=DIFSS+DIFS*PLICE 7186.
241     BERUN2=BERUN2+EDIFS*PLICE 7186.5
242     C AIJ(I,J,72)=AIJ(I,J,72)+ERUN2 7187.
243     AIJ(I,J,72)=AIJ(I,J,72)+EDIFS 7187.1
244     BRUN2=BRUN2+DIFS*PLICE 7187.5
245     GO TO 500 7188.
246     460 SNOW=SNANDI-ACE1I 7188.5
247     C**** CALCULATE TG2 7189.
248     500 TG2=TG2+F1DT/HC2LI 7189.5
249     C**** RESAVE PROGNOSTIC QUANTITIES 7190.
250     GDATA(I,J,12)=SNOW 7190.5
251     GDATA(I,J,13)=TG1 7191.
252     GDATA(I,J,14)=TG2 7191.5
253     if (SNOW.gt.10.)then
254     RHOS0=ROSNOW(SNOW)
255     else
256     RHOS0=275.
257     endif
258     RHOS=COEFSN*RHOS0
259     BSNOW=BSNOW+100*SNOW/RHOS*PLICE
260     c BSNOW=BSNOW+SNOW*PLICE 7192.
261     BTG1=BTG1+TG1*PLICE 7192.5
262     BTG2=BTG2+TG2*PLICE 7193.
263     BF1DT=BF1DT+F1DT*PLICE 7193.5
264     AIJ(I,J,69)=AIJ(I,J,69)+F1DT 7194.
265     BEVAP=BEVAP+EVAP*PLICE 7194.5
266     SNOWS=SNOWS+SNOW*PLICE 7195.
267     TG1S=TG1S+TG1*PLICE 7195.5
268     ACE1S=ACE1S+ACE1I*PLICE 7196.
269     ACE2S=ACE2S+Z2LI*RHOI*PLICE 7196.5
270     TG2S=TG2S+TG2*PLICE 7197.
271     EVAPS=EVAPS+EVAP*PLICE 7197.5
272     C**** 7198.
273     600 IF(PEARTH.LE.1.E-5) GO TO 940 7198.5
274     C**** 7199.
275     C**** EARTH 7199.5
276     C**** 7200.
277     SNOW=GDATA(I,J,2) 7200.5
278     TG1=GDATA(I,J,4) 7201.
279     WTR1=GDATA(I,J,5) 7201.5
280     ACE1=GDATA(I,J,6) 7202.
281     TG2=GDATA(I,J,8) 7202.5
282     WTR2=GDATA(I,J,9) 7203.
283     ACE2=GDATA(I,J,10) 7203.5
284     WFC1=VDATA(I,J,9) 7204.
285     WFC2=VDATA(I,J,10) 7204.5
286     CHI1=(WTR1+ACE1)/WFC1 7205.
287     GFAC=WFC2/WFC1 7205.5
288     HC1=HC1DE+WTR1*SHW+(ACE1+SNOW)*SHI 7206.
289     F0DT=E0(I,J,4) 7206.5
290     AIJ(I,J,68)=AIJ(I,J,68)+F0DT 7207.
291     F1DT=E1(I,J,4) 7207.5
292     EVAP=EVAPOR(I,J,4) 7208.
293     EVAPS=EVAPS+EVAP*PEARTH 7208.5
294     AIJ(I,J,64)=AIJ(I,J,64)+EVAP 7209.
295     C**** 7209.5
296     C**** EARTH, DETERMINE EVAPORATION AND DIFFUSION OF WATER 7210.
297     C**** 7210.5
298     ENRG1=0. 7211.
299     IF(SNOW.LE.0.) GO TO 625 7211.5
300     IF(EVAP.GT.SNOW) GO TO 620 7212.
301     C**** SOME SNOW EVAPORATES 7212.5
302     610 ENRG1=EVAP*(TG1*SHI-LHM) 7213.
303     SNOW=SNOW-EVAP 7213.5
304     GO TO 660 7214.
305     C**** ALL SNOW EVAPORATES 7214.5
306     620 EVAP=EVAP-SNOW 7215.
307     ENRG1=SNOW*(TG1*SHI-LHM) 7215.5
308     SNOW=0. 7216.
309     GO TO 630 7216.5
310     625 IF(WTR1+ACE1-EVAP.LE.WFC1) GO TO 630 7217.
311     C**** DEW+WTR+ACE EXCEEDS WFC, DO NOT BOTHER TO CORRECT ALL DIAGNOSTICS 7217.5
312     C IF(TG1.LE.0.) GO TO 610 7218.
313     C RUN0=WTR1+ACE1-EVAP-WFC1 7218.5
314     C ERUN0=RUN0*TG1*SHW 7219.
315     C WTR1=WFC1-ACE1 7219.5
316     C ENRG1=-ERUN0 7220.
317     GO TO 660 7220.5
318     630 IF(EVAP.LE.WTR1+ACE1) GO TO 640 7221.
319     C**** ALL WATER AND ICE EVAPORATES,RECOMPUTE EVHDT AND EVAP 7221.5
320     DEVAP=EVAP-(WTR1+ACE1) 7222.
321     DEVHDT=-DEVAP*(LHE+TG1*SHV) 7222.5
322     ENRG1=ENRG1+WTR1*TG1*SHW+ACE1*(TG1*SHI-LHM) 7223.
323     EVAP=WTR1+ACE1 7223.5
324     WTR1=0. 7224.
325     ACE1=0. 7224.5
326     F0DT=F0DT-DEVHDT 7225.
327     BJ(J,14)=BJ(J,14)-DEVHDT*PEARTH 7225.5
328     AIJ(I,J,23)=AIJ(I,J,23)-DEVHDT*PEARTH 7226.
329     AIJ(I,J,68)=AIJ(I,J,68)-DEVHDT 7226.5
330     AIJ(I,J,64)=AIJ(I,J,64)-DEVAP 7227.
331     EVAPS=EVAPS-DEVAP*PEARTH 7227.5
332     GO TO 660 7228.
333     C**** EVAPORATION FROM WATER AND ICE 7228.5
334     640 IF(EVAP.GT.WTR1+ACE1) EVAP=WTR1+ACE1 7228.6
335     DWET=EVAP/(WTR1+ACE1+1.E-20) 7229.
336     650 ENRG1=ENRG1+DWET*(WTR1*TG1*SHW+ACE1*(TG1*SHI-LHM)) 7229.5
337     WTR1=WTR1*(1.-DWET) 7230.
338     ACE1=ACE1*(1.-DWET) 7230.5
339     C**** DETERMINE DIFFUSION OF WATER 7231.
340     660 X=(WTR1+ACE1)/(WTR2+ACE2+1.E-20) 7231.5
341     IF(1..LT.X*GFAC) GO TO 670 7232.
342     GROW=1. 7232.5
343     IF((SINP(J).GT..5).AND.(JDAY-121)*(243-JDAY).LT.0) GROW=0. 7233.
344     IF((SINP(J).LT.-.5).AND.(JDAY-60)*(304-JDAY).GE.0) GROW=0. 7233.5
345     DIFS=GROW*(1.-VDATA(I,J,1))*WTR2*(X*GFAC-1.)/(1.+GFAC) 7234.
346     EDIFS=TG2*DIFS*SHW 7234.5
347     c if(JDAY.GE.186.and.(J.eq.43.or.J.eq.44))then
348     c if(JRPR.ne.J) then
349     c print *,JDAY,J,SINP(J)
350     c print *,WTR1,WTR2,ACE1,ACE2
351     c print *,TG1,TG2,GROW,VDATA(I,J,1)
352     c print *,DIFS
353     c endif
354     c endif
355     GO TO 690 7235.
356     670 DIFS=DIFFUS*WTR1*(GFAC-1./X)/(1.+GFAC) 7235.5
357     EDIFS=TG1*DIFS*SHW 7236.
358     690 BEDIFS=BEDIFS+EDIFS*PEARTH 7236.5
359     BDIFS=BDIFS+DIFS*PEARTH 7237.
360     DIFSS=DIFSS+DIFS*PEARTH 7237.5
361     C**** 7238.
362     C**** EARTH, CALCULATE TG1 7238.5
363     C**** 7239.
364     ENRG1=ENRG1+F0DT-F1DT-EDIFS 7239.5
365     IF(TG1) 710,740,750 7240.
366     C**** FREEZE THE WATER THAT DIFFUSES INTO G1 7240.5
367     710 ENRG1=ENRG1+DIFS*(TG1*SHI-LHM) 7241.
368     ACE1=ACE1-DIFS 7241.5
369     HC1=HC1DE+(ACE1+SNOW)*SHI 7242.
370     IF(ENRG1.LE.-TG1*HC1) GO TO 780 7242.5
371     C**** FLUXES HEAT UP TG1 TO FREEZING POINT 7243.
372     ENRG1=ENRG1+TG1*HC1 7243.5
373     TG1=0. 7244.
374     720 IF(ENRG1.LE.(ACE1+SNOW)*LHM) GO TO 730 7244.5
375     C**** SNOW AND GROUND ICE MELTS, RECOMPUTE TG1 7245.
376     RUN0=MAX(SNOW*.5*CHI1,SNOW+WTR1+ACE1-WFC1) 7245.5
377     WTR1=WTR1+ACE1+SNOW-RUN0 7246.
378     TG1=(ENRG1-(ACE1+SNOW)*LHM)/(HC1DE+WTR1*SHW) 7246.5
379     ACE1=0. 7247.
380     SNOW=0. 7247.5
381     GO TO 790 7248.
382     C**** SOME SNOW AND GROUND ICE MELTS, TG1 IS AT FREEZING POINT 7248.5
383     730 DWATER=ENRG1/LHM 7249.
384     DSNOW=MIN(SNOW,DWATER) 7249.5
385     RUN0=MAX(DSNOW*.5*CHI1,DSNOW+WTR1+ACE1-WFC1) 7250.
386     SNOW=SNOW-DSNOW 7250.5
387     ACE1=ACE1-(DWATER-DSNOW) 7251.
388     WTR1=WTR1+(DWATER-RUN0) 7251.5
389     GO TO 790 7252.
390     C**** TG1 IS AT FREEZING POINT, SUBTRACT WATER THAT DIFFUSES OUT OF G1 7252.5
391     740 WTR1=WTR1-DIFS 7253.
392     HC1=HC1DE+WTR1*SHW+(ACE1+SNOW)*SHI 7253.5
393     IF(ENRG1.GT.0.) GO TO 720 7254.
394     GO TO 760 7254.5
395     C**** THE WATER THAT DIFFUSES OUT OF G1 IS ABOVE THE FREEZING POINT 7255.
396     750 ENRG1=ENRG1+TG1*DIFS*SHW 7255.5
397     WTR1=WTR1-DIFS 7256.
398     HC1=HC1DE+WTR1*SHW 7256.5
399     IF(-ENRG1.LE.TG1*HC1) GO TO 780 7257.
400     C**** FLUXES COOL TG1 TO FREEZING POINT 7257.5
401     ENRG1=ENRG1+TG1*HC1 7258.
402     TG1=0. 7258.5
403     760 IF(-ENRG1.LE.WTR1*LHM) GO TO 770 7259.
404     C**** GROUND WATER FREEZES, RECOMPUTE TG1 7259.5
405     ACE1=WTR1+ACE1 7260.
406     TG1=(ENRG1+WTR1*LHM)/(HC1DE+(ACE1+SNOW)*SHI) 7260.5
407     WTR1=0. 7261.
408     GO TO 800 7261.5
409     C**** SOME GROUND WATER FREEZES, TG1 IS AT FREEZING POINT 7262.
410     770 DICE=-ENRG1/LHM 7262.5
411     WTR1=WTR1-DICE 7263.
412     ACE1=ACE1+DICE 7263.5
413     GO TO 800 7264.
414     C**** FLUXES DO NOT CAUSE TG1 TO CROSS THE FREEZING POINT 7264.5
415     780 TG1=TG1+ENRG1/HC1 7265.
416     GO TO 800 7265.5
417     790 BRUN0=BRUN0+RUN0*PEARTH 7266.
418     RUNS0=RUN0
419     BRUNS0=BRUNS0+RUNS0*PEARTH
420     RUN0S=RUN0S+RUN0*PEARTH 7266.5
421     AIJ(I,J,32)=AIJ(I,J,32)+RUN0 7267.
422     C**** 7267.5
423     C**** EARTH, CALCULATE TG2 7268.
424     C**** 7268.5
425     800 ENRG2=F1DT+EDIFS 7269.
426     HC2=HC2DE+WTR2*SHW+ACE2*SHI 7269.5
427     IF(TG2) 810,840,850 7270.
428     C**** FREEZE THE WATER THAT DIFFUSES AND PERCOLATES INTO G2 7270.5
429     810 ENRG2=ENRG2-DIFS*(TG2*SHI-LHM) 7271.
430     ACE2=ACE2+DIFS 7271.5
431     HC2=HC2DE+ACE2*SHI 7272.
432     IF(ENRG2.LE.-TG2*HC2) GO TO 880 7272.5
433     C**** FLUXES HEAT UP TG2 TO FREEZING POINT 7273.
434     ENRG2=ENRG2+TG2*HC2 7273.5
435     TG2=0. 7274.
436     820 IF(ENRG2.LE.ACE2*LHM) GO TO 830 7274.5
437     C**** GROUND ICE MELTS, RECOMPUTE TG2 7275.
438     WTR2=WTR2+ACE2 7275.5
439     TG2=(ENRG2-ACE2*LHM)/(HC2DE+WTR2*SHW) 7276.
440     ACE2=0. 7276.5
441     GO TO 890 7277.
442     C**** SOME GROUND ICE MELTS, TG2 IS AT FREEZING POINT 7277.5
443     830 DWATER=ENRG2/LHM 7278.
444     WTR2=WTR2+DWATER 7278.5
445     ACE2=ACE2-DWATER 7279.
446     GO TO 890 7279.5
447     C**** TG2 IS AT FREEZING POINT, ADD IN WATER THAT DIFFUSES OR PERCOLATE 7280.
448     840 WTR2=WTR2+DIFS 7280.5
449     HC2=HC2DE+WTR2*SHW+ACE2*SHI 7281.
450     IF(ENRG2.GT.0.) GO TO 820 7281.5
451     GO TO 860 7282.
452     C**** WATER THAT DIFFUSES OR PERCOLATES IS ABOVE FREEZING POINT 7282.5
453     850 ENRG2=ENRG2-TG2*DIFS*SHW 7283.
454     WTR2=WTR2+DIFS 7283.5
455     HC2=HC2DE+WTR2*SHW 7284.
456     IF(-ENRG2.LE.TG2*HC2) GO TO 880 7284.5
457     C**** FLUXES COOL TG2 TO FREEZING POINT 7285.
458     ENRG2=ENRG2+TG2*HC2 7285.5
459     TG2=0. 7286.
460     860 IF(-ENRG2.LE.WTR2*LHM) GO TO 870 7286.5
461     C**** GROUND WATER FREEZES, RECOMPUTE TG2 7287.
462     ACE2=WTR2+ACE2 7287.5
463     TG2=(ENRG2+WTR2*LHM)/(HC2DE+ACE2*SHI) 7288.
464     WTR2=0. 7288.5
465     GO TO 890 7289.
466     C**** SOME GROUND WATER FREEZES, TG2 IS AT FREEZING POINT 7289.5
467     870 DICE=-ENRG2/LHM 7290.
468     WTR2=WTR2-DICE 7290.5
469     ACE2=ACE2+DICE 7291.
470     GO TO 890 7291.5
471     C**** FLUXES DO NOT CAUSE TG2 TO CROSS THE FREEZING POINT 7292.
472     880 TG2=TG2+ENRG2/HC2 7292.5
473     890 CONTINUE 7293.
474     C**** RESAVE PROGNOSTIC QUANTITIES 7293.5
475     GDATA(I,J,2)=SNOW 7294.
476     GDATA(I,J,4)=TG1 7294.5
477     c print *,'From GRLAND TG1=',TG1
478     C 13/11/03
479     c IF(WTR1+ACE1.GT.WFC1) WTR1=.99999*WTR1 7294.6
480     c IF(WTR1+ACE1.GT.WFC1) ACE1=.99999*ACE1 7294.7
481     IF(WTR1+ACE1.GT.WFC1) THEN
482     if(TG1.gt.0.0)then
483     print *,'From ground WFC1'
484     print *,JDAY,J
485     print *,WFC2,WTR2,TG2,ACE2
486     print *,WFC1,WTR1,TG1,ACE1
487     WTRT=WFC1-ACE1
488     RUNS0=WTR1-WTRT
489     BRUNS0=BRUNS0+RUNS0*PEARTH
490     WTR1=max(WTRT,0.0)
491     endif
492     ENDIF
493     GDATA(I,J,5)=WTR1 7295.
494     GDATA(I,J,6)=ACE1 7295.5
495     GDATA(I,J,8)=TG2 7296.
496     JDAYPR=JDAY
497     c if((WTR2.lt.1.e-7.and.ACE2.lt.1.e-7)
498     c & .or.(WTR1.lt.1.e-7.and.ACE1.lt.1.e-7) )then
499     c if(WTR2.lt.1.e-3*WFC2.and.ACE2.lt.1.e-5)then
500     c if(JDAY.ne.JDAYPR.and.JRPR.ne.J)then
501     c JDAYPR=JDAY
502     c JRPR=J
503     c print *,'From ground'
504     c print *,JDAY,J
505     c print *,WFC2,WTR2,TG2,ACE2
506     c print *,WFC1,WTR1,TG1,ACE1
507     c print *,'WTR2 was not changed'
508     c endif
509     c WTR2=1.e-7
510     c WTR2=1.e-3*WFC2
511     c endif
512     IF(WTR2+ACE2.GT.WFC2) THEN
513     if(TG2.gt.0.0)then
514     print *,'From ground WFC2'
515     print *,JDAY,J
516     print *,WFC2,WTR2,TG2,ACE2
517     print *,WFC1,WTR1,TG1,ACE1
518     WTRT=WFC2-ACE2
519     RUNS0=WTR2-WTRT
520     BRUNS0=BRUNS0+RUNS0*PEARTH
521     WTR2=max(WTRT,0.0)
522     endif
523     ENDIF
524     GDATA(I,J,9)=WTR2 7296.5
525     GDATA(I,J,10)=ACE2 7297.
526     if (SNOW.gt.10.)then
527     RHOS0=ROSNOW(SNOW)
528     else
529     RHOS0=275.
530     endif
531     RHOS=COEFSN*RHOS0
532     BSNOW=BSNOW+100*SNOW/RHOS*PEARTH
533     c BSNOW=BSNOW+SNOW*PEARTH 7297.5
534     BTG1=BTG1+TG1*PEARTH 7298.
535     BTG2=BTG2+TG2*PEARTH 7298.5
536     BWTR1=BWTR1+WTR1*PEARTH 7299.
537     BACE1=BACE1+ACE1*PEARTH 7299.5
538     BWTR2=BWTR2+WTR2*PEARTH 7300.
539     BACE2=BACE2+ACE2*PEARTH 7300.5
540     BF1DT=BF1DT+F1DT*PEARTH 7301.
541     BEVAP=BEVAP+EVAP*PEARTH 7301.5
542     SNOWS=SNOWS+SNOW*PEARTH 7302.
543     TG1S=TG1S+TG1*PEARTH 7302.5
544     WTR1S=WTR1S+WTR1*PEARTH 7303.
545     ACE1S=ACE1S+ACE1*PEARTH 7303.5
546     WTR2S=WTR2S+WTR2*PEARTH 7304.
547     ACE2S=ACE2S+ACE2*PEARTH 7304.5
548     TG2S=TG2S+TG2*PEARTH 7305.
549     AIJ(I,J,7)=AIJ(I,J,7)+(WTR1+ACE1)/WFC1 7305.5
550     AIJ(I,J,50)=AIJ(I,J,50)+(WTR1+ACE1+WTR2+ACE2) 7306.
551     C**** 7306.5
552     C**** ACCUMULATE DIAGNOSTICS 7307.
553     C**** 7307.5
554     C**** QUANTITIES ACCUMULATED FOR REGIONS IN DIAGJ 7308.
555     940 IF(JR.EQ.JM0) GO TO 950 7308.5
556     DJ(JR,17)=DJ(JR,17)+TG2S*DXYPJ 7309.
557     DJ(JR,18)=DJ(JR,18)+TG1S*DXYPJ 7309.5
558     DJ(JR,45)=DJ(JR,45)+DIFSS*DXYPJ 7310.5
559     DJ(JR,49)=DJ(JR,49)+WTR1S*DXYPJ 7311.
560     DJ(JR,50)=DJ(JR,50)+ACE1S*DXYPJ 7311.5
561     DJ(JR,51)=DJ(JR,51)+WTR2S*DXYPJ 7312.
562     DJ(JR,52)=DJ(JR,52)+ACE2S*DXYPJ 7312.5
563     DJ(JR,53)=DJ(JR,53)+SNOWS*DXYPJ 7313.
564     DJ(JR,54)=DJ(JR,54)+RUN0S*DXYPJ 7313.5
565     C**** QUANTITIES ACCUMULATED FOR LATITUDE-LONGITUDE MAPS IN DIAGIJ 7314.
566     950 AIJ(I,J,6)=AIJ(I,J,6)+EVAPS 7314.5
567     AIJ(I,J,28)=AIJ(I,J,28)+TG1S 7315.
568     960 CONTINUE 7315.5
569     C**** LONGITUDINALLY INTEGRATED QUANTITIES FOR DIAGJ 7316.
570     BJ(J,17)=BJ(J,17)+BTG2 7317.5
571     BJ(J,18)=BJ(J,18)+BTG1 7319.
572     BJ(J,19)=BJ(J,19)+BEVAP 7320.5
573     BJ(J,40)=BJ(J,40)+BERUN0 7323.5
574     BJ(J,41)=BJ(J,41)+BEDIFS 7324.
575     BJ(J,42)=BJ(J,42)+BF1DT 7325.
576     BJ(J,43)=BJ(J,43)+BERUN2 7326.5
577     BJ(J,45)=BJ(J,45)+BDIFS 7327.5
578     BJ(J,46)=BJ(J,46)+BRUN2 7329.
579     BJ(J,49)=BJ(J,49)+BWTR1 7332.
580     BJ(J,50)=BJ(J,50)+BACE1 7332.5
581     BJ(J,51)=BJ(J,51)+BWTR2 7333.
582     BJ(J,52)=BJ(J,52)+BACE2 7333.5
583     BJ(J,53)=BJ(J,53)+BSNOW 7334.5
584     BJ(J,47)=BJ(J,47)+BRUN0 7335.5
585     BJ(J,54)=BJ(J,54)+BRUNS0
586     #if ( defined OCEAN_3D || defined ML_2D )
587     C Runoff from first layer of soil does not include ice melting
588     if(PLICE+PEARTH.gt.0.0)then
589     arunoff(j)=arunoff(j)+BRUNS0/(PLICE+PEARTH)
590     end if
591     #endif
592     980 CONTINUE 7336.5
593     RETURN 7337.
594     END 7337.5

  ViewVC Help
Powered by ViewVC 1.1.22