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