source: LMDZ5/branches/LMDZ5_SPLA/libf/phylmd/readaerosol_optic.F90 @ 2699

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