source: LMDZ4/branches/LMDZ4-dev/libf/phylmd/readaerosol_optic.F90 @ 1221

Last change on this file since 1221 was 1221, checked in by jghattas, 15 years ago

Modification pour les aerosols sels marin.

Nicolas Yan, Yves Balkanski LSCE
File size: 7.3 KB
Line 
1! $Id$
2!
3SUBROUTINE readaerosol_optic(debut, new_aod, flag_aerosol, rjourvrai, pdtphys, &
4     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  IMPLICIT NONE
17
18! Input arguments
19!****************************************************************************************
20  LOGICAL, INTENT(IN)                      :: debut
21  LOGICAL, INTENT(IN)                      :: new_aod
22  INTEGER, INTENT(IN)                      :: flag_aerosol
23  REAL, INTENT(IN)                         :: rjourvrai
24  REAL, INTENT(IN)                         :: pdtphys
25  REAL, DIMENSION(klon,klev), INTENT(IN)   :: pplay
26  REAL, DIMENSION(klon,klev+1), INTENT(IN) :: paprs
27  REAL, DIMENSION(klon,klev), INTENT(IN)   :: t_seri
28  REAL, DIMENSION(klon,klev), INTENT(IN)   :: rhcl   ! humidite relative ciel clair
29  REAL, DIMENSION(klev), INTENT(IN)        :: presnivs
30
31! Output arguments
32!****************************************************************************************
33  REAL, DIMENSION(klon,klev), INTENT(OUT)     :: mass_solu_aero    ! Total mass for all soluble aerosols
34  REAL, DIMENSION(klon,klev), INTENT(OUT)     :: mass_solu_aero_pi !     -"-     preindustrial values
35  REAL, DIMENSION(klon,klev,naero_grp,nbands), INTENT(OUT) :: tau_aero    ! Aerosol optical thickness
36  REAL, DIMENSION(klon,klev,naero_grp,nbands), INTENT(OUT) :: piz_aero    ! Single scattering albedo aerosol
37  REAL, DIMENSION(klon,klev,naero_grp,nbands), INTENT(OUT) :: cg_aero     ! asymmetry parameter aerosol
38  REAL, DIMENSION(klon,nwave,naero_spc), INTENT(OUT)       :: tausum_aero
39  REAL, DIMENSION(klon,klev,nwave,naero_spc), INTENT(OUT)  :: tau3d_aero
40
41! Local variables
42!****************************************************************************************
43  REAL, DIMENSION(klon)        :: aerindex ! POLDER aerosol index
44  REAL, DIMENSION(klon,klev)   :: sulfate  ! SO4 aerosol concentration [ug/m3]
45  REAL, DIMENSION(klon,klev)   :: bcsol    ! BC soluble concentration [ug/m3]
46  REAL, DIMENSION(klon,klev)   :: bcins    ! BC insoluble concentration [ug/m3]
47  REAL, DIMENSION(klon,klev)   :: pomsol   ! POM soluble concentration [ug/m3]
48  REAL, DIMENSION(klon,klev)   :: pomins   ! POM insoluble concentration [ug/m3]
49  REAL, DIMENSION(klon,klev)   :: cidust    ! DUST aerosol concentration  [ug/m3]
50  REAL, DIMENSION(klon,klev)   :: sscoarse  ! SS Coarse concentration [ug/m3]
51  REAL, DIMENSION(klon,klev)   :: sssupco   ! SS Super Coarse concentration [ug/m3]
52  REAL, DIMENSION(klon,klev)   :: ssacu     ! SS Acumulation concentration [ug/m3]
53  REAL, DIMENSION(klon,klev)   :: sulfate_pi
54  REAL, DIMENSION(klon,klev)   :: bcsol_pi
55  REAL, DIMENSION(klon,klev)   :: bcins_pi
56  REAL, DIMENSION(klon,klev)   :: pomsol_pi
57  REAL, DIMENSION(klon,klev)   :: pomins_pi
58  REAL, DIMENSION(klon,klev)   :: cidust_pi
59  REAL, DIMENSION(klon,klev)   :: sscoarse_pi
60  REAL, DIMENSION(klon,klev)   :: sssupco_pi
61  REAL, DIMENSION(klon,klev)   :: ssacu_pi
62  REAL, DIMENSION(klon,klev)   :: pdel
63  REAL, DIMENSION(klon,klev,naero_spc) :: m_allaer
64  REAL, DIMENSION(klon,naero_tot)      :: fractnat_allaer
65
66  INTEGER :: k, i
67 
68!****************************************************************************************
69! 1) Get aerosol mass
70!   
71!****************************************************************************************
72! Read and interpolate sulfate
73  IF ( flag_aerosol .EQ. 1 .OR. &
74       flag_aerosol .EQ. 6 ) THEN
75
76     CALL readaerosol_interp(id_ASSO4M, rjourvrai, debut, pplay, paprs, t_seri, sulfate, sulfate_pi)
77  ELSE
78     sulfate(:,:) = 0. ; sulfate_pi(:,:) = 0.
79  END IF
80
81! Read and interpolate bcsol and bcins
82  IF ( flag_aerosol .EQ. 2 .OR. &
83       flag_aerosol .EQ. 6 ) THEN
84
85     ! Get bc aerosol distribution
86     CALL readaerosol_interp(id_ASBCM, rjourvrai, debut, pplay, paprs, t_seri, bcsol, bcsol_pi )
87     CALL readaerosol_interp(id_AIBCM, rjourvrai, debut, pplay, paprs, t_seri, bcins, bcins_pi )
88  ELSE
89     bcsol(:,:) = 0. ; bcsol_pi(:,:) = 0.
90     bcins(:,:) = 0. ; bcins_pi(:,:) = 0.
91  END IF
92
93
94! Read and interpolate pomsol and pomins
95  IF ( flag_aerosol .EQ. 3 .OR. &
96       flag_aerosol .EQ. 6 ) THEN
97
98     CALL readaerosol_interp(id_ASPOMM, rjourvrai, debut, pplay, paprs, t_seri, pomsol, pomsol_pi)
99     CALL readaerosol_interp(id_AIPOMM, rjourvrai, debut, pplay, paprs, t_seri, pomins, pomins_pi)
100  ELSE
101     pomsol(:,:) = 0. ; pomsol_pi(:,:) = 0.
102     pomins(:,:) = 0. ; pomins_pi(:,:) = 0.
103  END IF
104
105
106! Read and interpolate csssm, ssssm, assssm
107  IF (flag_aerosol .EQ. 4 .OR. &
108      flag_aerosol .EQ. 6 ) THEN
109
110      CALL readaerosol_interp(id_SSSSM ,rjourvrai, debut, pplay, paprs, t_seri, sssupco, sssupco_pi)
111      CALL readaerosol_interp(id_CSSSM ,rjourvrai, debut, pplay, paprs, t_seri, sscoarse,sscoarse_pi)
112      CALL readaerosol_interp(id_ASSSM ,rjourvrai, debut, pplay, paprs, t_seri, ssacu, ssacu_pi)
113
114  ELSE
115     sscoarse(:,:) = 0. ; sscoarse_pi(:,:) = 0.
116     ssacu(:,:)    = 0. ; ssacu_pi(:,:) = 0.
117     sssupco(:,:)  = 0. ; sssupco_pi = 0.
118  ENDIF
119
120! Read and interpolate cidustm
121  IF (flag_aerosol .EQ. 5 .OR.  &
122      flag_aerosol .EQ. 6 ) THEN
123
124      CALL readaerosol_interp(id_CIDUSTM, rjourvrai, debut, pplay, paprs, t_seri, cidust, cidust_pi)
125
126  ELSE
127      cidust(:,:) = 0. ; cidust_pi(:,:) = 0.
128  ENDIF
129
130!
131! Store all aerosols in one variable
132!
133  m_allaer(:,:,id_ASBCM)  = bcsol(:,:)        ! ASBCM
134  m_allaer(:,:,id_ASPOMM) = pomsol(:,:)       ! ASPOMM
135  m_allaer(:,:,id_ASSO4M) = sulfate(:,:)      ! ASSO4M (= SO4)
136  m_allaer(:,:,id_CSSO4M) = 0.                ! CSSO4M
137  m_allaer(:,:,id_SSSSM)  = sssupco(:,:)      ! SSSSM
138  m_allaer(:,:,id_CSSSM)  = sscoarse(:,:)     ! CSSSM
139  m_allaer(:,:,id_ASSSM)  = ssacu(:,:)        ! ASSSM
140  m_allaer(:,:,id_CIDUSTM)= cidust(:,:)       ! CIDUSTM
141  m_allaer(:,:,id_AIBCM)  = bcins(:,:)        ! AIBCM
142  m_allaer(:,:,id_AIPOMM) = pomins(:,:)       ! AIPOMM
143
144!
145! Calculate the total mass of all soluble aersosols
146!
147  mass_solu_aero(:,:)    = sulfate(:,:)    + bcsol(:,:)    + pomsol(:,:)    + &
148       sscoarse(:,:)    + ssacu(:,:)    + sssupco(:,:)
149  mass_solu_aero_pi(:,:) = sulfate_pi(:,:) + bcsol_pi(:,:) + pomsol_pi(:,:) + &
150       sscoarse_pi(:,:) + ssacu_pi(:,:) + sssupco_pi(:,:)
151
152!****************************************************************************************
153! 2) Calculate optical properties for the aerosols
154!
155!****************************************************************************************
156  DO k = 1, klev
157     DO i = 1, klon
158        pdel(i,k) = paprs(i,k) - paprs (i,k+1)
159     END DO
160  END DO
161
162  IF (new_aod) THEN
163
164     fractnat_allaer(:,:) = 0.
165     CALL aeropt_2bands( &
166          pdel, m_allaer, pdtphys, rhcl, &
167          tau_aero, piz_aero, cg_aero,   &
168          fractnat_allaer, flag_aerosol, &
169          pplay, t_seri, presnivs)
170     
171     ! aeropt_5wv only for validation and diagnostics.
172     CALL aeropt_5wv( &
173          pdel, m_allaer, &
174          pdtphys, rhcl, aerindex, &
175          flag_aerosol, pplay, t_seri, &
176          tausum_aero, tau3d_aero, presnivs)
177  ELSE
178
179     CALL aeropt(pplay, paprs, t_seri, sulfate, rhcl, &
180          tau_aero(:,:,id_ASSO4M,:), piz_aero(:,:,id_ASSO4M,:), cg_aero(:,:,id_ASSO4M,:), aerindex)
181     
182  END IF
183
184END SUBROUTINE readaerosol_optic
Note: See TracBrowser for help on using the repository browser.