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

Contents of /trunk/Sources/phylmd/Radlwsw/sw1s.f

Parent Directory Parent Directory | Revision Log Revision Log

Revision 178 - (show annotations)
Fri Mar 11 18:47:26 2016 UTC (8 years, 2 months ago) by guez
File size: 6381 byte(s) 
Moved variables date0, deltat, datasz_max, ncvar_ids, point, buff_pos,
buffer, regular from module histcom_var to modules where they are
defined.

Removed procedure ioipslmpp, useless for a sequential program.

Added argument datasz_max to histwrite_real (to avoid circular
dependency with histwrite).

Removed useless variables and computations everywhere.

Changed real litteral constants from default kind to double precision
in lwb, lwu, lwvn, sw1s, swtt, swtt1, swu.

Removed unused arguments: paer of sw, sw1s, sw2s, swclr; pcldsw of
sw1s, sw2s; pdsig, prayl of swr; co2_ppm of clmain, clqh; tsol of
transp_lay; nsrf of screenp; kcrit and kknu of gwstress; pstd of
orosetup.

Added output of relative humidity.
1 module sw1s_m
2
3 IMPLICIT NONE
4
5 contains
6
7 SUBROUTINE sw1s(knu, flag_aer, tauae, pizae, cgae, palbd, palbp, pcg, &
8 pcld, pclear, pdsig, pomega, poz, prmu, psec, ptau, pud, pfd, &
9 pfu)
10 USE dimens_m
11 USE dimphy
12 USE raddim
13 use swclr_m, only: swclr
14 use swr_m, only: swr
15
16 ! ------------------------------------------------------------------
17 ! PURPOSE.
18 ! --------
19
20 ! THIS ROUTINE COMPUTES THE SHORTWAVE RADIATION FLUXES IN TWO
21 ! SPECTRAL INTERVALS FOLLOWING FOUQUART AND BONNEL (1980).
22
23 ! METHOD.
24 ! -------
25
26 ! 1. COMPUTES UPWARD AND DOWNWARD FLUXES CORRESPONDING TO
27 ! CONTINUUM SCATTERING
28 ! 2. MULTIPLY BY OZONE TRANSMISSION FUNCTION
29
30 ! REFERENCE.
31 ! ----------
32
33 ! SEE RADIATION'S PART OF THE ECMWF RESEARCH DEPARTMENT
34 ! DOCUMENTATION, AND FOUQUART AND BONNEL (1980)
35
36 ! AUTHOR.
37 ! -------
38 ! JEAN-JACQUES MORCRETTE *ECMWF*
39
40 ! MODIFICATIONS.
41 ! --------------
42 ! ORIGINAL : 89-07-14
43 ! 94-11-15 J.-J. MORCRETTE DIRECT/DIFFUSE ALBEDO
44 ! ------------------------------------------------------------------
45
46 ! * ARGUMENTS:
47
48 INTEGER knu
49 ! -OB
50 DOUBLE PRECISION flag_aer
51 DOUBLE PRECISION tauae(kdlon, kflev, 2)
52 DOUBLE PRECISION pizae(kdlon, kflev, 2)
53 DOUBLE PRECISION cgae(kdlon, kflev, 2)
54 DOUBLE PRECISION palbd(kdlon, 2)
55 DOUBLE PRECISION palbp(kdlon, 2)
56 DOUBLE PRECISION pcg(kdlon, 2, kflev)
57 DOUBLE PRECISION pcld(kdlon, kflev)
58 DOUBLE PRECISION pclear(kdlon)
59 DOUBLE PRECISION pdsig(kdlon, kflev)
60 DOUBLE PRECISION pomega(kdlon, 2, kflev)
61 DOUBLE PRECISION poz(kdlon, kflev)
62 DOUBLE PRECISION prmu(kdlon)
63 DOUBLE PRECISION psec(kdlon)
64 DOUBLE PRECISION ptau(kdlon, 2, kflev)
65 DOUBLE PRECISION pud(kdlon, 5, kflev+1)
66
67 DOUBLE PRECISION pfd(kdlon, kflev+1)
68 DOUBLE PRECISION pfu(kdlon, kflev+1)
69
70 ! * LOCAL VARIABLES:
71
72 INTEGER iind(4)
73
74 DOUBLE PRECISION zcgaz(kdlon, kflev)
75 DOUBLE PRECISION zdiff(kdlon)
76 DOUBLE PRECISION zdirf(kdlon)
77 DOUBLE PRECISION zpizaz(kdlon, kflev)
78 DOUBLE PRECISION zrayl(kdlon)
79 DOUBLE PRECISION zray1(kdlon, kflev+1)
80 DOUBLE PRECISION zray2(kdlon, kflev+1)
81 DOUBLE PRECISION zrefz(kdlon, 2, kflev+1)
82 DOUBLE PRECISION zrj(kdlon, 6, kflev+1)
83 DOUBLE PRECISION zrj0(kdlon, 6, kflev+1)
84 DOUBLE PRECISION zrk(kdlon, 6, kflev+1)
85 DOUBLE PRECISION zrk0(kdlon, 6, kflev+1)
86 DOUBLE PRECISION zrmue(kdlon, kflev+1)
87 DOUBLE PRECISION zrmu0(kdlon, kflev+1)
88 DOUBLE PRECISION zr(kdlon, 4)
89 DOUBLE PRECISION ztauaz(kdlon, kflev)
90 DOUBLE PRECISION ztra1(kdlon, kflev+1)
91 DOUBLE PRECISION ztra2(kdlon, kflev+1)
92 DOUBLE PRECISION zw(kdlon, 4)
93
94 INTEGER jl, jk, k, jaj, ikm1, ikl
95
96 ! Prescribed Data:
97
98 DOUBLE PRECISION rsun(2)
99 SAVE rsun
100 DOUBLE PRECISION rray(2, 6)
101 SAVE rray
102 DATA rsun(1)/0.441676d0/
103 DATA rsun(2)/0.558324d0/
104 DATA (rray(1,k), k=1, 6)/.428937d-01, .890743d+00, -.288555d+01, &
105 .522744d+01, -.469173d+01, .161645d+01/
106 DATA (rray(2,k), k=1, 6)/.697200d-02, .173297d-01, -.850903d-01, &
107 .248261d+00, -.302031d+00, .129662d+00/
108 ! ------------------------------------------------------------------
109
110 ! * 1. FIRST SPECTRAL INTERVAL (0.25-0.68 MICRON)
111 ! ----------------------- ------------------
112
113
114
115 ! * 1.1 OPTICAL THICKNESS FOR RAYLEIGH SCATTERING
116 ! -----------------------------------------
117
118
119 DO jl = 1, kdlon
120 zrayl(jl) = rray(knu, 1) + prmu(jl)*(rray(knu,2)+prmu(jl)*(rray(knu, &
121 3)+prmu(jl)*(rray(knu,4)+prmu(jl)*(rray(knu,5)+prmu(jl)*rray(knu,6)))))
122 END DO
123
124
125 ! ------------------------------------------------------------------
126
127 ! * 2. CONTINUUM SCATTERING CALCULATIONS
128 ! ---------------------------------
129
130
131 ! * 2.1 CLEAR-SKY FRACTION OF THE COLUMN
132 ! --------------------------------
133
134
135 CALL swclr(knu, flag_aer, tauae, pizae, cgae, palbp, pdsig, zrayl, &
136 psec, zcgaz, zpizaz, zray1, zray2, zrefz, zrj0, zrk0, zrmu0, ztauaz, &
137 ztra1, ztra2)
138
139
140 ! * 2.2 CLOUDY FRACTION OF THE COLUMN
141 ! -----------------------------
142
143
144 CALL swr(knu, palbd, pcg, pcld, pomega, psec, ptau, zcgaz, &
145 zpizaz, zray1, zray2, zrefz, zrj, zrk, zrmue, ztauaz, ztra1, ztra2)
146
147
148 ! ------------------------------------------------------------------
149
150 ! * 3. OZONE ABSORPTION
151 ! ----------------
152
153
154 iind(1) = 1
155 iind(2) = 3
156 iind(3) = 1
157 iind(4) = 3
158
159
160 ! * 3.1 DOWNWARD FLUXES
161 ! ---------------
162
163
164 jaj = 2
165
166 DO jl = 1, kdlon
167 zw(jl, 1) = 0.
168 zw(jl, 2) = 0.
169 zw(jl, 3) = 0.
170 zw(jl, 4) = 0.
171 pfd(jl, kflev+1) = ((1.-pclear(jl))*zrj(jl,jaj,kflev+1)+pclear(jl)*zrj0( &
172 jl,jaj,kflev+1))*rsun(knu)
173 END DO
174 DO jk = 1, kflev
175 ikl = kflev + 1 - jk
176 DO jl = 1, kdlon
177 zw(jl, 1) = zw(jl, 1) + pud(jl, 1, ikl)/zrmue(jl, ikl)
178 zw(jl, 2) = zw(jl, 2) + poz(jl, ikl)/zrmue(jl, ikl)
179 zw(jl, 3) = zw(jl, 3) + pud(jl, 1, ikl)/zrmu0(jl, ikl)
180 zw(jl, 4) = zw(jl, 4) + poz(jl, ikl)/zrmu0(jl, ikl)
181 END DO
182
183 CALL swtt1(knu, 4, iind, zw, zr)
184
185 DO jl = 1, kdlon
186 zdiff(jl) = zr(jl, 1)*zr(jl, 2)*zrj(jl, jaj, ikl)
187 zdirf(jl) = zr(jl, 3)*zr(jl, 4)*zrj0(jl, jaj, ikl)
188 pfd(jl, ikl) = ((1.-pclear(jl))*zdiff(jl)+pclear(jl)*zdirf(jl))* &
189 rsun(knu)
190 END DO
191 END DO
192
193
194 ! * 3.2 UPWARD FLUXES
195 ! -------------
196
197
198 DO jl = 1, kdlon
199 pfu(jl, 1) = ((1.-pclear(jl))*zdiff(jl)*palbd(jl,knu)+pclear(jl)*zdirf(jl &
200 )*palbp(jl,knu))*rsun(knu)
201 END DO
202
203 DO jk = 2, kflev + 1
204 ikm1 = jk - 1
205 DO jl = 1, kdlon
206 zw(jl, 1) = zw(jl, 1) + pud(jl, 1, ikm1)*1.66
207 zw(jl, 2) = zw(jl, 2) + poz(jl, ikm1)*1.66
208 zw(jl, 3) = zw(jl, 3) + pud(jl, 1, ikm1)*1.66
209 zw(jl, 4) = zw(jl, 4) + poz(jl, ikm1)*1.66
210 END DO
211
212 CALL swtt1(knu, 4, iind, zw, zr)
213
214 DO jl = 1, kdlon
215 zdiff(jl) = zr(jl, 1)*zr(jl, 2)*zrk(jl, jaj, jk)
216 zdirf(jl) = zr(jl, 3)*zr(jl, 4)*zrk0(jl, jaj, jk)
217 pfu(jl, jk) = ((1.-pclear(jl))*zdiff(jl)+pclear(jl)*zdirf(jl))* &
218 rsun(knu)
219 END DO
220 END DO
221
222 END SUBROUTINE sw1s
223
224 end module sw1s_m
  ViewVC Help
Powered by ViewVC 1.1.21