source: LMDZ5/trunk/libf/phylmd/rrtm/readaerosol_optic_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: 9.4 KB
Line 
1! $Id$
2!
3SUBROUTINE readaerosol_optic_rrtm(debut, new_aod, flag_aerosol, itap, rjourvrai, &
4     pdtphys, pplay, paprs, t_seri, rhcl, presnivs, &
5     mass_solu_aero, mass_solu_aero_pi, &
6     tau_aero, piz_aero, cg_aero, &
7     tausum_aero, tau3d_aero )
8
9! This routine will :
10! 1) recevie the aerosols(already read and interpolated) corresponding to flag_aerosol
11! 2) calculate the optical properties for the aerosols
12!
13 
14  USE dimphy
15  USE aero_mod
16  USE phys_local_var_mod, only: sconcso4,sconcoa,sconcbc,sconcss,sconcdust, &
17      concso4,concoa,concbc,concss,concdust,loadso4,loadoa,loadbc,loadss,loaddust, &
18      load_tmp1,load_tmp2,load_tmp3,load_tmp4,load_tmp5,load_tmp6,load_tmp7
19  IMPLICIT NONE
20  include "clesphys.h"
21
22! Input arguments
23!****************************************************************************************
24  LOGICAL, INTENT(IN)                      :: debut
25  LOGICAL, INTENT(IN)                      :: new_aod
26  INTEGER, INTENT(IN)                      :: flag_aerosol
27  INTEGER, INTENT(IN)                      :: itap
28  REAL, INTENT(IN)                         :: rjourvrai
29  REAL, INTENT(IN)                         :: pdtphys
30  REAL, DIMENSION(klon,klev), INTENT(IN)   :: pplay
31  REAL, DIMENSION(klon,klev+1), INTENT(IN) :: paprs
32  REAL, DIMENSION(klon,klev), INTENT(IN)   :: t_seri
33  REAL, DIMENSION(klon,klev), INTENT(IN)   :: rhcl   ! humidite relative ciel clair
34  REAL, DIMENSION(klev), INTENT(IN)        :: presnivs
35
36! Output arguments
37!****************************************************************************************
38  REAL, DIMENSION(klon,klev), INTENT(OUT)     :: mass_solu_aero    ! Total mass for all soluble aerosols
39  REAL, DIMENSION(klon,klev), INTENT(OUT)     :: mass_solu_aero_pi !     -"-     preindustrial values
40  REAL, DIMENSION(klon,klev,2,NSW), INTENT(OUT) :: tau_aero    ! Aerosol optical thickness
41  REAL, DIMENSION(klon,klev,2,NSW), INTENT(OUT) :: piz_aero    ! Single scattering albedo aerosol
42  REAL, DIMENSION(klon,klev,2,NSW), INTENT(OUT) :: cg_aero     ! asymmetry parameter aerosol
43!  REAL, DIMENSION(klon,nwave,naero_spc), INTENT(OUT)       :: tausum_aero
44!  REAL, DIMENSION(klon,klev,nwave,naero_spc), INTENT(OUT)  :: tau3d_aero
45!--correction minibug OB
46  REAL, DIMENSION(klon,nwave,naero_tot), INTENT(OUT)       :: tausum_aero
47  REAL, DIMENSION(klon,klev,nwave,naero_tot), INTENT(OUT)  :: tau3d_aero
48
49! Local variables
50!****************************************************************************************
51  REAL, DIMENSION(klon)        :: aerindex ! POLDER aerosol index
52  REAL, DIMENSION(klon,klev)   :: sulfate  ! SO4 aerosol concentration [ug/m3]
53  REAL, DIMENSION(klon,klev)   :: bcsol    ! BC soluble concentration [ug/m3]
54  REAL, DIMENSION(klon,klev)   :: bcins    ! BC insoluble concentration [ug/m3]
55  REAL, DIMENSION(klon,klev)   :: pomsol   ! POM soluble concentration [ug/m3]
56  REAL, DIMENSION(klon,klev)   :: pomins   ! POM insoluble concentration [ug/m3]
57  REAL, DIMENSION(klon,klev)   :: cidust    ! DUST aerosol concentration  [ug/m3]
58  REAL, DIMENSION(klon,klev)   :: sscoarse  ! SS Coarse concentration [ug/m3]
59  REAL, DIMENSION(klon,klev)   :: sssupco   ! SS Super Coarse concentration [ug/m3]
60  REAL, DIMENSION(klon,klev)   :: ssacu     ! SS Acumulation concentration [ug/m3]
61  REAL, DIMENSION(klon,klev)   :: sulfate_pi
62  REAL, DIMENSION(klon,klev)   :: bcsol_pi
63  REAL, DIMENSION(klon,klev)   :: bcins_pi
64  REAL, DIMENSION(klon,klev)   :: pomsol_pi
65  REAL, DIMENSION(klon,klev)   :: pomins_pi
66  REAL, DIMENSION(klon,klev)   :: cidust_pi
67  REAL, DIMENSION(klon,klev)   :: sscoarse_pi
68  REAL, DIMENSION(klon,klev)   :: sssupco_pi
69  REAL, DIMENSION(klon,klev)   :: ssacu_pi
70  REAL, DIMENSION(klon,klev)   :: pdel
71  REAL, DIMENSION(klon,klev,naero_spc) :: m_allaer
72  REAL, DIMENSION(klon,klev,naero_spc) :: m_allaer_pi !RAF 
73!  REAL, DIMENSION(klon,naero_tot)      :: fractnat_allaer !RAF delete??
74
75  INTEGER :: k, i
76 
77!****************************************************************************************
78! 1) Get aerosol mass
79!   
80!****************************************************************************************
81! Read and interpolate sulfate
82  IF ( flag_aerosol .EQ. 1 .OR. &
83       flag_aerosol .EQ. 6 ) THEN
84
85     CALL readaerosol_interp(id_ASSO4M, itap, pdtphys, rjourvrai, debut, pplay, paprs, t_seri, sulfate, sulfate_pi,loadso4)
86  ELSE
87     sulfate(:,:) = 0. ; sulfate_pi(:,:) = 0.
88     loadso4=0.
89  END IF
90
91! Read and interpolate bcsol and bcins
92  IF ( flag_aerosol .EQ. 2 .OR. &
93       flag_aerosol .EQ. 6 ) THEN
94
95     ! Get bc aerosol distribution
96     CALL readaerosol_interp(id_ASBCM, itap, pdtphys, rjourvrai, debut, pplay, paprs, t_seri, bcsol, bcsol_pi, load_tmp1 )
97     CALL readaerosol_interp(id_AIBCM, itap, pdtphys, rjourvrai, debut, pplay, paprs, t_seri, bcins, bcins_pi, load_tmp2 )
98     loadbc(:)=load_tmp1(:)+load_tmp2(:)
99  ELSE
100     bcsol(:,:) = 0. ; bcsol_pi(:,:) = 0.
101     bcins(:,:) = 0. ; bcins_pi(:,:) = 0.
102     loadbc=0.
103  END IF
104
105
106! Read and interpolate pomsol and pomins
107  IF ( flag_aerosol .EQ. 3 .OR. &
108       flag_aerosol .EQ. 6 ) THEN
109
110     CALL readaerosol_interp(id_ASPOMM, itap, pdtphys, rjourvrai, debut, pplay, paprs, t_seri, pomsol, pomsol_pi, load_tmp3)
111     CALL readaerosol_interp(id_AIPOMM, itap, pdtphys, rjourvrai, debut, pplay, paprs, t_seri, pomins, pomins_pi, load_tmp4)
112     loadoa(:)=load_tmp3(:)+load_tmp4(:)
113  ELSE
114     pomsol(:,:) = 0. ; pomsol_pi(:,:) = 0.
115     pomins(:,:) = 0. ; pomins_pi(:,:) = 0.
116     loadoa=0.
117  END IF
118
119
120! Read and interpolate csssm, ssssm, assssm
121  IF (flag_aerosol .EQ. 4 .OR. &
122      flag_aerosol .EQ. 6 ) THEN
123
124      CALL readaerosol_interp(id_SSSSM ,itap, pdtphys, rjourvrai, debut, pplay, paprs, t_seri, sssupco, sssupco_pi, load_tmp5)
125      CALL readaerosol_interp(id_CSSSM ,itap, pdtphys, rjourvrai, debut, pplay, paprs, t_seri, sscoarse,sscoarse_pi, load_tmp6)
126      CALL readaerosol_interp(id_ASSSM ,itap, pdtphys, rjourvrai, debut, pplay, paprs, t_seri, ssacu, ssacu_pi, load_tmp7)
127     loadss(:)=load_tmp5(:)+load_tmp6(:)+load_tmp7(:)
128  ELSE
129     sscoarse(:,:) = 0. ; sscoarse_pi(:,:) = 0.
130     ssacu(:,:)    = 0. ; ssacu_pi(:,:) = 0.
131     sssupco(:,:)  = 0. ; sssupco_pi = 0.
132     loadss=0.
133  ENDIF
134
135! Read and interpolate cidustm
136  IF (flag_aerosol .EQ. 5 .OR.  &
137      flag_aerosol .EQ. 6 ) THEN
138
139      CALL readaerosol_interp(id_CIDUSTM, itap, pdtphys, rjourvrai, debut, pplay, paprs, t_seri, cidust, cidust_pi, loaddust)
140
141  ELSE
142      cidust(:,:) = 0. ; cidust_pi(:,:) = 0.
143      loaddust=0.
144  ENDIF
145
146!
147! Store all aerosols in one variable
148!
149  m_allaer(:,:,id_ASBCM)  = bcsol(:,:)        ! ASBCM
150  m_allaer(:,:,id_ASPOMM) = pomsol(:,:)       ! ASPOMM
151  m_allaer(:,:,id_ASSO4M) = sulfate(:,:)      ! ASSO4M (= SO4)
152  m_allaer(:,:,id_CSSO4M) = 0.                ! CSSO4M
153  m_allaer(:,:,id_SSSSM)  = sssupco(:,:)      ! SSSSM
154  m_allaer(:,:,id_CSSSM)  = sscoarse(:,:)     ! CSSSM
155  m_allaer(:,:,id_ASSSM)  = ssacu(:,:)        ! ASSSM
156  m_allaer(:,:,id_CIDUSTM)= cidust(:,:)       ! CIDUSTM
157  m_allaer(:,:,id_AIBCM)  = bcins(:,:)        ! AIBCM
158  m_allaer(:,:,id_AIPOMM) = pomins(:,:)       ! AIPOMM
159
160!RAF
161  m_allaer_pi(:,:,1)  = bcsol_pi(:,:)        ! ASBCM pre-ind
162  m_allaer_pi(:,:,2)  = pomsol_pi(:,:)       ! ASPOMM pre-ind
163  m_allaer_pi(:,:,3)  = sulfate_pi(:,:)      ! ASSO4M (= SO4) pre-ind
164  m_allaer_pi(:,:,4)  = 0.                   ! CSSO4M pre-ind
165  m_allaer_pi(:,:,5)  = sssupco_pi(:,:)      ! SSSSM pre-ind
166  m_allaer_pi(:,:,6)  = sscoarse_pi(:,:)     ! CSSSM pre-ind
167  m_allaer_pi(:,:,7)  = ssacu_pi(:,:)        ! ASSSM pre-ind
168  m_allaer_pi(:,:,8)  = cidust_pi(:,:)       ! CIDUSTM pre-ind
169  m_allaer_pi(:,:,9)  = bcins_pi(:,:)        ! AIBCM pre-ind
170  m_allaer_pi(:,:,10) = pomins_pi(:,:)       ! AIPOMM pre-ind
171
172!
173! Calculate the total mass of all soluble aersosols
174!
175  mass_solu_aero(:,:)    = sulfate(:,:)    + bcsol(:,:)    + pomsol(:,:) !   + &
176!       sscoarse(:,:)    + ssacu(:,:)    + sssupco(:,:)
177  mass_solu_aero_pi(:,:) = sulfate_pi(:,:) + bcsol_pi(:,:) + pomsol_pi(:,:) ! + &
178!       sscoarse_pi(:,:) + ssacu_pi(:,:) + sssupco_pi(:,:)
179
180!****************************************************************************************
181! 2) Calculate optical properties for the aerosols
182!
183!****************************************************************************************
184  DO k = 1, klev
185     DO i = 1, klon
186        pdel(i,k) = paprs(i,k) - paprs (i,k+1)
187     END DO
188  END DO
189
190  CALL aeropt_6bands_rrtm( &
191          pdel, m_allaer, pdtphys, rhcl, &
192          tau_aero, piz_aero, cg_aero,   &
193          m_allaer_pi, flag_aerosol, &
194          pplay, t_seri, presnivs)
195     
196     ! aeropt_5wv only for validation and diagnostics.
197     CALL aeropt_5wv_rrtm(                    &
198          pdel, m_allaer,                &
199          pdtphys, rhcl, aerindex,       &
200          flag_aerosol, pplay, t_seri,   &
201          tausum_aero, tau3d_aero )
202
203! Diagnostics calculation for CMIP5 protocol
204  sconcso4(:)=m_allaer(:,1,id_ASSO4M)*1.e-9
205  sconcoa(:)=(m_allaer(:,1,id_ASPOMM)+m_allaer(:,1,id_AIPOMM))*1.e-9
206  sconcbc(:)=(m_allaer(:,1,id_ASBCM)+m_allaer(:,1,id_AIBCM))*1.e-9
207  sconcss(:)=(m_allaer(:,1,id_ASSSM)+m_allaer(:,1,id_CSSSM)+m_allaer(:,1,id_SSSSM))*1.e-9
208  sconcdust(:)=m_allaer(:,1,id_CIDUSTM)*1.e-9
209  concso4(:,:)=m_allaer(:,:,id_ASSO4M)*1.e-9
210  concoa(:,:)=(m_allaer(:,:,id_ASPOMM)+m_allaer(:,:,id_AIPOMM))*1.e-9
211  concbc(:,:)=(m_allaer(:,:,id_ASBCM)+m_allaer(:,:,id_AIBCM))*1.e-9
212  concss(:,:)=(m_allaer(:,:,id_ASSSM)+m_allaer(:,:,id_CSSSM)+m_allaer(:,:,id_SSSSM))*1.e-9
213  concdust(:,:)=m_allaer(:,:,id_CIDUSTM)*1.e-9
214
215END SUBROUTINE readaerosol_optic_rrtm
Note: See TracBrowser for help on using the repository browser.