1 |
SUBROUTINE TZM(T,TH,Z,Z0,ZGS,PSMB,TG,TS,RIGS,WS,SHEAT,TGM,LR,EPS) |
2 |
PARAMETER(R=287.D0,G=9.8D0,CP=1007.D0,CAR=0.35, |
3 |
:RCP=R/CP,RG=R/G,GCP=G/CP) |
4 |
LOGICAL FIRST |
5 |
DIMENSION AROUGH(20),BROUGH(20),CROUGH(20),DROUGH(20),EROUGH(20) 5823. |
6 |
DATA AROUGH/16.59,13.99,10.4,7.35,5.241,3.926,3.126,2.632,2.319, 5824. |
7 |
*2.116,1.982,1.893,1.832,1.788,1.757,1.733,1.714,1.699,1.687,1.677/5825. |
8 |
DATA BROUGH/3.245,1.733,0.8481,0.3899,0.1832,0.9026E-1,0.4622E-1, 5826. |
9 |
* .241E-1,.1254E-1,.6414E-2,.3199E-2,.1549E-2,.7275E-3,.3319E-3, 5827. |
10 |
* .1474E-3,.6392E-4,.2713E-4,.1130E-4,.4630E-5,.1868E-5/ 5828. |
11 |
DATA CROUGH/5.111,3.088,1.682,.9239,.5626,.3994,.3282,.3017,.299 5829. |
12 |
*,.3114,.3324,.3587,.3881,.4186,.4492,.4792,.5082,.5361,.5627, 5830. |
13 |
* .5882/ 5831. |
14 |
DATA DROUGH/1.24,1.02,0.806,0.682,0.661,0.771,0.797,0.895,0.994, 5832. |
15 |
* 1.09,1.18,1.27,1.35,1.43,1.50,1.58,1.65,1.71,1.78,1.84/ 5833. |
16 |
DATA EROUGH/0.128,0.130,0.141,0.174,0.238,0.330,0.438,0.550,0.660,5834. |
17 |
* 0.766,0.866,0.962,1.05,1.14,1.22,1.30,1.37,1.45,1.52,1.58/ 5835. |
18 |
DATA FIRST/.TRUE./ |
19 |
PS=PSMB*1.D2 |
20 |
PSR=PS/R |
21 |
ROS=PSR/TG |
22 |
|
23 |
c DTH=TS-TG |
24 |
c CDN=(CAR/LOG(ZGS/Z0))**2 |
25 |
c IF(RIGS.LE.0) THEN |
26 |
C surface layer has unstable stratification |
27 |
c DM=SQRT((1.-AROUGH(LR)*RIGS)*(1.-BROUGH(LR)*RIGS)/ |
28 |
c * (1.-CROUGH(LR)*RIGS)) |
29 |
c DH=1.35*SQRT((1.-DROUGH(LR)*RIGS)/(1.-EROUGH(LR)*RIGS)) |
30 |
c ELSE |
31 |
C surface layer has stable stratification |
32 |
c DM=1./(1.+(11.238+89.9*RIGS)*RIGS) |
33 |
c DH=1.35/(1.+1.93*RIGS) |
34 |
c END IF |
35 |
c FM=DM |
36 |
c FH=DM*DH |
37 |
c HF=-CP*ROS*WS*CDN*FH*DTH |
38 |
c TGM1=ROS*CDN*FM*WS**2 |
39 |
|
40 |
c print *,'FROM TZM' |
41 |
c print *,'CDN=',CDN |
42 |
c print *,'SHEAT=',SHEAT,' HF=',HF |
43 |
c print *,'TGM=',TGM,' TGM1=',TGM1 |
44 |
c print *,Z,Z0,PS,TG,SHEAT,TGM,LR,EPS |
45 |
CB CALCULATION OF T (TEMPERATURE ON HEIGHT Z) |
46 |
ZZ=Z/Z0 |
47 |
SZZ=SQRT(ZZ) |
48 |
ZZ1=1.D0/ZZ |
49 |
SCD=CAR/LOG(ZZ) |
50 |
CD=SCD*SCD |
51 |
CDSZZ=CD*SZZ |
52 |
HF1=SHEAT/CP |
53 |
SRCDTX=SCD*SQRT(ROS*TGM) |
54 |
THCOF=HF1/SRCDTX |
55 |
RICOF=G*Z*HF1*SRCDTX/(TG*TGM**2) |
56 |
RICOF2=RICOF**2 |
57 |
DX0=10.D0 |
58 |
IF(SHEAT.LT.0.D0) THEN |
59 |
DX0=10.D0 |
60 |
ELSE |
61 |
DX0=-10.D0 |
62 |
END IF |
63 |
DX=DX0 |
64 |
X1=DX |
65 |
CALL DR(X1,RICOF2,DEL1,FM,FH,LR) |
66 |
in=0 |
67 |
10 CONTINUE |
68 |
in=in+1 |
69 |
IF(DEL1.LT.0.D0) THEN |
70 |
DX=DX+DX0 |
71 |
X1=X1+DX |
72 |
CALL DR(X1,RICOF2,DEL1,FM,FH,LR) |
73 |
c print *,'in=',in,'DEL1=',DEL1 |
74 |
GO TO 10 |
75 |
END IF |
76 |
X0=X1-DX |
77 |
in=0 |
78 |
20 CONTINUE |
79 |
in=in+1 |
80 |
DLX=0.5D0*(X1-X0) |
81 |
IF(ABS(DLX).GT.EPS) THEN |
82 |
X=X0+DLX |
83 |
CALL DR(X,RICOF2,DEL,FM,FH,LR) |
84 |
IF(DEL.LT.0.D0) THEN |
85 |
X0=X |
86 |
ELSE |
87 |
X1=X |
88 |
END IF |
89 |
GO TO 20 |
90 |
END IF |
91 |
TH=TG-THCOF*SQRT(FM)/FH |
92 |
PZ=PS-G*ROS*Z |
93 |
T=TH/(1.D0+GCP*Z/TG) |
94 |
CE |
95 |
RETURN |
96 |
END |
97 |
SUBROUTINE DR(RIGS,RICOF2,DEL,FM,FH,LR) |
98 |
DIMENSION AROUGH(20),BROUGH(20),CROUGH(20),DROUGH(20),EROUGH(20) 5823. |
99 |
DATA AROUGH/16.59,13.99,10.4,7.35,5.241,3.926,3.126,2.632,2.319, 5824. |
100 |
*2.116,1.982,1.893,1.832,1.788,1.757,1.733,1.714,1.699,1.687,1.677/5825. |
101 |
DATA BROUGH/3.245,1.733,0.8481,0.3899,0.1832,0.9026E-1,0.4622E-1, 5826. |
102 |
* .241E-1,.1254E-1,.6414E-2,.3199E-2,.1549E-2,.7275E-3,.3319E-3, 5827. |
103 |
* .1474E-3,.6392E-4,.2713E-4,.1130E-4,.4630E-5,.1868E-5/ 5828. |
104 |
DATA CROUGH/5.111,3.088,1.682,.9239,.5626,.3994,.3282,.3017,.299 5829. |
105 |
*,.3114,.3324,.3587,.3881,.4186,.4492,.4792,.5082,.5361,.5627, 5830. |
106 |
* .5882/ 5831. |
107 |
DATA DROUGH/1.24,1.02,0.806,0.682,0.661,0.771,0.797,0.895,0.994, 5832. |
108 |
* 1.09,1.18,1.27,1.35,1.43,1.50,1.58,1.65,1.71,1.78,1.84/ 5833. |
109 |
DATA EROUGH/0.128,0.130,0.141,0.174,0.238,0.330,0.438,0.550,0.660,5834. |
110 |
* 0.766,0.866,0.962,1.05,1.14,1.22,1.30,1.37,1.45,1.52,1.58/ 5835. |
111 |
RI=RIGS |
112 |
c print *,'here' |
113 |
c print *,RI,LR |
114 |
c do ii=1,100 |
115 |
c print *,' ' |
116 |
c enddo |
117 |
IF(RIGS.LE.0) THEN |
118 |
C surface layer has unstable stratification |
119 |
DM=SQRT((1.-AROUGH(LR)*RIGS)*(1.-BROUGH(LR)*RIGS)/ |
120 |
* (1.-CROUGH(LR)*RIGS)) |
121 |
DH=1.35*SQRT((1.-DROUGH(LR)*RIGS)/(1.-EROUGH(LR)*RIGS)) |
122 |
ELSE |
123 |
C surface layer has stable stratification |
124 |
DM=1./(1.+(11.238+89.9*RIGS)*RIGS) |
125 |
DH=1.35/(1.+1.93*RIGS) |
126 |
END IF |
127 |
FM=DM |
128 |
FH=DM*DH |
129 |
c print *,FM,FH |
130 |
DEL=RI*RI-RICOF2*FM*FM*FM/(FH*FH) |
131 |
RETURN |
132 |
END |