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