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