/[lmdze]/trunk/phylmd/Radlwsw/lwtt.f
ViewVC logotype

Contents of /trunk/phylmd/Radlwsw/lwtt.f

Parent Directory Parent Directory | Revision Log Revision Log


Revision 265 - (show annotations)
Tue Mar 20 09:35:59 2018 UTC (6 years, 2 months ago) by guez
File size: 4764 byte(s)
Rename module dimens_m to dimensions.
1 SUBROUTINE lwtt(pga, pgb, puu, ptt)
2 USE dimensions
3 USE dimphy
4 USE raddim
5 USE raddimlw
6 IMPLICIT NONE
7
8 ! -----------------------------------------------------------------------
9 ! PURPOSE.
10 ! --------
11 ! THIS ROUTINE COMPUTES THE TRANSMISSION FUNCTIONS FOR ALL THE
12 ! ABSORBERS (H2O, UNIFORMLY MIXED GASES, AND O3) IN ALL SIX SPECTRAL
13 ! INTERVALS.
14
15 ! METHOD.
16 ! -------
17
18 ! 1. TRANSMISSION FUNCTION BY H2O AND UNIFORMLY MIXED GASES ARE
19 ! COMPUTED USING PADE APPROXIMANTS AND HORNER'S ALGORITHM.
20 ! 2. TRANSMISSION BY O3 IS EVALUATED WITH MALKMUS'S BAND MODEL.
21 ! 3. TRANSMISSION BY H2O CONTINUUM AND AEROSOLS FOLLOW AN
22 ! A SIMPLE EXPONENTIAL DECREASE WITH ABSORBER AMOUNT.
23
24 ! REFERENCE.
25 ! ----------
26
27 ! SEE RADIATION'S PART OF THE MODEL'S DOCUMENTATION AND
28 ! ECMWF RESEARCH DEPARTMENT DOCUMENTATION OF THE IFS
29
30 ! AUTHOR.
31 ! -------
32 ! JEAN-JACQUES MORCRETTE *ECMWF*
33
34 ! MODIFICATIONS.
35 ! --------------
36 ! ORIGINAL : 88-12-15
37
38 ! -----------------------------------------------------------------------
39 DOUBLE PRECISION o1h, o2h
40 PARAMETER (o1h=2230.)
41 PARAMETER (o2h=100.)
42 DOUBLE PRECISION rpialf0
43 PARAMETER (rpialf0=2.0)
44
45 ! * ARGUMENTS:
46
47 DOUBLE PRECISION puu(kdlon, nua)
48 DOUBLE PRECISION ptt(kdlon, ntra)
49 DOUBLE PRECISION pga(kdlon, 8, 2)
50 DOUBLE PRECISION pgb(kdlon, 8, 2)
51
52 ! * LOCAL VARIABLES:
53
54 DOUBLE PRECISION zz, zxd, zxn
55 DOUBLE PRECISION zpu, zpu10, zpu11, zpu12, zpu13
56 DOUBLE PRECISION zeu, zeu10, zeu11, zeu12, zeu13
57 DOUBLE PRECISION zx, zy, zsq1, zsq2, zvxy, zuxy
58 DOUBLE PRECISION zaercn, zto1, zto2, zxch4, zych4, zxn2o, zyn2o
59 DOUBLE PRECISION zsqn21, zodn21, zsqh42, zodh42
60 DOUBLE PRECISION zsqh41, zodh41, zsqn22, zodn22, zttf11, zttf12
61 DOUBLE PRECISION zuu11, zuu12, za11, za12
62 INTEGER jl, ja
63 ! ------------------------------------------------------------------
64
65 ! * 1. HORNER'S ALGORITHM FOR H2O AND CO2 TRANSMISSION
66 ! -----------------------------------------------
67
68
69
70 DO ja = 1, 8
71 DO jl = 1, kdlon
72 zz = sqrt(puu(jl,ja))
73 ! ZXD(JL,1)=PGB( JL, 1,1) + ZZ(JL, 1)*(PGB( JL, 1,2) + ZZ(JL, 1))
74 ! ZXN(JL,1)=PGA( JL, 1,1) + ZZ(JL, 1)*(PGA( JL, 1,2) )
75 ! PTT(JL,1)=ZXN(JL,1)/ZXD(JL,1)
76 zxd = pgb(jl, ja, 1) + zz*(pgb(jl,ja,2)+zz)
77 zxn = pga(jl, ja, 1) + zz*(pga(jl,ja,2))
78 ptt(jl, ja) = zxn/zxd
79 END DO
80 END DO
81
82 ! ------------------------------------------------------------------
83
84 ! * 2. CONTINUUM, OZONE AND AEROSOL TRANSMISSION FUNCTIONS
85 ! ---------------------------------------------------
86
87
88 DO jl = 1, kdlon
89 ptt(jl, 9) = ptt(jl, 8)
90
91 ! - CONTINUUM ABSORPTION: E- AND P-TYPE
92
93 zpu = 0.002*puu(jl, 10)
94 zpu10 = 112.*zpu
95 zpu11 = 6.25*zpu
96 zpu12 = 5.00*zpu
97 zpu13 = 80.0*zpu
98 zeu = puu(jl, 11)
99 zeu10 = 12.*zeu
100 zeu11 = 6.25*zeu
101 zeu12 = 5.00*zeu
102 zeu13 = 80.0*zeu
103
104 ! - OZONE ABSORPTION
105
106 zx = puu(jl, 12)
107 zy = puu(jl, 13)
108 zuxy = 4.*zx*zx/(rpialf0*zy)
109 zsq1 = sqrt(1.+o1h*zuxy) - 1.
110 zsq2 = sqrt(1.+o2h*zuxy) - 1.
111 zvxy = rpialf0*zy/(2.*zx)
112 zaercn = puu(jl, 17) + zeu12 + zpu12
113 zto1 = exp(-zvxy*zsq1-zaercn)
114 zto2 = exp(-zvxy*zsq2-zaercn)
115
116 ! -- TRACE GASES (CH4, N2O, CFC-11, CFC-12)
117
118 ! * CH4 IN INTERVAL 800-970 + 1110-1250 CM-1
119
120 ! NEXOTIC=1
121 ! IF (NEXOTIC.EQ.1) THEN
122 zxch4 = puu(jl, 19)
123 zych4 = puu(jl, 20)
124 zuxy = 4.*zxch4*zxch4/(0.103*zych4)
125 zsqh41 = sqrt(1.+33.7*zuxy) - 1.
126 zvxy = 0.103*zych4/(2.*zxch4)
127 zodh41 = zvxy*zsqh41
128
129 ! * N2O IN INTERVAL 800-970 + 1110-1250 CM-1
130
131 zxn2o = puu(jl, 21)
132 zyn2o = puu(jl, 22)
133 zuxy = 4.*zxn2o*zxn2o/(0.416*zyn2o)
134 zsqn21 = sqrt(1.+21.3*zuxy) - 1.
135 zvxy = 0.416*zyn2o/(2.*zxn2o)
136 zodn21 = zvxy*zsqn21
137
138 ! * CH4 IN INTERVAL 1250-1450 + 1880-2820 CM-1
139
140 zuxy = 4.*zxch4*zxch4/(0.113*zych4)
141 zsqh42 = sqrt(1.+400.*zuxy) - 1.
142 zvxy = 0.113*zych4/(2.*zxch4)
143 zodh42 = zvxy*zsqh42
144
145 ! * N2O IN INTERVAL 1250-1450 + 1880-2820 CM-1
146
147 zuxy = 4.*zxn2o*zxn2o/(0.197*zyn2o)
148 zsqn22 = sqrt(1.+2000.*zuxy) - 1.
149 zvxy = 0.197*zyn2o/(2.*zxn2o)
150 zodn22 = zvxy*zsqn22
151
152 ! * CFC-11 IN INTERVAL 800-970 + 1110-1250 CM-1
153
154 za11 = 2.*puu(jl, 23)*4.404E+05
155 zttf11 = 1. - za11*0.003225
156
157 ! * CFC-12 IN INTERVAL 800-970 + 1110-1250 CM-1
158
159 za12 = 2.*puu(jl, 24)*6.7435E+05
160 zttf12 = 1. - za12*0.003225
161
162 zuu11 = -puu(jl, 15) - zeu10 - zpu10
163 zuu12 = -puu(jl, 16) - zeu11 - zpu11 - zodh41 - zodn21
164 ptt(jl, 10) = exp(-puu(jl,14))
165 ptt(jl, 11) = exp(zuu11)
166 ptt(jl, 12) = exp(zuu12)*zttf11*zttf12
167 ptt(jl, 13) = 0.7554*zto1 + 0.2446*zto2
168 ptt(jl, 14) = ptt(jl, 10)*exp(-zeu13-zpu13)
169 ptt(jl, 15) = exp(-puu(jl,14)-zodh42-zodn22)
170 END DO
171
172 RETURN
173 END SUBROUTINE lwtt

  ViewVC Help
Powered by ViewVC 1.1.21