Line data Source code
1 : module hygrocoreshell_aerosol_optics_mod
2 : use shr_kind_mod, only: r8 => shr_kind_r8
3 : use aerosol_optics_mod, only: aerosol_optics
4 : use aerosol_state_mod, only: aerosol_state
5 : use aerosol_properties_mod, only: aerosol_properties
6 : use table_interp_mod, only: table_interp, table_interp_wghts, table_interp_calcwghts
7 :
8 : implicit none
9 :
10 : private
11 : public :: hygrocoreshell_aerosol_optics
12 :
13 : !> hygrocoreshell_aerosol_optics
14 : !! Table look up implementation of aerosol_optics to parameterize aerosol
15 : !! radiative properties in terms of core mass fraction, black carbon/dust fraction,
16 : !! kappa and relative humidity
17 : type, extends(aerosol_optics) :: hygrocoreshell_aerosol_optics
18 :
19 : real(r8), allocatable :: totalmmr(:,:) ! total mmr of the aerosol
20 : real(r8), allocatable :: corefrac(:,:) ! mass fraction that is core
21 : real(r8), allocatable :: bcdust(:,:) ! mass fraction of bc vs (bc + dust)
22 : real(r8), allocatable :: kappa(:,:) ! hygroscopicity
23 : real(r8), allocatable :: relh(:,:) ! relative humidity
24 :
25 : real(r8), pointer :: sw_hygro_coreshell_ext(:,:,:,:,:) => null() ! short wave extinction table
26 : real(r8), pointer :: sw_hygro_coreshell_ssa(:,:,:,:,:) => null() ! short wave single-scatter albedo table
27 : real(r8), pointer :: sw_hygro_coreshell_asm(:,:,:,:,:) => null() ! short wave asymmetry table
28 : real(r8), pointer :: lw_hygro_coreshell_abs(:,:,:,:,:) => null() ! long wave absorption table
29 :
30 : real(r8), pointer :: tbl_corefrac(:) => null() ! core fraction dimension values
31 : real(r8), pointer :: tbl_bcdust(:) => null() ! bc/(bc + dust) fraction dimension values
32 : real(r8), pointer :: tbl_kap(:) => null() ! hygroscopicity dimension values
33 : real(r8), pointer :: tbl_relh(:) => null() ! relative humidity dimension values
34 :
35 : integer :: nfrac = -1 ! core fraction dimension size
36 : integer :: nbcdust = -1 ! bc/(bc + dust) fraction dimension size
37 : integer :: nkap = -1 ! hygroscopicity dimension size
38 : integer :: nrelh = -1 ! relative humidity dimension size
39 :
40 : contains
41 :
42 : procedure :: sw_props
43 : procedure :: lw_props
44 :
45 : final :: destructor
46 :
47 : end type hygrocoreshell_aerosol_optics
48 :
49 : interface hygrocoreshell_aerosol_optics
50 : procedure :: constructor
51 : end interface hygrocoreshell_aerosol_optics
52 :
53 : contains
54 :
55 : !------------------------------------------------------------------------------
56 : !------------------------------------------------------------------------------
57 1536000 : function constructor(aero_props, aero_state, ilist, ibin, ncol, nlev, relhum) result(newobj)
58 :
59 : class(aerosol_properties),intent(in) :: aero_props ! aerosol_properties object
60 : class(aerosol_state),intent(in) :: aero_state ! aerosol_state object
61 : integer, intent(in) :: ilist ! climate or a diagnostic list number
62 : integer, intent(in) :: ibin ! bin number
63 : integer, intent(in) :: ncol ! number of columns
64 : integer, intent(in) :: nlev ! number of levels
65 : real(r8),intent(in) :: relhum(ncol,nlev) ! relative humidity
66 :
67 : type(hygrocoreshell_aerosol_optics), pointer :: newobj
68 :
69 : integer :: ierr, nspec
70 : integer :: ilev, ispec, icol
71 :
72 1536000 : real(r8), pointer :: specmmr(:,:) ! species mass mixing ratio
73 :
74 3072000 : real(r8) :: coremmr(ncol,nlev)
75 3072000 : real(r8) :: coredustmmr(ncol,nlev)
76 3072000 : real(r8) :: corebcmmr(ncol,nlev)
77 3072000 : real(r8) :: shellmmr(ncol,nlev)
78 3072000 : real(r8) :: bcdustmmr(ncol,nlev)
79 :
80 : character(len=32) :: spectype ! species type
81 : character(len=32) :: specmorph
82 : real(r8) :: specdens ! species density (kg/m3)
83 :
84 1536000 : allocate(newobj, stat=ierr)
85 1536000 : if (ierr/=0) then
86 1536000 : nullify(newobj)
87 : return
88 : end if
89 :
90 6144000 : allocate(newobj%totalmmr(ncol,nlev),stat=ierr)
91 1536000 : if (ierr/=0) then
92 0 : nullify(newobj)
93 0 : return
94 : end if
95 :
96 4608000 : allocate(newobj%corefrac(ncol,nlev),stat=ierr)
97 1536000 : if (ierr/=0) then
98 0 : nullify(newobj)
99 0 : return
100 : end if
101 :
102 4608000 : allocate(newobj%bcdust(ncol,nlev),stat=ierr)
103 1536000 : if (ierr/=0) then
104 0 : nullify(newobj)
105 0 : return
106 : end if
107 :
108 4608000 : allocate(newobj%kappa(ncol,nlev),stat=ierr)
109 1536000 : if (ierr/=0) then
110 0 : nullify(newobj)
111 0 : return
112 : end if
113 :
114 4608000 : allocate(newobj%relh(ncol,nlev),stat=ierr)
115 1536000 : if (ierr/=0) then
116 0 : nullify(newobj)
117 0 : return
118 : end if
119 :
120 1536000 : nspec = aero_props%nspecies(ilist,ibin)
121 :
122 758476800 : coremmr(:,:) = 0._r8
123 758476800 : coredustmmr(:,:) = 0._r8
124 758476800 : corebcmmr(:,:) = 0._r8
125 758476800 : shellmmr(:,:) = 0._r8
126 :
127 16896000 : do ispec = 1,nspec
128 :
129 15360000 : call aero_state%get_ambient_mmr(ilist,ispec,ibin,specmmr)
130 :
131 : call aero_props%get(ibin, ispec, list_ndx=ilist, density=specdens, &
132 15360000 : spectype=spectype, specmorph=specmorph)
133 :
134 16896000 : if (trim(specmorph) == 'core') then
135 3072000 : if (trim(spectype) == 'dust') then
136 758476800 : coredustmmr(:ncol,:nlev) = coredustmmr(:ncol,:nlev) + specmmr(:ncol,:nlev)
137 : end if
138 3072000 : if (trim(spectype) == 'black-c') then
139 758476800 : corebcmmr(:ncol,:nlev) = corebcmmr(:ncol,:nlev) + specmmr(:ncol,:nlev)
140 : end if
141 1516953600 : coremmr(:ncol,:nlev) = coremmr(:ncol,:nlev) + specmmr(:ncol,:nlev)
142 12288000 : else if (trim(specmorph) == 'shell') then
143 6067814400 : shellmmr(:ncol,:nlev) = shellmmr(:ncol,:nlev) + specmmr(:ncol,:nlev)
144 : else
145 0 : nullify(newobj)
146 0 : return
147 : end if
148 :
149 : end do
150 :
151 758476800 : newobj%totalmmr(:,:) = coremmr(:,:) + shellmmr(:,:)
152 758476800 : bcdustmmr(:,:) = corebcmmr(:,:) + coredustmmr(:,:)
153 :
154 50688000 : do ilev = 1, nlev
155 758476800 : do icol = 1, ncol
156 :
157 707788800 : if (newobj%totalmmr(icol,ilev) > 0._r8) then
158 707788800 : newobj%corefrac(icol,ilev) = coremmr(icol,ilev) / newobj%totalmmr(icol,ilev)
159 : else
160 0 : newobj%corefrac(icol,ilev) = 0._r8
161 : end if
162 707788800 : newobj%corefrac(icol,ilev) = max(0._r8, min(1.0_r8, newobj%corefrac(icol,ilev)))
163 :
164 707788800 : if (bcdustmmr(icol,ilev) > 0._r8) then
165 707788800 : newobj%bcdust(icol,ilev) = corebcmmr(icol,ilev) / bcdustmmr(icol,ilev)
166 : else
167 0 : newobj%bcdust(icol,ilev) = 0._r8
168 : end if
169 756940800 : newobj%bcdust(icol,ilev) = max(0._r8, min(1.0_r8, newobj%bcdust(icol,ilev)))
170 :
171 : end do
172 : end do
173 :
174 1536000 : call aero_state%hygroscopicity(ilist, ibin, newobj%kappa)
175 :
176 : call aero_props%optics_params(ilist, ibin, &
177 : corefrac=newobj%tbl_corefrac, kap=newobj%tbl_kap, &
178 : bcdust=newobj%tbl_bcdust, relh=newobj%tbl_relh, &
179 : nfrac=newobj%nfrac, nbcdust=newobj%nbcdust, &
180 1536000 : nkap=newobj%nkap, nrelh=newobj%nrelh)
181 :
182 758476800 : newobj%relh(:ncol,:) = relhum(:ncol,:)
183 :
184 : ! long wave optical properties table
185 : call aero_props%optics_params(ilist, ibin, &
186 : sw_hygro_coreshell_ext=newobj%sw_hygro_coreshell_ext, &
187 : sw_hygro_coreshell_ssa=newobj%sw_hygro_coreshell_ssa, &
188 : sw_hygro_coreshell_asm=newobj%sw_hygro_coreshell_asm, &
189 1536000 : lw_hygro_coreshell_ext=newobj%lw_hygro_coreshell_abs)
190 :
191 1536000 : end function constructor
192 :
193 : !------------------------------------------------------------------------------
194 : ! returns short wave aerosol optics properties
195 : !------------------------------------------------------------------------------
196 344064000 : subroutine sw_props(self, ncol, ilev, iwav, pext, pabs, palb, pasm)
197 :
198 : class(hygrocoreshell_aerosol_optics), intent(in) :: self
199 : integer, intent(in) :: ncol ! number of columns
200 : integer, intent(in) :: ilev ! vertical level index
201 : integer, intent(in) :: iwav ! wave length index
202 : real(r8),intent(out) :: pext(ncol) ! parameterized specific extinction (m2/kg)
203 : real(r8),intent(out) :: pabs(ncol) ! parameterized specific absorption (m2/kg)
204 : real(r8),intent(out) :: palb(ncol) ! parameterized single scattering albedo
205 : real(r8),intent(out) :: pasm(ncol) ! parameterized asymmetry factor
206 :
207 : integer :: icol
208 :
209 688128000 : type(table_interp_wghts) :: rhwghts(ncol)
210 688128000 : type(table_interp_wghts) :: cfwghts(ncol)
211 688128000 : type(table_interp_wghts) :: bcwghts(ncol)
212 688128000 : type(table_interp_wghts) :: kpwghts(ncol)
213 :
214 344064000 : rhwghts = table_interp_calcwghts( self%nrelh, self%tbl_relh, ncol, self%relh(:ncol,ilev) )
215 344064000 : cfwghts = table_interp_calcwghts( self%nfrac, self%tbl_corefrac, ncol, self%corefrac(:ncol,ilev) )
216 344064000 : bcwghts = table_interp_calcwghts( self%nbcdust, self%tbl_bcdust, ncol, self%bcdust(:ncol,ilev) )
217 344064000 : kpwghts = table_interp_calcwghts( self%nkap, self%tbl_kap, ncol, self%kappa(:ncol,ilev) )
218 :
219 >24807*10^8 : pext = table_interp( ncol, self%nrelh,self%nfrac,self%nbcdust,self%nkap, rhwghts,cfwghts,bcwghts,kpwghts, self%sw_hygro_coreshell_ext(:,iwav,:,:,:))
220 >24860*10^8 : pabs = (1._r8-table_interp( ncol, self%nrelh,self%nfrac,self%nbcdust,self%nkap, rhwghts,cfwghts,bcwghts,kpwghts, self%sw_hygro_coreshell_ssa(:,iwav,:,:,:)))*pext
221 >24807*10^8 : pasm = table_interp( ncol, self%nrelh,self%nfrac,self%nbcdust,self%nkap, rhwghts,cfwghts,bcwghts,kpwghts, self%sw_hygro_coreshell_asm(:,iwav,:,:,:))
222 :
223 5298585600 : do icol = 1, ncol
224 :
225 4954521600 : pext(icol) = pext(icol)*self%totalmmr(icol,ilev)
226 4954521600 : pabs(icol) = pabs(icol)*self%totalmmr(icol,ilev)
227 4954521600 : pabs(icol) = max(0._r8,pabs(icol))
228 4954521600 : pabs(icol) = min(pext(icol),pabs(icol))
229 :
230 5298585600 : palb(icol) = 1._r8-pabs(icol)/max(pext(icol),1.e-40_r8)
231 :
232 : end do
233 :
234 344064000 : end subroutine sw_props
235 :
236 : !------------------------------------------------------------------------------
237 : ! returns long wave aerosol optics properties
238 : !------------------------------------------------------------------------------
239 393216000 : subroutine lw_props(self, ncol, ilev, iwav, pabs)
240 :
241 : class(hygrocoreshell_aerosol_optics), intent(in) :: self
242 : integer, intent(in) :: ncol ! number of columns
243 : integer, intent(in) :: ilev ! vertical level index
244 : integer, intent(in) :: iwav ! wave length index
245 : real(r8),intent(out) :: pabs(ncol) ! parameterized specific absorption (m2/kg)
246 :
247 : integer :: icol
248 :
249 786432000 : type(table_interp_wghts) :: rhwghts(ncol)
250 786432000 : type(table_interp_wghts) :: cfwghts(ncol)
251 786432000 : type(table_interp_wghts) :: bcwghts(ncol)
252 786432000 : type(table_interp_wghts) :: kpwghts(ncol)
253 :
254 393216000 : rhwghts = table_interp_calcwghts( self%nrelh, self%tbl_relh, ncol, self%relh(:ncol,ilev) )
255 393216000 : cfwghts = table_interp_calcwghts( self%nfrac, self%tbl_corefrac, ncol, self%corefrac(:ncol,ilev) )
256 393216000 : bcwghts = table_interp_calcwghts( self%nbcdust, self%tbl_bcdust, ncol, self%bcdust(:ncol,ilev) )
257 393216000 : kpwghts = table_interp_calcwghts( self%nkap, self%tbl_kap, ncol, self%kappa(:ncol,ilev) )
258 :
259 >28350*10^8 : pabs = table_interp( ncol, self%nrelh,self%nfrac,self%nbcdust,self%nkap, rhwghts,cfwghts,bcwghts,kpwghts, self%lw_hygro_coreshell_abs(:,iwav,:,:,:))
260 :
261 6055526400 : do icol = 1, ncol
262 5662310400 : pabs(icol) = pabs(icol)*self%totalmmr(icol,ilev)
263 6055526400 : pabs(icol) = max(0._r8,pabs(icol))
264 : end do
265 :
266 393216000 : end subroutine lw_props
267 :
268 : !------------------------------------------------------------------------------
269 : !------------------------------------------------------------------------------
270 1536000 : subroutine destructor(self)
271 :
272 : type(hygrocoreshell_aerosol_optics), intent(inout) :: self
273 :
274 1536000 : deallocate(self%totalmmr)
275 1536000 : deallocate(self%corefrac)
276 1536000 : deallocate(self%bcdust)
277 1536000 : deallocate(self%kappa)
278 1536000 : deallocate(self%relh)
279 :
280 1536000 : nullify(self%tbl_corefrac)
281 1536000 : nullify(self%tbl_bcdust)
282 1536000 : nullify(self%tbl_kap)
283 1536000 : nullify(self%tbl_relh)
284 1536000 : nullify(self%sw_hygro_coreshell_ext)
285 1536000 : nullify(self%sw_hygro_coreshell_ssa)
286 1536000 : nullify(self%sw_hygro_coreshell_asm)
287 1536000 : nullify(self%lw_hygro_coreshell_abs)
288 :
289 1536000 : end subroutine destructor
290 :
291 6144000 : end module hygrocoreshell_aerosol_optics_mod
|