LCOV - code coverage report
Current view: | top level - physics/clubb/src/CLUBB_core - Skx_module.F90 (source / functions) |  |  | Hit | Total | Coverage
Test: | coverage.info |  | Lines: | 34 | 34 | 100.0 %
Date: | 2024-12-17 22:39:59 |  | Functions: | 3 | 3 | 100.0 %

              Line data    Source code
           1             : !-------------------------------------------------------------------------
           2             : !$Id$
           3             : !===============================================================================
           4             : module Skx_module
           5             :
           6             :   implicit none
           7             :
           8             :   private ! Default Scope
           9             :
          10             :   public :: Skx_func, &
          11             :             LG_2005_ansatz, &
          12             :             xp3_LG_2005_ansatz
          13             :
          14             :   contains
          15             :
          16             :   !-----------------------------------------------------------------------------
          17   116155728 :   subroutine Skx_func( nz, ngrdcol, xp2, xp3, &
          18   116155728 :                        x_tol, clubb_params, &
          19   116155728 :                        Skx )
          20             :
          21             :     ! Description:
          22             :     ! Calculate the skewness of x
          23             :
          24             :     ! References:
          25             :     ! None
          26             :     !-----------------------------------------------------------------------
          27             :
          28             :     use clubb_precision, only: &
          29             :         core_rknd         ! Variable(s)
          30             :
          31             :     use parameter_indices, only: &
          32             :       nparams,                 & ! Variable(s)
          33             :       iSkw_denom_coef,         &
          34             :       iSkw_max_mag
          35             :
          36             :     implicit none
          37             :
          38             :     integer, intent(in) :: &
          39             :       nz, &
          40             :       ngrdcol
          41             :
          42             :     ! External
          43             :     intrinsic :: min, max
          44             :
          45             :     ! Parameter Constants
          46             :     ! Whether to apply clipping to the final result
          47             :     logical, parameter ::  &
          48             :       l_clipping_kluge = .false.
          49             :
          50             :     ! Input Variables
          51             :     real( kind = core_rknd ), dimension(ngrdcol,nz), intent(in) :: &
          52             :       xp2,   & ! <x'^2>               [(x units)^2]
          53             :       xp3      ! <x'^3>               [(x units)^3]
          54             :
          55             :     real( kind = core_rknd ), intent(in) :: &
          56             :       x_tol     ! x tolerance value                       [(x units)]
          57             :
          58             :     real( kind = core_rknd ), dimension(ngrdcol,nparams), intent(in) :: &
          59             :       clubb_params    ! Array of CLUBB's tunable parameters    [units vary]
          60             :
          61             :     ! Output Variable
          62             :     real( kind = core_rknd ), dimension(ngrdcol,nz), intent(out) :: &
          63             :       Skx      ! Skewness of x        [-]
          64             :
          65             :     ! Local Variable
          66             :     real( kind = core_rknd ), dimension(ngrdcol) :: &
          67   232311456 :       Skx_denom_tol
          68             :
          69             :     integer :: i, k
          70             :
          71             :     ! ---- Begin Code ----
          72             :
          73             :     !$acc data copyin( xp2, xp3, clubb_params ) &
          74             :     !$acc      create( Skx_denom_tol ) &
          75             :     !$acc      copyout( Skx )
          76             :
          77             :     !$acc parallel loop gang vector default(present)
          78  1939530528 :     do i = 1, ngrdcol
          79  1939530528 :       Skx_denom_tol(i) = clubb_params(i,iSkw_denom_coef) * x_tol**2
          80             :     end do
          81             :     !$acc end parallel loop
          82             :
          83             :     !Skx = xp3 / ( max( xp2, x_tol**two ) )**three_halves
          84             :     ! Calculation of skewness to help reduce the sensitivity of this value to
          85             :     ! small values of xp2.
          86             :     !$acc parallel loop gang vector collapse(2) default(present)
          87  9989392608 :     do k = 1, nz
          88 >16497*10^7 :       do i = 1, ngrdcol
          89 >16486*10^7 :         Skx(i,k) = xp3(i,k) * sqrt( xp2(i,k) + Skx_denom_tol(i) )**(-3)
          90             :       end do
          91             :     end do
          92             :     !$acc end parallel loop
          93             :
          94             :     ! This is no longer needed since clipping is already
          95             :     ! imposed on wp2 and wp3 elsewhere in the code
          96             :
          97             :     ! I turned clipping on in this local copy since thlp3 and rtp3 are not clipped
          98             :     if ( l_clipping_kluge ) then
          99             :       !$acc parallel loop gang vector collapse(2) default(present)
         100             :       do k = 1, nz
         101             :         do i = 1, ngrdcol
         102             :           Skx(i,k) = min( max( Skx(i,k), -clubb_params(i,iSkw_max_mag) ), clubb_params(i,iSkw_max_mag) )
         103             :         end do
         104             :       end do
         105             :       !$acc end parallel loop
         106             :     end if
         107             :
         108             :     !$acc end data
         109             :
         110   116155728 :     return
         111             :
         112             :   end subroutine Skx_func
         113             :
         114             :   !-----------------------------------------------------------------------------
         115    35740224 :   subroutine LG_2005_ansatz( nz, ngrdcol, Skw, wpxp, wp2, &
         116    35740224 :                              xp2, beta, sigma_sqd_w, x_tol, &
         117    35740224 :                              Skx )
         118             :
         119             :     ! Description:
         120             :     ! Calculate the skewness of x using the diagnostic ansatz of Larson and
         121             :     ! Golaz (2005).
         122             :
         123             :     ! References:
         124             :     ! Vincent E. Larson and Jean-Christophe Golaz, 2005:  Using Probability
         125             :     ! Density Functions to Derive Consistent Closure Relationships among
         126             :     ! Higher-Order Moments.  Mon. Wea. Rev., 133, 1023–1042.
         127             :     !-----------------------------------------------------------------------
         128             :
         129             :     use constants_clubb, only: &
         130             :         one,          & ! Variable(s)
         131             :         w_tol_sqd
         132             :
         133             :     use clubb_precision, only: &
         134             :         core_rknd ! Variable(s)
         135             :
         136             :     implicit none
         137             :
         138             :     !-------------------------- Input Variables --------------------------
         139             :     integer, intent(in) :: &
         140             :       nz, &
         141             :       ngrdcol
         142             :
         143             :     real( kind = core_rknd ), dimension(ngrdcol,nz), intent(in) :: &
         144             :       Skw,         & ! Skewness of w                  [-]
         145             :       wpxp,        & ! Turbulent flux of x            [m/s (x units)]
         146             :       wp2,         & ! Variance of w                  [m^2/s^2]
         147             :       xp2,         & ! Variance of x                  [(x units)^2]
         148             :       sigma_sqd_w    ! Normalized variance of w       [-]
         149             :
         150             :     real( kind = core_rknd ), dimension(ngrdcol), intent(in) :: &
         151             :       beta           ! Tunable parameter              [-]
         152             :
         153             :     real( kind = core_rknd ), intent(in) :: &
         154             :       x_tol          ! Minimum tolerance of x         [(x units)]
         155             :
         156             :     !-------------------------- Output Variable --------------------------
         157             :     real( kind = core_rknd ), dimension(ngrdcol,nz) :: &
         158             :       Skx            ! Skewness of x                  [-]
         159             :
         160             :     !-------------------------- Local Variables --------------------------
         161             :     real( kind = core_rknd ) :: &
         162             :       nrmlzd_corr_wx, & ! Normalized correlation of w and x       [-]
         163             :       nrmlzd_Skw        ! Normalized skewness of w                [-]
         164             :
         165             :     integer :: i, k
         166             :
         167             :     !--------------------------Begin Code --------------------------
         168             :
         169             :     ! weberjk, 8-July 2015. Commented this out for now. cgils was failing during some tests.
         170             :
         171             :     ! Larson and Golaz (2005) eq. 16
         172             :     !$acc parallel loop gang vector collapse(2) default(present)
         173  3073659264 :     do k = 1, nz
         174 50761923264 :       do i = 1, ngrdcol
         175             :         nrmlzd_corr_wx = &
         176 95376528000 :                 wpxp(i,k) / sqrt( max( wp2(i,k), w_tol_sqd ) &
         177 95376528000 :                              * max( xp2(i,k), x_tol**2 ) * ( one - sigma_sqd_w(i,k) ) )
         178             :
         179             :         ! Larson and Golaz (2005) eq. 11
         180 47688264000 :         nrmlzd_Skw = Skw(i,k) / ( ( one - sigma_sqd_w(i,k)) * sqrt( one - sigma_sqd_w(i,k) ) )
         181             :
         182             :         ! Larson and Golaz (2005) eq. 33
         183             :         Skx(i,k) = nrmlzd_Skw * nrmlzd_corr_wx &
         184 50726183040 :               * ( beta(i) + ( one - beta(i) ) * nrmlzd_corr_wx**2 )
         185             :       end do
         186             :     end do
         187             :     !$acc end parallel loop
         188             :
         189    35740224 :     return
         190             :
         191             :   end subroutine LG_2005_ansatz
         192             :
         193             :   !-----------------------------------------------------------------------------
         194    35740224 :   subroutine xp3_LG_2005_ansatz( nz, ngrdcol, Skw_zt, wpxp_zt, wp2_zt, &
         195    35740224 :                                  xp2_zt, sigma_sqd_w_zt, &
         196    35740224 :                                  clubb_params, x_tol, &
         197    35740224 :                                  xp3 )
         198             :     ! Description:
         199             :     ! Calculate <x'^3> after calculating the skewness of x using the ansatz of
         200             :     ! Larson and Golaz (2005).
         201             :
         202             :     ! References:
         203             :     !-----------------------------------------------------------------------
         204             :
         205             :     use grid_class, only: &
         206             :         grid ! Type
         207             :
         208             :     use clubb_precision, only: &
         209             :         core_rknd ! Variable(s)
         210             :
         211             :     use parameter_indices, only: &
         212             :       nparams,                 & ! Variable(s)
         213             :       iSkw_denom_coef,         &
         214             :       ibeta
         215             :
         216             :     implicit none
         217             :
         218             :     !-------------------------- Input Variables--------------------------
         219             :     integer, intent(in) :: &
         220             :       nz, &
         221             :       ngrdcol
         222             :
         223             :     real( kind = core_rknd ), dimension(ngrdcol,nz), intent(in) :: &
         224             :       Skw_zt,         & ! Skewness of w on thermodynamic levels   [-]
         225             :       wpxp_zt,        & ! Flux of x  (interp. to t-levs.)         [m/s(x units)]
         226             :       wp2_zt,         & ! Variance of w (interp. to t-levs.)      [m^2/s^2]
         227             :       xp2_zt,         & ! Variance of x (interp. to t-levs.)      [(x units)^2]
         228             :       sigma_sqd_w_zt    ! Normalized variance of w (interp. to t-levs.)   [-]
         229             :
         230             :     real( kind = core_rknd ), dimension(ngrdcol,nparams), intent(in) :: &
         231             :       clubb_params    ! Array of CLUBB's tunable parameters    [units vary]
         232             :
         233             :     real( kind = core_rknd ), intent(in) :: &
         234             :       x_tol             ! Minimum tolerance of x                  [(x units)]
         235             :
         236             :     !-------------------------- Return Variable --------------------------
         237             :     real( kind = core_rknd ), dimension(ngrdcol,nz) :: &
         238             :       xp3    ! <x'^3> (thermodynamic levels)    [(x units)^3]
         239             :
         240             :     !-------------------------- Local Variable --------------------------
         241             :     real( kind = core_rknd ), dimension(ngrdcol,nz) :: &
         242    71480448 :       Skx_zt       ! Skewness of x on thermodynamic levels    [-]
         243             :
         244             :     real( kind = core_rknd ), dimension(ngrdcol) :: &
         245    71480448 :       Skx_denom_tol
         246             :
         247             :     integer :: i, k
         248             :
         249             :     !-------------------------- Begin Code --------------------------
         250             :
         251             :     !$acc data copyin( Skw_zt, wpxp_zt, wp2_zt, xp2_zt, sigma_sqd_w_zt ) &
         252             :     !$acc      create( Skx_zt, Skx_denom_tol ) &
         253             :     !$acc      copyout( xp3 )
         254             :
         255             :     ! Calculate skewness of x using the ansatz of LG05.
         256             :     call LG_2005_ansatz( nz, ngrdcol, Skw_zt, wpxp_zt, wp2_zt, &
         257             :                          xp2_zt, clubb_params(:,ibeta), sigma_sqd_w_zt, x_tol, &
         258    35740224 :                          Skx_zt )
         259             :
         260             :     !$acc parallel loop gang vector default(present)
         261   596778624 :     do i = 1, ngrdcol
         262   596778624 :       Skx_denom_tol(i) = clubb_params(i,iSkw_denom_coef) * x_tol**2
         263             :     end do
         264             :     !$acc end parallel loop
         265             :
         266             :     ! Calculate <x'^3> using the reverse of the special sensitivity reduction
         267             :     ! formula in function Skx_func above.
         268             :     !$acc parallel loop gang vector collapse(2) default(present)
         269  3073659264 :     do k = 1, nz
         270 50761923264 :       do i = 1, ngrdcol
         271 95376528000 :         xp3(i,k) = Skx_zt(i,k) * ( xp2_zt(i,k) + Skx_denom_tol(i) ) &
         272 >14610*10^7 :                                * sqrt( xp2_zt(i,k) + Skx_denom_tol(i) )
         273             :       end do
         274             :     end do
         275             :     !$acc end parallel loop
         276             :
         277             :     !$acc end data
         278             :
         279    35740224 :     return
         280             :
         281             :   end subroutine xp3_LG_2005_ansatz
         282             :
         283             :   !-----------------------------------------------------------------------------
         284             :
         285             : end module Skx_module

Generated by: LCOV version 1.14