Line data Source code
1 : module chemistry
2 :
3 : !---------------------------------------------------------------------------------
4 : ! "Interactive" gas phase module
5 : !---------------------------------------------------------------------------------
6 :
7 : use shr_kind_mod, only : r8 => shr_kind_r8, shr_kind_cl
8 : use ppgrid, only : pcols, pver, begchunk, endchunk
9 : use physconst, only : gravit
10 : use constituents, only : pcnst, cnst_add, cnst_name, cnst_fixed_ubc
11 : use chem_mods, only : gas_pcnst
12 : use cam_history, only : fieldname_len
13 : use physics_types, only : physics_state, physics_ptend, physics_ptend_init
14 : use spmd_utils, only : masterproc
15 : use cam_logfile, only : iulog
16 : use mo_gas_phase_chemdr, only : map2chm
17 : use shr_megan_mod, only : shr_megan_mechcomps, shr_megan_mechcomps_n
18 : use srf_field_check, only : active_Fall_flxvoc
19 : use tracer_data, only : MAXTRCRS
20 : use gcr_ionization, only : gcr_ionization_readnl, gcr_ionization_init, gcr_ionization_adv
21 : use epp_ionization, only : epp_ionization_readnl, epp_ionization_adv
22 : use mee_ionization, only : mee_ion_readnl
23 : use mo_apex, only : mo_apex_readnl
24 : use ref_pres, only : ptop_ref
25 : use phys_control, only : waccmx_is ! WACCM-X switch query function
26 : use phys_control, only : use_hemco ! HEMCO switch logical
27 : use mo_chm_diags, only : chem_has_ndep_flx => chm_prod_ndep_flx
28 :
29 : implicit none
30 : private
31 : save
32 :
33 : !---------------------------------------------------------------------------------
34 : ! Public interfaces
35 : !---------------------------------------------------------------------------------
36 : public :: chem_is ! identify which chemistry is being used
37 : public :: chem_register ! register consituents
38 : public :: chem_readnl ! read chem namelist
39 : public :: chem_is_active ! returns true
40 : public :: chem_implements_cnst ! returns true if consituent is implemented by this package
41 : public :: chem_init_cnst ! initialize mixing ratios if not read from initial file
42 : public :: chem_init ! initialize (history) variables
43 : public :: chem_timestep_init ! per timestep initializations
44 : public :: chem_timestep_tend ! interface to tendency computation
45 : public :: chem_final
46 : public :: chem_write_restart
47 : public :: chem_read_restart
48 : public :: chem_init_restart
49 : public :: chem_emissions
50 : public :: chem_has_ndep_flx
51 :
52 : integer, public :: imozart = -1 ! index of 1st constituent
53 :
54 : ! Namelist variables
55 :
56 : ! control
57 :
58 : integer :: chem_freq = 1 ! time steps
59 :
60 : ! ghg
61 :
62 : character(len=shr_kind_cl) :: bndtvg = ' ' ! pathname for greenhouse gas loss rate
63 : character(len=shr_kind_cl) :: h2orates = ' ' ! pathname for greenhouse gas (lyman-alpha H2O loss)
64 :
65 : ! photolysis
66 :
67 : character(len=shr_kind_cl) :: rsf_file = 'rsf_file'
68 : character(len=shr_kind_cl) :: exo_coldens_file = ''
69 : character(len=shr_kind_cl) :: xs_coef_file = 'xs_coef_file'
70 : character(len=shr_kind_cl) :: xs_short_file = 'xs_short_file'
71 : character(len=shr_kind_cl) :: xs_long_file = 'xs_long_file'
72 : character(len=shr_kind_cl) :: electron_file = 'electron_file'
73 : character(len=shr_kind_cl) :: euvac_file = 'NONE'
74 : real(r8) :: photo_max_zen=-huge(1._r8)
75 :
76 : ! solar / geomag data
77 :
78 : character(len=shr_kind_cl) :: photon_file = 'photon_file'
79 :
80 : ! dry dep
81 :
82 : character(len=shr_kind_cl) :: depvel_lnd_file = 'depvel_lnd_file'
83 :
84 : ! emis
85 : integer, parameter :: max_num_emis_files = max(100,2*pcnst)
86 : character(len=shr_kind_cl) :: airpl_emis_file = '' ! airplane emissions
87 : character(len=shr_kind_cl) :: srf_emis_specifier(max_num_emis_files) = ''
88 : character(len=shr_kind_cl) :: ext_frc_specifier(max_num_emis_files) = ''
89 :
90 : character(len=24) :: srf_emis_type = 'CYCLICAL' ! 'CYCLICAL' | 'SERIAL' | 'INTERP_MISSING_MONTHS'
91 : integer :: srf_emis_cycle_yr = 0
92 : integer :: srf_emis_fixed_ymd = 0
93 : integer :: srf_emis_fixed_tod = 0
94 :
95 : character(len=24) :: ext_frc_type = 'CYCLICAL' ! 'CYCLICAL' | 'SERIAL' | 'INTERP_MISSING_MONTHS'
96 : integer :: ext_frc_cycle_yr = 0
97 : integer :: ext_frc_fixed_ymd = 0
98 : integer :: ext_frc_fixed_tod = 0
99 :
100 : ! fixed stratosphere
101 :
102 : character(len=shr_kind_cl) :: fstrat_file = 'fstrat_file'
103 : character(len=16) :: fstrat_list(pcnst) = ''
104 :
105 : !---------------------------------------------------------------------------------
106 : ! dummy values for specific heats at constant pressure
107 : !---------------------------------------------------------------------------------
108 : real(r8), parameter :: cptmp = 666._r8
109 :
110 : character(len=fieldname_len) :: srcnam(gas_pcnst) ! names of source/sink tendencies
111 :
112 : integer :: ixcldliq ! index of liquid cloud water
113 : integer :: ndx_cld
114 : integer :: ndx_cmfdqr
115 : integer :: ndx_nevapr
116 : integer :: ndx_prain
117 : integer :: ndx_cldtop
118 : integer :: h2o_ndx
119 : integer :: ixndrop ! cloud droplet number index
120 : integer :: ndx_pblh
121 : integer :: ndx_fsds
122 :
123 : logical :: ghg_chem = .false. ! .true. => use ghg chem package
124 : logical :: chem_step = .true.
125 : logical :: is_active = .false.
126 :
127 : character(len=32) :: chem_name = 'NONE'
128 : logical :: chem_rad_passive = .false.
129 :
130 : ! for MEGAN emissions
131 : integer, allocatable :: megan_indices_map(:)
132 : real(r8),allocatable :: megan_wght_factors(:)
133 :
134 : logical :: chem_use_chemtrop = .false.
135 :
136 : integer :: srf_ozone_pbf_ndx = -1
137 : logical :: srf_emis_diag(pcnst) = .false.
138 :
139 : !================================================================================================
140 : contains
141 : !================================================================================================
142 :
143 768 : logical function chem_is (name)
144 : use phys_control, only : cam_chempkg_is
145 :
146 : character(len=*), intent(in) :: name
147 0 : chem_is = cam_chempkg_is(name)
148 :
149 0 : end function chem_is
150 :
151 : !================================================================================================
152 :
153 1536 : subroutine chem_register
154 : !-----------------------------------------------------------------------
155 : !
156 : ! Purpose: register advected constituents and physics buffer fields
157 : !
158 : !-----------------------------------------------------------------------
159 :
160 : use mo_sim_dat, only : set_sim_dat
161 : use chem_mods, only : gas_pcnst, adv_mass
162 : use mo_tracname, only : solsym
163 : use mo_chem_utls, only : get_spc_ndx, get_inv_ndx
164 : use short_lived_species, only : slvd_index, short_lived_map=>map, register_short_lived_species
165 : use cfc11star, only : register_cfc11star
166 : use mo_photo, only : photo_register
167 : use mo_aurora, only : aurora_register
168 : use aero_model, only : aero_model_register
169 : use physics_buffer, only : pbuf_add_field, dtype_r8
170 : use upper_bc, only : ubc_fixed_conc
171 :
172 : implicit none
173 :
174 : !-----------------------------------------------------------------------
175 : ! Local variables
176 : !-----------------------------------------------------------------------
177 : integer :: m, n ! tracer index
178 : real(r8) :: qmin ! min value
179 : logical :: ic_from_cam2 ! wrk variable for initial cond input
180 : logical :: has_fixed_ubc ! wrk variable for upper bndy cond
181 : logical :: has_fixed_ubflx ! wrk variable for upper bndy flux
182 : integer :: ch4_ndx, n2o_ndx, o3_ndx, o3_inv_ndx, ndx
183 : integer :: cfc11_ndx, cfc12_ndx, o2_1s_ndx, o2_1d_ndx, o2_ndx
184 : integer :: n_ndx, no_ndx, h_ndx, h2_ndx, o_ndx, e_ndx, np_ndx
185 : integer :: op_ndx, o1d_ndx, n2d_ndx, nop_ndx, n2p_ndx, o2p_ndx
186 : integer :: hf_ndx, f_ndx
187 :
188 : character(len=128) :: lng_name ! variable long name
189 : logical :: cam_outfld
190 : character(len=128) :: mixtype
191 : character(len=128) :: molectype
192 : logical :: ndropmixed
193 : integer :: islvd
194 :
195 : !-----------------------------------------------------------------------
196 : ! Set the simulation chemistry variables
197 : !-----------------------------------------------------------------------
198 1536 : call set_sim_dat
199 :
200 1536 : o3_ndx = get_spc_ndx('O3')
201 1536 : o3_inv_ndx= get_inv_ndx('O3')
202 1536 : ch4_ndx = get_spc_ndx('CH4')
203 1536 : n2o_ndx = get_spc_ndx('N2O')
204 :
205 1536 : cfc11_ndx = get_spc_ndx('CFC11')
206 1536 : cfc12_ndx = get_spc_ndx('CFC12')
207 1536 : o2_1s_ndx = get_spc_ndx('O2_1S')
208 1536 : o2_1d_ndx = get_spc_ndx('O2_1D')
209 1536 : o2_ndx = get_spc_ndx('O2')
210 : n_ndx = get_spc_ndx('N')
211 : no_ndx = get_spc_ndx('NO')
212 1536 : h_ndx = get_spc_ndx('H')
213 : h2_ndx = get_spc_ndx('H2')
214 1536 : o_ndx = get_spc_ndx('O')
215 1536 : e_ndx = get_spc_ndx('e')
216 1536 : np_ndx = get_spc_ndx('Np')
217 1536 : op_ndx = get_spc_ndx('Op')
218 1536 : o1d_ndx = get_spc_ndx('O1D')
219 1536 : n2d_ndx = get_spc_ndx('N2D')
220 1536 : n2p_ndx = get_spc_ndx('N2p')
221 1536 : nop_ndx = get_spc_ndx('NOp')
222 1536 : h2o_ndx = get_spc_ndx('H2O')
223 1536 : o2p_ndx = get_spc_ndx('O2p')
224 :
225 : f_ndx = get_spc_ndx('F')
226 : hf_ndx = get_spc_ndx('HF')
227 :
228 1536 : if (o3_ndx>0 .or. o3_inv_ndx>0) then
229 1536 : call pbuf_add_field('SRFOZONE','global',dtype_r8,(/pcols/),srf_ozone_pbf_ndx)
230 : endif
231 :
232 : !-----------------------------------------------------------------------
233 : ! Set names of diffused variable tendencies and declare them as history variables
234 : !-----------------------------------------------------------------------
235 : !----------------------------------------------------------------------------------
236 : ! For WACCM-X, change variable has_fixed_ubc from .true. to .false. which is a flag
237 : ! used later to check for a fixed upper boundary condition for species.
238 : !----------------------------------------------------------------------------------
239 49152 : do m = 1,gas_pcnst
240 : ! setting of these variables is for registration of transported species
241 47616 : ic_from_cam2 = .true.
242 47616 : has_fixed_ubc = ubc_fixed_conc(solsym(m))
243 47616 : has_fixed_ubflx = .false.
244 47616 : ndropmixed = .false.
245 47616 : lng_name = trim( solsym(m) )
246 47616 : molectype = 'minor'
247 :
248 47616 : qmin = 1.e-36_r8
249 :
250 47616 : if ( index(lng_name,'_a')>0 ) then ! modal aerosol species undergoes ndrop activation mixing
251 29184 : ndropmixed = .true.
252 : endif
253 :
254 47616 : if ( lng_name(1:5) .eq. 'num_a' ) then ! aerosol number density
255 6144 : qmin = 1.e-5_r8
256 41472 : else if ( m == o3_ndx ) then
257 0 : qmin = 1.e-12_r8
258 41472 : else if ( m == ch4_ndx ) then
259 1536 : qmin = 1.e-12_r8
260 39936 : else if ( m == n2o_ndx ) then
261 1536 : qmin = 1.e-15_r8
262 38400 : else if( m == cfc11_ndx .or. m == cfc12_ndx ) then
263 3072 : qmin = 1.e-20_r8
264 35328 : else if( m == o2_1s_ndx .or. m == o2_1d_ndx ) then
265 0 : ic_from_cam2 = .false.
266 0 : if( m == o2_1d_ndx ) then
267 0 : lng_name = 'O2(1-delta)'
268 : else
269 0 : lng_name = 'O2(1-sigma)'
270 : end if
271 35328 : else if ( m==o2_ndx .or. m==o_ndx .or. m==h_ndx ) then
272 0 : if ( waccmx_is('ionosphere') .or. waccmx_is('neutral') ) then
273 0 : if ( m == h_ndx ) has_fixed_ubflx = .true. ! fixed flux value for H at UB
274 0 : if ( m == o2_ndx .or. m == o_ndx ) molectype = 'major'
275 : endif
276 35328 : else if( m == e_ndx ) then
277 0 : lng_name = 'electron concentration'
278 35328 : else if( m == np_ndx ) then
279 0 : lng_name = 'N+'
280 35328 : else if( m == op_ndx ) then
281 0 : lng_name = 'O+'
282 35328 : else if( m == o1d_ndx ) then
283 0 : lng_name = 'O(1D)'
284 35328 : else if( m == n2d_ndx ) then
285 0 : lng_name = 'N(2D)'
286 35328 : else if( m == o2p_ndx ) then
287 0 : lng_name = 'O2+'
288 35328 : else if( m == n2p_ndx ) then
289 0 : lng_name = 'N2+'
290 35328 : else if( m == nop_ndx ) then
291 0 : lng_name = 'NO+'
292 35328 : else if( m == h2o_ndx ) then
293 1536 : map2chm(1) = m
294 1536 : cycle
295 : endif
296 :
297 46080 : cam_outfld=.false.
298 46080 : is_active = .true.
299 46080 : mixtype = 'dry'
300 :
301 46080 : islvd = slvd_index(solsym(m))
302 :
303 47616 : if ( islvd > 0 ) then
304 0 : short_lived_map(islvd) = m
305 : else
306 : call cnst_add( solsym(m), adv_mass(m), cptmp, qmin, n, readiv=ic_from_cam2, cam_outfld=cam_outfld, &
307 : mixtype=mixtype, molectype=molectype, ndropmixed=ndropmixed, &
308 : fixed_ubc=has_fixed_ubc, fixed_ubflx=has_fixed_ubflx, &
309 46080 : longname=trim(lng_name) )
310 :
311 46080 : if( imozart == -1 ) then
312 1536 : imozart = n
313 : end if
314 46080 : map2chm(n) = m
315 : endif
316 :
317 : end do
318 :
319 1536 : call register_short_lived_species()
320 1536 : call register_cfc11star()
321 :
322 1536 : if ( waccmx_is('ionosphere') ) then
323 0 : call photo_register()
324 0 : call aurora_register()
325 : endif
326 :
327 : ! add fields to pbuf needed by aerosol models
328 1536 : call aero_model_register()
329 :
330 1536 : end subroutine chem_register
331 :
332 : !================================================================================================
333 :
334 1536 : subroutine chem_readnl(nlfile)
335 :
336 : ! Read chem namelist group.
337 :
338 1536 : use cam_abortutils, only: endrun
339 : use namelist_utils, only: find_group_name
340 : use units, only: getunit, freeunit
341 : use mpishorthand
342 :
343 : use tracer_cnst, only: tracer_cnst_defaultopts, tracer_cnst_setopts
344 : use tracer_srcs, only: tracer_srcs_defaultopts, tracer_srcs_setopts
345 : use aero_model, only: aero_model_readnl
346 : use gas_wetdep_opts, only: gas_wetdep_readnl
347 : use mo_drydep, only: drydep_srf_file
348 : use mo_sulf, only: sulf_readnl
349 : use species_sums_diags,only: species_sums_readnl
350 : use ocean_emis, only: ocean_emis_readnl
351 :
352 : ! args
353 :
354 : character(len=*), intent(in) :: nlfile ! filepath for file containing namelist input
355 :
356 : ! local vars
357 : integer :: unitn, ierr
358 :
359 : ! trop_mozart prescribed constituent concentratons
360 : character(len=shr_kind_cl) :: tracer_cnst_file ! prescribed data file
361 : character(len=shr_kind_cl) :: tracer_cnst_filelist ! list of prescribed data files (series of files)
362 : character(len=shr_kind_cl) :: tracer_cnst_datapath ! absolute path of prescribed data files
363 : character(len=24) :: tracer_cnst_type ! 'INTERP_MISSING_MONTHS' | 'CYCLICAL' | 'SERIAL' (default)
364 : character(len=shr_kind_cl) :: tracer_cnst_specifier(MAXTRCRS) ! string array where each
365 : logical :: tracer_cnst_rmfile ! remove data file from local disk (default .false.)
366 : integer :: tracer_cnst_cycle_yr
367 : integer :: tracer_cnst_fixed_ymd
368 : integer :: tracer_cnst_fixed_tod
369 :
370 : ! trop_mozart prescribed constituent sourrces/sinks
371 : character(len=shr_kind_cl) :: tracer_srcs_file ! prescribed data file
372 : character(len=shr_kind_cl) :: tracer_srcs_filelist ! list of prescribed data files (series of files)
373 : character(len=shr_kind_cl) :: tracer_srcs_datapath ! absolute path of prescribed data files
374 : character(len=24) :: tracer_srcs_type ! 'INTERP_MISSING_MONTHS' | 'CYCLICAL' | 'SERIAL' (default)
375 : character(len=shr_kind_cl) :: tracer_srcs_specifier(MAXTRCRS) ! string array where each
376 : logical :: tracer_srcs_rmfile ! remove data file from local disk (default .false.)
377 : integer :: tracer_srcs_cycle_yr
378 : integer :: tracer_srcs_fixed_ymd
379 : integer :: tracer_srcs_fixed_tod
380 :
381 : namelist /chem_inparm/ chem_freq, airpl_emis_file, &
382 : euvac_file, photon_file, electron_file, &
383 : xs_coef_file, xs_short_file, &
384 : exo_coldens_file, &
385 : xs_long_file, rsf_file, photo_max_zen, &
386 : depvel_lnd_file, drydep_srf_file, &
387 : srf_emis_type, srf_emis_cycle_yr, srf_emis_fixed_ymd, srf_emis_fixed_tod, srf_emis_specifier, &
388 : fstrat_file, fstrat_list, &
389 : ext_frc_specifier, ext_frc_type, ext_frc_cycle_yr, ext_frc_fixed_ymd, ext_frc_fixed_tod
390 :
391 : namelist /chem_inparm/ chem_rad_passive
392 :
393 : ! ghg chem
394 :
395 : namelist /chem_inparm/ bndtvg, h2orates, ghg_chem
396 :
397 : ! prescribed chem tracers
398 :
399 : namelist /chem_inparm/ &
400 : tracer_cnst_file, tracer_cnst_filelist, tracer_cnst_datapath, &
401 : tracer_cnst_type, tracer_cnst_specifier, &
402 : tracer_srcs_file, tracer_srcs_filelist, tracer_srcs_datapath, &
403 : tracer_srcs_type, tracer_srcs_specifier, &
404 : tracer_cnst_rmfile, tracer_cnst_cycle_yr, tracer_cnst_fixed_ymd, tracer_cnst_fixed_tod, &
405 : tracer_srcs_rmfile, tracer_srcs_cycle_yr, tracer_srcs_fixed_ymd, tracer_srcs_fixed_tod
406 :
407 : ! tropopause level control
408 : namelist /chem_inparm/ chem_use_chemtrop
409 :
410 : ! get the default settings
411 :
412 : call tracer_cnst_defaultopts( &
413 : tracer_cnst_file_out = tracer_cnst_file, &
414 : tracer_cnst_filelist_out = tracer_cnst_filelist, &
415 : tracer_cnst_datapath_out = tracer_cnst_datapath, &
416 : tracer_cnst_type_out = tracer_cnst_type, &
417 : tracer_cnst_specifier_out = tracer_cnst_specifier, &
418 : tracer_cnst_rmfile_out = tracer_cnst_rmfile, &
419 : tracer_cnst_cycle_yr_out = tracer_cnst_cycle_yr, &
420 : tracer_cnst_fixed_ymd_out = tracer_cnst_fixed_ymd, &
421 1536 : tracer_cnst_fixed_tod_out = tracer_cnst_fixed_tod )
422 : call tracer_srcs_defaultopts( &
423 : tracer_srcs_file_out = tracer_srcs_file, &
424 : tracer_srcs_filelist_out = tracer_srcs_filelist, &
425 : tracer_srcs_datapath_out = tracer_srcs_datapath, &
426 : tracer_srcs_type_out = tracer_srcs_type, &
427 : tracer_srcs_specifier_out = tracer_srcs_specifier, &
428 : tracer_srcs_rmfile_out = tracer_srcs_rmfile, &
429 : tracer_srcs_cycle_yr_out = tracer_srcs_cycle_yr, &
430 : tracer_srcs_fixed_ymd_out = tracer_srcs_fixed_ymd, &
431 1536 : tracer_srcs_fixed_tod_out = tracer_srcs_fixed_tod )
432 :
433 1536 : drydep_srf_file = ' '
434 :
435 1536 : if (masterproc) then
436 2 : unitn = getunit()
437 2 : open( unitn, file=trim(nlfile), status='old' )
438 2 : call find_group_name(unitn, 'chem_inparm', status=ierr)
439 2 : if (ierr == 0) then
440 2 : read(unitn, chem_inparm, iostat=ierr)
441 2 : if (ierr /= 0) then
442 0 : call endrun('chem_readnl: ERROR reading namelist')
443 : end if
444 : end if
445 2 : close(unitn)
446 2 : call freeunit(unitn)
447 : end if
448 :
449 : #ifdef SPMD
450 : ! Broadcast namelist variables
451 :
452 : ! control
453 :
454 1536 : call mpibcast (chem_freq, 1, mpiint, 0, mpicom)
455 :
456 1536 : call mpibcast (chem_rad_passive, 1, mpilog, 0, mpicom)
457 :
458 : ! ghg
459 :
460 1536 : call mpibcast (ghg_chem, 1, mpilog, 0, mpicom)
461 1536 : call mpibcast (bndtvg, len(bndtvg), mpichar, 0, mpicom)
462 1536 : call mpibcast (h2orates, len(h2orates), mpichar, 0, mpicom)
463 :
464 : ! photolysis
465 :
466 1536 : call mpibcast (rsf_file, len(rsf_file), mpichar, 0, mpicom)
467 1536 : call mpibcast (exo_coldens_file, len(exo_coldens_file), mpichar, 0, mpicom)
468 1536 : call mpibcast (xs_coef_file, len(xs_coef_file), mpichar, 0, mpicom)
469 1536 : call mpibcast (xs_short_file, len(xs_short_file), mpichar, 0, mpicom)
470 1536 : call mpibcast (xs_long_file, len(xs_long_file), mpichar, 0, mpicom)
471 1536 : call mpibcast (photo_max_zen, 1, mpir8, 0, mpicom)
472 1536 : call mpibcast (electron_file, len(electron_file), mpichar, 0, mpicom)
473 1536 : call mpibcast (euvac_file, len(euvac_file), mpichar, 0, mpicom)
474 :
475 : ! solar / geomag data
476 :
477 1536 : call mpibcast (photon_file, len(photon_file), mpichar, 0, mpicom)
478 :
479 : ! dry dep
480 :
481 1536 : call mpibcast (depvel_lnd_file, len(depvel_lnd_file), mpichar, 0, mpicom)
482 1536 : call mpibcast (drydep_srf_file, len(drydep_srf_file), mpichar, 0, mpicom)
483 :
484 : ! emis
485 :
486 1536 : call mpibcast (airpl_emis_file, len(airpl_emis_file), mpichar, 0, mpicom)
487 1536 : call mpibcast (srf_emis_specifier,len(srf_emis_specifier(1))*pcnst,mpichar, 0, mpicom)
488 1536 : call mpibcast (srf_emis_type, len(srf_emis_type), mpichar, 0, mpicom)
489 1536 : call mpibcast (srf_emis_cycle_yr, 1, mpiint, 0, mpicom)
490 1536 : call mpibcast (srf_emis_fixed_ymd,1, mpiint, 0, mpicom)
491 1536 : call mpibcast (srf_emis_fixed_tod,1, mpiint, 0, mpicom)
492 1536 : call mpibcast (ext_frc_specifier, len(ext_frc_specifier(1))*pcnst, mpichar, 0, mpicom)
493 1536 : call mpibcast (ext_frc_type, len(ext_frc_type), mpichar, 0, mpicom)
494 1536 : call mpibcast (ext_frc_cycle_yr, 1, mpiint, 0, mpicom)
495 1536 : call mpibcast (ext_frc_fixed_ymd, 1, mpiint, 0, mpicom)
496 1536 : call mpibcast (ext_frc_fixed_tod, 1, mpiint, 0, mpicom)
497 :
498 :
499 : ! fixed stratosphere
500 :
501 1536 : call mpibcast (fstrat_file, len(fstrat_file), mpichar, 0, mpicom)
502 1536 : call mpibcast (fstrat_list, len(fstrat_list(1))*pcnst, mpichar, 0, mpicom)
503 :
504 : ! prescribed chemical tracers
505 :
506 1536 : call mpibcast (tracer_cnst_specifier, len(tracer_cnst_specifier(1))*MAXTRCRS, mpichar, 0, mpicom)
507 1536 : call mpibcast (tracer_cnst_file, len(tracer_cnst_file), mpichar, 0, mpicom)
508 1536 : call mpibcast (tracer_cnst_filelist, len(tracer_cnst_filelist), mpichar, 0, mpicom)
509 1536 : call mpibcast (tracer_cnst_datapath, len(tracer_cnst_datapath), mpichar, 0, mpicom)
510 1536 : call mpibcast (tracer_cnst_type, len(tracer_cnst_type), mpichar, 0, mpicom)
511 1536 : call mpibcast (tracer_cnst_rmfile, 1, mpilog, 0, mpicom)
512 1536 : call mpibcast (tracer_cnst_cycle_yr, 1, mpiint, 0, mpicom)
513 1536 : call mpibcast (tracer_cnst_fixed_ymd, 1, mpiint, 0, mpicom)
514 1536 : call mpibcast (tracer_cnst_fixed_tod, 1, mpiint, 0, mpicom)
515 :
516 1536 : call mpibcast (tracer_srcs_specifier, len(tracer_srcs_specifier(1))*MAXTRCRS, mpichar, 0, mpicom)
517 1536 : call mpibcast (tracer_srcs_file, len(tracer_srcs_file), mpichar, 0, mpicom)
518 1536 : call mpibcast (tracer_srcs_filelist, len(tracer_srcs_filelist), mpichar, 0, mpicom)
519 1536 : call mpibcast (tracer_srcs_datapath, len(tracer_srcs_datapath), mpichar, 0, mpicom)
520 1536 : call mpibcast (tracer_srcs_type, len(tracer_srcs_type), mpichar, 0, mpicom)
521 1536 : call mpibcast (tracer_srcs_rmfile, 1, mpilog, 0, mpicom)
522 1536 : call mpibcast (tracer_srcs_cycle_yr, 1, mpiint, 0, mpicom)
523 1536 : call mpibcast (tracer_srcs_fixed_ymd, 1, mpiint, 0, mpicom)
524 1536 : call mpibcast (tracer_srcs_fixed_tod, 1, mpiint, 0, mpicom)
525 :
526 1536 : call mpibcast (chem_use_chemtrop,1, mpilog, 0, mpicom)
527 :
528 : #endif
529 :
530 : ! set the options
531 :
532 : call tracer_cnst_setopts( &
533 : tracer_cnst_file_in = tracer_cnst_file, &
534 : tracer_cnst_filelist_in = tracer_cnst_filelist, &
535 : tracer_cnst_datapath_in = tracer_cnst_datapath, &
536 : tracer_cnst_type_in = tracer_cnst_type, &
537 : tracer_cnst_specifier_in = tracer_cnst_specifier, &
538 : tracer_cnst_rmfile_in = tracer_cnst_rmfile, &
539 : tracer_cnst_cycle_yr_in = tracer_cnst_cycle_yr, &
540 : tracer_cnst_fixed_ymd_in = tracer_cnst_fixed_ymd, &
541 1536 : tracer_cnst_fixed_tod_in = tracer_cnst_fixed_tod )
542 : call tracer_srcs_setopts( &
543 : tracer_srcs_file_in = tracer_srcs_file, &
544 : tracer_srcs_filelist_in = tracer_srcs_filelist, &
545 : tracer_srcs_datapath_in = tracer_srcs_datapath, &
546 : tracer_srcs_type_in = tracer_srcs_type, &
547 : tracer_srcs_specifier_in = tracer_srcs_specifier, &
548 : tracer_srcs_rmfile_in = tracer_srcs_rmfile, &
549 : tracer_srcs_cycle_yr_in = tracer_srcs_cycle_yr, &
550 : tracer_srcs_fixed_ymd_in = tracer_srcs_fixed_ymd, &
551 1536 : tracer_srcs_fixed_tod_in = tracer_srcs_fixed_tod )
552 :
553 1536 : call aero_model_readnl(nlfile)
554 : !
555 1536 : call gas_wetdep_readnl(nlfile)
556 1536 : call gcr_ionization_readnl(nlfile)
557 1536 : call epp_ionization_readnl(nlfile)
558 1536 : call mee_ion_readnl(nlfile)
559 1536 : call mo_apex_readnl(nlfile)
560 1536 : call sulf_readnl(nlfile)
561 1536 : call species_sums_readnl(nlfile)
562 1536 : call ocean_emis_readnl(nlfile)
563 :
564 1536 : end subroutine chem_readnl
565 :
566 : !================================================================================================
567 :
568 58824 : function chem_is_active()
569 : !-----------------------------------------------------------------------
570 : ! Purpose: return true if this package is active
571 : !-----------------------------------------------------------------------
572 : logical :: chem_is_active
573 : !-----------------------------------------------------------------------
574 58824 : chem_is_active = is_active
575 1536 : end function chem_is_active
576 :
577 : !================================================================================================
578 :
579 0 : function chem_implements_cnst(name)
580 : !-----------------------------------------------------------------------
581 : !
582 : ! Purpose: return true if specified constituent is implemented by this package
583 : !
584 : ! Author: B. Eaton
585 : !
586 : !-----------------------------------------------------------------------
587 : use chem_mods, only : gas_pcnst, inv_lst, nfs
588 : use mo_tracname, only : solsym
589 :
590 : !-----------------------------------------------------------------------
591 : ! ... dummy arguments
592 : !-----------------------------------------------------------------------
593 : character(len=*), intent(in) :: name ! constituent name
594 : logical :: chem_implements_cnst ! return value
595 : !-----------------------------------------------------------------------
596 : ! ... local variables
597 : !-----------------------------------------------------------------------
598 : integer :: m
599 :
600 0 : chem_implements_cnst = .false.
601 0 : do m = 1,gas_pcnst
602 0 : if( trim(name) /= 'H2O' ) then
603 0 : if( trim(name) == solsym(m) ) then
604 0 : chem_implements_cnst = .true.
605 0 : exit
606 : end if
607 : end if
608 : end do
609 0 : do m = 1,nfs
610 0 : if( trim(name) /= 'H2O' ) then
611 0 : if( trim(name) == inv_lst(m) ) then
612 0 : chem_implements_cnst = .true.
613 0 : exit
614 : end if
615 : endif
616 : enddo
617 :
618 0 : end function chem_implements_cnst
619 :
620 3072 : subroutine chem_init(phys_state, pbuf2d)
621 :
622 : !-----------------------------------------------------------------------
623 : !
624 : ! Purpose: initialize parameterized greenhouse gas chemistry
625 : ! (declare history variables)
626 : !
627 : ! Method:
628 : ! <Describe the algorithm(s) used in the routine.>
629 : ! <Also include any applicable external references.>
630 : !
631 : ! Author: NCAR CMS
632 : !
633 : !-----------------------------------------------------------------------
634 : use physics_buffer, only : physics_buffer_desc, pbuf_get_index, pbuf_set_field
635 : use time_manager, only : is_first_step
636 : use constituents, only : cnst_get_ind
637 : use cam_history, only : addfld, add_default, horiz_only, fieldname_len
638 : use chem_mods, only : gas_pcnst
639 : use mo_chemini, only : chemini
640 : use mo_ghg_chem, only : ghg_chem_init
641 : use mo_tracname, only : solsym
642 : use cfc11star, only : init_cfc11star
643 : use phys_control, only : phys_getopts
644 : use chem_mods, only : adv_mass
645 : use infnan, only : nan, assignment(=)
646 : use mo_chem_utls, only : get_spc_ndx
647 : use cam_abortutils, only : endrun
648 : use aero_model, only : aero_model_init
649 : use constituents, only : sflxnam
650 : use fire_emissions, only : fire_emissions_init
651 : use short_lived_species, only : short_lived_species_initic
652 : use ocean_emis, only : ocean_emis_init, ocean_emis_species
653 : use mo_srf_emissions, only : has_emis
654 :
655 : type(physics_buffer_desc), pointer :: pbuf2d(:,:)
656 : type(physics_state), intent(in):: phys_state(begchunk:endchunk)
657 :
658 :
659 : !-----------------------------------------------------------------------
660 : ! Local variables
661 : !-----------------------------------------------------------------------
662 : integer :: m ! tracer indicies
663 : character(len=fieldname_len) :: spc_name
664 : integer :: n, ii, ierr
665 : logical :: history_aerosol
666 : logical :: history_chemistry
667 : logical :: history_cesm_forcing
668 :
669 : character(len=2) :: unit_basename ! Units 'kg' or '1'
670 : logical :: history_budget ! output tendencies and state variables for CAM
671 : ! temperature, water vapor, cloud ice and cloud
672 : ! liquid budgets.
673 : integer :: history_budget_histfile_num ! output history file number for budget fields
674 :
675 : character(len=*), parameter :: prefix = 'chem_init: '
676 :
677 : call phys_getopts( cam_chempkg_out=chem_name, &
678 : history_aerosol_out=history_aerosol , &
679 : history_chemistry_out=history_chemistry , &
680 : history_budget_out = history_budget , &
681 : history_budget_histfile_num_out = history_budget_histfile_num, &
682 1536 : history_cesm_forcing_out = history_cesm_forcing )
683 :
684 : ! Initialize aerosols
685 1536 : call aero_model_init( pbuf2d )
686 :
687 : !-----------------------------------------------------------------------
688 : ! Get liq and ice cloud water indicies
689 : !-----------------------------------------------------------------------
690 1536 : call cnst_get_ind( 'CLDLIQ', ixcldliq )
691 1536 : call cnst_get_ind( 'NUMLIQ', ixndrop, abort=.false. )
692 :
693 : !-----------------------------------------------------------------------
694 : ! get pbuf indicies
695 : !-----------------------------------------------------------------------
696 1536 : ndx_cld = pbuf_get_index('CLD')
697 1536 : ndx_cmfdqr = pbuf_get_index('RPRDTOT')
698 1536 : ndx_nevapr = pbuf_get_index('NEVAPR')
699 1536 : ndx_prain = pbuf_get_index('PRAIN')
700 1536 : ndx_cldtop = pbuf_get_index('CLDTOP')
701 1536 : ndx_pblh = pbuf_get_index('pblh')
702 1536 : ndx_fsds = pbuf_get_index('FSDS')
703 :
704 3072 : call addfld( 'HEIGHT', (/ 'ilev' /),'A','m', 'geopotential height above surface at interfaces (m)' )
705 3072 : call addfld( 'CT_H2O_GHG', (/ 'lev' /), 'A','kg/kg/s', 'ghg-chem h2o source/sink' )
706 :
707 : !-----------------------------------------------------------------------
708 : ! Initialize chemistry modules
709 : !-----------------------------------------------------------------------
710 : call chemini &
711 : ( euvac_file &
712 : , photon_file &
713 : , electron_file &
714 : , airpl_emis_file &
715 : , depvel_lnd_file &
716 : , xs_coef_file &
717 : , xs_short_file &
718 : , xs_long_file &
719 : , photo_max_zen &
720 : , rsf_file &
721 : , fstrat_file &
722 : , fstrat_list &
723 : , srf_emis_specifier &
724 : , srf_emis_type &
725 : , srf_emis_cycle_yr &
726 : , srf_emis_fixed_ymd &
727 : , srf_emis_fixed_tod &
728 : , ext_frc_specifier &
729 : , ext_frc_type &
730 : , ext_frc_cycle_yr &
731 : , ext_frc_fixed_ymd &
732 : , ext_frc_fixed_tod &
733 : , exo_coldens_file &
734 : , use_hemco &
735 : , pbuf2d &
736 1536 : )
737 :
738 1536 : if ( ghg_chem ) then
739 1536 : call ghg_chem_init(phys_state, bndtvg, h2orates)
740 : endif
741 :
742 1536 : call init_cfc11star(pbuf2d)
743 :
744 : ! MEGAN emissions initialize
745 1536 : if (shr_megan_mechcomps_n>0) then
746 :
747 4608 : allocate( megan_indices_map(shr_megan_mechcomps_n), stat=ierr)
748 1536 : if( ierr /= 0 ) then
749 0 : call endrun(prefix//'failed to allocate megan_indices_map')
750 : end if
751 4608 : allocate( megan_wght_factors(shr_megan_mechcomps_n), stat=ierr)
752 1536 : if( ierr /= 0 ) then
753 0 : call endrun(prefix//'failed to allocate megan_indices_map')
754 : end if
755 1536 : megan_wght_factors(:) = nan
756 :
757 3072 : do n=1,shr_megan_mechcomps_n
758 1536 : call cnst_get_ind (shr_megan_mechcomps(n)%name, megan_indices_map(n), abort=.false.)
759 1536 : ii = get_spc_ndx(shr_megan_mechcomps(n)%name)
760 1536 : if (ii>0) then
761 1536 : megan_wght_factors(n) = adv_mass(ii)*1.e-3_r8 ! kg/moles (to convert moles/m2/sec to kg/m2/sec)
762 : else
763 : call endrun( 'gas_phase_chemdr_inti: MEGAN compound not in chemistry mechanism : '&
764 0 : //trim(shr_megan_mechcomps(n)%name))
765 : endif
766 :
767 : ! MEGAN history fields
768 0 : call addfld( 'MEG_'//trim(shr_megan_mechcomps(n)%name),horiz_only,'A','kg/m2/sec',&
769 1536 : trim(shr_megan_mechcomps(n)%name)//' MEGAN emissions flux')
770 1536 : if (history_chemistry) then
771 1536 : call add_default('MEG_'//trim(shr_megan_mechcomps(n)%name), 1, ' ')
772 : endif
773 :
774 3072 : srf_emis_diag(megan_indices_map(n)) = .true.
775 : enddo
776 : endif
777 :
778 : ! Galatic Cosmic Rays ...
779 1536 : call gcr_ionization_init()
780 :
781 : ! Fire emissions ...
782 1536 : call fire_emissions_init()
783 :
784 1536 : call short_lived_species_initic()
785 :
786 1536 : call ocean_emis_init()
787 :
788 : !-----------------------------------------------------------------------
789 : ! Set names of chemistry variable tendencies and declare them as history variables
790 : !-----------------------------------------------------------------------
791 49152 : do m = 1,gas_pcnst
792 47616 : spc_name = solsym(m)
793 47616 : srcnam(m) = 'CT_' // spc_name ! chem tendancy (source/sink)
794 :
795 95232 : call addfld( srcnam(m), (/ 'lev' /), 'A', 'kg/kg/s', trim(spc_name)//' source/sink' )
796 47616 : call cnst_get_ind(solsym(m), n, abort=.false.)
797 :
798 49152 : if ( n>0 ) then
799 46080 : if (has_emis(m) .or. aero_has_emis(solsym(m)) .or. ocean_emis_species(solsym(m)) .or. srf_emis_diag(n)) then
800 26112 : srf_emis_diag(n) = .true.
801 :
802 26112 : if (sflxnam(n)(3:5) == 'num') then ! name is in the form of "SF****"
803 6144 : unit_basename = ' 1'
804 : else
805 19968 : unit_basename = 'kg'
806 : endif
807 :
808 26112 : call addfld (sflxnam(n),horiz_only, 'A', unit_basename//'/m2/s',trim(solsym(m))//' surface flux')
809 26112 : if ( history_aerosol .or. history_chemistry ) then
810 26112 : call add_default( sflxnam(n), 1, ' ' )
811 : endif
812 :
813 26112 : if ( history_cesm_forcing ) then
814 0 : if ( spc_name == 'NO' .or. spc_name == 'NH3' ) then
815 0 : call add_default( sflxnam(n), 1, ' ' )
816 : endif
817 : endif
818 :
819 : endif
820 : endif
821 : end do
822 :
823 : ! Add chemical tendency of water vapor to water budget output
824 1536 : if ( history_budget ) then
825 0 : call add_default ('CT_H2O' , history_budget_histfile_num, ' ')
826 : endif
827 :
828 : ! initialize srf ozone to zero
829 2304 : if (is_first_step() .and. srf_ozone_pbf_ndx>0) then
830 768 : call pbuf_set_field(pbuf2d, srf_ozone_pbf_ndx, 0._r8)
831 : end if
832 :
833 : contains
834 :
835 46080 : pure logical function aero_has_emis(spcname)
836 1536 : use seasalt_model, only: seasalt_names
837 : use dust_model, only: dust_names
838 :
839 : character(len=*),intent(in) :: spcname
840 :
841 534528 : aero_has_emis = any(seasalt_names(:) == spcname).or.any(dust_names(:) == spcname)
842 :
843 46080 : end function aero_has_emis
844 :
845 : end subroutine chem_init
846 :
847 : !================================================================================
848 : !================================================================================
849 58824 : subroutine chem_emissions( state, cam_in, pbuf )
850 : use physics_buffer, only: physics_buffer_desc
851 : use aero_model, only: aero_model_emissions
852 : use camsrfexch, only: cam_in_t
853 : use constituents, only: sflxnam
854 : use cam_history, only: outfld
855 : use mo_srf_emissions, only: set_srf_emissions
856 : use hco_cc_emissions, only: hco_set_srf_emissions
857 : use fire_emissions, only: fire_emissions_srf
858 : use ocean_emis, only: ocean_emis_getflux
859 :
860 : ! Arguments:
861 :
862 : type(physics_state), intent(in) :: state ! Physics state variables
863 : type(cam_in_t), intent(inout) :: cam_in ! import state
864 : type(physics_buffer_desc), pointer :: pbuf(:) ! Physics buffer in chunk, for HEMCO
865 :
866 : ! local vars
867 :
868 : integer :: lchnk, ncol
869 : integer :: i, m,n
870 :
871 : real(r8) :: sflx(pcols,gas_pcnst)
872 : real(r8) :: megflx(pcols)
873 :
874 58824 : lchnk = state%lchnk
875 58824 : ncol = state%ncol
876 :
877 : ! initialize chemistry constituent surface fluxes to zero
878 2411784 : do m = 2,pcnst
879 2352960 : n = map2chm(m)
880 30647304 : if (n>0) cam_in%cflx(:,m) = 0._r8
881 : enddo
882 :
883 : ! aerosol emissions ...
884 58824 : call aero_model_emissions( state, cam_in )
885 :
886 : ! MEGAN emissions ...
887 :
888 58824 : if ( active_Fall_flxvoc .and. shr_megan_mechcomps_n>0 ) then
889 :
890 : ! set MEGAN fluxes
891 117648 : do n = 1,shr_megan_mechcomps_n
892 982224 : do i =1,ncol
893 923400 : megflx(i) = -cam_in%meganflx(i,n) * megan_wght_factors(n)
894 982224 : cam_in%cflx(i,megan_indices_map(n)) = cam_in%cflx(i,megan_indices_map(n)) + megflx(i)
895 : enddo
896 :
897 : ! output MEGAN emis fluxes to history
898 117648 : call outfld('MEG_'//trim(shr_megan_mechcomps(n)%name), megflx(:ncol), ncol, lchnk)
899 : enddo
900 :
901 : endif
902 :
903 58824 : if ( use_hemco ) then
904 : ! prescribed emissions from HEMCO ...
905 :
906 : !-----------------------------------------------------------------------
907 : ! ... Set surface emissions using HEMCO compatibility API
908 : !-----------------------------------------------------------------------
909 0 : call hco_set_srf_emissions( lchnk, ncol, sflx(:,:), pbuf )
910 : else
911 : ! prescribed emissions from file ...
912 :
913 : !-----------------------------------------------------------------------
914 : ! ... Set surface emissions
915 : !-----------------------------------------------------------------------
916 58824 : call set_srf_emissions( lchnk, ncol, sflx(:,:) )
917 : endif
918 :
919 2470608 : do m = 1,pcnst
920 2411784 : n = map2chm(m)
921 2470608 : if ( n /= h2o_ndx .and. n > 0 ) then
922 29466720 : cam_in%cflx(:ncol,m) = cam_in%cflx(:ncol,m) + sflx(:ncol,n)
923 1764720 : if (srf_emis_diag(m)) then
924 1000008 : call outfld( sflxnam(m), cam_in%cflx(:ncol,m), ncol,lchnk )
925 : endif
926 : endif
927 : enddo
928 :
929 : ! fire surface emissions if not elevated forcing
930 58824 : call fire_emissions_srf( lchnk, ncol, cam_in%fireflx, cam_in%cflx )
931 :
932 : ! air-sea exchange of trace gases
933 58824 : call ocean_emis_getflux(lchnk, ncol, state, cam_in%u10, cam_in%sst, cam_in%ocnfrac, cam_in%icefrac, cam_in%cflx)
934 :
935 58824 : end subroutine chem_emissions
936 :
937 : !================================================================================
938 :
939 0 : subroutine chem_init_cnst( name, latvals, lonvals, mask, q)
940 : !-----------------------------------------------------------------------
941 : !
942 : ! Purpose:
943 : ! Specify initial mass mixing ratios
944 : !
945 : !-----------------------------------------------------------------------
946 :
947 58824 : use chem_mods, only : inv_lst
948 :
949 : use physconst, only : mwdry, mwch4, mwn2o, mwf11, mwf12
950 : use chem_surfvals, only : chem_surfvals_get
951 :
952 : implicit none
953 :
954 : !-----------------------------------------------------------------------
955 : ! Dummy arguments
956 : !-----------------------------------------------------------------------
957 : character(len=*), intent(in) :: name ! constituent name
958 : real(r8), intent(in) :: latvals(:) ! lat in degrees (ncol)
959 : real(r8), intent(in) :: lonvals(:) ! lon in degrees (ncol)
960 : logical, intent(in) :: mask(:) ! Only initialize where .true.
961 : real(r8), intent(out) :: q(:,:) ! kg tracer/kg dry air (gcol, plev
962 :
963 : !-----------------------------------------------------------------------
964 : ! Local variables
965 : !-----------------------------------------------------------------------
966 :
967 : real(r8) :: rmwn2o != mwn2o/mwdry ! ratio of mol weight n2o to dry air
968 : real(r8) :: rmwch4 != mwch4/mwdry ! ratio of mol weight ch4 to dry air
969 : real(r8) :: rmwf11 != mwf11/mwdry ! ratio of mol weight cfc11 to dry air
970 : real(r8) :: rmwf12 != mwf12/mwdry ! ratio of mol weight cfc12 to dry air
971 : integer :: ilev, nlev
972 :
973 : !-----------------------------------------------------------------------
974 : ! initialize local variables
975 : !-----------------------------------------------------------------------
976 :
977 0 : rmwn2o = mwn2o/mwdry
978 0 : rmwch4 = mwch4/mwdry
979 0 : rmwf11 = mwf11/mwdry
980 0 : rmwf12 = mwf12/mwdry
981 :
982 : !-----------------------------------------------------------------------
983 : ! Get initial mixing ratios
984 : !-----------------------------------------------------------------------
985 0 : nlev = size(q, 2)
986 0 : if ( any( inv_lst .eq. name ) ) then
987 0 : do ilev = 1, nlev
988 0 : where(mask)
989 0 : q(:,ilev) = 0.0_r8
990 : end where
991 : end do
992 : else
993 0 : do ilev = 1, nlev
994 0 : where(mask)
995 0 : q(:,ilev) = 1.e-38_r8
996 : end where
997 : end do
998 : endif
999 :
1000 0 : if ( ghg_chem ) then
1001 0 : do ilev = 1, nlev
1002 0 : select case (name)
1003 : case ('N2O')
1004 0 : where(mask)
1005 0 : q(:,ilev) = rmwn2o * chem_surfvals_get('N2OVMR')
1006 : end where
1007 : case ('CH4')
1008 0 : where(mask)
1009 0 : q(:,ilev) = rmwch4 * chem_surfvals_get('CH4VMR')
1010 : end where
1011 : case ('CFC11')
1012 0 : where(mask)
1013 0 : q(:,ilev) = rmwf11 * chem_surfvals_get('F11VMR')
1014 : end where
1015 : case ('CFC12')
1016 0 : where(mask)
1017 0 : q(:,ilev) = rmwf12 * chem_surfvals_get('F12VMR')
1018 : end where
1019 : case ('CO2')
1020 0 : where(mask)
1021 0 : q(:,ilev) = chem_surfvals_get('CO2MMR')
1022 : end where
1023 : end select
1024 : end do
1025 : end if
1026 :
1027 0 : end subroutine chem_init_cnst
1028 :
1029 32256 : subroutine chem_timestep_init(phys_state,pbuf2d)
1030 :
1031 0 : use time_manager, only : get_nstep
1032 : use time_manager, only : get_curr_calday
1033 : use mo_srf_emissions, only : set_srf_emissions_time
1034 : use mo_sulf, only : set_sulf_time
1035 : use mo_extfrc, only : extfrc_timestep_init
1036 : use mo_flbc, only : flbc_chk
1037 : use tracer_cnst, only : tracer_cnst_adv
1038 : use tracer_srcs, only : tracer_srcs_adv
1039 : use mo_ghg_chem, only : ghg_chem_timestep_init
1040 :
1041 : use mo_aurora, only : aurora_timestep_init
1042 : use mo_photo, only : photo_timestep_init
1043 :
1044 : use cfc11star, only : update_cfc11star
1045 : use physics_buffer, only : physics_buffer_desc
1046 : use ocean_emis, only : ocean_emis_advance
1047 : use mee_fluxes, only : mee_fluxes_adv
1048 :
1049 : implicit none
1050 :
1051 : type(physics_state), intent(inout) :: phys_state(begchunk:endchunk)
1052 : type(physics_buffer_desc), pointer :: pbuf2d(:,:)
1053 :
1054 : !-----------------------------------------------------------------------
1055 : ! Local variables
1056 : !-----------------------------------------------------------------------
1057 : real(r8) :: calday
1058 : integer :: nstep
1059 :
1060 16128 : nstep = get_nstep()
1061 16128 : chem_step = mod( nstep, chem_freq ) == 0
1062 :
1063 16128 : if ( .not. chem_step ) return
1064 :
1065 : !-----------------------------------------------------------------------
1066 : ! get current calendar day of year
1067 : !-----------------------------------------------------------------------
1068 16128 : calday = get_curr_calday( )
1069 :
1070 : !-----------------------------------------------------------------------
1071 : ! Set emissions timing factors
1072 : !-----------------------------------------------------------------------
1073 16128 : call set_srf_emissions_time( pbuf2d, phys_state )
1074 :
1075 : !-----------------------------------------------------------------------
1076 : ! Set external forcings timing factors
1077 : !-----------------------------------------------------------------------
1078 16128 : call extfrc_timestep_init( pbuf2d, phys_state )
1079 :
1080 : !-----------------------------------------------------------------------
1081 : ! Set sulf timing factors
1082 : !-----------------------------------------------------------------------
1083 16128 : call set_sulf_time( pbuf2d, phys_state )
1084 :
1085 : !-----------------------------------------------------------------------
1086 : ! Set fixed lower boundary timing factors
1087 : !-----------------------------------------------------------------------
1088 16128 : call flbc_chk
1089 :
1090 : !-----------------------------------------------------------------------
1091 : ! Set fixed offline tracers
1092 : !-----------------------------------------------------------------------
1093 16128 : call tracer_cnst_adv(pbuf2d, phys_state)
1094 :
1095 : !-----------------------------------------------------------------------
1096 : ! Set fixed offline tracer sources
1097 : !-----------------------------------------------------------------------
1098 16128 : call tracer_srcs_adv(pbuf2d, phys_state)
1099 :
1100 16128 : if ( ghg_chem ) then
1101 16128 : call ghg_chem_timestep_init(phys_state)
1102 : endif
1103 :
1104 : !-----------------------------------------------------------------------
1105 : ! Set up aurora
1106 : !-----------------------------------------------------------------------
1107 16128 : call aurora_timestep_init
1108 :
1109 : !-----------------------------------------------------------------------------
1110 : ! ... setup the time interpolation for mo_photo
1111 : !-----------------------------------------------------------------------------
1112 16128 : call photo_timestep_init( calday )
1113 :
1114 16128 : call update_cfc11star( pbuf2d, phys_state )
1115 :
1116 : ! Galatic Cosmic Rays ...
1117 16128 : call gcr_ionization_adv( pbuf2d, phys_state )
1118 16128 : call epp_ionization_adv()
1119 :
1120 : ! medium energy electron flux data ...
1121 16128 : call mee_fluxes_adv()
1122 :
1123 16128 : call ocean_emis_advance( pbuf2d, phys_state )
1124 :
1125 16128 : end subroutine chem_timestep_init
1126 :
1127 2470608 : subroutine chem_timestep_tend( state, ptend, cam_in, cam_out, dt, pbuf, fh2o)
1128 :
1129 : !-----------------------------------------------------------------------
1130 : !
1131 : ! Purpose:
1132 : ! Interface to parameterized greenhouse gas chemisty (source/sink).
1133 : !
1134 : ! Method:
1135 : ! <Describe the algorithm(s) used in the routine.>
1136 : ! <Also include any applicable external references.>
1137 : !
1138 : ! Author: B.A. Boville
1139 : !
1140 : !-----------------------------------------------------------------------
1141 :
1142 16128 : use physics_buffer, only : physics_buffer_desc, pbuf_get_field, pbuf_old_tim_idx
1143 : use cam_history, only : outfld
1144 : use time_manager, only : get_curr_calday
1145 : use mo_gas_phase_chemdr, only : gas_phase_chemdr
1146 : use camsrfexch, only : cam_in_t, cam_out_t
1147 : use perf_mod, only : t_startf, t_stopf
1148 : use tropopause, only : tropopause_findChemTrop, tropopause_find_cam
1149 : use mo_drydep, only : drydep_update
1150 : use mo_neu_wetdep, only : neu_wetdep_tend
1151 : use aerodep_flx, only : aerodep_flx_prescribed
1152 : use short_lived_species, only : short_lived_species_writeic
1153 : use atm_stream_ndep, only : ndep_stream_active
1154 :
1155 : implicit none
1156 :
1157 : !-----------------------------------------------------------------------
1158 : ! Dummy arguments
1159 : !-----------------------------------------------------------------------
1160 : real(r8), intent(in) :: dt ! time step
1161 : type(physics_state), intent(in) :: state ! Physics state variables
1162 : type(physics_ptend), intent(out) :: ptend ! indivdual parameterization tendencies
1163 : type(cam_in_t), intent(inout) :: cam_in
1164 : type(cam_out_t), intent(inout) :: cam_out
1165 : real(r8), intent(out) :: fh2o(pcols) ! h2o flux to balance source from chemistry
1166 :
1167 :
1168 : type(physics_buffer_desc), pointer :: pbuf(:)
1169 :
1170 : !-----------------------------------------------------------------------
1171 : ! Local variables
1172 : !-----------------------------------------------------------------------
1173 : integer :: i, k, m, n ! indicies
1174 : integer :: lchnk ! chunk identifier
1175 : integer :: ncol ! number of atmospheric columns
1176 : real(r8) :: calday ! current calendar day of year
1177 : real(r8) :: cldw(pcols,pver) ! cloud water (kg/kg)
1178 : real(r8) :: chem_dt ! time step
1179 : real(r8) :: drydepflx(pcols,pcnst) ! dry deposition fluxes (kg/m2/s)
1180 : real(r8) :: wetdepflx(pcols,pcnst) ! wet deposition fluxes (kg/m2/s)
1181 : integer :: tropLev(pcols), tropLevChem(pcols)
1182 : real(r8) :: ncldwtr(pcols,pver) ! droplet number concentration (#/kg)
1183 58824 : real(r8), pointer :: fsds(:) ! longwave down at sfc
1184 58824 : real(r8), pointer :: pblh(:)
1185 58824 : real(r8), pointer :: prain(:,:)
1186 58824 : real(r8), pointer :: cldfr(:,:)
1187 58824 : real(r8), pointer :: cmfdqr(:,:)
1188 58824 : real(r8), pointer :: nevapr(:,:)
1189 58824 : real(r8), pointer :: cldtop(:)
1190 : real(r8) :: nhx_nitrogen_flx(pcols)
1191 : real(r8) :: noy_nitrogen_flx(pcols)
1192 :
1193 : integer :: tim_ndx
1194 :
1195 : logical :: lq(pcnst)
1196 :
1197 58824 : if ( .not. chem_step ) return
1198 :
1199 58824 : chem_dt = chem_freq*dt
1200 :
1201 58824 : lchnk = state%lchnk
1202 58824 : ncol = state%ncol
1203 :
1204 58824 : call short_lived_species_writeic( lchnk, pbuf )
1205 :
1206 58824 : lq(:) = .false.
1207 2470608 : do n = 1,pcnst
1208 2411784 : m = map2chm(n)
1209 2470608 : if( m > 0 ) then
1210 1823544 : lq(n) = .true.
1211 : end if
1212 : end do
1213 58824 : if ( ghg_chem ) lq(1) = .true.
1214 :
1215 58824 : call physics_ptend_init(ptend, state%psetcols, 'chemistry', lq=lq)
1216 :
1217 58824 : call drydep_update( state, cam_in )
1218 :
1219 : !-----------------------------------------------------------------------
1220 : ! get current calendar day of year
1221 : !-----------------------------------------------------------------------
1222 58824 : calday = get_curr_calday()
1223 :
1224 : !-----------------------------------------------------------------------
1225 : ! get tropopause level
1226 : !-----------------------------------------------------------------------
1227 : !REMOVECAM - no longer need this when CAM is retired and pcols no longer exists
1228 58824 : tropLev(:) = 0
1229 58824 : tropLevChem(:) = 0
1230 : !REMOVECAM_END
1231 58824 : if (.not.chem_use_chemtrop) then
1232 0 : call tropopause_find_cam(state,tropLev)
1233 0 : tropLevChem=tropLev
1234 : else
1235 58824 : call tropopause_find_cam(state,tropLev)
1236 58824 : call tropopause_findChemTrop(state, tropLevChem)
1237 : endif
1238 :
1239 58824 : tim_ndx = pbuf_old_tim_idx()
1240 58824 : call pbuf_get_field(pbuf, ndx_fsds, fsds)
1241 58824 : call pbuf_get_field(pbuf, ndx_pblh, pblh)
1242 176472 : call pbuf_get_field(pbuf, ndx_prain, prain, start=(/1,1/), kount=(/ncol,pver/))
1243 411768 : call pbuf_get_field(pbuf, ndx_cld, cldfr, start=(/1,1,tim_ndx/), kount=(/ncol,pver,1/) )
1244 176472 : call pbuf_get_field(pbuf, ndx_cmfdqr, cmfdqr, start=(/1,1/), kount=(/ncol,pver/))
1245 176472 : call pbuf_get_field(pbuf, ndx_nevapr, nevapr, start=(/1,1/), kount=(/ncol,pver/))
1246 58824 : call pbuf_get_field(pbuf, ndx_cldtop, cldtop )
1247 :
1248 : !-----------------------------------------------------------------------
1249 : ! call Neu wet dep scheme
1250 : !-----------------------------------------------------------------------
1251 : call neu_wetdep_tend(lchnk,ncol,state%q,state%pmid,state%pdel,state%zi,state%t,dt, &
1252 58824 : prain, nevapr, cldfr, cmfdqr, ptend%q, wetdepflx)
1253 :
1254 : !-----------------------------------------------------------------------
1255 : ! compute tendencies and surface fluxes
1256 : !-----------------------------------------------------------------------
1257 58824 : call t_startf( 'chemdr' )
1258 5529456 : do k = 1,pver
1259 91346832 : cldw(:ncol,k) = state%q(:ncol,k,ixcldliq)
1260 5470632 : if (ixndrop>0) &
1261 91405656 : ncldwtr(:ncol,k) = state%q(:ncol,k,ixndrop)
1262 : end do
1263 :
1264 : call gas_phase_chemdr(state,lchnk, ncol, imozart, state%q, &
1265 : state%phis, state%zm, state%zi, calday, &
1266 : state%t, state%pmid, state%pdel, state%pint, state%rpdel, state%rpdeldry, &
1267 : cldw, tropLev, tropLevChem, ncldwtr, state%u, state%v, chem_dt, state%ps, &
1268 : fsds, cam_in%ts, cam_in%asdir, cam_in%ocnfrac, cam_in%icefrac, &
1269 : cam_out%precc, cam_out%precl, cam_in%snowhland, ghg_chem, state%latmapback, &
1270 : drydepflx, wetdepflx, cam_in%cflx, cam_in%fireflx, cam_in%fireztop, &
1271 58824 : nhx_nitrogen_flx, noy_nitrogen_flx, use_hemco, ptend%q, pbuf )
1272 58824 : if (.not.ndep_stream_active) then
1273 0 : if (associated(cam_out%nhx_nitrogen_flx)) then
1274 0 : cam_out%nhx_nitrogen_flx(:ncol) = nhx_nitrogen_flx(:ncol)
1275 : endif
1276 0 : if (associated(cam_out%noy_nitrogen_flx)) then
1277 0 : cam_out%noy_nitrogen_flx(:ncol) = noy_nitrogen_flx(:ncol)
1278 : endif
1279 : endif
1280 :
1281 58824 : call t_stopf( 'chemdr' )
1282 :
1283 : !-----------------------------------------------------------------------
1284 : ! set flags for tracer tendencies (water and gas phase constituents)
1285 : ! record tendencies on history files
1286 : !-----------------------------------------------------------------------
1287 2470608 : do n = 1,pcnst
1288 2411784 : m = map2chm(n)
1289 2411784 : if( m > 0 ) then
1290 1823544 : call outfld( srcnam(m), ptend%q(:,:,n), pcols, lchnk )
1291 : end if
1292 :
1293 : ! if the user has specified prescribed aerosol dep fluxes then
1294 : ! do not set cam_out dep fluxes according to the prognostic aerosols
1295 2470608 : if (.not.aerodep_flx_prescribed()) then
1296 : ! set deposition fluxes in the export state
1297 4823568 : select case (trim(cnst_name(n)))
1298 : case('CB1')
1299 0 : do i = 1, ncol
1300 0 : cam_out%bcphodry(i) = max(drydepflx(i,n), 0._r8)
1301 : end do
1302 : case('CB2')
1303 0 : do i = 1, ncol
1304 0 : cam_out%bcphidry(i) = max(drydepflx(i,n), 0._r8)
1305 : end do
1306 : case('OC1')
1307 0 : do i = 1, ncol
1308 0 : cam_out%ocphodry(i) = max(drydepflx(i,n), 0._r8)
1309 : end do
1310 : case('OC2')
1311 4823568 : do i = 1, ncol
1312 0 : cam_out%ocphidry(i) = max(drydepflx(i,n), 0._r8)
1313 : end do
1314 : end select
1315 : endif
1316 : end do
1317 58824 : if ( ghg_chem ) then
1318 58824 : ptend%lq(1) = .true.
1319 58824 : call outfld( 'CT_H2O_GHG', ptend%q(:,:,1), pcols, lchnk )
1320 : endif
1321 :
1322 21705144 : call outfld( 'HEIGHT', state%zi(:ncol,:), ncol, lchnk )
1323 :
1324 : !-----------------------------------------------------------------------
1325 : ! turn off water vapor tendency if radiatively passive
1326 : !-----------------------------------------------------------------------
1327 58824 : if (chem_rad_passive) then
1328 0 : ptend%lq(1) = .false.
1329 0 : ptend%q(:ncol,:,1) = 0._r8
1330 : endif
1331 :
1332 : !-----------------------------------------------------------------------
1333 : ! Compute water vapor flux required to make conservation check
1334 : !-----------------------------------------------------------------------
1335 982224 : fh2o(:ncol) = 0._r8
1336 5529456 : do k = 1,pver
1337 91405656 : fh2o(:ncol) = fh2o(:ncol) + ptend%q(:ncol,k,1)*state%pdel(:ncol,k)/gravit
1338 : end do
1339 :
1340 117648 : end subroutine chem_timestep_tend
1341 :
1342 : !-------------------------------------------------------------------
1343 : !-------------------------------------------------------------------
1344 1536 : subroutine chem_final()
1345 58824 : use mee_ionization, only: mee_ion_final
1346 : use rate_diags, only: rate_diags_final
1347 : use species_sums_diags, only: species_sums_final
1348 : use short_lived_species, only: short_lived_species_final
1349 :
1350 1536 : call mee_ion_final()
1351 1536 : call rate_diags_final()
1352 1536 : call species_sums_final()
1353 1536 : call short_lived_species_final()
1354 :
1355 1536 : end subroutine chem_final
1356 :
1357 : !-------------------------------------------------------------------
1358 : !-------------------------------------------------------------------
1359 :
1360 1536 : subroutine chem_init_restart( File )
1361 1536 : use pio, only : file_desc_t
1362 : use tracer_cnst, only: init_tracer_cnst_restart
1363 : use tracer_srcs, only: init_tracer_srcs_restart
1364 : implicit none
1365 : type(file_desc_t),intent(inout) :: File ! pio File pointer
1366 :
1367 : !
1368 : ! data for offline tracers
1369 : !
1370 1536 : call init_tracer_cnst_restart(File)
1371 1536 : call init_tracer_srcs_restart(File)
1372 1536 : end subroutine chem_init_restart
1373 : !-------------------------------------------------------------------
1374 : !-------------------------------------------------------------------
1375 1536 : subroutine chem_write_restart( File )
1376 1536 : use tracer_cnst, only: write_tracer_cnst_restart
1377 : use tracer_srcs, only: write_tracer_srcs_restart
1378 : use pio, only : file_desc_t
1379 : implicit none
1380 : type(file_desc_t) :: File
1381 :
1382 : !
1383 : ! data for offline tracers
1384 : !
1385 1536 : call write_tracer_cnst_restart(File)
1386 1536 : call write_tracer_srcs_restart(File)
1387 1536 : end subroutine chem_write_restart
1388 :
1389 : !-------------------------------------------------------------------
1390 : !-------------------------------------------------------------------
1391 768 : subroutine chem_read_restart( File )
1392 1536 : use tracer_cnst, only: read_tracer_cnst_restart
1393 : use tracer_srcs, only: read_tracer_srcs_restart
1394 :
1395 : use pio, only : file_desc_t
1396 : implicit none
1397 : type(file_desc_t) :: File
1398 :
1399 : !
1400 : ! data for offline tracers
1401 : !
1402 768 : call read_tracer_cnst_restart(File)
1403 768 : call read_tracer_srcs_restart(File)
1404 768 : end subroutine chem_read_restart
1405 :
1406 : end module chemistry
|