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

Generated by: LCOV version 1.14