GCC Code Coverage Report

Directory: ./
File: phys/readaerosol_optic.f90
Date: 2022-01-11 19:19:34
Exec Total Coverage
Lines: 0 103 0.0%
Branches: 0 250 0.0%
Line Branch Exec Source
1 ! $Id: readaerosol_optic.F90 3630 2020-02-10 10:04:40Z fairhead $
2 !
3 ✗ SUBROUTINE readaerosol_optic(debut, 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,sconcno3,sconcoa,sconcbc,sconcss,sconcdust, &
17 concso4,concno3,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 INTEGER, INTENT(IN) :: flag_aerosol
25 INTEGER, INTENT(IN) :: itap
26 REAL, INTENT(IN) :: rjourvrai
27 REAL, INTENT(IN) :: pdtphys
28 REAL, DIMENSION(klon,klev), INTENT(IN) :: pplay
29 REAL, DIMENSION(klon,klev+1), INTENT(IN) :: paprs
30 REAL, DIMENSION(klon,klev), INTENT(IN) :: t_seri
31 REAL, DIMENSION(klon,klev), INTENT(IN) :: rhcl ! humidite relative ciel clair
32 REAL, DIMENSION(klev), INTENT(IN) :: presnivs
33
34 ! Output arguments
35 !****************************************************************************************
36 REAL, DIMENSION(klon,klev), INTENT(OUT) :: mass_solu_aero ! Total mass for all soluble aerosols
37 REAL, DIMENSION(klon,klev), INTENT(OUT) :: mass_solu_aero_pi ! -"- preindustrial values
38 REAL, DIMENSION(klon,klev,naero_grp,nbands), INTENT(OUT) :: tau_aero ! Aerosol optical thickness
39 REAL, DIMENSION(klon,klev,naero_grp,nbands), INTENT(OUT) :: piz_aero ! Single scattering albedo aerosol
40 REAL, DIMENSION(klon,klev,naero_grp,nbands), INTENT(OUT) :: cg_aero ! asymmetry parameter aerosol
41 ! REAL, DIMENSION(klon,nwave,naero_spc), INTENT(OUT) :: tausum_aero
42 ! REAL, DIMENSION(klon,klev,nwave,naero_spc), INTENT(OUT) :: tau3d_aero
43 !--correction mini bug OB
44 REAL, DIMENSION(klon,nwave,naero_tot), INTENT(OUT) :: tausum_aero
45 REAL, DIMENSION(klon,klev,nwave,naero_tot), INTENT(OUT) :: tau3d_aero
46
47 ! Local variables
48 !****************************************************************************************
49 ✗ REAL, DIMENSION(klon) :: aerindex ! POLDER aerosol index
50 ✗ REAL, DIMENSION(klon,klev) :: sulfate ! SO4 aerosol concentration [ug/m3]
51 ✗ REAL, DIMENSION(klon,klev) :: bcsol ! BC soluble concentration [ug/m3]
52 ✗ REAL, DIMENSION(klon,klev) :: bcins ! BC insoluble concentration [ug/m3]
53 ✗ REAL, DIMENSION(klon,klev) :: pomsol ! POM soluble concentration [ug/m3]
54 ✗ REAL, DIMENSION(klon,klev) :: pomins ! POM insoluble concentration [ug/m3]
55 ✗ REAL, DIMENSION(klon,klev) :: cidust ! DUST aerosol concentration [ug/m3]
56 ✗ REAL, DIMENSION(klon,klev) :: sscoarse ! SS Coarse concentration [ug/m3]
57 ✗ REAL, DIMENSION(klon,klev) :: sssupco ! SS Super Coarse concentration [ug/m3]
58 ✗ REAL, DIMENSION(klon,klev) :: ssacu ! SS Acumulation concentration [ug/m3]
59 ✗ REAL, DIMENSION(klon,klev) :: sulfate_pi
60 ✗ REAL, DIMENSION(klon,klev) :: bcsol_pi
61 ✗ REAL, DIMENSION(klon,klev) :: bcins_pi
62 ✗ REAL, DIMENSION(klon,klev) :: pomsol_pi
63 ✗ REAL, DIMENSION(klon,klev) :: pomins_pi
64 ✗ REAL, DIMENSION(klon,klev) :: cidust_pi
65 ✗ REAL, DIMENSION(klon,klev) :: sscoarse_pi
66 ✗ REAL, DIMENSION(klon,klev) :: sssupco_pi
67 ✗ REAL, DIMENSION(klon,klev) :: ssacu_pi
68 ✗ REAL, DIMENSION(klon,klev) :: pdel
69 ✗ REAL, DIMENSION(klon,klev,naero_tot) :: m_allaer
70 ✗ REAL, DIMENSION(klon,klev,naero_tot) :: m_allaer_pi !RAF
71 ! REAL, DIMENSION(klon,naero_tot) :: fractnat_allaer !RAF delete??
72
73 INTEGER :: k, i
74
75 !****************************************************************************************
76 ! 1) Get aerosol mass
77 !
78 !****************************************************************************************
79 ! Read and interpolate sulfate
80 ✗ IF ( flag_aerosol .EQ. 1 .OR. &
81 flag_aerosol .EQ. 6 ) THEN
82
83 ✗ CALL readaerosol_interp(id_ASSO4M_phy, itap, pdtphys, rjourvrai, debut, pplay, paprs, t_seri, sulfate, sulfate_pi,loadso4)
84 ELSE
85 ✗ sulfate(:,:) = 0. ; sulfate_pi(:,:) = 0.
86 ✗ loadso4=0.
87 END IF
88
89 ! Read and interpolate bcsol and bcins
90 ✗ IF ( flag_aerosol .EQ. 2 .OR. &
91 flag_aerosol .EQ. 6 ) THEN
92
93 ! Get bc aerosol distribution
94 ✗ CALL readaerosol_interp(id_ASBCM_phy, itap, pdtphys, rjourvrai, debut, pplay, paprs, t_seri, bcsol, bcsol_pi, load_tmp1)
95 ✗ CALL readaerosol_interp(id_AIBCM_phy, itap, pdtphys, rjourvrai, debut, pplay, paprs, t_seri, bcins, bcins_pi, load_tmp2)
96 ✗ loadbc(:)=load_tmp1(:)+load_tmp2(:)
97 ELSE
98 ✗ bcsol(:,:) = 0. ; bcsol_pi(:,:) = 0.
99 ✗ bcins(:,:) = 0. ; bcins_pi(:,:) = 0.
100 ✗ loadbc=0.
101 END IF
102
103
104 ! Read and interpolate pomsol and pomins
105 ✗ IF ( flag_aerosol .EQ. 3 .OR. &
106 flag_aerosol .EQ. 6 ) THEN
107
108 ✗ CALL readaerosol_interp(id_ASPOMM_phy, itap, pdtphys, rjourvrai, debut, pplay, paprs, t_seri, pomsol, pomsol_pi, load_tmp3)
109 ✗ CALL readaerosol_interp(id_AIPOMM_phy, itap, pdtphys, rjourvrai, debut, pplay, paprs, t_seri, pomins, pomins_pi, load_tmp4)
110 ✗ loadoa(:)=load_tmp3(:)+load_tmp4(:)
111 ELSE
112 ✗ pomsol(:,:) = 0. ; pomsol_pi(:,:) = 0.
113 ✗ pomins(:,:) = 0. ; pomins_pi(:,:) = 0.
114 ✗ loadoa=0.
115 END IF
116
117
118 ! Read and interpolate csssm, ssssm, assssm
119 ✗ IF (flag_aerosol .EQ. 4 .OR. &
120 flag_aerosol .EQ. 6 ) THEN
121
122 ✗ CALL readaerosol_interp(id_SSSSM_phy ,itap, pdtphys, rjourvrai, debut, pplay, paprs, t_seri, sssupco, sssupco_pi, load_tmp5)
123 ✗ CALL readaerosol_interp(id_CSSSM_phy ,itap, pdtphys, rjourvrai, debut, pplay, paprs, t_seri, sscoarse,sscoarse_pi, load_tmp6)
124 ✗ CALL readaerosol_interp(id_ASSSM_phy ,itap, pdtphys, rjourvrai, debut, pplay, paprs, t_seri, ssacu, ssacu_pi, load_tmp7)
125 ✗ loadss(:)=load_tmp5(:)+load_tmp6(:)+load_tmp7(:)
126 ELSE
127 ✗ sscoarse(:,:) = 0. ; sscoarse_pi(:,:) = 0.
128 ✗ ssacu(:,:) = 0. ; ssacu_pi(:,:) = 0.
129 ✗ sssupco(:,:) = 0. ; sssupco_pi = 0.
130 ✗ loadss=0.
131 ENDIF
132
133 ! Read and interpolate cidustm
134 ✗ IF (flag_aerosol .EQ. 5 .OR. &
135 flag_aerosol .EQ. 6 ) THEN
136
137 ✗ CALL readaerosol_interp(id_CIDUSTM_phy, itap, pdtphys, rjourvrai, debut, pplay, paprs, t_seri, cidust, cidust_pi, loaddust)
138 ELSE
139 ✗ cidust(:,:) = 0. ; cidust_pi(:,:) = 0.
140 ✗ loaddust=0.
141 ENDIF
142
143 !
144 ! Store all aerosols in one variable
145 !
146 ✗ m_allaer(:,:,id_ASBCM_phy) = bcsol(:,:) ! ASBCM
147 ✗ m_allaer(:,:,id_ASPOMM_phy) = pomsol(:,:) ! ASPOMM
148 ✗ m_allaer(:,:,id_ASSO4M_phy) = sulfate(:,:) ! ASSO4M (= SO4)
149 ✗ m_allaer(:,:,id_CSSO4M_phy) = 0. ! CSSO4M
150 ✗ m_allaer(:,:,id_SSSSM_phy) = sssupco(:,:) ! SSSSM
151 ✗ m_allaer(:,:,id_CSSSM_phy) = sscoarse(:,:) ! CSSSM
152 ✗ m_allaer(:,:,id_ASSSM_phy) = ssacu(:,:) ! ASSSM
153 ✗ m_allaer(:,:,id_CIDUSTM_phy)= cidust(:,:) ! CIDUSTM
154 ✗ m_allaer(:,:,id_AIBCM_phy) = bcins(:,:) ! AIBCM
155 ✗ m_allaer(:,:,id_AIPOMM_phy) = pomins(:,:) ! AIPOMM
156 ✗ m_allaer(:,:,id_ASNO3M_phy) = 0.0
157 ✗ m_allaer(:,:,id_CSNO3M_phy) = 0.0
158 ✗ m_allaer(:,:,id_CINO3M_phy) = 0.0
159
160 !RAF
161 ✗ m_allaer_pi(:,:,id_ASBCM_phy) = bcsol_pi(:,:) ! ASBCM pre-ind
162 ✗ m_allaer_pi(:,:,id_ASPOMM_phy) = pomsol_pi(:,:) ! ASPOMM pre-ind
163 ✗ m_allaer_pi(:,:,id_ASSO4M_phy) = sulfate_pi(:,:) ! ASSO4M (= SO4) pre-ind
164 ✗ m_allaer_pi(:,:,id_CSSO4M_phy) = 0. ! CSSO4M pre-ind
165 ✗ m_allaer_pi(:,:,id_SSSSM_phy) = sssupco_pi(:,:) ! SSSSM pre-ind
166 ✗ m_allaer_pi(:,:,id_CSSSM_phy) = sscoarse_pi(:,:) ! CSSSM pre-ind
167 ✗ m_allaer_pi(:,:,id_ASSSM_phy) = ssacu_pi(:,:) ! ASSSM pre-ind
168 ✗ m_allaer_pi(:,:,id_CIDUSTM_phy) = cidust_pi(:,:) ! CIDUSTM pre-ind
169 ✗ m_allaer_pi(:,:,id_AIBCM_phy) = bcins_pi(:,:) ! AIBCM pre-ind
170 ✗ m_allaer_pi(:,:,id_AIPOMM_phy) = pomins_pi(:,:) ! AIPOMM pre-ind
171 ✗ m_allaer_pi(:,:,id_ASNO3M_phy) = 0.0
172 ✗ m_allaer_pi(:,:,id_CSNO3M_phy) = 0.0
173 ✗ m_allaer_pi(:,:,id_CINO3M_phy) = 0.0
174 !
175 ! Calculate the total mass of all soluble aersosols
176 !
177 ✗ mass_solu_aero(:,:) = sulfate(:,:) + bcsol(:,:) + pomsol(:,:) + ssacu(:,:)
178 ✗ mass_solu_aero_pi(:,:) = sulfate_pi(:,:) + bcsol_pi(:,:) + pomsol_pi(:,:) + ssacu_pi(:,:)
179
180 !****************************************************************************************
181 ! 2) Calculate optical properties for the aerosols
182 !
183 !****************************************************************************************
184 ✗ DO k = 1, klev
185 ✗ DO i = 1, klon
186 ✗ pdel(i,k) = paprs(i,k) - paprs (i,k+1)
187 END DO
188 END DO
189
190 ! RAF delete?? fractnat_allaer(:,:) = 0.
191 ! RAF fractnat_allaer -> m_allaer_pi
192
193 CALL aeropt_2bands( &
194 pdel, m_allaer, pdtphys, rhcl, &
195 tau_aero, piz_aero, cg_aero, &
196 m_allaer_pi, flag_aerosol, &
197 ✗ pplay, t_seri, presnivs)
198
199 ! aeropt_5wv only for validation and diagnostics.
200 CALL aeropt_5wv( &
201 pdel, m_allaer, &
202 pdtphys, rhcl, aerindex, &
203 flag_aerosol, pplay, t_seri, &
204 ✗ tausum_aero, tau3d_aero, presnivs)
205
206 ! Diagnostics calculation for CMIP5 protocol
207 ✗ sconcso4(:)=m_allaer(:,1,id_ASSO4M_phy)*1.e-9
208 ✗ sconcno3(:)=m_allaer(:,1,id_ASNO3M_phy)*1.e-9
209 ✗ sconcoa(:)=(m_allaer(:,1,id_ASPOMM_phy)+m_allaer(:,1,id_AIPOMM_phy))*1.e-9
210 ✗ sconcbc(:)=(m_allaer(:,1,id_ASBCM_phy)+m_allaer(:,1,id_AIBCM_phy))*1.e-9
211 ✗ sconcss(:)=(m_allaer(:,1,id_ASSSM_phy)+m_allaer(:,1,id_CSSSM_phy)+m_allaer(:,1,id_SSSSM_phy))*1.e-9
212 ✗ sconcdust(:)=m_allaer(:,1,id_CIDUSTM_phy)*1.e-9
213 ✗ concso4(:,:)=m_allaer(:,:,id_ASSO4M_phy)*1.e-9
214 ✗ concno3(:,:)=m_allaer(:,:,id_ASNO3M_phy)*1.e-9
215 ✗ concoa(:,:)=(m_allaer(:,:,id_ASPOMM_phy)+m_allaer(:,:,id_AIPOMM_phy))*1.e-9
216 ✗ concbc(:,:)=(m_allaer(:,:,id_ASBCM_phy)+m_allaer(:,:,id_AIBCM_phy))*1.e-9
217 ✗ concss(:,:)=(m_allaer(:,:,id_ASSSM_phy)+m_allaer(:,:,id_CSSSM_phy)+m_allaer(:,:,id_SSSSM_phy))*1.e-9
218 ✗ concdust(:,:)=m_allaer(:,:,id_CIDUSTM_phy)*1.e-9
219
220 ✗ END SUBROUTINE readaerosol_optic
221