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

Annotation of /MITgcm_contrib/jscott/igsm/src/surf_clm.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:32 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     ! SURFACE.F: THIS SUBROUTINE CALCULATES THE SURFACE FLUXES
7     ! WHICH INCLUDE SENSIBLE HEAT, EVAPORATION,
8     ! THERMAL RADIATION, AND MOMENTUM DRAG. IT ALSO
9     ! CALCULATES INSTANTANEOUSLY SURFACE TEMPERATURE,
10     ! SURFACE SPECIFIC HUMIDITY, AND SURFACE WIND
11     ! COMPONENTS.
12     !
13     ! ----------------------------------------------------------
14     !
15     ! Author of Chemistry Modules: Chien Wang
16     !
17     ! ----------------------------------------------------------
18     !
19     ! Revision History:
20     !
21     ! When Who What
22     ! ---- ---------- -------
23     ! 073100 Chien Wang repack based on CliChem3 and add cpp
24     ! 092301 Chien Wang add bc and oc
25     !
26     ! ==========================================================
27    
28     SUBROUTINE SURF_CLM
29    
30     C**** 5802.
31     C**** THIS SUBROUTINE CALCULATES THE SURFACE FLUXES WHICH INCLUDE 5803.
32     C**** SENSIBLE HEAT, EVAPORATION, THERMAL RADIATION, AND MOMENTUM 5804.
33     C**** DRAG. IT ALSO CALCULATES INSTANTANEOUSLY SURFACE TEMPERATURE, 5805.
34     C**** SURFACE SPECIFIC HUMIDITY, AND SURFACE WIND COMPONENTS. 5806.
35     C**** 5807.
36    
37     #if ( defined CLM )
38     #if ( defined CPL_CHEM )
39     !
40     #include "chem_para"
41     #include "chem_com"
42     !
43     #endif
44    
45     #include "BD2G04.COM"
46    
47     #include "CLM.COM"
48    
49     COMMON/SPEC2/KM,KINC,COEK,C3LAND(IO0,JM0),C3OICE(IO0,JM0) 5808.1
50     * ,C3LICE(IO0,JM0),WMGE(IO0,JM0),TSSFC(1,JM0,4) 5808.2
51     COMMON U,V,T,P,Q 5809.
52     COMMON/WORK1/CONV(IM0,JM0,LM0),PK(IM0,JM0,LM0),PREC(IM0,JM0),
53     & TPREC(IM0,JM0), 5810.
54     * COSZ1(IO0,JM0) 5811.
55     COMMON/WORK2/UT(IM0,JM0,LM0),VT(IM0,JM0,LM0),DU1(IO0,JM0),
56     & DV1(IO0,JM0), 5812.
57     * RA(8),ID(8),UMS(8) 5813.
58     COMMON/WORK3/E0(IO0,JM0,4),E1(IO0,JM0,4),EVAPOR(IO0,JM0,4), 5814.
59     * TGRND(IO0,JM0,4) 5814.1
60     COMMON/RDATA/ROUGHL(IO0,JM0) 5815.
61     DIMENSION SINI(72),COSI(72) 5816.
62     LOGICAL POLE,PRNT,HPRNT
63     common/conprn/HPRNT
64     common/TSUR/TSURFC(JM0,0:13),TSURFT(JM0),TSURFD(JM0),DTEMSR(JM0)
65     common/SURRAD/TRSURF(JM0,4),SRSURF(JM0,4)
66     c REAL*8 B,TGV,TKV,TSV0,TSV1,TSV 5818.
67     COMMON/CWMG/WMGEA(JM0),NWMGEA(JM0),CHAVER(JM0),DTAV(JM0),DQAV(JM0)
68     & ,Z0AV(JM0),WSAV(JM0),WS0AV(JM0),TAUAV(JM0)
69     C
70     COMMON/SURFLAND/ DUL1(JM0),DVL1(JM0),DT1L(JM0),DQ1L(JM0),
71     & WSSL(JM0),T2ML(JM0),
72     & TSSL(JM0),QSSL(JM0),USSL(JM0),VSSL(JM0),TAUSL(JM0),BLJ(JM0,50)
73     & ,ELHTG(JM0),SHTG(JM0),TAUXG(JM0),TAUYG(JM0)
74     c
75     DATA RVAP/461.5/ 5819.
76     DATA SHV/0./,SHW/4185./,SHI/2060./,RHOW/1000./,RHOI/916.6/, 5820.
77     * ALAMI/2.1762/,STBO/.5672573E-7/,TF/273.16/,TFO/-1.56/ 5821.
78     DATA Z1I/.1/,Z2LI/2.9/,Z1E/.1/,Z2E/4./,RHOS/91.66/,ALAMS/.35/ 5822.
79     QSAT(TM,PR,QLH)=3.797915*EXP(QLH*(7.93252E-6-2.166847E-3/TM))/PR 5836.
80     DLQSDT(TM,QLH)=QLH*2.166847E-3/(TM*TM)
81     DATA IFIRST/1/ 5838.
82     ROSNOW(X)=0.54*X/LOG(1.+0.54*X/275.)
83     ALSNOW(X)=2.8E-6*X**2
84     C**** 5839.
85     C**** FDATA 2 LAND COVERAGE (1) 5840.
86     C**** 3 RATIO OF LAND ICE COVERAGE TO LAND COVERAGE (1) 5841.
87     C**** 5842.
88     C**** ODATA 1 OCEAN TEMPERATURE (C) 5843.
89     C**** 2 RATIO OF OCEAN ICE COVERAGE TO WATER COVERAGE (1) 5844.
90     C**** 3 OCEAN ICE AMOUNT OF SECOND LAYER (KG/M**2) 5845.
91     C**** 5846.
92     C**** GDATA 1 OCEAN ICE SNOW AMOUNT (KG/M**2) 5847.
93     C**** 2 EARTH SNOW AMOUNT (KG/M**2) 5848.
94     C**** 3 OCEAN ICE TEMPERATURE OF FIRST LAYER (C) 5849.
95     C**** 4 EARTH TEMPERATURE OF FIRST LAYER (C) 5850.
96     C**** 5 EARTH WATER OF FIRST LAYER (KG/M**2) 5851.
97     C**** 6 EARTH ICE OF FIRST LAYER (KG/M**2) 5852.
98     C**** 7 OCEAN ICE TEMPERATURE OF SECOND LAYER (C) 5853.
99     C**** 8 EARTH TEMPERATURE OF SECOND LAYER (C) 5854.
100     C**** 9 EARTH WATER OF SECOND LAYER (KG/M**2) 5855.
101     C**** 10 EARTH ICE OF SECOND LAYER (KG/M**2) 5856.
102     C**** 12 LAND ICE SNOW AMOUNT (KG/M**2) 5857.
103     C**** 13 LAND ICE TEMPERATURE OF FIRST LAYER (C) 5858.
104     C**** 14 LAND ICE TEMPERATURE OF SECOND LAYER (C) 5859.
105     C**** 5860.
106     C**** BLDATA 1 COMPOSITE SURFACE WIND MAGNITUDE (M/S) 5861.
107     C**** 2 COMPOSITE SURFACE AIR TEMPERATURE (K) 5862.
108     C**** 3 COMPOSITE SURFACE AIR SPECIFIC HUMIDITY (1) 5863.
109     C**** 4 LAYER TO WHICH DRY CONVECTION MIXES (1) 5864.
110     C**** 5 FREE 5865.
111     C**** 6 COMPOSITE SURFACE U WIND 5866.
112     C**** 7 COMPOSITE SURFACE V WIND 5867.
113     C**** 8 COMPOSITE SURFACE MOMENTUM TRANSFER (TAU) 5868.
114     C**** 5869.
115     C**** VDATA 9 WATER FIELD CAPACITY OF FIRST LAYER (KG/M**2) 5870.
116     C**** 10 WATER FIELD CAPACITY OF SECOND LAYER (KG/M**2) 5871.
117     C**** 5872.
118     C**** ROUGHL LOG(ZGS/ROUGHNESS LENGTH) (LOGARITHM TO BASE 10) 5873.
119     C**** ROUGHL will be ROUGHNESS LENGTH
120     C**** 5874.
121     c print *,'surface TAU=',TAU
122     NSTEPS=NSURF*NSTEP/NDYN 5875.
123     IF(IFIRST.NE.1) GO TO 50 5876.
124     print *,' SURFACE FOR LAND AFTER CLM'
125     IFIRST=0 5877.
126     COEFSN=100./ROSNOW(10.)
127     COEFSN=1.
128     DTSURF=NDYN*DT/NSURF 5884.
129     NGRNDZ=NGRND
130     DTGRND=DTSURF/NGRNDZ 6143.
131     print *,' DTSURF=',DTSURF
132     print *,' DTGRND=',DTGRND
133     SHA=RGAS/KAPA 5886.
134     RVX=0. 5887.
135     ZS1CO=.5*DSIG(1)*RGAS/GRAV 5896.
136     P1000K=EXPBYK(1000.) 5897.
137     COEFS=GRAV/(100.*DSIG(1)) 5898.
138     COEF1=(1.-SIG(2))/DSIGO(1) 5899.
139     COEF2=(SIG(1)-1.)/DSIGO(1) 5900.
140     50 CONTINUE
141     C**** ZERO OUT ENERGY AND EVAPORATION FOR GROUND AND INITIALIZE TGRND 5906.
142     DO 70 J=1,JM 5907.
143     DO 70 I=1,IM 5908.
144     TGRND(I,J,3)=GDATA(I,J,13) 5910.
145     TGRND(I,J,4)=GDATA(I,J,4) 5911.
146     DO 70 K=3,4 5912.
147     EVAPOR(I,J,K)=0.
148     E1(I,J,K)=0. 5913.
149     E0(I,J,K)=0. 5913.
150     70 CONTINUE
151     IHOUR=1.5+TOFDAY 5914.
152     C**** 5915.
153     C**** OUTSIDE LOOP OVER TIME STEPS, EXECUTED NSURF TIMES EVERY HOUR 5916.
154     C**** 5917.
155     C**** ZERO OUT LAYER 1 WIND INCREMENTS 5922.
156     DO 60 J=1,JM 5923.
157     DUL1(J)=0.
158     60 DVL1(J)=0.
159     C**** 5927.
160     C**** OUTSIDE LOOP OVER J AND I, EXECUTED ONCE FOR EACH GRID POINT 5928.
161     C**** 5929.
162     DO 7000 J=1,JM 5930.
163     if(PRNT)then
164     if(ns.eq.1)then
165     write(78,*) ,' '
166     write(78,*) ,'TAU=',TAU
167     endif
168     write(78,*),'NS=',ns
169     endif
170     100 CONTINUE
171     BTRHDT=0. 5958.
172     BSHDT=0. 5961.
173     BEVHDT=0. 5964.
174     BT2=0. 5967.
175     BTAUL=0.
176     BTAUF=0.
177     IMAX=IM 5969.
178     DO 6000 I=1,IMAX 5970.
179     C**** 5971.
180     C**** DETERMINE SURFACE CONDITIONS 5972.
181     C**** 5973.
182     PLAND=FDATA(I,J,2) 5974.
183     if(PLAND.gt.0.0)then
184     SP=P(I,J) 5980.
185     PS=SP+PTOP 5981.
186     PSK=EXPBYK(PS) 5982.
187     P1=SIG(1)*SP+PTOP 5983.
188     P1K=EXPBYK(P1) 5984.
189     C surface fluxes from radiation
190     TRHT0=TRSURF(J,2)
191     SRHEAT=SRSURF(J,2)*COSZ1(I,J)
192     C surface fluxes from radiation
193    
194     RMBYA=100.*SP*DSIG(1)/GRAV 6001.
195     C**** ZERO OUT QUANTITIES TO BE SUMMED OVER SURFACE TYPES 6002.
196     TAUS=0. 6008.
197     T2MS=0.
198     C**** 6032.
199     SNOW=snwdclm(i,j)
200     ACE1=h2oiclm(i,j,1)
201     WTR1=h2olclm(i,j,1)
202     IF(SNOW.GT.0.) THEN
203     ELHX=LHS
204     ELSE
205     PFROZN=ACE1/(WTR1+ACE1+1.E-20)
206     ELHX=LHE+LHM*PFROZN
207     ENDIF
208    
209     SRHDT=SRHEAT*DTSURF
210     TKV=THV1*PSK 6137.
211     ZS1=ZS1CO*TKV*SP/PS 6138.
212     P1=SIG(1)*SP+PTOP 6139.
213     SHDT=0. 6144.
214     EVHDT=0. 6145.
215     TRHDT=0. 6146.
216     F1DT=0. 6147.
217     C**** LOOP OVER GROUND TIME STEPS 6148.
218     C**** CALCULATE FLUXES OF SENSIBLE HEAT, LATENT HEAT, THERMAL 6478.
219     C**** RADIATION, AND CONDUCTION HEAT (WATTS/M**2) 6479.
220     SHEAT=shfclm(i,j)
221     EVHEAT=lhfclm(i,j)
222     TG=(abs(lwuclm(i,j))/STBO)**(1./4.)
223     TG1=TG-TF
224     c print *,'From surf_clm TAU=',TAU,' J=',j
225     c print *,LHS,LHE,LHM,ELHX
226     c print *,shfclm(i,j),lhfclm(i,j)
227     c TRHEAT=TRHT0-STBO*(TG*TG)*(TG*TG)
228     TRHEAT=TRHT0+lwuclm(i,j)
229     SHDT=DTSURF*SHEAT 6505.
230     EVHDT=DTSURF*EVHEAT 6506.
231     TRHDT=DTSURF*TRHEAT
232    
233     c DQ1=EVHDT/(ELHX*RMBYA)
234     c EVAP=-EVHDT/ELHX
235     EVAP=vetclm(i,j)+sevclm(i,j)+cevclm(i,j)
236     !! EVAP=vetclm(i,j)
237     EVAP=EVAP*DTSURF
238     DQ1=-EVAP/RMBYA
239     c print *,EVHDT,SHDT,DQ1,EVAP
240    
241     F0=SRHEAT+TRHEAT+SHEAT+EVHEAT 6487.
242    
243     TAUL=tauxclm(i,j)
244     TAUF=tauyclm(i,j)
245     WR=SQRT(VSSL(J)**2+USSL(J)**2)/WSSL(J)
246     TAUL=WR*TAUL
247     TAUF=WR*TAUF
248     DUL1(J)=DUL1(J)+PLAND*DTGRND*TAUL*COEFS/SP
249     DVL1(J)=DVL1(J)+PLAND*DTGRND*TAUF*COEFS/SP
250     TAUYG(J)=TAUL
251     TAUXG(J)=TAUF
252     c print *,tauxclm(i,j),tauyclm(i,j)
253     c print *,PLAND,DTGRND,COEFS,SP
254     c print *,DUL1(J),DVL1(J)
255    
256    
257     c TH2M=tref2mclm(i,j)
258     c t2md4tem(j)=t2md4tem(j)+TH2M
259     T2M=tref2mclm(i,j)
260     t2md4tem(j)=t2md4tem(j)+T2M
261     nt2md4tem(j)=nt2md4tem(j)+1
262     F0DT=CORSR*SRHDT+TRHDT+SHDT+EVHDT 6510.
263     c print *,'From surface ',TAU,CORSR,SRHDT,TRHDT,SHDT,EVHDT
264     C**** ACCUMULATE SURFACE FLUXES AND PROGNOSTIC AND DIAGNOSTIC QUANTITIES6517.
265     do ITYPE=3,4
266     E0(I,J,ITYPE)=E0(I,J,ITYPE)+F0DT 6518.
267     E1(I,J,ITYPE)=E1(I,J,ITYPE)+F1DT 6519.
268     EVAPOR(I,J,ITYPE)=EVAPOR(I,J,ITYPE)+EVAP 6520.
269     TGRND(I,J,ITYPE)=TG1 6521.
270     enddo
271    
272     DTH1=-SHDT*PLAND/(SHA*RMBYA*P1K)
273     DQQ1=-DQ1*PLAND
274    
275    
276     TAUS=TAUS+SQRT(TAUL**2+TAUF**2)*PLAND
277     T2MS=T2MS+T2M*PLAND
278     BSHDT=BSHDT+SHDT*PLAND
279     BEVHDT=BEVHDT+EVHDT*PLAND
280     BTRHDT=BTRHDT+TRHDT*PLAND
281     c BT2=BT2+(TH2M-TF)*PLAND
282     BT2=BT2+(T2M-TF)*PLAND
283     BTAUL=BTAUL+TAUL*PLAND
284     BTAUF=BTAUF+TAUF*PLAND
285    
286     5000 CONTINUE
287     DT1L(J)=DTH1
288     DQ1L(J)=DQQ1
289     TAUSL(J)=TAUS
290     T2ML(J)=T2MS
291     C**** 6596.
292     C**** ACCUMULATE DIAGNOSTICS 6597.
293     C**** 6598.
294     endif
295     6000 CONTINUE
296     C**** QUANTITIES ACCUMULATED FOR SURFACE TYPE TABLES IN DIAG1 6663.
297     BLJ(J,9)=BTRHDT
298     BLJ(J,13)=BSHDT
299     BLJ(J,14)=BEVHDT
300     BLJ(J,32)=BTAUL
301     BLJ(J,33)=BTAUF
302     BLJ(J,38)=BTAUL
303     BLJ(J,26)=BT2
304     if(J.eq.-23)then
305     print *,'TAU=',TAU,' EVHEAT=',EVHEAT
306     print *,'EVAP=',EVAP,' EVAP1=',-EVHDT/ELHX
307     endif
308     7000 CONTINUE 6677.
309     c print *,' From surf_clm T2ML'
310     c print *,T2ML
311     c write(935),TAU,ELHTG,SHTG,TAUXG,TAUYG
312     C**** 6678.
313     #endif
314     RETURN 6795.
315     990 FORMAT ('0PPBL',3I4,14F8.2) 6818.
316     991 FORMAT ('0SURFACE ',4I4,5F10.4,3F11.7) 6819.
317     992 FORMAT ('0',I2,10F10.4/23X,4F10.4,10X,2F10.4/ 6820.
318     * 33X,3F10.4,10X,2F10.4) 6821.
319     993 FORMAT ('0',I2,10F10.4/23X,7F10.4/33X,7F10.4) 6822.
320     994 FORMAT ('0',I2,11F10.4) 6823.
321     END 6824.

  ViewVC Help
Powered by ViewVC 1.1.22