Line data Source code
1 : module physpkg
2 : !-----------------------------------------------------------------------
3 : ! Purpose:
4 : !
5 : ! Provides the interface to CAM physics package
6 : !
7 : ! Revision history:
8 : ! Aug 2005, E. B. Kluzek, Creation of module from physpkg subroutine
9 : ! 2005-10-17 B. Eaton Add contents of inti.F90 to phys_init(). Add
10 : ! initialization of grid info in phys_state.
11 : ! Nov 2010 A. Gettelman Put micro/macro physics into separate routines
12 : !-----------------------------------------------------------------------
13 :
14 : use shr_kind_mod, only: r8 => shr_kind_r8
15 : use spmd_utils, only: masterproc
16 : use physconst, only: latvap, latice
17 : use physics_types, only: physics_state, physics_tend, physics_state_set_grid, &
18 : physics_ptend, physics_tend_init, physics_update, &
19 : physics_type_alloc, physics_ptend_dealloc,&
20 : physics_state_alloc, physics_state_dealloc, physics_tend_alloc, physics_tend_dealloc
21 : use phys_grid, only: get_ncols_p
22 : use phys_gmean, only: gmean_mass
23 : use ppgrid, only: begchunk, endchunk, pcols, pver, pverp, psubcols
24 : use constituents, only: pcnst, cnst_get_ind
25 : use camsrfexch, only: cam_out_t, cam_in_t
26 :
27 : use cam_control_mod, only: ideal_phys, adiabatic
28 : use phys_control, only: phys_do_flux_avg, phys_getopts, waccmx_is
29 : use scamMod, only: single_column, scm_crm_mode
30 : use flux_avg, only: flux_avg_init
31 : use perf_mod
32 : use cam_logfile, only: iulog
33 : use camsrfexch, only: cam_export
34 :
35 : use phys_control, only: use_hemco ! Use Harmonized Emissions Component (HEMCO)
36 :
37 : use modal_aero_calcsize, only: modal_aero_calcsize_init, modal_aero_calcsize_diag, modal_aero_calcsize_reg
38 : use modal_aero_calcsize, only: modal_aero_calcsize_sub
39 : use modal_aero_wateruptake, only: modal_aero_wateruptake_init, modal_aero_wateruptake_dr, modal_aero_wateruptake_reg
40 :
41 : use carma_diags_mod, only: carma_diags_t
42 :
43 : implicit none
44 : private
45 : save
46 :
47 : ! Public methods
48 : public phys_register ! was initindx - register physics methods
49 : public phys_init ! Public initialization method
50 : public phys_run1 ! First phase of the public run method
51 : public phys_run2 ! Second phase of the public run method
52 : public phys_final ! Public finalization method
53 :
54 : ! Private module data
55 :
56 : ! Physics package options
57 : character(len=16) :: shallow_scheme
58 : character(len=16) :: macrop_scheme
59 : character(len=16) :: microp_scheme
60 : character(len=16) :: subcol_scheme
61 : character(len=32) :: cam_take_snapshot_before ! Physics routine to take a snapshot "before"
62 : character(len=32) :: cam_take_snapshot_after ! Physics routine to take a snapshot "after"
63 : integer :: cld_macmic_num_steps ! Number of macro/micro substeps
64 : integer :: cam_snapshot_before_num ! tape number for before snapshots
65 : integer :: cam_snapshot_after_num ! tape number for after snapshots
66 : logical :: do_clubb_sgs
67 : logical :: use_subcol_microp ! if true, use subcolumns in microphysics
68 : logical :: state_debug_checks ! Debug physics_state.
69 : logical :: clim_modal_aero ! climate controled by prognostic or prescribed modal aerosols
70 : logical :: prog_modal_aero ! Prognostic modal aerosols present
71 :
72 : ! Physics buffer index
73 : integer :: teout_idx = 0
74 :
75 : integer :: landm_idx = 0
76 : integer :: sgh_idx = 0
77 : integer :: sgh30_idx = 0
78 :
79 : integer :: qini_idx = 0
80 : integer :: cldliqini_idx = 0
81 : integer :: cldiceini_idx = 0
82 : integer :: totliqini_idx = 0
83 : integer :: toticeini_idx = 0
84 :
85 : integer :: prec_str_idx = 0
86 : integer :: snow_str_idx = 0
87 : integer :: prec_sed_idx = 0
88 : integer :: snow_sed_idx = 0
89 : integer :: prec_pcw_idx = 0
90 : integer :: snow_pcw_idx = 0
91 : integer :: prec_dp_idx = 0
92 : integer :: snow_dp_idx = 0
93 : integer :: prec_sh_idx = 0
94 : integer :: snow_sh_idx = 0
95 : integer :: dlfzm_idx = 0 ! detrained convective cloud water mixing ratio.
96 : integer :: ducore_idx = 0 ! ducore index in physics buffer
97 : integer :: dvcore_idx = 0 ! dvcore index in physics buffer
98 : integer :: dtcore_idx = 0 ! dtcore index in physics buffer
99 : integer :: dqcore_idx = 0 ! dqcore index in physics buffer
100 :
101 : !=======================================================================
102 : contains
103 : !=======================================================================
104 :
105 17664 : subroutine phys_register
106 : !-----------------------------------------------------------------------
107 : !
108 : ! Purpose: Register constituents and physics buffer fields.
109 : !
110 : ! Author: CSM Contact: M. Vertenstein, Aug. 1997
111 : ! B.A. Boville, Oct 2001
112 : ! A. Gettelman, Nov 2010 - put micro/macro physics into separate routines
113 : !
114 : !-----------------------------------------------------------------------
115 : use cam_abortutils, only: endrun
116 : use physics_buffer, only: pbuf_init_time, pbuf_cam_snapshot_register
117 : use physics_buffer, only: pbuf_add_field, dtype_r8, pbuf_register_subcol
118 : use shr_kind_mod, only: r8 => shr_kind_r8
119 : use constituents, only: pcnst, cnst_add, cnst_chk_dim
120 :
121 : use cam_control_mod, only: moist_physics
122 : use chemistry, only: chem_register
123 : use mo_lightning, only: lightning_register
124 : use cloud_fraction, only: cldfrc_register
125 : use rk_stratiform, only: rk_stratiform_register
126 : use microp_driver, only: microp_driver_register
127 : use microp_aero, only: microp_aero_register
128 : use macrop_driver, only: macrop_driver_register
129 : use clubb_intr, only: clubb_register_cam
130 : use conv_water, only: conv_water_register
131 : use physconst, only: mwh2o, cpwv
132 : use tracers, only: tracers_register
133 : use check_energy, only: check_energy_register
134 : use carma_intr, only: carma_register
135 : use ghg_data, only: ghg_data_register
136 : use vertical_diffusion, only: vd_register
137 : use convect_deep, only: convect_deep_register
138 : use convect_shallow, only: convect_shallow_register
139 : use radiation, only: radiation_register
140 : use co2_cycle, only: co2_register
141 : use flux_avg, only: flux_avg_register
142 : use iondrag, only: iondrag_register
143 : use waccmx_phys_intr, only: waccmx_phys_ion_elec_temp_reg
144 : use prescribed_ozone, only: prescribed_ozone_register
145 : use prescribed_volcaero,only: prescribed_volcaero_register
146 : use prescribed_strataero,only: prescribed_strataero_register
147 : use prescribed_aero, only: prescribed_aero_register
148 : use prescribed_ghg, only: prescribed_ghg_register
149 : use sslt_rebin, only: sslt_rebin_register
150 : use aoa_tracers, only: aoa_tracers_register
151 : use aircraft_emit, only: aircraft_emit_register
152 : use cam_diagnostics, only: diag_register
153 : use cloud_diagnostics, only: cloud_diagnostics_register
154 : use cospsimulator_intr, only: cospsimulator_intr_register
155 : use rad_constituents, only: rad_cnst_get_info ! Added to query if it is a modal aero sim or not
156 : use radheat, only: radheat_register
157 : use subcol, only: subcol_register
158 : use subcol_utils, only: is_subcol_on, subcol_get_scheme
159 : use dyn_comp, only: dyn_register
160 : use offline_driver, only: offline_driver_reg
161 : use hemco_interface, only: HCOI_Chunk_Init
162 : use upper_bc, only: ubc_fixed_conc
163 : use surface_emissions_mod, only: surface_emissions_reg
164 : use elevated_emissions_mod, only: elevated_emissions_reg
165 :
166 : !---------------------------Local variables-----------------------------
167 : !
168 : integer :: m ! loop index
169 : integer :: mm ! constituent index
170 : integer :: nmodes
171 : logical :: has_fixed_ubc ! for upper bndy cond
172 : !-----------------------------------------------------------------------
173 :
174 : ! Get physics options
175 : call phys_getopts(shallow_scheme_out = shallow_scheme, &
176 : macrop_scheme_out = macrop_scheme, &
177 : microp_scheme_out = microp_scheme, &
178 : cld_macmic_num_steps_out = cld_macmic_num_steps, &
179 : do_clubb_sgs_out = do_clubb_sgs, &
180 : use_subcol_microp_out = use_subcol_microp, &
181 : state_debug_checks_out = state_debug_checks, &
182 : cam_take_snapshot_before_out= cam_take_snapshot_before, &
183 : cam_take_snapshot_after_out = cam_take_snapshot_after, &
184 : cam_snapshot_before_num_out = cam_snapshot_before_num, &
185 1536 : cam_snapshot_after_num_out = cam_snapshot_after_num)
186 :
187 1536 : subcol_scheme = subcol_get_scheme()
188 :
189 : ! Initialize dyn_time_lvls
190 1536 : call pbuf_init_time()
191 :
192 : ! Register the subcol scheme
193 1536 : call subcol_register()
194 :
195 : ! Register water vapor.
196 : ! ***** N.B. ***** This must be the first call to cnst_add so that
197 : ! water vapor is constituent 1.
198 1536 : has_fixed_ubc = ubc_fixed_conc('Q') ! .false.
199 1536 : if (moist_physics) then
200 : call cnst_add('Q', mwh2o, cpwv, 1.E-12_r8, mm, fixed_ubc=has_fixed_ubc, &
201 1536 : longname='Specific humidity', readiv=.true., is_convtran1=.true.)
202 : else
203 : call cnst_add('Q', mwh2o, cpwv, 0.0_r8, mm, fixed_ubc=has_fixed_ubc, &
204 0 : longname='Specific humidity', readiv=.false., is_convtran1=.true.)
205 : end if
206 :
207 : ! Topography file fields.
208 1536 : call pbuf_add_field('LANDM', 'global', dtype_r8, (/pcols/), landm_idx)
209 1536 : call pbuf_add_field('SGH', 'global', dtype_r8, (/pcols/), sgh_idx)
210 1536 : call pbuf_add_field('SGH30', 'global', dtype_r8, (/pcols/), sgh30_idx)
211 :
212 : ! Fields for physics package diagnostics
213 1536 : call pbuf_add_field('QINI', 'physpkg', dtype_r8, (/pcols,pver/), qini_idx)
214 1536 : call pbuf_add_field('CLDLIQINI', 'physpkg', dtype_r8, (/pcols,pver/), cldliqini_idx)
215 1536 : call pbuf_add_field('CLDICEINI', 'physpkg', dtype_r8, (/pcols,pver/), cldiceini_idx)
216 1536 : call pbuf_add_field('TOTLIQINI', 'physpkg', dtype_r8, (/pcols,pver/), totliqini_idx)
217 1536 : call pbuf_add_field('TOTICEINI', 'physpkg', dtype_r8, (/pcols,pver/), toticeini_idx)
218 :
219 : ! check energy package
220 1536 : call check_energy_register
221 :
222 : ! If using a simple physics option (e.g., held_suarez, adiabatic),
223 : ! the normal CAM physics parameterizations are not called.
224 1536 : if (moist_physics) then
225 :
226 : ! register fluxes for saving across time
227 1536 : if (phys_do_flux_avg()) call flux_avg_register()
228 :
229 1536 : call cldfrc_register()
230 :
231 : ! cloud water
232 1536 : if( microp_scheme == 'RK' ) then
233 0 : call rk_stratiform_register()
234 1536 : elseif( microp_scheme == 'MG' ) then
235 1536 : if (.not. do_clubb_sgs) call macrop_driver_register()
236 1536 : call microp_aero_register()
237 1536 : call microp_driver_register()
238 : end if
239 :
240 : ! Register CLUBB_SGS here
241 1536 : if (do_clubb_sgs) call clubb_register_cam()
242 :
243 :
244 1536 : call pbuf_add_field('PREC_STR', 'physpkg',dtype_r8,(/pcols/),prec_str_idx)
245 1536 : call pbuf_add_field('SNOW_STR', 'physpkg',dtype_r8,(/pcols/),snow_str_idx)
246 1536 : call pbuf_add_field('PREC_PCW', 'physpkg',dtype_r8,(/pcols/),prec_pcw_idx)
247 1536 : call pbuf_add_field('SNOW_PCW', 'physpkg',dtype_r8,(/pcols/),snow_pcw_idx)
248 1536 : call pbuf_add_field('PREC_SED', 'physpkg',dtype_r8,(/pcols/),prec_sed_idx)
249 1536 : call pbuf_add_field('SNOW_SED', 'physpkg',dtype_r8,(/pcols/),snow_sed_idx)
250 1536 : if (is_subcol_on()) then
251 0 : call pbuf_register_subcol('PREC_STR', 'phys_register', prec_str_idx)
252 0 : call pbuf_register_subcol('SNOW_STR', 'phys_register', snow_str_idx)
253 0 : call pbuf_register_subcol('PREC_PCW', 'phys_register', prec_pcw_idx)
254 0 : call pbuf_register_subcol('SNOW_PCW', 'phys_register', snow_pcw_idx)
255 0 : call pbuf_register_subcol('PREC_SED', 'phys_register', prec_sed_idx)
256 0 : call pbuf_register_subcol('SNOW_SED', 'phys_register', snow_sed_idx)
257 : end if
258 :
259 : ! Who should add FRACIS?
260 : ! -- It does not seem that aero_intr should add it since FRACIS is used in convection
261 : ! even if there are no prognostic aerosols ... so do it here for now
262 1536 : call pbuf_add_field('FRACIS','physpkg',dtype_r8,(/pcols,pver,pcnst/),m)
263 :
264 1536 : call conv_water_register()
265 :
266 : ! Determine whether its a 'modal' aerosol simulation or not
267 1536 : call rad_cnst_get_info(0, nmodes=nmodes)
268 1536 : clim_modal_aero = (nmodes > 0)
269 :
270 1536 : if (clim_modal_aero) then
271 1536 : call modal_aero_calcsize_reg()
272 1536 : call modal_aero_wateruptake_reg()
273 : endif
274 :
275 1536 : call surface_emissions_reg()
276 1536 : call elevated_emissions_reg()
277 :
278 : ! register chemical constituents including aerosols ...
279 1536 : call chem_register()
280 :
281 : ! add prognostic lightning flash freq pbuf fld
282 1536 : call lightning_register()
283 :
284 : ! co2 constituents
285 1536 : call co2_register()
286 :
287 : ! register data model ozone with pbuf
288 1536 : call prescribed_volcaero_register()
289 1536 : call prescribed_strataero_register()
290 1536 : call prescribed_ozone_register()
291 1536 : call prescribed_aero_register()
292 1536 : call prescribed_ghg_register()
293 1536 : call sslt_rebin_register
294 :
295 : ! register various data model gasses with pbuf
296 1536 : call ghg_data_register()
297 :
298 : ! carma microphysics
299 : !
300 1536 : call carma_register()
301 :
302 : ! Register iondrag variables with pbuf
303 1536 : call iondrag_register()
304 :
305 : ! Register ionosphere variables with pbuf if mode set to ionosphere
306 1536 : if( waccmx_is('ionosphere') ) then
307 0 : call waccmx_phys_ion_elec_temp_reg()
308 : endif
309 :
310 1536 : call aircraft_emit_register()
311 :
312 : ! deep convection
313 1536 : call convect_deep_register
314 :
315 : ! shallow convection
316 1536 : call convect_shallow_register
317 :
318 : ! radiation
319 1536 : call radiation_register
320 1536 : call cloud_diagnostics_register
321 1536 : call radheat_register
322 :
323 : ! COSP
324 1536 : call cospsimulator_intr_register
325 :
326 : ! vertical diffusion
327 1536 : call vd_register()
328 : else
329 : ! held_suarez/adiabatic physics option should be in simple_physics
330 0 : call endrun('phys_register: moist_physics configuration error')
331 : end if
332 :
333 : ! Register diagnostics PBUF
334 1536 : call diag_register()
335 :
336 : ! Register age of air tracers
337 1536 : call aoa_tracers_register()
338 :
339 : ! Register test tracers
340 1536 : call tracers_register()
341 :
342 1536 : call dyn_register()
343 :
344 : ! All tracers registered, check that the dimensions are correct
345 1536 : call cnst_chk_dim()
346 :
347 : ! ***NOTE*** No registering constituents after the call to cnst_chk_dim.
348 :
349 1536 : call offline_driver_reg()
350 :
351 1536 : if (use_hemco) then
352 : ! initialize harmonized emissions component (HEMCO)
353 0 : call HCOI_Chunk_Init()
354 : endif
355 :
356 : ! This needs to be last as it requires all pbuf fields to be added
357 1536 : if (cam_snapshot_before_num > 0 .or. cam_snapshot_after_num > 0) then
358 0 : call pbuf_cam_snapshot_register()
359 : end if
360 :
361 1536 : end subroutine phys_register
362 :
363 :
364 :
365 : !=======================================================================
366 :
367 768 : subroutine phys_inidat( cam_out, pbuf2d )
368 1536 : use cam_abortutils, only: endrun
369 :
370 : use physics_buffer, only: pbuf_get_index, physics_buffer_desc, pbuf_set_field, dyn_time_lvls
371 :
372 :
373 : use cam_initfiles, only: initial_file_get_id, topo_file_get_id
374 : use cam_grid_support, only: cam_grid_check, cam_grid_id
375 : use cam_grid_support, only: cam_grid_get_dim_names
376 : use pio, only: file_desc_t
377 : use ncdio_atm, only: infld
378 : use dycore, only: dycore_is
379 : use polar_avg, only: polar_average
380 : use short_lived_species, only: initialize_short_lived_species
381 : use cam_control_mod, only: aqua_planet
382 : use waccmx_phys_intr, only: waccmx_phys_ion_elec_temp_inidat
383 :
384 : type(cam_out_t), intent(inout) :: cam_out(begchunk:endchunk)
385 : type(physics_buffer_desc), pointer :: pbuf2d(:,:)
386 : integer :: lchnk, m, n, ncol
387 : type(file_desc_t), pointer :: fh_ini, fh_topo
388 : character(len=8) :: fieldname
389 768 : real(r8), pointer :: tptr(:,:), tptr_2(:,:), tptr3d(:,:,:), tptr3d_2(:,:,:)
390 :
391 : character(len=11) :: subname='phys_inidat' ! subroutine name
392 : integer :: tpert_idx, qpert_idx, pblh_idx
393 :
394 : logical :: found=.false., found2=.false.
395 : integer :: ierr
396 : character(len=8) :: dim1name, dim2name
397 : integer :: ixcldice, ixcldliq
398 : integer :: grid_id ! grid ID for data mapping
399 :
400 768 : nullify(tptr,tptr_2,tptr3d,tptr3d_2)
401 :
402 1536 : fh_ini => initial_file_get_id()
403 768 : fh_topo => topo_file_get_id()
404 :
405 : ! dynamics variables are handled in dyn_init - here we read variables needed for physics
406 : ! but not dynamics
407 :
408 768 : grid_id = cam_grid_id('physgrid')
409 768 : if (.not. cam_grid_check(grid_id)) then
410 0 : call endrun(trim(subname)//': Internal error, no "physgrid" grid')
411 : end if
412 768 : call cam_grid_get_dim_names(grid_id, dim1name, dim2name)
413 :
414 2304 : allocate(tptr(1:pcols,begchunk:endchunk))
415 :
416 768 : if (associated(fh_topo) .and. .not. aqua_planet) then
417 : call infld('SGH', fh_topo, dim1name, dim2name, 1, pcols, begchunk, endchunk, &
418 768 : tptr, found, gridname='physgrid')
419 768 : if(.not. found) call endrun('ERROR: SGH not found on topo file')
420 :
421 768 : call pbuf_set_field(pbuf2d, sgh_idx, tptr)
422 :
423 2304 : allocate(tptr_2(1:pcols,begchunk:endchunk))
424 : call infld('SGH30', fh_topo, dim1name, dim2name, 1, pcols, begchunk, endchunk, &
425 768 : tptr_2, found, gridname='physgrid')
426 768 : if(found) then
427 768 : call pbuf_set_field(pbuf2d, sgh30_idx, tptr_2)
428 : else
429 0 : if (masterproc) write(iulog,*) 'Warning: Error reading SGH30 from topo file.'
430 0 : if (masterproc) write(iulog,*) 'The field SGH30 will be filled using data from SGH.'
431 0 : call pbuf_set_field(pbuf2d, sgh30_idx, tptr)
432 : end if
433 :
434 768 : deallocate(tptr_2)
435 :
436 : call infld('LANDM_COSLAT', fh_topo, dim1name, dim2name, 1, pcols, begchunk, endchunk, &
437 768 : tptr, found, gridname='physgrid')
438 :
439 768 : if(.not.found) call endrun(' ERROR: LANDM_COSLAT not found on topo dataset.')
440 :
441 768 : call pbuf_set_field(pbuf2d, landm_idx, tptr)
442 :
443 : else
444 0 : call pbuf_set_field(pbuf2d, sgh_idx, 0._r8)
445 0 : call pbuf_set_field(pbuf2d, sgh30_idx, 0._r8)
446 0 : call pbuf_set_field(pbuf2d, landm_idx, 0._r8)
447 : end if
448 :
449 : call infld('PBLH', fh_ini, dim1name, dim2name, 1, pcols, begchunk, endchunk, &
450 768 : tptr(:,:), found, gridname='physgrid')
451 768 : if(.not. found) then
452 66048 : tptr(:,:) = 0._r8
453 768 : if (masterproc) write(iulog,*) 'PBLH initialized to 0.'
454 : end if
455 768 : pblh_idx = pbuf_get_index('pblh')
456 :
457 768 : call pbuf_set_field(pbuf2d, pblh_idx, tptr)
458 :
459 : call infld('TPERT', fh_ini, dim1name, dim2name, 1, pcols, begchunk, endchunk, &
460 768 : tptr(:,:), found, gridname='physgrid')
461 768 : if(.not. found) then
462 66048 : tptr(:,:) = 0._r8
463 768 : if (masterproc) write(iulog,*) 'TPERT initialized to 0.'
464 : end if
465 768 : tpert_idx = pbuf_get_index( 'tpert')
466 768 : call pbuf_set_field(pbuf2d, tpert_idx, tptr)
467 :
468 768 : fieldname='QPERT'
469 768 : qpert_idx = pbuf_get_index( 'qpert',ierr)
470 768 : if (qpert_idx > 0) then
471 : call infld(fieldname, fh_ini, dim1name, dim2name, 1, pcols, begchunk, endchunk, &
472 768 : tptr(:,:), found, gridname='physgrid')
473 768 : if(.not. found) then
474 66048 : tptr(:,:) = 0._r8
475 768 : if (masterproc) write(iulog,*) trim(fieldname), ' initialized to 0.'
476 : end if
477 768 : call pbuf_set_field(pbuf2d, qpert_idx, tptr)
478 : end if
479 :
480 768 : fieldname='CUSH'
481 768 : m = pbuf_get_index('cush', ierr)
482 768 : if (m > 0) then
483 : call infld(fieldname, fh_ini, dim1name, dim2name, 1, pcols, begchunk, endchunk, &
484 768 : tptr, found, gridname='physgrid')
485 768 : if(.not.found) then
486 768 : if(masterproc) write(iulog,*) trim(fieldname), ' initialized to 1000.'
487 66048 : tptr=1000._r8
488 : end if
489 1536 : do n=1,dyn_time_lvls
490 3072 : call pbuf_set_field(pbuf2d, m, tptr, start=(/1,n/), kount=(/pcols,1/))
491 : end do
492 768 : deallocate(tptr)
493 : end if
494 :
495 : !
496 : ! 3-D fields
497 : !
498 :
499 2304 : allocate(tptr3d(pcols,pver,begchunk:endchunk))
500 :
501 768 : fieldname='CLOUD'
502 768 : m = pbuf_get_index('CLD')
503 : call infld(fieldname, fh_ini, dim1name, 'lev', dim2name, 1, pcols, 1, pver, begchunk, endchunk, &
504 768 : tptr3d, found, gridname='physgrid')
505 768 : if(found) then
506 0 : do n = 1, dyn_time_lvls
507 0 : call pbuf_set_field(pbuf2d, m, tptr3d, (/1,1,n/),(/pcols,pver,1/))
508 : end do
509 : else
510 768 : call pbuf_set_field(pbuf2d, m, 0._r8)
511 768 : if (masterproc) write(iulog,*) trim(fieldname), ' initialized to 0.'
512 : end if
513 :
514 768 : fieldname='QCWAT'
515 768 : m = pbuf_get_index(fieldname,ierr)
516 768 : if (m > 0) then
517 : call infld(fieldname, fh_ini, dim1name, 'lev', dim2name, 1, pcols, 1, pver, begchunk, endchunk, &
518 0 : tptr3d, found, gridname='physgrid')
519 0 : if(.not. found) then
520 : call infld('Q',fh_ini,dim1name, 'lev', dim2name, 1, pcols, 1, pver, begchunk, endchunk, &
521 0 : tptr3d, found, gridname='physgrid')
522 0 : if (found) then
523 0 : if (masterproc) write(iulog,*) trim(fieldname), ' initialized with Q'
524 0 : if(dycore_is('LR')) call polar_average(pver, tptr3d)
525 : else
526 0 : if (masterproc) write(iulog,*) trim(fieldname), ' initialized to huge()'
527 0 : tptr3d = huge(1.0_r8)
528 : end if
529 : end if
530 0 : do n = 1, dyn_time_lvls
531 0 : call pbuf_set_field(pbuf2d, m, tptr3d, (/1,1,n/),(/pcols,pver,1/))
532 : end do
533 : end if
534 :
535 768 : fieldname = 'ICCWAT'
536 768 : m = pbuf_get_index(fieldname, ierr)
537 768 : if (m > 0) then
538 : call infld(fieldname, fh_ini, dim1name, 'lev', dim2name, 1, pcols, 1, pver, begchunk, endchunk, &
539 0 : tptr3d, found, gridname='physgrid')
540 0 : if(found) then
541 0 : do n = 1, dyn_time_lvls
542 0 : call pbuf_set_field(pbuf2d, m, tptr3d, (/1,1,n/),(/pcols,pver,1/))
543 : end do
544 : else
545 0 : call cnst_get_ind('CLDICE', ixcldice)
546 : call infld('CLDICE',fh_ini,dim1name, 'lev', dim2name, 1, pcols, 1, pver, begchunk, endchunk, &
547 0 : tptr3d, found, gridname='physgrid')
548 0 : if(found) then
549 0 : do n = 1, dyn_time_lvls
550 0 : call pbuf_set_field(pbuf2d, m, tptr3d, (/1,1,n/),(/pcols,pver,1/))
551 : end do
552 : else
553 0 : call pbuf_set_field(pbuf2d, m, 0._r8)
554 : end if
555 0 : if (masterproc) then
556 0 : if (found) then
557 0 : write(iulog,*) trim(fieldname), ' initialized with CLDICE'
558 : else
559 0 : write(iulog,*) trim(fieldname), ' initialized to 0.0'
560 : end if
561 : end if
562 : end if
563 : end if
564 :
565 768 : fieldname = 'LCWAT'
566 768 : m = pbuf_get_index(fieldname,ierr)
567 768 : if (m > 0) then
568 : call infld(fieldname, fh_ini, dim1name, 'lev', dim2name, 1, pcols, 1, pver, begchunk, endchunk, &
569 0 : tptr3d, found, gridname='physgrid')
570 0 : if(found) then
571 0 : do n = 1, dyn_time_lvls
572 0 : call pbuf_set_field(pbuf2d, m, tptr3d, (/1,1,n/),(/pcols,pver,1/))
573 : end do
574 : else
575 0 : allocate(tptr3d_2(pcols,pver,begchunk:endchunk))
576 0 : call cnst_get_ind('CLDICE', ixcldice)
577 0 : call cnst_get_ind('CLDLIQ', ixcldliq)
578 : call infld('CLDICE',fh_ini,dim1name, 'lev', dim2name, 1, pcols, 1, pver, begchunk, endchunk, &
579 0 : tptr3d, found, gridname='physgrid')
580 : call infld('CLDLIQ',fh_ini,dim1name, 'lev', dim2name, 1, pcols, 1, pver, begchunk, endchunk, &
581 0 : tptr3d_2, found2, gridname='physgrid')
582 0 : if(found .and. found2) then
583 0 : do lchnk = begchunk, endchunk
584 0 : ncol = get_ncols_p(lchnk)
585 0 : tptr3d(:ncol,:,lchnk)=tptr3d(:ncol,:,lchnk)+tptr3d_2(:ncol,:,lchnk)
586 : end do
587 0 : if (masterproc) write(iulog,*) trim(fieldname), ' initialized with CLDICE + CLDLIQ'
588 0 : else if (found) then ! Data already loaded in tptr3d
589 0 : if (masterproc) write(iulog,*) trim(fieldname), ' initialized with CLDICE only'
590 0 : else if (found2) then
591 0 : tptr3d(:,:,:)=tptr3d_2(:,:,:)
592 0 : if (masterproc) write(iulog,*) trim(fieldname), ' initialized with CLDLIQ only'
593 : end if
594 :
595 0 : if (found .or. found2) then
596 0 : do n = 1, dyn_time_lvls
597 0 : call pbuf_set_field(pbuf2d, m, tptr3d, (/1,1,n/),(/pcols,pver,1/))
598 : end do
599 0 : if(dycore_is('LR')) call polar_average(pver, tptr3d)
600 : else
601 0 : call pbuf_set_field(pbuf2d, m, 0._r8)
602 0 : if (masterproc) write(iulog,*) trim(fieldname), ' initialized to 0.0'
603 : end if
604 0 : deallocate(tptr3d_2)
605 : end if
606 : end if
607 :
608 768 : deallocate(tptr3d)
609 2304 : allocate(tptr3d(pcols,pver,begchunk:endchunk))
610 :
611 768 : fieldname = 'TCWAT'
612 768 : m = pbuf_get_index(fieldname,ierr)
613 768 : if (m > 0) then
614 : call infld(fieldname, fh_ini, dim1name, 'lev', dim2name, 1, pcols, 1, pver, begchunk, endchunk, &
615 0 : tptr3d, found, gridname='physgrid')
616 0 : if(.not.found) then
617 : call infld('T', fh_ini, dim1name, 'lev', dim2name, 1, pcols, 1, pver, begchunk, endchunk, &
618 0 : tptr3d, found, gridname='physgrid')
619 0 : if (found) then
620 0 : if(dycore_is('LR')) call polar_average(pver, tptr3d)
621 0 : if (masterproc) write(iulog,*) trim(fieldname), ' initialized with T'
622 : else
623 0 : if (masterproc) write(iulog,*) trim(fieldname), ' initialized to huge()'
624 0 : tptr3d = huge(1._r8)
625 : end if
626 : end if
627 0 : do n = 1, dyn_time_lvls
628 0 : call pbuf_set_field(pbuf2d, m, tptr3d, (/1,1,n/),(/pcols,pver,1/))
629 : end do
630 : end if
631 :
632 768 : deallocate(tptr3d)
633 2304 : allocate(tptr3d(pcols,pverp,begchunk:endchunk))
634 :
635 768 : fieldname = 'TKE'
636 768 : m = pbuf_get_index( 'tke')
637 : call infld(fieldname, fh_ini, dim1name, 'ilev', dim2name, 1, pcols, 1, pverp, begchunk, endchunk, &
638 768 : tptr3d, found, gridname='physgrid')
639 768 : if (found) then
640 0 : call pbuf_set_field(pbuf2d, m, tptr3d)
641 : else
642 768 : call pbuf_set_field(pbuf2d, m, 0.01_r8)
643 768 : if (masterproc) write(iulog,*) trim(fieldname), ' initialized to 0.01'
644 : end if
645 :
646 :
647 768 : fieldname = 'KVM'
648 768 : m = pbuf_get_index('kvm')
649 : call infld(fieldname, fh_ini, dim1name, 'ilev', dim2name, 1, pcols, 1, pverp, begchunk, endchunk, &
650 768 : tptr3d, found, gridname='physgrid')
651 768 : if (found) then
652 0 : call pbuf_set_field(pbuf2d, m, tptr3d)
653 : else
654 768 : call pbuf_set_field(pbuf2d, m, 0._r8)
655 768 : if (masterproc) write(iulog,*) trim(fieldname), ' initialized to 0.'
656 : end if
657 :
658 :
659 768 : fieldname = 'KVH'
660 768 : m = pbuf_get_index('kvh')
661 : call infld(fieldname, fh_ini, dim1name, 'ilev', dim2name, 1, pcols, 1, pverp, begchunk, endchunk, &
662 768 : tptr3d, found, gridname='physgrid')
663 768 : if (found) then
664 0 : call pbuf_set_field(pbuf2d, m, tptr3d)
665 : else
666 768 : call pbuf_set_field(pbuf2d, m, 0._r8)
667 768 : if (masterproc) write(iulog,*) trim(fieldname), ' initialized to 0.'
668 : end if
669 :
670 768 : deallocate(tptr3d)
671 2304 : allocate(tptr3d(pcols,pver,begchunk:endchunk))
672 :
673 768 : fieldname = 'CONCLD'
674 768 : m = pbuf_get_index('CONCLD',ierr)
675 768 : if (m > 0) then
676 : call infld(fieldname, fh_ini, dim1name, 'lev', dim2name, 1, pcols, 1, pver, begchunk, endchunk, &
677 768 : tptr3d, found, gridname='physgrid')
678 768 : if(found) then
679 0 : do n = 1, dyn_time_lvls
680 0 : call pbuf_set_field(pbuf2d, m, tptr3d, (/1,1,n/),(/pcols,pver,1/))
681 : end do
682 : else
683 768 : call pbuf_set_field(pbuf2d, m, 0._r8)
684 768 : if (masterproc) write(iulog,*) trim(fieldname), ' initialized to 0.'
685 : end if
686 :
687 768 : deallocate (tptr3d)
688 : end if
689 :
690 768 : call initialize_short_lived_species(fh_ini, pbuf2d)
691 :
692 : !---------------------------------------------------------------------------------
693 : ! If needed, get ion and electron temperature fields from initial condition file
694 : !---------------------------------------------------------------------------------
695 :
696 768 : call waccmx_phys_ion_elec_temp_inidat(fh_ini,pbuf2d)
697 :
698 1536 : end subroutine phys_inidat
699 :
700 :
701 3072 : subroutine phys_init( phys_state, phys_tend, pbuf2d, cam_in, cam_out )
702 :
703 : !-----------------------------------------------------------------------
704 : !
705 : ! Initialization of physics package.
706 : !
707 : !-----------------------------------------------------------------------
708 :
709 768 : use physics_buffer, only: physics_buffer_desc, pbuf_initialize, pbuf_get_index
710 : use physconst, only: rair, cpair, gravit, zvir, karman
711 : use cam_thermo, only: cam_thermo_init
712 : use ref_pres, only: pref_edge, pref_mid
713 :
714 : use carma_intr, only: carma_init
715 : use cam_control_mod, only: initial_run
716 : use check_energy, only: check_energy_init
717 : use chemistry, only: chem_init
718 : use mo_lightning, only: lightning_init
719 : use prescribed_ozone, only: prescribed_ozone_init
720 : use prescribed_ghg, only: prescribed_ghg_init
721 : use prescribed_aero, only: prescribed_aero_init
722 : use aerodep_flx, only: aerodep_flx_init
723 : use aircraft_emit, only: aircraft_emit_init
724 : use prescribed_volcaero,only: prescribed_volcaero_init
725 : use prescribed_strataero,only: prescribed_strataero_init
726 : use cloud_fraction, only: cldfrc_init
727 : use cldfrc2m, only: cldfrc2m_init
728 : use co2_cycle, only: co2_init, co2_transport
729 : use convect_deep, only: convect_deep_init
730 : use convect_shallow, only: convect_shallow_init
731 : use constituents, only: cnst_get_ind
732 : use cam_diagnostics, only: diag_init
733 : use gw_drag, only: gw_init
734 : use radheat, only: radheat_init
735 : use radiation, only: radiation_init
736 : use cloud_diagnostics, only: cloud_diagnostics_init
737 : use rk_stratiform, only: rk_stratiform_init
738 : use wv_saturation, only: wv_sat_init
739 : use microp_driver, only: microp_driver_init
740 : use microp_aero, only: microp_aero_init
741 : use macrop_driver, only: macrop_driver_init
742 : use conv_water, only: conv_water_init
743 : use tracers, only: tracers_init
744 : use aoa_tracers, only: aoa_tracers_init
745 : use rayleigh_friction, only: rayleigh_friction_init
746 : use vertical_diffusion, only: vertical_diffusion_init
747 : use phys_debug_util, only: phys_debug_init
748 : use rad_constituents, only: rad_cnst_init
749 : use aer_rad_props, only: aer_rad_props_init
750 : use subcol, only: subcol_init
751 : use qbo, only: qbo_init
752 : use qneg_module, only: qneg_init
753 : use lunar_tides, only: lunar_tides_init
754 : use iondrag, only: iondrag_init
755 : #if ( defined OFFLINE_DYN )
756 : use metdata, only: metdata_phys_init
757 : #endif
758 : use epp_ionization, only: epp_ionization_init, epp_ionization_active
759 : use waccmx_phys_intr, only: waccmx_phys_ion_elec_temp_init ! Initialization of ionosphere module (WACCM-X)
760 : use waccmx_phys_intr, only: waccmx_phys_mspd_init ! Initialization of major species diffusion module (WACCM-X)
761 : use clubb_intr, only: clubb_ini_cam
762 : use sslt_rebin, only: sslt_rebin_init
763 : use tropopause, only: tropopause_init
764 : use solar_data, only: solar_data_init
765 : use dadadj_cam, only: dadadj_cam_init
766 : use cam_abortutils, only: endrun
767 : use nudging, only: Nudge_Model, nudging_init
768 : use cam_snapshot, only: cam_snapshot_init
769 : use cam_history, only: addfld, register_vector_field, add_default
770 : use phys_control, only: phys_getopts
771 : use phys_grid_ctem, only: phys_grid_ctem_init
772 : use cam_budget, only: cam_budget_init
773 : use surface_emissions_mod, only: surface_emissions_init
774 : use elevated_emissions_mod, only: elevated_emissions_init
775 :
776 : use ccpp_constituent_prop_mod, only: ccpp_const_props_init
777 :
778 : ! Input/output arguments
779 : type(physics_state), pointer :: phys_state(:)
780 : type(physics_tend ), pointer :: phys_tend(:)
781 : type(physics_buffer_desc), pointer :: pbuf2d(:,:)
782 :
783 : type(cam_in_t), intent(in) :: cam_in(begchunk:endchunk)
784 : type(cam_out_t),intent(inout) :: cam_out(begchunk:endchunk)
785 :
786 : ! local variables
787 : integer :: lchnk
788 : integer :: ierr, ixq
789 :
790 : logical :: history_budget ! output tendencies and state variables for
791 : ! temperature, water vapor, cloud
792 : ! ice, cloud liquid, U, V
793 : integer :: history_budget_histfile_num ! output history file number for budget fields
794 : !-----------------------------------------------------------------------
795 :
796 1536 : call physics_type_alloc(phys_state, phys_tend, begchunk, endchunk, pcols)
797 :
798 9216 : do lchnk = begchunk, endchunk
799 9216 : call physics_state_set_grid(lchnk, phys_state(lchnk))
800 : end do
801 :
802 : !-------------------------------------------------------------------------------------------
803 : ! Initialize any variables in cam_thermo which are not temporally and/or spatially constant
804 : !-------------------------------------------------------------------------------------------
805 1536 : call cam_thermo_init()
806 :
807 : ! Initialize debugging a physics column
808 1536 : call phys_debug_init()
809 :
810 1536 : call pbuf_initialize(pbuf2d)
811 :
812 : ! Initialize subcol scheme
813 1536 : call subcol_init(pbuf2d)
814 :
815 : ! diag_init makes addfld calls for dynamics fields that are output from
816 : ! the physics decomposition
817 1536 : call diag_init(pbuf2d)
818 :
819 1536 : call check_energy_init()
820 :
821 1536 : call tracers_init()
822 :
823 : ! age of air tracers
824 1536 : call aoa_tracers_init()
825 :
826 1536 : teout_idx = pbuf_get_index( 'TEOUT')
827 :
828 : ! adiabatic or ideal physics should be only used if in simple_physics
829 1536 : if (adiabatic .or. ideal_phys) then
830 0 : if (adiabatic) then
831 0 : call endrun('phys_init: adiabatic configuration error')
832 : else
833 0 : call endrun('phys_init: ideal_phys configuration error')
834 : end if
835 : end if
836 :
837 1536 : if (initial_run) then
838 768 : call phys_inidat(cam_out, pbuf2d)
839 : end if
840 :
841 : ! wv_saturation is relatively independent of everything else and
842 : ! low level, so init it early. Must at least do this before radiation.
843 1536 : call wv_sat_init
844 :
845 : ! solar irradiance data modules
846 1536 : call solar_data_init()
847 :
848 : ! Initialize rad constituents and their properties
849 1536 : call rad_cnst_init()
850 :
851 1536 : call radiation_init(pbuf2d)
852 :
853 1536 : call aer_rad_props_init()
854 :
855 : ! initialize carma
856 1536 : call carma_init(pbuf2d)
857 1536 : call surface_emissions_init(pbuf2d)
858 1536 : call elevated_emissions_init(pbuf2d)
859 :
860 : ! Prognostic chemistry.
861 1536 : call chem_init(phys_state,pbuf2d)
862 :
863 : ! Lightning flash frq and NOx prod
864 1536 : call lightning_init( pbuf2d )
865 :
866 : ! Prescribed tracers
867 1536 : call prescribed_ozone_init()
868 1536 : call prescribed_ghg_init()
869 1536 : call prescribed_aero_init()
870 1536 : call aerodep_flx_init()
871 1536 : call aircraft_emit_init()
872 1536 : call prescribed_volcaero_init()
873 1536 : call prescribed_strataero_init()
874 :
875 : ! co2 cycle
876 1536 : if (co2_transport()) then
877 0 : call co2_init()
878 : end if
879 :
880 1536 : call gw_init()
881 :
882 1536 : call rayleigh_friction_init()
883 :
884 1536 : call vertical_diffusion_init(pbuf2d)
885 :
886 1536 : if ( waccmx_is('ionosphere') .or. waccmx_is('neutral') ) then
887 0 : call waccmx_phys_mspd_init ()
888 : ! Initialization of ionosphere module if mode set to ionosphere
889 0 : if( waccmx_is('ionosphere') ) then
890 0 : call waccmx_phys_ion_elec_temp_init(pbuf2d)
891 : endif
892 : endif
893 :
894 1536 : call cloud_diagnostics_init(pbuf2d)
895 :
896 1536 : call radheat_init(pref_mid)
897 :
898 1536 : call convect_shallow_init(pref_edge, pbuf2d)
899 :
900 1536 : call cldfrc_init()
901 1536 : call cldfrc2m_init()
902 :
903 1536 : call convect_deep_init(pref_edge)
904 :
905 1536 : if( microp_scheme == 'RK' ) then
906 0 : call rk_stratiform_init()
907 1536 : elseif( microp_scheme == 'MG' ) then
908 1536 : if (.not. do_clubb_sgs) call macrop_driver_init(pbuf2d)
909 1536 : call microp_aero_init(phys_state,pbuf2d)
910 1536 : call microp_driver_init(pbuf2d)
911 1536 : call conv_water_init
912 : end if
913 :
914 : ! initiate CLUBB within CAM
915 1536 : if (do_clubb_sgs) call clubb_ini_cam(pbuf2d)
916 :
917 1536 : call qbo_init
918 :
919 1536 : call lunar_tides_init()
920 :
921 1536 : call iondrag_init(pref_mid)
922 : ! Geomagnetic module -- after iondrag_init
923 1536 : if (epp_ionization_active) then
924 1536 : call epp_ionization_init()
925 : endif
926 :
927 : #if ( defined OFFLINE_DYN )
928 : call metdata_phys_init()
929 : #endif
930 1536 : call sslt_rebin_init()
931 1536 : call tropopause_init()
932 1536 : call dadadj_cam_init()
933 :
934 1536 : prec_dp_idx = pbuf_get_index('PREC_DP')
935 1536 : snow_dp_idx = pbuf_get_index('SNOW_DP')
936 1536 : prec_sh_idx = pbuf_get_index('PREC_SH')
937 1536 : snow_sh_idx = pbuf_get_index('SNOW_SH')
938 :
939 1536 : dlfzm_idx = pbuf_get_index('DLFZM', ierr)
940 :
941 1536 : call phys_getopts(prog_modal_aero_out=prog_modal_aero)
942 :
943 : ! Initialize Nudging Parameters
944 : !--------------------------------
945 1536 : if(Nudge_Model) call nudging_init
946 :
947 1536 : if (clim_modal_aero) then
948 :
949 : ! If climate calculations are affected by prescribed modal aerosols, the
950 : ! the initialization routine for the dry mode radius calculation is called
951 : ! here. For prognostic MAM the initialization is called from
952 : ! modal_aero_initialize
953 1536 : if (.not. prog_modal_aero) then
954 0 : call modal_aero_calcsize_init(pbuf2d)
955 : endif
956 :
957 1536 : call modal_aero_wateruptake_init(pbuf2d)
958 :
959 : end if
960 :
961 : ! Initialize CAM CCPP constituent properties array
962 : ! for use in CCPP-ized physics schemes:
963 1536 : call cnst_get_ind('Q', ixq)
964 1536 : call ccpp_const_props_init(ixq)
965 :
966 : ! Initialize qneg3 and qneg4
967 1536 : call qneg_init()
968 :
969 : ! Initialize phys TEM diagnostics
970 1536 : call phys_grid_ctem_init()
971 :
972 : ! Initialize the snapshot capability
973 1536 : call cam_snapshot_init(cam_in, cam_out, pbuf2d, begchunk)
974 :
975 : ! Initialize the budget capability
976 1536 : call cam_budget_init()
977 :
978 : ! addfld calls for U, V tendency budget variables that are output in
979 : ! tphysac, tphysbc
980 3072 : call addfld ( 'UTEND_DCONV', (/ 'lev' /), 'A', 'm/s2', 'Zonal wind tendency by deep convection')
981 3072 : call addfld ( 'VTEND_DCONV', (/ 'lev' /), 'A', 'm/s2', 'Meridional wind tendency by deep convection')
982 1536 : call register_vector_field ( 'UTEND_DCONV', 'VTEND_DCONV')
983 3072 : call addfld ( 'UTEND_SHCONV', (/ 'lev' /), 'A', 'm/s2', 'Zonal wind tendency by shallow convection')
984 3072 : call addfld ( 'VTEND_SHCONV', (/ 'lev' /), 'A', 'm/s2', 'Meridional wind tendency by shallow convection')
985 1536 : call register_vector_field ( 'UTEND_SHCONV', 'VTEND_SHCONV')
986 3072 : call addfld ( 'UTEND_MACROP', (/ 'lev' /), 'A', 'm/s2', 'Zonal wind tendency by macrophysics')
987 3072 : call addfld ( 'VTEND_MACROP', (/ 'lev' /), 'A', 'm/s2', 'Meridional wind tendency by macrophysics')
988 1536 : call register_vector_field ( 'UTEND_MACROP', 'VTEND_MACROP')
989 3072 : call addfld ( 'UTEND_VDIFF', (/ 'lev' /), 'A', 'm/s2', 'Zonal wind tendency by vert. diffus.')
990 3072 : call addfld ( 'VTEND_VDIFF', (/ 'lev' /), 'A', 'm/s2', 'Meridional wind tendency by vert. diffus.')
991 1536 : call register_vector_field ( 'UTEND_VDIFF', 'VTEND_VDIFF')
992 3072 : call addfld ( 'UTEND_RAYLEIGH', (/ 'lev' /), 'A', 'm/s2', 'Zonal wind tendency by Rayleigh Fric.')
993 3072 : call addfld ( 'VTEND_RAYLEIGH', (/ 'lev' /), 'A', 'm/s2', 'Meridional wind tendency by Rayleigh Fric.')
994 1536 : call register_vector_field ( 'UTEND_RAYLEIGH', 'VTEND_RAYLEIGH')
995 3072 : call addfld ( 'UTEND_GWDTOT', (/ 'lev' /), 'A', 'm/s2', 'Zonal wind tendency by all GWs')
996 3072 : call addfld ( 'VTEND_GWDTOT', (/ 'lev' /), 'A', 'm/s2', 'Meridional wind tendency by all GWs')
997 1536 : call register_vector_field ( 'UTEND_GWDTOT', 'VTEND_GWDTOT')
998 3072 : call addfld ( 'UTEND_QBORLX', (/ 'lev' /), 'A', 'm/s2', 'Zonal wind tendency by QBO relaxation')
999 3072 : call addfld ( 'VTEND_QBORLX', (/ 'lev' /), 'A', 'm/s2', 'Meridional wind tendency by QBO relaxation')
1000 1536 : call register_vector_field ( 'UTEND_QBORLX', 'VTEND_QBORLX')
1001 3072 : call addfld ( 'UTEND_LUNART', (/ 'lev' /), 'A', 'm/s2', 'Zonal wind tendency by lunar tides')
1002 3072 : call addfld ( 'VTEND_LUNART', (/ 'lev' /), 'A', 'm/s2', 'Meridional wind tendency by lunar tides')
1003 1536 : call register_vector_field ( 'UTEND_LUNART', 'VTEND_LUNART')
1004 3072 : call addfld ( 'UTEND_IONDRG', (/ 'lev' /), 'A', 'm/s2', 'Zonal wind tendency by ion drag')
1005 3072 : call addfld ( 'VTEND_IONDRG', (/ 'lev' /), 'A', 'm/s2', 'Meridional wind tendency by ion drag')
1006 1536 : call register_vector_field ( 'UTEND_IONDRG', 'VTEND_IONDRG')
1007 3072 : call addfld ( 'UTEND_NDG', (/ 'lev' /), 'A', 'm/s2', 'Zonal wind tendency by nudging')
1008 3072 : call addfld ( 'VTEND_NDG', (/ 'lev' /), 'A', 'm/s2', 'Meridional wind tendency by nudging')
1009 1536 : call register_vector_field ( 'UTEND_NDG', 'VTEND_NDG')
1010 3072 : call addfld('UTEND_CORE', (/ 'lev' /), 'A', 'm/s2' , 'Zonal wind tendency due to dynamical core')
1011 3072 : call addfld('VTEND_CORE', (/ 'lev' /), 'A', 'm/s2' , 'Meridional wind tendency due to dynamical core')
1012 1536 : call register_vector_field('UTEND_CORE','VTEND_CORE')
1013 :
1014 :
1015 : call phys_getopts(history_budget_out = history_budget, &
1016 1536 : history_budget_histfile_num_out = history_budget_histfile_num)
1017 :
1018 1536 : if ( history_budget ) then
1019 0 : call add_default ( 'UTEND_DCONV' , history_budget_histfile_num, ' ')
1020 0 : call add_default ( 'VTEND_DCONV' , history_budget_histfile_num, ' ')
1021 0 : call add_default ( 'UTEND_SHCONV' , history_budget_histfile_num, ' ')
1022 0 : call add_default ( 'VTEND_SHCONV' , history_budget_histfile_num, ' ')
1023 0 : call add_default ( 'UTEND_MACROP' , history_budget_histfile_num, ' ')
1024 0 : call add_default ( 'VTEND_MACROP' , history_budget_histfile_num, ' ')
1025 0 : call add_default ( 'UTEND_VDIFF' , history_budget_histfile_num, ' ')
1026 0 : call add_default ( 'VTEND_VDIFF' , history_budget_histfile_num, ' ')
1027 0 : call add_default ( 'UTEND_RAYLEIGH' , history_budget_histfile_num, ' ')
1028 0 : call add_default ( 'VTEND_RAYLEIGH' , history_budget_histfile_num, ' ')
1029 0 : call add_default ( 'UTEND_GWDTOT' , history_budget_histfile_num, ' ')
1030 0 : call add_default ( 'VTEND_GWDTOT' , history_budget_histfile_num, ' ')
1031 0 : call add_default ( 'UTEND_QBORLX' , history_budget_histfile_num, ' ')
1032 0 : call add_default ( 'VTEND_QBORLX' , history_budget_histfile_num, ' ')
1033 0 : call add_default ( 'UTEND_LUNART' , history_budget_histfile_num, ' ')
1034 0 : call add_default ( 'VTEND_LUNART' , history_budget_histfile_num, ' ')
1035 0 : call add_default ( 'UTEND_IONDRG' , history_budget_histfile_num, ' ')
1036 0 : call add_default ( 'VTEND_IONDRG' , history_budget_histfile_num, ' ')
1037 0 : call add_default ( 'UTEND_NDG' , history_budget_histfile_num, ' ')
1038 0 : call add_default ( 'VTEND_NDG' , history_budget_histfile_num, ' ')
1039 0 : call add_default ( 'UTEND_CORE' , history_budget_histfile_num, ' ')
1040 0 : call add_default ( 'VTEND_CORE' , history_budget_histfile_num, ' ')
1041 : end if
1042 :
1043 1536 : ducore_idx = pbuf_get_index('DUCORE')
1044 1536 : dvcore_idx = pbuf_get_index('DVCORE')
1045 1536 : dtcore_idx = pbuf_get_index('DTCORE')
1046 1536 : dqcore_idx = pbuf_get_index('DQCORE')
1047 :
1048 1536 : end subroutine phys_init
1049 :
1050 : !
1051 : !-----------------------------------------------------------------------
1052 : !
1053 :
1054 32256 : subroutine phys_run1(phys_state, ztodt, phys_tend, pbuf2d, cam_in, cam_out)
1055 : !-----------------------------------------------------------------------
1056 : !
1057 : ! Purpose:
1058 : ! First part of atmospheric physics package before updating of surface models
1059 : !
1060 : !-----------------------------------------------------------------------
1061 1536 : use time_manager, only: get_nstep
1062 : use cam_diagnostics,only: diag_allocate, diag_physvar_ic
1063 : use check_energy, only: check_energy_gmean
1064 : use phys_control, only: phys_getopts
1065 : use spmd_utils, only: mpicom
1066 : use physics_buffer, only: physics_buffer_desc, pbuf_get_chunk, pbuf_allocate
1067 : use cam_history, only: outfld, write_camiop
1068 : use cam_abortutils, only: endrun
1069 : #if ( defined OFFLINE_DYN )
1070 : use metdata, only: get_met_srf1
1071 : #endif
1072 : !
1073 : ! Input arguments
1074 : !
1075 : real(r8), intent(in) :: ztodt ! physics time step unless nstep=0
1076 : !
1077 : ! Input/Output arguments
1078 : !
1079 : type(physics_state), intent(inout), dimension(begchunk:endchunk) :: phys_state
1080 : type(physics_tend ), intent(inout), dimension(begchunk:endchunk) :: phys_tend
1081 :
1082 : type(physics_buffer_desc), pointer, dimension(:,:) :: pbuf2d
1083 : type(cam_in_t), dimension(begchunk:endchunk) :: cam_in
1084 : type(cam_out_t), dimension(begchunk:endchunk) :: cam_out
1085 : !-----------------------------------------------------------------------
1086 : !
1087 : !---------------------------Local workspace-----------------------------
1088 : !
1089 : integer :: c ! indices
1090 : integer :: nstep ! current timestep number
1091 16128 : type(physics_buffer_desc), pointer :: phys_buffer_chunk(:)
1092 :
1093 16128 : call t_startf ('physpkg_st1')
1094 16128 : nstep = get_nstep()
1095 :
1096 : #if ( defined OFFLINE_DYN )
1097 : !
1098 : ! if offline mode set SNOWH and TS for micro-phys
1099 : !
1100 : call get_met_srf1( cam_in )
1101 : #endif
1102 :
1103 : ! The following initialization depends on the import state (cam_in)
1104 : ! being initialized. This isn't true when cam_init is called, so need
1105 : ! to postpone this initialization to here.
1106 16128 : if (nstep == 0 .and. phys_do_flux_avg()) call flux_avg_init(cam_in, pbuf2d)
1107 :
1108 : ! Compute total energy of input state and previous output state
1109 16128 : call t_startf ('chk_en_gmean')
1110 16128 : call check_energy_gmean(phys_state, pbuf2d, ztodt, nstep)
1111 16128 : call t_stopf ('chk_en_gmean')
1112 :
1113 16128 : call pbuf_allocate(pbuf2d, 'physpkg')
1114 16128 : call diag_allocate()
1115 :
1116 : !-----------------------------------------------------------------------
1117 : ! Advance time information
1118 : !-----------------------------------------------------------------------
1119 :
1120 16128 : call phys_timestep_init(phys_state, cam_in, cam_out, pbuf2d)
1121 :
1122 16128 : call t_stopf ('physpkg_st1')
1123 :
1124 : #ifdef TRACER_CHECK
1125 : call gmean_mass ('before tphysbc DRY', phys_state)
1126 : #endif
1127 :
1128 :
1129 : !-----------------------------------------------------------------------
1130 : ! Tendency physics before flux coupler invocation
1131 : !-----------------------------------------------------------------------
1132 : !
1133 :
1134 16128 : if (write_camiop) then
1135 0 : do c=begchunk, endchunk
1136 0 : call outfld('Tg',cam_in(c)%ts,pcols ,c )
1137 : end do
1138 : end if
1139 :
1140 16128 : call t_barrierf('sync_bc_physics', mpicom)
1141 16128 : call t_startf ('bc_physics')
1142 16128 : call t_adj_detailf(+1)
1143 :
1144 : !$OMP PARALLEL DO PRIVATE (C, phys_buffer_chunk)
1145 96768 : do c=begchunk, endchunk
1146 : !
1147 : ! Output physics terms to IC file
1148 : !
1149 80640 : phys_buffer_chunk => pbuf_get_chunk(pbuf2d, c)
1150 :
1151 80640 : call t_startf ('diag_physvar_ic')
1152 80640 : call diag_physvar_ic ( c, phys_buffer_chunk, cam_out(c), cam_in(c) )
1153 80640 : call t_stopf ('diag_physvar_ic')
1154 :
1155 80640 : call tphysbc(ztodt, phys_state(c), phys_tend(c), phys_buffer_chunk, &
1156 258048 : cam_out(c), cam_in(c) )
1157 : end do
1158 :
1159 16128 : call t_adj_detailf(-1)
1160 16128 : call t_stopf ('bc_physics')
1161 :
1162 : ! Don't call the rest in CRM mode
1163 16128 : if(single_column.and.scm_crm_mode) return
1164 :
1165 : #ifdef TRACER_CHECK
1166 : call gmean_mass ('between DRY', phys_state)
1167 : #endif
1168 :
1169 32256 : end subroutine phys_run1
1170 :
1171 : !
1172 : !-----------------------------------------------------------------------
1173 : !
1174 :
1175 29184 : subroutine phys_run2(phys_state, ztodt, phys_tend, pbuf2d, cam_out, &
1176 14592 : cam_in )
1177 : !-----------------------------------------------------------------------
1178 : !
1179 : ! Purpose:
1180 : ! Second part of atmospheric physics package after updating of surface models
1181 : !
1182 : !-----------------------------------------------------------------------
1183 16128 : use physics_buffer, only: physics_buffer_desc, pbuf_get_chunk, pbuf_deallocate, pbuf_update_tim_idx
1184 : use mo_lightning, only: lightning_no_prod
1185 : use cam_diagnostics, only: diag_deallocate, diag_surf
1186 : use carma_intr, only: carma_accumulate_stats
1187 : use spmd_utils, only: mpicom
1188 : use iop_forcing, only: scam_use_iop_srf
1189 : #if ( defined OFFLINE_DYN )
1190 : use metdata, only: get_met_srf2
1191 : #endif
1192 : use hemco_interface, only: HCOI_Chunk_Run
1193 : !
1194 : ! Input arguments
1195 : !
1196 : real(r8), intent(in) :: ztodt ! physics time step unless nstep=0
1197 : !
1198 : ! Input/Output arguments
1199 : !
1200 : type(physics_state), intent(inout), dimension(begchunk:endchunk) :: phys_state
1201 : type(physics_tend ), intent(inout), dimension(begchunk:endchunk) :: phys_tend
1202 : type(physics_buffer_desc),pointer, dimension(:,:) :: pbuf2d
1203 :
1204 : type(cam_out_t), intent(inout), dimension(begchunk:endchunk) :: cam_out
1205 : type(cam_in_t), intent(inout), dimension(begchunk:endchunk) :: cam_in
1206 : !
1207 : !-----------------------------------------------------------------------
1208 : !---------------------------Local workspace-----------------------------
1209 : !
1210 : integer :: c ! chunk index
1211 : integer :: ncol ! number of columns
1212 14592 : type(physics_buffer_desc),pointer, dimension(:) :: phys_buffer_chunk
1213 : !
1214 : ! If exit condition just return
1215 : !
1216 :
1217 14592 : if(single_column.and.scm_crm_mode) then
1218 0 : call diag_deallocate()
1219 : return
1220 : end if
1221 : !-----------------------------------------------------------------------
1222 : ! if using IOP values for surface fluxes overwrite here after surface components run
1223 : !-----------------------------------------------------------------------
1224 14592 : if (single_column) call scam_use_iop_srf(cam_in)
1225 :
1226 :
1227 14592 : if(use_hemco) then
1228 : !----------------------------------------------------------
1229 : ! run hemco (phase 2 before chemistry)
1230 : ! only phase 2 is used currently for HEMCO-CESM
1231 : !----------------------------------------------------------
1232 0 : call HCOI_Chunk_Run(cam_in, phys_state, pbuf2d, phase=2)
1233 : endif
1234 :
1235 : !-----------------------------------------------------------------------
1236 : ! Tendency physics after coupler
1237 : ! Not necessary at terminal timestep.
1238 : !-----------------------------------------------------------------------
1239 : !
1240 : #if ( defined OFFLINE_DYN )
1241 : !
1242 : ! if offline mode set SHFLX QFLX TAUX TAUY for vert diffusion
1243 : !
1244 : call get_met_srf2( cam_in )
1245 : #endif
1246 : ! lightning flash freq and prod rate of NOx
1247 14592 : call t_startf ('lightning_no_prod')
1248 14592 : call lightning_no_prod( phys_state, pbuf2d, cam_in )
1249 14592 : call t_stopf ('lightning_no_prod')
1250 :
1251 14592 : call t_barrierf('sync_ac_physics', mpicom)
1252 14592 : call t_startf ('ac_physics')
1253 14592 : call t_adj_detailf(+1)
1254 :
1255 : !$OMP PARALLEL DO PRIVATE (C, NCOL, phys_buffer_chunk)
1256 :
1257 87552 : do c=begchunk,endchunk
1258 : ncol = get_ncols_p(c)
1259 72960 : phys_buffer_chunk => pbuf_get_chunk(pbuf2d, c)
1260 : !
1261 : ! surface diagnostics for history files
1262 : !
1263 72960 : call t_startf('diag_surf')
1264 72960 : call diag_surf(cam_in(c), cam_out(c), phys_state(c), phys_buffer_chunk)
1265 72960 : call t_stopf('diag_surf')
1266 :
1267 72960 : call tphysac(ztodt, cam_in(c), &
1268 : cam_out(c), &
1269 233472 : phys_state(c), phys_tend(c), phys_buffer_chunk)
1270 : end do ! Chunk loop
1271 :
1272 14592 : call t_adj_detailf(-1)
1273 14592 : call t_stopf('ac_physics')
1274 :
1275 : #ifdef TRACER_CHECK
1276 : call gmean_mass ('after tphysac FV:WET)', phys_state)
1277 : #endif
1278 :
1279 14592 : call t_startf ('carma_accumulate_stats')
1280 14592 : call carma_accumulate_stats()
1281 14592 : call t_stopf ('carma_accumulate_stats')
1282 :
1283 14592 : call t_startf ('physpkg_st2')
1284 14592 : call pbuf_deallocate(pbuf2d, 'physpkg')
1285 :
1286 14592 : call pbuf_update_tim_idx()
1287 14592 : call diag_deallocate()
1288 14592 : call t_stopf ('physpkg_st2')
1289 :
1290 29184 : end subroutine phys_run2
1291 :
1292 : !
1293 : !-----------------------------------------------------------------------
1294 : !
1295 :
1296 1536 : subroutine phys_final( phys_state, phys_tend, pbuf2d )
1297 14592 : use physics_buffer, only : physics_buffer_desc, pbuf_deallocate
1298 : use chemistry, only : chem_final
1299 : use carma_intr, only : carma_final
1300 : use wv_saturation, only : wv_sat_final
1301 : use hemco_interface, only: HCOI_Chunk_Final
1302 : use microp_aero, only : microp_aero_final
1303 : use phys_grid_ctem, only : phys_grid_ctem_final
1304 : use nudging, only: Nudge_Model, nudging_final
1305 :
1306 : !-----------------------------------------------------------------------
1307 : !
1308 : ! Purpose:
1309 : ! Finalization of physics package
1310 : !
1311 : !-----------------------------------------------------------------------
1312 : ! Input/output arguments
1313 : type(physics_state), pointer :: phys_state(:)
1314 : type(physics_tend ), pointer :: phys_tend(:)
1315 : type(physics_buffer_desc), pointer :: pbuf2d(:,:)
1316 :
1317 1536 : if(associated(pbuf2d)) then
1318 1536 : call pbuf_deallocate(pbuf2d,'global')
1319 1536 : deallocate(pbuf2d)
1320 : end if
1321 1536 : deallocate(phys_state)
1322 1536 : deallocate(phys_tend)
1323 1536 : call chem_final
1324 1536 : call carma_final
1325 1536 : call wv_sat_final
1326 1536 : call microp_aero_final()
1327 1536 : call phys_grid_ctem_final()
1328 1536 : if(Nudge_Model) call nudging_final()
1329 :
1330 1536 : if(use_hemco) then
1331 : ! cleanup hemco
1332 0 : call HCOI_Chunk_Final
1333 : endif
1334 :
1335 1536 : end subroutine phys_final
1336 :
1337 :
1338 72960 : subroutine tphysac (ztodt, cam_in, &
1339 : cam_out, state, tend, pbuf)
1340 : !-----------------------------------------------------------------------
1341 : !
1342 : ! Tendency physics after coupling to land, sea, and ice models.
1343 : !
1344 : ! Computes the following:
1345 : !
1346 : ! o Aerosol Emission at Surface
1347 : ! o Source-Sink for Advected Tracers
1348 : ! o Symmetric Turbulence Scheme - Vertical Diffusion
1349 : ! o Rayleigh Friction
1350 : ! o Dry Deposition of Aerosol
1351 : ! o Enforce Charge Neutrality ( Only for WACCM )
1352 : ! o Gravity Wave Drag
1353 : ! o QBO Relaxation ( Only for WACCM )
1354 : ! o Ion Drag ( Only for WACCM )
1355 : ! o Scale Dry Mass Energy
1356 : !-----------------------------------------------------------------------
1357 1536 : use physics_buffer, only: physics_buffer_desc, pbuf_set_field, pbuf_get_index, pbuf_get_field, pbuf_old_tim_idx
1358 : use shr_kind_mod, only: r8 => shr_kind_r8
1359 : use chemistry, only: chem_is_active, chem_timestep_tend, chem_emissions
1360 : use cam_diagnostics, only: diag_phys_tend_writeout
1361 : use gw_drag, only: gw_tend
1362 : use vertical_diffusion, only: vertical_diffusion_tend
1363 : use rayleigh_friction, only: rayleigh_friction_tend
1364 : use constituents, only: cnst_get_ind
1365 : use physics_types, only: physics_state, physics_tend, physics_ptend, physics_update, &
1366 : physics_dme_adjust, set_dry_to_wet, physics_state_check, &
1367 : dyn_te_idx
1368 : use waccmx_phys_intr, only: waccmx_phys_mspd_tend ! WACCM-X major diffusion
1369 : use waccmx_phys_intr, only: waccmx_phys_ion_elec_temp_tend ! WACCM-X
1370 : use aoa_tracers, only: aoa_tracers_timestep_tend
1371 : use physconst, only: rhoh2o, latvap,latice
1372 : use dyn_tests_utils, only: vc_dycore
1373 : use aero_model, only: aero_model_drydep
1374 : use carma_intr, only: carma_emission_tend, carma_timestep_tend
1375 : use carma_flags_mod, only: carma_do_aerosol, carma_do_emission
1376 : use check_energy, only: tot_energy_phys
1377 : use check_energy, only: check_tracers_data, check_tracers_init, check_tracers_chng
1378 : use check_energy, only: check_energy_cam_chng
1379 : use time_manager, only: get_nstep
1380 : use cam_abortutils, only: endrun
1381 : use dycore, only: dycore_is
1382 : use cam_control_mod, only: aqua_planet
1383 : use mo_gas_phase_chemdr,only: map2chm
1384 : use clybry_fam, only: clybry_fam_set
1385 : use charge_neutrality, only: charge_balance
1386 : use qbo, only: qbo_relax
1387 : use iondrag, only: iondrag_calc, do_waccm_ions
1388 : use perf_mod
1389 : use flux_avg, only: flux_avg_run
1390 : use unicon_cam, only: unicon_cam_org_diags
1391 : use cam_history, only: outfld
1392 : use qneg_module, only: qneg4
1393 : use co2_cycle, only: co2_cycle_set_ptend
1394 : use nudging, only: Nudge_Model,Nudge_ON,nudging_timestep_tend
1395 : use cam_snapshot, only: cam_snapshot_all_outfld_tphysac
1396 : use cam_snapshot_common,only: cam_snapshot_ptend_outfld
1397 : use lunar_tides, only: lunar_tides_tend
1398 : use cam_thermo, only: cam_thermo_water_update
1399 : use cam_budget, only: thermo_budget_history
1400 : use dyn_tests_utils, only: vc_dycore, vc_height, vc_dry_pressure
1401 : use air_composition, only: cpairv, cp_or_cv_dycore
1402 : !
1403 : ! Arguments
1404 : !
1405 : real(r8), intent(in) :: ztodt ! Two times model timestep (2 delta-t)
1406 :
1407 : type(cam_in_t), intent(inout) :: cam_in
1408 : type(cam_out_t), intent(inout) :: cam_out
1409 : type(physics_state), intent(inout) :: state
1410 : type(physics_tend ), intent(inout) :: tend
1411 : type(physics_buffer_desc), pointer :: pbuf(:)
1412 :
1413 :
1414 : type(check_tracers_data):: tracerint ! tracer mass integrals and cummulative boundary fluxes
1415 :
1416 : !
1417 : !---------------------------Local workspace-----------------------------
1418 : !
1419 14810880 : type(physics_ptend) :: ptend ! indivdual parameterization tendencies
1420 :
1421 : integer :: nstep ! current timestep number
1422 : real(r8) :: zero(pcols) ! array of zeros
1423 :
1424 : integer :: lchnk ! chunk identifier
1425 : integer :: ncol ! number of atmospheric columns
1426 : integer :: i,k ! Longitude, level indices
1427 : integer :: ixq
1428 :
1429 : logical :: labort ! abort flag
1430 :
1431 : real(r8) surfric(pcols) ! surface friction velocity
1432 : real(r8) obklen(pcols) ! Obukhov length
1433 : real(r8) :: fh2o(pcols) ! h2o flux to balance source from methane chemistry
1434 : real(r8) :: flx_heat(pcols) ! Heat flux for check_energy_chng.
1435 : real(r8) :: tmp_trac (pcols,pver,pcnst) ! tmp space
1436 : real(r8) :: tmp_pdel (pcols,pver) ! tmp space
1437 : real(r8) :: tmp_ps (pcols) ! tmp space
1438 : real(r8) :: scaling(pcols,pver)
1439 : logical :: moist_mixing_ratio_dycore
1440 :
1441 : ! physics buffer fields for total energy and mass adjustment
1442 : integer itim_old, ifld
1443 :
1444 72960 : real(r8), pointer, dimension(:,:) :: cld
1445 72960 : real(r8), pointer, dimension(:,:) :: qini
1446 72960 : real(r8), pointer, dimension(:,:) :: cldliqini
1447 72960 : real(r8), pointer, dimension(:,:) :: cldiceini
1448 72960 : real(r8), pointer, dimension(:,:) :: totliqini
1449 72960 : real(r8), pointer, dimension(:,:) :: toticeini
1450 72960 : real(r8), pointer, dimension(:,:) :: dtcore
1451 72960 : real(r8), pointer, dimension(:,:) :: dqcore
1452 72960 : real(r8), pointer, dimension(:,:) :: ducore
1453 72960 : real(r8), pointer, dimension(:,:) :: dvcore
1454 72960 : real(r8), pointer, dimension(:,:) :: ast ! relative humidity cloud fraction
1455 :
1456 : ! For aerosol budget diagnostics
1457 : type(carma_diags_t), pointer :: carma_diags_obj
1458 :
1459 : !-----------------------------------------------------------------------
1460 72960 : carma_diags_obj => carma_diags_t()
1461 72960 : if (.not.associated(carma_diags_obj)) then
1462 0 : call endrun('tphysac: carma_diags_obj allocation failed')
1463 : end if
1464 :
1465 72960 : lchnk = state%lchnk
1466 72960 : ncol = state%ncol
1467 :
1468 72960 : nstep = get_nstep()
1469 72960 : call cnst_get_ind('Q', ixq)
1470 :
1471 : ! Adjust the surface fluxes to reduce instabilities in near sfc layer
1472 72960 : if (phys_do_flux_avg()) then
1473 0 : call flux_avg_run(state, cam_in, pbuf, nstep, ztodt)
1474 : endif
1475 :
1476 : ! Validate the physics state.
1477 72960 : if (state_debug_checks) &
1478 72960 : call physics_state_check(state, name="before tphysac")
1479 :
1480 72960 : call t_startf('tphysac_init')
1481 : ! Associate pointers with physics buffer fields
1482 72960 : itim_old = pbuf_old_tim_idx()
1483 :
1484 291840 : call pbuf_get_field(pbuf, dtcore_idx, dtcore, start=(/1,1,itim_old/), kount=(/pcols,pver,1/) )
1485 291840 : call pbuf_get_field(pbuf, dqcore_idx, dqcore, start=(/1,1,itim_old/), kount=(/pcols,pver,1/) )
1486 291840 : call pbuf_get_field(pbuf, ducore_idx, ducore, start=(/1,1,itim_old/), kount=(/pcols,pver,1/) )
1487 291840 : call pbuf_get_field(pbuf, dvcore_idx, dvcore, start=(/1,1,itim_old/), kount=(/pcols,pver,1/) )
1488 :
1489 72960 : call pbuf_get_field(pbuf, qini_idx, qini)
1490 72960 : call pbuf_get_field(pbuf, cldliqini_idx, cldliqini)
1491 72960 : call pbuf_get_field(pbuf, cldiceini_idx, cldiceini)
1492 72960 : call pbuf_get_field(pbuf, totliqini_idx, totliqini)
1493 72960 : call pbuf_get_field(pbuf, toticeini_idx, toticeini)
1494 :
1495 72960 : ifld = pbuf_get_index('CLD')
1496 291840 : call pbuf_get_field(pbuf, ifld, cld, start=(/1,1,itim_old/),kount=(/pcols,pver,1/))
1497 :
1498 72960 : ifld = pbuf_get_index('AST')
1499 291840 : call pbuf_get_field(pbuf, ifld, ast, start=(/1,1,itim_old/), kount=(/pcols,pver,1/) )
1500 :
1501 : !
1502 : ! accumulate fluxes into net flux array for spectral dycores
1503 : ! jrm Include latent heat of fusion for snow
1504 : !
1505 1123584 : do i=1,ncol
1506 1050624 : tend%flx_net(i) = tend%flx_net(i) + cam_in%shf(i) + (cam_out%precc(i) &
1507 : + cam_out%precl(i))*latvap*rhoh2o &
1508 2174208 : + (cam_out%precsc(i) + cam_out%precsl(i))*latice*rhoh2o
1509 : end do
1510 :
1511 : ! emissions of aerosols and gas-phase chemistry constituents at surface
1512 :
1513 72960 : if (trim(cam_take_snapshot_before) == "chem_emissions") then
1514 : call cam_snapshot_all_outfld_tphysac(cam_snapshot_before_num, state, tend, cam_in, cam_out, pbuf,&
1515 0 : fh2o, surfric, obklen, flx_heat)
1516 : end if
1517 :
1518 72960 : call carma_diags_obj%update(cam_in, state, pbuf)
1519 :
1520 72960 : call chem_emissions( state, cam_in, pbuf )
1521 :
1522 72960 : call carma_diags_obj%output(state, ptend, cam_in, "CHEMEMIS", ztodt, pbuf)
1523 :
1524 72960 : if (trim(cam_take_snapshot_after) == "chem_emissions") then
1525 : call cam_snapshot_all_outfld_tphysac(cam_snapshot_after_num, state, tend, cam_in, cam_out, pbuf,&
1526 0 : fh2o, surfric, obklen, flx_heat)
1527 : end if
1528 :
1529 72960 : if (carma_do_emission) then
1530 : ! carma emissions
1531 0 : call carma_diags_obj%update(cam_in, state, pbuf)
1532 0 : call carma_emission_tend(state, ptend, cam_in, ztodt, pbuf)
1533 0 : call carma_diags_obj%output(state, ptend, cam_in, "CREMIS", ztodt, pbuf)
1534 0 : call physics_update(state, ptend, ztodt, tend)
1535 : end if
1536 :
1537 : ! get nstep and zero array for energy checker
1538 72960 : zero = 0._r8
1539 72960 : nstep = get_nstep()
1540 72960 : call check_tracers_init(state, tracerint)
1541 :
1542 : ! Check if latent heat flux exceeds the total moisture content of the
1543 : ! lowest model layer, thereby creating negative moisture.
1544 :
1545 : call qneg4('TPHYSAC', lchnk, ncol, ztodt , &
1546 0 : state%q(1,pver,1), state%rpdel(1,pver), &
1547 72960 : cam_in%shf, cam_in%lhf, cam_in%cflx)
1548 :
1549 72960 : call t_stopf('tphysac_init')
1550 : !===================================================
1551 : ! Source/sink terms for advected tracers.
1552 : !===================================================
1553 72960 : call t_startf('adv_tracer_src_snk')
1554 : ! Test tracers
1555 :
1556 72960 : if (trim(cam_take_snapshot_before) == "aoa_tracers_timestep_tend") then
1557 : call cam_snapshot_all_outfld_tphysac(cam_snapshot_before_num, state, tend, cam_in, cam_out, pbuf,&
1558 0 : fh2o, surfric, obklen, flx_heat)
1559 : end if
1560 72960 : call aoa_tracers_timestep_tend(state, ptend, ztodt)
1561 72960 : if ( (trim(cam_take_snapshot_after) == "aoa_tracers_timestep_tend") .and. &
1562 : (trim(cam_take_snapshot_before) == trim(cam_take_snapshot_after))) then
1563 0 : call cam_snapshot_ptend_outfld(ptend, lchnk)
1564 : end if
1565 72960 : call physics_update(state, ptend, ztodt, tend)
1566 72960 : if (trim(cam_take_snapshot_after) == "aoa_tracers_timestep_tend") then
1567 : call cam_snapshot_all_outfld_tphysac(cam_snapshot_after_num, state, tend, cam_in, cam_out, pbuf,&
1568 0 : fh2o, surfric, obklen, flx_heat)
1569 : end if
1570 : call check_tracers_chng(state, tracerint, "aoa_tracers_timestep_tend", nstep, ztodt, &
1571 72960 : cam_in%cflx)
1572 :
1573 72960 : if (trim(cam_take_snapshot_before) == "co2_cycle_set_ptend") then
1574 : call cam_snapshot_all_outfld_tphysac(cam_snapshot_before_num, state, tend, cam_in, cam_out, pbuf,&
1575 0 : fh2o, surfric, obklen, flx_heat)
1576 : end if
1577 72960 : call co2_cycle_set_ptend(state, pbuf, ptend)
1578 72960 : if ( (trim(cam_take_snapshot_after) == "co2_cycle_set_ptend") .and. &
1579 : (trim(cam_take_snapshot_before) == trim(cam_take_snapshot_after))) then
1580 0 : call cam_snapshot_ptend_outfld(ptend, lchnk)
1581 : end if
1582 72960 : call physics_update(state, ptend, ztodt, tend)
1583 72960 : if (trim(cam_take_snapshot_after) == "co2_cycle_set_ptend") then
1584 : call cam_snapshot_all_outfld_tphysac(cam_snapshot_after_num, state, tend, cam_in, cam_out, pbuf,&
1585 0 : fh2o, surfric, obklen, flx_heat)
1586 : end if
1587 :
1588 : !===================================================
1589 : ! Chemistry and MAM calculation
1590 : ! MAM core aerosol conversion process is performed in the below 'chem_timestep_tend'.
1591 : ! In addition, surface flux of aerosol species other than 'dust' and 'sea salt', and
1592 : ! elevated emission of aerosol species are treated in 'chem_timestep_tend' before
1593 : ! Gas chemistry and MAM core aerosol conversion.
1594 : ! Note that surface flux is not added into the atmosphere, but elevated emission is
1595 : ! added into the atmosphere as tendency.
1596 : !===================================================
1597 72960 : if (chem_is_active()) then
1598 :
1599 72960 : if (trim(cam_take_snapshot_before) == "chem_timestep_tend") then
1600 : call cam_snapshot_all_outfld_tphysac(cam_snapshot_before_num, state, tend, cam_in, cam_out, pbuf,&
1601 0 : fh2o, surfric, obklen, flx_heat)
1602 : end if
1603 :
1604 72960 : call carma_diags_obj%update(cam_in, state, pbuf)
1605 :
1606 : call chem_timestep_tend(state, ptend, cam_in, cam_out, ztodt, &
1607 72960 : pbuf, fh2o=fh2o)
1608 :
1609 :
1610 72960 : if ( (trim(cam_take_snapshot_after) == "chem_timestep_tend") .and. &
1611 : (trim(cam_take_snapshot_before) == trim(cam_take_snapshot_after))) then
1612 0 : call cam_snapshot_ptend_outfld(ptend, lchnk)
1613 : end if
1614 :
1615 72960 : call carma_diags_obj%output(state, ptend, cam_in, "CHEM", ztodt, pbuf)
1616 :
1617 72960 : call physics_update(state, ptend, ztodt, tend)
1618 :
1619 72960 : if (trim(cam_take_snapshot_after) == "chem_timestep_tend") then
1620 : call cam_snapshot_all_outfld_tphysac(cam_snapshot_after_num, state, tend, cam_in, cam_out, pbuf,&
1621 0 : fh2o, surfric, obklen, flx_heat)
1622 : end if
1623 72960 : call check_energy_cam_chng(state, tend, "chem", nstep, ztodt, fh2o, zero, zero, zero)
1624 : call check_tracers_chng(state, tracerint, "chem_timestep_tend", nstep, ztodt, &
1625 72960 : cam_in%cflx)
1626 : end if
1627 72960 : call t_stopf('adv_tracer_src_snk')
1628 :
1629 : !===================================================
1630 : ! Vertical diffusion/pbl calculation
1631 : ! Call vertical diffusion code (pbl, free atmosphere and molecular)
1632 : !===================================================
1633 :
1634 72960 : call t_startf('vertical_diffusion_tend')
1635 :
1636 72960 : if (trim(cam_take_snapshot_before) == "vertical_diffusion_section") then
1637 : call cam_snapshot_all_outfld_tphysac(cam_snapshot_before_num, state, tend, cam_in, cam_out, pbuf,&
1638 0 : fh2o, surfric, obklen, flx_heat)
1639 : end if
1640 :
1641 72960 : call carma_diags_obj%update(cam_in, state, pbuf)
1642 :
1643 : call vertical_diffusion_tend (ztodt ,state , cam_in, &
1644 72960 : surfric ,obklen ,ptend ,ast ,pbuf )
1645 :
1646 : !------------------------------------------
1647 : ! Call major diffusion for extended model
1648 : !------------------------------------------
1649 72960 : if ( waccmx_is('ionosphere') .or. waccmx_is('neutral') ) then
1650 0 : call waccmx_phys_mspd_tend (ztodt ,state ,ptend)
1651 : endif
1652 :
1653 72960 : if ( (trim(cam_take_snapshot_after) == "vertical_diffusion_section") .and. &
1654 : (trim(cam_take_snapshot_before) == trim(cam_take_snapshot_after))) then
1655 0 : call cam_snapshot_ptend_outfld(ptend, lchnk)
1656 : end if
1657 72960 : if ( ptend%lu ) then
1658 72960 : call outfld( 'UTEND_VDIFF', ptend%u, pcols, lchnk)
1659 : end if
1660 72960 : if ( ptend%lv ) then
1661 72960 : call outfld( 'VTEND_VDIFF', ptend%v, pcols, lchnk)
1662 : end if
1663 :
1664 72960 : call carma_diags_obj%output(state, ptend, cam_in, "VDIF", ztodt, pbuf)
1665 :
1666 72960 : call physics_update(state, ptend, ztodt, tend)
1667 :
1668 72960 : if (trim(cam_take_snapshot_after) == "vertical_diffusion_section") then
1669 : call cam_snapshot_all_outfld_tphysac(cam_snapshot_after_num, state, tend, cam_in, cam_out, pbuf,&
1670 0 : fh2o, surfric, obklen, flx_heat)
1671 : end if
1672 :
1673 72960 : call t_stopf ('vertical_diffusion_tend')
1674 :
1675 : !===================================================
1676 : ! Rayleigh friction calculation
1677 : !===================================================
1678 72960 : call t_startf('rayleigh_friction')
1679 72960 : call rayleigh_friction_tend( ztodt, state, ptend)
1680 72960 : if ( ptend%lu ) then
1681 72960 : call outfld( 'UTEND_RAYLEIGH', ptend%u, pcols, lchnk)
1682 : end if
1683 72960 : if ( ptend%lv ) then
1684 72960 : call outfld( 'VTEND_RAYLEIGH', ptend%v, pcols, lchnk)
1685 : end if
1686 72960 : call physics_update(state, ptend, ztodt, tend)
1687 72960 : call t_stopf('rayleigh_friction')
1688 :
1689 72960 : if (do_clubb_sgs) then
1690 72960 : call check_energy_cam_chng(state, tend, "vdiff", nstep, ztodt, zero, zero, zero, zero)
1691 : else
1692 : call check_energy_cam_chng(state, tend, "vdiff", nstep, ztodt, cam_in%cflx(:,1), zero, &
1693 0 : zero, cam_in%shf)
1694 : endif
1695 :
1696 72960 : call check_tracers_chng(state, tracerint, "vdiff", nstep, ztodt, cam_in%cflx)
1697 :
1698 : ! aerosol dry deposition processes
1699 72960 : call t_startf('aero_drydep')
1700 :
1701 72960 : if (trim(cam_take_snapshot_before) == "aero_model_drydep") then
1702 : call cam_snapshot_all_outfld_tphysac(cam_snapshot_before_num, state, tend, cam_in, cam_out, pbuf,&
1703 0 : fh2o, surfric, obklen, flx_heat)
1704 : end if
1705 :
1706 72960 : call carma_diags_obj%update(cam_in, state, pbuf)
1707 :
1708 72960 : call aero_model_drydep( state, pbuf, obklen, surfric, cam_in, ztodt, cam_out, ptend )
1709 72960 : if ( (trim(cam_take_snapshot_after) == "aero_model_drydep") .and. &
1710 : (trim(cam_take_snapshot_before) == trim(cam_take_snapshot_after))) then
1711 0 : call cam_snapshot_ptend_outfld(ptend, lchnk)
1712 : end if
1713 72960 : call carma_diags_obj%output(state, ptend, cam_in, "DRYDEPA", ztodt, pbuf)
1714 72960 : call physics_update(state, ptend, ztodt, tend)
1715 :
1716 72960 : if (trim(cam_take_snapshot_after) == "aero_model_drydep") then
1717 : call cam_snapshot_all_outfld_tphysac(cam_snapshot_after_num, state, tend, cam_in, cam_out, pbuf,&
1718 0 : fh2o, surfric, obklen, flx_heat)
1719 : end if
1720 :
1721 72960 : call t_stopf('aero_drydep')
1722 :
1723 : ! CARMA microphysics
1724 : !
1725 : ! NOTE: This does both the timestep_tend for CARMA aerosols as well as doing the dry
1726 : ! deposition for CARMA aerosols. It needs to follow vertical_diffusion_tend, so that
1727 : ! obklen and surfric have been calculated. It needs to follow aero_model_drydep, so
1728 : ! that cam_out%xxxdryxxx fields have already been set for CAM aerosols and cam_out
1729 : ! can be added to for CARMA aerosols.
1730 72960 : if (carma_do_aerosol) then
1731 72960 : call t_startf('carma_timestep_tend')
1732 72960 : call carma_diags_obj%update(cam_in, state, pbuf)
1733 72960 : call carma_timestep_tend(state, cam_in, cam_out, ptend, ztodt, pbuf, obklen=obklen, ustar=surfric)
1734 72960 : call carma_diags_obj%output(state, ptend, cam_in, "CRTEND", ztodt, pbuf)
1735 72960 : call physics_update(state, ptend, ztodt, tend)
1736 :
1737 72960 : call check_energy_cam_chng(state, tend, "carma_tend", nstep, ztodt, zero, zero, zero, zero)
1738 72960 : call t_stopf('carma_timestep_tend')
1739 : end if
1740 :
1741 :
1742 : !---------------------------------------------------------------------------------
1743 : ! ... enforce charge neutrality
1744 : !---------------------------------------------------------------------------------
1745 72960 : call charge_balance(state, pbuf)
1746 :
1747 : !===================================================
1748 : ! Gravity wave drag
1749 : !===================================================
1750 72960 : call t_startf('gw_tend')
1751 :
1752 72960 : if (trim(cam_take_snapshot_before) == "gw_tend") then
1753 : call cam_snapshot_all_outfld_tphysac(cam_snapshot_before_num, state, tend, cam_in, cam_out, pbuf,&
1754 0 : fh2o, surfric, obklen, flx_heat)
1755 : end if
1756 :
1757 72960 : call gw_tend(state, pbuf, ztodt, ptend, cam_in, flx_heat)
1758 :
1759 72960 : if ( (trim(cam_take_snapshot_after) == "gw_tend") .and. &
1760 : (trim(cam_take_snapshot_before) == trim(cam_take_snapshot_after))) then
1761 0 : call cam_snapshot_ptend_outfld(ptend, lchnk)
1762 : end if
1763 72960 : if ( ptend%lu ) then
1764 72960 : call outfld( 'UTEND_GWDTOT', ptend%u, pcols, lchnk)
1765 : end if
1766 72960 : if ( ptend%lv ) then
1767 72960 : call outfld( 'VTEND_GWDTOT', ptend%v, pcols, lchnk)
1768 : end if
1769 72960 : call physics_update(state, ptend, ztodt, tend)
1770 :
1771 72960 : if (trim(cam_take_snapshot_after) == "gw_tend") then
1772 : call cam_snapshot_all_outfld_tphysac(cam_snapshot_after_num, state, tend, cam_in, cam_out, pbuf,&
1773 0 : fh2o, surfric, obklen, flx_heat)
1774 : end if
1775 :
1776 : ! Check energy integrals
1777 : call check_energy_cam_chng(state, tend, "gwdrag", nstep, ztodt, zero, &
1778 72960 : zero, zero, flx_heat)
1779 72960 : call t_stopf('gw_tend')
1780 :
1781 : ! QBO relaxation
1782 :
1783 72960 : if (trim(cam_take_snapshot_before) == "qbo_relax") then
1784 : call cam_snapshot_all_outfld_tphysac(cam_snapshot_before_num, state, tend, cam_in, cam_out, pbuf,&
1785 0 : fh2o, surfric, obklen, flx_heat)
1786 : end if
1787 :
1788 72960 : call qbo_relax(state, pbuf, ptend)
1789 72960 : if ( (trim(cam_take_snapshot_after) == "qbo_relax") .and. &
1790 : (trim(cam_take_snapshot_before) == trim(cam_take_snapshot_after))) then
1791 0 : call cam_snapshot_ptend_outfld(ptend, lchnk)
1792 : end if
1793 72960 : if ( ptend%lu ) then
1794 72960 : call outfld( 'UTEND_QBORLX', ptend%u, pcols, lchnk)
1795 : end if
1796 72960 : if ( ptend%lv ) then
1797 0 : call outfld( 'VTEND_QBORLX', ptend%v, pcols, lchnk)
1798 : end if
1799 72960 : call physics_update(state, ptend, ztodt, tend)
1800 :
1801 72960 : if (trim(cam_take_snapshot_after) == "qbo_relax") then
1802 : call cam_snapshot_all_outfld_tphysac(cam_snapshot_after_num, state, tend, cam_in, cam_out, pbuf,&
1803 0 : fh2o, surfric, obklen, flx_heat)
1804 : end if
1805 :
1806 : ! Check energy integrals
1807 72960 : call check_energy_cam_chng(state, tend, "qborelax", nstep, ztodt, zero, zero, zero, zero)
1808 :
1809 : ! Lunar tides
1810 72960 : call lunar_tides_tend( state, ptend )
1811 72960 : if ( ptend%lu ) then
1812 0 : call outfld( 'UTEND_LUNART', ptend%u, pcols, lchnk)
1813 : end if
1814 72960 : if ( ptend%lv ) then
1815 0 : call outfld( 'VTEND_LUNART', ptend%v, pcols, lchnk)
1816 : end if
1817 72960 : call physics_update(state, ptend, ztodt, tend)
1818 : ! Check energy integrals
1819 72960 : call check_energy_cam_chng(state, tend, "lunar_tides", nstep, ztodt, zero, zero, zero, zero)
1820 :
1821 : ! Ion drag calculation
1822 72960 : call t_startf ( 'iondrag' )
1823 :
1824 72960 : if (trim(cam_take_snapshot_before) == "iondrag_calc_section") then
1825 : call cam_snapshot_all_outfld_tphysac(cam_snapshot_before_num, state, tend, cam_in, cam_out, pbuf,&
1826 0 : fh2o, surfric, obklen, flx_heat)
1827 : end if
1828 :
1829 72960 : if ( do_waccm_ions ) then
1830 72960 : call iondrag_calc( lchnk, ncol, state, ptend, pbuf, ztodt )
1831 : else
1832 0 : call iondrag_calc( lchnk, ncol, state, ptend)
1833 : endif
1834 : !----------------------------------------------------------------------------
1835 : ! Call ionosphere routines for extended model if mode is set to ionosphere
1836 : !----------------------------------------------------------------------------
1837 72960 : if( waccmx_is('ionosphere') ) then
1838 0 : call waccmx_phys_ion_elec_temp_tend(state, ptend, pbuf, ztodt)
1839 : endif
1840 :
1841 72960 : if ( (trim(cam_take_snapshot_after) == "iondrag_calc_section") .and. &
1842 : (trim(cam_take_snapshot_before) == trim(cam_take_snapshot_after))) then
1843 0 : call cam_snapshot_ptend_outfld(ptend, lchnk)
1844 : end if
1845 72960 : if ( ptend%lu ) then
1846 72960 : call outfld( 'UTEND_IONDRG', ptend%u, pcols, lchnk)
1847 : end if
1848 72960 : if ( ptend%lv ) then
1849 72960 : call outfld( 'VTEND_IONDRG', ptend%v, pcols, lchnk)
1850 : end if
1851 72960 : call physics_update(state, ptend, ztodt, tend)
1852 :
1853 72960 : if (trim(cam_take_snapshot_after) == "iondrag_calc_section") then
1854 : call cam_snapshot_all_outfld_tphysac(cam_snapshot_after_num, state, tend, cam_in, cam_out, pbuf,&
1855 0 : fh2o, surfric, obklen, flx_heat)
1856 : end if
1857 :
1858 72960 : call tot_energy_phys(state, 'phAP')
1859 72960 : call tot_energy_phys(state, 'dyAP',vc=vc_dycore)
1860 :
1861 : !---------------------------------------------------------------------------------
1862 : ! Enforce charge neutrality after O+ change from ionos_tend
1863 : !---------------------------------------------------------------------------------
1864 72960 : if( waccmx_is('ionosphere') ) then
1865 0 : call charge_balance(state, pbuf)
1866 : endif
1867 :
1868 : ! Check energy integrals
1869 72960 : call check_energy_cam_chng(state, tend, "iondrag", nstep, ztodt, zero, zero, zero, zero)
1870 :
1871 72960 : call t_stopf ( 'iondrag' )
1872 :
1873 : ! Update Nudging values, if needed
1874 : !----------------------------------
1875 72960 : if((Nudge_Model).and.(Nudge_ON)) then
1876 0 : call nudging_timestep_tend(state,ptend)
1877 0 : if ( ptend%lu ) then
1878 0 : call outfld( 'UTEND_NDG', ptend%u, pcols, lchnk)
1879 : end if
1880 0 : if ( ptend%lv ) then
1881 0 : call outfld( 'VTEND_NDG', ptend%v, pcols, lchnk)
1882 : end if
1883 0 : call physics_update(state,ptend,ztodt,tend)
1884 0 : call check_energy_cam_chng(state, tend, "nudging", nstep, ztodt, zero, zero, zero, zero)
1885 : endif
1886 :
1887 : !-------------- Energy budget checks vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv
1888 :
1889 : ! Save total energy for global fixer in next timestep
1890 : !
1891 : ! This call must be after the last parameterization and call to physics_update
1892 : !
1893 218880 : call pbuf_set_field(pbuf, teout_idx, state%te_cur(:,dyn_te_idx), (/1,itim_old/),(/pcols,1/))
1894 :
1895 72960 : if (shallow_scheme .eq. 'UNICON') then
1896 :
1897 : ! ------------------------------------------------------------------------
1898 : ! Insert the organization-related heterogeneities computed inside the
1899 : ! UNICON into the tracer arrays here before performing advection.
1900 : ! This is necessary to prevent any modifications of organization-related
1901 : ! heterogeneities by non convection-advection process, such as
1902 : ! dry and wet deposition of aerosols, MAM, etc.
1903 : ! Again, note that only UNICON and advection schemes are allowed to
1904 : ! changes to organization at this stage, although we can include the
1905 : ! effects of other physical processes in future.
1906 : ! ------------------------------------------------------------------------
1907 :
1908 0 : call unicon_cam_org_diags(state, pbuf)
1909 :
1910 : end if
1911 : !
1912 : ! FV: convert dry-type mixing ratios to moist here because physics_dme_adjust
1913 : ! assumes moist. This is done in p_d_coupling for other dynamics. Bundy, Feb 2004.
1914 72960 : moist_mixing_ratio_dycore = dycore_is('LR').or. dycore_is('FV3')
1915 : !
1916 : ! update cp/cv for energy computation based in updated water variables
1917 : !
1918 0 : call cam_thermo_water_update(state%q(:ncol,:,:), lchnk, ncol, vc_dycore,&
1919 78723840 : to_dry_factor=state%pdel(:ncol,:)/state%pdeldry(:ncol,:))
1920 :
1921 : ! for dry mixing ratio dycore, physics_dme_adjust is called for energy diagnostic purposes only.
1922 : ! So, save off tracers
1923 72960 : if (.not.moist_mixing_ratio_dycore) then
1924 : !
1925 : ! for dry-mixing ratio based dycores dme_adjust takes place in the dynamical core
1926 : !
1927 : ! only compute dme_adjust for diagnostics purposes
1928 : !
1929 0 : if (thermo_budget_history) then
1930 0 : tmp_trac(:ncol,:pver,:pcnst) = state%q(:ncol,:pver,:pcnst)
1931 0 : tmp_pdel(:ncol,:pver) = state%pdel(:ncol,:pver)
1932 0 : tmp_ps(:ncol) = state%ps(:ncol)
1933 0 : call physics_dme_adjust(state, tend, qini, totliqini, toticeini, ztodt)
1934 0 : call tot_energy_phys(state, 'phAM')
1935 0 : call tot_energy_phys(state, 'dyAM', vc=vc_dycore)
1936 : ! Restore pre-"physics_dme_adjust" tracers
1937 0 : state%q(:ncol,:pver,:pcnst) = tmp_trac(:ncol,:pver,:pcnst)
1938 0 : state%pdel(:ncol,:pver) = tmp_pdel(:ncol,:pver)
1939 0 : state%ps(:ncol) = tmp_ps(:ncol)
1940 : end if
1941 : else
1942 : !
1943 : ! for moist-mixing ratio based dycores
1944 : !
1945 : ! Note: this operation will NOT be reverted with set_wet_to_dry after set_dry_to_wet call
1946 : !
1947 72960 : call set_dry_to_wet(state, convert_cnst_type='dry')
1948 :
1949 72960 : if (trim(cam_take_snapshot_before) == "physics_dme_adjust") then
1950 : call cam_snapshot_all_outfld_tphysac(cam_snapshot_after_num, state, tend, cam_in, cam_out, pbuf,&
1951 0 : fh2o, surfric, obklen, flx_heat)
1952 : end if
1953 72960 : call physics_dme_adjust(state, tend, qini, totliqini, toticeini, ztodt)
1954 72960 : if (trim(cam_take_snapshot_after) == "physics_dme_adjust") then
1955 : call cam_snapshot_all_outfld_tphysac(cam_snapshot_after_num, state, tend, cam_in, cam_out, pbuf,&
1956 0 : fh2o, surfric, obklen, flx_heat)
1957 : end if
1958 :
1959 72960 : call tot_energy_phys(state, 'phAM')
1960 72960 : call tot_energy_phys(state, 'dyAM', vc=vc_dycore)
1961 : endif
1962 :
1963 72960 : if (vc_dycore == vc_height.or.vc_dycore == vc_dry_pressure) then
1964 : !
1965 : ! MPAS and SE specific scaling of temperature for enforcing energy consistency
1966 : ! (and to make sure that temperature dependent diagnostic tendencies
1967 : ! are computed correctly; e.g. dtcore)
1968 : !
1969 0 : scaling(1:ncol,:) = cpairv(:ncol,:,lchnk)/cp_or_cv_dycore(:ncol,:,lchnk)
1970 0 : state%T(1:ncol,:) = state%temp_ini(1:ncol,:)+&
1971 0 : scaling(1:ncol,:)*(state%T(1:ncol,:)-state%temp_ini(1:ncol,:))
1972 0 : tend%dtdt(:ncol,:) = scaling(:ncol,:)*tend%dtdt(:ncol,:)
1973 : !
1974 : ! else: do nothing for dycores with energy consistent with CAM physics
1975 : !
1976 : end if
1977 :
1978 :
1979 : ! store T, U, and V in buffer for use in computing dynamics T-tendency in next timestep
1980 5180160 : do k = 1,pver
1981 78650880 : dtcore(:ncol,k) = state%t(:ncol,k)
1982 78650880 : dqcore(:ncol,k) = state%q(:ncol,k,ixq)
1983 78650880 : ducore(:ncol,k) = state%u(:ncol,k)
1984 78723840 : dvcore(:ncol,k) = state%v(:ncol,k)
1985 : end do
1986 :
1987 : !-------------- Energy budget checks ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
1988 :
1989 72960 : if (aqua_planet) then
1990 0 : labort = .false.
1991 0 : do i=1,ncol
1992 0 : if (cam_in%ocnfrac(i) /= 1._r8) then
1993 0 : labort = .true.
1994 0 : if (masterproc) write(iulog,*) 'oceanfrac(',i,')=',cam_in%ocnfrac(i)
1995 : end if
1996 : end do
1997 0 : if (labort) then
1998 0 : call endrun ('TPHYSAC error: in aquaplanet mode, but grid contains non-ocean point')
1999 : endif
2000 : endif
2001 :
2002 72960 : call diag_phys_tend_writeout (state, pbuf, tend, ztodt, qini, cldliqini, cldiceini)
2003 :
2004 72960 : call clybry_fam_set( ncol, lchnk, map2chm, state%q, pbuf )
2005 :
2006 : ! clean CARMA diagnostics object
2007 72960 : if (associated(carma_diags_obj)) then
2008 72960 : deallocate(carma_diags_obj)
2009 72960 : nullify(carma_diags_obj)
2010 : end if
2011 :
2012 : ! output these here -- after updates by chem_timestep_tend or export_fields within the current time step
2013 72960 : if (associated(cam_out%nhx_nitrogen_flx)) then
2014 72960 : call outfld('a2x_NHXDEP', cam_out%nhx_nitrogen_flx, pcols, lchnk)
2015 : end if
2016 72960 : if (associated(cam_out%noy_nitrogen_flx)) then
2017 72960 : call outfld('a2x_NOYDEP', cam_out%noy_nitrogen_flx, pcols, lchnk)
2018 : end if
2019 :
2020 218880 : end subroutine tphysac
2021 :
2022 80640 : subroutine tphysbc (ztodt, state, &
2023 : tend, pbuf, &
2024 : cam_out, cam_in )
2025 : !-----------------------------------------------------------------------
2026 : !
2027 : ! Purpose:
2028 : ! Evaluate and apply physical processes that are calculated BEFORE
2029 : ! coupling to land, sea, and ice models.
2030 : !
2031 : ! Processes currently included are:
2032 : !
2033 : ! o Resetting Negative Tracers to Positive
2034 : ! o Global Mean Total Energy Fixer
2035 : ! o Dry Adjustment
2036 : ! o Asymmetric Turbulence Scheme : Deep Convection & Shallow Convection
2037 : ! o Stratiform Macro-Microphysics
2038 : ! o Wet Scavenging of Aerosol
2039 : ! o Radiation
2040 : !
2041 : ! Method:
2042 : !
2043 : ! Each parameterization should be implemented with this sequence of calls:
2044 : ! 1) Call physics interface
2045 : ! 2) Check energy
2046 : ! 3) Call physics_update
2047 : ! See Interface to Column Physics and Chemistry Packages
2048 : ! http://www.ccsm.ucar.edu/models/atm-cam/docs/phys-interface/index.html
2049 : !
2050 : !-----------------------------------------------------------------------
2051 :
2052 : use physics_buffer, only: physics_buffer_desc, pbuf_get_field
2053 72960 : use physics_buffer, only: pbuf_get_index, pbuf_old_tim_idx
2054 : use physics_buffer, only: col_type_subcol, dyn_time_lvls
2055 : use shr_kind_mod, only: r8 => shr_kind_r8
2056 :
2057 : use dadadj_cam, only: dadadj_tend
2058 : use rk_stratiform, only: rk_stratiform_tend
2059 : use microp_driver, only: microp_driver_tend
2060 : use microp_aero, only: microp_aero_run
2061 : use macrop_driver, only: macrop_driver_tend
2062 : use physics_types, only: physics_state, physics_tend, physics_ptend, &
2063 : physics_update, physics_ptend_init, physics_ptend_sum, &
2064 : physics_state_check, physics_ptend_scale, &
2065 : dyn_te_idx
2066 : use cam_diagnostics, only: diag_conv_tend_ini, diag_phys_writeout, diag_conv, diag_export, diag_state_b4_phys_write
2067 : use cam_diagnostics, only: diag_clip_tend_writeout
2068 : use cam_history, only: outfld
2069 : use physconst, only: latvap
2070 : use constituents, only: pcnst, qmin, cnst_get_ind
2071 : use air_composition, only: thermodynamic_active_species_liq_num,thermodynamic_active_species_liq_idx
2072 : use air_composition, only: thermodynamic_active_species_ice_num,thermodynamic_active_species_ice_idx
2073 : use convect_deep, only: convect_deep_tend, convect_deep_tend_2, deep_scheme_does_scav_trans
2074 : use time_manager, only: is_first_step, get_nstep
2075 : use convect_shallow, only: convect_shallow_tend
2076 : use check_energy, only: check_energy_timestep_init, check_energy_cam_chng
2077 : use check_energy, only: check_energy_cam_fix
2078 : use check_energy, only: check_tracers_data, check_tracers_init, check_tracers_chng
2079 : use check_energy, only: tot_energy_phys
2080 : use dycore, only: dycore_is
2081 : use aero_model, only: aero_model_wetdep
2082 : use aero_wetdep_cam, only: wetdep_lq
2083 : use carma_intr, only: carma_wetdep_tend, carma_timestep_tend
2084 : use carma_flags_mod, only: carma_do_detrain, carma_do_cldice, carma_do_cldliq, carma_do_wetdep
2085 : use radiation, only: radiation_tend
2086 : use cloud_diagnostics, only: cloud_diagnostics_calc
2087 : use perf_mod
2088 : use mo_gas_phase_chemdr,only: map2chm
2089 : use clybry_fam, only: clybry_fam_adj
2090 : use clubb_intr, only: clubb_tend_cam
2091 : use sslt_rebin, only: sslt_rebin_adv
2092 : use tropopause, only: tropopause_output
2093 : use cam_abortutils, only: endrun
2094 : use subcol, only: subcol_gen, subcol_ptend_avg
2095 : use subcol_utils, only: subcol_ptend_copy, is_subcol_on
2096 : use qneg_module, only: qneg3
2097 : use subcol_SILHS, only: subcol_SILHS_var_covar_driver, init_state_subcol
2098 : use subcol_SILHS, only: subcol_SILHS_fill_holes_conserv
2099 : use subcol_SILHS, only: subcol_SILHS_hydromet_conc_tend_lim
2100 : use micro_pumas_cam, only: massless_droplet_destroyer
2101 : use cam_snapshot, only: cam_snapshot_all_outfld_tphysbc
2102 : use cam_snapshot_common, only: cam_snapshot_ptend_outfld
2103 : use ssatcontrail, only: ssatcontrail_d0
2104 : use dyn_tests_utils, only: vc_dycore
2105 : use surface_emissions_mod,only: surface_emissions_set
2106 : use elevated_emissions_mod,only: elevated_emissions_set
2107 :
2108 : ! Arguments
2109 :
2110 : real(r8), intent(in) :: ztodt ! 2 delta t (model time increment)
2111 :
2112 : type(physics_state), intent(inout) :: state
2113 : type(physics_tend ), intent(inout) :: tend
2114 : type(physics_buffer_desc), pointer :: pbuf(:)
2115 :
2116 : type(cam_out_t), intent(inout) :: cam_out
2117 : type(cam_in_t), intent(in) :: cam_in
2118 :
2119 :
2120 : !
2121 : !---------------------------Local workspace-----------------------------
2122 : !
2123 :
2124 16369920 : type(physics_ptend) :: ptend ! indivdual parameterization tendencies
2125 16369920 : type(physics_ptend) :: ptend_macp_all ! sum of macrophysics tendencies (e.g. CLUBB) over substeps
2126 80640 : type(physics_state) :: state_sc ! state for sub-columns
2127 16369920 : type(physics_ptend) :: ptend_sc ! ptend for sub-columns
2128 16369920 : type(physics_ptend) :: ptend_aero ! ptend for microp_aero
2129 16369920 : type(physics_ptend) :: ptend_aero_sc ! ptend for microp_aero on sub-columns
2130 80640 : type(physics_tend) :: tend_sc ! tend for sub-columns
2131 :
2132 : integer :: nstep ! current timestep number
2133 :
2134 : real(r8) :: net_flx(pcols)
2135 :
2136 : real(r8) :: zdu(pcols,pver) ! detraining mass flux from deep convection
2137 : real(r8) :: cmfmc(pcols,pverp) ! Convective mass flux--m sub c
2138 :
2139 : real(r8) cmfcme(pcols,pver) ! cmf condensation - evaporation
2140 :
2141 : real(r8) dlf(pcols,pver) ! Detraining cld H20 from shallow + deep convections
2142 : real(r8) dlf2(pcols,pver) ! Detraining cld H20 from shallow convections
2143 : real(r8) rtdt ! 1./ztodt
2144 :
2145 : integer lchnk ! chunk identifier
2146 : integer ncol ! number of atmospheric columns
2147 :
2148 : integer :: i ! column indicex
2149 : integer :: ixcldice, ixcldliq, ixq ! constituent indices for cloud liquid and ice water.
2150 : integer :: m, m_cnst
2151 : ! for macro/micro co-substepping
2152 : integer :: macmic_it ! iteration variables
2153 : real(r8) :: cld_macmic_ztodt ! modified timestep
2154 : ! physics buffer fields to compute tendencies for stratiform package
2155 : integer itim_old, ifld
2156 80640 : real(r8), pointer, dimension(:,:) :: cld ! cloud fraction
2157 :
2158 :
2159 : ! physics buffer fields for total energy and mass adjustment
2160 80640 : real(r8), pointer, dimension(: ) :: teout
2161 80640 : real(r8), pointer, dimension(:,:) :: qini
2162 80640 : real(r8), pointer, dimension(:,:) :: cldliqini
2163 80640 : real(r8), pointer, dimension(:,:) :: cldiceini
2164 80640 : real(r8), pointer, dimension(:,:) :: totliqini
2165 80640 : real(r8), pointer, dimension(:,:) :: toticeini
2166 80640 : real(r8), pointer, dimension(:,:) :: dtcore
2167 80640 : real(r8), pointer, dimension(:,:) :: dqcore
2168 80640 : real(r8), pointer, dimension(:,:) :: ducore
2169 80640 : real(r8), pointer, dimension(:,:) :: dvcore
2170 :
2171 80640 : real(r8), pointer, dimension(:,:,:) :: fracis ! fraction of transported species that are insoluble
2172 :
2173 80640 : real(r8), pointer :: dlfzm(:,:) ! ZM detrained convective cloud water mixing ratio.
2174 :
2175 : ! convective precipitation variables
2176 80640 : real(r8),pointer :: prec_dp(:) ! total precipitation from ZM convection
2177 80640 : real(r8),pointer :: snow_dp(:) ! snow from ZM convection
2178 80640 : real(r8),pointer :: prec_sh(:) ! total precipitation from Hack convection
2179 80640 : real(r8),pointer :: snow_sh(:) ! snow from Hack convection
2180 :
2181 : ! carma precipitation variables
2182 : real(r8) :: prec_sed_carma(pcols) ! total precip from cloud sedimentation (CARMA)
2183 : real(r8) :: snow_sed_carma(pcols) ! snow from cloud ice sedimentation (CARMA)
2184 :
2185 : ! stratiform precipitation variables
2186 80640 : real(r8),pointer :: prec_str(:) ! sfc flux of precip from stratiform (m/s)
2187 80640 : real(r8),pointer :: snow_str(:) ! sfc flux of snow from stratiform (m/s)
2188 80640 : real(r8),pointer :: prec_str_sc(:) ! sfc flux of precip from stratiform (m/s) -- for subcolumns
2189 80640 : real(r8),pointer :: snow_str_sc(:) ! sfc flux of snow from stratiform (m/s) -- for subcolumns
2190 80640 : real(r8),pointer :: prec_pcw(:) ! total precip from prognostic cloud scheme
2191 80640 : real(r8),pointer :: snow_pcw(:) ! snow from prognostic cloud scheme
2192 80640 : real(r8),pointer :: prec_sed(:) ! total precip from cloud sedimentation
2193 80640 : real(r8),pointer :: snow_sed(:) ! snow from cloud ice sedimentation
2194 :
2195 : ! Local copies for substepping
2196 : real(r8) :: prec_pcw_macmic(pcols)
2197 : real(r8) :: snow_pcw_macmic(pcols)
2198 : real(r8) :: prec_sed_macmic(pcols)
2199 : real(r8) :: snow_sed_macmic(pcols)
2200 :
2201 : ! energy checking variables
2202 : real(r8) :: zero(pcols) ! array of zeros
2203 : real(r8) :: zero_sc(pcols*psubcols) ! array of zeros
2204 : real(r8) :: rliq(pcols) ! vertical integral of liquid not yet in q(ixcldliq)
2205 : real(r8) :: rice(pcols) ! vertical integral of ice not yet in q(ixcldice)
2206 : real(r8) :: rliq2(pcols) ! vertical integral of liquid from shallow scheme
2207 : real(r8) :: det_s (pcols) ! vertical integral of detrained static energy from ice
2208 : real(r8) :: det_ice(pcols) ! vertical integral of detrained ice
2209 : real(r8) :: flx_cnd(pcols)
2210 : real(r8) :: flx_heat(pcols)
2211 : type(check_tracers_data):: tracerint ! energy integrals and cummulative boundary fluxes
2212 : real(r8) :: zero_tracers(pcols,pcnst)
2213 :
2214 : ! For aerosol budget diagnostics
2215 : character(len=16) :: pname !! package name
2216 : type(carma_diags_t), pointer :: carma_diags_obj
2217 :
2218 : !-----------------------------------------------------------------------
2219 80640 : carma_diags_obj => carma_diags_t()
2220 80640 : if (.not.associated(carma_diags_obj)) then
2221 0 : call endrun('tphysbc: carma_diags_obj allocation failed')
2222 : end if
2223 :
2224 80640 : call t_startf('bc_init')
2225 :
2226 80640 : zero = 0._r8
2227 80640 : zero_tracers(:,:) = 0._r8
2228 80640 : zero_sc(:) = 0._r8
2229 :
2230 80640 : lchnk = state%lchnk
2231 80640 : ncol = state%ncol
2232 :
2233 80640 : rtdt = 1._r8/ztodt
2234 :
2235 80640 : nstep = get_nstep()
2236 :
2237 : ! Associate pointers with physics buffer fields
2238 80640 : itim_old = pbuf_old_tim_idx()
2239 80640 : ifld = pbuf_get_index('CLD')
2240 322560 : call pbuf_get_field(pbuf, ifld, cld, (/1,1,itim_old/),(/pcols,pver,1/))
2241 :
2242 241920 : call pbuf_get_field(pbuf, teout_idx, teout, (/1,itim_old/), (/pcols,1/))
2243 :
2244 80640 : call pbuf_get_field(pbuf, qini_idx, qini)
2245 80640 : call pbuf_get_field(pbuf, cldliqini_idx, cldliqini)
2246 80640 : call pbuf_get_field(pbuf, cldiceini_idx, cldiceini)
2247 80640 : call pbuf_get_field(pbuf, totliqini_idx, totliqini)
2248 80640 : call pbuf_get_field(pbuf, toticeini_idx, toticeini)
2249 :
2250 322560 : call pbuf_get_field(pbuf, dtcore_idx, dtcore, start=(/1,1,itim_old/), kount=(/pcols,pver,1/) )
2251 322560 : call pbuf_get_field(pbuf, dqcore_idx, dqcore, start=(/1,1,itim_old/), kount=(/pcols,pver,1/) )
2252 322560 : call pbuf_get_field(pbuf, ducore_idx, ducore, start=(/1,1,itim_old/), kount=(/pcols,pver,1/) )
2253 322560 : call pbuf_get_field(pbuf, dvcore_idx, dvcore, start=(/1,1,itim_old/), kount=(/pcols,pver,1/) )
2254 :
2255 80640 : ifld = pbuf_get_index('FRACIS')
2256 80640 : call pbuf_get_field(pbuf, ifld, fracis, start=(/1,1,1/), kount=(/pcols, pver, pcnst/) )
2257 17576213760 : fracis (:ncol,:,1:pcnst) = 1._r8
2258 :
2259 : ! Set physics tendencies to 0
2260 87010560 : tend %dTdt(:ncol,:pver) = 0._r8
2261 87010560 : tend %dudt(:ncol,:pver) = 0._r8
2262 87010560 : tend %dvdt(:ncol,:pver) = 0._r8
2263 :
2264 : ! Verify state coming from the dynamics
2265 80640 : if (state_debug_checks) &
2266 80640 : call physics_state_check(state, name="before tphysbc (dycore?)")
2267 :
2268 80640 : call clybry_fam_adj( ncol, lchnk, map2chm, state%q, pbuf )
2269 :
2270 : ! Since clybry_fam_adj operates directly on the tracers, and has no
2271 : ! physics_update call, re-run qneg3.
2272 : call qneg3('TPHYSBCc',lchnk ,ncol ,pcols ,pver , &
2273 80640 : 1, pcnst, qmin ,state%q )
2274 :
2275 : ! Validate output of clybry_fam_adj.
2276 80640 : if (state_debug_checks) &
2277 80640 : call physics_state_check(state, name="clybry_fam_adj")
2278 :
2279 : !
2280 : ! Dump out "before physics" state
2281 : !
2282 80640 : call diag_state_b4_phys_write (state)
2283 :
2284 : ! compute mass integrals of input tracers state
2285 80640 : call check_tracers_init(state, tracerint)
2286 :
2287 80640 : call t_stopf('bc_init')
2288 :
2289 : !===================================================
2290 : ! Global mean total energy fixer
2291 : !===================================================
2292 80640 : call t_startf('energy_fixer')
2293 :
2294 80640 : call tot_energy_phys(state, 'phBF')
2295 80640 : call tot_energy_phys(state, 'dyBF',vc=vc_dycore)
2296 :
2297 80640 : call check_energy_cam_fix(state, ptend, nstep, flx_heat)
2298 80640 : call physics_update(state, ptend, ztodt, tend)
2299 80640 : call check_energy_cam_chng(state, tend, "chkengyfix", nstep, ztodt, zero, zero, zero, flx_heat)
2300 80640 : call outfld( 'EFIX', flx_heat , pcols, lchnk )
2301 :
2302 80640 : call tot_energy_phys(state, 'phBP')
2303 80640 : call tot_energy_phys(state, 'dyBP',vc=vc_dycore)
2304 : ! Save state for convective tendency calculations.
2305 80640 : call diag_conv_tend_ini(state, pbuf)
2306 :
2307 80640 : call cnst_get_ind('Q', ixq)
2308 80640 : call cnst_get_ind('CLDLIQ', ixcldliq)
2309 80640 : call cnst_get_ind('CLDICE', ixcldice)
2310 87010560 : qini (:ncol,:pver) = state%q(:ncol,:pver, 1)
2311 87010560 : cldliqini(:ncol,:pver) = state%q(:ncol,:pver,ixcldliq)
2312 87010560 : cldiceini(:ncol,:pver) = state%q(:ncol,:pver,ixcldice)
2313 :
2314 87010560 : totliqini(:ncol,:pver) = 0.0_r8
2315 241920 : do m_cnst=1,thermodynamic_active_species_liq_num
2316 161280 : m = thermodynamic_active_species_liq_idx(m_cnst)
2317 174101760 : totliqini(:ncol,:pver) = totliqini(:ncol,:pver)+state%q(:ncol,:pver,m)
2318 : end do
2319 87010560 : toticeini(:ncol,:pver) = 0.0_r8
2320 241920 : do m_cnst=1,thermodynamic_active_species_ice_num
2321 161280 : m = thermodynamic_active_species_ice_idx(m_cnst)
2322 174101760 : toticeini(:ncol,:pver) = toticeini(:ncol,:pver)+state%q(:ncol,:pver,m)
2323 : end do
2324 :
2325 :
2326 80640 : call outfld('TEOUT', teout , pcols, lchnk )
2327 80640 : call outfld('TEINP', state%te_ini(:,dyn_te_idx), pcols, lchnk )
2328 80640 : call outfld('TEFIX', state%te_cur(:,dyn_te_idx), pcols, lchnk )
2329 :
2330 : ! T, U, V tendency due to dynamics
2331 80640 : if( nstep > dyn_time_lvls-1 ) then
2332 82867200 : dtcore(:ncol,:pver) = (state%t(:ncol,:pver) - dtcore(:ncol,:pver))/ztodt
2333 82867200 : dqcore(:ncol,:pver) = (state%q(:ncol,:pver,ixq) - dqcore(:ncol,:pver))/ztodt
2334 82867200 : ducore(:ncol,:pver) = (state%u(:ncol,:pver) - ducore(:ncol,:pver))/ztodt
2335 82867200 : dvcore(:ncol,:pver) = (state%v(:ncol,:pver) - dvcore(:ncol,:pver))/ztodt
2336 76800 : call outfld( 'DTCORE', dtcore, pcols, lchnk )
2337 76800 : call outfld( 'DQCORE', dqcore, pcols, lchnk )
2338 76800 : call outfld( 'UTEND_CORE', ducore, pcols, lchnk )
2339 76800 : call outfld( 'VTEND_CORE', dvcore, pcols, lchnk )
2340 : end if
2341 :
2342 80640 : call t_stopf('energy_fixer')
2343 :
2344 80640 : call surface_emissions_set( lchnk, ncol, pbuf )
2345 80640 : call elevated_emissions_set( lchnk, ncol, pbuf )
2346 :
2347 : !
2348 : !===================================================
2349 : ! Dry adjustment
2350 : !===================================================
2351 80640 : call t_startf('dry_adjustment')
2352 :
2353 80640 : if (trim(cam_take_snapshot_before) == "dadadj_tend") then
2354 : call cam_snapshot_all_outfld_tphysbc(cam_snapshot_before_num, state, tend, cam_in, cam_out, pbuf, &
2355 0 : flx_heat, cmfmc, cmfcme, zdu, rliq, rice, dlf, dlf2, rliq2, det_s, det_ice, net_flx)
2356 : end if
2357 :
2358 80640 : call dadadj_tend(ztodt, state, ptend)
2359 :
2360 80640 : if ( (trim(cam_take_snapshot_after) == "dadadj_tend") .and. &
2361 : (trim(cam_take_snapshot_before) == trim(cam_take_snapshot_after))) then
2362 0 : call cam_snapshot_ptend_outfld(ptend, lchnk)
2363 : end if
2364 80640 : call physics_update(state, ptend, ztodt, tend)
2365 :
2366 80640 : if (trim(cam_take_snapshot_after) == "dadadj_tend") then
2367 : call cam_snapshot_all_outfld_tphysbc(cam_snapshot_after_num, state, tend, cam_in, cam_out, pbuf, &
2368 0 : flx_heat, cmfmc, cmfcme, zdu, rliq, rice, dlf, dlf2, rliq2, det_s, det_ice, net_flx)
2369 : end if
2370 :
2371 80640 : call t_stopf('dry_adjustment')
2372 :
2373 : !===================================================
2374 : ! Moist convection
2375 : !===================================================
2376 80640 : call t_startf('moist_convection')
2377 :
2378 80640 : call t_startf ('convect_deep_tend')
2379 :
2380 80640 : if (trim(cam_take_snapshot_before) == "convect_deep_tend") then
2381 : call cam_snapshot_all_outfld_tphysbc(cam_snapshot_before_num, state, tend, cam_in, cam_out, pbuf, &
2382 0 : flx_heat, cmfmc, cmfcme, zdu, rliq, rice, dlf, dlf2, rliq2, det_s, det_ice, net_flx)
2383 : end if
2384 :
2385 : call convect_deep_tend( &
2386 : cmfmc, cmfcme, &
2387 : zdu, &
2388 : rliq, rice, &
2389 : ztodt, &
2390 80640 : state, ptend, cam_in%landfrac, pbuf)
2391 :
2392 80640 : if ( (trim(cam_take_snapshot_after) == "convect_deep_tend") .and. &
2393 : (trim(cam_take_snapshot_before) == trim(cam_take_snapshot_after))) then
2394 0 : call cam_snapshot_ptend_outfld(ptend, lchnk)
2395 : end if
2396 :
2397 80640 : if ( ptend%lu ) then
2398 80640 : call outfld( 'UTEND_DCONV', ptend%u, pcols, lchnk)
2399 : end if
2400 80640 : if ( ptend%lv ) then
2401 80640 : call outfld( 'VTEND_DCONV', ptend%v, pcols, lchnk)
2402 : end if
2403 80640 : call physics_update(state, ptend, ztodt, tend)
2404 :
2405 80640 : if (trim(cam_take_snapshot_after) == "convect_deep_tend") then
2406 : call cam_snapshot_all_outfld_tphysbc(cam_snapshot_after_num, state, tend, cam_in, cam_out, pbuf, &
2407 0 : flx_heat, cmfmc, cmfcme, zdu, rliq, rice, dlf, dlf2, rliq2, det_s, det_ice, net_flx)
2408 : end if
2409 :
2410 80640 : call t_stopf('convect_deep_tend')
2411 :
2412 80640 : call pbuf_get_field(pbuf, prec_dp_idx, prec_dp )
2413 80640 : call pbuf_get_field(pbuf, snow_dp_idx, snow_dp )
2414 80640 : call pbuf_get_field(pbuf, prec_sh_idx, prec_sh )
2415 80640 : call pbuf_get_field(pbuf, snow_sh_idx, snow_sh )
2416 80640 : call pbuf_get_field(pbuf, prec_str_idx, prec_str )
2417 80640 : call pbuf_get_field(pbuf, snow_str_idx, snow_str )
2418 80640 : call pbuf_get_field(pbuf, prec_sed_idx, prec_sed )
2419 80640 : call pbuf_get_field(pbuf, snow_sed_idx, snow_sed )
2420 80640 : call pbuf_get_field(pbuf, prec_pcw_idx, prec_pcw )
2421 80640 : call pbuf_get_field(pbuf, snow_pcw_idx, snow_pcw )
2422 :
2423 80640 : if (use_subcol_microp) then
2424 0 : call pbuf_get_field(pbuf, prec_str_idx, prec_str_sc, col_type=col_type_subcol)
2425 0 : call pbuf_get_field(pbuf, snow_str_idx, snow_str_sc, col_type=col_type_subcol)
2426 : end if
2427 :
2428 : ! Check energy integrals, including "reserved liquid"
2429 1241856 : flx_cnd(:ncol) = prec_dp(:ncol) + rliq(:ncol)
2430 1241856 : snow_dp(:ncol) = snow_dp(:ncol) + rice(:ncol)
2431 80640 : call check_energy_cam_chng(state, tend, "convect_deep", nstep, ztodt, zero, flx_cnd, snow_dp, zero)
2432 1241856 : snow_dp(:ncol) = snow_dp(:ncol) - rice(:ncol)
2433 :
2434 : !
2435 : ! Call Hack (1994) convection scheme to deal with shallow/mid-level convection
2436 : !
2437 80640 : call t_startf ('convect_shallow_tend')
2438 :
2439 80640 : if (dlfzm_idx > 0) then
2440 80640 : call pbuf_get_field(pbuf, dlfzm_idx, dlfzm)
2441 87010560 : dlf(:ncol,:) = dlfzm(:ncol,:)
2442 : else
2443 0 : dlf(:,:) = 0._r8
2444 : end if
2445 :
2446 : ! Zero-initialize subroutine-level variables for snapshot
2447 80640 : dlf2(:,:) = 0._r8
2448 80640 : rliq2(:) = 0._r8
2449 :
2450 80640 : if (trim(cam_take_snapshot_before) == "convect_shallow_tend") then
2451 : call cam_snapshot_all_outfld_tphysbc(cam_snapshot_before_num, state, tend, cam_in, cam_out, pbuf, &
2452 0 : flx_heat, cmfmc, cmfcme, zdu, rliq, rice, dlf, dlf2, rliq2, det_s, det_ice, net_flx)
2453 : end if
2454 :
2455 : call convect_shallow_tend (ztodt , cmfmc, &
2456 : dlf , dlf2 , rliq , rliq2, &
2457 80640 : state , ptend , pbuf, cam_in)
2458 80640 : call t_stopf ('convect_shallow_tend')
2459 :
2460 80640 : call physics_update(state, ptend, ztodt, tend)
2461 :
2462 80640 : if ( (trim(cam_take_snapshot_after) == "convect_shallow_tend") .and. &
2463 : (trim(cam_take_snapshot_before) == trim(cam_take_snapshot_after))) then
2464 0 : call cam_snapshot_ptend_outfld(ptend, lchnk)
2465 : end if
2466 80640 : if ( ptend%lu ) then
2467 0 : call outfld( 'UTEND_SHCONV', ptend%u, pcols, lchnk)
2468 : end if
2469 80640 : if ( ptend%lv ) then
2470 0 : call outfld( 'VTEND_SHCONV', ptend%v, pcols, lchnk)
2471 : end if
2472 80640 : call physics_update(state, ptend, ztodt, tend)
2473 :
2474 80640 : if (trim(cam_take_snapshot_after) == "convect_shallow_tend") then
2475 : call cam_snapshot_all_outfld_tphysbc(cam_snapshot_after_num, state, tend, cam_in, cam_out, pbuf, &
2476 0 : flx_heat, cmfmc, cmfcme, zdu, rliq, rice, dlf, dlf2, rliq2, det_s, det_ice, net_flx)
2477 : end if
2478 :
2479 1241856 : flx_cnd(:ncol) = prec_sh(:ncol) + rliq2(:ncol)
2480 80640 : call check_energy_cam_chng(state, tend, "convect_shallow", nstep, ztodt, zero, flx_cnd, snow_sh, zero)
2481 :
2482 80640 : call check_tracers_chng(state, tracerint, "convect_shallow", nstep, ztodt, zero_tracers)
2483 :
2484 80640 : call t_stopf('moist_convection')
2485 :
2486 : ! Rebin the 4-bin version of sea salt into bins for coarse and accumulation
2487 : ! modes that correspond to the available optics data. This is only necessary
2488 : ! for CAM-RT. But it's done here so that the microphysics code which is called
2489 : ! from the stratiform interface has access to the same aerosols as the radiation
2490 : ! code.
2491 80640 : call sslt_rebin_adv(pbuf, state)
2492 :
2493 : !===================================================
2494 : ! Calculate tendencies from CARMA bin microphysics.
2495 : !===================================================
2496 : !
2497 : ! If CARMA is doing detrainment, then on output, rliq no longer represents water reserved
2498 : ! for detrainment, but instead represents potential snow fall. The mass and number of the
2499 : ! snow are stored in the physics buffer and will be incorporated by the MG microphysics.
2500 : !
2501 : ! Currently CARMA cloud microphysics is only supported with the MG microphysics.
2502 80640 : call t_startf('carma_timestep_tend')
2503 :
2504 80640 : if (carma_do_cldice .or. carma_do_cldliq) then
2505 0 : call carma_diags_obj%update(cam_in, state, pbuf)
2506 : call carma_timestep_tend(state, cam_in, cam_out, ptend, ztodt, pbuf, dlf=dlf, rliq=rliq, &
2507 0 : prec_str=prec_str, snow_str=snow_str, prec_sed=prec_sed_carma, snow_sed=snow_sed_carma)
2508 0 : call carma_diags_obj%output(state, ptend, cam_in, "CRTEND", ztodt, pbuf)
2509 0 : call physics_update(state, ptend, ztodt, tend)
2510 :
2511 : ! Before the detrainment, the reserved condensate is all liquid, but if CARMA is doing
2512 : ! detrainment, then the reserved condensate is snow.
2513 0 : if (carma_do_detrain) then
2514 0 : call check_energy_cam_chng(state, tend, "carma_tend", nstep, ztodt, zero, prec_str+rliq, snow_str+rliq, zero)
2515 : else
2516 0 : call check_energy_cam_chng(state, tend, "carma_tend", nstep, ztodt, zero, prec_str, snow_str, zero)
2517 : end if
2518 : end if
2519 :
2520 80640 : call t_stopf('carma_timestep_tend')
2521 :
2522 80640 : if( microp_scheme == 'RK' ) then
2523 :
2524 : !===================================================
2525 : ! Calculate stratiform tendency (sedimentation, detrain, cloud fraction and microphysics )
2526 : !===================================================
2527 0 : call t_startf('rk_stratiform_tend')
2528 :
2529 : call rk_stratiform_tend(state, ptend, pbuf, ztodt, &
2530 : cam_in%icefrac, cam_in%landfrac, cam_in%ocnfrac, &
2531 : cam_in%snowhland, & ! sediment
2532 : dlf, dlf2, & ! detrain
2533 : rliq , & ! check energy after detrain
2534 : cmfmc, &
2535 0 : cam_in%ts, cam_in%sst, zdu)
2536 :
2537 0 : call physics_update(state, ptend, ztodt, tend)
2538 0 : call check_energy_cam_chng(state, tend, "cldwat_tend", nstep, ztodt, zero, prec_str, snow_str, zero)
2539 :
2540 0 : call t_stopf('rk_stratiform_tend')
2541 :
2542 80640 : elseif( microp_scheme == 'MG' ) then
2543 : ! Start co-substepping of macrophysics and microphysics
2544 80640 : cld_macmic_ztodt = ztodt/cld_macmic_num_steps
2545 :
2546 : ! Clear precip fields that should accumulate.
2547 80640 : prec_sed_macmic = 0._r8
2548 80640 : snow_sed_macmic = 0._r8
2549 80640 : prec_pcw_macmic = 0._r8
2550 80640 : snow_pcw_macmic = 0._r8
2551 :
2552 : ! contrail parameterization
2553 : ! see Chen et al., 2012: Global contrail coverage simulated
2554 : ! by CAM5 with the inventory of 2006 global aircraft emissions, JAMES
2555 : ! https://doi.org/10.1029/2011MS000105
2556 80640 : call ssatcontrail_d0(state, pbuf, ztodt, ptend)
2557 80640 : call physics_update(state, ptend, ztodt, tend)
2558 :
2559 : ! initialize ptend structures where macro and microphysics tendencies are
2560 : ! accumulated over macmic substeps
2561 80640 : call physics_ptend_init(ptend_macp_all,state%psetcols,'macrophysics',lu=.true.,lv=.true.)
2562 :
2563 322560 : do macmic_it = 1, cld_macmic_num_steps
2564 :
2565 : !===================================================
2566 : ! Calculate macrophysical tendency (sedimentation, detrain, cloud fraction)
2567 : !===================================================
2568 :
2569 241920 : call t_startf('macrop_tend')
2570 :
2571 : ! don't call Park macrophysics if CLUBB is called
2572 241920 : if (macrop_scheme .ne. 'CLUBB_SGS') then
2573 :
2574 0 : if (trim(cam_take_snapshot_before) == "macrop_driver_tend") then
2575 : call cam_snapshot_all_outfld_tphysbc(cam_snapshot_before_num, state, tend, cam_in, cam_out, pbuf, &
2576 0 : flx_heat, cmfmc, cmfcme, zdu, rliq, rice, dlf, dlf2, rliq2, det_s, det_ice, net_flx)
2577 : end if
2578 :
2579 : call macrop_driver_tend( &
2580 : state, ptend, cld_macmic_ztodt, &
2581 : cam_in%landfrac, cam_in%ocnfrac, cam_in%snowhland, & ! sediment
2582 : dlf, dlf2, & ! detrain
2583 : cmfmc, &
2584 : cam_in%ts, cam_in%sst, zdu, &
2585 0 : pbuf, det_s, det_ice)
2586 :
2587 : ! Since we "added" the reserved liquid back in this routine, we need
2588 : ! to account for it in the energy checker
2589 0 : flx_cnd(:ncol) = -1._r8*rliq(:ncol)
2590 0 : flx_heat(:ncol) = det_s(:ncol)
2591 :
2592 : ! Unfortunately, physics_update does not know what time period
2593 : ! "tend" is supposed to cover, and therefore can't update it
2594 : ! with substeps correctly. For now, work around this by scaling
2595 : ! ptend down by the number of substeps, then applying it for
2596 : ! the full time (ztodt).
2597 0 : call physics_ptend_scale(ptend, 1._r8/cld_macmic_num_steps, ncol)
2598 0 : if ( (trim(cam_take_snapshot_after) == "macrop_driver_tend") .and. &
2599 : (trim(cam_take_snapshot_before) == trim(cam_take_snapshot_after))) then
2600 0 : call cam_snapshot_ptend_outfld(ptend, lchnk)
2601 : end if
2602 0 : call physics_ptend_sum(ptend,ptend_macp_all,ncol)
2603 0 : call physics_update(state, ptend, ztodt, tend)
2604 :
2605 0 : if (trim(cam_take_snapshot_after) == "macrop_driver_tend") then
2606 : call cam_snapshot_all_outfld_tphysbc(cam_snapshot_after_num, state, tend, cam_in, cam_out, pbuf, &
2607 0 : flx_heat, cmfmc, cmfcme, zdu, rliq, rice, dlf, dlf2, rliq2, det_s, det_ice, net_flx)
2608 : end if
2609 :
2610 : call check_energy_cam_chng(state, tend, "macrop_tend", nstep, ztodt, &
2611 0 : zero, flx_cnd(:ncol)/cld_macmic_num_steps, &
2612 : det_ice(:ncol)/cld_macmic_num_steps, &
2613 0 : flx_heat(:ncol)/cld_macmic_num_steps)
2614 :
2615 : else ! Calculate CLUBB macrophysics
2616 :
2617 : ! =====================================================
2618 : ! CLUBB call (PBL, shallow convection, macrophysics)
2619 : ! =====================================================
2620 :
2621 241920 : if (trim(cam_take_snapshot_before) == "clubb_tend_cam") then
2622 : call cam_snapshot_all_outfld_tphysbc(cam_snapshot_before_num, state, tend, cam_in, cam_out, pbuf, &
2623 0 : flx_heat, cmfmc, cmfcme, zdu, rliq, rice, dlf, dlf2, rliq2, det_s, det_ice, net_flx)
2624 : end if
2625 :
2626 : call clubb_tend_cam(state, ptend, pbuf, cld_macmic_ztodt,&
2627 : cmfmc, cam_in, macmic_it, cld_macmic_num_steps, &
2628 241920 : dlf, det_s, det_ice)
2629 :
2630 : ! Since we "added" the reserved liquid back in this routine, we need
2631 : ! to account for it in the energy checker
2632 3725568 : flx_cnd(:ncol) = -1._r8*rliq(:ncol)
2633 3725568 : flx_heat(:ncol) = cam_in%shf(:ncol) + det_s(:ncol)
2634 :
2635 : ! Unfortunately, physics_update does not know what time period
2636 : ! "tend" is supposed to cover, and therefore can't update it
2637 : ! with substeps correctly. For now, work around this by scaling
2638 : ! ptend down by the number of substeps, then applying it for
2639 : ! the full time (ztodt).
2640 241920 : call physics_ptend_scale(ptend, 1._r8/cld_macmic_num_steps, ncol)
2641 :
2642 : ! Update physics tendencies and copy state to state_eq, because that is
2643 : ! input for microphysics
2644 241920 : if ( (trim(cam_take_snapshot_after) == "clubb_tend_cam") .and. &
2645 : (trim(cam_take_snapshot_before) == trim(cam_take_snapshot_after))) then
2646 0 : call cam_snapshot_ptend_outfld(ptend, lchnk)
2647 : end if
2648 241920 : call physics_ptend_sum(ptend,ptend_macp_all,ncol)
2649 241920 : call physics_update(state, ptend, ztodt, tend)
2650 :
2651 241920 : if (trim(cam_take_snapshot_after) == "clubb_tend_cam") then
2652 : call cam_snapshot_all_outfld_tphysbc(cam_snapshot_after_num, state, tend, cam_in, cam_out, pbuf, &
2653 0 : flx_heat, cmfmc, cmfcme, zdu, rliq, rice, dlf, dlf2, rliq2, det_s, det_ice, net_flx)
2654 : end if
2655 :
2656 : ! Use actual qflux (not lhf/latvap) for consistency with surface fluxes and revised code
2657 : call check_energy_cam_chng(state, tend, "clubb_tend", nstep, ztodt, &
2658 0 : cam_in%cflx(:ncol,1)/cld_macmic_num_steps, &
2659 : flx_cnd(:ncol)/cld_macmic_num_steps, &
2660 : det_ice(:ncol)/cld_macmic_num_steps, &
2661 14176512 : flx_heat(:ncol)/cld_macmic_num_steps)
2662 :
2663 : endif
2664 :
2665 241920 : call t_stopf('macrop_tend')
2666 :
2667 : !===================================================
2668 : ! Calculate cloud microphysics
2669 : !===================================================
2670 :
2671 241920 : if (is_subcol_on() .neqv. use_subcol_microp ) then
2672 0 : call endrun("Error calculating cloud microphysics: is_subcol_on() != use_subcol_microp")
2673 : end if
2674 :
2675 241920 : if (is_subcol_on()) then
2676 : ! Allocate sub-column structures.
2677 0 : call physics_state_alloc(state_sc, lchnk, psubcols*pcols)
2678 0 : call physics_tend_alloc(tend_sc, psubcols*pcols)
2679 :
2680 : ! Generate sub-columns using the requested scheme
2681 0 : if (trim(subcol_scheme) == 'SILHS') call init_state_subcol(state, tend, state_sc, tend_sc)
2682 0 : call subcol_gen(state, tend, state_sc, tend_sc, pbuf)
2683 :
2684 : !Initialize check energy for subcolumns
2685 0 : call check_energy_timestep_init(state_sc, tend_sc, pbuf, col_type_subcol)
2686 : end if
2687 :
2688 241920 : if (trim(cam_take_snapshot_before) == "microp_section") then
2689 : call cam_snapshot_all_outfld_tphysbc(cam_snapshot_before_num, state, tend, cam_in, cam_out, pbuf, &
2690 0 : flx_heat, cmfmc, cmfcme, zdu, rliq, rice, dlf, dlf2, rliq2, det_s, det_ice, net_flx)
2691 : end if
2692 :
2693 241920 : call carma_diags_obj%update(cam_in, state, pbuf)
2694 :
2695 241920 : call t_startf('microp_aero_run')
2696 241920 : call microp_aero_run(state, ptend_aero, cld_macmic_ztodt, pbuf)
2697 241920 : call t_stopf('microp_aero_run')
2698 :
2699 241920 : call t_startf('microp_tend')
2700 :
2701 241920 : if (use_subcol_microp) then
2702 :
2703 0 : if (trim(cam_take_snapshot_before) == "microp_driver_tend_subcol") then
2704 : call cam_snapshot_all_outfld_tphysbc(cam_snapshot_before_num, state_sc, tend_sc, cam_in, cam_out, pbuf, &
2705 0 : flx_heat, cmfmc, cmfcme, zdu, rliq, rice, dlf, dlf2, rliq2, det_s, det_ice, net_flx)
2706 : end if
2707 :
2708 0 : call microp_driver_tend(state_sc, ptend_sc, cld_macmic_ztodt, pbuf)
2709 : ! Parameterize subcolumn effects on covariances, if enabled
2710 0 : if (trim(subcol_scheme) == 'SILHS') &
2711 0 : call subcol_SILHS_var_covar_driver( cld_macmic_ztodt, state_sc, ptend_sc, pbuf )
2712 :
2713 : ! Average the sub-column ptend for use in gridded update - will not contain ptend_aero
2714 0 : call subcol_ptend_avg(ptend_sc, state_sc%ngrdcol, lchnk, ptend)
2715 :
2716 : ! Call the conservative hole filler.
2717 : ! Hole filling is only necessary when using subcolumns.
2718 : ! Note: this needs to be called after subcol_ptend_avg but before
2719 : ! physics_ptend_scale.
2720 0 : if (trim(subcol_scheme) == 'SILHS') &
2721 : call subcol_SILHS_fill_holes_conserv( state, cld_macmic_ztodt, &
2722 0 : ptend, pbuf )
2723 :
2724 : ! Destroy massless droplets - Note this routine returns with no change unless
2725 : ! micro_do_massless_droplet_destroyer has been set to true
2726 : call massless_droplet_destroyer( cld_macmic_ztodt, state, & ! Intent(in)
2727 0 : ptend ) ! Intent(inout)
2728 :
2729 : ! Limit the value of hydrometeor concentrations in order to place
2730 : ! reasonable limits on hydrometeor drop size and keep them from
2731 : ! becoming too large.
2732 : ! Note: this needs to be called after hydrometeor mixing ratio
2733 : ! tendencies are adjusted by subcol_SILHS_fill_holes_conserv
2734 : ! and after massless drop concentrations are removed by the
2735 : ! subcol_SILHS_massless_droplet_destroyer, but before the
2736 : ! call to physics_ptend_scale.
2737 0 : if (trim(subcol_scheme) == 'SILHS') &
2738 0 : call subcol_SILHS_hydromet_conc_tend_lim( state, cld_macmic_ztodt, ptend )
2739 :
2740 : ! Copy ptend_aero field to one dimensioned by sub-columns before summing with ptend
2741 0 : call subcol_ptend_copy(ptend_aero, state_sc, ptend_aero_sc)
2742 0 : call physics_ptend_sum(ptend_aero_sc, ptend_sc, state_sc%ncol)
2743 0 : call physics_ptend_dealloc(ptend_aero_sc)
2744 :
2745 : ! Have to scale and apply for full timestep to get tend right
2746 : ! (see above note for macrophysics).
2747 0 : call physics_ptend_scale(ptend_sc, 1._r8/cld_macmic_num_steps, ncol)
2748 :
2749 0 : if ( (trim(cam_take_snapshot_after) == "microp_driver_tend_subcol") .and. &
2750 : (trim(cam_take_snapshot_before) == trim(cam_take_snapshot_after))) then
2751 0 : call cam_snapshot_ptend_outfld(ptend, lchnk)
2752 : end if
2753 0 : call physics_update (state_sc, ptend_sc, ztodt, tend_sc)
2754 :
2755 0 : if (trim(cam_take_snapshot_after) == "microp_driver_tend_subcol") then
2756 : call cam_snapshot_all_outfld_tphysbc(cam_snapshot_after_num, state_sc, tend_sc, cam_in, cam_out, pbuf, &
2757 0 : flx_heat, cmfmc, cmfcme, zdu, rliq, rice, dlf, dlf2, rliq2, det_s, det_ice, net_flx)
2758 : end if
2759 :
2760 : call check_energy_cam_chng(state_sc, tend_sc, "microp_tend_subcol", &
2761 : nstep, ztodt, zero_sc, &
2762 0 : prec_str_sc(:state_sc%ncol)/cld_macmic_num_steps, &
2763 0 : snow_str_sc(:state_sc%ncol)/cld_macmic_num_steps, zero_sc)
2764 :
2765 0 : call physics_state_dealloc(state_sc)
2766 0 : call physics_tend_dealloc(tend_sc)
2767 0 : call physics_ptend_dealloc(ptend_sc)
2768 : else
2769 241920 : call microp_driver_tend(state, ptend, cld_macmic_ztodt, pbuf)
2770 : end if
2771 : ! combine aero and micro tendencies for the grid
2772 241920 : call physics_ptend_sum(ptend_aero, ptend, ncol)
2773 241920 : call physics_ptend_dealloc(ptend_aero)
2774 :
2775 : ! These need to be reported before the scaling as they are based
2776 : ! on the substep size not ztodt.
2777 241920 : write(pname, '(A, I2.2)') "MICROP", macmic_it
2778 241920 : call carma_diags_obj%output(state, ptend, cam_in, pname, ztodt/cld_macmic_num_steps, pbuf)
2779 :
2780 : ! Have to scale and apply for full timestep to get tend right
2781 : ! (see above note for macrophysics).
2782 241920 : call physics_ptend_scale(ptend, 1._r8/cld_macmic_num_steps, ncol)
2783 :
2784 241920 : call diag_clip_tend_writeout(state, ptend, ncol, lchnk, ixcldliq, ixcldice, ixq, ztodt, rtdt)
2785 :
2786 241920 : if ( (trim(cam_take_snapshot_after) == "microp_section") .and. &
2787 : (trim(cam_take_snapshot_before) == trim(cam_take_snapshot_after))) then
2788 0 : call cam_snapshot_ptend_outfld(ptend, lchnk)
2789 : end if
2790 241920 : call physics_update (state, ptend, ztodt, tend)
2791 :
2792 241920 : if (trim(cam_take_snapshot_after) == "microp_section") then
2793 : call cam_snapshot_all_outfld_tphysbc(cam_snapshot_after_num, state, tend, cam_in, cam_out, pbuf, &
2794 0 : flx_heat, cmfmc, cmfcme, zdu, rliq, rice, dlf, dlf2, rliq2, det_s, det_ice, net_flx)
2795 : end if
2796 :
2797 : call check_energy_cam_chng(state, tend, "microp_tend", nstep, ztodt, &
2798 0 : zero, prec_str(:ncol)/cld_macmic_num_steps, &
2799 7209216 : snow_str(:ncol)/cld_macmic_num_steps, zero)
2800 :
2801 241920 : call t_stopf('microp_tend')
2802 3725568 : prec_sed_macmic(:ncol) = prec_sed_macmic(:ncol) + prec_sed(:ncol)
2803 3725568 : snow_sed_macmic(:ncol) = snow_sed_macmic(:ncol) + snow_sed(:ncol)
2804 3725568 : prec_pcw_macmic(:ncol) = prec_pcw_macmic(:ncol) + prec_pcw(:ncol)
2805 3806208 : snow_pcw_macmic(:ncol) = snow_pcw_macmic(:ncol) + snow_pcw(:ncol)
2806 :
2807 : end do ! end substepping over macrophysics/microphysics
2808 :
2809 80640 : call outfld( 'UTEND_MACROP', ptend_macp_all%u, pcols, lchnk)
2810 80640 : call outfld( 'VTEND_MACROP', ptend_macp_all%v, pcols, lchnk)
2811 80640 : call physics_ptend_dealloc(ptend_macp_all)
2812 :
2813 1241856 : prec_sed(:ncol) = prec_sed_macmic(:ncol)/cld_macmic_num_steps
2814 1241856 : snow_sed(:ncol) = snow_sed_macmic(:ncol)/cld_macmic_num_steps
2815 1241856 : prec_pcw(:ncol) = prec_pcw_macmic(:ncol)/cld_macmic_num_steps
2816 1241856 : snow_pcw(:ncol) = snow_pcw_macmic(:ncol)/cld_macmic_num_steps
2817 2403072 : prec_str(:ncol) = prec_pcw(:ncol) + prec_sed(:ncol)
2818 2403072 : snow_str(:ncol) = snow_pcw(:ncol) + snow_sed(:ncol)
2819 :
2820 : endif
2821 :
2822 : ! Add the precipitation from CARMA to the precipitation from stratiform.
2823 80640 : if (carma_do_cldice .or. carma_do_cldliq) then
2824 0 : prec_sed(:ncol) = prec_sed(:ncol) + prec_sed_carma(:ncol)
2825 0 : snow_sed(:ncol) = snow_sed(:ncol) + snow_sed_carma(:ncol)
2826 : end if
2827 :
2828 80640 : if ( .not. deep_scheme_does_scav_trans() ) then
2829 :
2830 : ! -------------------------------------------------------------------------------
2831 : ! 1. Wet Scavenging of Aerosols by Convective and Stratiform Precipitation.
2832 : ! 2. Convective Transport of Non-Water Aerosol Species.
2833 : !
2834 : ! . Aerosol wet chemistry determines scavenging fractions, and transformations
2835 : ! . Then do convective transport of all trace species except qv,ql,qi.
2836 : ! . We needed to do the scavenging first to determine the interstitial fraction.
2837 : ! . When UNICON is used as unified convection, we should still perform
2838 : ! wet scavenging but not 'convect_deep_tend2'.
2839 : ! -------------------------------------------------------------------------------
2840 :
2841 80640 : call t_startf('aerosol_wet_processes')
2842 80640 : if (clim_modal_aero) then
2843 80640 : if (prog_modal_aero) then
2844 80640 : call physics_ptend_init(ptend, state%psetcols, 'aero_water_uptake', lq=wetdep_lq)
2845 : ! Do calculations of mode radius and water uptake if:
2846 : ! 1) modal aerosols are affecting the climate, or
2847 : ! 2) prognostic modal aerosols are enabled
2848 80640 : call modal_aero_calcsize_sub(state, ptend, ztodt, pbuf)
2849 : ! for prognostic modal aerosols the transfer of mass between aitken and accumulation
2850 : ! modes is done in conjunction with the dry radius calculation
2851 80640 : call modal_aero_wateruptake_dr(state, pbuf)
2852 80640 : call physics_update(state, ptend, ztodt, tend)
2853 : else
2854 0 : call modal_aero_calcsize_diag(state, pbuf)
2855 0 : call modal_aero_wateruptake_dr(state, pbuf)
2856 : endif
2857 : endif
2858 :
2859 80640 : if (trim(cam_take_snapshot_before) == "aero_model_wetdep") then
2860 : call cam_snapshot_all_outfld_tphysbc(cam_snapshot_before_num, state, tend, cam_in, cam_out, pbuf, &
2861 0 : flx_heat, cmfmc, cmfcme, zdu, rliq, rice, dlf, dlf2, rliq2, det_s, det_ice, net_flx)
2862 : end if
2863 :
2864 80640 : call carma_diags_obj%update(cam_in, state, pbuf)
2865 :
2866 80640 : call aero_model_wetdep( state, ztodt, dlf, cam_out, ptend, pbuf)
2867 80640 : if ( (trim(cam_take_snapshot_after) == "aero_model_wetdep") .and. &
2868 : (trim(cam_take_snapshot_before) == trim(cam_take_snapshot_after))) then
2869 0 : call cam_snapshot_ptend_outfld(ptend, lchnk)
2870 : end if
2871 80640 : call carma_diags_obj%output(state, ptend, cam_in, "WETDEPA", ztodt, pbuf)
2872 80640 : call physics_update(state, ptend, ztodt, tend)
2873 :
2874 80640 : if (trim(cam_take_snapshot_after) == "aero_model_wetdep") then
2875 : call cam_snapshot_all_outfld_tphysbc(cam_snapshot_after_num, state, tend, cam_in, cam_out, pbuf, &
2876 0 : flx_heat, cmfmc, cmfcme, zdu, rliq, rice, dlf, dlf2, rliq2, det_s, det_ice, net_flx)
2877 : end if
2878 :
2879 80640 : if (carma_do_wetdep) then
2880 : ! CARMA wet deposition
2881 : !
2882 : ! NOTE: It needs to follow aero_model_wetdep, so that cam_out%xxxwetxxx
2883 : ! fields have already been set for CAM aerosols and cam_out can be added
2884 : ! to for CARMA aerosols.
2885 0 : call t_startf ('carma_wetdep_tend')
2886 0 : call carma_diags_obj%update(cam_in, state, pbuf)
2887 0 : call carma_wetdep_tend(state, ptend, ztodt, pbuf, dlf, cam_out)
2888 0 : call carma_diags_obj%output(state, ptend, cam_in, "WETDEPC", ztodt, pbuf)
2889 0 : call physics_update(state, ptend, ztodt, tend)
2890 0 : call t_stopf ('carma_wetdep_tend')
2891 : end if
2892 :
2893 80640 : call t_startf ('convect_deep_tend2')
2894 80640 : call convect_deep_tend_2( state, ptend, ztodt, pbuf )
2895 80640 : call physics_update(state, ptend, ztodt, tend)
2896 80640 : call t_stopf ('convect_deep_tend2')
2897 :
2898 : ! check tracer integrals
2899 80640 : call check_tracers_chng(state, tracerint, "cmfmca", nstep, ztodt, zero_tracers)
2900 :
2901 80640 : call t_stopf('aerosol_wet_processes')
2902 :
2903 : endif
2904 :
2905 : !===================================================
2906 : ! Moist physical parameteriztions complete:
2907 : ! send dynamical variables, and derived variables to history file
2908 : !===================================================
2909 :
2910 80640 : call t_startf('bc_history_write')
2911 80640 : call diag_phys_writeout(state, pbuf)
2912 80640 : call diag_conv(state, ztodt, pbuf)
2913 :
2914 80640 : call t_stopf('bc_history_write')
2915 :
2916 : !===================================================
2917 : ! Write cloud diagnostics on history file
2918 : !===================================================
2919 :
2920 80640 : call t_startf('bc_cld_diag_history_write')
2921 :
2922 80640 : call cloud_diagnostics_calc(state, pbuf)
2923 :
2924 80640 : call t_stopf('bc_cld_diag_history_write')
2925 :
2926 : !===================================================
2927 : ! Radiation computations
2928 : !===================================================
2929 80640 : call t_startf('radiation')
2930 :
2931 80640 : if (trim(cam_take_snapshot_before) == "radiation_tend") then
2932 : call cam_snapshot_all_outfld_tphysbc(cam_snapshot_before_num, state, tend, cam_in, cam_out, pbuf, &
2933 0 : flx_heat, cmfmc, cmfcme, zdu, rliq, rice, dlf, dlf2, rliq2, det_s, det_ice, net_flx)
2934 : end if
2935 :
2936 : call radiation_tend( &
2937 80640 : state, ptend, pbuf, cam_out, cam_in, net_flx)
2938 :
2939 : ! Set net flux used by spectral dycores
2940 1241856 : do i=1,ncol
2941 1241856 : tend%flx_net(i) = net_flx(i)
2942 : end do
2943 :
2944 80640 : if ( (trim(cam_take_snapshot_after) == "radiation_tend") .and. &
2945 : (trim(cam_take_snapshot_before) == trim(cam_take_snapshot_after))) then
2946 0 : call cam_snapshot_ptend_outfld(ptend, lchnk)
2947 : end if
2948 80640 : call physics_update(state, ptend, ztodt, tend)
2949 :
2950 80640 : if (trim(cam_take_snapshot_after) == "radiation_tend") then
2951 : call cam_snapshot_all_outfld_tphysbc(cam_snapshot_after_num, state, tend, cam_in, cam_out, pbuf, &
2952 0 : flx_heat, cmfmc, cmfcme, zdu, rliq, rice, dlf, dlf2, rliq2, det_s, det_ice, net_flx)
2953 : end if
2954 :
2955 80640 : call check_energy_cam_chng(state, tend, "radheat", nstep, ztodt, zero, zero, zero, net_flx)
2956 :
2957 80640 : call t_stopf('radiation')
2958 :
2959 : ! Diagnose the location of the tropopause and its location to the history file(s).
2960 80640 : call t_startf('tropopause')
2961 80640 : call tropopause_output(state)
2962 80640 : call t_stopf('tropopause')
2963 :
2964 : ! Save atmospheric fields to force surface models
2965 80640 : call t_startf('cam_export')
2966 80640 : call cam_export (state,cam_out,pbuf)
2967 80640 : call t_stopf('cam_export')
2968 :
2969 : ! Write export state to history file
2970 80640 : call t_startf('diag_export')
2971 80640 : call diag_export(cam_out)
2972 80640 : call t_stopf('diag_export')
2973 :
2974 : ! clean CARMA diagnostics object
2975 80640 : if (associated(carma_diags_obj)) then
2976 80640 : deallocate(carma_diags_obj)
2977 80640 : nullify(carma_diags_obj)
2978 : end if
2979 :
2980 241920 : end subroutine tphysbc
2981 :
2982 16128 : subroutine phys_timestep_init(phys_state, cam_in, cam_out, pbuf2d)
2983 : !-----------------------------------------------------------------------------------
2984 : !
2985 : ! Purpose: The place for parameterizations to call per timestep initializations.
2986 : ! Generally this is used to update time interpolated fields from boundary
2987 : ! datasets.
2988 : !
2989 : !-----------------------------------------------------------------------------------
2990 80640 : use chemistry, only: chem_timestep_init
2991 : use chem_surfvals, only: chem_surfvals_set
2992 : use physics_types, only: physics_state
2993 : use physics_buffer, only: physics_buffer_desc
2994 : use carma_intr, only: carma_timestep_init
2995 : use ghg_data, only: ghg_data_timestep_init
2996 : use aoa_tracers, only: aoa_tracers_timestep_init
2997 : use vertical_diffusion, only: vertical_diffusion_ts_init
2998 : use radheat, only: radheat_timestep_init
2999 : use solar_data, only: solar_data_advance
3000 : use qbo, only: qbo_timestep_init
3001 : use iondrag, only: do_waccm_ions, iondrag_timestep_init
3002 : use perf_mod
3003 :
3004 : use prescribed_ozone, only: prescribed_ozone_adv
3005 : use prescribed_ghg, only: prescribed_ghg_adv
3006 : use prescribed_aero, only: prescribed_aero_adv
3007 : use aerodep_flx, only: aerodep_flx_adv
3008 : use aircraft_emit, only: aircraft_emit_adv
3009 : use prescribed_volcaero, only: prescribed_volcaero_adv
3010 : use prescribed_strataero,only: prescribed_strataero_adv
3011 : use mo_apex, only: mo_apex_init
3012 : use epp_ionization, only: epp_ionization_active
3013 : use iop_forcing, only: scam_use_iop_srf
3014 : use nudging, only: Nudge_Model, nudging_timestep_init
3015 : use waccmx_phys_intr, only: waccmx_phys_ion_elec_temp_timestep_init
3016 : use phys_grid_ctem, only: phys_grid_ctem_diags
3017 : use surface_emissions_mod,only: surface_emissions_adv
3018 : use elevated_emissions_mod,only: elevated_emissions_adv
3019 :
3020 : implicit none
3021 :
3022 : type(physics_state), intent(inout), dimension(begchunk:endchunk) :: phys_state
3023 : type(cam_in_t), intent(inout), dimension(begchunk:endchunk) :: cam_in
3024 : type(cam_out_t), intent(inout), dimension(begchunk:endchunk) :: cam_out
3025 :
3026 : type(physics_buffer_desc), pointer :: pbuf2d(:,:)
3027 :
3028 : !-----------------------------------------------------------------------------
3029 :
3030 16128 : if (single_column) call scam_use_iop_srf(cam_in)
3031 :
3032 : ! update geomagnetic coordinates
3033 16128 : if (epp_ionization_active .or. do_waccm_ions) then
3034 16128 : call mo_apex_init(phys_state)
3035 : endif
3036 :
3037 : ! Chemistry surface values
3038 16128 : call chem_surfvals_set()
3039 16128 : call surface_emissions_adv(pbuf2d, phys_state)
3040 16128 : call elevated_emissions_adv(pbuf2d, phys_state)
3041 :
3042 : ! Solar irradiance
3043 16128 : call solar_data_advance()
3044 :
3045 : ! Time interpolate for chemistry.
3046 16128 : call chem_timestep_init(phys_state, pbuf2d)
3047 :
3048 16128 : if( waccmx_is('ionosphere') ) then
3049 0 : call waccmx_phys_ion_elec_temp_timestep_init(phys_state,pbuf2d)
3050 : endif
3051 :
3052 : ! Prescribed tracers
3053 16128 : call prescribed_ozone_adv(phys_state, pbuf2d)
3054 16128 : call prescribed_ghg_adv(phys_state, pbuf2d)
3055 16128 : call prescribed_aero_adv(phys_state, pbuf2d)
3056 16128 : call aircraft_emit_adv(phys_state, pbuf2d)
3057 16128 : call prescribed_volcaero_adv(phys_state, pbuf2d)
3058 16128 : call prescribed_strataero_adv(phys_state, pbuf2d)
3059 :
3060 : ! prescribed aerosol deposition fluxes
3061 16128 : call aerodep_flx_adv(phys_state, pbuf2d, cam_out)
3062 :
3063 : ! Time interpolate data models of gasses in pbuf2d
3064 16128 : call ghg_data_timestep_init(pbuf2d, phys_state)
3065 :
3066 : ! Upper atmosphere radiative processes
3067 16128 : call radheat_timestep_init(phys_state, pbuf2d)
3068 :
3069 : ! Time interpolate for vertical diffusion upper boundary condition
3070 16128 : call vertical_diffusion_ts_init(pbuf2d, phys_state)
3071 :
3072 : !----------------------------------------------------------------------
3073 : ! update QBO data for this time step
3074 : !----------------------------------------------------------------------
3075 16128 : call qbo_timestep_init
3076 :
3077 16128 : call iondrag_timestep_init()
3078 :
3079 16128 : call carma_timestep_init()
3080 :
3081 : ! age of air tracers
3082 16128 : call aoa_tracers_timestep_init(phys_state)
3083 :
3084 : ! Update Nudging values, if needed
3085 : !----------------------------------
3086 16128 : if(Nudge_Model) call nudging_timestep_init(phys_state)
3087 :
3088 : ! Update TEM diagnostics
3089 16128 : call phys_grid_ctem_diags(phys_state)
3090 :
3091 16128 : end subroutine phys_timestep_init
3092 :
3093 : end module physpkg
|
