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 17:57:11 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