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 | real(wp) :: seuil |
---|
60 | |
---|
61 | if (ok_debug_cosp) then |
---|
62 | seuil=1.e-15 |
---|
63 | else |
---|
64 | seuil=0.0 |
---|
65 | endif |
---|
66 | |
---|
67 | |
---|
68 | |
---|
69 | mxratio = 0.0 |
---|
70 | |
---|
71 | if (n_ax >= 0.0) then ! N_ax is used to control which hydrometeors need to be computed |
---|
72 | xi = d_x/(alpha_x + b_x - n_bx + 1._wp) |
---|
73 | rho0 = 1.29_wp |
---|
74 | sigma = (gamma2/(gamma1*c_x))*(n_ax*a_x*gamma2)**xi |
---|
75 | one_over_xip1 = 1._wp/(xi + 1._wp) |
---|
76 | gamma_4_3_2 = 0.5_wp*gamma4/gamma3 |
---|
77 | delta = (alpha_x + b_x + d_x - n_bx + 1._wp) |
---|
78 | |
---|
79 | do k=1,Nlevels |
---|
80 | do j=1,Ncolumns |
---|
81 | do i=1,Npoints |
---|
82 | if ((prec_frac(i,j,k)==prec_type).or.(prec_frac(i,j,k)==3.)) then |
---|
83 | rho = p(i,k)/(287.05_wp*T(i,k)) |
---|
84 | mxratio(i,j,k)=(flux(i,k)*((rho/rho0)**g_x)*sigma)**one_over_xip1 |
---|
85 | mxratio(i,j,k)=mxratio(i,j,k)/rho |
---|
86 | ! Compute effective radius |
---|
87 | ! if ((reff(i,j,k) <= 0._wp).and.(flux(i,k) /= 0._wp)) then |
---|
88 | if ((reff(i,j,k) <= 0._wp).and.(flux(i,k) > seuil)) then |
---|
89 | lambda_x = (a_x*c_x*((rho0/rho)**g_x)*n_ax*gamma1/flux(i,k))**(1._wp/delta) |
---|
90 | reff(i,j,k) = gamma_4_3_2/lambda_x |
---|
91 | endif |
---|
92 | endif |
---|
93 | |
---|
94 | !Test Artem MxRatio |
---|
95 | !print '(a8, i5, i8, i8, f10.2, f10.2, f10.2, f10.2, f10.2)',& |
---|
96 | !'MxRatio ', k, j, i, rho, p(i,k), T(i,k), flux(i,k), mxratio(i,j,k) |
---|
97 | |
---|
98 | enddo |
---|
99 | enddo |
---|
100 | enddo |
---|
101 | endif |
---|
102 | END SUBROUTINE COSP_PRECIP_MXRATIO |
---|
103 | |
---|
104 | |
---|
105 | END MODULE MOD_COSP_UTILS |
---|