/[lmdze]/trunk/Sources/phylmd/Radlwsw/lwttm.f
ViewVC logotype

Annotation of /trunk/Sources/phylmd/Radlwsw/lwttm.f

Parent Directory Parent Directory | Revision Log Revision Log

Revision 81 - (hide annotations)
Wed Mar 5 14:38:41 2014 UTC (10 years, 3 months ago) by guez
Original Path: trunk/phylmd/Radlwsw/lwttm.f90
File size: 4967 byte(s) 
 Converted to free source form files which were still in fixed source
form. The conversion was done using the polish mode of the NAG Fortran
Compiler.

In addition to converting to free source form, the processing of the
files also:

-- indented the code (including comments);

-- set Fortran keywords to uppercase, and set all other identifiers
to lower case;

-- added qualifiers to end statements (for example "end subroutine
conflx", instead of "end");

-- changed the terminating statements of all DO loops so that each
loop ends with an ENDDO statement (instead of a labeled continue).
1 guez 81 SUBROUTINE lwttm(pga, pgb, puu1, puu2, ptt)
2     USE dimens_m
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 pga(kdlon, 8, 2) ! PADE APPROXIMANTS
48     DOUBLE PRECISION pgb(kdlon, 8, 2) ! PADE APPROXIMANTS
49     DOUBLE PRECISION puu1(kdlon, nua) ! ABSORBER AMOUNTS FROM TOP TO LEVEL 1
50     DOUBLE PRECISION puu2(kdlon, nua) ! ABSORBER AMOUNTS FROM TOP TO LEVEL 2
51     DOUBLE PRECISION ptt(kdlon, ntra) ! TRANSMISSION FUNCTIONS
52    
53     ! * LOCAL VARIABLES:
54    
55     INTEGER ja, jl
56     DOUBLE PRECISION zz, zxd, zxn
57     DOUBLE PRECISION zpu, zpu10, zpu11, zpu12, zpu13
58     DOUBLE PRECISION zeu, zeu10, zeu11, zeu12, zeu13
59     DOUBLE PRECISION zx, zy, zuxy, zsq1, zsq2, zvxy, zaercn, zto1
60     DOUBLE PRECISION zto2
61     DOUBLE PRECISION zxch4, zych4, zsqh41, zodh41
62     DOUBLE PRECISION zxn2o, zyn2o, zsqn21, zodn21, zsqh42, zodh42
63     DOUBLE PRECISION zsqn22, zodn22, za11, zttf11, za12, zttf12
64     DOUBLE PRECISION zuu11, zuu12
65     ! ------------------------------------------------------------------
66    
67     ! * 1. HORNER'S ALGORITHM FOR H2O AND CO2 TRANSMISSION
68     ! -----------------------------------------------
69    
70    
71    
72     DO ja = 1, 8
73     DO jl = 1, kdlon
74     zz = sqrt(puu1(jl,ja)-puu2(jl,ja))
75     zxd = pgb(jl, ja, 1) + zz*(pgb(jl,ja,2)+zz)
76     zxn = pga(jl, ja, 1) + zz*(pga(jl,ja,2))
77     ptt(jl, ja) = zxn/zxd
78     END DO
79     END DO
80    
81     ! ------------------------------------------------------------------
82    
83     ! * 2. CONTINUUM, OZONE AND AEROSOL TRANSMISSION FUNCTIONS
84     ! ---------------------------------------------------
85    
86    
87     DO jl = 1, kdlon
88     ptt(jl, 9) = ptt(jl, 8)
89    
90     ! - CONTINUUM ABSORPTION: E- AND P-TYPE
91    
92     zpu = 0.002*(puu1(jl,10)-puu2(jl,10))
93     zpu10 = 112.*zpu
94     zpu11 = 6.25*zpu
95     zpu12 = 5.00*zpu
96     zpu13 = 80.0*zpu
97     zeu = (puu1(jl,11)-puu2(jl,11))
98     zeu10 = 12.*zeu
99     zeu11 = 6.25*zeu
100     zeu12 = 5.00*zeu
101     zeu13 = 80.0*zeu
102    
103     ! - OZONE ABSORPTION
104    
105     zx = (puu1(jl,12)-puu2(jl,12))
106     zy = (puu1(jl,13)-puu2(jl,13))
107     zuxy = 4.*zx*zx/(rpialf0*zy)
108     zsq1 = sqrt(1.+o1h*zuxy) - 1.
109     zsq2 = sqrt(1.+o2h*zuxy) - 1.
110     zvxy = rpialf0*zy/(2.*zx)
111     zaercn = (puu1(jl,17)-puu2(jl,17)) + zeu12 + zpu12
112     zto1 = exp(-zvxy*zsq1-zaercn)
113     zto2 = exp(-zvxy*zsq2-zaercn)
114    
115     ! -- TRACE GASES (CH4, N2O, CFC-11, CFC-12)
116    
117     ! * CH4 IN INTERVAL 800-970 + 1110-1250 CM-1
118    
119     zxch4 = (puu1(jl,19)-puu2(jl,19))
120     zych4 = (puu1(jl,20)-puu2(jl,20))
121     zuxy = 4.*zxch4*zxch4/(0.103*zych4)
122     zsqh41 = sqrt(1.+33.7*zuxy) - 1.
123     zvxy = 0.103*zych4/(2.*zxch4)
124     zodh41 = zvxy*zsqh41
125    
126     ! * N2O IN INTERVAL 800-970 + 1110-1250 CM-1
127    
128     zxn2o = (puu1(jl,21)-puu2(jl,21))
129     zyn2o = (puu1(jl,22)-puu2(jl,22))
130     zuxy = 4.*zxn2o*zxn2o/(0.416*zyn2o)
131     zsqn21 = sqrt(1.+21.3*zuxy) - 1.
132     zvxy = 0.416*zyn2o/(2.*zxn2o)
133     zodn21 = zvxy*zsqn21
134    
135     ! * CH4 IN INTERVAL 1250-1450 + 1880-2820 CM-1
136    
137     zuxy = 4.*zxch4*zxch4/(0.113*zych4)
138     zsqh42 = sqrt(1.+400.*zuxy) - 1.
139     zvxy = 0.113*zych4/(2.*zxch4)
140     zodh42 = zvxy*zsqh42
141    
142     ! * N2O IN INTERVAL 1250-1450 + 1880-2820 CM-1
143    
144     zuxy = 4.*zxn2o*zxn2o/(0.197*zyn2o)
145     zsqn22 = sqrt(1.+2000.*zuxy) - 1.
146     zvxy = 0.197*zyn2o/(2.*zxn2o)
147     zodn22 = zvxy*zsqn22
148    
149     ! * CFC-11 IN INTERVAL 800-970 + 1110-1250 CM-1
150    
151     za11 = (puu1(jl,23)-puu2(jl,23))*4.404E+05
152     zttf11 = 1. - za11*0.003225
153    
154     ! * CFC-12 IN INTERVAL 800-970 + 1110-1250 CM-1
155    
156     za12 = (puu1(jl,24)-puu2(jl,24))*6.7435E+05
157     zttf12 = 1. - za12*0.003225
158    
159     zuu11 = -(puu1(jl,15)-puu2(jl,15)) - zeu10 - zpu10
160     zuu12 = -(puu1(jl,16)-puu2(jl,16)) - zeu11 - zpu11 - zodh41 - zodn21
161     ptt(jl, 10) = exp(-(puu1(jl,14)-puu2(jl,14)))
162     ptt(jl, 11) = exp(zuu11)
163     ptt(jl, 12) = exp(zuu12)*zttf11*zttf12
164     ptt(jl, 13) = 0.7554*zto1 + 0.2446*zto2
165     ptt(jl, 14) = ptt(jl, 10)*exp(-zeu13-zpu13)
166     ptt(jl, 15) = exp(-(puu1(jl,14)-puu2(jl,14))-zodh42-zodn22)
167     END DO
168    
169     RETURN
170     END SUBROUTINE lwttm
  ViewVC Help
Powered by ViewVC 1.1.21