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