Line data Source code
1 : !------------------------------------------------------------------------------
2 : ! Harmonized Emissions Component (HEMCO) !
3 : !------------------------------------------------------------------------------
4 : !BOP
5 : !
6 : ! !MODULE: hco_cc_emissions
7 : !
8 : ! !DESCRIPTION: Module hco\_cc\_emissions provides emissions to CAM-chem in CESM.
9 : ! This module replaces mo\_extfrc and mo\_srf\_emissions in CAM-chem
10 : ! when HEMCO is enabled, otherwise they are not called if HEMCO-CESM is not
11 : ! enabled at runtime.
12 : !
13 : ! These subroutines emulate the behavior of extfrc\_set (3-D emissions)
14 : ! and set\_srf\_emissions in CAM-chem for API compatibility.
15 : !\\
16 : !\\
17 : ! !INTERFACE:
18 : !
19 : module hco_cc_emissions
20 : !
21 : ! !USES:
22 : !
23 : ! CESM types
24 : use shr_kind_mod, only: r8 => shr_kind_r8
25 :
26 : ! Run control
27 : use spmd_utils, only: masterproc
28 : use cam_abortutils, only: endrun
29 : use cam_logfile, only: iulog
30 :
31 : ! Grid information
32 : use ppgrid, only: pver, pverp
33 :
34 : ! Chemistry mechanism properties
35 : use chem_mods, only: gas_pcnst
36 : use mo_tracname, only: solsym
37 :
38 : ! Physics buffer operations
39 : use physics_buffer, only: physics_buffer_desc
40 : use physics_buffer, only: pbuf_get_field, pbuf_get_index
41 :
42 : ! Compat with XFRC diagn
43 : use cam_history, only: outfld
44 : use cam_history_support, only: max_fieldname_len
45 :
46 : implicit none
47 : private
48 : !
49 : ! !PUBLIC MEMBER FUNCTIONS:
50 : !
51 : public :: hco_extfrc_inti
52 : public :: hco_set_srf_emissions, hco_set_extfrc
53 : !
54 : ! !REMARKS:
55 : ! None
56 : !
57 : ! !REVISION HISTORY:
58 : ! 08 Aug 2022 - H.P. Lin - Initial version
59 : ! 04 Nov 2022 - H.P. Lin - Now initialize extfrc fields in here
60 : !EOP
61 : !------------------------------------------------------------------------------
62 : !BOC
63 : logical :: pcnst_is_extfrc(gas_pcnst) ! Is external forcing? (3-D data)
64 : integer :: pcnst_extfrc_ndx(gas_pcnst) ! External forcing index from get_extfrc_ndx
65 : integer :: hco_pbuf_idx(gas_pcnst) ! Physics buffer indices for HCO_* fields from HEMCO
66 : contains
67 : !EOC
68 : !------------------------------------------------------------------------------
69 : ! Harmonized Emissions Component (HEMCO) !
70 : !------------------------------------------------------------------------------
71 : !BOP
72 : !
73 : ! !IROUTINE: hco_set_srf_emissions
74 : !
75 : ! !DESCRIPTION: Sets surface level emissions (note, TOA is level 1, so this is level pver)
76 : ! for this latitude slice (chunk).
77 : !\\
78 : !\\
79 : ! !INTERFACE:
80 : !
81 0 : subroutine hco_set_srf_emissions( lchnk, ncol, sflx, pbuf )
82 : !
83 : ! !USES:
84 : !
85 : implicit none
86 : !
87 : ! !INPUT PARAMETERS:
88 : !
89 : integer, intent(in) :: ncol ! columns in chunk
90 : integer, intent(in) :: lchnk ! chunk index
91 : real(r8), intent(out) :: sflx(:,:) ! surface emissions ( kg/m^2/s )
92 : type(physics_buffer_desc), pointer :: pbuf(:) ! pbuf in chunk
93 : !
94 : ! !REVISION HISTORY:
95 : ! 08 Aug 2022 - H.P. Lin - Initial version
96 : ! 12 Jan 2023 - H.P. Lin - Check if pbuf is 2-D or 3-D first
97 : ! 09 Feb 2023 - H.P. Lin - For 3-D pbuf, no longer set cflx and use 3-D forcing only.
98 : !EOP
99 : !------------------------------------------------------------------------------
100 : !BOC
101 : !
102 : ! !LOCAL VARIABLES:
103 : !
104 : integer :: n
105 :
106 : real(r8), pointer :: pbuf_ptr_3d(:,:) ! ptr to pbuf data (/pcols,pver/)
107 0 : real(r8), pointer :: pbuf_ptr_2d(:) ! ptr to pbuf data (/pcols/)
108 : integer :: tmpIdx ! pbuf field id
109 :
110 : ! reset sflx here. (same as mo_srf_emissions.F90)
111 : ! sflx is defined in chem_emissions (chemistry.F90) but without default values, and is
112 : ! later added to cam_in%cflx. it must be initialized in this subroutine.
113 0 : sflx(:,:) = 0._r8
114 :
115 : !--------------------------------------------------------
116 : ! ... set HEMCO emissions
117 : ! hplin 7/19/20
118 : !--------------------------------------------------------
119 :
120 : ! for every species index retrieve the species name, compute the pbuf name,
121 : ! and write it into sflx(col, n)
122 : ! where n is spc_ndx
123 :
124 : ! if the pbuf exists, set has_emis(1:gas_pcnst) to .true.
125 : ! this process is supposed to be set by srf_emissions_inti but it is just
126 : ! used below, so we shunt it here and decide later
127 :
128 : ! ncol: # of columns in chunk
129 : ! lchnk: chunk number
130 :
131 : ! sflx is given in (pcols, gas_pcnst) so it is a in-chunk slice of the
132 : ! srf flux specifier. maybe this loop needs to be done higher up so
133 : ! we loop over the pbuf to prevent inquiries. tbd hplin 7/19/20
134 :
135 : do n = 1, gas_pcnst
136 : tmpIdx = hco_pbuf_idx(n)
137 : if(tmpIdx > 0) then
138 : if(pcnst_is_extfrc(n)) then ! 3-D data
139 : ! if species is 3-D data, then all forcings set through 3-D. no longer process
140 : ! their emissions here.
141 : else ! 2-D data
142 : call pbuf_get_field(pbuf, tmpIdx, pbuf_ptr_2d)
143 :
144 : ! for each col retrieve data from pbuf_ptr(I, K)
145 : sflx(1:ncol,n) = pbuf_ptr_2d(1:ncol)
146 :
147 : pbuf_ptr_2d => null()
148 : endif
149 : endif
150 : enddo
151 :
152 0 : end subroutine hco_set_srf_emissions
153 : !EOC
154 : !------------------------------------------------------------------------------
155 : ! Harmonized Emissions Component (HEMCO) !
156 : !------------------------------------------------------------------------------
157 : !BOP
158 : !
159 : ! !IROUTINE: hco_set_extfrc
160 : !
161 : ! !DESCRIPTION: Set 3-D emissions apart from surface level.
162 : !\\
163 : !\\
164 : ! !INTERFACE:
165 : !
166 0 : subroutine hco_set_extfrc( lchnk, zint, frcing, ncol, pbuf )
167 : !
168 : ! !USES:
169 : !
170 : use mo_chem_utls, only: get_spc_ndx
171 :
172 : ! Check list whether this species has external forcing from dataset - this is a CAM-chem flag
173 : ! and this is CAM-chem specific.
174 : use chem_mods, only: frc_from_dataset, extfrc_lst
175 : use chem_mods, only: extcnt, adv_mass
176 :
177 : use mo_constants, only: avogadro
178 : implicit none
179 : !
180 : ! !INPUT PARAMETERS:
181 : !
182 : integer, intent(in) :: ncol ! columns in chunk
183 : integer, intent(in) :: lchnk ! chunk index
184 : real(r8), intent(in) :: zint(ncol, pverp) ! interface geopot above surface (km)
185 : real(r8), intent(inout) :: frcing(ncol,pver,extcnt) ! insitu forcings (molec/cm^3/s)
186 : type(physics_buffer_desc), pointer :: pbuf(:) ! pbuf in chunk
187 : !
188 : ! !REVISION HISTORY:
189 : ! 08 Aug 2022 - H.P. Lin - Initial version based on original from 14 Nov 2020
190 : ! 09 Feb 2023 - H.P. Lin - Use full 3-D emissions, including surface, if available
191 : !EOP
192 : !------------------------------------------------------------------------------
193 : !BOC
194 : !
195 : ! !LOCAL VARIABLES:
196 : !
197 : real(r8), parameter :: cm2_to_m2 = 1.e4_r8
198 : real(r8), parameter :: kg_to_g = 1.e-3_r8
199 : real(r8), parameter :: km_to_cm = 1.e5_r8
200 :
201 : ! Loop idxs
202 : integer :: m, n, k
203 :
204 : ! For compatibility with XFRC_ diagnostic in CAM-chem
205 0 : real(r8) :: frcing_col(1:ncol), frcing_col_kg(1:ncol)
206 : character(len=max_fieldname_len) :: xfcname
207 : real(r8) :: molec_to_kg
208 : integer :: spc_ndx
209 :
210 :
211 0 : real(r8), pointer :: pbuf_ik(:,:) ! ptr to pbuf data (/pcols,pver/)
212 : integer :: tmpIdx ! pbuf field id
213 : real(r8) :: kg_to_molec
214 :
215 : ! for every species index retrieve the species name, compute the pbuf name,
216 : ! and write it into frcing(col, lev, n)
217 : ! where n is FRC_IDX --
218 : !
219 :
220 : !******************************************************************************************************
221 : ! WARNING: ONLY SPECIES THAT ARE EXTERNALLY FORCED AND SPECIFIED IN mo_sim_dat.F90
222 : ! CAN HAVE 3-D EMISSIONS, OTHERWISE THEY WILL BE IGNORED!!!
223 : !
224 : ! the n = frc_idx comes from get_extfrc_ndx( spc_name ).
225 : ! it is too computationally expensive to check all fields to see if they are 3-d emitted
226 : !
227 : ! so PLEASE verify that all your species are in mo_sim_dat.F90:: extfrc_lst before attempting
228 : ! to have 3-D emissions for them.
229 : !
230 : ! I will still loop through all species, get its symbol and attempt to inject extfrc emissions
231 : ! for it, but it may not be guaranteed to be done.
232 : !******************************************************************************************************
233 :
234 : ! if the pbuf exists, set has_emis(1:gas_pcnst) to .true.
235 : ! this process is supposed to be set by srf_emissions_inti but it is just
236 : ! used below, so we shunt it here and decide later
237 :
238 : ! ncol: # of columns in chunk
239 : ! lchnk: chunk number
240 :
241 : ! Zero out frcing to be consistent with mo_extfrc
242 : frcing(:,:,:) = 0._r8
243 :
244 : do n = 1, gas_pcnst
245 : ! check if extfrc available?
246 : if(pcnst_is_extfrc(n)) then
247 : ! add extfrc
248 : ! "external insitu forcing" (1/cm^3/s)
249 : m = pcnst_extfrc_ndx(n)
250 : tmpIdx = hco_pbuf_idx(n)
251 : if(tmpIdx > 0) then
252 : ! Note: units coming out of HEMCO are in kg/m2/s, so unit conversion must be done
253 : !
254 : ! using species factor...
255 : ! (kg_to_g is actually kg/g...)
256 : !
257 : ! 1 / (kg/molec cm2/m2) = molec/kg m2/cm2
258 : !
259 : ! kg/m2/s * molec/kg m2/cm2 = molec/cm2/s
260 : ! now divide by z-interface height (in CM!) for each height to get the right answer!
261 : ! (hplin, 11/14/20)
262 : kg_to_molec = 1/(adv_mass(n) / avogadro * cm2_to_m2 * kg_to_g)
263 :
264 : ! this is already in chunk, retrieve it.
265 : ! if the field does not exist, pbuf_get_field will return an error, so sanity check for pbuf_ik is not needed.
266 : call pbuf_get_field(pbuf, tmpIdx, pbuf_ik)
267 :
268 : ! for each col retrieve data from pbuf_ik(I, K)
269 : ! this includes surface layer.
270 : do k = 1, pver
271 : frcing(:ncol,k,m) = frcing(:ncol,k,m) + pbuf_ik(1:ncol,k) * kg_to_molec / ((zint(:ncol,k)-zint(:ncol,k+1)) * km_to_cm)
272 : enddo
273 :
274 : if ( frc_from_dataset(m) ) then
275 : xfcname = trim(extfrc_lst(m))//'_XFRC'
276 : call outfld( xfcname, frcing(:ncol,:,n), ncol, lchnk )
277 : spc_ndx = get_spc_ndx( extfrc_lst(m) )
278 : molec_to_kg = adv_mass( spc_ndx ) / avogadro * cm2_to_m2 * kg_to_g
279 :
280 : frcing_col(:ncol) = 0._r8
281 : frcing_col_kg(:ncol) = 0._r8
282 : do k = 1, pver
283 : frcing_col(:ncol) = frcing_col(:ncol) + frcing(:ncol,k,m)*(zint(:ncol,k)-zint(:ncol,k+1))*km_to_cm
284 : frcing_col_kg(:ncol) = frcing_col_kg(:ncol) + frcing(:ncol,k,m)*(zint(:ncol,k)-zint(:ncol,k+1))*km_to_cm*molec_to_kg
285 : enddo
286 :
287 : xfcname = trim(extfrc_lst(m))//'_CLXF'
288 : call outfld( xfcname, frcing_col(:ncol), ncol, lchnk )
289 : xfcname = trim(extfrc_lst(m))//'_CMXF'
290 : call outfld( xfcname, frcing_col_kg(:ncol), ncol, lchnk )
291 : endif
292 : endif
293 : endif
294 : enddo
295 :
296 0 : end subroutine hco_set_extfrc
297 : !EOC
298 : !------------------------------------------------------------------------------
299 : ! Harmonized Emissions Component (HEMCO) !
300 : !------------------------------------------------------------------------------
301 : !BOP
302 : !
303 : ! !IROUTINE: hco_extfrc_inti
304 : !
305 : ! !DESCRIPTION: Initialize external forcing related diagnostic fields
306 : !\\
307 : !\\
308 : ! !INTERFACE:
309 : !
310 0 : subroutine hco_extfrc_inti( )
311 : !
312 : ! !USES:
313 : !
314 : use chem_mods, only: frc_from_dataset, extcnt, extfrc_lst
315 : use cam_history, only: addfld, add_default, horiz_only
316 : use phys_control, only: phys_getopts
317 : use mo_chem_utls, only: get_extfrc_ndx
318 : implicit none
319 : !
320 : ! !REVISION HISTORY:
321 : ! 04 Nov 2022 - H.P. Lin - Initial version based on extfrc_inti
322 : ! 10 Apr 2023 - H.P. Lin - Now move pcnst_is_extfrc initialization here
323 : !EOP
324 : !------------------------------------------------------------------------------
325 : !BOC
326 : !
327 : ! !LOCAL VARIABLES:
328 : !
329 : logical :: history_aerosol
330 : logical :: history_chemistry
331 : logical :: history_cesm_forcing
332 : character(len=16) :: spc_name
333 : integer :: n
334 :
335 : character(len=255) :: fldname_ns ! field name HCO_NH3
336 : integer :: RC ! return code (dummy)
337 :
338 : ! for first run, cache results of 3-D or 2-D scan within pcnst_is_extfrc
339 : ! to avoid lengthy lookups in future timesteps. hplin 1/12/23
340 : do n = 1, gas_pcnst
341 : pcnst_extfrc_ndx(n) = get_extfrc_ndx(trim(solsym(n)))
342 : pcnst_is_extfrc(n) = (pcnst_extfrc_ndx(n) > 0)
343 :
344 : ! construct information about HCO_* corresponding pbuf location
345 : fldname_ns = 'HCO_' // trim(solsym(n))
346 : hco_pbuf_idx(n) = pbuf_get_index(fldname_ns, RC)
347 : enddo
348 :
349 0 : if(masterproc) then
350 0 : write(iulog,*) "hco_set_srf_emissions: first run pcnst_is_extfrc cache, extfrc_ndx:"
351 : do n = 1, gas_pcnst
352 0 : write(iulog,*) trim(solsym(n)), ' : ', pcnst_is_extfrc(n), pcnst_extfrc_ndx(n)
353 : end do
354 : endif
355 :
356 : ! Replicate functionality in extfrc_inti to create _XFRC... diagnostics
357 : call phys_getopts( &
358 : history_aerosol_out = history_aerosol, &
359 : history_chemistry_out = history_chemistry, &
360 0 : history_cesm_forcing_out = history_cesm_forcing )
361 :
362 : do n= 1,extcnt
363 : if (frc_from_dataset(n)) then
364 : spc_name = extfrc_lst(n)
365 : call addfld( trim(spc_name)//'_XFRC', (/ 'lev' /), 'A', 'molec/cm3/s', &
366 : 'external forcing for '//trim(spc_name) )
367 : call addfld( trim(spc_name)//'_CLXF', horiz_only, 'A', 'molec/cm2/s', &
368 : 'vertically intergrated external forcing for '//trim(spc_name) )
369 : call addfld( trim(spc_name)//'_CMXF', horiz_only, 'A', 'kg/m2/s', &
370 : 'vertically intergrated external forcing for '//trim(spc_name) )
371 : if ( history_aerosol .or. history_chemistry ) then
372 : call add_default( trim(spc_name)//'_CLXF', 1, ' ' )
373 : call add_default( trim(spc_name)//'_CMXF', 1, ' ' )
374 : endif
375 : if ( history_cesm_forcing .and. spc_name == 'NO2' ) then
376 : call add_default( trim(spc_name)//'_CLXF', 1, ' ' )
377 : call add_default( trim(spc_name)//'_CMXF', 1, ' ' )
378 : endif
379 : endif
380 : enddo
381 :
382 0 : end subroutine hco_extfrc_inti
383 : !EOC
384 : end module hco_cc_emissions
|