LCOV - code coverage report
Current view: | top level - physics/clubb/src/CLUBB_core - numerical_check.F90 (source / functions) |  |  | Hit | Total | Coverage
Test: | coverage.info |  | Lines: | 0 | 289 | 0.0 %
Date: | 2024-12-17 17:57:11 |  | Functions: | 0 | 12 | 0.0 %

              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

Generated by: LCOV version 1.14