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

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

Parent Directory Parent Directory | Revision Log Revision Log

Revision 346 - (hide 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 guez 178 module sw1s_m
2    
3 guez 81 IMPLICIT NONE
4    
5 guez 178 contains
6 guez 81
7 guez 219 SUBROUTINE sw1s(knu, palbd, palbp, pcg, pcld, pclear, pdsig, pomega, poz, &
8     prmu, psec, ptau, pud, pfd, pfu)
9 guez 217
10 guez 346 USE raddim, only: kdlon, kflev
11 guez 178 use swclr_m, only: swclr
12     use swr_m, only: swr
13 guez 81
14 guez 178 ! PURPOSE.
15     ! THIS ROUTINE COMPUTES THE SHORTWAVE RADIATION FLUXES IN TWO
16     ! SPECTRAL INTERVALS FOLLOWING FOUQUART AND BONNEL (1980).
17 guez 81
18 guez 178 ! METHOD.
19     ! 1. COMPUTES UPWARD AND DOWNWARD FLUXES CORRESPONDING TO
20     ! CONTINUUM SCATTERING
21     ! 2. MULTIPLY BY OZONE TRANSMISSION FUNCTION
22 guez 81
23 guez 178 ! REFERENCE.
24     ! SEE RADIATION'S PART OF THE ECMWF RESEARCH DEPARTMENT
25     ! DOCUMENTATION, AND FOUQUART AND BONNEL (1980)
26 guez 81
27 guez 178 ! AUTHOR.
28     ! JEAN-JACQUES MORCRETTE *ECMWF*
29 guez 81
30 guez 178 ! MODIFICATIONS.
31     ! ORIGINAL : 89-07-14
32     ! 94-11-15 J.-J. MORCRETTE DIRECT/DIFFUSE ALBEDO
33 guez 81
34 guez 178 ! * ARGUMENTS:
35 guez 81
36 guez 178 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 guez 81
50 guez 178 DOUBLE PRECISION pfd(kdlon, kflev+1)
51     DOUBLE PRECISION pfu(kdlon, kflev+1)
52 guez 81
53 guez 346 ! LOCAL VARIABLES:
54 guez 81
55 guez 178 INTEGER iind(4)
56 guez 81
57 guez 178 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 guez 81
77 guez 178 INTEGER jl, jk, k, jaj, ikm1, ikl
78 guez 81
79 guez 178 ! Prescribed Data:
80 guez 81
81 guez 178 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 guez 81
93 guez 178 ! * 1. FIRST SPECTRAL INTERVAL (0.25-0.68 MICRON)
94     ! ----------------------- ------------------
95 guez 81
96    
97    
98 guez 178 ! * 1.1 OPTICAL THICKNESS FOR RAYLEIGH SCATTERING
99     ! -----------------------------------------
100 guez 81
101    
102 guez 178 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 guez 81
107    
108 guez 178 ! ------------------------------------------------------------------
109 guez 81
110 guez 178 ! * 2. CONTINUUM SCATTERING CALCULATIONS
111     ! ---------------------------------
112 guez 81
113    
114 guez 178 ! * 2.1 CLEAR-SKY FRACTION OF THE COLUMN
115     ! --------------------------------
116 guez 81
117    
118 guez 219 CALL swclr(knu, palbp, pdsig, zrayl, psec, zpizaz, zray1, zray2, zrefz, &
119     zrj0, zrk0, zrmu0, ztauaz, ztra1, ztra2)
120 guez 81
121    
122 guez 178 ! * 2.2 CLOUDY FRACTION OF THE COLUMN
123     ! -----------------------------
124 guez 81
125 guez 219 zcgaz = 0d0
126 guez 178 CALL swr(knu, palbd, pcg, pcld, pomega, psec, ptau, zcgaz, &
127     zpizaz, zray1, zray2, zrefz, zrj, zrk, zrmue, ztauaz, ztra1, ztra2)
128 guez 81
129    
130 guez 178 ! ------------------------------------------------------------------
131 guez 81
132 guez 178 ! * 3. OZONE ABSORPTION
133     ! ----------------
134 guez 81
135    
136 guez 178 iind(1) = 1
137     iind(2) = 3
138     iind(3) = 1
139     iind(4) = 3
140 guez 81
141    
142 guez 178 ! * 3.1 DOWNWARD FLUXES
143     ! ---------------
144 guez 81
145 guez 178
146     jaj = 2
147    
148 guez 81 DO jl = 1, kdlon
149 guez 178 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 guez 81 END DO
156 guez 178 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 guez 81
165 guez 178 CALL swtt1(knu, 4, iind, zw, zr)
166 guez 81
167 guez 178 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 guez 81 END DO
174    
175    
176 guez 178 ! * 3.2 UPWARD FLUXES
177     ! -------------
178 guez 81
179    
180     DO jl = 1, kdlon
181 guez 178 pfu(jl, 1) = ((1.-pclear(jl))*zdiff(jl)*palbd(jl,knu)+pclear(jl)*zdirf(jl &
182     )*palbp(jl,knu))*rsun(knu)
183 guez 81 END DO
184    
185 guez 178 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 guez 81
194 guez 178 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 guez 81 END DO
203    
204 guez 178 END SUBROUTINE sw1s
205 guez 81
206 guez 178 end module sw1s_m
  ViewVC Help
Powered by ViewVC 1.1.21