/[lmdze]/trunk/phylmd/Radlwsw/sw1s.f90
ViewVC logotype

Contents of /trunk/phylmd/Radlwsw/sw1s.f90

Parent Directory Parent Directory | Revision Log Revision Log

Revision 346 - (show annotations)
Mon Dec 9 20:15:29 2019 UTC (4 years, 6 months ago) by guez
File size: 5899 byte(s) 
Rename block to `my_block` in procedure `CLOUDS_GNO` because block is
a Fortran keyword.

Remove computation of palpbla in procedure sw. It was not used nor
output. (Not used nor output either in LMDZ.)

In procedure physiq, define `d_[uv]_con` and add them to `[uv]_seri`
only if `conv_Emanuel`. Thus, we do not need to initialize
`d_[uv]_con` to 0, we do not have to save them and we do not add 0 to
`[uv]_seri`.

In procedure physiq, no need to initialize rnebcon to 0, it is defined
by phyetat0 afterwards.

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