LMDZ
aeropt_5wv_rrtm.F90
Go to the documentation of this file.
1 !
2 ! $Id: aeropt_5wv_rrtm.F90 2215 2015-02-23 16:21:29Z oboucher $
3 !
4 
5 SUBROUTINE 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
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_tot), 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, aerindex
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, itau
99  LOGICAL :: ok_itau
100 
101  REAL :: dh(klon,klev)
102 
103  ! Soluble components 1- BC soluble; 2- POM soluble; 3- SO4 acc.; 4- SO4 coarse; 5 seasalt super-coarse; 6 seasalt coarse; 7 seasalt acc.
104  REAL :: alpha_aers_5wv(nbre_rh,las,naero_soluble) ! Ext. coeff. ** m2/g
105  ! Insoluble components 1- Dust: 2- BC; 3- POM
106  REAL :: alpha_aeri_5wv(las,naero_insoluble) ! Ext. coeff. ** m2/g
107 
108  REAL, DIMENSION(klon,klev,naero_tot) :: mass_temp
109 
110  !
111  ! Proprietes optiques
112  !
113  REAL :: fact_RH(nbre_rh)
114  LOGICAL :: used_tau(naero_tot)
115  INTEGER :: n
116 
117 ! From here on we look at the optical parameters at 5 wavelengths:
118 ! 443nm, 550, 670, 765 and 865 nm
119 ! le 12 AVRIL 2006
120 !
121  DATA alpha_aers_5wv/ &
122  ! bc soluble
123  7.930,7.930,7.930,7.930,7.930,7.930, &
124  7.930,7.930,10.893,12.618,14.550,16.613, &
125  7.658,7.658,7.658,7.658,7.658,7.658, &
126  7.658,7.658,10.351,11.879,13.642,15.510, &
127  7.195,7.195,7.195,7.195,7.195,7.195, &
128  7.195,7.195,9.551,10.847,12.381,13.994, &
129  6.736,6.736,6.736,6.736,6.736,6.736, &
130  6.736,6.736,8.818,9.938,11.283,12.687, &
131  6.277,6.277,6.277,6.277,6.277,6.277, &
132  6.277,6.277,8.123,9.094,10.275,11.501, &
133  ! pom soluble
134  6.676,6.676,6.676,6.676,6.710,6.934, &
135  7.141,7.569,8.034,8.529,9.456,10.511, &
136  5.109,5.109,5.109,5.109,5.189,5.535, &
137  5.960,6.852,8.008,9.712,12.897,19.676, &
138  3.718,3.718,3.718,3.718,3.779,4.042, &
139  4.364,5.052,5.956,7.314,9.896,15.688, &
140  2.849,2.849,2.849,2.849,2.897,3.107, &
141  3.365,3.916,4.649,5.760,7.900,12.863, &
142  2.229,2.229,2.229,2.229,2.268,2.437, &
143  2.645,3.095,3.692,4.608,6.391,10.633, &
144  ! Sulfate (Accumulation)
145  5.751,6.215,6.690,7.024,7.599,8.195, &
146  9.156,10.355,12.660,14.823,18.908,24.508, &
147  4.320,4.675,5.052,5.375,5.787,6.274, &
148  7.066,8.083,10.088,12.003,15.697,21.133, &
149  3.079,3.351,3.639,3.886,4.205,4.584, &
150  5.206,6.019,7.648,9.234,12.391,17.220, &
151  2.336,2.552,2.781,2.979,3.236,3.540, &
152  4.046,4.711,6.056,7.388,10.093,14.313, &
153  1.777,1.949,2.134,2.292,2.503,2.751, &
154  3.166,3.712,4.828,5.949,8.264,11.922, &
155  ! Sulfate (Coarse)
156  5.751,6.215,6.690,7.024,7.599,8.195, &
157  9.156,10.355,12.660,14.823,18.908,24.508, &
158  4.320,4.675,5.052,5.375,5.787,6.274, &
159  7.066,8.083,10.088,12.003,15.697,21.133, &
160  3.079,3.351,3.639,3.886,4.205,4.584, &
161  5.206,6.019,7.648,9.234,12.391,17.220, &
162  2.336,2.552,2.781,2.979,3.236,3.540, &
163  4.046,4.711,6.056,7.388,10.093,14.313, &
164  1.777,1.949,2.134,2.292,2.503,2.751, &
165  3.166,3.712,4.828,5.949,8.264,11.922, &
166  ! seasalt seasalt Super Coarse Soluble (SS)
167  0.218, 0.272, 0.293, 0.316, 0.343, 0.380, &
168  0.429, 0.501, 0.636, 0.755, 0.967, 1.495, &
169  0.221, 0.275, 0.297, 0.320, 0.348, 0.383, &
170  0.432, 0.509, 0.640, 0.759, 0.972, 1.510, &
171  0.224, 0.279, 0.301, 0.324, 0.352, 0.388, &
172  0.438, 0.514, 0.647, 0.768, 0.985, 1.514, &
173  0.227, 0.282, 0.303, 0.327, 0.356, 0.392, &
174  0.441, 0.518, 0.652, 0.770, 0.987, 1.529, &
175  0.230, 0.285, 0.306, 0.330, 0.359, 0.396, &
176  0.446, 0.522, 0.656, 0.777, 0.993, 1.539, &
177  ! seasalt seasalt Coarse Soluble (CS)
178  0.578, 0.706, 0.756, 0.809, 0.876, 0.964, &
179  1.081, 1.256, 1.577, 1.858, 2.366, 3.613, &
180  0.598, 0.725, 0.779, 0.833, 0.898, 0.990, &
181  1.109, 1.290, 1.609, 1.889, 2.398, 3.682, &
182  0.619, 0.750, 0.802, 0.857, 0.927, 1.022, &
183  1.141, 1.328, 1.648, 1.939, 2.455, 3.729, &
184  0.633, 0.767, 0.820, 0.879, 0.948, 1.044, &
185  1.167, 1.353, 1.683, 1.969, 2.491, 3.785, &
186  0.648, 0.785, 0.838, 0.896, 0.967, 1.066, &
187  1.192, 1.381, 1.714, 2.006, 2.531, 3.836, &
188  ! seasalt seasalt Accumulation Soluble (AS)
189  4.432, 5.899, 6.505, 7.166, 7.964, 7.962, &
190  9.232,11.257,14.979,18.337,24.223,37.811, &
191  3.298, 4.569, 5.110, 5.709, 6.446, 6.268, &
192  7.396, 9.246,12.787,16.113,22.197,37.136, &
193  2.340, 3.358, 3.803, 4.303, 4.928, 4.696, &
194  5.629, 7.198,10.308,13.342,19.120,34.296, &
195  1.789, 2.626, 2.999, 3.422, 3.955, 3.730, &
196  4.519, 5.864, 8.593,11.319,16.653,31.331, &
197  1.359, 2.037, 2.343, 2.693, 3.139, 2.940, &
198  3.596, 4.729, 7.076, 9.469,14.266,28.043 /
199 
200  DATA alpha_aeri_5wv/ &
201  ! dust insoluble
202  0.759, 0.770, 0.775, 0.775, 0.772, &
203  !!jb bc insoluble
204  11.536,10.033, 8.422, 7.234, 6.270, &
205  ! pom insoluble
206  5.042, 3.101, 1.890, 1.294, 0.934/
207  !
208  ! Initialisations
209  ai(:) = 0.
210  tausum(:,:,:) = 0.
211 
212  DO k=1, klev
213  DO i=1, klon
214  zrho=pplay(i,k)/t_seri(i,k)/rd ! kg/m3
215  dh(i,k)=pdel(i,k)/(rg*zrho)
216 !CDIR UNROLL=naero_spc
217  mass_temp(i,k,:) = m_allaer(i,k,:) / zrho / 1.e+9
218  zdp1(i,k)=pdel(i,k)/(rg*delt) ! air mass auxiliary variable --> zdp1 [kg/(m^2 *s)]
219  ENDDO
220  ENDDO
221 
222  IF (flag_aerosol .EQ. 1) THEN
223  nb_aer = 2
224  ALLOCATE (aerosol_name(nb_aer))
225  aerosol_name(1) = id_asso4m_phy
226  aerosol_name(2) = id_csso4m_phy
227  ELSEIF (flag_aerosol .EQ. 2) THEN
228  nb_aer = 2
229  ALLOCATE (aerosol_name(nb_aer))
230  aerosol_name(1) = id_asbcm_phy
231  aerosol_name(2) = id_aibcm_phy
232  ELSEIF (flag_aerosol .EQ. 3) THEN
233  nb_aer = 2
234  ALLOCATE (aerosol_name(nb_aer))
235  aerosol_name(1) = id_aspomm_phy
236  aerosol_name(2) = id_aipomm_phy
237  ELSEIF (flag_aerosol .EQ. 4) THEN
238  nb_aer = 3
239  ALLOCATE (aerosol_name(nb_aer))
240  aerosol_name(1) = id_csssm_phy
241  aerosol_name(2) = id_ssssm_phy
242  aerosol_name(3) = id_asssm_phy
243  ELSEIF (flag_aerosol .EQ. 5) THEN
244  nb_aer = 1
245  ALLOCATE (aerosol_name(nb_aer))
246  aerosol_name(1) = id_cidustm_phy
247  ELSEIF (flag_aerosol .EQ. 6) THEN
248  nb_aer = 10
249  ALLOCATE (aerosol_name(nb_aer))
250  aerosol_name(1) = id_asso4m_phy
251  aerosol_name(2) = id_asbcm_phy
252  aerosol_name(3) = id_aibcm_phy
253  aerosol_name(4) = id_aspomm_phy
254  aerosol_name(5) = id_aipomm_phy
255  aerosol_name(6) = id_csssm_phy
256  aerosol_name(7) = id_ssssm_phy
257  aerosol_name(8) = id_asssm_phy
258  aerosol_name(9) = id_cidustm_phy
259  aerosol_name(10) = id_csso4m_phy
260  ENDIF
261 
262  !
263  ! Loop over modes, use of precalculated nmd and corresponding sigma
264  ! loop over wavelengths
265  ! for each mass species in mode
266  ! interpolate from Sext to retrieve Sext_at_gridpoint_per_species
267  ! compute optical_thickness_at_gridpoint_per_species
268  !
269  ! Calculations that need to be done since we are not in the subroutines INCA
270  !
271 
272 !CDIR ON_ADB(RH_tab)
273 !CDIR ON_ADB(fact_RH)
274 !CDIR NOVECTOR
275  DO n=1,nbre_rh-1
276  fact_rh(n)=1./(rh_tab(n+1)-rh_tab(n))
277  ENDDO
278 
279  DO k=1, klev
280 !CDIR ON_ADB(RH_tab)
281 !CDIR ON_ADB(fact_RH)
282  DO i=1, klon
283  rh(i,k)=min(rhcl(i,k)*100.,rh_max)
284  rh_num(i,k) = int( rh(i,k)/10. + 1.)
285  IF (rh(i,k).GT.85.) rh_num(i,k)=10
286  IF (rh(i,k).GT.90.) rh_num(i,k)=11
287  delta(i,k)=(rh(i,k)-rh_tab(rh_num(i,k)))*fact_rh(rh_num(i,k))
288  ENDDO
289  ENDDO
290 
291 !CDIR SHORTLOOP
292  used_tau(:)=.false.
293 
294  DO m=1,nb_aer ! tau is only computed for each mass
295  fac=1.0
296  IF (aerosol_name(m).EQ.id_asbcm_phy) THEN
297  soluble=.true.
298  spsol=1
299  ELSEIF (aerosol_name(m).EQ.id_aspomm_phy) THEN
300  soluble=.true.
301  spsol=2
302  ELSEIF (aerosol_name(m).EQ.id_asso4m_phy) THEN
303  soluble=.true.
304  spsol=3
305  fac=1.375 ! (NH4)2-SO4/SO4 132/96 mass conversion factor for OD
306  ELSEIF (aerosol_name(m).EQ.id_csso4m_phy) THEN
307  soluble=.true.
308  spsol=4
309  fac=1.375 ! (NH4)2-SO4/SO4 132/96 mass conversion factor for OD
310  ELSEIF (aerosol_name(m).EQ.id_ssssm_phy) THEN
311  soluble=.true.
312  spsol=5
313  ELSEIF (aerosol_name(m).EQ.id_csssm_phy) THEN
314  soluble=.true.
315  spsol=6
316  ELSEIF (aerosol_name(m).EQ.id_asssm_phy) THEN
317  soluble=.true.
318  spsol=7
319  ELSEIF (aerosol_name(m).EQ.id_cidustm_phy) THEN
320  soluble=.false.
321  spinsol=1
322  ELSEIF (aerosol_name(m).EQ.id_aibcm_phy) THEN
323  soluble=.false.
324  spinsol=2
325  ELSEIF (aerosol_name(m).EQ.id_aipomm_phy) THEN
326  soluble=.false.
327  spinsol=3
328  ELSE
329  cycle
330  ENDIF
331 
332  IF (soluble) then
333  used_tau(spsol)=.true.
334  ELSE
335  used_tau(naero_soluble+spinsol)=.true.
336  ENDIF
337 
338  aerindex=aerosol_name(m)
339 
340  DO la=1,las
341 
342  IF (soluble) THEN ! For soluble aerosol
343 
344  DO k=1, klev
345  DO i=1, klon
346  tau_ae5wv_int = alpha_aers_5wv(rh_num(i,k),la,spsol)+delta(i,k)* &
347  (alpha_aers_5wv(rh_num(i,k)+1,la,spsol) - &
348  alpha_aers_5wv(rh_num(i,k),la,spsol))
349  tau(i,k,la,aerindex) = mass_temp(i,k,aerindex)*1000.*zdp1(i,k)* &
350  tau_ae5wv_int*delt*fac
351  tausum(i,la,aerindex)=tausum(i,la,aerindex)+tau(i,k,la,aerindex)
352  ENDDO
353  ENDDO
354 
355  ELSE ! For insoluble aerosol
356 
357  DO k=1, klev
358  DO i=1, klon
359  tau_ae5wv_int = alpha_aeri_5wv(la,spinsol)
360  tau(i,k,la,aerindex) = mass_temp(i,k,aerindex)*1000.*zdp1(i,k)* &
361  tau_ae5wv_int*delt*fac
362  tausum(i,la,aerindex)= tausum(i,la,aerindex)+tau(i,k,la,aerindex)
363  ENDDO
364  ENDDO
365 
366  ENDIF
367 
368  ENDDO ! Boucle sur les longueurs d'onde
369  ENDDO ! Boucle sur les masses de traceurs
370 
371  DO m=1,naero_tot
372  IF (.NOT.used_tau(m)) tau(:,:,:,m)=0.
373  ENDDO
374 
375  DO i=1, klon
376  od550aer(i)=0.
377  DO m=1,naero_tot
378  od550aer(i)=od550aer(i)+tausum(i,la550,m)
379  END DO
380  END DO
381 
382  DO i=1, klon
383  od670aer(i)=0.
384  DO m=1,naero_tot
385  od670aer(i)=od670aer(i)+tausum(i,la670,m)
386  END DO
387  END DO
388 
389  DO i=1, klon
390  od865aer(i)=0.
391  DO m=1,naero_tot
392  od865aer(i)=od865aer(i)+tausum(i,la865,m)
393  END DO
394  END DO
395 
396  DO i=1, klon
397  DO k=1, klev
398  ec550aer(i,k)=0.
399  DO m=1,naero_tot
400  ec550aer(i,k)=ec550aer(i,k)+tau(i,k,la550,m)/dh(i,k)
401  END DO
402  END DO
403  END DO
404 
405  DO i=1, klon
406  ai(i)=-log(max(od670aer(i),1.e-8)/max(od865aer(i),1.e-8))/log(670./865.)
407  ENDDO
408 
409  od550lt1aer(:)=tausum(:,la550,id_asso4m_phy)+tausum(:,la550,id_asbcm_phy) +tausum(:,la550,id_aibcm_phy)+ &
410  tausum(:,la550,id_aspomm_phy)+tausum(:,la550,id_aipomm_phy)+tausum(:,la550,id_asssm_phy)+ &
411  0.03*tausum(:,la550,id_csssm_phy)+0.4*tausum(:,la550,id_cidustm_phy)
412 
413  DEALLOCATE(aerosol_name)
414 
415 END SUBROUTINE aeropt_5wv_rrtm
integer, parameter id_asssm_phy
Definition: aero_mod.F90:20
integer, parameter id_aipomm_phy
Definition: aero_mod.F90:23
integer, parameter id_aspomm_phy
Definition: aero_mod.F90:15
real, dimension(:), allocatable, save od550lt1aer
integer, save klon
Definition: dimphy.F90:3
real, dimension(:,:), allocatable, save ec550aer
integer, parameter id_csssm_phy
Definition: aero_mod.F90:19
integer, save klev
Definition: dimphy.F90:7
real, dimension(:), allocatable, save od865aer
!$Id itapm1 ENDIF!IM on interpole les champs sur les niveaux STD de pression!IM a chaque pas de temps de la physique c!positionnement de l argument logique a false c!pour ne pas recalculer deux fois la meme chose!c!a cet effet un appel a plevel_new a ete deplace c!a la fin de la serie d appels c!la boucle DO nlevSTD a ete internalisee c!dans d ou la creation de cette routine c c!CALL false
Definition: calcul_STDlev.h:26
integer, parameter id_asbcm_phy
Definition: aero_mod.F90:14
integer, parameter id_aibcm_phy
Definition: aero_mod.F90:22
!$Id itapm1 ENDIF!IM on interpole les champs sur les niveaux STD de pression!IM a chaque pas de temps de la physique c!positionnement de l argument logique a false c!pour ne pas recalculer deux fois la meme chose!c!a cet effet un appel a plevel_new a ete deplace c!a la fin de la serie d appels c!la boucle DO nlevSTD a ete internalisee c!dans d ou la creation de cette routine c c!CALL pplay
Definition: calcul_STDlev.h:26
integer, parameter id_asso4m_phy
Definition: aero_mod.F90:16
!$Id itapm1 ENDIF!IM on interpole les champs sur les niveaux STD de pression!IM a chaque pas de temps de la physique c!positionnement de l argument logique a false c!pour ne pas recalculer deux fois la meme chose!c!a cet effet un appel a plevel_new a ete deplace c!a la fin de la serie d appels c!la boucle DO nlevSTD a ete internalisee c!dans d ou la creation de cette routine c c!CALL ulevSTD CALL &zphi philevSTD CALL &zx_rh rhlevSTD!DO klev DO klon klev DO klon klev DO klon klev DO klon klev DO klon klev DO klon klev DO klon klev DO klon klev DO klon klev DO klon du jour ou toutes les read_climoz CALL true
real, dimension(:), allocatable, save od550aer
subroutine aeropt_5wv_rrtm(pdel, m_allaer, delt, RHcl, ai, flag_aerosol, pplay, t_seri, tausum, tau)
integer, parameter id_ssssm_phy
Definition: aero_mod.F90:18
integer, parameter naero_tot
Definition: aero_mod.F90:10
integer, parameter id_csso4m_phy
Definition: aero_mod.F90:17
Definition: dimphy.F90:1
integer, parameter nwave
Definition: aero_mod.F90:90
integer, parameter id_cidustm_phy
Definition: aero_mod.F90:21
real rg
Definition: comcstphy.h:1