Line data Source code
1 : !------------------------------------------------------------------------
2 : ! $Id$
3 : !===============================================================================
4 : module numerical_check
5 :
6 : implicit none
7 :
8 : ! Made is_nan_2d public so it may be used
9 : ! for finding code that cause NaNs
10 : ! Joshua Fasching November 2007
11 :
12 : ! *_check subroutines were added to ensure that the
13 : ! subroutines they are checking perform correctly
14 : ! Joshua Fasching February 2008
15 :
16 : ! rad_clipping has been replaced by rad_check as the new
17 : ! subroutine only reports if there are invalid values.
18 : ! Joshua Fasching March 2008
19 :
20 : private ! Default scope
21 :
22 : public :: invalid_model_arrays, is_nan_2d, &
23 : rad_check, parameterization_check, &
24 : sfc_varnce_check, pdf_closure_check, &
25 : length_check, is_nan_sclr, calculate_spurious_source
26 :
27 : private :: check_negative, check_nan
28 :
29 :
30 : ! Abstraction of check_nan
31 : interface check_nan
32 : module procedure check_nan_sclr, check_nan_2d
33 : end interface
34 :
35 : ! Abstraction of check_negative
36 : interface check_negative
37 : module procedure check_negative_index!, check_negative_total
38 : end interface
39 :
40 :
41 : contains
42 : !---------------------------------------------------------------------------------
43 0 : subroutine length_check( nz, Lscale, Lscale_up, Lscale_down )
44 : !
45 : ! Description: This subroutine determines if any of the output
46 : ! variables for the length_new subroutine carry values that
47 : ! are NaNs.
48 : !
49 : ! Joshua Fasching February 2008
50 : !---------------------------------------------------------------------------------
51 :
52 : use clubb_precision, only: &
53 : core_rknd ! Variable(s)
54 :
55 : implicit none
56 :
57 : integer, intent(in) :: &
58 : nz
59 :
60 : ! Constant Parameters
61 : character(*), parameter :: proc_name = "compute_mixing_length"
62 :
63 : ! Input Variables
64 : real( kind = core_rknd ), dimension(nz), intent(in) :: &
65 : Lscale, & ! Mixing length [m]
66 : Lscale_up, & ! Upward mixing length [m]
67 : Lscale_down ! Downward mixing length [m]
68 :
69 : !-----------------------------------------------------------------------------
70 :
71 0 : call check_nan( Lscale, "Lscale", proc_name ) ! intnet(in)
72 0 : call check_nan( Lscale_up, "Lscale_up", proc_name ) ! intent(in)
73 0 : call check_nan( Lscale_down, "Lscale_down", proc_name ) ! intent(in)
74 :
75 0 : return
76 : end subroutine length_check
77 :
78 : !---------------------------------------------------------------------------
79 0 : subroutine pdf_closure_check( nz, wp4, wprtp2, wp2rtp, wpthlp2, &
80 0 : wp2thlp, cloud_frac, rcm, wpthvp, wp2thvp, &
81 0 : rtpthvp, thlpthvp, wprcp, wp2rcp, &
82 0 : rtprcp, thlprcp, rcp2, wprtpthlp, &
83 0 : crt_1, crt_2, cthl_1, cthl_2, pdf_params, &
84 0 : sclrpthvp, sclrprcp, wpsclrp2, &
85 0 : wpsclrprtp, wpsclrpthlp, wp2sclrp, &
86 : stats_metadata )
87 :
88 : ! Description: This subroutine determines if any of the output
89 : ! variables for the pdf_closure subroutine carry values that
90 : ! are NaNs.
91 : !
92 : ! Joshua Fasching February 2008
93 : !---------------------------------------------------------------------------
94 :
95 : use parameters_model, only: &
96 : sclr_dim ! Variable
97 :
98 : use pdf_parameter_module, only: &
99 : pdf_parameter ! type
100 :
101 : use clubb_precision, only: &
102 : core_rknd ! Variable(s)
103 :
104 : use stats_variables, only: &
105 : stats_metadata_type
106 :
107 : implicit none
108 :
109 : integer, intent(in) :: &
110 : nz
111 :
112 : ! Parameter Constants
113 : character(len=*), parameter :: proc_name = &
114 : "pdf_closure"
115 :
116 : ! Input Variables
117 : real( kind = core_rknd ), dimension(nz), intent(in) :: &
118 : wp4, & ! w'^4 [m^4/s^4]
119 : wprtp2, & ! w' r_t' [(m kg)/(s kg)]
120 : wp2rtp, & ! w'^2 r_t' [(m^2 kg)/(s^2 kg)]
121 : wpthlp2, & ! w' th_l'^2 [(m K^2)/s]
122 : wp2thlp, & ! w'^2 th_l' [(m^2 K)/s^2]
123 : cloud_frac, & ! Cloud fraction [-]
124 : rcm, & ! Mean liquid water [kg/kg]
125 : wpthvp, & ! Buoyancy flux [(K m)/s]
126 : wp2thvp, & ! w'^2 th_v' [(m^2 K)/s^2]
127 : rtpthvp, & ! r_t' th_v' [(kg K)/kg]
128 : thlpthvp, & ! th_l' th_v' [K^2]
129 : wprcp, & ! w' r_c' [(m kg)/(s kg)]
130 : wp2rcp, & ! w'^2 r_c' [(m^2 kg)/(s^2 kg)]
131 : rtprcp, & ! r_t' r_c' [(kg^2)/(kg^2)]
132 : thlprcp, & ! th_l' r_c' [(K kg)/kg]
133 : rcp2, & ! r_c'^2 [(kg^2)/(kg^2)]
134 : wprtpthlp, & ! w' r_t' th_l' [(m kg K)/(s kg)]
135 : crt_1, crt_2, &
136 : cthl_1, cthl_2
137 :
138 : type(pdf_parameter), intent(in) :: &
139 : pdf_params ! PDF parameters [units vary]
140 :
141 : ! Input (Optional passive scalar variables)
142 : real( kind = core_rknd ), dimension(nz,sclr_dim), intent(in) :: &
143 : sclrpthvp, &
144 : sclrprcp, &
145 : wpsclrp2, &
146 : wpsclrprtp, &
147 : wpsclrpthlp, &
148 : wp2sclrp
149 :
150 : type (stats_metadata_type), intent(in) :: &
151 : stats_metadata
152 :
153 : integer :: i ! Scalar loop index
154 :
155 : !-------------------------------------------------------------------------------
156 :
157 : ! ---- Begin Code ----
158 :
159 0 : if ( stats_metadata%iwp4 > 0 ) call check_nan( wp4,"wp4", proc_name ) ! intent(in)
160 0 : if ( stats_metadata%iwprtp2 > 0 ) call check_nan( wprtp2,"wprtp2", proc_name ) ! intent(in)
161 0 : call check_nan( wp2rtp,"wp2rtp", proc_name ) ! intent(in)
162 0 : if ( stats_metadata%iwpthlp2 > 0 ) call check_nan( wpthlp2,"wpthlp2", proc_name ) ! intnet(in)
163 0 : call check_nan( wp2thlp,"wp2thlp", proc_name ) ! intent(in)
164 0 : call check_nan( cloud_frac,"cloud_frac", proc_name ) ! intent(in)
165 0 : call check_nan( rcm,"rcm", proc_name ) ! intent(in)
166 0 : call check_nan( wpthvp, "wpthvp", proc_name ) ! intent(in)
167 0 : call check_nan( wp2thvp, "wp2thvp", proc_name ) ! intent(in)
168 0 : call check_nan( rtpthvp, "rtpthvp", proc_name ) ! intent(in)
169 0 : call check_nan( thlpthvp, "thlpthvp", proc_name ) ! intent(in)
170 0 : call check_nan( wprcp, "wprcp", proc_name ) ! intent(in)
171 0 : call check_nan( wp2rcp, "wp2rcp", proc_name ) ! intent(in)
172 0 : call check_nan( rtprcp, "rtprcp", proc_name ) ! intent(in)
173 0 : call check_nan( thlprcp, "thlprcp", proc_name ) ! intent(in)
174 0 : if ( stats_metadata%ircp2 > 0 ) call check_nan( rcp2, "rcp2", proc_name ) ! intent(in)
175 0 : if ( stats_metadata%iwprtpthlp > 0 ) call check_nan( wprtpthlp, "wprtpthlp", proc_name ) ! intnet(in)
176 0 : call check_nan( crt_1, "crt_1", proc_name ) ! intent(in)
177 0 : call check_nan( crt_2, "crt_2", proc_name ) ! intent(in)
178 0 : call check_nan( cthl_1, "cthl_1", proc_name ) ! intent(in)
179 0 : call check_nan( cthl_2, "cthl_2", proc_name ) ! intent(in)
180 : ! Check each PDF parameter at the grid level sent in.
181 0 : call check_nan( pdf_params%w_1(1,:), "pdf_params%w_1(1,:)", proc_name ) ! intent(in)
182 0 : call check_nan( pdf_params%w_2(1,:), "pdf_params%w_2(1,:)", proc_name ) ! intnet(in)
183 : call check_nan( pdf_params%varnce_w_1(1,:), "pdf_params%varnce_w_1(1,:)", & ! intent(in)
184 0 : proc_name ) ! intent(in)
185 : call check_nan( pdf_params%varnce_w_2(1,:), "pdf_params%varnce_w_2(1,:)", & ! intent(in)
186 0 : proc_name ) ! intent(in)
187 0 : call check_nan( pdf_params%rt_1(1,:), "pdf_params%rt_1(1,:)", proc_name ) ! intent(in)
188 0 : call check_nan( pdf_params%rt_2(1,:), "pdf_params%rt_2(1,:)", proc_name ) ! intent(in)
189 : call check_nan( pdf_params%varnce_rt_1(1,:), "pdf_params%varnce_rt_1(1,:)", & ! intent(in)
190 0 : proc_name ) ! intent(in)
191 : call check_nan( pdf_params%varnce_rt_2(1,:), "pdf_params%varnce_rt_2(1,:)", & ! intent(in)
192 0 : proc_name ) ! intent(in)
193 0 : call check_nan( pdf_params%thl_1(1,:), "pdf_params%thl_1(1,:)", proc_name ) ! intent(in)
194 0 : call check_nan( pdf_params%thl_2(1,:), "pdf_params%thl_2(1,:)", proc_name ) ! intent(in)
195 : call check_nan( pdf_params%varnce_thl_1(1,:), "pdf_params%varnce_thl_1(1,:)", & ! intent(in)
196 0 : proc_name ) ! intent(in)
197 : call check_nan( pdf_params%varnce_thl_2(1,:), "pdf_params%varnce_thl_2(1,:)", & ! intent(in)
198 0 : proc_name ) ! intent(in)
199 : call check_nan( pdf_params%mixt_frac(1,:), "pdf_params%mixt_frac(1,:)", & ! intent(in)
200 0 : proc_name ) ! intent(in)
201 : call check_nan( pdf_params%corr_w_rt_1(1,:), "pdf_params%corr_w_rt_1(1,:)", & ! intent(in)
202 0 : proc_name ) ! intent(in)
203 : call check_nan( pdf_params%corr_w_rt_2(1,:), "pdf_params%corr_w_rt_2(1,:)", & ! intent(in)
204 0 : proc_name ) ! intent(in)
205 : call check_nan( pdf_params%corr_w_thl_1(1,:), "pdf_params%corr_w_thl_1(1,:)", & ! intent(in)
206 0 : proc_name ) ! intent(in)
207 : call check_nan( pdf_params%corr_w_thl_2(1,:), "pdf_params%corr_w_thl_2(1,:)", & ! intent(in)
208 0 : proc_name ) ! intent(in)
209 : call check_nan( pdf_params%corr_rt_thl_1(1,:), "pdf_params%corr_rt_thl_1(1,:)", & ! intent(in)
210 0 : proc_name ) ! intent(in)
211 : call check_nan( pdf_params%corr_rt_thl_2(1,:), "pdf_params%corr_rt_thl_2(1,:)", & ! intent(in)
212 0 : proc_name ) ! intent(in)
213 0 : call check_nan( pdf_params%rc_1(1,:), "pdf_params%rc_1(1,:)", proc_name ) ! intent(in)
214 0 : call check_nan( pdf_params%rc_2(1,:), "pdf_params%rc_2(1,:)", proc_name ) ! intent(in)
215 : call check_nan( pdf_params%rsatl_1(1,:), "pdf_params%rsatl_1(1,:)", & ! intent(in)
216 0 : proc_name ) ! intent(in)
217 : call check_nan( pdf_params%rsatl_2(1,:), "pdf_params%rsatl_2(1,:)", & ! intent(in)
218 0 : proc_name ) ! intent(in)
219 : call check_nan( pdf_params%cloud_frac_1(1,:), "pdf_params%cloud_frac_1(1,:)", & ! intent(in)
220 0 : proc_name ) ! intent(in)
221 : call check_nan( pdf_params%cloud_frac_2(1,:), "pdf_params%cloud_frac_2(1,:)", & ! intent(in)
222 0 : proc_name ) ! intent(in)
223 0 : call check_nan( pdf_params%chi_1(1,:), "pdf_params%chi_1(1,:)", proc_name ) ! intent(in)
224 0 : call check_nan( pdf_params%chi_2(1,:), "pdf_params%chi_2(1,:)", proc_name ) ! intent(in)
225 : call check_nan( pdf_params%stdev_chi_1(1,:), "pdf_params%stdev_chi_1(1,:)", &! intent(in)
226 0 : proc_name ) ! intent(in)
227 : call check_nan( pdf_params%stdev_chi_2(1,:), "pdf_params%stdev_chi_2(1,:)", & ! intent(in)
228 0 : proc_name ) ! intent(in)
229 : call check_nan( pdf_params%stdev_eta_1(1,:), "pdf_params%stdev_eta_1(1,:)", & ! intent(in)
230 0 : proc_name ) ! intent(in)
231 : call check_nan( pdf_params%stdev_eta_2(1,:), "pdf_params%stdev_eta_2(1,:)", & ! intent(in)
232 0 : proc_name ) ! intent(in)
233 : call check_nan( pdf_params%covar_chi_eta_1(1,:), "pdf_params%covar_chi_eta_1(1,:)",&!intent(in)
234 0 : proc_name ) ! intent(in)
235 : call check_nan( pdf_params%covar_chi_eta_2(1,:), "pdf_params%covar_chi_eta_2(1,:)",&!intent(in)
236 0 : proc_name ) ! intent(in)
237 : call check_nan( pdf_params%corr_w_chi_1(1,:), "pdf_params%corr_w_chi_1(1,:)", & ! intent(in)
238 0 : proc_name ) ! intent(in)
239 : call check_nan( pdf_params%corr_w_chi_2(1,:), "pdf_params%corr_w_chi_2(1,:)", & ! intent(in)
240 0 : proc_name ) ! intent(in)
241 : call check_nan( pdf_params%corr_w_eta_1(1,:), "pdf_params%corr_w_eta_1(1,:)", & ! intent(in)
242 0 : proc_name ) ! intent(in)
243 : call check_nan( pdf_params%corr_w_eta_2(1,:), "pdf_params%corr_w_eta_2(1,:)", & ! intent(in)
244 0 : proc_name ) ! intent(in)
245 : call check_nan( pdf_params%corr_chi_eta_1(1,:), "pdf_params%corr_chi_eta_1(1,:)", & !intent(in)
246 0 : proc_name ) ! intent(in)
247 : call check_nan( pdf_params%corr_chi_eta_2(1,:), "pdf_params%corr_chi_eta_2(1,:)", & !intent(in)
248 0 : proc_name ) ! intent(in)
249 : call check_nan( pdf_params%alpha_thl(1,:), "pdf_params%alpha_thl(1,:)", & ! intent(in)
250 0 : proc_name ) ! intent(in)
251 : call check_nan( pdf_params%alpha_rt(1,:), "pdf_params%alpha_rt(1,:)", & ! intent(in)
252 0 : proc_name ) ! intent(in)
253 : call check_nan( pdf_params%ice_supersat_frac_1(1,:), & ! intent(in)
254 0 : "pdf_params%ice_supersat_frac_1(1,:)", proc_name ) ! intent(in)
255 : call check_nan( pdf_params%ice_supersat_frac_2(1,:), & ! intent(in)
256 0 : "pdf_params%ice_supersat_frac_2(1,:)", proc_name ) ! intent(in)
257 :
258 0 : if ( sclr_dim > 0 ) then
259 0 : do i = 1, sclr_dim, 1
260 : call check_nan( sclrpthvp(:,i),"sclrpthvp", & ! intent(in)
261 0 : proc_name ) ! intent(in)
262 : call check_nan( sclrprcp(:,i), "sclrprcp", & ! intent(in)
263 0 : proc_name ) ! intent(in)
264 : call check_nan( wpsclrprtp(:,i), "wpsclrprtp", & ! intent(in)
265 0 : proc_name ) ! intent(in)
266 : call check_nan( wpsclrp2(:,i), "wpsclrp2", & ! intent(in)
267 0 : proc_name ) ! intent(in)
268 : call check_nan( wpsclrpthlp(:,i), "wpsclrtlp", & ! intent(in)
269 0 : proc_name ) ! intent(in)
270 : call check_nan( wp2sclrp(:,i), "wp2sclrp", & ! intent(in)
271 0 : proc_name ) ! intent(in)
272 : enddo ! i = 1, sclr_dim, 1
273 : endif
274 :
275 0 : return
276 : end subroutine pdf_closure_check
277 :
278 : !-------------------------------------------------------------------------------
279 0 : subroutine parameterization_check &
280 0 : ( nz, thlm_forcing, rtm_forcing, um_forcing, & ! intent(in)
281 0 : vm_forcing, wm_zm, wm_zt, p_in_Pa, & ! intent(in)
282 0 : rho_zm, rho, exner, rho_ds_zm, & ! intent(in)
283 0 : rho_ds_zt, invrs_rho_ds_zm, invrs_rho_ds_zt, & ! intent(in)
284 0 : thv_ds_zm, thv_ds_zt, wpthlp_sfc, wprtp_sfc, upwp_sfc, & ! intent(in)
285 0 : vpwp_sfc, um, upwp, vm, vpwp, up2, vp2, & ! intent(in)
286 0 : rtm, wprtp, thlm, wpthlp, wp2, wp3, & ! intent(in)
287 0 : rtp2, thlp2, rtpthlp, & ! intent(in)
288 : ! rcm, &
289 : prefix, & ! intent(in)
290 0 : wpsclrp_sfc, wpedsclrp_sfc, sclrm, wpsclrp, sclrp2, & ! intent(in)
291 0 : sclrprtp, sclrpthlp, sclrm_forcing, edsclrm, edsclrm_forcing ) ! intent(in)
292 :
293 : !
294 : ! Description:
295 : ! This subroutine determines what input variables may have NaN values.
296 : ! In addition it checks to see if rho_zm, rho, exner, up2, vp2, rtm, thlm,
297 : ! wp2, rtp2, thlp2, or tau_zm have negative values.
298 : !-------------------------------------------------------------------------------
299 :
300 : use grid_class, only: &
301 : grid ! Type
302 :
303 : use parameters_model, only: &
304 : sclr_dim, & ! Variable
305 : edsclr_dim
306 :
307 : use clubb_precision, only: &
308 : core_rknd ! Variable(s)
309 :
310 : use error_code, only: &
311 : clubb_at_least_debug_level, & ! Procedure
312 : err_code, & ! Error Indicator
313 : clubb_no_error, & ! Constants
314 : clubb_fatal_error
315 :
316 : use T_in_K_module, only: &
317 : thlm2T_in_K ! Procedure
318 :
319 : use constants_clubb, only: &
320 : fstderr ! Variable
321 :
322 : implicit none
323 :
324 : integer, intent(in) :: &
325 : nz
326 :
327 : ! Constant Parameters
328 : ! Name of the procedure using parameterization_check
329 : character(len=18), parameter :: &
330 : proc_name = "advance_clubb_core"
331 :
332 : ! Input variables
333 : real( kind = core_rknd ), intent(in), dimension(nz) :: &
334 : thlm_forcing, & ! theta_l forcing (thermodynamic levels) [K/s]
335 : rtm_forcing, & ! r_t forcing (thermodynamic levels) [(kg/kg)/s]
336 : um_forcing, & ! u wind forcing (thermodynamic levels) [m/s/s]
337 : vm_forcing, & ! v wind forcing (thermodynamic levels) [m/s/s]
338 : wm_zm, & ! w mean wind component on momentum levels [m/s]
339 : wm_zt, & ! w mean wind component on thermo. levels [m/s]
340 : p_in_Pa, & ! Air pressure (thermodynamic levels) [Pa]
341 : rho_zm, & ! Air density on momentum levels [kg/m^3]
342 : rho, & ! Air density on thermodynamic levels [kg/m^3]
343 : exner, & ! Exner function (thermodynamic levels) [-]
344 : rho_ds_zm, & ! Dry, static density on momentum levels [kg/m^3]
345 : rho_ds_zt, & ! Dry, static density on thermo. levels [kg/m^3]
346 : invrs_rho_ds_zm, & ! Inv. dry, static density @ momentum levs. [m^3/kg]
347 : invrs_rho_ds_zt, & ! Inv. dry, static density @ thermo. levs. [m^3/kg]
348 : thv_ds_zm, & ! Dry, base-state theta_v on momentum levs. [K]
349 : thv_ds_zt!, & ! Dry, base-state theta_v on thermo. levs. [K]
350 : ! rcm ! Cloud water mixing ratio [kg/kg] - Unused
351 :
352 : real( kind = core_rknd ), intent(in) :: &
353 : wpthlp_sfc, & ! w' theta_l' at surface. [(m K)/s]
354 : wprtp_sfc, & ! w' r_t' at surface. [(kg m)/( kg s)]
355 : upwp_sfc, & ! u'w' at surface. [m^2/s^2]
356 : vpwp_sfc ! v'w' at surface. [m^2/s^2]
357 :
358 : ! These are prognostic or are planned to be in the future
359 : real( kind = core_rknd ), intent(in), dimension(nz) :: &
360 : um, & ! u mean wind component (thermodynamic levels) [m/s]
361 : upwp, & ! u'w' (momentum levels) [m^2/s^2]
362 : vm, & ! v mean wind component (thermodynamic levels) [m/s]
363 : vpwp, & ! v'w' (momentum levels) [m^2/s^2]
364 : up2, & ! u'^2 (momentum levels) [m^2/s^2]
365 : vp2, & ! v'^2 (momentum levels) [m^2/s^2]
366 : rtm, & ! total water mixing ratio, r_t (thermo. levels) [kg/kg]
367 : wprtp, & ! w' r_t' (momentum levels) [(kg/kg) m/s]
368 : thlm, & ! liq. water pot. temp., th_l (thermo. levels) [K]
369 : wpthlp, & ! w' th_l' (momentum levels) [(m/s) K]
370 : rtp2, & ! r_t'^2 (momentum levels) [(kg/kg)^2]
371 : thlp2, & ! th_l'^2 (momentum levels) [K^2]
372 : rtpthlp, & ! r_t' th_l' (momentum levels) [(kg/kg) K]
373 : wp2, & ! w'^2 (momentum levels) [m^2/s^2]
374 : wp3 ! w'^3 (thermodynamic levels) [m^3/s^3]
375 :
376 : character(len=*), intent(in) :: prefix ! Location where subroutine is called
377 :
378 : real( kind = core_rknd ), intent(in), dimension(sclr_dim) :: &
379 : wpsclrp_sfc ! Scalar flux at surface [units m/s]
380 :
381 : real( kind = core_rknd ), intent(in), dimension(edsclr_dim) :: &
382 : wpedsclrp_sfc ! Eddy-Scalar flux at surface [units m/s]
383 :
384 : real( kind = core_rknd ), intent(in),dimension(nz,sclr_dim) :: &
385 : sclrm, & ! Passive scalar mean [units vary]
386 : wpsclrp, & ! w'sclr' [units vary]
387 : sclrp2, & ! sclr'^2 [units vary]
388 : sclrprtp, & ! sclr'rt' [units vary]
389 : sclrpthlp, & ! sclr'thl' [units vary]
390 : sclrm_forcing ! Passive scalar forcing [units / s]
391 :
392 : real( kind = core_rknd ), intent(in),dimension(nz,edsclr_dim) :: &
393 : edsclrm, & ! Eddy passive scalar mean [units vary]
394 : edsclrm_forcing ! Eddy passive scalar forcing [units / s]
395 :
396 : ! Local Variables
397 : integer :: i ! Loop iterator for the scalars
398 : integer :: k ! Vertical grid level
399 :
400 : !-------- Input Nan Check ----------------------------------------------
401 :
402 0 : call check_nan( thlm_forcing, "thlm_forcing", prefix//proc_name ) ! intent(in)
403 0 : call check_nan( rtm_forcing,"rtm_forcing", prefix//proc_name ) ! intent(in)
404 0 : call check_nan( um_forcing,"um_forcing", prefix//proc_name ) ! intent(in)
405 0 : call check_nan( vm_forcing,"vm_forcing", prefix//proc_name ) ! intent(in)
406 :
407 0 : call check_nan( wm_zm, "wm_zm", prefix//proc_name ) ! intent(in)
408 0 : call check_nan( wm_zt, "wm_zt", prefix//proc_name ) ! intent(in)
409 0 : call check_nan( p_in_Pa, "p_in_Pa", prefix//proc_name ) ! intent(in)
410 0 : call check_nan( rho_zm, "rho_zm", prefix//proc_name ) ! intent(in)
411 0 : call check_nan( rho, "rho", prefix//proc_name ) ! intent(in)
412 0 : call check_nan( exner, "exner", prefix//proc_name ) ! intent(in)
413 0 : call check_nan( rho_ds_zm, "rho_ds_zm", prefix//proc_name ) ! intent(in)
414 0 : call check_nan( rho_ds_zt, "rho_ds_zt", prefix//proc_name ) ! intent(in)
415 0 : call check_nan( invrs_rho_ds_zm, "invrs_rho_ds_zm", prefix//proc_name ) ! intent(in)
416 0 : call check_nan( invrs_rho_ds_zt, "invrs_rho_ds_zt", prefix//proc_name ) ! intent(in)
417 0 : call check_nan( thv_ds_zm, "thv_ds_zm", prefix//proc_name ) ! intent(in)
418 0 : call check_nan( thv_ds_zt, "thv_ds_zt", prefix//proc_name ) ! intent(in)
419 :
420 0 : call check_nan( um, "um", prefix//proc_name ) ! intent(in)
421 0 : call check_nan( upwp, "upwp", prefix//proc_name ) ! intent(in)
422 0 : call check_nan( vm, "vm", prefix//proc_name ) ! intent(in)
423 0 : call check_nan( vpwp, "vpwp", prefix//proc_name ) ! intent(in)
424 0 : call check_nan( up2, "up2", prefix//proc_name ) ! intent(in)
425 0 : call check_nan( vp2, "vp2", prefix//proc_name ) ! intent(in)
426 0 : call check_nan( rtm, "rtm", prefix//proc_name ) ! intent(in)
427 0 : call check_nan( wprtp, "wprtp", prefix//proc_name ) ! intent(in)
428 0 : call check_nan( thlm, "thlm", prefix//proc_name ) ! intent(in)
429 0 : call check_nan( wpthlp, "wpthlp", prefix//proc_name ) ! intent(in)
430 0 : call check_nan( wp2, "wp2", prefix//proc_name ) ! intent(in)
431 0 : call check_nan( wp3, "wp3", prefix//proc_name ) ! intent(in)
432 0 : call check_nan( rtp2, "rtp2", prefix//proc_name ) ! intent(in)
433 0 : call check_nan( thlp2, "thlp2", prefix//proc_name ) ! intent(in)
434 0 : call check_nan( rtpthlp, "rtpthlp", prefix//proc_name ) ! intent(in)
435 :
436 0 : call check_nan( wpthlp_sfc, "wpthlp_sfc", prefix//proc_name ) ! intent(in)
437 0 : call check_nan( wprtp_sfc, "wprtp_sfc", prefix//proc_name ) ! intent(in)
438 0 : call check_nan( upwp_sfc, "upwp_sfc", prefix//proc_name ) ! intent(in)
439 0 : call check_nan( vpwp_sfc, "vpwp_sfc", prefix//proc_name ) ! intent(in)
440 :
441 0 : do i = 1, sclr_dim
442 :
443 : call check_nan( sclrm_forcing(2:,i),"sclrm_forcing", & ! intent(in)
444 0 : prefix//proc_name ) ! intent(in)
445 :
446 0 : call check_nan( wpsclrp_sfc(i),"wpsclrp_sfc", & ! intent(in)
447 0 : prefix//proc_name ) ! intent(in)
448 :
449 0 : call check_nan( sclrm(2:,i),"sclrm", prefix//proc_name ) ! intent(in)
450 0 : call check_nan( wpsclrp(:,i),"wpsclrp", prefix//proc_name ) ! intent(in)
451 0 : call check_nan( sclrp2(:,i),"sclrp2", prefix//proc_name ) ! intent(in)
452 0 : call check_nan( sclrprtp(:,i),"sclrprtp", prefix//proc_name ) ! intent(in)
453 0 : call check_nan( sclrpthlp(:,i),"sclrpthlp", prefix//proc_name ) ! intent(in)
454 :
455 : end do
456 :
457 :
458 0 : do i = 1, edsclr_dim
459 :
460 0 : call check_nan( edsclrm_forcing(2:,i),"edsclrm_forcing", prefix//proc_name ) ! intent(in)
461 :
462 0 : call check_nan( wpedsclrp_sfc(i),"wpedsclrp_sfc", & ! intent(in)
463 0 : prefix//proc_name ) ! intent(in)
464 :
465 0 : call check_nan( edsclrm(2:,i),"edsclrm", prefix//proc_name ) ! intent(in)
466 :
467 : enddo
468 :
469 : !---------------------------------------------------------------------
470 :
471 0 : if ( clubb_at_least_debug_level( 0 ) ) then
472 0 : if ( err_code == clubb_fatal_error ) then
473 : return
474 : end if
475 : end if
476 :
477 0 : call check_negative( rtm, 2, nz, "rtm", prefix//proc_name ) ! intent(in)
478 0 : call check_negative( p_in_Pa, 2, nz, "p_in_Pa", prefix//proc_name ) ! intent(in)
479 0 : call check_negative( rho, 2, nz, "rho", prefix//proc_name ) ! intent(in)
480 0 : call check_negative( rho_zm, 1, nz, "rho_zm", prefix//proc_name ) ! intent(in)
481 0 : call check_negative( exner, 2, nz, "exner", prefix//proc_name ) ! intent(in)
482 0 : call check_negative( rho_ds_zm, 1, nz, "rho_ds_zm", prefix//proc_name ) ! intent(in)
483 0 : call check_negative( rho_ds_zt, 2, nz, "rho_ds_zt", prefix//proc_name ) ! intent(in)
484 : call check_negative( invrs_rho_ds_zm, 1, nz, "invrs_rho_ds_zm", & ! intent(in)
485 0 : prefix//proc_name )!intent(in)
486 : call check_negative( invrs_rho_ds_zt, 2, nz, "invrs_rho_ds_zt", & ! intent(in)
487 0 : prefix//proc_name ) ! intent(in)
488 0 : call check_negative( thv_ds_zm, 1, nz, "thv_ds_zm", prefix//proc_name ) ! intent(in)
489 0 : call check_negative( thv_ds_zt, 2, nz, "thv_ds_zt", prefix//proc_name ) ! intent(in)
490 0 : call check_negative( up2, 1, nz, "up2", prefix//proc_name ) ! intent(in)
491 0 : call check_negative( vp2, 1, nz, "vp2", prefix//proc_name ) ! intent(in)
492 0 : call check_negative( wp2, 1, nz, "wp2", prefix//proc_name ) ! intent(in)
493 0 : call check_negative( thlm, 2, nz, "thlm", prefix//proc_name ) ! intent(in)
494 0 : call check_negative( rtp2, 1, nz, "rtp2", prefix//proc_name ) ! intent(in)
495 0 : call check_negative( thlp2, 1, nz, "thlp2", prefix//proc_name ) ! intent(in)
496 :
497 0 : if ( err_code == clubb_fatal_error .and. prefix == "beginning of " ) then
498 0 : err_code = clubb_no_error ! Negative value generated by host model, hence ignore error
499 : end if
500 :
501 : ! Check the first levels for temperatures greater than 200K
502 0 : do k=1, min( 10, size(thlm) )
503 0 : if ( thlm(k) < 190. ) then
504 0 : write(fstderr,*) "Liquid water potential temperature (thlm) < 190K ", &
505 0 : "at grid level k = ", k, ": thlm(",k,") = ", thlm(k)
506 : end if
507 : end do
508 :
509 0 : return
510 : end subroutine parameterization_check
511 :
512 : !-----------------------------------------------------------------------
513 0 : subroutine sfc_varnce_check( wp2_sfc, up2_sfc, vp2_sfc, thlp2_sfc, &
514 : rtp2_sfc, rtpthlp_sfc, &
515 0 : sclrp2_sfc, sclrprtp_sfc, sclrpthlp_sfc )
516 : !
517 : ! Description:This subroutine determines if any of the output
518 : ! variables for the calc_surface_varnce subroutine carry values that
519 : ! are nans.
520 : !
521 : ! Joshua Fasching February 2008
522 : !
523 : !
524 : !-----------------------------------------------------------------------
525 : use parameters_model, only: &
526 : sclr_dim ! Variable
527 :
528 : use clubb_precision, only: &
529 : core_rknd ! Variable(s)
530 :
531 : implicit none
532 :
533 : ! Constant Parameters
534 : ! Name of the subroutine calling the check
535 : character(len=*), parameter :: &
536 : proc_name = "calc_surface_varnce"
537 :
538 : ! Input Variables
539 : real( kind = core_rknd ),intent(in) :: &
540 : wp2_sfc, & ! Vertical velocity variance [m^2/s^2]
541 : up2_sfc, & ! u'^2 [m^2/s^2]
542 : vp2_sfc, & ! u'^2 [m^2/s^2]
543 : thlp2_sfc, & ! thetal variance [K^2]
544 : rtp2_sfc, & ! rt variance [(kg/kg)^2]
545 : rtpthlp_sfc ! thetal rt covariance [kg K/kg]
546 :
547 :
548 : real( kind = core_rknd ), dimension(sclr_dim), intent(in) :: &
549 : sclrp2_sfc, & ! Passive scalar variance [units^2]
550 : sclrprtp_sfc, & ! Passive scalar r_t covariance [units kg/kg]
551 : sclrpthlp_sfc ! Passive scalar theta_l covariance [units K]
552 :
553 : !-----------------------------------------------------------------------
554 :
555 : ! ---- Begin Code ----
556 :
557 0 : call check_nan( wp2_sfc, "wp2_sfc", proc_name ) ! intent(in)
558 0 : call check_nan( up2_sfc, "up2_sfc", proc_name ) ! intent(in)
559 0 : call check_nan( vp2_sfc, "vp2_sfc", proc_name ) ! intent(in)
560 0 : call check_nan( thlp2_sfc, "thlp2_sfc", proc_name ) ! intent(in)
561 0 : call check_nan( rtp2_sfc, "rtp2_sfc", proc_name ) ! intent(in)
562 : call check_nan( rtpthlp_sfc, "rtpthlp_sfc", &
563 0 : proc_name )
564 :
565 0 : if ( sclr_dim > 0 ) then
566 : call check_nan( sclrp2_sfc, "sclrp2_sfc", & ! intent(in)
567 0 : proc_name ) ! intent(in)
568 :
569 : call check_nan( sclrprtp_sfc, "sclrprtp_sfc", & ! intent(in)
570 0 : proc_name ) ! intent(in)
571 :
572 : call check_nan( sclrpthlp_sfc, "sclrpthlp_sfc", & ! intent(in)
573 0 : proc_name ) ! intent(in)
574 : end if
575 :
576 0 : return
577 : end subroutine sfc_varnce_check
578 :
579 : !-----------------------------------------------------------------------
580 0 : subroutine rad_check( nz, thlm, rcm, rtm, rim, &
581 0 : cloud_frac, p_in_Pa, exner, rho_zm )
582 : ! Description:
583 : ! Checks radiation input variables. If they are < 0 it reports
584 : ! to the console.
585 : !------------------------------------------------------------------------
586 :
587 : use clubb_precision, only: &
588 : core_rknd ! Variable(s)
589 :
590 : implicit none
591 :
592 : integer, intent(in) :: &
593 : nz
594 :
595 : ! Constant Parameters
596 : character(len=*), parameter :: &
597 : proc_name = "Before BUGSrad."
598 :
599 : ! Input/Output variables
600 : real( kind = core_rknd ), dimension(nz), intent(in) :: &
601 : thlm, & ! Liquid Water Potential Temperature [K/s]
602 : rcm, & ! Liquid Water Mixing Ratio [kg/kg]
603 : rtm, & ! Total Water Mixing Ratio [kg/kg]
604 : rim, & ! Ice Water Mixing Ratio [kg/kg]
605 : cloud_frac, & ! Cloud Fraction [-]
606 : p_in_Pa, & ! Pressure [Pa]
607 : exner, & ! Exner Function [-]
608 : rho_zm ! Air Density [kg/m^3]
609 :
610 : ! Local variables
611 0 : real( kind = core_rknd ),dimension(nz) :: rvm
612 :
613 : !-------------------------------------------------------------------------
614 :
615 0 : rvm = rtm - rcm
616 :
617 0 : call check_negative( thlm, 1, nz, "thlm", proc_name ) ! intent(in)
618 0 : call check_negative( rcm, 1, nz, "rcm", proc_name ) ! intent(in)
619 0 : call check_negative( rtm, 1, nz, "rtm", proc_name ) ! intent(in)
620 0 : call check_negative( rvm, 1, nz, "rvm", proc_name ) ! intent(in)
621 0 : call check_negative( rim, 1, nz, "rim", proc_name ) ! intent(in)
622 0 : call check_negative( cloud_frac, 1, nz,"cloud_frac", proc_name ) ! intent(in)
623 0 : call check_negative( p_in_Pa, 1, nz, "p_in_Pa", proc_name ) ! intent(in)
624 0 : call check_negative( exner, 1, nz, "exner", proc_name ) ! intent(in)
625 0 : call check_negative( rho_zm, 1, nz, "rho_zm", proc_name ) ! intent(in)
626 :
627 0 : return
628 :
629 : end subroutine rad_check
630 :
631 : !-----------------------------------------------------------------------
632 0 : logical function invalid_model_arrays( nz, um, vm, rtm, wprtp, thlm, wpthlp, &
633 0 : rtp2, thlp2, rtpthlp, wp2, wp3, &
634 0 : wp2thvp, rtpthvp, thlpthvp, &
635 0 : hydromet, sclrm, edsclrm )
636 :
637 : ! Description:
638 : ! Checks for invalid floating point values in select model arrays.
639 :
640 : ! References:
641 : ! None
642 : !------------------------------------------------------------------------
643 :
644 : use constants_clubb, only: &
645 : fstderr ! Constant(s)
646 :
647 : use parameters_model, only: &
648 : sclr_dim, & ! Variable(s)
649 : edsclr_dim, &
650 : hydromet_dim
651 :
652 : use array_index, only: &
653 : hydromet_list ! Variable(s)
654 :
655 : use clubb_precision, only: &
656 : core_rknd ! Variable(s)
657 :
658 : implicit none
659 :
660 : integer, intent(in) :: &
661 : nz
662 :
663 : real( kind = core_rknd ), dimension(nz), intent(in) :: &
664 : um, & ! eastward grid-mean wind comp. (thermo. levs.) [m/s]
665 : vm, & ! northward grid-mean wind comp. (thermo. levs.) [m/s]
666 : rtm, & ! total water mixing ratio, r_t (thermo. levels) [kg/kg]
667 : wprtp, & ! w' r_t' (momentum levels) [(kg/kg) m/s]
668 : thlm, & ! liq. water pot. temp., th_l (thermo. levels) [K]
669 : wpthlp, & ! w'th_l' (momentum levels) [(m/s) K]
670 : rtp2, & ! r_t'^2 (momentum levels) [(kg/kg)^2]
671 : thlp2, & ! th_l'^2 (momentum levels) [K^2]
672 : rtpthlp, & ! r_t'th_l' (momentum levels) [(kg/kg) K]
673 : wp2, & ! w'^2 (momentum levels) [m^2/s^2]
674 : wp3, & ! w'^3 (thermodynamic levels) [m^3/s^3]
675 : wp2thvp, & ! < w'^2 th_v' > (thermodynamic levels) [m^2/s^2 K]
676 : rtpthvp, & ! < r_t' th_v' > (momentum levels) [kg/kg K]
677 : thlpthvp ! < th_l' th_v' > (momentum levels) [K^2]
678 :
679 : real( kind = core_rknd ), dimension(nz,hydromet_dim), intent(in) :: &
680 : hydromet ! Array of hydrometeors [units vary]
681 :
682 : real( kind = core_rknd ), dimension(nz,sclr_dim), intent(in) :: &
683 : sclrm ! Passive scalar mean (thermo. levels) [units vary]
684 :
685 : real( kind = core_rknd ), dimension(nz,edsclr_dim), intent(in) :: &
686 : edsclrm ! Eddy passive scalar grid-mean (thermo. levels) [units vary]
687 :
688 : ! Local Variables
689 : integer :: i
690 :
691 0 : invalid_model_arrays = .false.
692 :
693 : ! Check whether any variable array contains a NaN for
694 : ! um, vm, thlm, rtm, rtp2, thlp2, wprtp, wpthlp, rtpthlp,
695 : ! wp2, & wp3.
696 0 : if ( is_nan_2d( um ) ) then
697 0 : write(fstderr,*) "NaN in um model array"
698 : ! write(fstderr,*) "um= ", um
699 0 : invalid_model_arrays = .true.
700 : ! return
701 : end if
702 :
703 0 : if ( is_nan_2d( vm ) ) then
704 0 : write(fstderr,*) "NaN in vm model array"
705 : ! write(fstderr,*) "vm= ", vm
706 0 : invalid_model_arrays = .true.
707 : ! return
708 : end if
709 :
710 0 : if ( is_nan_2d( wp2 ) ) then
711 0 : write(fstderr,*) "NaN in wp2 model array"
712 : ! write(fstderr,*) "wp2= ", wp2
713 0 : invalid_model_arrays = .true.
714 : ! return
715 : end if
716 :
717 0 : if ( is_nan_2d( wp3 ) ) then
718 0 : write(fstderr,*) "NaN in wp3 model array"
719 : ! write(fstderr,*) "wp3= ", wp3
720 0 : invalid_model_arrays = .true.
721 : ! return
722 : end if
723 :
724 0 : if ( is_nan_2d( rtm ) ) then
725 0 : write(fstderr,*) "NaN in rtm model array"
726 : ! write(fstderr,*) "rtm= ", rtm
727 0 : invalid_model_arrays = .true.
728 : ! return
729 : end if
730 :
731 0 : if ( is_nan_2d( thlm ) ) then
732 0 : write(fstderr,*) "NaN in thlm model array"
733 : ! write(fstderr,*) "thlm= ", thlm
734 0 : invalid_model_arrays = .true.
735 : ! return
736 : end if
737 :
738 0 : if ( is_nan_2d( rtp2 ) ) then
739 0 : write(fstderr,*) "NaN in rtp2 model array"
740 : ! write(fstderr,*) "rtp2= ", rtp2
741 0 : invalid_model_arrays = .true.
742 : ! return
743 : end if
744 :
745 0 : if ( is_nan_2d( thlp2 ) ) then
746 0 : write(fstderr,*) "NaN in thlp2 model array"
747 : ! write(fstderr,*) "thlp2= ", thlp2
748 0 : invalid_model_arrays = .true.
749 : ! return
750 : end if
751 :
752 0 : if ( is_nan_2d( wprtp ) ) then
753 0 : write(fstderr,*) "NaN in wprtp model array"
754 : ! write(fstderr,*) "wprtp= ", wprtp
755 0 : invalid_model_arrays = .true.
756 : ! return
757 : end if
758 :
759 0 : if ( is_nan_2d( wpthlp ) ) then
760 0 : write(fstderr,*) "NaN in wpthlp model array"
761 : ! write(fstderr,*) "wpthlp= ", wpthlp
762 0 : invalid_model_arrays = .true.
763 : ! return
764 : end if
765 :
766 0 : if ( is_nan_2d( rtpthlp ) ) then
767 0 : write(fstderr,*) "NaN in rtpthlp model array"
768 : ! write(fstderr,*) "rtpthlp= ", rtpthlp
769 0 : invalid_model_arrays = .true.
770 : ! return
771 : end if
772 :
773 0 : if ( hydromet_dim > 0 ) then
774 0 : do i = 1, hydromet_dim, 1
775 0 : if ( is_nan_2d( hydromet(:,i) ) ) then
776 : write(fstderr,*) "NaN in a hydrometeor model array "// &
777 0 : trim( hydromet_list(i) )
778 : ! write(fstderr,*) "hydromet= ", hydromet
779 0 : invalid_model_arrays = .true.
780 : ! return
781 : end if
782 : end do
783 : end if
784 :
785 : ! if ( is_nan_2d( wm_zt ) ) then
786 : ! write(fstderr,*) "NaN in wm_zt model array"
787 : ! write(fstderr,*) "wm_zt= ", wm_zt
788 : ! invalid_model_arrays = .true.
789 : ! return
790 : ! end if
791 :
792 0 : if ( is_nan_2d( wp2thvp ) ) then
793 0 : write(fstderr,*) "NaN in wp2thvp model array"
794 : ! write(fstderr,*) "wp2thvp = ", wp2thvp
795 0 : invalid_model_arrays = .true.
796 : ! return
797 : end if
798 :
799 0 : if ( is_nan_2d( rtpthvp ) ) then
800 0 : write(fstderr,*) "NaN in rtpthvp model array"
801 : ! write(fstderr,*) "rtpthvp = ", rtpthvp
802 0 : invalid_model_arrays = .true.
803 : end if
804 :
805 0 : if ( is_nan_2d( thlpthvp ) ) then
806 0 : write(fstderr,*) "NaN in thlpthvp model array"
807 : ! write(fstderr,*) "thlpthvp = ", thlpthvp
808 0 : invalid_model_arrays = .true.
809 : end if
810 :
811 0 : do i = 1, sclr_dim, 1
812 0 : if ( is_nan_2d( sclrm(:,i) ) ) then
813 0 : write(fstderr,*) "NaN in sclrm", i, "model array"
814 : ! write(fstderr,'(a6,i2,a1)') "sclrm(", i, ")"
815 : ! write(fstderr,*) sclrm(:,i)
816 0 : invalid_model_arrays = .true.
817 : end if
818 : end do
819 :
820 0 : do i = 1, edsclr_dim, 1
821 0 : if ( is_nan_2d( edsclrm(:,i) ) ) then
822 0 : write(fstderr,*) "NaN in edsclrm", i, "model array"
823 : ! write(fstderr,'(a8,i2,a1)') "edsclrm(", i, ")"
824 : ! write(fstderr,*) edsclrm(:,i)
825 0 : invalid_model_arrays = .true.
826 : end if
827 : end do
828 :
829 : return
830 : end function invalid_model_arrays
831 :
832 : !------------------------------------------------------------------------
833 0 : logical function is_nan_sclr( xarg )
834 :
835 : ! Description:
836 : ! Checks if a given scalar real is a NaN, +inf or -inf.
837 :
838 : ! Notes:
839 : ! I was advised by Andy Vaught to use a data statement and the transfer( )
840 : ! intrinsic rather than using a hex number in a parameter for portability.
841 :
842 : ! Certain compiler optimizations may cause variables with invalid
843 : ! results to flush to zero. Avoid these!
844 : ! -dschanen 16 Dec 2010
845 :
846 : !------------------------------------------------------------------------
847 :
848 : use, intrinsic :: ieee_arithmetic
849 :
850 : use clubb_precision, only: &
851 : core_rknd ! Variable(s)
852 :
853 : implicit none
854 :
855 : ! Input Variables
856 : real( kind = core_rknd ), intent(in) :: xarg
857 :
858 : ! ---- Begin Code ---
859 :
860 0 : if (.not. ieee_is_finite(xarg) .or. ieee_is_nan(xarg)) then
861 : ! Try ieee_is_finite ieee_is_nan
862 : is_nan_sclr = .true.
863 : else
864 0 : is_nan_sclr = .false.
865 : end if
866 :
867 :
868 : return
869 0 : end function is_nan_sclr
870 : !------------------------------------------------------------------------
871 :
872 : !------------------------------------------------------------------------
873 0 : logical function is_nan_2d( x2d )
874 :
875 : ! Description:
876 : ! Checks if a given real vector is a NaN, +inf or -inf.
877 :
878 : !------------------------------------------------------------------------
879 :
880 0 : use clubb_precision, only: &
881 : core_rknd ! Variable(s)
882 :
883 : implicit none
884 :
885 : ! External
886 : intrinsic :: any
887 :
888 : ! Input Variables
889 : real( kind = core_rknd ), dimension(:), intent(in) :: x2d
890 :
891 : ! Local Variables
892 : integer :: k
893 :
894 : ! ---- Begin Code ----
895 :
896 0 : is_nan_2d = .false.
897 :
898 0 : do k = 1, size( x2d )
899 0 : if ( is_nan_sclr( x2d(k) ) ) then
900 : is_nan_2d = .true.
901 : exit
902 : end if
903 : end do
904 :
905 : return
906 :
907 : end function is_nan_2d
908 :
909 :
910 : !------------------------------------------------------------------------
911 0 : subroutine check_negative_index &
912 0 : ( var, varstart, varend, varname, operation )
913 : !
914 : ! Description:
915 : ! Checks for negative values in the var array and reports
916 : ! the index in which the negative values occur.
917 : !
918 : !-----------------------------------------------------------------------
919 : use constants_clubb, only: &
920 : fstderr ! Variable
921 :
922 : use clubb_precision, only: &
923 : core_rknd ! Variable(s)
924 :
925 : use error_code, only: &
926 : err_code, & ! Error Indicator
927 : clubb_fatal_error ! Constant
928 :
929 : implicit none
930 :
931 : real( kind = core_rknd ), intent(in) :: var(:)
932 :
933 : integer, intent(in) :: varstart, varend
934 :
935 : character(len=*), intent(in):: &
936 : varname, & ! Varible being examined
937 : operation ! Procedure calling check_zero
938 :
939 : ! Local Variable
940 : integer :: k ! Loop iterator
941 :
942 0 : do k = varstart, varend
943 :
944 0 : if ( var(k) < 0.0_core_rknd ) then
945 :
946 0 : write(fstderr,*) varname, " < 0 in ", operation, &
947 0 : " at k = ", k
948 0 : err_code = clubb_fatal_error
949 :
950 : end if
951 :
952 : end do
953 :
954 0 : return
955 :
956 : end subroutine check_negative_index
957 :
958 :
959 : !------------------------------------------------------------------------
960 0 : subroutine check_nan_2d( var, varname, operation )
961 : !
962 : ! Description:
963 : ! Checks for a NaN in the var array and reports it.
964 : !
965 : !
966 : !------------------------------------------------------------------------
967 : use constants_clubb, only: &
968 : fstderr ! Variable(s)
969 :
970 : use clubb_precision, only: &
971 : core_rknd ! Variable(s)
972 :
973 : use error_code, only: &
974 : err_code, & ! Error Indicator
975 : clubb_fatal_error ! Constant
976 :
977 : implicit none
978 :
979 : ! External
980 : intrinsic :: present
981 :
982 : ! Input variables
983 : real( kind = core_rknd ), intent(in), dimension(:) :: var ! Variable being examined
984 :
985 : character(len=*), intent(in):: &
986 : varname, & ! Name of variable
987 : operation ! Procedure calling check_nan
988 :
989 0 : if ( is_nan_2d( var ) ) then
990 0 : write(fstderr,*) varname, " is NaN in ",operation
991 0 : err_code = clubb_fatal_error
992 : end if
993 :
994 0 : return
995 : end subroutine check_nan_2d
996 :
997 : !-----------------------------------------------------------------------
998 0 : subroutine check_nan_sclr( var, varname, operation )
999 : !
1000 : ! Description:
1001 : ! Checks for a NaN in the scalar var then reports it.
1002 : !
1003 : !-----------------------------------------------------------------------
1004 : use constants_clubb, only: &
1005 : fstderr ! Variable
1006 :
1007 : use clubb_precision, only: &
1008 : core_rknd ! Variable(s)
1009 :
1010 : use error_code, only: &
1011 : err_code, & ! Error Indicator
1012 : clubb_fatal_error ! Constant
1013 :
1014 : implicit none
1015 :
1016 : ! External
1017 : intrinsic :: present
1018 :
1019 : ! Input Variables
1020 : real( kind = core_rknd ), intent(in) :: var ! Variable being examined
1021 :
1022 : character(len=*), intent(in):: &
1023 : varname, & ! Name of variable being examined
1024 : operation ! Procedure calling check_nan
1025 :
1026 : !--------------------------------------------------------------------
1027 0 : if ( is_nan_sclr( var ) ) then
1028 0 : write(fstderr,*) varname, " is NaN in ",operation
1029 0 : err_code = clubb_fatal_error
1030 : end if
1031 :
1032 0 : return
1033 :
1034 : end subroutine check_nan_sclr
1035 : !-------------------------------------------------------------------------
1036 :
1037 : !-----------------------------------------------------------------------
1038 0 : function calculate_spurious_source( integral_after, integral_before, &
1039 : flux_top, flux_sfc, &
1040 : integral_forcing, dt ) &
1041 : result( spurious_source )
1042 : !
1043 : ! Description:
1044 : ! Checks whether there is conservation within the column and returns any
1045 : ! imbalance as spurious_source where spurious_source is defined negative
1046 : ! for a spurious sink.
1047 : !
1048 : !-----------------------------------------------------------------------
1049 :
1050 : use clubb_precision, only: &
1051 : core_rknd ! Variable(s)
1052 :
1053 : implicit none
1054 :
1055 : ! Input Variables
1056 : real( kind = core_rknd ), intent(in) :: &
1057 : integral_after, & ! Vertically-integrated quantity after dt time [units vary]
1058 : integral_before, & ! Vertically-integrated quantity before dt time [units vary]
1059 : flux_top, & ! Total flux at the top of the domain [units vary]
1060 : flux_sfc, & ! Total flux at the bottom of the domain [units vary]
1061 : integral_forcing, & ! Vertically-integrated forcing [units vary]
1062 : dt ! Timestep size [s]
1063 :
1064 : ! Return Variable
1065 : real( kind = core_rknd ) :: spurious_source ! [units vary]
1066 :
1067 : !--------------------------------------------------------------------
1068 :
1069 : ! ---- Begin Code ----
1070 :
1071 : spurious_source = (integral_after - integral_before) / dt &
1072 0 : + flux_top - flux_sfc - integral_forcing
1073 :
1074 : return
1075 :
1076 : end function calculate_spurious_source
1077 : !-------------------------------------------------------------------------
1078 : end module numerical_check
|