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