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

Contents of /MITgcm_contrib/jscott/igsm/src/t2m.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:33 2006 UTC (18 years, 11 months ago) by jscott
Branch: MAIN
CVS Tags: HEAD
atm2d package

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

  ViewVC Help
Powered by ViewVC 1.1.22