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