/[lmdze]/trunk/phylmd/Radlwsw/sw.f
ViewVC logotype

Annotation of /trunk/phylmd/Radlwsw/sw.f

Parent Directory Parent Directory | Revision Log Revision Log

Revision 118 - (hide annotations)
Thu Dec 18 17:30:24 2014 UTC (9 years, 5 months ago) by guez
File size: 10768 byte(s) 
In file grilles_gcm.nc, renamed variable phis to orog, deleted
variable presnivs.

Removed variable bug_ozone from module clesphys.

In procedure ozonecm, moved computation of sint and cost out of the
loops on horizontal position and vertical level. Inverted the order of
the two loops. We can then move all computations from slat to aprim
out of the loop on vertical levels. Created variable slat2, following
LMDZ. Moved the limitation of column-density of ozone in cell at 1e-12
from radlwsw to ozonecm, following LMDZ.

Removed unused arguments u, albsol, rh, cldfra, rneb, diafra, cldliq,
pmflxr, pmflxs, prfl, psfl of phytrac.

In procedure yamada4, for all the arrays, replaced the dimension klon
by ngrid. At the end of the procedure, for the computation of kmn,kn,
kq and q2, changed the upper limit of the loop index from klon to ngrid.

In radlwsw, for the calculation of pozon, removed the factor
paprs(iof+i, 1)/101325, as in LMDZ. In procedure sw, removed the
factor 101325.0/PPSOL(JL), as in LMDZ.
1 guez 53 module sw_m
2 guez 24
3 guez 53 IMPLICIT none
4 guez 24
5 guez 53 contains
6    
7     SUBROUTINE SW(PSCT, PRMU0, PFRAC, PPMB, PDP, PPSOL, PALBD, PALBP, PTAVE, &
8     PWV, PQS, POZON, PAER, PCLDSW, PTAU, POMEGA, PCG, PHEAT, PHEAT0, &
9     PALBPLA, PTOPSW, PSOLSW, PTOPSW0, PSOLSW0, ZFSUP, ZFSDN, ZFSUP0, &
10     ZFSDN0, tauae, pizae, cgae, PTAUA, POMEGAA, PTOPSWAD, PSOLSWAD, &
11     PTOPSWAI, PSOLSWAI, ok_ade, ok_aie)
12    
13 guez 72 ! Purpose.
14     ! This routine computes the shortwave radiation fluxes in two
15     ! spectral intervals following Fouquart and Bonnel (1980).
16 guez 53
17 guez 72 ! Method.
18     ! 1. Computes absorber amounts (swu)
19     ! 2. Computes fluxes in 1st spectral interval (SW1S)
20     ! 3. Computes fluxes in 2nd spectral interval (SW2S)
21 guez 53
22 guez 72 ! Reference.
23     ! See radiation part of the ECMWF research department
24     ! documentation, and Fouquart and Bonnel (1980)
25 guez 53
26 guez 72 ! Author.
27     ! Jean-Jacques Morcrette *ecmwf*
28 guez 53
29 guez 72 ! Modifications.
30     ! Original: 89-07-14
31     ! 95-01-01 J.-J. Morcrette direct/diffuse albedo
32     ! 03-11-27 J. Quaas Introduce aerosol forcings (based on Boucher)
33 guez 53
34 guez 72 USE raddim, ONLY: kdlon, kflev
35 guez 118 USE suphec_m, ONLY: rcpd, rday, rg
36 guez 53
37     ! ARGUMENTS:
38    
39     DOUBLE PRECISION PSCT ! constante solaire (valeur conseillee: 1370)
40    
41     DOUBLE PRECISION PPSOL(KDLON) ! SURFACE PRESSURE (PA)
42     DOUBLE PRECISION PDP(KDLON, KFLEV) ! LAYER THICKNESS (PA)
43     DOUBLE PRECISION PPMB(KDLON, KFLEV+1) ! HALF-LEVEL PRESSURE (MB)
44    
45     DOUBLE PRECISION PRMU0(KDLON) ! COSINE OF ZENITHAL ANGLE
46     DOUBLE PRECISION PFRAC(KDLON) ! fraction de la journee
47    
48     DOUBLE PRECISION PTAVE(KDLON, KFLEV) ! LAYER TEMPERATURE (K)
49     DOUBLE PRECISION PWV(KDLON, KFLEV) ! SPECIFIC HUMIDITY (KG/KG)
50     DOUBLE PRECISION PQS(KDLON, KFLEV) ! SATURATED WATER VAPOUR (KG/KG)
51     DOUBLE PRECISION POZON(KDLON, KFLEV) ! OZONE CONCENTRATION (KG/KG)
52     DOUBLE PRECISION PAER(KDLON, KFLEV, 5) ! AEROSOLS' OPTICAL THICKNESS
53    
54     DOUBLE PRECISION PALBD(KDLON, 2) ! albedo du sol (lumiere diffuse)
55     DOUBLE PRECISION PALBP(KDLON, 2) ! albedo du sol (lumiere parallele)
56    
57     DOUBLE PRECISION PCLDSW(KDLON, KFLEV) ! CLOUD FRACTION
58     DOUBLE PRECISION PTAU(KDLON, 2, KFLEV) ! CLOUD OPTICAL THICKNESS
59     DOUBLE PRECISION PCG(KDLON, 2, KFLEV) ! ASYMETRY FACTOR
60     DOUBLE PRECISION POMEGA(KDLON, 2, KFLEV) ! SINGLE SCATTERING ALBEDO
61    
62     DOUBLE PRECISION PHEAT(KDLON, KFLEV) ! SHORTWAVE HEATING (K/DAY)
63     DOUBLE PRECISION PHEAT0(KDLON, KFLEV)! SHORTWAVE HEATING (K/DAY) clear-sky
64     DOUBLE PRECISION PALBPLA(KDLON) ! PLANETARY ALBEDO
65     DOUBLE PRECISION PTOPSW(KDLON) ! SHORTWAVE FLUX AT T.O.A.
66     DOUBLE PRECISION PSOLSW(KDLON) ! SHORTWAVE FLUX AT SURFACE
67     DOUBLE PRECISION PTOPSW0(KDLON) ! SHORTWAVE FLUX AT T.O.A. (CLEAR-SKY)
68     DOUBLE PRECISION PSOLSW0(KDLON) ! SHORTWAVE FLUX AT SURFACE (CLEAR-SKY)
69    
70     ! LOCAL VARIABLES:
71    
72     DOUBLE PRECISION ZOZ(KDLON, KFLEV)
73     DOUBLE PRECISION ZAKI(KDLON, 2)
74     DOUBLE PRECISION ZCLD(KDLON, KFLEV)
75     DOUBLE PRECISION ZCLEAR(KDLON)
76     DOUBLE PRECISION ZDSIG(KDLON, KFLEV)
77     DOUBLE PRECISION ZFACT(KDLON)
78     DOUBLE PRECISION ZFD(KDLON, KFLEV+1)
79     DOUBLE PRECISION ZFDOWN(KDLON, KFLEV+1)
80     DOUBLE PRECISION ZFU(KDLON, KFLEV+1)
81     DOUBLE PRECISION ZFUP(KDLON, KFLEV+1)
82     DOUBLE PRECISION ZRMU(KDLON)
83     DOUBLE PRECISION ZSEC(KDLON)
84     DOUBLE PRECISION ZUD(KDLON, 5, KFLEV+1)
85     DOUBLE PRECISION ZCLDSW0(KDLON, KFLEV)
86    
87     DOUBLE PRECISION ZFSUP(KDLON, KFLEV+1)
88     DOUBLE PRECISION ZFSDN(KDLON, KFLEV+1)
89     DOUBLE PRECISION ZFSUP0(KDLON, KFLEV+1)
90     DOUBLE PRECISION ZFSDN0(KDLON, KFLEV+1)
91    
92     INTEGER inu, jl, jk, i, k, kpl1
93    
94 guez 72 INTEGER, PARAMETER:: swpas = 1 ! Every swpas steps, sw is calculated
95 guez 53
96 guez 72 INTEGER:: itapsw = 0
97     LOGICAL:: appel1er = .TRUE.
98 guez 53 !jq-Introduced for aerosol forcings
99 guez 72 double precision, save:: flag_aer
100 guez 62 logical, intent(in):: ok_ade, ok_aie ! use aerosol forcings or not?
101 guez 53 double precision tauae(kdlon, kflev, 2) ! aerosol optical properties
102     double precision pizae(kdlon, kflev, 2)
103     ! aerosol optical properties(see aeropt.F)
104    
105     double precision cgae(kdlon, kflev, 2) !aerosol optical properties -"-
106     DOUBLE PRECISION PTAUA(KDLON, 2, KFLEV)
107     ! CLOUD OPTICAL THICKNESS (pre-industrial value)
108    
109     DOUBLE PRECISION POMEGAA(KDLON, 2, KFLEV) ! SINGLE SCATTERING ALBEDO
110     DOUBLE PRECISION PTOPSWAD(KDLON)
111     ! (diagnosed aerosol forcing)SHORTWAVE FLUX AT T.O.A.(+AEROSOL DIR)
112    
113     DOUBLE PRECISION PSOLSWAD(KDLON)
114     ! (diagnosed aerosol forcing)SHORTWAVE FLUX AT SURFACE(+AEROSOL DIR)
115    
116     DOUBLE PRECISION PTOPSWAI(KDLON)
117     ! (diagnosed aerosol forcing)SHORTWAVE FLUX AT T.O.A.(+AEROSOL IND)
118    
119     DOUBLE PRECISION PSOLSWAI(KDLON)
120     ! (diagnosed aerosol forcing)SHORTWAVE FLUX AT SURFACE(+AEROSOL IND)
121    
122     !jq - Fluxes including aerosol effects
123 guez 72 DOUBLE PRECISION, save:: ZFSUPAD(KDLON, KFLEV+1)
124     DOUBLE PRECISION, save:: ZFSDNAD(KDLON, KFLEV+1)
125     DOUBLE PRECISION, save:: ZFSUPAI(KDLON, KFLEV+1)
126     DOUBLE PRECISION, save:: ZFSDNAI(KDLON, KFLEV+1)
127 guez 53
128 guez 72 logical:: initialized = .false.
129 guez 118 REAL, PARAMETER :: dobson_u = 2.1415E-05 ! Dobson unit, in kg m-2
130 guez 72
131 guez 53 !-------------------------------------------------------------------
132    
133     if(.not.initialized) then
134     flag_aer=0.
135     initialized=.TRUE.
136 guez 72 ZFSUPAD = 0.
137     ZFSDNAD = 0.
138     ZFSUPAI = 0.
139     ZFSDNAI = 0.
140 guez 53 endif
141     !rv
142    
143     IF (appel1er) THEN
144     PRINT*, 'SW calling frequency: ', swpas
145     PRINT*, " In general, it should be 1"
146     appel1er = .FALSE.
147     ENDIF
148    
149     IF (MOD(itapsw, swpas).EQ.0) THEN
150     DO JK = 1 , KFLEV
151     DO JL = 1, KDLON
152     ZCLDSW0(JL, JK) = 0.0
153 guez 118 ZOZ(JL, JK) = POZON(JL, JK) / (dobson_u * 1E3 * rg) * PDP(JL, JK)
154 guez 53 ENDDO
155     ENDDO
156    
157     ! clear-sky:
158     CALL SWU(PSCT, ZCLDSW0, PPMB, PPSOL, &
159     PRMU0, PFRAC, PTAVE, PWV, &
160     ZAKI, ZCLD, ZCLEAR, ZDSIG, ZFACT, ZRMU, ZSEC, ZUD)
161     INU = 1
162     CALL SW1S(INU, &
163     PAER, flag_aer, tauae, pizae, cgae, &
164     PALBD, PALBP, PCG, ZCLD, ZCLEAR, ZCLDSW0, &
165     ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD, &
166     ZFD, ZFU)
167     INU = 2
168     CALL SW2S(INU, &
169     PAER, flag_aer, tauae, pizae, cgae, &
170     ZAKI, PALBD, PALBP, PCG, ZCLD, ZCLEAR, ZCLDSW0, &
171     ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD, &
172     PWV, PQS, &
173     ZFDOWN, ZFUP)
174     DO JK = 1 , KFLEV+1
175     DO JL = 1, KDLON
176     ZFSUP0(JL, JK) = (ZFUP(JL, JK) + ZFU(JL, JK)) * ZFACT(JL)
177     ZFSDN0(JL, JK) = (ZFDOWN(JL, JK) + ZFD(JL, JK)) * ZFACT(JL)
178     ENDDO
179     ENDDO
180    
181 guez 62 flag_aer=0.
182 guez 53 CALL SWU(PSCT, PCLDSW, PPMB, PPSOL, &
183     PRMU0, PFRAC, PTAVE, PWV, &
184     ZAKI, ZCLD, ZCLEAR, ZDSIG, ZFACT, ZRMU, ZSEC, ZUD)
185     INU = 1
186     CALL SW1S(INU, &
187     PAER, flag_aer, tauae, pizae, cgae, &
188     PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW, &
189     ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD, &
190     ZFD, ZFU)
191     INU = 2
192     CALL SW2S(INU, &
193     PAER, flag_aer, tauae, pizae, cgae, &
194     ZAKI, PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW, &
195     ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD, &
196     PWV, PQS, &
197     ZFDOWN, ZFUP)
198    
199     ! cloudy-sky:
200    
201     DO JK = 1 , KFLEV+1
202     DO JL = 1, KDLON
203     ZFSUP(JL, JK) = (ZFUP(JL, JK) + ZFU(JL, JK)) * ZFACT(JL)
204     ZFSDN(JL, JK) = (ZFDOWN(JL, JK) + ZFD(JL, JK)) * ZFACT(JL)
205     ENDDO
206     ENDDO
207    
208     IF (ok_ade) THEN
209     ! cloudy-sky + aerosol dir OB
210 guez 62 flag_aer=1.
211 guez 53 CALL SWU(PSCT, PCLDSW, PPMB, PPSOL, &
212     PRMU0, PFRAC, PTAVE, PWV, &
213     ZAKI, ZCLD, ZCLEAR, ZDSIG, ZFACT, ZRMU, ZSEC, ZUD)
214     INU = 1
215     CALL SW1S(INU, &
216     PAER, flag_aer, tauae, pizae, cgae, &
217     PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW, &
218     ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD, &
219     ZFD, ZFU)
220     INU = 2
221     CALL SW2S(INU, &
222     PAER, flag_aer, tauae, pizae, cgae, &
223     ZAKI, PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW, &
224     ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD, &
225     PWV, PQS, &
226     ZFDOWN, ZFUP)
227     DO JK = 1 , KFLEV+1
228     DO JL = 1, KDLON
229     ZFSUPAD(JL, JK) = ZFSUP(JL, JK)
230     ZFSDNAD(JL, JK) = ZFSDN(JL, JK)
231     ZFSUP(JL, JK) = (ZFUP(JL, JK) + ZFU(JL, JK)) * ZFACT(JL)
232     ZFSDN(JL, JK) = (ZFDOWN(JL, JK) + ZFD(JL, JK)) * ZFACT(JL)
233     ENDDO
234     ENDDO
235     ENDIF
236    
237     IF (ok_aie) THEN
238     !jq cloudy-sky + aerosol direct + aerosol indirect
239     flag_aer=1.0
240     CALL SWU(PSCT, PCLDSW, PPMB, PPSOL, &
241     PRMU0, PFRAC, PTAVE, PWV, &
242     ZAKI, ZCLD, ZCLEAR, ZDSIG, ZFACT, ZRMU, ZSEC, ZUD)
243     INU = 1
244     CALL SW1S(INU, &
245     PAER, flag_aer, tauae, pizae, cgae, &
246     PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW, &
247     ZDSIG, POMEGAA, ZOZ, ZRMU, ZSEC, PTAUA, ZUD, &
248     ZFD, ZFU)
249     INU = 2
250     CALL SW2S(INU, &
251     PAER, flag_aer, tauae, pizae, cgae, &
252     ZAKI, PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW, &
253     ZDSIG, POMEGAA, ZOZ, ZRMU, ZSEC, PTAUA, ZUD, &
254     PWV, PQS, &
255     ZFDOWN, ZFUP)
256     DO JK = 1 , KFLEV+1
257     DO JL = 1, KDLON
258     ZFSUPAI(JL, JK) = ZFSUP(JL, JK)
259     ZFSDNAI(JL, JK) = ZFSDN(JL, JK)
260     ZFSUP(JL, JK) = (ZFUP(JL, JK) + ZFU(JL, JK)) * ZFACT(JL)
261     ZFSDN(JL, JK) = (ZFDOWN(JL, JK) + ZFD(JL, JK)) * ZFACT(JL)
262     ENDDO
263     ENDDO
264     ENDIF
265    
266     itapsw = 0
267     ENDIF
268     itapsw = itapsw + 1
269    
270     DO k = 1, KFLEV
271     kpl1 = k+1
272     DO i = 1, KDLON
273     PHEAT(i, k) = -(ZFSUP(i, kpl1)-ZFSUP(i, k)) &
274     -(ZFSDN(i, k)-ZFSDN(i, kpl1))
275     PHEAT(i, k) = PHEAT(i, k) * RDAY*RG/RCPD / PDP(i, k)
276     PHEAT0(i, k) = -(ZFSUP0(i, kpl1)-ZFSUP0(i, k)) &
277     -(ZFSDN0(i, k)-ZFSDN0(i, kpl1))
278     PHEAT0(i, k) = PHEAT0(i, k) * RDAY*RG/RCPD / PDP(i, k)
279     ENDDO
280     ENDDO
281     DO i = 1, KDLON
282     PALBPLA(i) = ZFSUP(i, KFLEV+1)/(ZFSDN(i, KFLEV+1)+1.0e-20)
283    
284     PSOLSW(i) = ZFSDN(i, 1) - ZFSUP(i, 1)
285     PTOPSW(i) = ZFSDN(i, KFLEV+1) - ZFSUP(i, KFLEV+1)
286    
287     PSOLSW0(i) = ZFSDN0(i, 1) - ZFSUP0(i, 1)
288     PTOPSW0(i) = ZFSDN0(i, KFLEV+1) - ZFSUP0(i, KFLEV+1)
289    
290     PSOLSWAD(i) = ZFSDNAD(i, 1) - ZFSUPAD(i, 1)
291     PTOPSWAD(i) = ZFSDNAD(i, KFLEV+1) - ZFSUPAD(i, KFLEV+1)
292    
293     PSOLSWAI(i) = ZFSDNAI(i, 1) - ZFSUPAI(i, 1)
294     PTOPSWAI(i) = ZFSDNAI(i, KFLEV+1) - ZFSUPAI(i, KFLEV+1)
295     ENDDO
296    
297     END SUBROUTINE SW
298    
299     end module sw_m
  ViewVC Help
Powered by ViewVC 1.1.21