Line data    Source code

       1             : ! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
       2             : ! Copyright (c) 2015, Regents of the University of Colorado
       3             : ! All rights reserved.
       4             : !
       5             : ! Redistribution and use in source and binary forms, with or without modification, are 
       6             : ! permitted provided that the following conditions are met:
       7             : !
       8             : ! 1. Redistributions of source code must retain the above copyright notice, this list of 
       9             : !    conditions and the following disclaimer.
      10             : !
      11             : ! 2. Redistributions in binary form must reproduce the above copyright notice, this list
      12             : !    of conditions and the following disclaimer in the documentation and/or other 
      13             : !    materials provided with the distribution.
      14             : !
      15             : ! 3. Neither the name of the copyright holder nor the names of its contributors may be 
      16             : !    used to endorse or promote products derived from this software without specific prior
      17             : !    written permission.
      18             : !
      19             : ! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY 
      20             : ! EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF 
      21             : ! MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL 
      22             : ! THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 
      23             : ! SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT 
      24             : ! OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS 
      25             : ! INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
      26             : ! LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
      27             : ! OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
      28             : !
      29             : ! History:
      30             : ! Jul 2007 - A. Bodas-Salcedo - Initial version
      31             : ! May 2015 - Dustin Swales    - Modified for COSPv2.0
      32             : ! 
      33             : ! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
      34             : MODULE MOD_COSP_UTILS
      35             :   USE COSP_KINDS, ONLY: wp
      36             :   USE MOD_COSP_CONFIG
      37             :   IMPLICIT NONE
      38             : 
      39             : CONTAINS
      40             : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
      41             : !------------------- SUBROUTINE COSP_PRECIP_MXRATIO --------------
      42             : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
      43       46440 : SUBROUTINE COSP_PRECIP_MXRATIO(Npoints,Nlevels,Ncolumns,p,T,prec_frac,prec_type, &
      44             :                           n_ax,n_bx,alpha_x,c_x,d_x,g_x,a_x,b_x,gamma1,gamma2,gamma3,gamma4, &
      45       46440 :                           flux,mxratio,reff)
      46             : 
      47             :     ! Input arguments, (IN)
      48             :     integer,intent(in) :: Npoints,Nlevels,Ncolumns
      49             :     real(wp),intent(in),dimension(Npoints,Nlevels) :: p,T,flux
      50             :     real(wp),intent(in),dimension(Npoints,Ncolumns,Nlevels) :: prec_frac
      51             :     real(wp),intent(in) :: n_ax,n_bx,alpha_x,c_x,d_x,g_x,a_x,b_x,gamma1,gamma2,gamma3,gamma4,prec_type
      52             :     ! Input arguments, (OUT)
      53             :     real(wp),intent(out),dimension(Npoints,Ncolumns,Nlevels) :: mxratio
      54             :     real(wp),intent(inout),dimension(Npoints,Ncolumns,Nlevels) :: reff
      55             :     ! Local variables
      56             :     integer :: i,j,k
      57             :     real(wp) :: sigma,one_over_xip1,xi,rho0,rho,lambda_x,gamma_4_3_2,delta
      58             :     
      59   655317000 :     mxratio = 0.0
      60             : 
      61       46440 :     if (n_ax >= 0.0) then ! N_ax is used to control which hydrometeors need to be computed
      62       46440 :         xi      = d_x/(alpha_x + b_x - n_bx + 1._wp)
      63       46440 :         rho0    = 1.29_wp
      64       46440 :         sigma   = (gamma2/(gamma1*c_x))*(n_ax*a_x*gamma2)**xi
      65       46440 :         one_over_xip1 = 1._wp/(xi + 1._wp)
      66       46440 :         gamma_4_3_2 = 0.5_wp*gamma4/gamma3
      67       46440 :         delta = (alpha_x + b_x + d_x - n_bx + 1._wp)
      68             :         
      69     3947400 :         do k=1,Nlevels
      70    42957000 :             do j=1,Ncolumns
      71   655270560 :                 do i=1,Npoints
      72   651369600 :                     if ((prec_frac(i,j,k)==prec_type).or.(prec_frac(i,j,k)==3.)) then
      73   200739366 :                         rho = p(i,k)/(287.05_wp*T(i,k))
      74   200739366 :                         mxratio(i,j,k)=(flux(i,k)*((rho/rho0)**g_x)*sigma)**one_over_xip1
      75   200739366 :                         mxratio(i,j,k)=mxratio(i,j,k)/rho
      76             :                         ! Compute effective radius
      77   200739366 :                         if ((reff(i,j,k) <= 0._wp).and.(flux(i,k) /= 0._wp)) then
      78    61283999 :                            lambda_x = (a_x*c_x*((rho0/rho)**g_x)*n_ax*gamma1/flux(i,k))**(1._wp/delta)
      79    61283999 :                            reff(i,j,k) = gamma_4_3_2/lambda_x
      80             :                         endif
      81             :                     endif
      82             :                 enddo
      83             :             enddo
      84             :         enddo
      85             :     endif
      86       46440 : END SUBROUTINE COSP_PRECIP_MXRATIO
      87             : 
      88             : 
      89             : END MODULE MOD_COSP_UTILS