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

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

Parent Directory Parent Directory | Revision Log Revision Log

Revision 217 - (hide annotations)
Thu Mar 30 14:25:18 2017 UTC (7 years, 3 months ago) by guez
Original Path: trunk/Sources/phylmd/Radlwsw/sw1s.f
File size: 6200 byte(s) 
run_off_lic downgraded from variable of module interface_surf to local
variable of fonte_neige.

Code could not work with ok_aie set to true, so removed this
possibility. tauae, piz_ae, cg_ae, topswai, solswai were then
0. cldtaupi was the same as cldtaupd.

In sw and procedures called by sw, flag_aer did not need to be double
precision, changed it to logical.

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