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