| 1 |
jscott |
1.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 |
Parent Directory
| 
Revision Log
| 
Revision Graph