source: LMDZ5/trunk/libf/phylmd/rrtm/aeropt_5wv_rrtm.F90 @ 2004

Last change on this file since 2004 was 2004, checked in by Laurent Fairhead, 10 years ago

Nouvelle version qui inclut les effets des aérosols et propose les mêmes diagnostics des effets directs
et indirects que l'ancienne version du rayonnement.
OB

New RRTM version that includes the effects of aerosols and outputs the same direct and indirect effects
diagnostics as the old version
OB
File size: 14.4 KB
Line 
1!
2! $Id: aeropt_5wv.F90 1716 2013-01-22 13:36:30Z acozic $
3!
4
5SUBROUTINE AEROPT_5WV_RRTM(&
6   pdel, m_allaer, delt, &
7   RHcl, ai, flag_aerosol, &
8   pplay, t_seri, &
9   tausum, tau )
10
11  USE DIMPHY
12  USE aero_mod
13  USE phys_local_var_mod, only: od550aer,od865aer,ec550aer,od550lt1aer
14
15  !
16  !    Yves Balkanski le 12 avril 2006
17  !    Celine Deandreis
18  !    Anne Cozic  Avril 2009
19  !    a partir d'une sous-routine de Johannes Quaas pour les sulfates
20  !    Olivier Boucher mars 2014 pour adaptation RRTM
21  !
22  ! Refractive indices for seasalt come from Shettle and Fenn (1979)
23  !
24  ! Refractive indices from water come from Hale and Querry (1973)
25  !
26  ! Refractive indices from Ammonium Sulfate Toon and Pollack (1976)
27  !
28  ! Refractive indices for Dust, internal mixture of minerals coated with 1.5% hematite
29  ! by Volume (Balkanski et al., 2006)
30  !
31  ! Refractive indices for POM: Kinne (pers. Communication
32  !
33  ! Refractive index for BC from Shettle and Fenn (1979)
34  !
35  ! Shettle, E. P., & Fenn, R. W. (1979), Models for the aerosols of the lower atmosphere and
36  ! the effects of humidity variations on their optical properties, U.S. Air Force Geophysics
37  ! Laboratory Rept. AFGL-TR-79-0214, Hanscomb Air Force Base, MA.
38  !
39  ! Hale, G. M. and M. R. Querry, Optical constants of water in the 200-nm to 200-m
40  ! wavelength region, Appl. Opt., 12, 555-563, 1973.
41  !
42  ! Toon, O. B. and J. B. Pollack, The optical constants of several atmospheric aerosol species:
43  ! Ammonium sulfate, aluminum oxide, and sodium chloride, J. Geohys. Res., 81, 5733-5748,
44  ! 1976.
45  !
46  ! Balkanski, Y., M. Schulz, T. Claquin And O. Boucher, Reevaluation of mineral aerosol
47  ! radiative forcings suggests a better agreement with satellite and AERONET data, Atmospheric
48  ! Chemistry and Physics Discussions., 6, pp 8383-8419, 2006.
49  !
50  IMPLICIT NONE
51  INCLUDE "YOMCST.h"
52  !
53  ! Input arguments:
54  !
55  REAL, DIMENSION(klon,klev), INTENT(in)   :: pdel
56  REAL, INTENT(in)                         :: delt
57  REAL, DIMENSION(klon,klev,naero_spc), INTENT(in) :: m_allaer
58  REAL, DIMENSION(klon,klev), INTENT(in)   :: RHcl     ! humidite relative ciel clair
59  INTEGER,INTENT(in)                       :: flag_aerosol
60  REAL, DIMENSION(klon,klev), INTENT(in)   :: pplay
61  REAL, DIMENSION(klon,klev), INTENT(in)   :: t_seri
62  !
63  ! Output arguments:
64  !
65  REAL, DIMENSION(klon), INTENT(out)                      :: ai      ! POLDER aerosol index
66  REAL, DIMENSION(klon,nwave,naero_tot), INTENT(out)      :: tausum
67  REAL, DIMENSION(klon,klev,nwave,naero_tot), INTENT(out) :: tau
68
69  !
70  ! Local
71  !
72  INTEGER, PARAMETER :: las = nwave
73  LOGICAL :: soluble
74 
75  INTEGER :: i, k, m
76  INTEGER :: spsol, spinsol, la
77  INTEGER :: RH_num(klon,klev)
78  INTEGER, PARAMETER :: la443 = 1
79  INTEGER, PARAMETER :: la550 = 2
80  INTEGER, PARAMETER :: la670 = 3
81  INTEGER, PARAMETER :: la765 = 4
82  INTEGER, PARAMETER :: la865 = 5
83  INTEGER, PARAMETER :: nbre_RH=12
84  INTEGER, PARAMETER :: naero_soluble=7   !  1- BC soluble; 2- POM soluble; 3- SO4 acc.
85                                          !  4- SO4 coarse; 5 seasalt super-C; 6 seasalt coarse; 7 seasalt acc.
86  INTEGER, PARAMETER :: naero_insoluble=3 !  1- Dust; 2- BC insoluble; 3- POM insoluble
87
88  REAL :: zrho
89
90  REAL, PARAMETER :: RH_tab(nbre_RH)=(/0.,10.,20.,30.,40.,50.,60.,70.,80.,85.,90.,95./)
91  REAL, PARAMETER :: RH_MAX=95.
92  REAL :: delta(klon,klev), rh(klon,klev)
93  REAL :: tau_ae5wv_int   ! Intermediate computation of epaisseur optique aerosol
94  REAL :: od670aer(klon)  ! epaisseur optique aerosol extinction 670 nm
95  REAL :: fac
96  REAL :: zdp1(klon,klev)
97  INTEGER, ALLOCATABLE, DIMENSION(:)  :: aerosol_name
98  INTEGER :: nb_aer
99 
100  REAL :: dh(KLON,KLEV)
101 
102   ! Soluble components 1- BC soluble; 2- POM soluble; 3- SO4 acc.; 4- SO4 coarse; 5 seasalt super-coarse; 6 seasalt coarse; 7 seasalt acc.
103  REAL :: alpha_aers_5wv(nbre_RH,las,naero_soluble)   ! Ext. coeff. ** m2/g
104   ! Insoluble components 1- Dust: 2- BC; 3- POM
105  REAL :: alpha_aeri_5wv(las,naero_insoluble)         ! Ext. coeff. ** m2/g
106
107  REAL, DIMENSION(klon,klev,naero_spc) :: mass_temp
108 
109  !
110  ! Proprietes optiques
111  !
112  REAL :: fact_RH(nbre_RH)
113  LOGICAL :: used_tau(naero_tot)
114  INTEGER :: n
115 
116! From here on we look at the optical parameters at 5 wavelengths: 
117! 443nm, 550, 670, 765 and 865 nm
118!                                   le 12 AVRIL 2006
119! 
120 DATA alpha_aers_5wv/ &
121                                ! bc soluble
122       7.930,7.930,7.930,7.930,7.930,7.930,     &
123       7.930,7.930,10.893,12.618,14.550,16.613, &
124       7.658,7.658,7.658,7.658,7.658,7.658,     &
125       7.658,7.658,10.351,11.879,13.642,15.510, &
126       7.195,7.195,7.195,7.195,7.195,7.195,     &
127       7.195,7.195,9.551,10.847,12.381,13.994,  &
128       6.736,6.736,6.736,6.736,6.736,6.736,     &
129       6.736,6.736,8.818,9.938,11.283,12.687,   &
130       6.277,6.277,6.277,6.277,6.277,6.277,     &
131       6.277,6.277,8.123,9.094,10.275,11.501,   &
132                                ! pom soluble
133       6.676,6.676,6.676,6.676,6.710,6.934,   &
134       7.141,7.569,8.034,8.529,9.456,10.511,  &
135       5.109,5.109,5.109,5.109,5.189,5.535,   &
136       5.960,6.852,8.008,9.712,12.897,19.676, &
137       3.718,3.718,3.718,3.718,3.779,4.042,   &
138       4.364,5.052,5.956,7.314,9.896,15.688,  &
139       2.849,2.849,2.849,2.849,2.897,3.107,   &
140       3.365,3.916,4.649,5.760,7.900,12.863,  &
141       2.229,2.229,2.229,2.229,2.268,2.437,   &
142       2.645,3.095,3.692,4.608,6.391,10.633,  &
143                                ! Sulfate (Accumulation)
144       5.751,6.215,6.690,7.024,7.599,8.195,      &
145       9.156,10.355,12.660,14.823,18.908,24.508, &
146       4.320,4.675,5.052,5.375,5.787,6.274,      &
147       7.066,8.083,10.088,12.003,15.697,21.133,  &
148       3.079,3.351,3.639,3.886,4.205,4.584,      &
149       5.206,6.019,7.648,9.234,12.391,17.220,    &
150       2.336,2.552,2.781,2.979,3.236,3.540,      &
151       4.046,4.711,6.056,7.388,10.093,14.313,    &
152       1.777,1.949,2.134,2.292,2.503,2.751,      &
153       3.166,3.712,4.828,5.949,8.264,11.922,     &
154                                ! Sulfate (Coarse)
155       5.751,6.215,6.690,7.024,7.599,8.195,      &
156       9.156,10.355,12.660,14.823,18.908,24.508, &
157       4.320,4.675,5.052,5.375,5.787,6.274,      &
158       7.066,8.083,10.088,12.003,15.697,21.133,  &
159       3.079,3.351,3.639,3.886,4.205,4.584,      &
160       5.206,6.019,7.648,9.234,12.391,17.220,    &
161       2.336,2.552,2.781,2.979,3.236,3.540,      &
162       4.046,4.711,6.056,7.388,10.093,14.313,    &
163       1.777,1.949,2.134,2.292,2.503,2.751,      &
164       3.166,3.712,4.828,5.949,8.264,11.922,     &
165                           ! seasalt seasalt Super Coarse Soluble (SS)
166        0.218, 0.240, 0.262, 0.311, 0.391, 0.452, &
167        0.544, 0.614, 0.886, 1.018, 1.260, 2.336, &
168        0.221, 0.243, 0.266, 0.315, 0.396, 0.455, &
169        0.551, 0.622, 0.896, 1.029, 1.270, 2.352, &
170        0.224, 0.246, 0.270, 0.319, 0.400, 0.461, &
171        0.558, 0.626, 0.904, 1.039, 1.278, 2.362, &
172        0.227, 0.249, 0.272, 0.322, 0.404, 0.466, &
173        0.560, 0.632, 0.907, 1.041, 1.284, 2.375, &
174        0.230, 0.252, 0.276, 0.325, 0.408, 0.469, &
175        0.567, 0.636, 0.917, 1.052, 1.293, 2.383, &
176                           ! seasalt seasalt Coarse Soluble (CS)     
177        0.578, 0.632, 0.691, 0.814, 1.017, 1.171, &
178        1.407, 1.585, 2.264, 2.594, 3.197, 5.882, &
179        0.598, 0.654, 0.711, 0.836, 1.041, 1.201, &
180        1.445, 1.622, 2.313, 2.647, 3.256, 5.961, &
181        0.619, 0.676, 0.736, 0.862, 1.072, 1.234, &
182        1.484, 1.659, 2.361, 2.698, 3.304, 6.014, &
183        0.633, 0.692, 0.754, 0.884, 1.095, 1.262, &
184        1.510, 1.693, 2.395, 2.734, 3.352, 6.090, &
185        0.648, 0.708, 0.771, 0.902, 1.119, 1.288, &
186        1.545, 1.725, 2.441, 2.784, 3.402, 6.144, &
187                           ! seasalt seasalt Accumulation Soluble (AS)
188        4.432, 5.160, 5.940, 7.646,10.520,11.464, &
189       14.686,16.949,25.977,30.118,37.327,65.333, &
190        3.298, 3.916, 4.594, 6.127, 8.845, 9.446, &
191       12.511,14.710,24.073,28.546,36.578,69.050, &
192        2.340, 2.826, 3.371, 4.638, 6.992, 7.360, &
193       10.047,12.016,20.909,25.349,33.605,69.554, &
194        1.789, 2.185, 2.633, 3.698, 5.733, 5.994, &
195        8.345,10.094,18.293,22.511,30.548,67.717, &
196        1.359, 1.676, 2.040, 2.916, 4.637, 4.829, &
197        6.843, 8.364,15.723,19.614,27.195,64.359 /
198
199  DATA alpha_aeri_5wv/ &
200                                 ! dust insoluble
201        0.759, 0.770, 0.775, 0.775, 0.772, &
202                                 !!jb bc insoluble
203        11.536,10.033, 8.422, 7.234, 6.270, &
204                                 ! pom insoluble
205        5.042, 3.101, 1.890, 1.294, 0.934/
206  !
207  ! Initialisations
208  ai(:) = 0.
209  tausum(:,:,:) = 0.
210
211  DO k=1, klev
212    DO i=1, klon
213      zrho=pplay(i,k)/t_seri(i,k)/RD                  ! kg/m3
214      dh(i,k)=pdel(i,k)/(RG*zrho)
215!CDIR UNROLL=naero_spc
216      mass_temp(i,k,:) = m_allaer(i,k,:) / zrho / 1.e+9
217      zdp1(i,k)=pdel(i,k)/(RG*delt)     ! air mass auxiliary  variable --> zdp1 [kg/(m^2 *s)]
218    ENDDO
219  ENDDO
220
221  IF (flag_aerosol .EQ. 1) THEN
222     nb_aer = 2
223     ALLOCATE (aerosol_name(nb_aer))
224     aerosol_name(1) = id_ASSO4M
225     aerosol_name(2) = id_CSSO4M
226  ELSEIF (flag_aerosol .EQ. 2) THEN
227     nb_aer = 2
228     ALLOCATE (aerosol_name(nb_aer))
229     aerosol_name(1) = id_ASBCM
230     aerosol_name(2) = id_AIBCM
231  ELSEIF (flag_aerosol .EQ. 3) THEN
232     nb_aer = 2
233     ALLOCATE (aerosol_name(nb_aer))
234     aerosol_name(1) = id_ASPOMM
235     aerosol_name(2) = id_AIPOMM
236  ELSEIF (flag_aerosol .EQ. 4) THEN
237     nb_aer = 3
238     ALLOCATE (aerosol_name(nb_aer))
239     aerosol_name(1) = id_CSSSM
240     aerosol_name(2) = id_SSSSM
241     aerosol_name(3) = id_ASSSM
242  ELSEIF (flag_aerosol .EQ. 5) THEN
243     nb_aer = 1
244     ALLOCATE (aerosol_name(nb_aer))
245     aerosol_name(1) = id_CIDUSTM
246  ELSEIF (flag_aerosol .EQ. 6) THEN
247     nb_aer = 10
248     ALLOCATE (aerosol_name(nb_aer))
249     aerosol_name(1) = id_ASSO4M     
250     aerosol_name(2) = id_ASBCM
251     aerosol_name(3) = id_AIBCM
252     aerosol_name(4) = id_ASPOMM
253     aerosol_name(5) = id_AIPOMM
254     aerosol_name(6) = id_CSSSM
255     aerosol_name(7) = id_SSSSM
256     aerosol_name(8) = id_ASSSM
257     aerosol_name(9) = id_CIDUSTM
258     aerosol_name(10) = id_CSSO4M
259  ENDIF
260
261  !
262  ! Loop over modes, use of precalculated nmd and corresponding sigma
263  !    loop over wavelengths
264  !    for each mass species in mode
265  !      interpolate from Sext to retrieve Sext_at_gridpoint_per_species
266  !      compute optical_thickness_at_gridpoint_per_species
267  !
268  ! Calculations that need to be done since we are not in the subroutines INCA
269  !     
270
271!CDIR ON_ADB(RH_tab)
272!CDIR ON_ADB(fact_RH)
273!CDIR NOVECTOR
274  DO n=1,nbre_RH-1
275    fact_RH(n)=1./(RH_tab(n+1)-RH_tab(n))
276  ENDDO
277   
278  DO k=1, KLEV
279!CDIR ON_ADB(RH_tab)
280!CDIR ON_ADB(fact_RH)
281    DO i=1, KLON
282      rh(i,k)=MIN(RHcl(i,k)*100.,RH_MAX)
283      RH_num(i,k) = INT( rh(i,k)/10. + 1.)
284      IF (rh(i,k).GT.85.) RH_num(i,k)=10
285      IF (rh(i,k).GT.90.) RH_num(i,k)=11
286      delta(i,k)=(rh(i,k)-RH_tab(RH_num(i,k)))*fact_RH(RH_num(i,k))
287    ENDDO
288  ENDDO
289
290!CDIR SHORTLOOP 
291  used_tau(:)=.FALSE.
292   
293  DO m=1,nb_aer   ! tau is only computed for each mass   
294    fac=1.0
295    IF (aerosol_name(m).EQ.id_ASBCM) THEN
296        soluble=.TRUE.
297        spsol=1
298    ELSEIF (aerosol_name(m).EQ.id_ASPOMM) THEN
299        soluble=.TRUE.
300        spsol=2
301    ELSEIF (aerosol_name(m).EQ.id_ASSO4M) THEN
302        soluble=.TRUE.
303        spsol=3
304        fac=1.375    ! (NH4)2-SO4/SO4 132/96 mass conversion factor for OD
305    ELSEIF (aerosol_name(m).EQ.id_CSSO4M) THEN
306        soluble=.TRUE.
307        spsol=4
308        fac=1.375    ! (NH4)2-SO4/SO4 132/96 mass conversion factor for OD
309    ELSEIF (aerosol_name(m).EQ.id_SSSSM) THEN
310        soluble=.TRUE.
311        spsol=5
312    ELSEIF (aerosol_name(m).EQ.id_CSSSM) THEN
313        soluble=.TRUE.
314        spsol=6
315    ELSEIF (aerosol_name(m).EQ.id_ASSSM) THEN
316        soluble=.TRUE.
317        spsol=7
318    ELSEIF (aerosol_name(m).EQ.id_CIDUSTM) THEN
319        soluble=.FALSE.
320        spinsol=1
321    ELSEIF  (aerosol_name(m).EQ.id_AIBCM) THEN
322        soluble=.FALSE.
323        spinsol=2
324    ELSEIF (aerosol_name(m).EQ.id_AIPOMM) THEN
325        soluble=.FALSE.
326        spinsol=3
327    ELSE
328        CYCLE
329    ENDIF
330
331    IF (soluble) then
332      used_tau(spsol)=.TRUE.
333    ELSE
334      used_tau(naero_soluble+spinsol)=.TRUE.
335    ENDIF
336
337    DO la=1,las
338
339      IF (soluble) THEN            ! For soluble aerosol
340
341          DO k=1, KLEV
342            DO i=1, KLON
343              tau_ae5wv_int = alpha_aers_5wv(RH_num(i,k),la,spsol)+DELTA(i,k)* &
344                             (alpha_aers_5wv(RH_num(i,k)+1,la,spsol) - &
345                              alpha_aers_5wv(RH_num(i,k),la,spsol))
346              tau(i,k,la,spsol) = mass_temp(i,k,spsol)*1000.*zdp1(i,k)   &
347                                 *tau_ae5wv_int*delt*fac
348              tausum(i,la,spsol)=tausum(i,la,spsol)+tau(i,k,la,spsol)
349            ENDDO
350          ENDDO
351
352      ELSE                         ! For insoluble aerosol
353
354        DO k=1, KLEV
355          DO i=1, KLON
356            tau_ae5wv_int = alpha_aeri_5wv(la,spinsol)
357            tau(i,k,la,naero_soluble+spinsol) = mass_temp(i,k,naero_soluble+spinsol)*1000.*zdp1(i,k)* &
358                                                tau_ae5wv_int*delt*fac
359            tausum(i,la,naero_soluble+spinsol)= tausum(i,la,naero_soluble+spinsol)  &
360                                               +tau(i,k,la,naero_soluble+spinsol)
361          ENDDO
362        ENDDO
363
364      ENDIF
365
366    ENDDO   ! Boucle sur les longueurs d'onde
367  ENDDO     ! Boucle sur les masses de traceurs
368
369  DO m=1,naero_tot
370    IF (.NOT.used_tau(m)) tau(:,:,:,m)=0.
371  ENDDO 
372
373  DO i=1, klon
374     od550aer(i)=0.
375     DO m=1,naero_tot
376        od550aer(i)=od550aer(i)+tausum(i,la550,m)
377     END DO
378  END DO
379
380  DO i=1, klon
381     od670aer(i)=0.
382     DO m=1,naero_tot
383        od670aer(i)=od670aer(i)+tausum(i,la670,m)
384     END DO
385  END DO
386
387  DO i=1, klon
388     od865aer(i)=0.
389     DO m=1,naero_tot
390        od865aer(i)=od865aer(i)+tausum(i,la865,m)
391     END DO
392  END DO
393
394  DO i=1, klon
395     DO k=1, KLEV
396        ec550aer(i,k)=0.
397        DO m=1,naero_tot
398           ec550aer(i,k)=ec550aer(i,k)+tau(i,k,la550,m)/dh(i,k)
399        END DO
400     END DO
401  END DO
402 
403  DO i=1, klon
404    ai(i)=-LOG(MAX(od670aer(i),1.e-8)/MAX(od865aer(i),1.e-8))/LOG(670./865.)
405  ENDDO
406
407  od550lt1aer(:)=tausum(:,la550,id_ASSO4M)+tausum(:,la550,id_ASBCM) +tausum(:,la550,id_AIBCM)+ &
408                 tausum(:,la550,id_ASPOMM)+tausum(:,la550,id_AIPOMM)+tausum(:,la550,id_ASSSM)+ &
409                 0.03*tausum(:,la550,id_CSSSM)+0.4*tausum(:,la550,id_CIDUSTM)
410
411  DEALLOCATE(aerosol_name)
412 
413END SUBROUTINE AEROPT_5WV_RRTM
Note: See TracBrowser for help on using the repository browser.