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

Last change on this file since 1239 was 1237, checked in by Laurent Fairhead, 15 years ago

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