LCOV - code coverage report
Current view: top level - physics/clubb/src/CLUBB_core - clip_explicit.F90 (source / functions) Hit Total Coverage
Test: coverage.info Lines: 134 218 61.5 %
Date: 2025-03-13 18:42:46 Functions: 5 6 83.3 %

          Line data    Source code
       1             : !-------------------------------------------------------------------------------
       2             : ! $Id$
       3             : !===============================================================================
       4             : module clip_explicit
       5             : 
       6             :   implicit none
       7             : 
       8             :   private
       9             : 
      10             :   public :: clip_covars_denom, &
      11             :             clip_covar, & 
      12             :             clip_covar_level, & 
      13             :             clip_variance, & 
      14             :             clip_skewness, &
      15             :             clip_skewness_core
      16             : 
      17             :   ! Named constants to avoid string comparisons
      18             :   integer, parameter, public :: &
      19             :     clip_rtp2 = 1, &         ! Named constant for rtp2 clipping
      20             :     clip_thlp2 = 2, &        ! Named constant for thlp2 clipping
      21             :     clip_rtpthlp = 3, &      ! Named constant for rtpthlp clipping
      22             :     clip_up2 = 5, &          ! Named constant for up2 clipping
      23             :     clip_vp2 = 6, &          ! Named constant for vp2 clipping
      24             : !    clip_scalar = 7, &       ! Named constant for scalar clipping
      25             :     clip_wprtp = 8, &        ! Named constant for wprtp clipping
      26             :     clip_wpthlp = 9, &       ! Named constant for wpthlp clipping
      27             :     clip_upwp = 10, &        ! Named constant for upwp clipping
      28             :     clip_vpwp = 11, &        ! Named constant for vpwp clipping
      29             :     clip_wp2 = 12, &         ! Named constant for wp2 clipping
      30             :     clip_wpsclrp = 13, &     ! Named constant for wp scalar clipping
      31             :     clip_sclrp2 = 14, &      ! Named constant for sclrp2 clipping
      32             :     clip_sclrprtp = 15, &    ! Named constant for sclrprtp clipping
      33             :     clip_sclrpthlp = 16, &   ! Named constant for sclrpthlp clipping
      34             :     clip_wphydrometp = 17    ! Named constant for wphydrometp clipping
      35             : 
      36             :   contains
      37             : 
      38             :   !=============================================================================
      39      705888 :   subroutine clip_covars_denom( nz, ngrdcol, gr, dt, rtp2, thlp2, up2, vp2, wp2, &
      40      705888 :                                 sclrp2, wprtp_cl_num, wpthlp_cl_num, &
      41             :                                 wpsclrp_cl_num, upwp_cl_num, vpwp_cl_num, &
      42             :                                 l_predict_upwp_vpwp, &
      43             :                                 l_tke_aniso, &
      44             :                                 l_linearize_pbl_winds, &
      45             :                                 stats_metadata, &
      46      705888 :                                 stats_zm, & 
      47      705888 :                                 wprtp, wpthlp, upwp, vpwp, wpsclrp, &
      48      705888 :                                 upwp_pert, vpwp_pert )
      49             : 
      50             :     ! Description:
      51             :     ! Some of the covariances found in the CLUBB model code need to be clipped
      52             :     ! multiple times during each timestep to ensure that the correlation between
      53             :     ! the two relevant variables stays between -1 and 1 at all times during the
      54             :     ! model run.  The covariances that need to be clipped multiple times are
      55             :     ! w'r_t', w'th_l', w'sclr', u'w', and v'w'.  One of the times that each one
      56             :     ! of these covariances is clipped is immediately after each one is set.
      57             :     ! However, each covariance still needs to be clipped two more times during
      58             :     ! each timestep (once after advance_xp2_xpyp is called and once after
      59             :     ! advance_wp2_wp3 is called).  This subroutine handles the times that the
      60             :     ! covariances are clipped away from the time that they are set.  In other
      61             :     ! words, this subroutine clips the covariances after the denominator terms
      62             :     ! in the relevant correlation equation have been altered, ensuring that
      63             :     ! all correlations will remain between -1 and 1 at all times.
      64             : 
      65             :     ! References:
      66             :     ! None
      67             :     !-----------------------------------------------------------------------
      68             : 
      69             :     use grid_class, only: &
      70             :         grid ! Type
      71             : 
      72             :     use parameters_model, only: &
      73             :         sclr_dim ! Variable(s)
      74             : 
      75             :     use clubb_precision, only: & 
      76             :         core_rknd ! Variable(s)
      77             : 
      78             :     use stats_type, only: &
      79             :         stats ! Type
      80             : 
      81             :      use stats_variables, only: &
      82             :         stats_metadata_type
      83             : 
      84             :     implicit none
      85             : 
      86             :     ! --------------------- Input Variables ---------------------
      87             :     integer, intent(in) :: &
      88             :       nz, &
      89             :       ngrdcol
      90             : 
      91             :     type (grid), target, intent(in) :: gr
      92             :     
      93             :     real( kind = core_rknd ), intent(in) :: &
      94             :       dt ! Timestep [s]
      95             : 
      96             :     real( kind = core_rknd ), dimension(ngrdcol,nz), intent(in) :: &
      97             :       rtp2,  & ! r_t'^2         [(kg/kg)^2]
      98             :       thlp2, & ! theta_l'^2     [K^2]
      99             :       up2,   & ! u'^2           [m^2/s^2]
     100             :       vp2,   & ! v'^2           [m^2/s^2]
     101             :       wp2      ! w'^2           [m^2/s^2]
     102             : 
     103             :     real( kind = core_rknd ), dimension(ngrdcol,nz,sclr_dim), intent(in) :: &
     104             :       sclrp2 ! sclr'^2  [{units vary}^2]
     105             : 
     106             :     integer, intent(in) :: &
     107             :       wprtp_cl_num,   &
     108             :       wpthlp_cl_num,  &
     109             :       wpsclrp_cl_num, &
     110             :       upwp_cl_num,    &
     111             :       vpwp_cl_num
     112             : 
     113             :     logical, intent(in) :: &
     114             :       l_predict_upwp_vpwp,   & ! Flag to predict <u'w'> and <v'w'> along with <u> and <v> alongside
     115             :                                ! the advancement of <rt>, <w'rt'>, <thl>, <wpthlp>, <sclr>, and
     116             :                                ! <w'sclr'> in subroutine advance_xm_wpxp.  Otherwise, <u'w'> and
     117             :                                ! <v'w'> are still approximated by eddy diffusivity when <u> and <v>
     118             :                                ! are advanced in subroutine advance_windm_edsclrm.
     119             :       l_tke_aniso,           & ! For anisotropic turbulent kinetic energy, i.e. TKE = 1/2
     120             :                                ! (u'^2 + v'^2 + w'^2)
     121             :       l_linearize_pbl_winds    ! Flag (used by E3SM) to linearize PBL winds
     122             : 
     123             :     type (stats_metadata_type), intent(in) :: &
     124             :       stats_metadata
     125             : 
     126             :     ! --------------------- Input/Output Variables ---------------------
     127             :     type (stats), target, dimension(ngrdcol), intent(inout) :: &
     128             :       stats_zm
     129             :     
     130             :     real( kind = core_rknd ), dimension(ngrdcol,nz), intent(inout) :: &
     131             :       wprtp,  & ! w'r_t'        [(kg/kg) m/s]
     132             :       wpthlp, & ! w'theta_l'    [K m/s]
     133             :       upwp,   & ! u'w'          [m^2/s^2]
     134             :       vpwp      ! v'w'          [m^2/s^2]
     135             : 
     136             :     real( kind = core_rknd ), dimension(ngrdcol,nz,sclr_dim), intent(inout) :: &
     137             :       wpsclrp ! w'sclr'         [units m/s]
     138             : 
     139             :     ! Variables used to track perturbed version of winds.
     140             :     real( kind = core_rknd ), dimension(ngrdcol,nz), intent(inout) :: &
     141             :       upwp_pert, & ! perturbed <u'w'> [m^2/s^2]
     142             :       vpwp_pert    ! perturbed <v'w'> [m^2/s^2]
     143             : 
     144             :     ! --------------------- Local Variables ---------------------
     145             :     logical :: & 
     146             :       l_first_clip_ts, & ! First instance of clipping in a timestep.
     147             :       l_last_clip_ts     ! Last instance of clipping in a timestep.
     148             : 
     149             :     real( kind = core_rknd ), dimension(ngrdcol,nz) :: &
     150     1411776 :       wprtp_chnge,  & ! Net change in w'r_t' due to clipping  [(kg/kg) m/s]
     151     1411776 :       wpthlp_chnge, & ! Net change in w'th_l' due to clipping [K m/s]
     152     1411776 :       upwp_chnge,   & ! Net change in u'w' due to clipping    [m^2/s^2]
     153     1411776 :       vpwp_chnge      ! Net change in v'w' due to clipping    [m^2/s^2]
     154             : 
     155             :     real( kind = core_rknd ), dimension(ngrdcol,nz,sclr_dim) :: &
     156     1411776 :       wpsclrp_chnge   ! Net change in w'sclr' due to clipping [{units vary}]
     157             : 
     158             :     integer :: sclr, i  ! scalar array index.
     159             : 
     160             :     ! --------------------- Begin Code ---------------------
     161             : 
     162             :     !$acc enter data create( wprtp_chnge, wpthlp_chnge, upwp_chnge, vpwp_chnge )
     163             :     !$acc enter data if( sclr_dim > 0 ) create( wpsclrp_chnge )
     164             : 
     165             :     !!! Clipping for w'r_t'
     166             :     !
     167             :     ! Clipping w'r_t' at each vertical level, based on the
     168             :     ! correlation of w and r_t at each vertical level, such that:
     169             :     ! corr_(w,r_t) = w'r_t' / [ sqrt(w'^2) * sqrt(r_t'^2) ];
     170             :     ! -1 <= corr_(w,r_t) <= 1.
     171             :     !
     172             :     ! Since w'^2, r_t'^2, and w'r_t' are each advanced in different
     173             :     ! subroutines from each other in advance_clubb_core, clipping for w'r_t'
     174             :     ! is done three times during each timestep (once after each variable has
     175             :     ! been updated).
     176             :     !
     177             :     ! This subroutine handles the first and third instances of
     178             :     ! w'r_t' clipping.
     179             :     ! The first instance of w'r_t' clipping takes place after
     180             :     ! r_t'^2 is updated in advance_xp2_xpyp.
     181             :     ! The third instance of w'r_t' clipping takes place after
     182             :     ! w'^2 is updated in advance_wp2_wp3.
     183             : 
     184             :     ! Used within subroutine clip_covar.
     185      705888 :     if ( wprtp_cl_num == 1 ) then
     186           0 :       l_first_clip_ts = .true.
     187           0 :       l_last_clip_ts  = .false.
     188      705888 :     elseif ( wprtp_cl_num == 2 ) then
     189      352944 :       l_first_clip_ts = .false.
     190      352944 :       l_last_clip_ts  = .false.
     191      352944 :     elseif ( wprtp_cl_num == 3 ) then
     192      352944 :       l_first_clip_ts = .false.
     193      352944 :       l_last_clip_ts  = .true.
     194             :     endif
     195             : 
     196             :     ! Clip w'r_t'
     197             :     call clip_covar( nz, ngrdcol, gr, clip_wprtp, l_first_clip_ts,  & ! intent(in) 
     198             :                      l_last_clip_ts, dt, wp2, rtp2,                 & ! intent(in)
     199             :                      l_predict_upwp_vpwp,                           & ! intent(in)
     200             :                      stats_metadata,                                & ! intent(in)
     201             :                      stats_zm,                                      & ! intent(inout)
     202      705888 :                      wprtp, wprtp_chnge )                             ! intent(inout)
     203             : 
     204             :     !!! Clipping for w'th_l'
     205             :     !
     206             :     ! Clipping w'th_l' at each vertical level, based on the
     207             :     ! correlation of w and th_l at each vertical level, such that:
     208             :     ! corr_(w,th_l) = w'th_l' / [ sqrt(w'^2) * sqrt(th_l'^2) ];
     209             :     ! -1 <= corr_(w,th_l) <= 1.
     210             :     !
     211             :     ! Since w'^2, th_l'^2, and w'th_l' are each advanced in different
     212             :     ! subroutines from each other in advance_clubb_core, clipping for w'th_l'
     213             :     ! is done three times during each timestep (once after each variable has
     214             :     ! been updated).
     215             :     !
     216             :     ! This subroutine handles the first and third instances of
     217             :     ! w'th_l' clipping.
     218             :     ! The first instance of w'th_l' clipping takes place after
     219             :     ! th_l'^2 is updated in advance_xp2_xpyp.
     220             :     ! The third instance of w'th_l' clipping takes place after
     221             :     ! w'^2 is updated in advance_wp2_wp3.
     222             : 
     223             :     ! Used within subroutine clip_covar.
     224      705888 :     if ( wpthlp_cl_num == 1 ) then
     225           0 :       l_first_clip_ts = .true.
     226           0 :       l_last_clip_ts  = .false.
     227      705888 :     elseif ( wpthlp_cl_num == 2 ) then
     228      352944 :       l_first_clip_ts = .false.
     229      352944 :       l_last_clip_ts  = .false.
     230      352944 :     elseif ( wpthlp_cl_num == 3 ) then
     231      352944 :       l_first_clip_ts = .false.
     232      352944 :       l_last_clip_ts  = .true.
     233             :     endif
     234             : 
     235             :     ! Clip w'th_l'
     236             :     call clip_covar( nz, ngrdcol, gr, clip_wpthlp, l_first_clip_ts, & ! intent(in)
     237             :                      l_last_clip_ts, dt, wp2, thlp2,                & ! intent(in)
     238             :                      l_predict_upwp_vpwp,                           & ! intent(in)
     239             :                      stats_metadata,                                & ! intent(in)
     240             :                      stats_zm,                                      & ! intent(inout)
     241      705888 :                      wpthlp, wpthlp_chnge )                           ! intent(inout)
     242             : 
     243             :     !!! Clipping for w'sclr'
     244             :     !
     245             :     ! Clipping w'sclr' at each vertical level, based on the
     246             :     ! correlation of w and sclr at each vertical level, such that:
     247             :     ! corr_(w,sclr) = w'sclr' / [ sqrt(w'^2) * sqrt(sclr'^2) ];
     248             :     ! -1 <= corr_(w,sclr) <= 1.
     249             :     !
     250             :     ! Since w'^2, sclr'^2, and w'sclr' are each advanced in different
     251             :     ! subroutines from each other in advance_clubb_core, clipping for w'sclr'
     252             :     ! is done three times during each timestep (once after each variable has
     253             :     ! been updated).
     254             :     !
     255             :     ! This subroutine handles the first and third instances of
     256             :     ! w'sclr' clipping.
     257             :     ! The first instance of w'sclr' clipping takes place after
     258             :     ! sclr'^2 is updated in advance_xp2_xpyp.
     259             :     ! The third instance of w'sclr' clipping takes place after
     260             :     ! w'^2 is updated in advance_wp2_wp3.
     261             : 
     262             :     ! Used within subroutine clip_covar.
     263      705888 :     if ( wpsclrp_cl_num == 1 ) then
     264           0 :       l_first_clip_ts = .true.
     265           0 :       l_last_clip_ts  = .false.
     266      705888 :     elseif ( wpsclrp_cl_num == 2 ) then
     267      352944 :       l_first_clip_ts = .false.
     268      352944 :       l_last_clip_ts  = .false.
     269      352944 :     elseif ( wpsclrp_cl_num == 3 ) then
     270      352944 :       l_first_clip_ts = .false.
     271      352944 :       l_last_clip_ts  = .true.
     272             :     endif
     273             : 
     274             :     ! Clip w'sclr'
     275      705888 :     do sclr = 1, sclr_dim
     276             :       call clip_covar( nz, ngrdcol, gr, clip_wpsclrp, l_first_clip_ts,  & ! intent(in)
     277             :                        l_last_clip_ts, dt, wp2(:,:), sclrp2(:,:,sclr),  & ! intent(in)
     278             :                        l_predict_upwp_vpwp,                             & ! intent(in)
     279             :                        stats_metadata,                                  & ! intent(in)
     280             :                        stats_zm,                                        & ! intent(inout)
     281      705888 :                        wpsclrp(:,:,sclr), wpsclrp_chnge(:,:,sclr) )       ! intent(inout)
     282             :     enddo
     283             : 
     284             : 
     285             :     !!! Clipping for u'w'
     286             :     !
     287             :     ! Clipping u'w' at each vertical level, based on the
     288             :     ! correlation of u and w at each vertical level, such that:
     289             :     ! corr_(u,w) = u'w' / [ sqrt(u'^2) * sqrt(w'^2) ];
     290             :     ! -1 <= corr_(u,w) <= 1.
     291             :     !
     292             :     ! Since w'^2, u'^2, and u'w' are each advanced in different
     293             :     ! subroutines from each other in advance_clubb_core, clipping for u'w'
     294             :     ! is done three times during each timestep (once after each variable has
     295             :     ! been updated).
     296             :     !
     297             :     ! This subroutine handles the first and second instances of
     298             :     ! u'w' clipping.
     299             :     ! The first instance of u'w' clipping takes place after
     300             :     ! u'^2 is updated in advance_xp2_xpyp.
     301             :     ! The second instance of u'w' clipping takes place after
     302             :     ! w'^2 is updated in advance_wp2_wp3.
     303             : 
     304             :     ! Used within subroutine clip_covar.
     305      705888 :     if ( upwp_cl_num == 1 ) then
     306           0 :       l_first_clip_ts = .true.
     307           0 :       l_last_clip_ts  = .false.
     308      705888 :     elseif ( upwp_cl_num == 2 ) then
     309      352944 :       l_first_clip_ts = .false.
     310      352944 :       l_last_clip_ts  = .false.
     311      352944 :     elseif ( upwp_cl_num == 3 ) then
     312      352944 :       l_first_clip_ts = .false.
     313      352944 :       l_last_clip_ts  = .true.
     314             :     endif
     315             : 
     316             :     ! Clip u'w'
     317      705888 :     if ( l_tke_aniso ) then
     318             :       call clip_covar( nz, ngrdcol, gr, clip_upwp, l_first_clip_ts, & ! intent(in)
     319             :                        l_last_clip_ts, dt, wp2, up2,                & ! intent(in)
     320             :                        l_predict_upwp_vpwp,                         & ! intent(in)
     321             :                        stats_metadata,                              & ! intent(in)
     322             :                        stats_zm,                                    & ! intent(inout)
     323      705888 :                        upwp, upwp_chnge )                             ! intent(inout)
     324             :                      
     325      705888 :       if ( l_linearize_pbl_winds ) then
     326             :         call clip_covar( nz, ngrdcol, gr, clip_upwp, l_first_clip_ts, & ! intent(in)
     327             :                          l_last_clip_ts, dt, wp2, up2,                & ! intent(in)
     328             :                          l_predict_upwp_vpwp,                         & ! intent(in)
     329             :                          stats_metadata,                              & ! intent(in)
     330             :                          stats_zm,                                    & ! intent(inout)
     331           0 :                          upwp_pert, upwp_chnge )                        ! intent(inout)
     332             :       endif ! l_linearize_pbl_winds
     333             :     else
     334             :       ! In this case, up2 = wp2, and the variable `up2' does not interact
     335             :       call clip_covar( nz, ngrdcol, gr, clip_upwp, l_first_clip_ts, & ! intent(in)
     336             :                        l_last_clip_ts, dt, wp2, wp2,                & ! intent(in)
     337             :                        l_predict_upwp_vpwp,                         & ! intent(in)
     338             :                        stats_metadata,                              & ! intent(in)
     339             :                        stats_zm,                                    & ! intent(inout)
     340           0 :                        upwp, upwp_chnge )                             ! intent(inout)
     341             :                      
     342           0 :       if ( l_linearize_pbl_winds ) then
     343             :           call clip_covar( nz, ngrdcol, gr, clip_upwp, l_first_clip_ts, & ! intent(in)
     344             :                            l_last_clip_ts, dt, wp2, wp2,                & ! intent(in)
     345             :                            l_predict_upwp_vpwp,                         & ! intent(in)
     346             :                            stats_metadata,                              & ! intent(in)
     347             :                            stats_zm,                                    & ! intent(inout)
     348           0 :                            upwp_pert, upwp_chnge )                        ! intent(inout)
     349             :       endif ! l_linearize_pbl_winds
     350             :     end if
     351             : 
     352             : 
     353             : 
     354             :     !!! Clipping for v'w'
     355             :     !
     356             :     ! Clipping v'w' at each vertical level, based on the
     357             :     ! correlation of v and w at each vertical level, such that:
     358             :     ! corr_(v,w) = v'w' / [ sqrt(v'^2) * sqrt(w'^2) ];
     359             :     ! -1 <= corr_(v,w) <= 1.
     360             :     !
     361             :     ! Since w'^2, v'^2, and v'w' are each advanced in different
     362             :     ! subroutines from each other in advance_clubb_core, clipping for v'w'
     363             :     ! is done three times during each timestep (once after each variable has
     364             :     ! been updated).
     365             :     !
     366             :     ! This subroutine handles the first and second instances of
     367             :     ! v'w' clipping.
     368             :     ! The first instance of v'w' clipping takes place after
     369             :     ! v'^2 is updated in advance_xp2_xpyp.
     370             :     ! The second instance of v'w' clipping takes place after
     371             :     ! w'^2 is updated in advance_wp2_wp3.
     372             : 
     373             :     ! Used within subroutine clip_covar.
     374      705888 :     if ( vpwp_cl_num == 1 ) then
     375           0 :       l_first_clip_ts = .true.
     376           0 :       l_last_clip_ts  = .false.
     377      705888 :     elseif ( vpwp_cl_num == 2 ) then
     378      352944 :       l_first_clip_ts = .false.
     379      352944 :       l_last_clip_ts  = .false.
     380      352944 :     elseif ( vpwp_cl_num == 3 ) then
     381      352944 :       l_first_clip_ts = .false.
     382      352944 :       l_last_clip_ts  = .true.
     383             :     endif
     384             : 
     385      705888 :     if ( l_tke_aniso ) then
     386             :       call clip_covar( nz, ngrdcol, gr, clip_vpwp, l_first_clip_ts, & ! intent(in)
     387             :                        l_last_clip_ts, dt, wp2, vp2,                & ! intent(in)
     388             :                        l_predict_upwp_vpwp,                         & ! intent(in)
     389             :                        stats_metadata,                              & ! intent(in)
     390             :                        stats_zm,                                    & ! intent(inout)
     391      705888 :                        vpwp, vpwp_chnge )                             ! intent(inout)
     392             :                      
     393      705888 :       if ( l_linearize_pbl_winds ) then
     394             :         call clip_covar( nz, ngrdcol, gr, clip_vpwp, l_first_clip_ts, & ! intent(in)
     395             :                          l_last_clip_ts, dt, wp2, vp2,                & ! intent(in)
     396             :                          l_predict_upwp_vpwp,                         & ! intent(in)
     397             :                          stats_metadata,                              & ! intent(in)
     398             :                          stats_zm,                                    & ! intent(inout)
     399           0 :                          vpwp_pert, vpwp_chnge )                        ! intent(inout)
     400             :       endif ! l_linearize_pbl_winds
     401             :     else
     402             :       ! In this case, vp2 = wp2, and the variable `vp2' does not interact
     403             :       call clip_covar( nz, ngrdcol, gr, clip_vpwp, l_first_clip_ts, & ! intent(in)
     404             :                        l_last_clip_ts, dt, wp2, wp2,                & ! intent(in)
     405             :                        l_predict_upwp_vpwp,                         & ! intent(in)
     406             :                        stats_metadata,                              & ! intent(in)
     407             :                        stats_zm,                                    & ! intent(inout)
     408           0 :                        vpwp, vpwp_chnge )                             ! intent(inout)
     409             :                      
     410           0 :       if ( l_linearize_pbl_winds ) then
     411             :         call clip_covar( nz, ngrdcol, gr, clip_vpwp, l_first_clip_ts, & ! intent(in)
     412             :                          l_last_clip_ts, dt, wp2, wp2,                & ! intent(in)
     413             :                          l_predict_upwp_vpwp,                         & ! intent(in)
     414             :                          stats_metadata,                              & ! intent(in)                       stats_metadata,                              & ! intent(in)
     415             :                          stats_zm,                                    & ! intent(inout)
     416           0 :                          vpwp_pert, vpwp_chnge )                        ! intent(inout)
     417             :       endif ! l_linearize_pbl_winds
     418             :     end if
     419             : 
     420             :     !$acc exit data delete( wprtp_chnge, wpthlp_chnge, upwp_chnge, vpwp_chnge )
     421             :     !$acc exit data if( sclr_dim > 0 ) delete( wpsclrp_chnge )
     422             : 
     423      705888 :     return
     424             :   end subroutine clip_covars_denom
     425             : 
     426             :   !=============================================================================
     427     4588272 :   subroutine clip_covar( nz, ngrdcol, gr, solve_type, l_first_clip_ts,  & 
     428     4588272 :                          l_last_clip_ts, dt, xp2, yp2,  &
     429             :                          l_predict_upwp_vpwp, &
     430             :                          stats_metadata, &
     431     4588272 :                          stats_zm, &
     432     4588272 :                          xpyp, xpyp_chnge )
     433             : 
     434             :     ! Description:
     435             :     ! Clipping the value of covariance x'y' based on the correlation between x
     436             :     ! and y.
     437             :     !
     438             :     ! The correlation between variables x and y is:
     439             :     !
     440             :     ! corr_(x,y) = x'y' / [ sqrt(x'^2) * sqrt(y'^2) ];
     441             :     !
     442             :     ! where x'^2 is the variance of x, y'^2 is the variance of y, and x'y' is
     443             :     ! the covariance of x and y.
     444             :     !
     445             :     ! The correlation of two variables must always have a value between -1
     446             :     ! and 1, such that:
     447             :     !
     448             :     ! -1 <= corr_(x,y) <= 1.
     449             :     !
     450             :     ! Therefore, there is an upper limit on x'y', such that:
     451             :     !
     452             :     ! x'y' <=  [ sqrt(x'^2) * sqrt(y'^2) ];
     453             :     !
     454             :     ! and a lower limit on x'y', such that:
     455             :     !
     456             :     ! x'y' >= -[ sqrt(x'^2) * sqrt(y'^2) ].
     457             :     !
     458             :     ! The values of x'y', x'^2, and y'^2 are all found on momentum levels.
     459             :     !
     460             :     ! The value of x'y' may need to be clipped whenever x'y', x'^2, or y'^2 is
     461             :     ! updated.
     462             :     !
     463             :     ! The following covariances are found in the code:
     464             :     !
     465             :     ! w'r_t', w'th_l', w'sclr', (computed in advance_xm_wpxp);
     466             :     ! r_t'th_l', sclr'r_t', sclr'th_l', (computed in advance_xp2_xpyp);
     467             :     ! u'w', v'w', w'edsclr' (computed in advance_windm_edsclrm);
     468             :     ! and w'hm' (computed in setup_pdf_parameters).
     469             : 
     470             :     ! References:
     471             :     ! None
     472             :     !-----------------------------------------------------------------------
     473             : 
     474             :     use grid_class, only: & 
     475             :         grid ! Type
     476             : 
     477             :     use constants_clubb, only: &
     478             :         max_mag_correlation,      & ! Constant(s)
     479             :         max_mag_correlation_flux
     480             : 
     481             :     use clubb_precision, only: & 
     482             :         core_rknd ! Variable(s)
     483             : 
     484             :     use stats_type_utilities, only: & 
     485             :         stat_begin_update,  & ! Procedure(s)
     486             :         stat_modify, & 
     487             :         stat_end_update
     488             : 
     489             :     use stats_variables, only: &
     490             :         stats_metadata_type
     491             : 
     492             :     use stats_type, only: stats ! Type
     493             : 
     494             :     implicit none
     495             : 
     496             :     ! -------------------------- Input Variables --------------------------
     497             :     integer, intent(in) :: &
     498             :       nz, &
     499             :       ngrdcol
     500             : 
     501             :     type (grid), target, intent(in) :: gr
     502             :   
     503             :     integer, intent(in) :: & 
     504             :       solve_type       ! Variable being solved; used for STATS.
     505             : 
     506             :     logical, intent(in) :: & 
     507             :       l_first_clip_ts, & ! First instance of clipping in a timestep.
     508             :       l_last_clip_ts     ! Last instance of clipping in a timestep.
     509             : 
     510             :     real( kind = core_rknd ), intent(in) ::  & 
     511             :       dt     ! Model timestep; used here for STATS           [s]
     512             : 
     513             :     real( kind = core_rknd ), dimension(ngrdcol,nz), intent(in) :: & 
     514             :       xp2, & ! Variance of x, x'^2 (momentum levels)         [{x units}^2]
     515             :       yp2    ! Variance of y, y'^2 (momentum levels)         [{y units}^2]
     516             : 
     517             :     logical, intent(in) :: &
     518             :       l_predict_upwp_vpwp ! Flag to predict <u'w'> and <v'w'> along with <u> and <v> alongside the
     519             :                           ! advancement of <rt>, <w'rt'>, <thl>, <wpthlp>, <sclr>, and <w'sclr'> in
     520             :                           ! subroutine advance_xm_wpxp.  Otherwise, <u'w'> and <v'w'> are still
     521             :                           ! approximated by eddy diffusivity when <u> and <v> are advanced in
     522             :                           ! subroutine advance_windm_edsclrm.
     523             :                           
     524             :     type (stats_metadata_type), intent(in) :: &
     525             :       stats_metadata
     526             : 
     527             :     ! -------------------------- InOut Variables --------------------------
     528             :     type (stats), target, dimension(ngrdcol), intent(inout) :: &
     529             :       stats_zm
     530             : 
     531             :     real( kind = core_rknd ), dimension(ngrdcol,nz), intent(inout) :: & 
     532             :       xpyp   ! Covariance of x and y, x'y' (momentum levels) [{x units}*{y units}]
     533             : 
     534             :     !-------------------------- Output Variable --------------------------
     535             :     real( kind = core_rknd ), dimension(ngrdcol,nz), intent(out) :: &
     536             :       xpyp_chnge  ! Net change in x'y' due to clipping [{x units}*{y units}]
     537             : 
     538             : 
     539             :     ! -------------------------- Local Variables --------------------------
     540             :     real( kind = core_rknd ) ::  & 
     541             :       max_mag_corr, &    ! Maximum magnitude of a correlation allowed
     542             :       xpyp_bound
     543             : 
     544             :     integer :: i, k  ! Array index
     545             : 
     546             :     integer :: & 
     547             :       ixpyp_cl
     548             : 
     549             :     ! -------------------------- Begin Code --------------------------
     550             : 
     551     5647104 :     select case ( solve_type )
     552             :     case ( clip_wprtp )   ! wprtp clipping budget term
     553     1058832 :       ixpyp_cl = stats_metadata%iwprtp_cl
     554             :     case ( clip_wpthlp )   ! wpthlp clipping budget term
     555     1058832 :       ixpyp_cl = stats_metadata%iwpthlp_cl
     556             :     case ( clip_rtpthlp )   ! rtpthlp clipping budget term
     557      352944 :       ixpyp_cl = stats_metadata%irtpthlp_cl
     558             :     case ( clip_upwp )   ! upwp clipping budget term
     559     1058832 :       if ( l_predict_upwp_vpwp ) then
     560     1058832 :         ixpyp_cl = stats_metadata%iupwp_cl
     561             :       else
     562           0 :         ixpyp_cl = 0
     563             :       endif ! l_predict_upwp_vpwp
     564             :     case ( clip_vpwp )   ! vpwp clipping budget term
     565     1058832 :       if ( l_predict_upwp_vpwp ) then
     566     1058832 :         ixpyp_cl = stats_metadata%ivpwp_cl
     567             :       else
     568           0 :         ixpyp_cl = 0
     569             :       endif ! l_predict_upwp_vpwp
     570             :     case default   ! scalars (or upwp/vpwp) are involved
     571     4588272 :       ixpyp_cl = 0
     572             :     end select
     573             : 
     574             : 
     575     4588272 :     if ( stats_metadata%l_stats_samp ) then
     576             : 
     577             :       !$acc update host( xpyp )
     578             : 
     579           0 :       if ( l_first_clip_ts ) then
     580           0 :         do i = 1, ngrdcol
     581           0 :           call stat_begin_update( nz, ixpyp_cl, xpyp(i,:) / dt, & ! intent(in)
     582           0 :                                   stats_zm(i) ) ! intent(inout)
     583             :         end do
     584             :       else
     585           0 :         do i = 1, ngrdcol
     586           0 :           call stat_modify( nz, ixpyp_cl, -xpyp(i,:) / dt, & ! intent(in)
     587           0 :                             stats_zm(i) ) ! intent(inout)
     588             :         end do
     589             :       endif
     590             :     endif
     591             : 
     592             :     ! When clipping for wprtp or wpthlp, use the special value for
     593             :     ! max_mag_correlation_flux.  For all other correlations, use
     594             :     ! max_mag_correlation.
     595             :     if ( ( solve_type == clip_wprtp ) .or. ( solve_type == clip_wpthlp ) ) then
     596             :        max_mag_corr = max_mag_correlation_flux
     597             :     else ! All other covariances
     598             :        max_mag_corr = max_mag_correlation
     599             :     endif ! solve_type
     600             : 
     601             :     ! The value of x'y' at the surface (or lower boundary) is a set value that
     602             :     ! is either specified or determined elsewhere in a surface subroutine.  It
     603             :     ! is ensured elsewhere that the correlation between x and y at the surface
     604             :     ! (or lower boundary) is between -1 and 1.  Thus, the covariance clipping
     605             :     ! code does not need to be invoked at the lower boundary.  Likewise, the
     606             :     ! value of x'y' is set at the upper boundary, so the covariance clipping
     607             :     ! code does not need to be invoked at the upper boundary.
     608             :     ! Note that if clipping were applied at the lower boundary, momentum will
     609             :     ! not be conserved, therefore it should never be added.
     610             :     !$acc parallel loop gang vector collapse(2) default(present)
     611   385414848 :     do k = 2, nz-1
     612  6363506448 :       do i = 1, ngrdcol
     613  5978091600 :         xpyp_bound = max_mag_corr * sqrt( xp2(i,k) * yp2(i,k) )
     614             : 
     615             :         ! Clipping for xpyp at an upper limit corresponding with a correlation
     616             :         ! between x and y of max_mag_corr.
     617  6358918176 :         if ( xpyp(i,k) > xpyp_bound ) then
     618             : 
     619     4825238 :           xpyp_chnge(i,k) = xpyp_bound - xpyp(i,k)
     620     4825238 :           xpyp(i,k) = xpyp_bound 
     621             : 
     622             :         ! Clipping for xpyp at a lower limit corresponding with a correlation
     623             :         ! between x and y of -max_mag_corr.
     624  5973266362 :         else if ( xpyp(i,k) < -xpyp_bound ) then
     625             : 
     626     2249628 :           xpyp_chnge(i,k) = -xpyp_bound - xpyp(i,k)
     627     2249628 :           xpyp(i,k) = -xpyp_bound 
     628             : 
     629             :         else
     630             : 
     631  5971016734 :           xpyp_chnge(i,k) = 0.0_core_rknd
     632             : 
     633             :         end if
     634             :       end do
     635             :     end do
     636             :     !$acc end parallel loop
     637             : 
     638             :     ! Since there is no covariance clipping at the upper or lower boundaries,
     639             :     ! the change in x'y' due to covariance clipping at those levels is 0.
     640             :     !$acc parallel loop gang vector default(present)
     641    76613472 :     do i = 1, ngrdcol
     642    72025200 :       xpyp_chnge(i,1)  = 0.0_core_rknd
     643    76613472 :       xpyp_chnge(i,nz) = 0.0_core_rknd
     644             :     end do
     645             :     !$acc end parallel loop
     646             : 
     647     4588272 :     if ( stats_metadata%l_stats_samp ) then
     648             : 
     649             :       !$acc update host( xpyp )
     650             : 
     651           0 :       if ( l_last_clip_ts ) then
     652           0 :         do i = 1, ngrdcol
     653           0 :           call stat_end_update( nz, ixpyp_cl, xpyp(i,:) / dt, & ! intent(in)
     654           0 :                                 stats_zm(i) ) ! intent(inout)
     655             :         end do
     656             :       else
     657           0 :         do i = 1, ngrdcol
     658           0 :           call stat_modify( nz, ixpyp_cl, xpyp(i,:) / dt, & ! intent(in)
     659           0 :                             stats_zm(i) ) ! intent(inout)
     660             :         end do
     661             :       endif
     662             :     endif
     663             : 
     664     4588272 :     return
     665             :     
     666             :   end subroutine clip_covar
     667             : 
     668             :   !=============================================================================
     669           0 :   subroutine clip_covar_level( solve_type, level, l_first_clip_ts,  & 
     670             :                                l_last_clip_ts, dt, xp2, yp2,  &
     671             :                                l_predict_upwp_vpwp, &
     672             :                                stats_metadata, &
     673             :                                stats_zm, & 
     674             :                                xpyp, xpyp_chnge )
     675             : 
     676             :     ! Description:
     677             :     ! Clipping the value of covariance x'y' based on the correlation between x
     678             :     ! and y.  This is all done at a single vertical level.
     679             :     !
     680             :     ! The correlation between variables x and y is:
     681             :     !
     682             :     ! corr_(x,y) = x'y' / [ sqrt(x'^2) * sqrt(y'^2) ];
     683             :     !
     684             :     ! where x'^2 is the variance of x, y'^2 is the variance of y, and x'y' is
     685             :     ! the covariance of x and y.
     686             :     !
     687             :     ! The correlation of two variables must always have a value between -1
     688             :     ! and 1, such that:
     689             :     !
     690             :     ! -1 <= corr_(x,y) <= 1.
     691             :     !
     692             :     ! Therefore, there is an upper limit on x'y', such that:
     693             :     !
     694             :     ! x'y' <=  [ sqrt(x'^2) * sqrt(y'^2) ];
     695             :     !
     696             :     ! and a lower limit on x'y', such that:
     697             :     !
     698             :     ! x'y' >= -[ sqrt(x'^2) * sqrt(y'^2) ].
     699             :     !
     700             :     ! The values of x'y', x'^2, and y'^2 are all found on momentum levels.
     701             :     !
     702             :     ! The value of x'y' may need to be clipped whenever x'y', x'^2, or y'^2 is
     703             :     ! updated.
     704             :     !
     705             :     ! The following covariances are found in the code:
     706             :     !
     707             :     ! w'r_t', w'th_l', w'sclr', (computed in advance_xm_wpxp);
     708             :     ! r_t'th_l', sclr'r_t', sclr'th_l', (computed in advance_xp2_xpyp);
     709             :     ! u'w', v'w', w'edsclr' (computed in advance_windm_edsclrm);
     710             :     ! and w'hm' (computed in setup_pdf_parameters).
     711             : 
     712             :     ! References:
     713             :     ! None
     714             :     !-----------------------------------------------------------------------
     715             : 
     716             :     use constants_clubb, only: &
     717             :         max_mag_correlation,      & ! Constant(s)
     718             :         max_mag_correlation_flux, &
     719             :         zero
     720             : 
     721             :     use clubb_precision, only: & 
     722             :         core_rknd ! Variable(s)
     723             : 
     724             :     use stats_type_utilities, only: & 
     725             :         stat_begin_update_pt, & ! Procedure(s)
     726             :         stat_modify_pt,       & 
     727             :         stat_end_update_pt
     728             : 
     729             :     use stats_variables, only: &
     730             :         stats_metadata_type
     731             : 
     732             :     use stats_type, only: stats ! Type
     733             : 
     734             :     implicit none
     735             : 
     736             :     type (stats), target, intent(inout) :: &
     737             :       stats_zm
     738             : 
     739             :     !------------------------- Input Variables -------------------------
     740             :     integer, intent(in) :: & 
     741             :       solve_type, & ! Variable being solved; used for STATS
     742             :       level         ! Vertical level index
     743             : 
     744             :     logical, intent(in) :: & 
     745             :       l_first_clip_ts, & ! First instance of clipping in a timestep.
     746             :       l_last_clip_ts     ! Last instance of clipping in a timestep.
     747             : 
     748             :     real( kind = core_rknd ), intent(in) ::  & 
     749             :       dt     ! Model timestep; used here for STATS        [s]
     750             : 
     751             :     real( kind = core_rknd ), intent(in) :: & 
     752             :       xp2, & ! Variance of x, <x'^2>                      [{x units}^2]
     753             :       yp2    ! Variance of y, <y'^2>                      [{y units}^2]
     754             : 
     755             :     logical, intent(in) :: &
     756             :       l_predict_upwp_vpwp ! Flag to predict <u'w'> and <v'w'> along with <u> and <v> alongside the
     757             :                           ! advancement of <rt>, <w'rt'>, <thl>, <wpthlp>, <sclr>, and <w'sclr'> in
     758             :                           ! subroutine advance_xm_wpxp.  Otherwise, <u'w'> and <v'w'> are still
     759             :                           ! approximated by eddy diffusivity when <u> and <v> are advanced in
     760             :                           ! subroutine advance_windm_edsclrm.
     761             : 
     762             :     type (stats_metadata_type), intent(in) :: &
     763             :       stats_metadata
     764             : 
     765             :     !------------------------- InOut Variable -------------------------
     766             :     real( kind = core_rknd ), intent(inout) :: & 
     767             :       xpyp   ! Covariance of x and y, <x'y'>              [{x units}*{y units}]
     768             : 
     769             :     !------------------------- Output Variable -------------------------
     770             :     real( kind = core_rknd ), intent(out) :: &
     771             :       xpyp_chnge  ! Net change in <x'y'> due to clipping  [{x units}*{y units}]
     772             : 
     773             : 
     774             :     !------------------------- Local Variables -------------------------
     775             :     real( kind = core_rknd ) ::  & 
     776             :       max_mag_corr    ! Maximum magnitude of a correlation allowed
     777             : 
     778             :     integer :: & 
     779             :       ixpyp_cl    ! Statistics index
     780             : 
     781             :     !------------------------- Begin Code -------------------------
     782             : 
     783           0 :     select case ( solve_type )
     784             :     case ( clip_wprtp )   ! wprtp clipping budget term
     785           0 :       ixpyp_cl = stats_metadata%iwprtp_cl
     786             :     case ( clip_wpthlp )   ! wpthlp clipping budget term
     787           0 :       ixpyp_cl = stats_metadata%iwpthlp_cl
     788             :     case ( clip_rtpthlp )   ! rtpthlp clipping budget term
     789           0 :       ixpyp_cl = stats_metadata%irtpthlp_cl
     790             :     case ( clip_upwp )   ! upwp clipping budget term
     791           0 :       if ( l_predict_upwp_vpwp ) then
     792           0 :         ixpyp_cl = stats_metadata%iupwp_cl
     793             :       else
     794           0 :         ixpyp_cl = 0
     795             :       endif ! l_predict_upwp_vpwp
     796             :     case ( clip_vpwp )   ! vpwp clipping budget term
     797           0 :       if ( l_predict_upwp_vpwp ) then
     798           0 :         ixpyp_cl = stats_metadata%ivpwp_cl
     799             :       else
     800           0 :         ixpyp_cl = 0
     801             :       endif ! l_predict_upwp_vpwp
     802             :     case default   ! scalars (or upwp/vpwp) are involved
     803           0 :       ixpyp_cl = 0
     804             :     end select
     805             : 
     806             : 
     807           0 :     if ( stats_metadata%l_stats_samp ) then
     808           0 :        if ( l_first_clip_ts ) then
     809             :           call stat_begin_update_pt( ixpyp_cl, level, xpyp / dt, & ! intent(in)
     810           0 :                                      stats_zm ) ! intent(inout)
     811             :        else
     812             :           call stat_modify_pt( ixpyp_cl, level, -xpyp / dt, & ! intent(in)
     813           0 :                                stats_zm ) ! intent(inout)
     814             :        endif
     815             :     endif
     816             : 
     817             :     ! When clipping for wprtp or wpthlp, use the special value for
     818             :     ! max_mag_correlation_flux.  For all other correlations, use
     819             :     ! max_mag_correlation.
     820             :     if ( ( solve_type == clip_wprtp ) .or. ( solve_type == clip_wpthlp ) ) then
     821             :        max_mag_corr = max_mag_correlation_flux
     822             :     else ! All other covariances
     823             :        max_mag_corr = max_mag_correlation
     824             :     endif ! solve_type
     825             : 
     826             :     ! The value of x'y' at the surface (or lower boundary) is a set value that
     827             :     ! is either specified or determined elsewhere in a surface subroutine.  It
     828             :     ! is ensured elsewhere that the correlation between x and y at the surface
     829             :     ! (or lower boundary) is between -1 and 1.  Thus, the covariance clipping
     830             :     ! code does not need to be invoked at the lower boundary.  Likewise, the
     831             :     ! value of x'y' is set at the upper boundary, so the covariance clipping
     832             :     ! code does not need to be invoked at the upper boundary.
     833             :     ! Note that if clipping were applied at the lower boundary, momentum will
     834             :     ! not be conserved, therefore it should never be added.
     835             : 
     836             :     ! Clipping for xpyp at an upper limit corresponding with a correlation
     837             :     ! between x and y of max_mag_corr.
     838           0 :     if ( xpyp > max_mag_corr * sqrt( xp2 * yp2 ) ) then
     839             : 
     840           0 :         xpyp_chnge = max_mag_corr * sqrt( xp2 * yp2 ) - xpyp
     841             : 
     842           0 :         xpyp = max_mag_corr * sqrt( xp2 * yp2 )
     843             : 
     844             :     ! Clipping for xpyp at a lower limit corresponding with a correlation
     845             :     ! between x and y of -max_mag_corr.
     846           0 :     elseif ( xpyp < -max_mag_corr * sqrt( xp2 * yp2 ) ) then
     847             : 
     848           0 :         xpyp_chnge = -max_mag_corr * sqrt( xp2 * yp2 ) - xpyp
     849             : 
     850           0 :         xpyp = -max_mag_corr * sqrt( xp2 * yp2 )
     851             : 
     852             :     else
     853             : 
     854           0 :         xpyp_chnge = zero
     855             : 
     856             :     endif
     857             : 
     858           0 :     if ( stats_metadata%l_stats_samp ) then
     859           0 :        if ( l_last_clip_ts ) then
     860             :           call stat_end_update_pt( ixpyp_cl, level, xpyp / dt, & ! intent(in)
     861           0 :                                    stats_zm ) ! intent(inout)
     862             :        else
     863             :           call stat_modify_pt( ixpyp_cl, level, xpyp / dt, & ! intent(in)
     864           0 :                                stats_zm ) ! intent(inout)
     865             :        endif
     866             :     endif
     867             : 
     868             : 
     869           0 :     return
     870             :   end subroutine clip_covar_level
     871             : 
     872             :   !=============================================================================
     873     1764720 :   subroutine clip_variance( nz, ngrdcol, gr, solve_type, dt, threshold, &
     874             :                             stats_metadata, &
     875     1764720 :                             stats_zm, &
     876     1764720 :                             xp2 )
     877             : 
     878             :     ! Description:
     879             :     ! Clipping the value of variance x'^2 based on a minimum threshold value.
     880             :     ! The threshold value must be greater than or equal to 0.
     881             :     !
     882             :     ! The values of x'^2 are found on the momentum levels.
     883             :     !
     884             :     ! The following variances are found in the code:
     885             :     !
     886             :     ! r_t'^2, th_l'^2, u'^2, v'^2, sclr'^2, (computed in advance_xp2_xpyp);
     887             :     ! w'^2 (computed in advance_wp2_wp3).
     888             : 
     889             :     ! References:
     890             :     ! None
     891             :     !-----------------------------------------------------------------------
     892             : 
     893             :     use grid_class, only: & 
     894             :         grid ! Type
     895             : 
     896             :     use clubb_precision, only: & 
     897             :         core_rknd ! Variable(s)
     898             : 
     899             :     use stats_type_utilities, only: & 
     900             :         stat_begin_update,  & ! Procedure(s)
     901             :         stat_end_update
     902             : 
     903             :     use stats_variables, only: &
     904             :         stats_metadata_type
     905             : 
     906             :     use stats_type, only: stats ! Type
     907             : 
     908             :     implicit none
     909             : 
     910             :     ! -------------------- Input Variables --------------------
     911             :     integer, intent(in) :: &
     912             :       nz, &
     913             :       ngrdcol
     914             : 
     915             :     type (grid), target, intent(in) :: gr
     916             :   
     917             :     integer, intent(in) :: & 
     918             :       solve_type  ! Variable being solved; used for STATS.
     919             : 
     920             :     real( kind = core_rknd ), intent(in) :: & 
     921             :       dt          ! Model timestep; used here for STATS     [s]
     922             : 
     923             :     real( kind = core_rknd ), dimension(ngrdcol,nz), intent(in) :: & 
     924             :       threshold   ! Minimum value of x'^2                   [{x units}^2]
     925             : 
     926             :     type (stats_metadata_type), intent(in) :: &
     927             :       stats_metadata
     928             : 
     929             :     ! -------------------- InOut Variables --------------------
     930             :     type (stats), target, dimension(ngrdcol), intent(inout) :: &
     931             :       stats_zm
     932             : 
     933             :     ! -------------------- Output Variable --------------------
     934             :     real( kind = core_rknd ), dimension(ngrdcol,nz), intent(inout) :: & 
     935             :       xp2         ! Variance of x, x'^2 (momentum levels)   [{x units}^2]
     936             : 
     937             :     ! -------------------- Local Variables --------------------
     938             :     integer :: i, k   ! Array index
     939             : 
     940             :     integer :: & 
     941             :       ixp2_cl
     942             : 
     943             :     ! -------------------- Begin Code --------------------
     944             : 
     945             :     !$acc data copyin( threshold ) &
     946             :     !$acc        copy( xp2 )
     947             : 
     948     2117664 :     select case ( solve_type )
     949             :     case ( clip_wp2 )   ! wp2 clipping budget term
     950      352944 :       ixp2_cl = stats_metadata%iwp2_cl
     951             :     case ( clip_rtp2 )   ! rtp2 clipping budget term
     952      352944 :       ixp2_cl = stats_metadata%irtp2_cl
     953             :     case ( clip_thlp2 )   ! thlp2 clipping budget term
     954      352944 :       ixp2_cl = stats_metadata%ithlp2_cl
     955             :     case ( clip_up2 )   ! up2 clipping budget term
     956      352944 :       ixp2_cl = stats_metadata%iup2_cl
     957             :     case ( clip_vp2 )   ! vp2 clipping budget term
     958      352944 :       ixp2_cl = stats_metadata%ivp2_cl
     959             :     case default   ! scalars are involved
     960     1764720 :       ixp2_cl = 0
     961             :     end select
     962             : 
     963             : 
     964     1764720 :     if ( stats_metadata%l_stats_samp ) then
     965             :       !$acc update host( xp2 )
     966           0 :       do i = 1, ngrdcol
     967           0 :         call stat_begin_update( nz, ixp2_cl, xp2(i,:) / dt, & ! intent(in)
     968           0 :                                 stats_zm(i) ) ! intent(inout)
     969             :       end do
     970             :     end if
     971             : 
     972             :     ! Limit the value of x'^2 at threshold.
     973             :     ! The value of x'^2 at the surface (or lower boundary) is a set value that
     974             :     ! is determined elsewhere in a surface subroutine.  Thus, the variance
     975             :     ! clipping code does not need to be invoked at the lower boundary.
     976             :     ! Likewise, the value of x'^2 is set at the upper boundary, so the variance
     977             :     ! clipping code does not need to be invoked at the upper boundary.
     978             :     !
     979             :     ! charlass on 09/11/2013: I changed the clipping so that also the surface
     980             :     ! level is clipped. I did this because we discovered that there are slightly
     981             :     ! negative values in thlp2(1) and rtp2(1) when running quarter_ss case with
     982             :     ! WRF-CLUBB (see wrf:ticket:51#comment:33) 
     983             :     !$acc parallel loop gang vector collapse(2) default(present)
     984   150001200 :     do k = 1, nz-1, 1
     985  2476969200 :       do i = 1, ngrdcol
     986  2475204480 :         if ( xp2(i,k) < threshold(i,k) ) then
     987     2615958 :           xp2(i,k) = threshold(i,k)
     988             :         end if
     989             :       end do
     990             :     end do
     991             :     !$acc end parallel loop
     992             : 
     993     1764720 :     if ( stats_metadata%l_stats_samp ) then
     994             :       !$acc update host( xp2 )
     995           0 :       do i = 1, ngrdcol
     996           0 :         call stat_end_update( nz, ixp2_cl, xp2(i,:) / dt, & ! intent(in)
     997           0 :                               stats_zm(i) ) ! intent(inout)
     998             :       end do
     999             :     end if
    1000             : 
    1001             :     !$acc end data
    1002             : 
    1003     1764720 :     return
    1004             : 
    1005             :   end subroutine clip_variance
    1006             : 
    1007             :   !=============================================================================
    1008      352944 :   subroutine clip_skewness( nz, ngrdcol, gr, dt, sfc_elevation, & ! intent(in)
    1009      352944 :                             Skw_max_mag, wp2_zt,                & ! intent(in)
    1010             :                             l_use_wp3_lim_with_smth_Heaviside,  & ! intent(in)
    1011             :                             stats_metadata,                     & ! intent(in)
    1012      352944 :                             stats_zt,                           & ! intent(inout)
    1013      352944 :                             wp3 )                                 ! intent(out)
    1014             : 
    1015             :     ! Description:
    1016             :     ! Clipping the value of w'^3 based on the skewness of w, Sk_w.
    1017             :     !
    1018             :     ! Aditionally, to prevent possible crashes due to wp3 growing too large, 
    1019             :     ! abs(wp3) will be clipped to 100.
    1020             :     !
    1021             :     ! The skewness of w is:
    1022             :     !
    1023             :     ! Sk_w = w'^3 / (w'^2)^(3/2).
    1024             :     !
    1025             :     ! The value of Sk_w is limited to a range between an upper limit and a lower
    1026             :     ! limit.  The values of the limits depend on whether the level altitude is
    1027             :     ! within 100 meters of the surface.
    1028             :     !
    1029             :     ! For altitudes less than or equal to 100 meters above ground level (AGL):
    1030             :     !
    1031             :     ! -0.2_core_rknd*sqrt(2) <= Sk_w <= 0.2_core_rknd*sqrt(2);
    1032             :     !
    1033             :     ! while for all altitudes greater than 100 meters AGL:
    1034             :     !
    1035             :     ! -4.5_core_rknd <= Sk_w <= 4.5_core_rknd.
    1036             :     !
    1037             :     ! Therefore, there is an upper limit on w'^3, such that:
    1038             :     !
    1039             :     ! w'^3  <=  threshold_magnitude * (w'^2)^(3/2);
    1040             :     !
    1041             :     ! and a lower limit on w'^3, such that:
    1042             :     !
    1043             :     ! w'^3  >= -threshold_magnitude * (w'^2)^(3/2).
    1044             :     !
    1045             :     ! The values of w'^3 are found on the thermodynamic levels, while the values
    1046             :     ! of w'^2 are found on the momentum levels.  Therefore, the values of w'^2
    1047             :     ! are interpolated to the thermodynamic levels before being used to
    1048             :     ! calculate the upper and lower limits for w'^3.
    1049             : 
    1050             :     ! References:
    1051             :     ! None
    1052             :     !-----------------------------------------------------------------------
    1053             : 
    1054             :     use grid_class, only: & 
    1055             :         grid ! Type
    1056             : 
    1057             :     use clubb_precision, only: & 
    1058             :         core_rknd ! Variable(s)
    1059             : 
    1060             :     use stats_type_utilities, only: &
    1061             :         stat_begin_update,  & ! Procedure(s)
    1062             :         stat_end_update
    1063             : 
    1064             :     use stats_variables, only: &
    1065             :         stats_metadata_type
    1066             : 
    1067             :     use stats_type, only: stats ! Type
    1068             : 
    1069             :     implicit none
    1070             : 
    1071             :     ! ----------------------- Input Variables -----------------------
    1072             :     integer, intent(in) :: &
    1073             :       nz, &
    1074             :       ngrdcol
    1075             : 
    1076             :     type (grid), target, intent(in) :: gr
    1077             :   
    1078             :     real( kind = core_rknd ), intent(in) :: & 
    1079             :       dt               ! Model timestep; used here for STATS        [s]
    1080             : 
    1081             :     real( kind = core_rknd ), dimension(ngrdcol), intent(in) ::  &
    1082             :       sfc_elevation  ! Elevation of ground level                  [m AMSL]
    1083             :       
    1084             :     real( kind = core_rknd ), intent(in) ::  &
    1085             :       Skw_max_mag      ! Maximum allowable magnitude of Skewness    [-]
    1086             : 
    1087             :     real( kind = core_rknd ), dimension(ngrdcol,nz), intent(in) :: &
    1088             :       wp2_zt           ! w'^2 interpolated to thermodyamic levels   [m^2/s^2]
    1089             : 
    1090             :     ! Flag to activate modifications on wp3 limiters for convergence test 
    1091             :     ! (use smooth Heaviside 'Preskin' function in the calculation of
    1092             :     ! clip_skewness for wp3) 
    1093             :     logical, intent(in):: &
    1094             :       l_use_wp3_lim_with_smth_Heaviside
    1095             : 
    1096             :     type (stats_metadata_type), intent(in) :: &
    1097             :       stats_metadata
    1098             : 
    1099             :     ! ----------------------- Input/Output Variables -----------------------
    1100             :     type (stats), target, dimension(ngrdcol), intent(inout) :: &
    1101             :       stats_zt
    1102             :       
    1103             :     real( kind = core_rknd ), dimension(ngrdcol,nz), intent(inout) :: &
    1104             :       wp3              ! w'^3 (thermodynamic levels)                [m^3/s^3]
    1105             :       
    1106             :     ! ----------------------- Local Variables -----------------------
    1107             :     integer :: i
    1108             : 
    1109             :     ! ----------------------- Begin Code -----------------------
    1110             : 
    1111             :     !$acc data copyin( gr, gr%zt, &
    1112             :     !$acc              sfc_elevation, wp2_zt ) &
    1113             :     !$acc        copy( wp3 )
    1114             : 
    1115      352944 :     if ( stats_metadata%l_stats_samp ) then
    1116             : 
    1117             :       !$acc update host( wp3 )
    1118             : 
    1119           0 :       do i = 1, ngrdcol
    1120           0 :         call stat_begin_update( nz, stats_metadata%iwp3_cl, wp3(i,:) / dt, & ! intent(in)
    1121           0 :                                 stats_zt(i) ) ! intent(inout)
    1122             :       end do
    1123             :     end if
    1124             : 
    1125             :     call clip_skewness_core( nz, ngrdcol, gr, sfc_elevation,    & ! intent(in)
    1126             :                              Skw_max_mag, wp2_zt,               & ! intent(in)
    1127             :                              l_use_wp3_lim_with_smth_Heaviside, & ! intent(in)
    1128      352944 :                              wp3 )                                ! intent(inout)
    1129             : 
    1130      352944 :     if ( stats_metadata%l_stats_samp ) then
    1131             : 
    1132             :       !$acc update host( wp3 )
    1133             : 
    1134           0 :       do i = 1, ngrdcol
    1135           0 :         call stat_end_update( nz, stats_metadata%iwp3_cl, wp3(i,:) / dt, & ! intent(in)
    1136           0 :                               stats_zt(i) ) ! intent(inout)
    1137             :       end do
    1138             :     end if
    1139             : 
    1140             :     !$acc end data
    1141             : 
    1142      352944 :     return
    1143             : 
    1144             :   end subroutine clip_skewness
    1145             : 
    1146             : !=============================================================================
    1147      352944 :   subroutine clip_skewness_core( nz, ngrdcol, gr, sfc_elevation, &
    1148      352944 :                                  Skw_max_mag, wp2_zt, &
    1149             :                                  l_use_wp3_lim_with_smth_Heaviside, & 
    1150      352944 :                                  wp3 )
    1151             : 
    1152             :     use grid_class, only: & 
    1153             :         grid ! Type
    1154             : 
    1155             :     use clubb_precision, only: &
    1156             :         core_rknd ! Variable(s)
    1157             : 
    1158             :     use advance_helper_module, only: &
    1159             :         smooth_heaviside_peskin
    1160             : 
    1161             :     implicit none
    1162             : 
    1163             :     !----------------------- Input Variables -----------------------
    1164             :     integer, intent(in) :: &
    1165             :       nz, &
    1166             :       ngrdcol
    1167             : 
    1168             :     type (grid), target, intent(in) :: gr
    1169             :     
    1170             :     real( kind = core_rknd ), dimension(ngrdcol), intent(in) ::  &
    1171             :       sfc_elevation  ! Elevation of ground level                  [m AMSL]
    1172             :       
    1173             :     real( kind = core_rknd ), intent(in) ::  &
    1174             :       Skw_max_mag      ! Maximum allowable magnitude of Skewness    [-]
    1175             : 
    1176             :     real( kind = core_rknd ), dimension(ngrdcol,nz), intent(in) :: &
    1177             :       wp2_zt           ! w'^2 interpolated to thermodyamic levels   [m^2/s^2]
    1178             : 
    1179             :     ! Flag to activate modifications on wp3 limiters for convergence test 
    1180             :     ! (use smooth Heaviside 'Preskin' function in the calculation of clip_skewness for wp3) 
    1181             :     logical, intent(in):: &
    1182             :       l_use_wp3_lim_with_smth_Heaviside
    1183             : 
    1184             :     !----------------------- Input/Output Variables -----------------------
    1185             :     real( kind = core_rknd ), dimension(ngrdcol,nz), intent(inout) :: &
    1186             :       wp3              ! w'^3 (thermodynamic levels)                [m^3/s^3]
    1187             : 
    1188             :     !----------------------- Local Variables -----------------------
    1189             :     real( kind = core_rknd ), dimension(ngrdcol,nz) :: &
    1190      705888 :       wp2_zt_cubed, & ! Variance of vertical velocity cubed (w^2_{zt}^3)   [m^6/s^6]
    1191      705888 :       wp3_lim_sqd     ! Keeps absolute value of Sk_w from becoming > limit [m^6/s^6]
    1192             : 
    1193             :     integer :: i, k       ! Vertical array index.
    1194             : 
    1195             :     real( kind = core_rknd ), parameter :: &  
    1196             :       wp3_max = 100._core_rknd ! Threshold for wp3 [m^3/s^3]      
    1197             : 
    1198             :     real( kind = core_rknd ), dimension(ngrdcol,nz) :: &
    1199      705888 :       zagl_thresh, & ! temporatory array  
    1200      705888 :       H_zagl ! Heaviside function for clippings of wp3_lim_sqd
    1201             : 
    1202             :     !----------------------- Begin Code-----------------------
    1203             : 
    1204             :     !$acc enter data create( wp2_zt_cubed, wp3_lim_sqd, zagl_thresh, H_zagl )
    1205             : 
    1206             :     ! Compute the upper and lower limits of w'^3 at every level,
    1207             :     ! based on the skewness of w, Sk_w, such that:
    1208             :     ! Sk_w = w'^3 / (w'^2)^(3/2);
    1209             :     ! -4.5 <= Sk_w <= 4.5;
    1210             :     ! or, if the level altitude is within 100 meters of the surface,
    1211             :     ! -0.2*sqrt(2) <= Sk_w <= 0.2*sqrt(2).
    1212             : 
    1213             :     ! The normal magnitude limit of skewness of w in the CLUBB code is 4.5.
    1214             :     ! However, according to Andre et al. (1976b & 1978), wp3 should not exceed
    1215             :     ! [2*(wp2^3)]^(1/2) at any level.  However, this term should be multiplied
    1216             :     ! by 0.2 close to the surface to include surface effects.  There already is
    1217             :     ! a wp3 clipping term in place for all other altitudes, but this term will
    1218             :     ! be included for the surface layer only.  Therefore, the lowest level wp3
    1219             :     ! should not exceed 0.2 * sqrt(2) * wp2^(3/2).  Brian Griffin.  12/18/05.
    1220             : 
    1221             :     ! To lower compute time, we squared both sides of the equation and compute
    1222             :     ! wp2^3 only once. -dschanen 9 Oct 2008
    1223             :     !$acc parallel loop gang vector collapse(2) default(present)
    1224    30353184 :     do k = 1, nz
    1225   501287184 :       do i = 1, ngrdcol
    1226   500934240 :         wp2_zt_cubed(i,k) = wp2_zt(i,k)**3
    1227             :       end do
    1228             :     end do
    1229             :     !$acc end parallel loop
    1230             : 
    1231      352944 :     if ( l_use_wp3_lim_with_smth_Heaviside ) then 
    1232             : 
    1233             :       !implement a smoothed Heaviside function to avoid discontinuities 
    1234             :       !$acc parallel loop gang vector collapse(2) default(present)
    1235           0 :       do k = 1, nz
    1236           0 :         do i = 1, ngrdcol
    1237           0 :           zagl_thresh(i,k) = ( gr%zt(i,k) - sfc_elevation(i) ) /  100.0_core_rknd 
    1238           0 :           zagl_thresh(i,k) = zagl_thresh(i,k)  - 1.0_core_rknd 
    1239             :         end do
    1240             :       end do
    1241             :       !$acc end parallel loop
    1242             : 
    1243           0 :       H_zagl(:,:) = smooth_heaviside_peskin(nz, ngrdcol, zagl_thresh(:,:), 0.6_core_rknd) 
    1244             : 
    1245             :       !$acc parallel loop gang vector collapse(2) default(present)
    1246           0 :       do k = 1, nz
    1247           0 :         do i = 1, ngrdcol
    1248           0 :           wp3_lim_sqd(i,k) = wp2_zt_cubed(i,k)   &
    1249             :                               * ( H_zagl(i,k) * Skw_max_mag**2   &
    1250             :                                   + (1.0_core_rknd - H_zagl(i,k)) & 
    1251           0 :                                      * 0.0021_core_rknd *Skw_max_mag**2 )
    1252             :         end do
    1253             :       end do
    1254             :      !$acc end parallel loop
    1255             : 
    1256             :     else ! default method 
    1257             : 
    1258             :       !$acc parallel loop gang vector collapse(2) default(present)
    1259    30353184 :       do k = 1, nz
    1260   501287184 :         do i = 1, ngrdcol
    1261   500934240 :           if ( gr%zt(i,k) - sfc_elevation(i) <= 100.0_core_rknd ) then ! Clip for 100 m. AGL.
    1262             :            !wp3_upper_lim(k) =  0.2_core_rknd * sqrt_2 * wp2_zt(k)**(3.0_core_rknd/2.0_core_rknd)
    1263             :            !wp3_lower_lim(k) = -0.2_core_rknd * sqrt_2 * wp2_zt(k)**(3.0_core_rknd/2.0_core_rknd)
    1264    16621200 :             wp3_lim_sqd(i,k) = 0.0021_core_rknd * Skw_max_mag**2 * wp2_zt_cubed(i,k)
    1265             :           else                          ! Clip skewness consistently with a.
    1266             :            !wp3_upper_lim(k) =  4.5_core_rknd * wp2_zt(k)**(3.0_core_rknd/2.0_core_rknd)
    1267             :            !wp3_lower_lim(k) = -4.5_core_rknd * wp2_zt(k)**(3.0_core_rknd/2.0_core_rknd)
    1268   454312800 :             wp3_lim_sqd(i,k) = Skw_max_mag**2 * wp2_zt_cubed(i,k) ! Skw_max_mag = 4.5_core_rknd^2
    1269             :           endif
    1270             :         end do
    1271             :       end do
    1272             :       !$acc end parallel loop
    1273             : 
    1274             :     end if
    1275             :   
    1276             :     ! Clipping for w'^3 at an upper and lower limit corresponding with
    1277             :     ! the appropriate value of Sk_w.
    1278             :     !$acc parallel loop gang vector collapse(2) default(present)
    1279    30353184 :     do k = 1, nz
    1280   501287184 :       do i = 1, ngrdcol
    1281             :         ! Set the magnitude to the wp3 limit and apply the sign of the current wp3
    1282   500934240 :         if ( wp3(i,k)**2 > wp3_lim_sqd(i,k) ) then
    1283     5091482 :           wp3(i,k) = sign( sqrt( wp3_lim_sqd(i,k) ), wp3(i,k) )
    1284             :         end if
    1285             :       end do
    1286             :     end do
    1287             :     !$acc end parallel loop
    1288             : 
    1289             :     ! Clipping abs(wp3) to 100. This keeps wp3 from growing too large in some 
    1290             :     ! deep convective cases, which helps prevent these cases from blowing up.
    1291             :     !$acc parallel loop gang vector collapse(2) default(present)
    1292    30353184 :     do k = 1, nz
    1293   501287184 :       do i = 1, ngrdcol
    1294   500934240 :         if ( abs(wp3(i,k)) > wp3_max ) then
    1295           0 :           wp3(i,k) = sign( wp3_max, wp3(i,k) ) ! Known magic number
    1296             :         end if
    1297             :       end do
    1298             :     end do
    1299             :     !$acc end parallel loop
    1300             : 
    1301             :     !$acc exit data delete( wp2_zt_cubed, wp3_lim_sqd, zagl_thresh, H_zagl )
    1302             : 
    1303      352944 :   end subroutine clip_skewness_core
    1304             : 
    1305             : !===============================================================================
    1306             : 
    1307             : end module clip_explicit

Generated by: LCOV version 1.14