| [3927] | 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 | 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 | 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 | mxratio = 0.0 |
|---|
| 60 | |
|---|
| 61 | if (n_ax >= 0.0) then ! N_ax is used to control which hydrometeors need to be computed |
|---|
| 62 | xi = d_x/(alpha_x + b_x - n_bx + 1._wp) |
|---|
| 63 | rho0 = 1.29_wp |
|---|
| 64 | sigma = (gamma2/(gamma1*c_x))*(n_ax*a_x*gamma2)**xi |
|---|
| 65 | one_over_xip1 = 1._wp/(xi + 1._wp) |
|---|
| 66 | gamma_4_3_2 = 0.5_wp*gamma4/gamma3 |
|---|
| 67 | delta = (alpha_x + b_x + d_x - n_bx + 1._wp) |
|---|
| 68 | |
|---|
| 69 | do k=1,Nlevels |
|---|
| 70 | do j=1,Ncolumns |
|---|
| 71 | do i=1,Npoints |
|---|
| 72 | if ((prec_frac(i,j,k)==prec_type).or.(prec_frac(i,j,k)==3.)) then |
|---|
| 73 | rho = p(i,k)/(287.05_wp*T(i,k)) |
|---|
| 74 | mxratio(i,j,k)=(flux(i,k)*((rho/rho0)**g_x)*sigma)**one_over_xip1 |
|---|
| 75 | mxratio(i,j,k)=mxratio(i,j,k)/rho |
|---|
| 76 | ! Compute effective radius |
|---|
| 77 | if ((reff(i,j,k) <= 0._wp).and.(flux(i,k) /= 0._wp)) then |
|---|
| 78 | lambda_x = (a_x*c_x*((rho0/rho)**g_x)*n_ax*gamma1/flux(i,k))**(1._wp/delta) |
|---|
| 79 | reff(i,j,k) = gamma_4_3_2/lambda_x |
|---|
| 80 | endif |
|---|
| 81 | endif |
|---|
| 82 | enddo |
|---|
| 83 | enddo |
|---|
| 84 | enddo |
|---|
| 85 | endif |
|---|
| 86 | END SUBROUTINE COSP_PRECIP_MXRATIO |
|---|
| 87 | |
|---|
| 88 | |
|---|
| 89 | END MODULE MOD_COSP_UTILS |
|---|
