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