source: LMDZ5/branches/LF-private/libf/phylmd/readaerosol_optic.F90 @ 5456

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

Additions to aerosol outputs for CMIP5 exercise

Additions aux sorties aérosols pour l'exercice CMIP5

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