Line data Source code
1 : module cam_diagnostics
2 :
3 : !---------------------------------------------------------------------------------
4 : ! Module to compute a variety of diagnostics quantities for history files
5 : !---------------------------------------------------------------------------------
6 :
7 : use shr_kind_mod, only: r8 => shr_kind_r8
8 : use camsrfexch, only: cam_in_t, cam_out_t
9 : use cam_control_mod, only: moist_physics
10 : use physics_types, only: physics_state, physics_tend, physics_ptend
11 : use ppgrid, only: pcols, pver, begchunk, endchunk
12 : use physics_buffer, only: physics_buffer_desc, pbuf_add_field, dtype_r8
13 : use physics_buffer, only: dyn_time_lvls, pbuf_get_field, pbuf_get_index, pbuf_old_tim_idx
14 :
15 : use cam_history, only: outfld, write_inithist, hist_fld_active, inithist_all, write_camiop
16 : use cam_history_support, only: max_fieldname_len
17 : use constituents, only: pcnst, cnst_name, cnst_longname, cnst_cam_outfld
18 : use constituents, only: ptendnam, apcnst, bpcnst, cnst_get_ind
19 : use dycore, only: dycore_is
20 : use phys_control, only: phys_getopts
21 : use wv_saturation, only: qsat, qsat_water, svp_ice_vect
22 : use time_manager, only: is_first_step
23 :
24 : use scamMod, only: single_column, wfld
25 : use cam_abortutils, only: endrun
26 :
27 : implicit none
28 : private
29 : save
30 :
31 : ! Public interfaces
32 :
33 : public :: &
34 : diag_readnl, &! read namelist options
35 : diag_register, &! register pbuf space
36 : diag_init, &! initialization
37 : diag_allocate, &! allocate memory for module variables
38 : diag_deallocate, &! deallocate memory for module variables
39 : diag_conv_tend_ini, &! initialize convective tendency calcs
40 : diag_phys_writeout, &! output diagnostics of the dynamics
41 : diag_clip_tend_writeout, &! output diagnostics for clipping
42 : diag_phys_tend_writeout, &! output physics tendencies
43 : diag_state_b4_phys_write, &! output state before physics execution
44 : diag_conv, &! output diagnostics of convective processes
45 : diag_surf, &! output diagnostics of the surface
46 : diag_export, &! output export state
47 : diag_physvar_ic, &
48 : nsurf
49 :
50 : integer, public, parameter :: num_stages = 8
51 : character (len = max_fieldname_len), dimension(num_stages) :: stage = (/"phBF","phBP","phAP","phAM","dyBF","dyBP","dyAP","dyAM"/)
52 : character (len = 45),dimension(num_stages) :: stage_txt = (/&
53 : " before energy fixer ",& !phBF - physics energy
54 : " before parameterizations ",& !phBF - physics energy
55 : " after parameterizations ",& !phAP - physics energy
56 : " after dry mass correction ",& !phAM - physics energy
57 : " before energy fixer (dycore) ",& !dyBF - dynamics energy
58 : " before parameterizations (dycore) ",& !dyBF - dynamics energy
59 : " after parameterizations (dycore) ",& !dyAP - dynamics energy
60 : " after dry mass correction (dycore) " & !dyAM - dynamics energy
61 : /)
62 :
63 : ! Private data
64 :
65 : integer :: dqcond_num ! number of constituents to compute convective
66 : character(len=16) :: dcconnam(pcnst) ! names of convection tendencies
67 : ! tendencies for
68 : real(r8), allocatable :: dtcond(:,:,:) ! temperature tendency due to convection
69 : type dqcond_t
70 : real(r8), allocatable :: cnst(:,:,:) ! constituent tendency due to convection
71 : end type dqcond_t
72 : type(dqcond_t), allocatable :: dqcond(:)
73 :
74 : character(len=8) :: diag_cnst_conv_tend = 'q_only' ! output constituent tendencies due to convection
75 : ! 'none', 'q_only' or 'all'
76 :
77 : integer, parameter :: surf_100000 = 1
78 : integer, parameter :: surf_092500 = 2
79 : integer, parameter :: surf_085000 = 3
80 : integer, parameter :: surf_070000 = 4
81 : integer, parameter :: nsurf = 4
82 :
83 : logical :: history_amwg ! output the variables used by the AMWG diag package
84 : logical :: history_vdiag ! output the variables used by the AMWG variability diag package
85 : logical :: history_eddy ! output the eddy variables
86 : logical :: history_budget ! output tendencies and state variables for CAM4
87 : ! temperature, water vapor, cloud ice and cloud
88 : ! liquid budgets.
89 : integer :: history_budget_histfile_num ! output history file number for budget fields
90 : logical :: history_waccm ! outputs typically used for WACCM
91 :
92 : ! Physics buffer indices
93 :
94 : integer :: psl_idx = 0
95 : integer :: relhum_idx = 0
96 : integer :: qcwat_idx = 0
97 : integer :: tcwat_idx = 0
98 : integer :: lcwat_idx = 0
99 : integer :: cld_idx = 0
100 : integer :: concld_idx = 0
101 : integer :: tke_idx = 0
102 : integer :: kvm_idx = 0
103 : integer :: kvh_idx = 0
104 : integer :: cush_idx = 0
105 : integer :: t_ttend_idx = 0
106 : integer :: t_utend_idx = 0
107 : integer :: t_vtend_idx = 0
108 :
109 : integer :: prec_dp_idx = 0
110 : integer :: snow_dp_idx = 0
111 : integer :: prec_sh_idx = 0
112 : integer :: snow_sh_idx = 0
113 : integer :: prec_sed_idx = 0
114 : integer :: snow_sed_idx = 0
115 : integer :: prec_pcw_idx = 0
116 : integer :: snow_pcw_idx = 0
117 :
118 :
119 : integer :: tpert_idx=-1, qpert_idx=-1, pblh_idx=-1
120 :
121 : integer :: trefmxav_idx = -1, trefmnav_idx = -1
122 :
123 : contains
124 :
125 : !==============================================================================
126 :
127 1536 : subroutine diag_readnl(nlfile)
128 : use namelist_utils, only: find_group_name
129 : use units, only: getunit, freeunit
130 : use spmd_utils, only: masterproc, masterprocid, mpi_character, mpicom
131 :
132 : character(len=*), intent(in) :: nlfile ! filepath for file containing namelist input
133 :
134 : ! Local variables
135 : integer :: unitn, ierr
136 : character(len=*), parameter :: subname = 'diag_readnl'
137 :
138 : namelist /cam_diag_opts/ diag_cnst_conv_tend
139 : !--------------------------------------------------------------------------
140 :
141 1536 : if (masterproc) then
142 2 : unitn = getunit()
143 2 : open( unitn, file=trim(nlfile), status='old' )
144 2 : call find_group_name(unitn, 'cam_diag_opts', status=ierr)
145 2 : if (ierr == 0) then
146 0 : read(unitn, cam_diag_opts, iostat=ierr)
147 0 : if (ierr /= 0) then
148 0 : call endrun(subname // ':: ERROR reading namelist')
149 : end if
150 : end if
151 2 : close(unitn)
152 2 : call freeunit(unitn)
153 : end if
154 :
155 : ! Broadcast namelist variables
156 1536 : call mpi_bcast(diag_cnst_conv_tend, len(diag_cnst_conv_tend), mpi_character, masterprocid, mpicom, ierr)
157 :
158 1536 : end subroutine diag_readnl
159 :
160 : !==============================================================================
161 :
162 1536 : subroutine diag_register_dry()
163 :
164 1536 : call pbuf_add_field('PSL', 'physpkg', dtype_r8, (/pcols/), psl_idx)
165 :
166 : ! Request physics buffer space for fields that persist across timesteps.
167 6144 : call pbuf_add_field('T_TTEND', 'global', dtype_r8, (/pcols,pver,dyn_time_lvls/), t_ttend_idx)
168 6144 : call pbuf_add_field('T_UTEND', 'global', dtype_r8, (/pcols,pver,dyn_time_lvls/), t_utend_idx)
169 6144 : call pbuf_add_field('T_VTEND', 'global', dtype_r8, (/pcols,pver,dyn_time_lvls/), t_vtend_idx)
170 1536 : end subroutine diag_register_dry
171 :
172 1536 : subroutine diag_register_moist()
173 : ! Request physics buffer space for fields that persist across timesteps.
174 1536 : call pbuf_add_field('TREFMXAV', 'global', dtype_r8, (/pcols/), trefmxav_idx)
175 1536 : call pbuf_add_field('TREFMNAV', 'global', dtype_r8, (/pcols/), trefmnav_idx)
176 1536 : end subroutine diag_register_moist
177 :
178 1536 : subroutine diag_register()
179 1536 : call diag_register_dry()
180 1536 : if (moist_physics) then
181 1536 : call diag_register_moist()
182 : end if
183 1536 : end subroutine diag_register
184 :
185 : !==============================================================================
186 :
187 1536 : subroutine diag_init_dry(pbuf2d)
188 : ! Declare the history fields for which this module contains outfld calls.
189 :
190 : use cam_history, only: addfld, add_default, horiz_only
191 : use cam_history, only: register_vector_field
192 : use tidal_diag, only: tidal_diag_init
193 : use cam_budget, only: cam_budget_em_snapshot, cam_budget_em_register, thermo_budget_history
194 :
195 : type(physics_buffer_desc), pointer, intent(in) :: pbuf2d(:,:)
196 :
197 : integer :: istage
198 : ! outfld calls in diag_phys_writeout
199 3072 : call addfld (cnst_name(1), (/ 'lev' /), 'A', 'kg/kg', cnst_longname(1))
200 1536 : call addfld ('NSTEP', horiz_only, 'A', 'timestep', 'Model timestep')
201 1536 : call addfld ('PHIS', horiz_only, 'I', 'm2/s2', 'Surface geopotential')
202 :
203 1536 : call addfld ('PS', horiz_only, 'A', 'Pa', 'Surface pressure')
204 3072 : call addfld ('T', (/ 'lev' /), 'A', 'K', 'Temperature')
205 3072 : call addfld ('U', (/ 'lev' /), 'A', 'm/s', 'Zonal wind')
206 3072 : call addfld ('V', (/ 'lev' /), 'A', 'm/s', 'Meridional wind')
207 :
208 1536 : call register_vector_field('U','V')
209 :
210 : ! State before physics
211 3072 : call addfld ('TBP', (/ 'lev' /), 'A','K', 'Temperature (before physics)')
212 3072 : call addfld ('UBP', (/ 'lev' /), 'A','m/s', 'Zonal wind (before physics)')
213 3072 : call addfld ('VBP', (/ 'lev' /), 'A','m/s', 'Meridional Wind (before physics)')
214 1536 : call register_vector_field('UBP','VBP')
215 3072 : call addfld (bpcnst(1), (/ 'lev' /), 'A','kg/kg', trim(cnst_longname(1))//' (before physics)')
216 : ! State after physics
217 3072 : call addfld ('TAP', (/ 'lev' /), 'A','K', 'Temperature (after physics)' )
218 3072 : call addfld ('UAP', (/ 'lev' /), 'A','m/s', 'Zonal wind (after physics)' )
219 3072 : call addfld ('VAP', (/ 'lev' /), 'A','m/s', 'Meridional wind (after physics)' )
220 :
221 1536 : call register_vector_field('UAP','VAP')
222 :
223 3072 : call addfld (apcnst(1), (/ 'lev' /), 'A','kg/kg', trim(cnst_longname(1))//' (after physics)')
224 1536 : if (.not.dycore_is('EUL')) then
225 1536 : call addfld ('TFIX', horiz_only, 'A', 'K/s', 'T fixer (T equivalent of Energy correction)')
226 : end if
227 3072 : call addfld ('TTEND_TOT', (/ 'lev' /), 'A', 'K/s', 'Total temperature tendency')
228 :
229 : ! outfld calls in diag_phys_tend_writeout
230 3072 : call addfld ('UTEND_TOT', (/ 'lev' /), 'A', 'm/s2', 'Total zonal wind tendency')
231 3072 : call addfld ('VTEND_TOT', (/ 'lev' /), 'A', 'm/s2', 'Total meridional wind tendency')
232 1536 : call register_vector_field('UTEND_TOT','VTEND_TOT')
233 :
234 : ! Debugging negative water output fields
235 3072 : call addfld ('INEGCLPTEND ', (/ 'lev' /), 'A', 'kg/kg/s', 'Cloud ice tendency due to clipping neg values after microp')
236 3072 : call addfld ('LNEGCLPTEND ', (/ 'lev' /), 'A', 'kg/kg/s', 'Cloud liq tendency due to clipping neg values after microp')
237 3072 : call addfld ('VNEGCLPTEND ', (/ 'lev' /), 'A', 'kg/kg/s', 'Vapor tendency due to clipping neg values after microp')
238 :
239 3072 : call addfld ('Z3', (/ 'lev' /), 'A', 'm', 'Geopotential Height (above sea level)')
240 1536 : call addfld ('Z1000', horiz_only, 'A', 'm', 'Geopotential Z at 1000 mbar pressure surface')
241 1536 : call addfld ('Z700', horiz_only, 'A', 'm', 'Geopotential Z at 700 mbar pressure surface')
242 1536 : call addfld ('Z500', horiz_only, 'A', 'm', 'Geopotential Z at 500 mbar pressure surface')
243 1536 : call addfld ('Z300', horiz_only, 'A', 'm', 'Geopotential Z at 300 mbar pressure surface')
244 1536 : call addfld ('Z200', horiz_only, 'A', 'm', 'Geopotential Z at 200 mbar pressure surface')
245 1536 : call addfld ('Z100', horiz_only, 'A', 'm', 'Geopotential Z at 100 mbar pressure surface')
246 1536 : call addfld ('Z050', horiz_only, 'A', 'm', 'Geopotential Z at 50 mbar pressure surface')
247 :
248 3072 : call addfld ('ZZ', (/ 'lev' /), 'A', 'm2', 'Eddy height variance' )
249 3072 : call addfld ('VZ', (/ 'lev' /), 'A', 'm2/s', 'Meridional transport of geopotential height')
250 3072 : call addfld ('VT', (/ 'lev' /), 'A', 'K m/s ', 'Meridional heat transport')
251 3072 : call addfld ('VU', (/ 'lev' /), 'A', 'm2/s2', 'Meridional flux of zonal momentum' )
252 3072 : call addfld ('VV', (/ 'lev' /), 'A', 'm2/s2', 'Meridional velocity squared' )
253 3072 : call addfld ('OMEGAV', (/ 'lev' /), 'A', 'm Pa/s2 ', 'Vertical flux of meridional momentum' )
254 3072 : call addfld ('OMGAOMGA', (/ 'lev' /), 'A', 'Pa2/s2', 'Vertical flux of vertical momentum' )
255 :
256 3072 : call addfld ('UU', (/ 'lev' /), 'A', 'm2/s2', 'Zonal velocity squared' )
257 3072 : call addfld ('WSPEED', (/ 'lev' /), 'X', 'm/s', 'Horizontal total wind speed maximum' )
258 1536 : call addfld ('WSPDSRFMX', horiz_only, 'X', 'm/s', 'Horizontal total wind speed maximum at surface layer midpoint' )
259 1536 : call addfld ('WSPDSRFAV', horiz_only, 'A', 'm/s', 'Horizontal total wind speed average at surface layer midpoint' )
260 :
261 3072 : call addfld ('OMEGA', (/ 'lev' /), 'A', 'Pa/s', 'Vertical velocity (pressure)')
262 3072 : call addfld ('OMEGAT', (/ 'lev' /), 'A', 'K Pa/s ', 'Vertical heat flux' )
263 3072 : call addfld ('OMEGAU', (/ 'lev' /), 'A', 'm Pa/s2 ', 'Vertical flux of zonal momentum' )
264 1536 : call addfld ('OMEGA850', horiz_only, 'A', 'Pa/s', 'Vertical velocity at 850 mbar pressure surface')
265 1536 : call addfld ('OMEGA500', horiz_only, 'A', 'Pa/s', 'Vertical velocity at 500 mbar pressure surface')
266 :
267 1536 : call addfld ('PSL', horiz_only, 'A', 'Pa','Sea level pressure')
268 :
269 1536 : call addfld ('T1000', horiz_only, 'A', 'K','Temperature at 1000 mbar pressure surface')
270 1536 : call addfld ('T925', horiz_only, 'A', 'K','Temperature at 925 mbar pressure surface')
271 1536 : call addfld ('T850', horiz_only, 'A', 'K','Temperature at 850 mbar pressure surface')
272 1536 : call addfld ('T700', horiz_only, 'A', 'K','Temperature at 700 mbar pressure surface')
273 1536 : call addfld ('T500', horiz_only, 'A', 'K','Temperature at 500 mbar pressure surface')
274 1536 : call addfld ('T400', horiz_only, 'A', 'K','Temperature at 400 mbar pressure surface')
275 1536 : call addfld ('T300', horiz_only, 'A', 'K','Temperature at 300 mbar pressure surface')
276 1536 : call addfld ('T200', horiz_only, 'A', 'K','Temperature at 200 mbar pressure surface')
277 1536 : call addfld ('T010', horiz_only, 'A', 'K','Temperature at 10 mbar pressure surface')
278 :
279 1536 : call addfld ('T7001000', horiz_only, 'A', 'K','Temperature difference 700 mb - 1000 mb')
280 1536 : call addfld ('TH7001000', horiz_only, 'A', 'K','Theta difference 700 mb - 1000 mb')
281 1536 : call addfld ('THE7001000', horiz_only, 'A', 'K','ThetaE difference 700 mb - 1000 mb')
282 :
283 1536 : call addfld ('T8501000', horiz_only, 'A', 'K','Temperature difference 850 mb - 1000 mb')
284 1536 : call addfld ('TH8501000', horiz_only, 'A', 'K','Theta difference 850 mb - 1000 mb')
285 1536 : call addfld ('T9251000', horiz_only, 'A', 'K','Temperature difference 925 mb - 1000 mb')
286 1536 : call addfld ('TH9251000', horiz_only, 'A', 'K','Theta difference 925 mb - 1000 mb')
287 :
288 3072 : call addfld ('TT', (/ 'lev' /), 'A', 'K2','Eddy temperature variance' )
289 :
290 1536 : call addfld ('U850', horiz_only, 'A', 'm/s','Zonal wind at 850 mbar pressure surface')
291 1536 : call addfld ('U500', horiz_only, 'A', 'm/s','Zonal wind at 500 mbar pressure surface')
292 1536 : call addfld ('U250', horiz_only, 'A', 'm/s','Zonal wind at 250 mbar pressure surface')
293 1536 : call addfld ('U200', horiz_only, 'A', 'm/s','Zonal wind at 200 mbar pressure surface')
294 1536 : call addfld ('U010', horiz_only, 'A', 'm/s','Zonal wind at 10 mbar pressure surface')
295 1536 : call addfld ('V850', horiz_only, 'A', 'm/s','Meridional wind at 850 mbar pressure surface')
296 1536 : call addfld ('V500', horiz_only, 'A', 'm/s','Meridional wind at 500 mbar pressure surface')
297 1536 : call addfld ('V250', horiz_only, 'A', 'm/s','Meridional wind at 250 mbar pressure surface')
298 1536 : call addfld ('V200', horiz_only, 'A', 'm/s','Meridional wind at 200 mbar pressure surface')
299 :
300 1536 : call register_vector_field('U850', 'V850')
301 1536 : call register_vector_field('U500', 'V500')
302 1536 : call register_vector_field('U250', 'V250')
303 1536 : call register_vector_field('U200', 'V200')
304 :
305 1536 : call addfld ('UBOT', horiz_only, 'A', 'm/s','Lowest model level zonal wind')
306 1536 : call addfld ('VBOT', horiz_only, 'A', 'm/s','Lowest model level meridional wind')
307 1536 : call register_vector_field('UBOT', 'VBOT')
308 :
309 1536 : call addfld ('ZBOT', horiz_only, 'A', 'm','Lowest model level height')
310 :
311 1536 : call addfld ('ATMEINT', horiz_only, 'A', 'J/m2','Vertically integrated total atmospheric energy ')
312 :
313 1536 : if (history_amwg) then
314 1536 : call add_default ('PHIS ' , 1, ' ')
315 1536 : call add_default ('PS ' , 1, ' ')
316 1536 : call add_default ('T ' , 1, ' ')
317 1536 : call add_default ('U ' , 1, ' ')
318 1536 : call add_default ('V ' , 1, ' ')
319 1536 : call add_default ('Z3 ' , 1, ' ')
320 1536 : call add_default ('OMEGA ' , 1, ' ')
321 1536 : call add_default ('VT ', 1, ' ')
322 1536 : call add_default ('VU ', 1, ' ')
323 1536 : call add_default ('VV ', 1, ' ')
324 1536 : call add_default ('UU ', 1, ' ')
325 1536 : call add_default ('OMEGAT ', 1, ' ')
326 1536 : call add_default ('PSL ', 1, ' ')
327 : end if
328 :
329 1536 : if (history_vdiag) then
330 0 : call add_default ('U200', 2, ' ')
331 0 : call add_default ('V200', 2, ' ')
332 0 : call add_default ('U850', 2, ' ')
333 0 : call add_default ('U200', 3, ' ')
334 0 : call add_default ('U850', 3, ' ')
335 0 : call add_default ('OMEGA500', 3, ' ')
336 : end if
337 :
338 1536 : if (history_eddy) then
339 0 : call add_default ('VT ', 1, ' ')
340 0 : call add_default ('VU ', 1, ' ')
341 0 : call add_default ('VV ', 1, ' ')
342 0 : call add_default ('UU ', 1, ' ')
343 0 : call add_default ('OMEGAT ', 1, ' ')
344 0 : call add_default ('OMEGAU ', 1, ' ')
345 0 : call add_default ('OMEGAV ', 1, ' ')
346 : endif
347 :
348 1536 : if ( history_budget ) then
349 0 : call add_default ('PHIS ' , history_budget_histfile_num, ' ')
350 0 : call add_default ('PS ' , history_budget_histfile_num, ' ')
351 0 : call add_default ('T ' , history_budget_histfile_num, ' ')
352 0 : call add_default ('U ' , history_budget_histfile_num, ' ')
353 0 : call add_default ('V ' , history_budget_histfile_num, ' ')
354 0 : call add_default ('TTEND_TOT' , history_budget_histfile_num, ' ')
355 0 : call add_default ('UTEND_TOT' , history_budget_histfile_num, ' ')
356 0 : call add_default ('VTEND_TOT' , history_budget_histfile_num, ' ')
357 :
358 : ! State before physics (FV)
359 0 : call add_default ('TBP ' , history_budget_histfile_num, ' ')
360 0 : call add_default ('UBP ' , history_budget_histfile_num, ' ')
361 0 : call add_default ('VBP ' , history_budget_histfile_num, ' ')
362 0 : call add_default (bpcnst(1) , history_budget_histfile_num, ' ')
363 : ! State after physics (FV)
364 0 : call add_default ('TAP ' , history_budget_histfile_num, ' ')
365 0 : call add_default ('UAP ' , history_budget_histfile_num, ' ')
366 0 : call add_default ('VAP ' , history_budget_histfile_num, ' ')
367 0 : call add_default (apcnst(1) , history_budget_histfile_num, ' ')
368 0 : if (.not.dycore_is('EUL')) then
369 0 : call add_default ('TFIX ' , history_budget_histfile_num, ' ')
370 : end if
371 : end if
372 :
373 1536 : if (history_waccm) then
374 0 : call add_default ('PHIS', 7, ' ')
375 0 : call add_default ('PS', 7, ' ')
376 0 : call add_default ('PSL', 7, ' ')
377 : end if
378 :
379 : ! outfld calls in diag_phys_tend_writeout
380 3072 : call addfld ('PTTEND', (/ 'lev' /), 'A', 'K/s','T total physics tendency')
381 3072 : call addfld ('UTEND_PHYSTOT', (/ 'lev' /), 'A', 'm/s2','U total physics tendency')
382 3072 : call addfld ('VTEND_PHYSTOT', (/ 'lev' /), 'A', 'm/s2','V total physics tendency')
383 1536 : call register_vector_field('UTEND_PHYSTOT','VTEND_PHYSTOT')
384 1536 : if ( history_budget ) then
385 0 : call add_default ('PTTEND' , history_budget_histfile_num, ' ')
386 0 : call add_default ('UTEND_PHYSTOT' , history_budget_histfile_num, ' ')
387 0 : call add_default ('VTEND_PHYSTOT' , history_budget_histfile_num, ' ')
388 : end if
389 :
390 : ! create history variables for fourier coefficients of the diurnal
391 : ! and semidiurnal tide in T, U, V, and Z3
392 1536 : call tidal_diag_init()
393 :
394 3072 : call addfld( 'CPAIRV', (/ 'lev' /), 'I', 'J/K/kg', 'Variable specific heat cap air' )
395 3072 : call addfld( 'RAIRV', (/ 'lev' /), 'I', 'J/K/kg', 'Variable dry air gas constant' )
396 :
397 1536 : if (thermo_budget_history) then
398 : !
399 : ! energy diagnostics addflds for vars_stage combinations plus e_m_snapshots
400 : !
401 0 : do istage = 1, num_stages
402 0 : call cam_budget_em_snapshot(TRIM(ADJUSTL(stage(istage))),'phy',longname=TRIM(ADJUSTL(stage_txt(istage))))
403 : end do
404 :
405 : ! Create budgets that are a sum/dif of 2 stages
406 :
407 0 : call cam_budget_em_register('dEdt_param_efix_physE','phAP','phBF','phy','dif',longname='dE/dt CAM physics + energy fixer using physics E formula (phAP-phBF)')
408 0 : call cam_budget_em_register('dEdt_param_efix_dynE' ,'dyAP','dyBF','phy','dif',longname='dE/dt CAM physics + energy fixer using dycore E formula (dyAP-dyBF)')
409 0 : call cam_budget_em_register('dEdt_param_physE' ,'phAP','phBP','phy','dif',longname='dE/dt CAM physics using physics E formula (phAP-phBP)')
410 0 : call cam_budget_em_register('dEdt_param_dynE' ,'dyAP','dyBP','phy','dif',longname='dE/dt CAM physics using dycore E (dyAP-dyBP)')
411 0 : call cam_budget_em_register('dEdt_dme_adjust_physE','phAM','phAP','phy','dif',longname='dE/dt dry mass adjustment using physics E formula (phAM-phAP)')
412 0 : call cam_budget_em_register('dEdt_dme_adjust_dynE' ,'dyAM','dyAP','phy','dif',longname='dE/dt dry mass adjustment using dycore E (dyAM-dyAP)')
413 0 : call cam_budget_em_register('dEdt_efix_physE' ,'phBP','phBF','phy','dif',longname='dE/dt energy fixer using physics E formula (phBP-phBF)')
414 0 : call cam_budget_em_register('dEdt_efix_dynE' ,'dyBP','dyBF','phy','dif',longname='dE/dt energy fixer using dycore E formula (dyBP-dyBF)')
415 0 : call cam_budget_em_register('dEdt_phys_tot_physE' ,'phAM','phBF','phy','dif',longname='dE/dt physics total using physics E formula (phAM-phBF)')
416 0 : call cam_budget_em_register('dEdt_phys_tot_dynE' ,'dyAM','dyBF','phy','dif',longname='dE/dt physics total using dycore E (dyAM-dyBF)')
417 : endif
418 1536 : end subroutine diag_init_dry
419 :
420 1536 : subroutine diag_init_moist(pbuf2d)
421 :
422 : ! Declare the history fields for which this module contains outfld calls.
423 :
424 1536 : use cam_history, only: addfld, add_default, horiz_only
425 : use constituent_burden, only: constituent_burden_init
426 : use physics_buffer, only: pbuf_set_field
427 :
428 : type(physics_buffer_desc), pointer, intent(in) :: pbuf2d(:,:)
429 :
430 : integer :: m
431 : integer :: ixcldice, ixcldliq ! constituent indices for cloud liquid and ice water.
432 : integer :: ierr
433 : ! column burdens for all constituents except water vapor
434 1536 : call constituent_burden_init
435 :
436 1536 : call cnst_get_ind('CLDLIQ', ixcldliq, abort=.false.)
437 1536 : call cnst_get_ind('CLDICE', ixcldice, abort=.false.)
438 :
439 : ! outfld calls in diag_phys_writeout
440 3072 : call addfld ('OMEGAQ', (/ 'lev' /), 'A', 'kgPa/kgs', 'Vertical water transport' )
441 3072 : call addfld ('VQ', (/ 'lev' /), 'A', 'm/skg/kg', 'Meridional water transport')
442 3072 : call addfld ('QQ', (/ 'lev' /), 'A', 'kg2/kg2', 'Eddy moisture variance')
443 :
444 3072 : call addfld ('MQ', (/ 'lev' /), 'A', 'kg/m2','Water vapor mass in layer')
445 1536 : call addfld ('TMQ', horiz_only, 'A', 'kg/m2','Total (vertically integrated) precipitable water')
446 3072 : call addfld ('RELHUM', (/ 'lev' /), 'A', 'percent','Relative humidity')
447 3072 : call addfld ('RHW', (/ 'lev' /), 'A', 'percent','Relative humidity with respect to liquid')
448 3072 : call addfld ('RHI', (/ 'lev' /), 'A', 'percent','Relative humidity with respect to ice')
449 3072 : call addfld ('RHCFMIP', (/ 'lev' /), 'A', 'percent','Relative humidity with respect to water above 273 K, ice below 273 K')
450 :
451 1536 : call addfld ('IVT', horiz_only, 'A', 'kg/m/s','Total (vertically integrated) vapor transport')
452 1536 : call addfld ('uIVT', horiz_only, 'A', 'kg/m/s','u-component (vertically integrated) vapor transport')
453 1536 : call addfld ('vIVT', horiz_only, 'A', 'kg/m/s','v-component (vertically integrated) vapor transport')
454 :
455 1536 : call addfld ('THE8501000', horiz_only, 'A', 'K','ThetaE difference 850 mb - 1000 mb')
456 1536 : call addfld ('THE9251000', horiz_only, 'A', 'K','ThetaE difference 925 mb - 1000 mb')
457 :
458 1536 : call addfld ('Q1000', horiz_only, 'A', 'kg/kg','Specific Humidity at 1000 mbar pressure surface')
459 1536 : call addfld ('Q925', horiz_only, 'A', 'kg/kg','Specific Humidity at 925 mbar pressure surface')
460 1536 : call addfld ('Q850', horiz_only, 'A', 'kg/kg','Specific Humidity at 850 mbar pressure surface')
461 1536 : call addfld ('Q200', horiz_only, 'A', 'kg/kg','Specific Humidity at 200 mbar pressure surface')
462 1536 : call addfld ('QBOT', horiz_only, 'A', 'kg/kg','Lowest model level water vapor mixing ratio')
463 :
464 1536 : call addfld ('PSDRY', horiz_only, 'A', 'Pa', 'Dry surface pressure')
465 3072 : call addfld ('PMID', (/ 'lev' /), 'A', 'Pa', 'Pressure at layer midpoints')
466 3072 : call addfld ('PINT', (/ 'ilev' /), 'A', 'Pa', 'Pressure at layer interfaces')
467 3072 : call addfld ('PDELDRY', (/ 'lev' /), 'A', 'Pa', 'Dry pressure difference between levels')
468 3072 : call addfld ('PDEL', (/ 'lev' /), 'A', 'Pa', 'Pressure difference between levels')
469 :
470 : ! outfld calls in diag_conv
471 :
472 3072 : call addfld ('DTCOND', (/ 'lev' /), 'A','K/s','T tendency - moist processes')
473 3072 : call addfld ('DTCOND_24_COS',(/ 'lev' /), 'A','K/s','T tendency - moist processes 24hr. cos coeff.')
474 3072 : call addfld ('DTCOND_24_SIN',(/ 'lev' /), 'A','K/s','T tendency - moist processes 24hr. sin coeff.')
475 3072 : call addfld ('DTCOND_12_COS',(/ 'lev' /), 'A','K/s','T tendency - moist processes 12hr. cos coeff.')
476 3072 : call addfld ('DTCOND_12_SIN',(/ 'lev' /), 'A','K/s','T tendency - moist processes 12hr. sin coeff.')
477 3072 : call addfld ('DTCOND_08_COS',(/ 'lev' /), 'A','K/s','T tendency - moist processes 8hr. cos coeff.')
478 3072 : call addfld ('DTCOND_08_SIN',(/ 'lev' /), 'A','K/s','T tendency - moist processes 8hr. sin coeff.')
479 :
480 1536 : call addfld ('PRECL', horiz_only, 'A', 'm/s','Large-scale (stable) precipitation rate (liq + ice)' )
481 1536 : call addfld ('PRECC', horiz_only, 'A', 'm/s','Convective precipitation rate (liq + ice)' )
482 1536 : call addfld ('PRECT', horiz_only, 'A', 'm/s','Total (convective and large-scale) precipitation rate (liq + ice)' )
483 1536 : call addfld ('PREC_PCW', horiz_only, 'A', 'm/s','LS_pcw precipitation rate')
484 1536 : call addfld ('PREC_zmc', horiz_only, 'A', 'm/s','CV_zmc precipitation rate')
485 1536 : call addfld ('PRECTMX', horiz_only, 'X','m/s','Maximum (convective and large-scale) precipitation rate (liq+ice)' )
486 1536 : call addfld ('PRECSL', horiz_only, 'A', 'm/s','Large-scale (stable) snow rate (water equivalent)' )
487 1536 : call addfld ('PRECSC', horiz_only, 'A', 'm/s','Convective snow rate (water equivalent)' )
488 1536 : call addfld ('PRECCav', horiz_only, 'A', 'm/s','Average large-scale precipitation (liq + ice)' )
489 1536 : call addfld ('PRECLav', horiz_only, 'A', 'm/s','Average convective precipitation (liq + ice)' )
490 :
491 : ! outfld calls in diag_surf
492 :
493 1536 : call addfld ('SHFLX', horiz_only, 'A', 'W/m2','Surface sensible heat flux')
494 1536 : call addfld ('LHFLX', horiz_only, 'A', 'W/m2','Surface latent heat flux')
495 1536 : call addfld ('QFLX', horiz_only, 'A', 'kg/m2/s','Surface water flux')
496 :
497 1536 : call addfld ('TAUX', horiz_only, 'A', 'N/m2','Zonal surface stress')
498 1536 : call addfld ('TAUY', horiz_only, 'A', 'N/m2','Meridional surface stress')
499 1536 : call addfld ('TREFHT', horiz_only, 'A', 'K','Reference height temperature')
500 1536 : call addfld ('TREFHTMN', horiz_only, 'M','K','Minimum reference height temperature over output period')
501 1536 : call addfld ('TREFHTMX', horiz_only, 'X','K','Maximum reference height temperature over output period')
502 1536 : call addfld ('QREFHT', horiz_only, 'A', 'kg/kg','Reference height humidity')
503 1536 : call addfld ('U10', horiz_only, 'A', 'm/s','10m wind speed')
504 1536 : call addfld ('UGUST', horiz_only, 'A', 'm/s','Gustiness term added to U10')
505 1536 : call addfld ('U10WITHGUSTS',horiz_only, 'A', 'm/s','10m wind speed with gustiness added')
506 1536 : call addfld ('RHREFHT', horiz_only, 'A', 'fraction','Reference height relative humidity')
507 :
508 1536 : call addfld ('LANDFRAC', horiz_only, 'A', 'fraction','Fraction of sfc area covered by land')
509 1536 : call addfld ('ICEFRAC', horiz_only, 'A', 'fraction','Fraction of sfc area covered by sea-ice')
510 1536 : call addfld ('OCNFRAC', horiz_only, 'A', 'fraction','Fraction of sfc area covered by ocean')
511 :
512 1536 : call addfld ('TREFMNAV', horiz_only, 'A', 'K','Average of TREFHT daily minimum')
513 1536 : call addfld ('TREFMXAV', horiz_only, 'A', 'K','Average of TREFHT daily maximum')
514 :
515 1536 : call addfld ('TS', horiz_only, 'A', 'K','Surface temperature (radiative)')
516 1536 : call addfld ('TSMN', horiz_only, 'M','K','Minimum surface temperature over output period')
517 1536 : call addfld ('TSMX', horiz_only, 'X','K','Maximum surface temperature over output period')
518 1536 : call addfld ('SNOWHLND', horiz_only, 'A', 'm','Water equivalent snow depth')
519 1536 : call addfld ('SNOWHICE', horiz_only, 'A', 'm','Snow depth over ice', fill_value = 1.e30_r8)
520 1536 : call addfld ('TBOT', horiz_only, 'A', 'K','Lowest model level temperature')
521 :
522 1536 : call addfld ('ASDIR', horiz_only, 'A', '1','albedo: shortwave, direct')
523 1536 : call addfld ('ASDIF', horiz_only, 'A', '1','albedo: shortwave, diffuse')
524 1536 : call addfld ('ALDIR', horiz_only, 'A', '1','albedo: longwave, direct')
525 1536 : call addfld ('ALDIF', horiz_only, 'A', '1','albedo: longwave, diffuse')
526 1536 : call addfld ('SST', horiz_only, 'A', 'K','sea surface temperature')
527 :
528 :
529 : ! outfld calls in diag_phys_tend_writeout
530 :
531 3072 : call addfld (ptendnam( 1),(/ 'lev' /), 'A', 'kg/kg/s',trim(cnst_name( 1))//' total physics tendency ' )
532 :
533 1536 : if (ixcldliq > 0) then
534 3072 : call addfld (ptendnam(ixcldliq),(/ 'lev' /), 'A', 'kg/kg/s',trim(cnst_name(ixcldliq))//' total physics tendency ' )
535 : end if
536 1536 : if (ixcldice > 0) then
537 3072 : call addfld (ptendnam(ixcldice),(/ 'lev' /), 'A', 'kg/kg/s',trim(cnst_name(ixcldice))//' total physics tendency ')
538 : end if
539 :
540 : ! outfld calls in diag_physvar_ic
541 :
542 3072 : call addfld ('QCWAT&IC', (/ 'lev' /), 'I','kg/kg','q associated with cloud water' )
543 3072 : call addfld ('TCWAT&IC', (/ 'lev' /), 'I','kg/kg','T associated with cloud water' )
544 3072 : call addfld ('LCWAT&IC', (/ 'lev' /), 'I','kg/kg','Cloud water (ice + liq' )
545 3072 : call addfld ('CLOUD&IC', (/ 'lev' /), 'I','fraction','Cloud fraction' )
546 3072 : call addfld ('CONCLD&IC', (/ 'lev' /), 'I','fraction','Convective cloud fraction' )
547 3072 : call addfld ('TKE&IC', (/ 'ilev' /), 'I','m2/s2','Turbulent Kinetic Energy' )
548 1536 : call addfld ('CUSH&IC', horiz_only, 'I','m','Convective Scale Height' )
549 3072 : call addfld ('KVH&IC', (/ 'ilev' /), 'I','m2/s','Vertical diffusion diffusivities (heat/moisture)' )
550 3072 : call addfld ('KVM&IC', (/ 'ilev' /), 'I','m2/s','Vertical diffusion diffusivities (momentum)' )
551 1536 : call addfld ('PBLH&IC', horiz_only, 'I','m','PBL height' )
552 1536 : call addfld ('TPERT&IC', horiz_only, 'I','K','Perturbation temperature (eddies in PBL)' )
553 1536 : call addfld ('QPERT&IC', horiz_only, 'I','kg/kg','Perturbation specific humidity (eddies in PBL)' )
554 :
555 : ! CAM export state
556 1536 : call addfld('a2x_BCPHIWET', horiz_only, 'A', 'kg/m2/s', 'wetdep of hydrophilic black carbon')
557 1536 : call addfld('a2x_BCPHIDRY', horiz_only, 'A', 'kg/m2/s', 'drydep of hydrophilic black carbon')
558 1536 : call addfld('a2x_BCPHODRY', horiz_only, 'A', 'kg/m2/s', 'drydep of hydrophobic black carbon')
559 1536 : call addfld('a2x_OCPHIWET', horiz_only, 'A', 'kg/m2/s', 'wetdep of hydrophilic organic carbon')
560 1536 : call addfld('a2x_OCPHIDRY', horiz_only, 'A', 'kg/m2/s', 'drydep of hydrophilic organic carbon')
561 1536 : call addfld('a2x_OCPHODRY', horiz_only, 'A', 'kg/m2/s', 'drydep of hydrophobic organic carbon')
562 1536 : call addfld('a2x_DSTWET1', horiz_only, 'A', 'kg/m2/s', 'wetdep of dust (bin1)')
563 1536 : call addfld('a2x_DSTDRY1', horiz_only, 'A', 'kg/m2/s', 'drydep of dust (bin1)')
564 1536 : call addfld('a2x_DSTWET2', horiz_only, 'A', 'kg/m2/s', 'wetdep of dust (bin2)')
565 1536 : call addfld('a2x_DSTDRY2', horiz_only, 'A', 'kg/m2/s', 'drydep of dust (bin2)')
566 1536 : call addfld('a2x_DSTWET3', horiz_only, 'A', 'kg/m2/s', 'wetdep of dust (bin3)')
567 1536 : call addfld('a2x_DSTDRY3', horiz_only, 'A', 'kg/m2/s', 'drydep of dust (bin3)')
568 1536 : call addfld('a2x_DSTWET4', horiz_only, 'A', 'kg/m2/s', 'wetdep of dust (bin4)')
569 1536 : call addfld('a2x_DSTDRY4', horiz_only, 'A', 'kg/m2/s', 'drydep of dust (bin4)')
570 :
571 : ! defaults
572 1536 : if (history_amwg) then
573 1536 : call add_default (cnst_name(1), 1, ' ')
574 1536 : call add_default ('VQ ', 1, ' ')
575 1536 : call add_default ('TMQ ', 1, ' ')
576 1536 : call add_default ('PSL ', 1, ' ')
577 1536 : call add_default ('RELHUM ', 1, ' ')
578 :
579 1536 : call add_default ('DTCOND ', 1, ' ')
580 1536 : call add_default ('PRECL ', 1, ' ')
581 1536 : call add_default ('PRECC ', 1, ' ')
582 1536 : call add_default ('PRECSL ', 1, ' ')
583 1536 : call add_default ('PRECSC ', 1, ' ')
584 1536 : call add_default ('SHFLX ', 1, ' ')
585 1536 : call add_default ('LHFLX ', 1, ' ')
586 1536 : call add_default ('QFLX ', 1, ' ')
587 1536 : call add_default ('TAUX ', 1, ' ')
588 1536 : call add_default ('TAUY ', 1, ' ')
589 1536 : call add_default ('TREFHT ', 1, ' ')
590 1536 : call add_default ('LANDFRAC', 1, ' ')
591 1536 : call add_default ('OCNFRAC ', 1, ' ')
592 1536 : call add_default ('QREFHT ', 1, ' ')
593 1536 : call add_default ('U10 ', 1, ' ')
594 1536 : call add_default ('ICEFRAC ', 1, ' ')
595 1536 : call add_default ('TS ', 1, ' ')
596 1536 : call add_default ('TSMN ', 1, ' ')
597 1536 : call add_default ('TSMX ', 1, ' ')
598 1536 : call add_default ('SNOWHLND', 1, ' ')
599 1536 : call add_default ('SNOWHICE', 1, ' ')
600 : end if
601 :
602 1536 : if (dycore_is('SE')) then
603 1536 : call add_default ('PSDRY', 1, ' ')
604 1536 : call add_default ('PMID', 1, ' ')
605 : end if
606 :
607 1536 : if (dycore_is('MPAS')) then
608 0 : call add_default ('PINT', 1, ' ')
609 0 : call add_default ('PMID', 1, ' ')
610 0 : call add_default ('PDEL', 1, ' ')
611 : end if
612 :
613 1536 : if (history_eddy) then
614 0 : call add_default ('VQ ', 1, ' ')
615 : endif
616 :
617 1536 : if ( history_budget ) then
618 0 : call add_default (cnst_name(1), history_budget_histfile_num, ' ')
619 0 : call add_default ('PTTEND' , history_budget_histfile_num, ' ')
620 0 : call add_default ('UTEND_PHYSTOT' , history_budget_histfile_num, ' ')
621 0 : call add_default ('VTEND_PHYSTOT' , history_budget_histfile_num, ' ')
622 0 : call add_default (ptendnam( 1), history_budget_histfile_num, ' ')
623 0 : if (ixcldliq > 0) then
624 0 : call add_default (ptendnam(ixcldliq), history_budget_histfile_num, ' ')
625 : end if
626 0 : if (ixcldice > 0) then
627 0 : call add_default (ptendnam(ixcldice), history_budget_histfile_num, ' ')
628 : end if
629 0 : if( history_budget_histfile_num > 1 ) then
630 0 : call add_default ('DTCOND ' , history_budget_histfile_num, ' ')
631 : end if
632 : end if
633 :
634 1536 : if (history_vdiag) then
635 0 : call add_default ('PRECT ', 2, ' ')
636 0 : call add_default ('PRECT ', 3, ' ')
637 0 : call add_default ('PRECT ', 4, ' ')
638 : end if
639 :
640 : ! Initial file - Optional fields
641 1536 : if (inithist_all.or.single_column) then
642 0 : call add_default ('CONCLD&IC ',0, 'I')
643 0 : call add_default ('QCWAT&IC ',0, 'I')
644 0 : call add_default ('TCWAT&IC ',0, 'I')
645 0 : call add_default ('LCWAT&IC ',0, 'I')
646 0 : call add_default ('PBLH&IC ',0, 'I')
647 0 : call add_default ('TPERT&IC ',0, 'I')
648 0 : call add_default ('QPERT&IC ',0, 'I')
649 0 : call add_default ('CLOUD&IC ',0, 'I')
650 0 : call add_default ('TKE&IC ',0, 'I')
651 0 : call add_default ('CUSH&IC ',0, 'I')
652 0 : call add_default ('KVH&IC ',0, 'I')
653 0 : call add_default ('KVM&IC ',0, 'I')
654 : end if
655 :
656 : ! determine number of constituents for which convective tendencies must be computed
657 1536 : if (history_budget) then
658 0 : dqcond_num = pcnst
659 : else
660 1536 : if (diag_cnst_conv_tend == 'none') dqcond_num = 0
661 1536 : if (diag_cnst_conv_tend == 'q_only') dqcond_num = 1
662 1536 : if (diag_cnst_conv_tend == 'all') dqcond_num = pcnst
663 : end if
664 :
665 3072 : do m = 1, dqcond_num
666 3072 : dcconnam(m) = 'DC'//cnst_name(m)
667 : end do
668 :
669 1536 : if ((diag_cnst_conv_tend == 'q_only') .or. (diag_cnst_conv_tend == 'all') .or. history_budget) then
670 3072 : call addfld (dcconnam(1),(/ 'lev' /),'A', 'kg/kg/s',trim(cnst_name(1))//' tendency due to moist processes')
671 1536 : if ( diag_cnst_conv_tend == 'q_only' .or. diag_cnst_conv_tend == 'all' ) then
672 1536 : call add_default (dcconnam(1), 1, ' ')
673 : end if
674 1536 : if( history_budget ) then
675 0 : call add_default (dcconnam(1), history_budget_histfile_num, ' ')
676 : end if
677 1536 : if (diag_cnst_conv_tend == 'all' .or. history_budget) then
678 0 : do m = 2, pcnst
679 0 : call addfld (dcconnam(m),(/ 'lev' /),'A', 'kg/kg/s',trim(cnst_name(m))//' tendency due to moist processes')
680 0 : if( diag_cnst_conv_tend == 'all' ) then
681 0 : call add_default (dcconnam(m), 1, ' ')
682 : end if
683 0 : if( history_budget .and. (m == ixcldliq .or. m == ixcldice) ) then
684 : call add_default (dcconnam(m), history_budget_histfile_num, ' ')
685 : end if
686 : end do
687 : end if
688 : end if
689 :
690 : ! Pbuf field indices for collecting output data
691 1536 : relhum_idx = pbuf_get_index('RELHUM', errcode=ierr)
692 1536 : qcwat_idx = pbuf_get_index('QCWAT', errcode=ierr)
693 1536 : tcwat_idx = pbuf_get_index('TCWAT', errcode=ierr)
694 1536 : lcwat_idx = pbuf_get_index('LCWAT', errcode=ierr)
695 1536 : cld_idx = pbuf_get_index('CLD', errcode=ierr)
696 1536 : concld_idx = pbuf_get_index('CONCLD', errcode=ierr)
697 :
698 1536 : tke_idx = pbuf_get_index('tke', errcode=ierr)
699 1536 : kvm_idx = pbuf_get_index('kvm', errcode=ierr)
700 1536 : kvh_idx = pbuf_get_index('kvh', errcode=ierr)
701 1536 : cush_idx = pbuf_get_index('cush', errcode=ierr)
702 :
703 1536 : pblh_idx = pbuf_get_index('pblh', errcode=ierr)
704 1536 : tpert_idx = pbuf_get_index('tpert', errcode=ierr)
705 1536 : qpert_idx = pbuf_get_index('qpert', errcode=ierr)
706 :
707 1536 : prec_dp_idx = pbuf_get_index('PREC_DP', errcode=ierr)
708 1536 : snow_dp_idx = pbuf_get_index('SNOW_DP', errcode=ierr)
709 1536 : prec_sh_idx = pbuf_get_index('PREC_SH', errcode=ierr)
710 1536 : snow_sh_idx = pbuf_get_index('SNOW_SH', errcode=ierr)
711 1536 : prec_sed_idx = pbuf_get_index('PREC_SED', errcode=ierr)
712 1536 : snow_sed_idx = pbuf_get_index('SNOW_SED', errcode=ierr)
713 1536 : prec_pcw_idx = pbuf_get_index('PREC_PCW', errcode=ierr)
714 1536 : snow_pcw_idx = pbuf_get_index('SNOW_PCW', errcode=ierr)
715 :
716 1536 : if (is_first_step()) then
717 768 : call pbuf_set_field(pbuf2d, trefmxav_idx, -1.0e36_r8)
718 768 : call pbuf_set_field(pbuf2d, trefmnav_idx, 1.0e36_r8)
719 : end if
720 :
721 1536 : end subroutine diag_init_moist
722 :
723 1536 : subroutine diag_init(pbuf2d)
724 :
725 : ! Declare the history fields for which this module contains outfld calls.
726 :
727 : type(physics_buffer_desc), pointer, intent(in) :: pbuf2d(:,:)
728 :
729 : ! ----------------------------
730 : ! determine default variables
731 : ! ----------------------------
732 : call phys_getopts(history_amwg_out = history_amwg , &
733 : history_vdiag_out = history_vdiag , &
734 : history_eddy_out = history_eddy , &
735 : history_budget_out = history_budget , &
736 : history_budget_histfile_num_out = history_budget_histfile_num, &
737 1536 : history_waccm_out = history_waccm)
738 :
739 1536 : call diag_init_dry(pbuf2d)
740 1536 : if (moist_physics) then
741 1536 : call diag_init_moist(pbuf2d)
742 : end if
743 :
744 1536 : end subroutine diag_init
745 :
746 : !===============================================================================
747 :
748 370944 : subroutine diag_allocate_dry()
749 : use infnan, only: nan, assignment(=)
750 :
751 : ! Allocate memory for module variables.
752 : ! Done at the begining of a physics step at same point as the pbuf allocate
753 : ! for variables with "physpkg" scope.
754 :
755 : ! Local variables
756 : character(len=*), parameter :: sub = 'diag_allocate_dry'
757 : character(len=128) :: errmsg
758 : integer :: istat
759 :
760 1112832 : allocate(dtcond(pcols,pver,begchunk:endchunk), stat=istat)
761 370944 : if ( istat /= 0 ) then
762 0 : write(errmsg, '(2a,i0)') sub, ': allocate failed, stat = ',istat
763 0 : call endrun (errmsg)
764 : end if
765 370944 : dtcond = nan
766 370944 : end subroutine diag_allocate_dry
767 :
768 370944 : subroutine diag_allocate_moist()
769 : use infnan, only: nan, assignment(=)
770 :
771 : ! Allocate memory for module variables.
772 : ! Done at the begining of a physics step at same point as the pbuf allocate
773 : ! for variables with "physpkg" scope.
774 :
775 : ! Local variables
776 : character(len=*), parameter :: sub = 'diag_allocate_moist'
777 : character(len=128) :: errmsg
778 : integer :: i, istat
779 :
780 370944 : if (dqcond_num > 0) then
781 1483776 : allocate(dqcond(dqcond_num))
782 741888 : do i = 1, dqcond_num
783 1112832 : allocate(dqcond(i)%cnst(pcols,pver,begchunk:endchunk), stat=istat)
784 370944 : if ( istat /= 0 ) then
785 0 : write(errmsg, '(2a,i0)') sub, ': allocate failed, stat = ',istat
786 0 : call endrun (errmsg)
787 : end if
788 741888 : dqcond(i)%cnst = nan
789 : end do
790 : end if
791 :
792 370944 : end subroutine diag_allocate_moist
793 :
794 370944 : subroutine diag_allocate()
795 :
796 370944 : call diag_allocate_dry()
797 370944 : if (moist_physics) then
798 370944 : call diag_allocate_moist()
799 : end if
800 :
801 370944 : end subroutine diag_allocate
802 :
803 : !===============================================================================
804 :
805 369408 : subroutine diag_deallocate_dry()
806 : ! Deallocate memory for module variables.
807 : ! Done at the end of a physics step at same point as the pbuf deallocate for
808 : ! variables with "physpkg" scope.
809 :
810 : ! Local variables
811 : character(len=*), parameter :: sub = 'diag_deallocate_dry'
812 : integer :: istat
813 :
814 369408 : deallocate(dtcond, stat=istat)
815 0 : if ( istat /= 0 ) call endrun (sub//': ERROR: deallocate failed')
816 369408 : end subroutine diag_deallocate_dry
817 :
818 369408 : subroutine diag_deallocate_moist()
819 :
820 : ! Deallocate memory for module variables.
821 : ! Done at the end of a physics step at same point as the pbuf deallocate for
822 : ! variables with "physpkg" scope.
823 :
824 : ! Local variables
825 : character(len=*), parameter :: sub = 'diag_deallocate_moist'
826 : integer :: i, istat
827 :
828 369408 : if (dqcond_num > 0) then
829 738816 : do i = 1, dqcond_num
830 369408 : deallocate(dqcond(i)%cnst, stat=istat)
831 369408 : if ( istat /= 0 ) call endrun (sub//': ERROR: deallocate failed')
832 : end do
833 738816 : deallocate(dqcond, stat=istat)
834 0 : if ( istat /= 0 ) call endrun (sub//': ERROR: deallocate failed')
835 : end if
836 369408 : end subroutine diag_deallocate_moist
837 :
838 369408 : subroutine diag_deallocate()
839 :
840 369408 : call diag_deallocate_dry()
841 369408 : if (moist_physics) then
842 369408 : call diag_deallocate_moist()
843 : end if
844 :
845 369408 : end subroutine diag_deallocate
846 :
847 : !===============================================================================
848 :
849 1495368 : subroutine diag_conv_tend_ini(state,pbuf)
850 :
851 : ! Initialize convective tendency calcs.
852 :
853 : ! Arguments:
854 : type(physics_state), intent(in) :: state
855 : type(physics_buffer_desc), pointer :: pbuf(:)
856 :
857 : ! Local variables:
858 :
859 : integer :: i, k, m, lchnk, ncol
860 1495368 : real(r8), pointer, dimension(:,:) :: t_ttend
861 1495368 : real(r8), pointer, dimension(:,:) :: t_utend
862 1495368 : real(r8), pointer, dimension(:,:) :: t_vtend
863 :
864 1495368 : lchnk = state%lchnk
865 1495368 : ncol = state%ncol
866 :
867 140564592 : do k = 1, pver
868 2323627992 : do i = 1, ncol
869 2322132624 : dtcond(i,k,lchnk) = state%t(i,k)
870 : end do
871 : end do
872 :
873 2990736 : do m = 1, dqcond_num
874 142059960 : do k = 1, pver
875 2323627992 : do i = 1, ncol
876 2322132624 : dqcond(m)%cnst(i,k,lchnk) = state%q(i,k,m)
877 : end do
878 : end do
879 : end do
880 :
881 : !! initialize to pbuf T_TTEND to temperature at first timestep
882 1495368 : if (is_first_step()) then
883 6192 : do m = 1, dyn_time_lvls
884 12384 : call pbuf_get_field(pbuf, t_ttend_idx, t_ttend, start=(/1,1,m/), kount=(/pcols,pver,1/))
885 4810824 : t_ttend(:ncol,:) = state%t(:ncol,:)
886 12384 : call pbuf_get_field(pbuf, t_utend_idx, t_utend, start=(/1,1,m/), kount=(/pcols,pver,1/))
887 4810824 : t_utend(:ncol,:) = state%u(:ncol,:)
888 12384 : call pbuf_get_field(pbuf, t_vtend_idx, t_vtend, start=(/1,1,m/), kount=(/pcols,pver,1/))
889 4813920 : t_vtend(:ncol,:) = state%v(:ncol,:)
890 : end do
891 : end if
892 :
893 1495368 : end subroutine diag_conv_tend_ini
894 :
895 : !===============================================================================
896 :
897 1489176 : subroutine diag_phys_writeout_dry(state, pbuf, p_surf_t)
898 :
899 : !-----------------------------------------------------------------------
900 : !
901 : ! Purpose: output dry physics diagnostics
902 : !
903 : !-----------------------------------------------------------------------
904 : use physconst, only: gravit, rga, rair, cappa
905 : use time_manager, only: get_nstep
906 : use interpolate_data, only: vertinterp
907 : use tidal_diag, only: tidal_diag_write
908 : use air_composition, only: cpairv, rairv
909 : use cam_diagnostic_utils, only: cpslec
910 : !-----------------------------------------------------------------------
911 : !
912 : ! Arguments
913 : !
914 : type(physics_state), intent(inout) :: state
915 : type(physics_buffer_desc), pointer :: pbuf(:)
916 : real(r8), intent(out) :: p_surf_t(pcols, nsurf) ! data interpolated to a pressure surface
917 : !
918 : !---------------------------Local workspace-----------------------------
919 : !
920 : real(r8) :: ftem(pcols,pver) ! temporary workspace
921 : real(r8) :: z3(pcols,pver) ! geo-potential height
922 : real(r8) :: p_surf(pcols) ! data interpolated to a pressure surface
923 : real(r8) :: timestep(pcols) ! used for outfld call
924 :
925 1489176 : real(r8), pointer :: psl(:) ! Sea Level Pressure
926 :
927 : integer :: i, k, m, lchnk, ncol, nstep
928 : !
929 : !-----------------------------------------------------------------------
930 : !
931 1489176 : lchnk = state%lchnk
932 1489176 : ncol = state%ncol
933 :
934 : ! Output NSTEP for debugging
935 2978352 : nstep = get_nstep()
936 24865776 : timestep(:ncol) = nstep
937 1489176 : call outfld ('NSTEP ',timestep, pcols, lchnk)
938 :
939 1489176 : call outfld('T ',state%t , pcols ,lchnk )
940 1489176 : call outfld('PS ',state%ps, pcols ,lchnk )
941 1489176 : call outfld('U ',state%u , pcols ,lchnk )
942 1489176 : call outfld('V ',state%v , pcols ,lchnk )
943 :
944 1489176 : call outfld('PHIS ',state%phis, pcols, lchnk )
945 :
946 1489176 : if (write_camiop) call outfld('phis ',state%phis, pcols, lchnk )
947 :
948 543653136 : call outfld( 'CPAIRV', cpairv(:ncol,:,lchnk), ncol, lchnk )
949 543653136 : call outfld( 'RAIRV', rairv(:ncol,:,lchnk), ncol, lchnk )
950 :
951 62545392 : do m = 1, pcnst
952 62545392 : if (cnst_cam_outfld(m)) then
953 16380936 : call outfld(cnst_name(m), state%q(1,1,m), pcols, lchnk)
954 : end if
955 : end do
956 :
957 : !
958 : ! Add height of surface to midpoint height above surface
959 : !
960 139982544 : do k = 1, pver
961 2314006344 : z3(:ncol,k) = state%zm(:ncol,k) + state%phis(:ncol)*rga
962 : end do
963 1489176 : call outfld('Z3 ',z3,pcols,lchnk)
964 : !
965 : ! Output Z3 on pressure surfaces
966 : !
967 1489176 : if (hist_fld_active('Z1000')) then
968 : call vertinterp(ncol, pcols, pver, state%pmid, 100000._r8, z3, p_surf, &
969 0 : extrapolate='Z', ln_interp=.true., ps=state%ps, phis=state%phis, tbot=state%t(:,pver))
970 0 : call outfld('Z1000 ', p_surf, pcols, lchnk)
971 : end if
972 1489176 : if (hist_fld_active('Z700')) then
973 : call vertinterp(ncol, pcols, pver, state%pmid, 70000._r8, z3, p_surf, &
974 0 : extrapolate='Z', ln_interp=.true., ps=state%ps, phis=state%phis, tbot=state%t(:,pver))
975 0 : call outfld('Z700 ', p_surf, pcols, lchnk)
976 : end if
977 1489176 : if (hist_fld_active('Z500')) then
978 : call vertinterp(ncol, pcols, pver, state%pmid, 50000._r8, z3, p_surf, &
979 0 : extrapolate='Z', ln_interp=.true., ps=state%ps, phis=state%phis, tbot=state%t(:,pver))
980 0 : call outfld('Z500 ', p_surf, pcols, lchnk)
981 : end if
982 1489176 : if (hist_fld_active('Z300')) then
983 0 : call vertinterp(ncol, pcols, pver, state%pmid, 30000._r8, z3, p_surf, ln_interp=.true.)
984 0 : call outfld('Z300 ', p_surf, pcols, lchnk)
985 : end if
986 1489176 : if (hist_fld_active('Z200')) then
987 0 : call vertinterp(ncol, pcols, pver, state%pmid, 20000._r8, z3, p_surf, ln_interp=.true.)
988 0 : call outfld('Z200 ', p_surf, pcols, lchnk)
989 : end if
990 1489176 : if (hist_fld_active('Z100')) then
991 0 : call vertinterp(ncol, pcols, pver, state%pmid, 10000._r8, z3, p_surf, ln_interp=.true.)
992 0 : call outfld('Z100 ', p_surf, pcols, lchnk)
993 : end if
994 1489176 : if (hist_fld_active('Z050')) then
995 0 : call vertinterp(ncol, pcols, pver, state%pmid, 5000._r8, z3, p_surf, ln_interp=.true.)
996 0 : call outfld('Z050 ', p_surf, pcols, lchnk)
997 : end if
998 : !
999 : ! Quadratic height fiels Z3*Z3
1000 : !
1001 2314006344 : ftem(:ncol,:) = z3(:ncol,:)*z3(:ncol,:)
1002 1489176 : call outfld('ZZ ',ftem,pcols,lchnk)
1003 :
1004 2314006344 : ftem(:ncol,:) = z3(:ncol,:)*state%v(:ncol,:)
1005 1489176 : call outfld('VZ ',ftem, pcols,lchnk)
1006 : !
1007 : ! Meridional advection fields
1008 : !
1009 2314006344 : ftem(:ncol,:) = state%v(:ncol,:)*state%t(:ncol,:)
1010 1489176 : call outfld ('VT ',ftem ,pcols ,lchnk )
1011 :
1012 2314006344 : ftem(:ncol,:) = state%v(:ncol,:)**2
1013 1489176 : call outfld ('VV ',ftem ,pcols ,lchnk )
1014 :
1015 2314006344 : ftem(:ncol,:) = state%v(:ncol,:) * state%u(:ncol,:)
1016 1489176 : call outfld ('VU ',ftem ,pcols ,lchnk )
1017 : !
1018 : ! zonal advection
1019 : !
1020 2314006344 : ftem(:ncol,:) = state%u(:ncol,:)**2
1021 1489176 : call outfld ('UU ',ftem ,pcols ,lchnk )
1022 :
1023 : ! Wind speed
1024 2314006344 : ftem(:ncol,:) = sqrt( state%u(:ncol,:)**2 + state%v(:ncol,:)**2)
1025 1489176 : call outfld ('WSPEED ',ftem ,pcols ,lchnk )
1026 1489176 : call outfld ('WSPDSRFMX',ftem(:,pver) ,pcols ,lchnk )
1027 1489176 : call outfld ('WSPDSRFAV',ftem(:,pver) ,pcols ,lchnk )
1028 :
1029 : ! Vertical velocity and advection
1030 :
1031 1489176 : if (single_column) then
1032 0 : call outfld('OMEGA ',wfld, pcols, lchnk )
1033 : else
1034 1489176 : call outfld('OMEGA ',state%omega, pcols, lchnk )
1035 : endif
1036 :
1037 1489176 : if (write_camiop) call outfld('omega ',state%omega, pcols, lchnk )
1038 :
1039 2314006344 : ftem(:ncol,:) = state%omega(:ncol,:)*state%t(:ncol,:)
1040 1489176 : call outfld('OMEGAT ',ftem, pcols, lchnk )
1041 2314006344 : ftem(:ncol,:) = state%omega(:ncol,:)*state%u(:ncol,:)
1042 1489176 : call outfld('OMEGAU ',ftem, pcols, lchnk )
1043 2314006344 : ftem(:ncol,:) = state%omega(:ncol,:)*state%v(:ncol,:)
1044 1489176 : call outfld('OMEGAV ',ftem, pcols, lchnk )
1045 2314006344 : ftem(:ncol,:) = state%omega(:ncol,:)*state%omega(:ncol,:)
1046 1489176 : call outfld('OMGAOMGA',ftem, pcols, lchnk )
1047 : !
1048 : ! Output omega at 850 and 500 mb pressure levels
1049 : !
1050 1489176 : if (hist_fld_active('OMEGA850')) then
1051 0 : call vertinterp(ncol, pcols, pver, state%pmid, 85000._r8, state%omega, p_surf)
1052 0 : call outfld('OMEGA850', p_surf, pcols, lchnk)
1053 : end if
1054 1489176 : if (hist_fld_active('OMEGA500')) then
1055 0 : call vertinterp(ncol, pcols, pver, state%pmid, 50000._r8, state%omega, p_surf)
1056 0 : call outfld('OMEGA500', p_surf, pcols, lchnk)
1057 : end if
1058 :
1059 : ! Sea level pressure
1060 1489176 : call pbuf_get_field(pbuf, psl_idx, psl)
1061 1489176 : call cpslec(ncol, state%pmid, state%phis, state%ps, state%t, psl, gravit, rair)
1062 1489176 : call outfld('PSL', psl, pcols, lchnk)
1063 :
1064 : ! Output T,u,v fields on pressure surfaces
1065 : !
1066 1489176 : if (hist_fld_active('T850')) then
1067 : call vertinterp(ncol, pcols, pver, state%pmid, 85000._r8, state%t, p_surf, &
1068 0 : extrapolate='T', ps=state%ps, phis=state%phis)
1069 0 : call outfld('T850 ', p_surf, pcols, lchnk )
1070 : end if
1071 1489176 : if (hist_fld_active('T500')) then
1072 : call vertinterp(ncol, pcols, pver, state%pmid, 50000._r8, state%t, p_surf, &
1073 0 : extrapolate='T', ps=state%ps, phis=state%phis)
1074 0 : call outfld('T500 ', p_surf, pcols, lchnk )
1075 : end if
1076 1489176 : if (hist_fld_active('T400')) then
1077 : call vertinterp(ncol, pcols, pver, state%pmid, 40000._r8, state%t, p_surf, &
1078 0 : extrapolate='T', ps=state%ps, phis=state%phis)
1079 0 : call outfld('T400 ', p_surf, pcols, lchnk )
1080 : end if
1081 1489176 : if (hist_fld_active('T300')) then
1082 0 : call vertinterp(ncol, pcols, pver, state%pmid, 30000._r8, state%t, p_surf)
1083 0 : call outfld('T300 ', p_surf, pcols, lchnk )
1084 : end if
1085 1489176 : if (hist_fld_active('T200')) then
1086 0 : call vertinterp(ncol, pcols, pver, state%pmid, 20000._r8, state%t, p_surf)
1087 0 : call outfld('T200 ', p_surf, pcols, lchnk )
1088 : end if
1089 1489176 : if (hist_fld_active('U850')) then
1090 0 : call vertinterp(ncol, pcols, pver, state%pmid, 85000._r8, state%u, p_surf)
1091 0 : call outfld('U850 ', p_surf, pcols, lchnk )
1092 : end if
1093 1489176 : if (hist_fld_active('U500')) then
1094 0 : call vertinterp(ncol, pcols, pver, state%pmid, 50000._r8, state%u, p_surf)
1095 0 : call outfld('U500 ', p_surf, pcols, lchnk )
1096 : end if
1097 1489176 : if (hist_fld_active('U250')) then
1098 0 : call vertinterp(ncol, pcols, pver, state%pmid, 25000._r8, state%u, p_surf)
1099 0 : call outfld('U250 ', p_surf, pcols, lchnk )
1100 : end if
1101 1489176 : if (hist_fld_active('U200')) then
1102 0 : call vertinterp(ncol, pcols, pver, state%pmid, 20000._r8, state%u, p_surf)
1103 0 : call outfld('U200 ', p_surf, pcols, lchnk )
1104 : end if
1105 1489176 : if (hist_fld_active('U010')) then
1106 0 : call vertinterp(ncol, pcols, pver, state%pmid, 1000._r8, state%u, p_surf)
1107 0 : call outfld('U010 ', p_surf, pcols, lchnk )
1108 : end if
1109 1489176 : if (hist_fld_active('V850')) then
1110 0 : call vertinterp(ncol, pcols, pver, state%pmid, 85000._r8, state%v, p_surf)
1111 0 : call outfld('V850 ', p_surf, pcols, lchnk )
1112 : end if
1113 1489176 : if (hist_fld_active('V500')) then
1114 0 : call vertinterp(ncol, pcols, pver, state%pmid, 50000._r8, state%v, p_surf)
1115 0 : call outfld('V500 ', p_surf, pcols, lchnk )
1116 : end if
1117 1489176 : if (hist_fld_active('V250')) then
1118 0 : call vertinterp(ncol, pcols, pver, state%pmid, 25000._r8, state%v, p_surf)
1119 0 : call outfld('V250 ', p_surf, pcols, lchnk )
1120 : end if
1121 1489176 : if (hist_fld_active('V200')) then
1122 0 : call vertinterp(ncol, pcols, pver, state%pmid, 20000._r8, state%v, p_surf)
1123 0 : call outfld('V200 ', p_surf, pcols, lchnk )
1124 : end if
1125 :
1126 2314006344 : ftem(:ncol,:) = state%t(:ncol,:)*state%t(:ncol,:)
1127 1489176 : call outfld('TT ',ftem ,pcols ,lchnk )
1128 : !
1129 : ! Output U, V, T, P and Z at bottom level
1130 : !
1131 1489176 : call outfld ('UBOT ', state%u(1,pver) , pcols, lchnk)
1132 1489176 : call outfld ('VBOT ', state%v(1,pver) , pcols, lchnk)
1133 1489176 : call outfld ('ZBOT ', state%zm(1,pver) , pcols, lchnk)
1134 :
1135 : !! Boundary layer atmospheric stability, temperature, water vapor diagnostics
1136 :
1137 102753144 : p_surf_t = -99.0_r8 ! Uninitialized to impossible value
1138 : if (hist_fld_active('T1000') .or. &
1139 : hist_fld_active('T9251000') .or. &
1140 : hist_fld_active('TH9251000') .or. &
1141 : hist_fld_active('T8501000') .or. &
1142 : hist_fld_active('TH8501000') .or. &
1143 1489176 : hist_fld_active('T7001000') .or. &
1144 : hist_fld_active('TH7001000')) then
1145 0 : call vertinterp(ncol, pcols, pver, state%pmid, 100000._r8, state%t, p_surf_t(:,surf_100000))
1146 : end if
1147 :
1148 : if ( hist_fld_active('T925') .or. &
1149 1489176 : hist_fld_active('T9251000') .or. &
1150 : hist_fld_active('TH9251000')) then
1151 0 : call vertinterp(ncol, pcols, pver, state%pmid, 92500._r8, state%t, p_surf_t(:,surf_092500))
1152 : end if
1153 :
1154 : !!! at 1000 mb and 925 mb
1155 1489176 : if (hist_fld_active('T1000')) then
1156 0 : call outfld('T1000 ', p_surf_t(:,surf_100000), pcols, lchnk )
1157 : end if
1158 :
1159 1489176 : if (hist_fld_active('T925')) then
1160 0 : call outfld('T925 ', p_surf_t(:,surf_092500), pcols, lchnk )
1161 : end if
1162 :
1163 1489176 : if (hist_fld_active('T9251000')) then
1164 0 : p_surf = p_surf_t(:,surf_092500) - p_surf_t(:,surf_100000)
1165 0 : call outfld('T9251000 ', p_surf, pcols, lchnk )
1166 : end if
1167 :
1168 1489176 : if (hist_fld_active('TH9251000')) then
1169 0 : p_surf = (p_surf_t(:,surf_092500)*(1000.0_r8/925.0_r8)**cappa) - (p_surf_t(:,surf_100000)*(1.0_r8)**cappa)
1170 0 : call outfld('TH9251000 ', p_surf, pcols, lchnk )
1171 : end if
1172 :
1173 1489176 : if (hist_fld_active('T8501000') .or. &
1174 : hist_fld_active('TH8501000')) then
1175 0 : call vertinterp(ncol, pcols, pver, state%pmid, 85000._r8, state%t, p_surf_t(:,surf_085000))
1176 : end if
1177 :
1178 : !!! at 1000 mb and 850 mb
1179 1489176 : if (hist_fld_active('T8501000')) then
1180 0 : p_surf = p_surf_t(:,surf_085000)-p_surf_t(:,surf_100000)
1181 0 : call outfld('T8501000 ', p_surf, pcols, lchnk )
1182 : end if
1183 :
1184 1489176 : if (hist_fld_active('TH8501000')) then
1185 0 : p_surf = (p_surf_t(:,surf_085000)*(1000.0_r8/850.0_r8)**cappa)-(p_surf_t(:,surf_100000)*(1.0_r8)**cappa)
1186 0 : call outfld('TH8501000 ', p_surf, pcols, lchnk )
1187 : end if
1188 :
1189 : if (hist_fld_active('T7001000') .or. &
1190 1489176 : hist_fld_active('TH7001000') .or. &
1191 : hist_fld_active('T700')) then
1192 0 : call vertinterp(ncol, pcols, pver, state%pmid, 70000._r8, state%t, p_surf_t(:,surf_070000))
1193 : end if
1194 :
1195 : !!! at 700 mb
1196 1489176 : if (hist_fld_active('T700')) then
1197 0 : call outfld('T700 ', p_surf_t(:,surf_070000), pcols, lchnk )
1198 : end if
1199 :
1200 : !!! at 1000 mb and 700 mb
1201 1489176 : if (hist_fld_active('T7001000')) then
1202 0 : p_surf = p_surf_t(:,surf_070000)-p_surf_t(:,surf_100000)
1203 0 : call outfld('T7001000 ', p_surf, pcols, lchnk )
1204 : end if
1205 :
1206 1489176 : if (hist_fld_active('TH7001000')) then
1207 0 : p_surf = (p_surf_t(:,surf_070000)*(1000.0_r8/700.0_r8)**cappa)-(p_surf_t(:,surf_100000)*(1.0_r8)**cappa)
1208 0 : call outfld('TH7001000 ', p_surf, pcols, lchnk )
1209 : end if
1210 :
1211 1489176 : if (hist_fld_active('T010')) then
1212 0 : call vertinterp(ncol, pcols, pver, state%pmid, 1000._r8, state%t, p_surf)
1213 0 : call outfld('T010 ', p_surf, pcols, lchnk )
1214 : end if
1215 :
1216 : !---------------------------------------------------------
1217 : ! tidal diagnostics
1218 : !---------------------------------------------------------
1219 1489176 : call tidal_diag_write(state)
1220 :
1221 1489176 : return
1222 2978352 : end subroutine diag_phys_writeout_dry
1223 :
1224 : !===============================================================================
1225 :
1226 1489176 : subroutine diag_phys_writeout_moist(state, pbuf, p_surf_t)
1227 :
1228 : !-----------------------------------------------------------------------
1229 : !
1230 : ! Purpose: record dynamics variables on physics grid
1231 : !
1232 : !-----------------------------------------------------------------------
1233 1489176 : use physconst, only: gravit, rga, rair, cpair, latvap, rearth, cappa
1234 : use interpolate_data, only: vertinterp
1235 : use constituent_burden, only: constituent_burden_comp
1236 : use co2_cycle, only: c_i, co2_transport
1237 : !-----------------------------------------------------------------------
1238 : !
1239 : ! Arguments
1240 : !
1241 : type(physics_state), intent(inout) :: state
1242 : type(physics_buffer_desc), pointer :: pbuf(:)
1243 : real(r8), intent(inout) :: p_surf_t(pcols, nsurf) ! data interpolated to a pressure surface
1244 : !
1245 : !---------------------------Local workspace-----------------------------
1246 : !
1247 : real(r8) :: ftem(pcols,pver) ! temporary workspace
1248 : real(r8) :: ftem1(pcols,pver) ! another temporary workspace
1249 : real(r8) :: ftem2(pcols,pver) ! another temporary workspace
1250 : real(r8) :: p_surf(pcols) ! data interpolated to a pressure surface
1251 : real(r8) :: p_surf_q1(pcols) ! data interpolated to a pressure surface
1252 : real(r8) :: p_surf_q2(pcols) ! data interpolated to a pressure surface
1253 : real(r8) :: tem2(pcols,pver) ! temporary workspace
1254 : real(r8) :: esl(pcols,pver) ! saturation vapor pressures
1255 : real(r8) :: esi(pcols,pver) !
1256 :
1257 1489176 : real(r8), pointer :: ftem_ptr(:,:)
1258 :
1259 : integer :: i, k, m, lchnk, ncol
1260 : integer :: ixq, ierr
1261 : !
1262 : !-----------------------------------------------------------------------
1263 : !
1264 1489176 : lchnk = state%lchnk
1265 1489176 : ncol = state%ncol
1266 :
1267 1489176 : call cnst_get_ind('Q', ixq)
1268 :
1269 1489176 : if (co2_transport()) then
1270 0 : do m = 1,4
1271 0 : call outfld(trim(cnst_name(c_i(m)))//'_BOT', state%q(1,pver,c_i(m)), pcols, lchnk)
1272 : end do
1273 : end if
1274 :
1275 : ! column burdens of all constituents except water vapor
1276 1489176 : call constituent_burden_comp(state)
1277 :
1278 1489176 : call outfld('PSDRY', state%psdry, pcols, lchnk)
1279 1489176 : call outfld('PMID', state%pmid, pcols, lchnk)
1280 1489176 : call outfld('PINT', state%pint, pcols, lchnk)
1281 1489176 : call outfld('PDELDRY', state%pdeldry, pcols, lchnk)
1282 1489176 : call outfld('PDEL', state%pdel, pcols, lchnk)
1283 :
1284 : !
1285 : ! Meridional advection fields
1286 : !
1287 2314006344 : ftem(:ncol,:) = state%v(:ncol,:)*state%q(:ncol,:,ixq)
1288 1489176 : call outfld ('VQ ',ftem ,pcols ,lchnk )
1289 :
1290 2314006344 : ftem(:ncol,:) = state%q(:ncol,:,1)*state%q(:ncol,:,ixq)
1291 1489176 : call outfld ('QQ ',ftem ,pcols ,lchnk )
1292 :
1293 : ! Vertical velocity and advection
1294 2314006344 : ftem(:ncol,:) = state%omega(:ncol,:)*state%q(:ncol,:,ixq)
1295 1489176 : call outfld('OMEGAQ ',ftem, pcols, lchnk )
1296 : !
1297 : ! Mass of q, by layer and vertically integrated
1298 : !
1299 2314006344 : ftem(:ncol,:) = state%q(:ncol,:,ixq) * state%pdel(:ncol,:) * rga
1300 1489176 : call outfld ('MQ ',ftem ,pcols ,lchnk )
1301 :
1302 138493368 : do k=2,pver
1303 2289140568 : ftem(:ncol,1) = ftem(:ncol,1) + ftem(:ncol,k)
1304 : end do
1305 1489176 : call outfld ('TMQ ',ftem, pcols ,lchnk )
1306 : !
1307 : ! Integrated vapor transport calculation
1308 : !
1309 : !compute uq*dp/g and vq*dp/g
1310 2314006344 : ftem1(:ncol,:) = state%q(:ncol,:,ixq) * state%u(:ncol,:) *state%pdel(:ncol,:) * rga
1311 2314006344 : ftem2(:ncol,:) = state%q(:ncol,:,ixq) * state%v(:ncol,:) *state%pdel(:ncol,:) * rga
1312 :
1313 138493368 : do k=2,pver
1314 2287651392 : ftem1(:ncol,1) = ftem1(:ncol,1) + ftem1(:ncol,k)
1315 2289140568 : ftem2(:ncol,1) = ftem2(:ncol,1) + ftem2(:ncol,k)
1316 : end do
1317 : ! compute ivt
1318 24865776 : ftem(:ncol,1) = sqrt( ftem1(:ncol,1)**2 + ftem2(:ncol,1)**2)
1319 :
1320 1489176 : call outfld ('IVT ',ftem, pcols ,lchnk )
1321 :
1322 : ! output uq*dp/g
1323 1489176 : call outfld ('uIVT ',ftem1, pcols ,lchnk )
1324 :
1325 : ! output vq*dp/g
1326 1489176 : call outfld ('vIVT ',ftem2, pcols ,lchnk )
1327 : !
1328 : ! Relative humidity
1329 : !
1330 1489176 : if (hist_fld_active('RELHUM')) then
1331 1489176 : if (relhum_idx > 0) then
1332 0 : call pbuf_get_field(pbuf, relhum_idx, ftem_ptr)
1333 0 : ftem(:ncol,:) = ftem_ptr(:ncol,:)
1334 : else
1335 139982544 : do k = 1, pver
1336 139982544 : call qsat(state%t(1:ncol,k), state%pmid(1:ncol,k), tem2(1:ncol,k), ftem(1:ncol,k), ncol)
1337 : end do
1338 2314006344 : ftem(:ncol,:) = state%q(:ncol,:,ixq)/ftem(:ncol,:)*100._r8
1339 : end if
1340 1489176 : call outfld ('RELHUM ',ftem ,pcols ,lchnk )
1341 : end if
1342 :
1343 1489176 : if (hist_fld_active('RHW') .or. hist_fld_active('RHI') .or. hist_fld_active('RHCFMIP') ) then
1344 :
1345 : ! RH w.r.t liquid (water)
1346 0 : do k = 1, pver
1347 0 : call qsat_water (state%t(1:ncol,k), state%pmid(1:ncol,k), esl(1:ncol,k), ftem(1:ncol,k), ncol)
1348 : end do
1349 0 : ftem(:ncol,:) = state%q(:ncol,:,ixq)/ftem(:ncol,:)*100._r8
1350 0 : call outfld ('RHW ',ftem ,pcols ,lchnk )
1351 :
1352 : ! Convert to RHI (ice)
1353 0 : do k=1,pver
1354 0 : call svp_ice_vect(state%t(1:ncol,k), esi(1:ncol,k), ncol)
1355 0 : do i=1,ncol
1356 0 : ftem1(i,k)=ftem(i,k)*esl(i,k)/esi(i,k)
1357 : end do
1358 : end do
1359 0 : call outfld ('RHI ',ftem1 ,pcols ,lchnk )
1360 :
1361 : ! use temperature to decide if you populate with ftem (liquid, above 0 C) or ftem1 (ice, below 0 C)
1362 :
1363 0 : ftem2(:ncol,:)=ftem(:ncol,:)
1364 :
1365 0 : do i=1,ncol
1366 0 : do k=1,pver
1367 0 : if (state%t(i,k) .gt. 273) then
1368 0 : ftem2(i,k)=ftem(i,k) !!wrt water
1369 : else
1370 0 : ftem2(i,k)=ftem1(i,k) !!wrt ice
1371 : end if
1372 : end do
1373 : end do
1374 :
1375 0 : call outfld ('RHCFMIP ',ftem2 ,pcols ,lchnk )
1376 :
1377 : end if
1378 : !
1379 : ! Output q field on pressure surfaces
1380 : !
1381 1489176 : if (hist_fld_active('Q850')) then
1382 0 : call vertinterp(ncol, pcols, pver, state%pmid, 85000._r8, state%q(1,1,ixq), p_surf)
1383 0 : call outfld('Q850 ', p_surf, pcols, lchnk )
1384 : end if
1385 1489176 : if (hist_fld_active('Q200')) then
1386 0 : call vertinterp(ncol, pcols, pver, state%pmid, 20000._r8, state%q(1,1,ixq), p_surf)
1387 0 : call outfld('Q200 ', p_surf, pcols, lchnk )
1388 : end if
1389 : !
1390 : ! Output Q at bottom level
1391 : !
1392 1489176 : call outfld ('QBOT ', state%q(1,pver,ixq), pcols, lchnk)
1393 :
1394 : ! Total energy of the atmospheric column for atmospheric heat storage calculations
1395 :
1396 : !! temporary variable to get surface geopotential in dimensions of (ncol,pver)
1397 139982544 : do k=1,pver
1398 2314006344 : ftem1(:ncol,k)=state%phis(:ncol) !! surface geopotential in units (m2/s2)
1399 : end do
1400 :
1401 : !! calculate sum of sensible, kinetic, latent, and surface geopotential energy
1402 : !! E=CpT+PHIS+Lv*q+(0.5)*(u^2+v^2)
1403 1489176 : ftem(:ncol,:) = (cpair*state%t(:ncol,:) + ftem1(:ncol,:) + latvap*state%q(:ncol,:,ixq) + &
1404 2315495520 : 0.5_r8*(state%u(:ncol,:)**2+state%v(:ncol,:)**2))*(state%pdel(:ncol,:)/gravit)
1405 : !! vertically integrate
1406 138493368 : do k=2,pver
1407 2289140568 : ftem(:ncol,1) = ftem(:ncol,1) + ftem(:ncol,k)
1408 : end do
1409 1489176 : call outfld ('ATMEINT ', ftem(:ncol,1), ncol, lchnk)
1410 :
1411 : !! Boundary layer atmospheric stability, temperature, water vapor diagnostics
1412 :
1413 : if ( hist_fld_active('THE9251000') .or. &
1414 1489176 : hist_fld_active('THE8501000') .or. &
1415 : hist_fld_active('THE7001000')) then
1416 0 : if (p_surf_t(1, surf_100000) < 0.0_r8) then
1417 0 : call vertinterp(ncol, pcols, pver, state%pmid, 100000._r8, state%t, p_surf_t(:, surf_100000))
1418 : end if
1419 : end if
1420 :
1421 1489176 : if ( hist_fld_active('TH9251000') .or. &
1422 : hist_fld_active('THE9251000')) then
1423 0 : if (p_surf_t(1, surf_092500) < 0.0_r8) then
1424 0 : call vertinterp(ncol, pcols, pver, state%pmid, 92500._r8, state%t, p_surf_t(:, surf_092500))
1425 : end if
1426 : end if
1427 :
1428 : if ( hist_fld_active('Q1000') .or. &
1429 : hist_fld_active('THE9251000') .or. &
1430 1489176 : hist_fld_active('THE8501000') .or. &
1431 : hist_fld_active('THE7001000')) then
1432 0 : call vertinterp(ncol, pcols, pver, state%pmid, 100000._r8, state%q(1,1,ixq), p_surf_q1)
1433 : end if
1434 :
1435 1489176 : if (hist_fld_active('THE9251000') .or. &
1436 : hist_fld_active('Q925')) then
1437 0 : call vertinterp(ncol, pcols, pver, state%pmid, 92500._r8, state%q(1,1,ixq), p_surf_q2)
1438 : end if
1439 :
1440 : !!! at 1000 mb and 925 mb
1441 1489176 : if (hist_fld_active('Q1000')) then
1442 0 : call outfld('Q1000 ', p_surf_q1, pcols, lchnk )
1443 : end if
1444 :
1445 1489176 : if (hist_fld_active('Q925')) then
1446 0 : call outfld('Q925 ', p_surf_q2, pcols, lchnk )
1447 : end if
1448 :
1449 1489176 : if (hist_fld_active('THE9251000')) then
1450 : p_surf = ((p_surf_t(:, surf_092500)*(1000.0_r8/925.0_r8)**cappa) * &
1451 : exp((2500000.0_r8*p_surf_q2)/(1004.0_r8*p_surf_t(:, surf_092500)))) - &
1452 0 : (p_surf_t(:,surf_100000)*(1.0_r8)**cappa)*exp((2500000.0_r8*p_surf_q1)/(1004.0_r8*p_surf_t(:,surf_100000)))
1453 0 : call outfld('THE9251000 ', p_surf, pcols, lchnk )
1454 : end if
1455 :
1456 1489176 : if (hist_fld_active('THE8501000')) then
1457 0 : if (p_surf_t(1, surf_085000) < 0.0_r8) then
1458 0 : call vertinterp(ncol, pcols, pver, state%pmid, 85000._r8, state%t, p_surf_t(:, surf_085000))
1459 : end if
1460 : end if
1461 :
1462 : !!! at 1000 mb and 850 mb
1463 1489176 : if (hist_fld_active('THE8501000')) then
1464 0 : call vertinterp(ncol, pcols, pver, state%pmid, 85000._r8, state%q(1,1,ixq), p_surf_q2)
1465 : p_surf = ((p_surf_t(:, surf_085000)*(1000.0_r8/850.0_r8)**cappa) * &
1466 : exp((2500000.0_r8*p_surf_q2)/(1004.0_r8*p_surf_t(:, surf_085000)))) - &
1467 0 : (p_surf_t(:,surf_100000)*(1.0_r8)**cappa)*exp((2500000.0_r8*p_surf_q1)/(1004.0_r8*p_surf_t(:,surf_100000)))
1468 0 : call outfld('THE8501000 ', p_surf, pcols, lchnk )
1469 : end if
1470 :
1471 1489176 : if (hist_fld_active('THE7001000')) then
1472 0 : if (p_surf_t(1, surf_070000) < 0.0_r8) then
1473 0 : call vertinterp(ncol, pcols, pver, state%pmid, 70000._r8, state%t, p_surf_t(:, surf_070000))
1474 : end if
1475 : end if
1476 :
1477 : !!! at 1000 mb and 700 mb
1478 1489176 : if (hist_fld_active('THE7001000')) then
1479 0 : call vertinterp(ncol, pcols, pver, state%pmid, 70000._r8, state%q(1,1,ixq), p_surf_q2)
1480 : p_surf = ((p_surf_t(:, surf_070000)*(1000.0_r8/700.0_r8)**cappa) * &
1481 : exp((2500000.0_r8*p_surf_q2)/(1004.0_r8*p_surf_t(:, surf_070000)))) - &
1482 0 : (p_surf_t(:,surf_100000)*(1.0_r8)**cappa)*exp((2500000.0_r8*p_surf_q1)/(1004.0_r8*p_surf_t(:,surf_100000)))
1483 0 : call outfld('THE7001000 ', p_surf, pcols, lchnk )
1484 : end if
1485 :
1486 1489176 : return
1487 2978352 : end subroutine diag_phys_writeout_moist
1488 :
1489 : !===============================================================================
1490 :
1491 1489176 : subroutine diag_phys_writeout(state, pbuf)
1492 :
1493 : !-----------------------------------------------------------------------
1494 : !
1495 : ! Arguments
1496 : !
1497 : type(physics_state), intent(inout) :: state
1498 : type(physics_buffer_desc), pointer :: pbuf(:)
1499 :
1500 : ! Local variable
1501 : real(r8) :: p_surf_t(pcols, nsurf) ! data interpolated to a pressure surface
1502 :
1503 1489176 : call diag_phys_writeout_dry(state, pbuf, p_surf_t)
1504 :
1505 1489176 : if (moist_physics) then
1506 1489176 : call diag_phys_writeout_moist(state, pbuf, p_surf_t)
1507 : end if
1508 :
1509 1489176 : end subroutine diag_phys_writeout
1510 :
1511 : !===============================================================================
1512 :
1513 4467528 : subroutine diag_clip_tend_writeout(state, ptend, ncol, lchnk, ixcldliq, ixcldice, ixq, ztodt, rtdt)
1514 :
1515 : !-----------------------------------------------------------------------
1516 : !
1517 : ! Arguments
1518 : !
1519 : type(physics_state), intent(in) :: state
1520 : type(physics_ptend), intent(in) :: ptend
1521 : integer :: ncol
1522 : integer :: lchnk
1523 : integer :: ixcldliq
1524 : integer :: ixcldice
1525 : integer :: ixq
1526 : real(r8) :: ztodt
1527 : real(r8) :: rtdt
1528 :
1529 : ! Local variables
1530 :
1531 : ! Debugging output to look at ice tendencies due to hard clipping negative values
1532 : real(r8) :: preclipice(pcols,pver)
1533 : real(r8) :: icecliptend(pcols,pver)
1534 : real(r8) :: preclipliq(pcols,pver)
1535 : real(r8) :: liqcliptend(pcols,pver)
1536 : real(r8) :: preclipvap(pcols,pver)
1537 : real(r8) :: vapcliptend(pcols,pver)
1538 :
1539 : ! Initialize to zero
1540 4467528 : liqcliptend(:,:) = 0._r8
1541 4467528 : icecliptend(:,:) = 0._r8
1542 4467528 : vapcliptend(:,:) = 0._r8
1543 :
1544 6942019032 : preclipliq(:ncol,:) = state%q(:ncol,:,ixcldliq)+(ptend%q(:ncol,:,ixcldliq)*ztodt)
1545 6942019032 : preclipice(:ncol,:) = state%q(:ncol,:,ixcldice)+(ptend%q(:ncol,:,ixcldice)*ztodt)
1546 6942019032 : preclipvap(:ncol,:) = state%q(:ncol,:,ixq)+(ptend%q(:ncol,:,ixq)*ztodt)
1547 6942019032 : vapcliptend(:ncol,:) = (state%q(:ncol,:,ixq)-preclipvap(:ncol,:))*rtdt
1548 6942019032 : icecliptend(:ncol,:) = (state%q(:ncol,:,ixcldice)-preclipice(:ncol,:))*rtdt
1549 6942019032 : liqcliptend(:ncol,:) = (state%q(:ncol,:,ixcldliq)-preclipliq(:ncol,:))*rtdt
1550 :
1551 4467528 : call outfld('INEGCLPTEND', icecliptend, pcols, lchnk )
1552 4467528 : call outfld('LNEGCLPTEND', liqcliptend, pcols, lchnk )
1553 4467528 : call outfld('VNEGCLPTEND', vapcliptend, pcols, lchnk )
1554 :
1555 4467528 : end subroutine diag_clip_tend_writeout
1556 :
1557 : !===============================================================================
1558 :
1559 1489176 : subroutine diag_conv(state, ztodt, pbuf)
1560 :
1561 : !-----------------------------------------------------------------------
1562 : !
1563 : ! Output diagnostics associated with all convective processes.
1564 : !
1565 : !-----------------------------------------------------------------------
1566 : use tidal_diag, only: get_tidal_coeffs
1567 :
1568 : ! Arguments:
1569 :
1570 : real(r8), intent(in) :: ztodt ! timestep for computing physics tendencies
1571 : type(physics_state), intent(in) :: state
1572 : type(physics_buffer_desc), pointer :: pbuf(:)
1573 :
1574 : ! convective precipitation variables
1575 1489176 : real(r8), pointer :: prec_dp(:) ! total precipitation from ZM convection
1576 1489176 : real(r8), pointer :: snow_dp(:) ! snow from ZM convection
1577 1489176 : real(r8), pointer :: prec_sh(:) ! total precipitation from Hack convection
1578 1489176 : real(r8), pointer :: snow_sh(:) ! snow from Hack convection
1579 1489176 : real(r8), pointer :: prec_sed(:) ! total precipitation from ZM convection
1580 1489176 : real(r8), pointer :: snow_sed(:) ! snow from ZM convection
1581 1489176 : real(r8), pointer :: prec_pcw(:) ! total precipitation from Hack convection
1582 1489176 : real(r8), pointer :: snow_pcw(:) ! snow from Hack convection
1583 :
1584 : ! Local variables:
1585 :
1586 : integer :: i, k, m, lchnk, ncol
1587 :
1588 : real(r8) :: rtdt
1589 :
1590 : real(r8):: precc(pcols) ! convective precip rate
1591 : real(r8):: precl(pcols) ! stratiform precip rate
1592 : real(r8):: snowc(pcols) ! convective snow rate
1593 : real(r8):: snowl(pcols) ! stratiform snow rate
1594 : real(r8):: prect(pcols) ! total (conv+large scale) precip rate
1595 : real(r8) :: dcoef(6) ! for tidal component of T tend
1596 :
1597 1489176 : lchnk = state%lchnk
1598 1489176 : ncol = state%ncol
1599 :
1600 1489176 : rtdt = 1._r8/ztodt
1601 :
1602 1489176 : if (moist_physics) then
1603 1489176 : if (prec_dp_idx > 0) then
1604 1489176 : call pbuf_get_field(pbuf, prec_dp_idx, prec_dp)
1605 : else
1606 0 : nullify(prec_dp)
1607 : end if
1608 1489176 : if (snow_dp_idx > 0) then
1609 1489176 : call pbuf_get_field(pbuf, snow_dp_idx, snow_dp)
1610 : else
1611 0 : nullify(snow_dp)
1612 : end if
1613 1489176 : if (prec_sh_idx > 0) then
1614 1489176 : call pbuf_get_field(pbuf, prec_sh_idx, prec_sh)
1615 : else
1616 0 : nullify(prec_sh)
1617 : end if
1618 1489176 : if (snow_sh_idx > 0) then
1619 1489176 : call pbuf_get_field(pbuf, snow_sh_idx, snow_sh)
1620 : else
1621 0 : nullify(snow_sh)
1622 : end if
1623 1489176 : if (prec_sed_idx > 0) then
1624 1489176 : call pbuf_get_field(pbuf, prec_sed_idx, prec_sed)
1625 : else
1626 0 : nullify(prec_sed)
1627 : end if
1628 1489176 : if (snow_sed_idx > 0) then
1629 1489176 : call pbuf_get_field(pbuf, snow_sed_idx, snow_sed)
1630 : else
1631 0 : nullify(snow_sed)
1632 : end if
1633 1489176 : if (prec_pcw_idx > 0) then
1634 1489176 : call pbuf_get_field(pbuf, prec_pcw_idx, prec_pcw)
1635 : else
1636 0 : nullify(prec_pcw)
1637 : end if
1638 1489176 : if (snow_pcw_idx > 0) then
1639 1489176 : call pbuf_get_field(pbuf, snow_pcw_idx, snow_pcw)
1640 : else
1641 0 : nullify(snow_pcw)
1642 : end if
1643 :
1644 : ! Precipitation rates (multi-process)
1645 1489176 : if (associated(prec_dp) .and. associated(prec_sh)) then
1646 24865776 : precc(:ncol) = prec_dp(:ncol) + prec_sh(:ncol)
1647 0 : else if (associated(prec_dp)) then
1648 0 : precc(:ncol) = prec_dp(:ncol)
1649 0 : else if (associated(prec_sh)) then
1650 0 : precc(:ncol) = prec_sh(:ncol)
1651 : else
1652 0 : precc(:ncol) = 0._r8
1653 : end if
1654 1489176 : if (associated(prec_sed) .and. associated(prec_pcw)) then
1655 24865776 : precl(:ncol) = prec_sed(:ncol) + prec_pcw(:ncol)
1656 0 : else if (associated(prec_sed)) then
1657 0 : precl(:ncol) = prec_sed(:ncol)
1658 0 : else if (associated(prec_pcw)) then
1659 0 : precl(:ncol) = prec_pcw(:ncol)
1660 : else
1661 0 : precl(:ncol) = 0._r8
1662 : end if
1663 1489176 : if (associated(snow_dp) .and. associated(snow_sh)) then
1664 24865776 : snowc(:ncol) = snow_dp(:ncol) + snow_sh(:ncol)
1665 0 : else if (associated(snow_dp)) then
1666 0 : snowc(:ncol) = snow_dp(:ncol)
1667 0 : else if (associated(snow_sh)) then
1668 0 : snowc(:ncol) = snow_sh(:ncol)
1669 : else
1670 0 : snowc(:ncol) = 0._r8
1671 : end if
1672 1489176 : if (associated(snow_sed) .and. associated(snow_pcw)) then
1673 24865776 : snowl(:ncol) = snow_sed(:ncol) + snow_pcw(:ncol)
1674 0 : else if (associated(snow_sed)) then
1675 0 : snowl(:ncol) = snow_sed(:ncol)
1676 0 : else if (associated(snow_pcw)) then
1677 0 : snowl(:ncol) = snow_pcw(:ncol)
1678 : else
1679 0 : snowl(:ncol) = 0._r8
1680 : end if
1681 26354952 : prect(:ncol) = precc(:ncol) + precl(:ncol)
1682 :
1683 1489176 : call outfld('PRECC ', precc, pcols, lchnk )
1684 1489176 : call outfld('PRECL ', precl, pcols, lchnk )
1685 1489176 : if (associated(prec_pcw)) then
1686 1489176 : call outfld('PREC_PCW', prec_pcw,pcols ,lchnk )
1687 : end if
1688 1489176 : if (associated(prec_dp)) then
1689 1489176 : call outfld('PREC_zmc', prec_dp ,pcols ,lchnk )
1690 : end if
1691 1489176 : call outfld('PRECSC ', snowc, pcols, lchnk )
1692 1489176 : call outfld('PRECSL ', snowl, pcols, lchnk )
1693 1489176 : call outfld('PRECT ', prect, pcols, lchnk )
1694 1489176 : call outfld('PRECTMX ', prect, pcols, lchnk )
1695 :
1696 1489176 : call outfld('PRECLav ', precl, pcols, lchnk )
1697 1489176 : call outfld('PRECCav ', precc, pcols, lchnk )
1698 :
1699 1489176 : if (write_camiop) call outfld('Prec ' , prect, pcols, lchnk )
1700 :
1701 : ! Total convection tendencies.
1702 :
1703 139982544 : do k = 1, pver
1704 2314006344 : do i = 1, ncol
1705 2312517168 : dtcond(i,k,lchnk) = (state%t(i,k) - dtcond(i,k,lchnk))*rtdt
1706 : end do
1707 : end do
1708 1489176 : call outfld('DTCOND ', dtcond(:,:,lchnk), pcols, lchnk)
1709 :
1710 : ! output tidal coefficients
1711 1489176 : call get_tidal_coeffs( dcoef )
1712 2314006344 : call outfld( 'DTCOND_24_SIN', dtcond(:ncol,:,lchnk)*dcoef(1), ncol, lchnk )
1713 2314006344 : call outfld( 'DTCOND_24_COS', dtcond(:ncol,:,lchnk)*dcoef(2), ncol, lchnk )
1714 2314006344 : call outfld( 'DTCOND_12_SIN', dtcond(:ncol,:,lchnk)*dcoef(3), ncol, lchnk )
1715 2314006344 : call outfld( 'DTCOND_12_COS', dtcond(:ncol,:,lchnk)*dcoef(4), ncol, lchnk )
1716 2314006344 : call outfld( 'DTCOND_08_SIN', dtcond(:ncol,:,lchnk)*dcoef(5), ncol, lchnk )
1717 2314006344 : call outfld( 'DTCOND_08_COS', dtcond(:ncol,:,lchnk)*dcoef(6), ncol, lchnk )
1718 :
1719 2978352 : do m = 1, dqcond_num
1720 2978352 : if ( cnst_cam_outfld(m) ) then
1721 139982544 : do k = 1, pver
1722 2314006344 : do i = 1, ncol
1723 2312517168 : dqcond(m)%cnst(i,k,lchnk) = (state%q(i,k,m) - dqcond(m)%cnst(i,k,lchnk))*rtdt
1724 : end do
1725 : end do
1726 1489176 : call outfld(dcconnam(m), dqcond(m)%cnst(:,:,lchnk), pcols, lchnk)
1727 : end if
1728 : end do
1729 :
1730 : end if
1731 1489176 : end subroutine diag_conv
1732 :
1733 : !===============================================================================
1734 :
1735 1489176 : subroutine diag_surf (cam_in, cam_out, state, pbuf)
1736 :
1737 : !-----------------------------------------------------------------------
1738 : !
1739 : ! Purpose: record surface diagnostics
1740 : !
1741 : !-----------------------------------------------------------------------
1742 :
1743 : use time_manager, only: is_end_curr_day
1744 : use co2_cycle, only: c_i, co2_transport
1745 : use constituents, only: sflxnam
1746 :
1747 : !-----------------------------------------------------------------------
1748 : !
1749 : ! Input arguments
1750 : !
1751 : type(cam_in_t), intent(in) :: cam_in
1752 : type(cam_out_t), intent(in) :: cam_out
1753 : type(physics_state), intent(in) :: state
1754 : type(physics_buffer_desc), pointer :: pbuf(:)
1755 : !
1756 : !---------------------------Local workspace-----------------------------
1757 : !
1758 : integer :: i, k, m ! indexes
1759 : integer :: lchnk ! chunk identifier
1760 : integer :: ncol ! longitude dimension
1761 : real(r8) tem2(pcols) ! temporary workspace
1762 : real(r8) ftem(pcols) ! temporary workspace
1763 :
1764 1489176 : real(r8), pointer :: trefmnav(:) ! daily minimum tref
1765 1489176 : real(r8), pointer :: trefmxav(:) ! daily maximum tref
1766 :
1767 : !
1768 : !-----------------------------------------------------------------------
1769 : !
1770 1489176 : lchnk = cam_in%lchnk
1771 1489176 : ncol = cam_in%ncol
1772 :
1773 1489176 : if (moist_physics) then
1774 1489176 : call outfld('SHFLX', cam_in%shf, pcols, lchnk)
1775 1489176 : call outfld('LHFLX', cam_in%lhf, pcols, lchnk)
1776 1489176 : call outfld('QFLX', cam_in%cflx(1,1), pcols, lchnk)
1777 :
1778 1489176 : call outfld('TAUX', cam_in%wsx, pcols, lchnk)
1779 1489176 : call outfld('TAUY', cam_in%wsy, pcols, lchnk)
1780 1489176 : call outfld('TREFHT ', cam_in%tref, pcols, lchnk)
1781 1489176 : call outfld('TREFHTMX', cam_in%tref, pcols, lchnk)
1782 1489176 : call outfld('TREFHTMN', cam_in%tref, pcols, lchnk)
1783 1489176 : call outfld('QREFHT', cam_in%qref, pcols, lchnk)
1784 1489176 : call outfld('U10', cam_in%u10, pcols, lchnk)
1785 1489176 : call outfld('UGUST', cam_in%ugustOut, pcols, lchnk)
1786 1489176 : call outfld('U10WITHGUSTS',cam_in%u10withGusts, pcols, lchnk)
1787 :
1788 : !
1789 : ! Calculate and output reference height RH (RHREFHT)
1790 1489176 : call qsat(cam_in%tref(1:ncol), state%ps(1:ncol), tem2(1:ncol), ftem(1:ncol), ncol)
1791 24865776 : ftem(:ncol) = cam_in%qref(:ncol)/ftem(:ncol)*100._r8
1792 :
1793 :
1794 1489176 : call outfld('RHREFHT', ftem, pcols, lchnk)
1795 :
1796 :
1797 1489176 : if (write_camiop) then
1798 0 : call outfld('shflx ',cam_in%shf, pcols, lchnk)
1799 0 : call outfld('lhflx ',cam_in%lhf, pcols, lchnk)
1800 0 : call outfld('trefht ',cam_in%tref, pcols, lchnk)
1801 0 : call outfld('Tg', cam_in%ts, pcols, lchnk)
1802 0 : call outfld('Tsair',cam_in%ts, pcols, lchnk)
1803 : end if
1804 : !
1805 : ! Ouput ocn and ice fractions
1806 : !
1807 1489176 : call outfld('LANDFRAC', cam_in%landfrac, pcols, lchnk)
1808 1489176 : call outfld('ICEFRAC', cam_in%icefrac, pcols, lchnk)
1809 1489176 : call outfld('OCNFRAC', cam_in%ocnfrac, pcols, lchnk)
1810 : !
1811 : ! Compute daily minimum and maximum of TREF
1812 : !
1813 1489176 : call pbuf_get_field(pbuf, trefmxav_idx, trefmxav)
1814 1489176 : call pbuf_get_field(pbuf, trefmnav_idx, trefmnav)
1815 24865776 : do i = 1,ncol
1816 23376600 : trefmxav(i) = max(cam_in%tref(i),trefmxav(i))
1817 24865776 : trefmnav(i) = min(cam_in%tref(i),trefmnav(i))
1818 : end do
1819 1489176 : if (is_end_curr_day()) then
1820 34056 : call outfld('TREFMXAV', trefmxav,pcols, lchnk )
1821 34056 : call outfld('TREFMNAV', trefmnav,pcols, lchnk )
1822 568656 : trefmxav(:ncol) = -1.0e36_r8
1823 568656 : trefmnav(:ncol) = 1.0e36_r8
1824 : endif
1825 :
1826 1489176 : call outfld('TBOT', cam_out%tbot, pcols, lchnk)
1827 1489176 : call outfld('TS', cam_in%ts, pcols, lchnk)
1828 1489176 : call outfld('TSMN', cam_in%ts, pcols, lchnk)
1829 1489176 : call outfld('TSMX', cam_in%ts, pcols, lchnk)
1830 1489176 : call outfld('SNOWHLND', cam_in%snowhland, pcols, lchnk)
1831 1489176 : call outfld('SNOWHICE', cam_in%snowhice, pcols, lchnk)
1832 1489176 : call outfld('ASDIR', cam_in%asdir, pcols, lchnk)
1833 1489176 : call outfld('ASDIF', cam_in%asdif, pcols, lchnk)
1834 1489176 : call outfld('ALDIR', cam_in%aldir, pcols, lchnk)
1835 1489176 : call outfld('ALDIF', cam_in%aldif, pcols, lchnk)
1836 1489176 : call outfld('SST', cam_in%sst, pcols, lchnk)
1837 :
1838 1489176 : if (co2_transport()) then
1839 0 : do m = 1,4
1840 0 : call outfld(sflxnam(c_i(m)), cam_in%cflx(:,c_i(m)), pcols, lchnk)
1841 : end do
1842 : end if
1843 : end if
1844 :
1845 2978352 : end subroutine diag_surf
1846 :
1847 : !===============================================================================
1848 :
1849 1495368 : subroutine diag_export(cam_out)
1850 :
1851 : !-----------------------------------------------------------------------
1852 : !
1853 : ! Purpose: Write export state to history file
1854 : !
1855 : !-----------------------------------------------------------------------
1856 :
1857 : ! arguments
1858 : type(cam_out_t), intent(inout) :: cam_out
1859 :
1860 : ! Local variables:
1861 : integer :: lchnk ! chunk identifier
1862 : logical :: atm_dep_flux ! true ==> sending deposition fluxes to coupler.
1863 : ! Otherwise, set them to zero.
1864 : !-----------------------------------------------------------------------
1865 :
1866 1495368 : lchnk = cam_out%lchnk
1867 :
1868 1495368 : call phys_getopts(atm_dep_flux_out=atm_dep_flux)
1869 :
1870 1495368 : if (.not. atm_dep_flux) then
1871 : ! set the fluxes to zero before outfld and sending them to the
1872 : ! coupler
1873 0 : cam_out%bcphiwet = 0.0_r8
1874 0 : cam_out%bcphidry = 0.0_r8
1875 0 : cam_out%bcphodry = 0.0_r8
1876 0 : cam_out%ocphiwet = 0.0_r8
1877 0 : cam_out%ocphidry = 0.0_r8
1878 0 : cam_out%ocphodry = 0.0_r8
1879 0 : cam_out%dstwet1 = 0.0_r8
1880 0 : cam_out%dstdry1 = 0.0_r8
1881 0 : cam_out%dstwet2 = 0.0_r8
1882 0 : cam_out%dstdry2 = 0.0_r8
1883 0 : cam_out%dstwet3 = 0.0_r8
1884 0 : cam_out%dstdry3 = 0.0_r8
1885 0 : cam_out%dstwet4 = 0.0_r8
1886 0 : cam_out%dstdry4 = 0.0_r8
1887 : end if
1888 :
1889 1495368 : if (moist_physics) then
1890 1495368 : call outfld('a2x_BCPHIWET', cam_out%bcphiwet, pcols, lchnk)
1891 1495368 : call outfld('a2x_BCPHIDRY', cam_out%bcphidry, pcols, lchnk)
1892 1495368 : call outfld('a2x_BCPHODRY', cam_out%bcphodry, pcols, lchnk)
1893 1495368 : call outfld('a2x_OCPHIWET', cam_out%ocphiwet, pcols, lchnk)
1894 1495368 : call outfld('a2x_OCPHIDRY', cam_out%ocphidry, pcols, lchnk)
1895 1495368 : call outfld('a2x_OCPHODRY', cam_out%ocphodry, pcols, lchnk)
1896 1495368 : call outfld('a2x_DSTWET1', cam_out%dstwet1, pcols, lchnk)
1897 1495368 : call outfld('a2x_DSTDRY1', cam_out%dstdry1, pcols, lchnk)
1898 1495368 : call outfld('a2x_DSTWET2', cam_out%dstwet2, pcols, lchnk)
1899 1495368 : call outfld('a2x_DSTDRY2', cam_out%dstdry2, pcols, lchnk)
1900 1495368 : call outfld('a2x_DSTWET3', cam_out%dstwet3, pcols, lchnk)
1901 1495368 : call outfld('a2x_DSTDRY3', cam_out%dstdry3, pcols, lchnk)
1902 1495368 : call outfld('a2x_DSTWET4', cam_out%dstwet4, pcols, lchnk)
1903 1495368 : call outfld('a2x_DSTDRY4', cam_out%dstdry4, pcols, lchnk)
1904 : end if
1905 :
1906 1489176 : end subroutine diag_export
1907 :
1908 : !#######################################################################
1909 :
1910 1495368 : subroutine diag_physvar_ic (lchnk, pbuf, cam_out, cam_in)
1911 : !
1912 : !---------------------------------------------
1913 : !
1914 : ! Purpose: record physics variables on IC file
1915 : !
1916 : !---------------------------------------------
1917 : !
1918 :
1919 : !
1920 : ! Arguments
1921 : !
1922 : integer , intent(in) :: lchnk ! chunk identifier
1923 : type(physics_buffer_desc), pointer :: pbuf(:)
1924 :
1925 : type(cam_out_t), intent(inout) :: cam_out
1926 : type(cam_in_t), intent(inout) :: cam_in
1927 : !
1928 : !---------------------------Local workspace-----------------------------
1929 : !
1930 : integer :: itim_old ! indices
1931 :
1932 1495368 : real(r8), pointer, dimension(:,:) :: cwat_var
1933 1495368 : real(r8), pointer, dimension(:,:) :: conv_var_3d
1934 1495368 : real(r8), pointer, dimension(: ) :: conv_var_2d
1935 1495368 : real(r8), pointer :: tpert(:), pblh(:), qpert(:)
1936 : !
1937 : !-----------------------------------------------------------------------
1938 : !
1939 1495368 : if( write_inithist() .and. moist_physics ) then
1940 :
1941 : !
1942 : ! Associate pointers with physics buffer fields
1943 : !
1944 0 : itim_old = pbuf_old_tim_idx()
1945 :
1946 0 : if (qcwat_idx > 0) then
1947 0 : call pbuf_get_field(pbuf, qcwat_idx, cwat_var, start=(/1,1,itim_old/), kount=(/pcols,pver,1/) )
1948 0 : call outfld('QCWAT&IC ',cwat_var, pcols,lchnk)
1949 : end if
1950 :
1951 0 : if (tcwat_idx > 0) then
1952 0 : call pbuf_get_field(pbuf, tcwat_idx, cwat_var, start=(/1,1,itim_old/), kount=(/pcols,pver,1/) )
1953 0 : call outfld('TCWAT&IC ',cwat_var, pcols,lchnk)
1954 : end if
1955 :
1956 0 : if (lcwat_idx > 0) then
1957 0 : call pbuf_get_field(pbuf, lcwat_idx, cwat_var, start=(/1,1,itim_old/), kount=(/pcols,pver,1/) )
1958 0 : call outfld('LCWAT&IC ',cwat_var, pcols,lchnk)
1959 : end if
1960 :
1961 0 : if (cld_idx > 0) then
1962 0 : call pbuf_get_field(pbuf, cld_idx, cwat_var, start=(/1,1,itim_old/), kount=(/pcols,pver,1/) )
1963 0 : call outfld('CLOUD&IC ',cwat_var, pcols,lchnk)
1964 : end if
1965 :
1966 0 : if (concld_idx > 0) then
1967 0 : call pbuf_get_field(pbuf, concld_idx, cwat_var, start=(/1,1,itim_old/), kount=(/pcols,pver,1/) )
1968 0 : call outfld('CONCLD&IC ',cwat_var, pcols,lchnk)
1969 : end if
1970 :
1971 0 : if (cush_idx > 0) then
1972 0 : call pbuf_get_field(pbuf, cush_idx, conv_var_2d ,(/1,itim_old/), (/pcols,1/))
1973 0 : call outfld('CUSH&IC ',conv_var_2d, pcols,lchnk)
1974 :
1975 : end if
1976 :
1977 0 : if (tke_idx > 0) then
1978 0 : call pbuf_get_field(pbuf, tke_idx, conv_var_3d)
1979 0 : call outfld('TKE&IC ',conv_var_3d, pcols,lchnk)
1980 : end if
1981 :
1982 0 : if (kvm_idx > 0) then
1983 0 : call pbuf_get_field(pbuf, kvm_idx, conv_var_3d)
1984 0 : call outfld('KVM&IC ',conv_var_3d, pcols,lchnk)
1985 : end if
1986 :
1987 0 : if (kvh_idx > 0) then
1988 0 : call pbuf_get_field(pbuf, kvh_idx, conv_var_3d)
1989 0 : call outfld('KVH&IC ',conv_var_3d, pcols,lchnk)
1990 : end if
1991 :
1992 0 : if (qpert_idx > 0) then
1993 0 : call pbuf_get_field(pbuf, qpert_idx, qpert)
1994 0 : call outfld('QPERT&IC ', qpert, pcols, lchnk)
1995 : end if
1996 :
1997 0 : if (pblh_idx > 0) then
1998 0 : call pbuf_get_field(pbuf, pblh_idx, pblh)
1999 0 : call outfld('PBLH&IC ', pblh, pcols, lchnk)
2000 : end if
2001 :
2002 0 : if (tpert_idx > 0) then
2003 0 : call pbuf_get_field(pbuf, tpert_idx, tpert)
2004 0 : call outfld('TPERT&IC ', tpert, pcols, lchnk)
2005 : end if
2006 :
2007 : end if
2008 :
2009 1495368 : end subroutine diag_physvar_ic
2010 :
2011 :
2012 : !#######################################################################
2013 :
2014 1489176 : subroutine diag_phys_tend_writeout_dry(state, pbuf, tend, ztodt)
2015 :
2016 : !---------------------------------------------------------------
2017 : !
2018 : ! Purpose: Dump physics tendencies for temperature
2019 : !
2020 : !---------------------------------------------------------------
2021 :
2022 : use check_energy, only: check_energy_get_integrals
2023 : use physconst, only: cpair
2024 :
2025 : ! Arguments
2026 :
2027 : type(physics_state), intent(in) :: state
2028 :
2029 : type(physics_buffer_desc), pointer :: pbuf(:)
2030 : type(physics_tend ), intent(in) :: tend
2031 : real(r8), intent(in) :: ztodt ! physics timestep
2032 :
2033 : !---------------------------Local workspace-----------------------------
2034 :
2035 : integer :: lchnk ! chunk index
2036 : integer :: ncol ! number of columns in chunk
2037 : real(r8) :: ftem2(pcols) ! Temporary workspace for outfld variables
2038 : real(r8) :: ftem3(pcols,pver) ! Temporary workspace for outfld variables
2039 : real(r8) :: heat_glob ! global energy integral (FV only)
2040 : ! CAM pointers to get variables from the physics buffer
2041 1489176 : real(r8), pointer, dimension(:,:) :: t_ttend
2042 1489176 : real(r8), pointer, dimension(:,:) :: t_utend
2043 1489176 : real(r8), pointer, dimension(:,:) :: t_vtend
2044 : integer :: itim_old,m
2045 :
2046 : !-----------------------------------------------------------------------
2047 :
2048 1489176 : lchnk = state%lchnk
2049 1489176 : ncol = state%ncol
2050 :
2051 : ! Dump out post-physics state (FV only)
2052 :
2053 1489176 : call outfld('TAP', state%t, pcols, lchnk )
2054 1489176 : call outfld('UAP', state%u, pcols, lchnk )
2055 1489176 : call outfld('VAP', state%v, pcols, lchnk )
2056 :
2057 : ! Total physics tendency for Temperature
2058 : ! (remove global fixer tendency from total for FV and SE dycores)
2059 :
2060 1489176 : if (.not.dycore_is('EUL')) then
2061 1489176 : call check_energy_get_integrals( heat_glob_out=heat_glob )
2062 24865776 : ftem2(:ncol) = heat_glob/cpair
2063 1489176 : call outfld('TFIX', ftem2, pcols, lchnk )
2064 2314006344 : ftem3(:ncol,:pver) = tend%dtdt(:ncol,:pver) - heat_glob/cpair
2065 : else
2066 0 : ftem3(:ncol,:pver) = tend%dtdt(:ncol,:pver)
2067 : end if
2068 1489176 : call outfld('PTTEND',ftem3, pcols, lchnk )
2069 2314006344 : ftem3(:ncol,:pver) = tend%dudt(:ncol,:pver)
2070 1489176 : call outfld('UTEND_PHYSTOT',ftem3, pcols, lchnk )
2071 2314006344 : ftem3(:ncol,:pver) = tend%dvdt(:ncol,:pver)
2072 1489176 : call outfld('VTEND_PHYSTOT',ftem3, pcols, lchnk )
2073 :
2074 : ! Total (physics+dynamics, everything!) tendency for Temperature
2075 :
2076 : !! get temperature, U, and V stored in physics buffer
2077 1489176 : itim_old = pbuf_old_tim_idx()
2078 5956704 : call pbuf_get_field(pbuf, t_ttend_idx, t_ttend, start=(/1,1,itim_old/), kount=(/pcols,pver,1/))
2079 5956704 : call pbuf_get_field(pbuf, t_utend_idx, t_utend, start=(/1,1,itim_old/), kount=(/pcols,pver,1/))
2080 5956704 : call pbuf_get_field(pbuf, t_vtend_idx, t_vtend, start=(/1,1,itim_old/), kount=(/pcols,pver,1/))
2081 :
2082 : !! calculate and outfld the total temperature, U, and V tendencies
2083 2314006344 : ftem3(:ncol,:) = (state%t(:ncol,:) - t_ttend(:ncol,:))/ztodt
2084 1489176 : call outfld('TTEND_TOT', ftem3, pcols, lchnk)
2085 2314006344 : ftem3(:ncol,:) = (state%u(:ncol,:) - t_utend(:ncol,:))/ztodt
2086 1489176 : call outfld('UTEND_TOT', ftem3, pcols, lchnk)
2087 2314006344 : ftem3(:ncol,:) = (state%v(:ncol,:) - t_vtend(:ncol,:))/ztodt
2088 1489176 : call outfld('VTEND_TOT', ftem3, pcols, lchnk)
2089 :
2090 : !! update physics buffer with this time-step's temperature, U, and V
2091 2314006344 : t_ttend(:ncol,:) = state%t(:ncol,:)
2092 2314006344 : t_utend(:ncol,:) = state%u(:ncol,:)
2093 2314006344 : t_vtend(:ncol,:) = state%v(:ncol,:)
2094 :
2095 2978352 : end subroutine diag_phys_tend_writeout_dry
2096 :
2097 : !#######################################################################
2098 :
2099 1489176 : subroutine diag_phys_tend_writeout_moist(state, pbuf, tend, ztodt, &
2100 : qini, cldliqini, cldiceini)
2101 :
2102 : !---------------------------------------------------------------
2103 : !
2104 : ! Purpose: Dump physics tendencies for moisture
2105 : !
2106 : !---------------------------------------------------------------
2107 :
2108 : ! Arguments
2109 :
2110 : type(physics_state), intent(in) :: state
2111 :
2112 : type(physics_buffer_desc), pointer :: pbuf(:)
2113 : type(physics_tend ), intent(in) :: tend
2114 : real(r8), intent(in) :: ztodt ! physics timestep
2115 : real(r8), intent(in) :: qini (pcols,pver) ! tracer fields at beginning of physics
2116 : real(r8), intent(in) :: cldliqini (pcols,pver) ! tracer fields at beginning of physics
2117 : real(r8), intent(in) :: cldiceini (pcols,pver) ! tracer fields at beginning of physics
2118 :
2119 : !---------------------------Local workspace-----------------------------
2120 :
2121 : integer :: lchnk ! chunk index
2122 : integer :: ncol ! number of columns in chunk
2123 : real(r8) :: ftem3(pcols,pver) ! Temporary workspace for outfld variables
2124 : real(r8) :: rtdt
2125 : integer :: ixcldice, ixcldliq! constituent indices for cloud liquid and ice water.
2126 :
2127 1489176 : lchnk = state%lchnk
2128 1489176 : ncol = state%ncol
2129 1489176 : rtdt = 1._r8/ztodt
2130 1489176 : call cnst_get_ind('CLDLIQ', ixcldliq, abort=.false.)
2131 1489176 : call cnst_get_ind('CLDICE', ixcldice, abort=.false.)
2132 :
2133 1489176 : if ( cnst_cam_outfld( 1) ) then
2134 1489176 : call outfld (apcnst( 1), state%q(1,1, 1), pcols, lchnk)
2135 : end if
2136 1489176 : if (ixcldliq > 0) then
2137 1489176 : if (cnst_cam_outfld(ixcldliq)) then
2138 1489176 : call outfld (apcnst(ixcldliq), state%q(1,1,ixcldliq), pcols, lchnk)
2139 : end if
2140 : end if
2141 1489176 : if (ixcldice > 0) then
2142 1489176 : if ( cnst_cam_outfld(ixcldice) ) then
2143 1489176 : call outfld (apcnst(ixcldice), state%q(1,1,ixcldice), pcols, lchnk)
2144 : end if
2145 : end if
2146 :
2147 : ! Total physics tendency for moisture and other tracers
2148 :
2149 1489176 : if ( cnst_cam_outfld( 1) ) then
2150 2314006344 : ftem3(:ncol,:pver) = (state%q(:ncol,:pver, 1) - qini (:ncol,:pver) )*rtdt
2151 1489176 : call outfld (ptendnam( 1), ftem3, pcols, lchnk)
2152 : end if
2153 1489176 : if (ixcldliq > 0) then
2154 1489176 : if (cnst_cam_outfld(ixcldliq) ) then
2155 2314006344 : ftem3(:ncol,:pver) = (state%q(:ncol,:pver,ixcldliq) - cldliqini(:ncol,:pver) )*rtdt
2156 1489176 : call outfld (ptendnam(ixcldliq), ftem3, pcols, lchnk)
2157 : end if
2158 : end if
2159 1489176 : if (ixcldice > 0) then
2160 1489176 : if ( cnst_cam_outfld(ixcldice) ) then
2161 2314006344 : ftem3(:ncol,:pver) = (state%q(:ncol,:pver,ixcldice) - cldiceini(:ncol,:pver) )*rtdt
2162 1489176 : call outfld (ptendnam(ixcldice), ftem3, pcols, lchnk)
2163 : end if
2164 : end if
2165 :
2166 1489176 : end subroutine diag_phys_tend_writeout_moist
2167 :
2168 : !#######################################################################
2169 :
2170 1489176 : subroutine diag_phys_tend_writeout(state, pbuf, tend, ztodt, &
2171 : qini, cldliqini, cldiceini)
2172 :
2173 : !---------------------------------------------------------------
2174 : !
2175 : ! Purpose: Dump physics tendencies for moisture and temperature
2176 : !
2177 : !---------------------------------------------------------------
2178 :
2179 : ! Arguments
2180 :
2181 : type(physics_state), intent(in) :: state
2182 :
2183 : type(physics_buffer_desc), pointer :: pbuf(:)
2184 : type(physics_tend ), intent(in) :: tend
2185 : real(r8), intent(in) :: ztodt ! physics timestep
2186 : real(r8), intent(in) :: qini (pcols,pver) ! tracer fields at beginning of physics
2187 : real(r8), intent(in) :: cldliqini (pcols,pver) ! tracer fields at beginning of physics
2188 : real(r8), intent(in) :: cldiceini (pcols,pver) ! tracer fields at beginning of physics
2189 :
2190 : !-----------------------------------------------------------------------
2191 :
2192 1489176 : call diag_phys_tend_writeout_dry(state, pbuf, tend, ztodt)
2193 1489176 : if (moist_physics) then
2194 : call diag_phys_tend_writeout_moist(state, pbuf, tend, ztodt, &
2195 1489176 : qini, cldliqini, cldiceini)
2196 : end if
2197 :
2198 1489176 : end subroutine diag_phys_tend_writeout
2199 :
2200 : !#######################################################################
2201 :
2202 1495368 : subroutine diag_state_b4_phys_write_dry (state)
2203 : !
2204 : !---------------------------------------------------------------
2205 : !
2206 : ! Purpose: Dump dry state just prior to executing physics
2207 : !
2208 : !---------------------------------------------------------------
2209 : !
2210 : ! Arguments
2211 : !
2212 : type(physics_state), intent(in) :: state
2213 : !
2214 : !---------------------------Local workspace-----------------------------
2215 : !
2216 : integer :: lchnk ! chunk index
2217 : !
2218 : !-----------------------------------------------------------------------
2219 : !
2220 1495368 : lchnk = state%lchnk
2221 :
2222 1495368 : call outfld('TBP', state%t, pcols, lchnk )
2223 1495368 : call outfld('UBP', state%u, pcols, lchnk )
2224 1495368 : call outfld('VBP', state%v, pcols, lchnk )
2225 :
2226 1495368 : end subroutine diag_state_b4_phys_write_dry
2227 :
2228 1495368 : subroutine diag_state_b4_phys_write_moist (state)
2229 : !
2230 : !---------------------------------------------------------------
2231 : !
2232 : ! Purpose: Dump moist state just prior to executing physics
2233 : !
2234 : !---------------------------------------------------------------
2235 : !
2236 : ! Arguments
2237 : !
2238 : type(physics_state), intent(in) :: state
2239 : !
2240 : !---------------------------Local workspace-----------------------------
2241 : !
2242 : integer :: ixcldice, ixcldliq ! constituent indices for cloud liquid and ice water.
2243 : integer :: lchnk ! chunk index
2244 : !
2245 : !-----------------------------------------------------------------------
2246 : !
2247 1495368 : lchnk = state%lchnk
2248 :
2249 1495368 : call cnst_get_ind('CLDLIQ', ixcldliq, abort=.false.)
2250 1495368 : call cnst_get_ind('CLDICE', ixcldice, abort=.false.)
2251 :
2252 1495368 : if ( cnst_cam_outfld( 1) ) then
2253 1495368 : call outfld (bpcnst( 1), state%q(1,1, 1), pcols, lchnk)
2254 : end if
2255 1495368 : if (ixcldliq > 0) then
2256 1495368 : if (cnst_cam_outfld(ixcldliq)) then
2257 1495368 : call outfld (bpcnst(ixcldliq), state%q(1,1,ixcldliq), pcols, lchnk)
2258 : end if
2259 : end if
2260 1495368 : if (ixcldice > 0) then
2261 1495368 : if (cnst_cam_outfld(ixcldice)) then
2262 1495368 : call outfld (bpcnst(ixcldice), state%q(1,1,ixcldice), pcols, lchnk)
2263 : end if
2264 : end if
2265 :
2266 1495368 : end subroutine diag_state_b4_phys_write_moist
2267 :
2268 1495368 : subroutine diag_state_b4_phys_write (state)
2269 : !
2270 : !---------------------------------------------------------------
2271 : !
2272 : ! Purpose: Dump state just prior to executing physics
2273 : !
2274 : !---------------------------------------------------------------
2275 : !
2276 : ! Arguments
2277 : !
2278 : type(physics_state), intent(in) :: state
2279 : !
2280 :
2281 1495368 : call diag_state_b4_phys_write_dry(state)
2282 1495368 : if (moist_physics) then
2283 1495368 : call diag_state_b4_phys_write_moist(state)
2284 : end if
2285 1495368 : end subroutine diag_state_b4_phys_write
2286 :
2287 0 : end module cam_diagnostics
|
