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