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

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

Oublié de mettre les propriétés

Forgot to set properties
  • Property copyright set to
    Name of program: LMDZ
    Creation date: 1984
    Version: LMDZ5
    License: CeCILL version 2
    Holder: Laboratoire de m\'et\'eorologie dynamique, CNRS, UMR 8539
    See the license file in the root directory
  • Property svn:keywords set to Author Date Id Revi
File size: 14.4 KB
Line 
1!
2! $Id: aeropt_5wv_rrtm.F90 2005 2014-04-04 12:59:37Z fairhead $
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.