GCC Code Coverage Report


Directory: ./
File: rad/readaerosol_optic_rrtm.f90
Date: 2022-01-11 19:19:34
Exec Total Coverage
Lines: 0 171 0.0%
Branches: 0 434 0.0%

Line Branch Exec Source
1 ! $Id: readaerosol_optic_rrtm.F90 3630 2020-02-10 10:04:40Z fairhead $
2 !
3 SUBROUTINE readaerosol_optic_rrtm(debut, aerosol_couple, ok_alw, ok_volcan, &
4 flag_aerosol, flag_bc_internal_mixture, itap, rjourvrai, &
5 pdtphys, pplay, paprs, t_seri, rhcl, presnivs, &
6 tr_seri, mass_solu_aero, mass_solu_aero_pi, &
7 tau_aero, piz_aero, cg_aero, &
8 tausum_aero, drytausum_aero, tau3d_aero )
9
10 ! This routine will :
11 ! 1) recevie the aerosols(already read and interpolated) corresponding to flag_aerosol
12 ! 2) calculate the optical properties for the aerosols
13 !
14
15 USE dimphy
16 USE aero_mod
17 USE phys_local_var_mod, only: sconcso4,sconcno3,sconcoa,sconcbc,sconcss,sconcdust, &
18 concso4,concno3,concoa,concbc,concss,concdust,loadso4,loadoa,loadbc,loadss,loaddust, &
19 loadno3,load_tmp1,load_tmp2,load_tmp3,load_tmp4,load_tmp5,load_tmp6,load_tmp7, &
20 load_tmp8,load_tmp9,load_tmp10
21
22 USE infotrac_phy
23 USE YOMCST
24
25 IMPLICIT NONE
26
27 include "clesphys.h"
28
29 ! Input arguments
30 !****************************************************************************************
31 LOGICAL, INTENT(IN) :: debut
32 LOGICAL, INTENT(IN) :: aerosol_couple
33 LOGICAL, INTENT(IN) :: ok_alw
34 LOGICAL, INTENT(IN) :: ok_volcan
35 INTEGER, INTENT(IN) :: flag_aerosol
36 LOGICAL, INTENT(IN) :: flag_bc_internal_mixture
37 INTEGER, INTENT(IN) :: itap
38 REAL, INTENT(IN) :: rjourvrai
39 REAL, INTENT(IN) :: pdtphys
40 REAL, DIMENSION(klon,klev), INTENT(IN) :: pplay
41 REAL, DIMENSION(klon,klev+1), INTENT(IN) :: paprs
42 REAL, DIMENSION(klon,klev), INTENT(IN) :: t_seri
43 REAL, DIMENSION(klon,klev), INTENT(IN) :: rhcl ! humidite relative ciel clair
44 REAL, DIMENSION(klev), INTENT(IN) :: presnivs
45 REAL, DIMENSION(klon,klev,nbtr), INTENT(IN) :: tr_seri ! concentration tracer
46
47 ! Output arguments
48 !****************************************************************************************
49 REAL, DIMENSION(klon,klev), INTENT(OUT) :: mass_solu_aero ! Total mass for all soluble aerosols
50 REAL, DIMENSION(klon,klev), INTENT(OUT) :: mass_solu_aero_pi ! -"- preindustrial values
51 REAL, DIMENSION(klon,klev,2,NSW), INTENT(OUT) :: tau_aero ! Aerosol optical thickness
52 REAL, DIMENSION(klon,klev,2,NSW), INTENT(OUT) :: piz_aero ! Single scattering albedo aerosol
53 REAL, DIMENSION(klon,klev,2,NSW), INTENT(OUT) :: cg_aero ! asymmetry parameter aerosol
54 REAL, DIMENSION(klon,nwave,naero_tot), INTENT(OUT) :: tausum_aero
55 REAL, DIMENSION(klon,naero_tot), INTENT(OUT) :: drytausum_aero
56 REAL, DIMENSION(klon,klev,nwave,naero_tot), INTENT(OUT) :: tau3d_aero
57
58 ! Local variables
59 !****************************************************************************************
60 REAL, DIMENSION(klon) :: aerindex ! POLDER aerosol index
61 REAL, DIMENSION(klon,klev) :: sulfacc ! SO4 accumulation concentration [ug/m3]
62 REAL, DIMENSION(klon,klev) :: sulfcoarse ! SO4 coarse concentration [ug/m3]
63 REAL, DIMENSION(klon,klev) :: bcsol ! BC soluble concentration [ug/m3]
64 REAL, DIMENSION(klon,klev) :: bcins ! BC insoluble concentration [ug/m3]
65 REAL, DIMENSION(klon,klev) :: pomsol ! POM soluble concentration [ug/m3]
66 REAL, DIMENSION(klon,klev) :: pomins ! POM insoluble concentration [ug/m3]
67 REAL, DIMENSION(klon,klev) :: cidust ! DUST aerosol concentration [ug/m3]
68 REAL, DIMENSION(klon,klev) :: sscoarse ! SS Coarse concentration [ug/m3]
69 REAL, DIMENSION(klon,klev) :: sssupco ! SS Super Coarse concentration [ug/m3]
70 REAL, DIMENSION(klon,klev) :: ssacu ! SS Acumulation concentration [ug/m3]
71 REAL, DIMENSION(klon,klev) :: nitracc ! nitrate accumulation concentration [ug/m3]
72 REAL, DIMENSION(klon,klev) :: nitrcoarse ! nitrate coarse concentration [ug/m3]
73 REAL, DIMENSION(klon,klev) :: nitrinscoarse ! nitrate insoluble coarse concentration [ug/m3]
74 REAL, DIMENSION(klon,klev) :: sulfacc_pi
75 REAL, DIMENSION(klon,klev) :: sulfcoarse_pi
76 REAL, DIMENSION(klon,klev) :: bcsol_pi
77 REAL, DIMENSION(klon,klev) :: bcins_pi
78 REAL, DIMENSION(klon,klev) :: pomsol_pi
79 REAL, DIMENSION(klon,klev) :: pomins_pi
80 REAL, DIMENSION(klon,klev) :: cidust_pi
81 REAL, DIMENSION(klon,klev) :: sscoarse_pi
82 REAL, DIMENSION(klon,klev) :: sssupco_pi
83 REAL, DIMENSION(klon,klev) :: ssacu_pi
84 REAL, DIMENSION(klon,klev) :: nitracc_pi
85 REAL, DIMENSION(klon,klev) :: nitrcoarse_pi
86 REAL, DIMENSION(klon,klev) :: nitrinscoarse_pi
87 REAL, DIMENSION(klon,klev) :: pdel, zrho
88 REAL, DIMENSION(klon,klev,naero_tot) :: m_allaer
89 REAL, DIMENSION(klon,klev,naero_tot) :: m_allaer_pi !RAF
90
91 integer :: id_ASBCM, id_ASPOMM, id_ASSO4M, id_ASMSAM, id_CSSO4M, id_CSMSAM, id_SSSSM
92 integer :: id_CSSSM, id_ASSSM, id_CIDUSTM, id_AIBCM, id_AIPOMM, id_ASNO3M, id_CSNO3M, id_CINO3M
93 INTEGER :: k, i
94
95 !--air density
96 zrho(:,:)=pplay(:,:)/t_seri(:,:)/RD !--kg/m3
97
98 !****************************************************************************************
99 ! 1) Get aerosol mass
100 !
101 !****************************************************************************************
102 !
103 !
104 IF (aerosol_couple) THEN !--we get aerosols from tr_seri array from INCA
105 !
106 !--copy fields from INCA tr_seri
107 !--convert to ug m-3 unit for consistency with offline fields
108 !
109 DO i=1,nbtr
110 SELECT CASE(trim(solsym(i)))
111 CASE ("ASBCM")
112 id_ASBCM = i
113 CASE ("ASPOMM")
114 id_ASPOMM = i
115 CASE ("ASSO4M")
116 id_ASSO4M = i
117 CASE ("ASMSAM")
118 id_ASMSAM = i
119 CASE ("CSSO4M")
120 id_CSSO4M = i
121 CASE ("CSMSAM")
122 id_CSMSAM = i
123 CASE ("SSSSM")
124 id_SSSSM = i
125 CASE ("CSSSM")
126 id_CSSSM = i
127 CASE ("ASSSM")
128 id_ASSSM = i
129 CASE ("CIDUSTM")
130 id_CIDUSTM = i
131 CASE ("AIBCM")
132 id_AIBCM = i
133 CASE ("AIPOMM")
134 id_AIPOMM = i
135 CASE ("ASNO3M")
136 id_ASNO3M = i
137 CASE ("CSNO3M")
138 id_CSNO3M = i
139 CASE ("CINO3M")
140 id_CINO3M = i
141 END SELECT
142 ENDDO
143
144 bcsol(:,:) = tr_seri(:,:,id_ASBCM) *zrho(:,:)*1.e9 ! ASBCM
145 pomsol(:,:) = tr_seri(:,:,id_ASPOMM) *zrho(:,:)*1.e9 ! ASPOMM
146 sulfacc(:,:) = (tr_seri(:,:,id_ASSO4M)+tr_seri(:,:,id_ASMSAM))*zrho(:,:)*1.e9 ! ASSO4M (=SO4) + ASMSAM (=MSA)
147 sulfcoarse(:,:) = (tr_seri(:,:,id_CSSO4M)+tr_seri(:,:,id_CSMSAM))*zrho(:,:)*1.e9 ! CSSO4M (=SO4) + CSMSAM (=MSA)
148 sssupco(:,:) = tr_seri(:,:,id_SSSSM) *zrho(:,:)*1.e9 ! SSSSM
149 sscoarse(:,:) = tr_seri(:,:,id_CSSSM) *zrho(:,:)*1.e9 ! CSSSM
150 ssacu(:,:) = tr_seri(:,:,id_ASSSM) *zrho(:,:)*1.e9 ! ASSSM
151 cidust(:,:) = tr_seri(:,:,id_CIDUSTM) *zrho(:,:)*1.e9 ! CIDUSTM
152 bcins(:,:) = tr_seri(:,:,id_AIBCM) *zrho(:,:)*1.e9 ! AIBCM
153 pomins(:,:) = tr_seri(:,:,id_AIPOMM) *zrho(:,:)*1.e9 ! AIPOMM
154 nitracc(:,:) = tr_seri(:,:,id_ASNO3M) *zrho(:,:)*1.e9 ! ASNO3M
155 nitrcoarse(:,:) = tr_seri(:,:,id_CSNO3M) *zrho(:,:)*1.e9 ! CSNO3M
156 nitrinscoarse(:,:)= tr_seri(:,:,id_CINO3M) *zrho(:,:)*1.e9 ! CINO3M
157 !
158 bcsol_pi(:,:) = 0.0 ! ASBCM pre-ind
159 pomsol_pi(:,:) = 0.0 ! ASPOMM pre-ind
160 sulfacc_pi(:,:) = 0.0 ! ASSO4M (=SO4) + ASMSAM (=MSA) pre-ind
161 sulfcoarse_pi(:,:) = 0.0 ! CSSO4M (=SO4) + CSMSAM (=MSA) pre-ind
162 sssupco_pi(:,:) = 0.0 ! SSSSM pre-ind
163 sscoarse_pi(:,:) = 0.0 ! CSSSM pre-ind
164 ssacu_pi(:,:) = 0.0 ! ASSSM pre-ind
165 cidust_pi(:,:) = 0.0 ! CIDUSTM pre-ind
166 bcins_pi(:,:) = 0.0 ! AIBCM pre-ind
167 pomins_pi(:,:) = 0.0 ! AIPOMM pre-ind
168 nitracc_pi(:,:) = 0.0 ! ASNO3M pre-ind
169 nitrcoarse_pi(:,:) = 0.0 ! CSNO3M pre-ind
170 nitrinscoarse_pi(:,:)= 0.0 ! CINO3M
171 !
172 ELSE !--not aerosol_couple
173 !
174 ! Read and interpolate sulfate
175 IF ( flag_aerosol .EQ. 1 .OR. flag_aerosol .EQ. 6 .OR. flag_aerosol .EQ. 7 ) THEN
176
177 CALL readaerosol_interp(id_ASSO4M_phy, itap, pdtphys, rjourvrai, debut, pplay, paprs, t_seri, sulfacc, sulfacc_pi,loadso4)
178 ELSE
179 sulfacc(:,:) = 0. ; sulfacc_pi(:,:) = 0.
180 loadso4=0.
181 ENDIF
182
183 ! Read and interpolate bcsol and bcins
184 IF ( flag_aerosol .EQ. 2 .OR. flag_aerosol .EQ. 6 .OR. flag_aerosol .EQ. 7 ) THEN
185
186 ! Get bc aerosol distribution
187 CALL readaerosol_interp(id_ASBCM_phy, itap, pdtphys, rjourvrai, debut, pplay, paprs, t_seri, bcsol, bcsol_pi, load_tmp1 )
188 CALL readaerosol_interp(id_AIBCM_phy, itap, pdtphys, rjourvrai, debut, pplay, paprs, t_seri, bcins, bcins_pi, load_tmp2 )
189 loadbc(:)=load_tmp1(:)+load_tmp2(:)
190 ELSE
191 bcsol(:,:) = 0. ; bcsol_pi(:,:) = 0.
192 bcins(:,:) = 0. ; bcins_pi(:,:) = 0.
193 loadbc=0.
194 ENDIF
195
196 ! Read and interpolate pomsol and pomins
197 IF ( flag_aerosol .EQ. 3 .OR. flag_aerosol .EQ. 6 .OR. flag_aerosol .EQ. 7 ) THEN
198
199 CALL readaerosol_interp(id_ASPOMM_phy, itap, pdtphys, rjourvrai, debut, pplay, paprs, t_seri, pomsol, pomsol_pi, load_tmp3)
200 CALL readaerosol_interp(id_AIPOMM_phy, itap, pdtphys, rjourvrai, debut, pplay, paprs, t_seri, pomins, pomins_pi, load_tmp4)
201 loadoa(:)=load_tmp3(:)+load_tmp4(:)
202 ELSE
203 pomsol(:,:) = 0. ; pomsol_pi(:,:) = 0.
204 pomins(:,:) = 0. ; pomins_pi(:,:) = 0.
205 loadoa=0.
206 ENDIF
207
208 ! Read and interpolate csssm, ssssm, assssm
209 IF (flag_aerosol .EQ. 4 .OR. flag_aerosol .EQ. 6 .OR. flag_aerosol .EQ. 7 ) THEN
210
211 CALL readaerosol_interp(id_SSSSM_phy ,itap, pdtphys,rjourvrai, &
212 debut, pplay, paprs, t_seri, sssupco, sssupco_pi, load_tmp5)
213 CALL readaerosol_interp(id_CSSSM_phy ,itap, pdtphys,rjourvrai, &
214 debut, pplay, paprs, t_seri, sscoarse,sscoarse_pi, load_tmp6)
215 CALL readaerosol_interp(id_ASSSM_phy ,itap, pdtphys,rjourvrai, &
216 debut, pplay, paprs, t_seri, ssacu, ssacu_pi, load_tmp7)
217 loadss(:)=load_tmp5(:)+load_tmp6(:)+load_tmp7(:)
218 ELSE
219 sscoarse(:,:) = 0. ; sscoarse_pi(:,:) = 0.
220 ssacu(:,:) = 0. ; ssacu_pi(:,:) = 0.
221 sssupco(:,:) = 0. ; sssupco_pi = 0.
222 loadss=0.
223 ENDIF
224
225 ! Read and interpolate cidustm
226 IF (flag_aerosol .EQ. 5 .OR. flag_aerosol .EQ. 6 .OR. flag_aerosol .EQ. 7 ) THEN
227
228 CALL readaerosol_interp(id_CIDUSTM_phy, itap, pdtphys, rjourvrai, debut, pplay, paprs, t_seri, cidust, cidust_pi, loaddust)
229
230 ELSE
231 cidust(:,:) = 0. ; cidust_pi(:,:) = 0.
232 loaddust=0.
233 ENDIF
234 !
235 ! Read and interpolate asno3m, csno3m, cino3m
236 IF (flag_aerosol .EQ. 6 .OR. flag_aerosol .EQ. 7 ) THEN
237
238 CALL readaerosol_interp(id_ASNO3M_phy, itap, pdtphys, rjourvrai, &
239 debut, pplay, paprs, t_seri, nitracc, nitracc_pi, load_tmp8)
240 CALL readaerosol_interp(id_CSNO3M_phy, itap, pdtphys, rjourvrai, &
241 debut, pplay, paprs, t_seri, nitrcoarse, nitrcoarse_pi, load_tmp9)
242 CALL readaerosol_interp(id_CINO3M_phy, itap, pdtphys, rjourvrai, &
243 debut, pplay, paprs, t_seri, nitrinscoarse, nitrinscoarse_pi, load_tmp10)
244 loadno3(:)=load_tmp8(:)+load_tmp9(:)+load_tmp10(:)
245
246 ELSE
247 nitracc(:,:) = 0.0 ; nitracc_pi(:,:) = 0.0
248 nitrcoarse(:,:) = 0.0 ; nitrcoarse_pi(:,:) = 0.0
249 nitrinscoarse(:,:) = 0.0 ; nitrinscoarse_pi(:,:)= 0.0
250 loadno3(:)=0.0
251 ENDIF
252 !
253 ! CSSO4M is set to 0 as not reliable
254 sulfcoarse(:,:) = 0.0 ! CSSO4M (=SO4) + CSMSAM (=MSA)
255 sulfcoarse_pi(:,:) = 0.0 ! CSSO4M (=SO4) + CSMSAM (=MSA) pre-ind
256
257 ENDIF !--not aerosol_couple
258
259 !
260 ! Store all aerosols in one variable
261 !
262 m_allaer(:,:,id_ASBCM_phy) = bcsol(:,:) ! ASBCM
263 m_allaer(:,:,id_ASPOMM_phy) = pomsol(:,:) ! ASPOMM
264 m_allaer(:,:,id_ASSO4M_phy) = sulfacc(:,:) ! ASSO4M (= SO4)
265 m_allaer(:,:,id_CSSO4M_phy) = sulfcoarse(:,:) ! CSSO4M
266 m_allaer(:,:,id_SSSSM_phy) = sssupco(:,:) ! SSSSM
267 m_allaer(:,:,id_CSSSM_phy) = sscoarse(:,:) ! CSSSM
268 m_allaer(:,:,id_ASSSM_phy) = ssacu(:,:) ! ASSSM
269 m_allaer(:,:,id_CIDUSTM_phy)= cidust(:,:) ! CIDUSTM
270 m_allaer(:,:,id_AIBCM_phy) = bcins(:,:) ! AIBCM
271 m_allaer(:,:,id_ASNO3M_phy) = nitracc(:,:) ! ASNO3M
272 m_allaer(:,:,id_CSNO3M_phy) = nitrcoarse(:,:) ! CSNO3M
273 m_allaer(:,:,id_CINO3M_phy) = nitrinscoarse(:,:)! CINO3M
274 m_allaer(:,:,id_AIPOMM_phy) = pomins(:,:) ! AIPOMM
275 m_allaer(:,:,id_STRAT_phy) = 0.0
276
277 !RAF
278 m_allaer_pi(:,:,id_ASBCM_phy) = bcsol_pi(:,:) ! ASBCM pre-ind
279 m_allaer_pi(:,:,id_ASPOMM_phy) = pomsol_pi(:,:) ! ASPOMM pre-ind
280 m_allaer_pi(:,:,id_ASSO4M_phy) = sulfacc_pi(:,:) ! ASSO4M (= SO4) pre-ind
281 m_allaer_pi(:,:,id_CSSO4M_phy) = sulfcoarse_pi(:,:) ! CSSO4M pre-ind
282 m_allaer_pi(:,:,id_SSSSM_phy) = sssupco_pi(:,:) ! SSSSM pre-ind
283 m_allaer_pi(:,:,id_CSSSM_phy) = sscoarse_pi(:,:) ! CSSSM pre-ind
284 m_allaer_pi(:,:,id_ASSSM_phy) = ssacu_pi(:,:) ! ASSSM pre-ind
285 m_allaer_pi(:,:,id_CIDUSTM_phy)= cidust_pi(:,:) ! CIDUSTM pre-ind
286 m_allaer_pi(:,:,id_AIBCM_phy) = bcins_pi(:,:) ! AIBCM pre-ind
287 m_allaer_pi(:,:,id_ASNO3M_phy) = nitracc_pi(:,:) ! ASNO3M pre-ind
288 m_allaer_pi(:,:,id_CSNO3M_phy) = nitrcoarse_pi(:,:) ! CSNO3M pre-ind
289 m_allaer_pi(:,:,id_CINO3M_phy) = nitrinscoarse_pi(:,:)! CINO3M pre-ind
290 m_allaer_pi(:,:,id_AIPOMM_phy) = pomins_pi(:,:) ! AIPOMM pre-ind
291 m_allaer_pi(:,:,id_STRAT_phy) = 0.0
292
293 !
294 ! Calculate the total mass of all soluble aersosols
295 ! to be revisited for AR6
296 mass_solu_aero(:,:) = sulfacc(:,:) + bcsol(:,:) + pomsol(:,:) + nitracc(:,:) + ssacu(:,:)
297 mass_solu_aero_pi(:,:) = sulfacc_pi(:,:) + bcsol_pi(:,:) + pomsol_pi(:,:) + nitracc_pi(:,:) + ssacu_pi(:,:)
298
299 !****************************************************************************************
300 ! 2) Calculate optical properties for the aerosols
301 !
302 !****************************************************************************************
303 DO k = 1, klev
304 DO i = 1, klon
305 pdel(i,k) = paprs(i,k) - paprs (i,k+1)
306 ENDDO
307 ENDDO
308
309 !--new aerosol properties
310 ! aeropt_6bands for rrtm
311 CALL aeropt_6bands_rrtm( &
312 pdel, m_allaer, rhcl, &
313 tau_aero, piz_aero, cg_aero, &
314 m_allaer_pi, flag_aerosol, &
315 flag_bc_internal_mixture, zrho, ok_volcan )
316
317 ! aeropt_5wv only for validation and diagnostics
318 CALL aeropt_5wv_rrtm( &
319 pdel, m_allaer, &
320 rhcl, aerindex, &
321 flag_aerosol, &
322 flag_bc_internal_mixture, &
323 pplay, t_seri, &
324 tausum_aero, drytausum_aero, tau3d_aero )
325
326 !--call LW optical properties for tropospheric aerosols
327 CALL aeropt_lw_rrtm(ok_alw, pdel, zrho, flag_aerosol, m_allaer, m_allaer_pi)
328
329 ! Diagnostics calculation for CMIP5 protocol
330 sconcso4(:) =m_allaer(:,1,id_ASSO4M_phy)*1.e-9
331 sconcno3(:) =(m_allaer(:,1,id_ASNO3M_phy)+m_allaer(:,1,id_CSNO3M_phy)+m_allaer(:,1,id_CINO3M_phy))*1.e-9
332 sconcoa(:) =(m_allaer(:,1,id_ASPOMM_phy)+m_allaer(:,1,id_AIPOMM_phy))*1.e-9
333 sconcbc(:) =(m_allaer(:,1,id_ASBCM_phy)+m_allaer(:,1,id_AIBCM_phy))*1.e-9
334 sconcss(:) =(m_allaer(:,1,id_ASSSM_phy)+m_allaer(:,1,id_CSSSM_phy)+m_allaer(:,1,id_SSSSM_phy))*1.e-9
335 sconcdust(:) =m_allaer(:,1,id_CIDUSTM_phy)*1.e-9
336 concso4(:,:) =m_allaer(:,:,id_ASSO4M_phy)*1.e-9
337 concno3(:,:) =(m_allaer(:,:,id_ASNO3M_phy)+m_allaer(:,:,id_CSNO3M_phy)+m_allaer(:,:,id_CINO3M_phy))*1.e-9
338 concoa(:,:) =(m_allaer(:,:,id_ASPOMM_phy)+m_allaer(:,:,id_AIPOMM_phy))*1.e-9
339 concbc(:,:) =(m_allaer(:,:,id_ASBCM_phy)+m_allaer(:,:,id_AIBCM_phy))*1.e-9
340 concss(:,:) =(m_allaer(:,:,id_ASSSM_phy)+m_allaer(:,:,id_CSSSM_phy)+m_allaer(:,:,id_SSSSM_phy))*1.e-9
341 concdust(:,:)=m_allaer(:,:,id_CIDUSTM_phy)*1.e-9
342
343 END SUBROUTINE readaerosol_optic_rrtm
344