TETEN.inc
References to this file elsewhere.
1 SUBROUTINE TETEN(ICE)
2 C IMPLICIT DOUBLE PRECISION (A-H,O-Z,\)
3 REAL*8 XB,XC,X,TABLE,DTABLE
4 REAL*8 B,C,BI,CI,TSAT,TSATI
5 REAL*8 RTABLE !##
6 COMMON/CTETEN /TABLE (25000)
7 COMMON/DTETEN /DTABLE(25000)
8 COMMON/CLATENT/CTABLE(25000),DCL,TEMP0,TEMPI
9 COMMON/RLQIC /RTABLE(25000),TLI1,TLI2 !##
10 COMMON/COMPHC/ CP,HL,GASR,ER,G,STB,SOLCON,TWOMG
11 COMMON/COMEVP/CEV(4001),DFW,RDFW
12 DATA XB,XC/21.18123D0,5418.0D0/
13 DATA B,C,BI,CI,TSAT,TSATI/19.480254D0,4304.412D0,
14 & 23.684812D0,5803.3203D0,
15 & 29.55D0,7.85D0/
16 TEMP0 = t_kelvin
17 CBBK TEMPI = 233.15
18 TEMPI = 258.15
19 DTEMP = TEMP0-TEMPI
20 TLI1 = TEMPI !##
21 TLI2 = TEMP0 !##
22 IF(ICE.EQ.1) THEN
23 DICE = 3.33E5
24 ELSE
25 DICE = 0.0
26 ENDIF
27 HICE = HL + DICE
28 C DL/DT
29 DCL = -DICE/DTEMP
30 CX CLBYCP = HL/CP
31 CX CLBYCPI = HICE/CP
32 IF(ICE.EQ.0) THEN
33 DO 10 I = 1,25000
34 X = 123.2D0 + 0.01D0*I
35 ! JRB
36 ! TABLE(I) = 0.622*DEXP(B-C/(X-TSAT))
37 TABLE(I) = 0.622*EXP(B-C/(X-TSAT))
38 DTABLE(I) = TABLE(I)*C/(X-TSAT)**2
39 CTABLE(I) = HL
40 RTABLE(I) = 1. !##
41 10 CONTINUE
42 ELSE
43 DO 20 I = 1,25000
44 X = 123.2D0 + 0.01D0*I
45 IF(X.GE.TEMP0) THEN
46 ! JRB
47 ! TABLE(I) = 0.622*DEXP(B-C/(X-TSAT))
48 TABLE(I) = 0.622*EXP(B-C/(X-TSAT))
49 DTABLE(I) = TABLE(I)*C/(X-TSAT)**2
50 CTABLE(I) = HL
51 RTABLE(I) = 1. !##
52 ELSEIF(X.LE.TEMPI) THEN
53 ! TABLE(I) = 0.622*DEXP(BI-CI/(X-TSATI))
54 TABLE(I) = 0.622*EXP(BI-CI/(X-TSATI))
55 DTABLE(I) = TABLE(I)*CI/(X-TSATI)**2
56 CTABLE(I) = HICE
57 RTABLE(I) = 0. !##
58 ELSE
59 RR = (TEMP0-X)/DTEMP
60 CTABLE(I) = HL*(1.0-RR) + HICE*RR
61 ! JRB
62 ! TBL1 = 0.622*DEXP(B-C/(X-TSAT))
63 TBL1 = 0.622*EXP(B-C/(X-TSAT))
64 DTBL1 = TBL1*C/(X-TSAT)**2
65 ! JRB
66 ! TBL2 = 0.622*DEXP(BI-CI/(X-TSATI))
67 TBL2 = 0.622*EXP(BI-CI/(X-TSATI))
68 DTBL2 = TBL2*CI/(X-TSATI)**2
69 TABLE(I) = TBL1*(1.D0-RR)+TBL2*RR
70 DTABLE(I) = DTBL1*(1.D0-RR)+DTBL2*RR+(TBL1-TBL2)/DTEMP
71 RTABLE(I) = 1.D0-RR !##
72 C ## 3-JI KANSUU : RTABLE(I) = TT*TT*(3.-2.*TT)
73 C ## WHERE TT = 1.D0-RR
74 ENDIF
75 20 CONTINUE
76 ENDIF
77 FWMX = 5.0
78 FWMN = 0.0
79 IFWM = 4001
80 DFW = (FWMX-FWMN)/(IFWM-1.)
81 RDFW=1./DFW
82 *VOPTION NOFVAL
83 DO 30 I = 1,IFWM
84 FW = FWMN + DFW*(I-1.)
85 CEV(I) = 8.*GASR*(1.6+23.2*(FW)**0.167)*(FW)**0.467
86 30 CONTINUE
87 CEV(1) = 0.0
88 C ## CALL MNTRLQIC (RTABLE,TLI1,TLI2)
89 RETURN
90 END SUBROUTINE TETEN