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

Last change on this file since 1181 was 1181, checked in by jghattas, 15 years ago
  • Ajoute le possibilite de forcer avec les aerosols poussiere et sel de mer.
  • Ajoute le module aerosol_mod qui contient des parmetres pour les aerosols
  • flag_aerosol a legerement change signification

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