source: LMDZ6/branches/Amaury_dev/libf/phylmd/cospv2/cosp_utils.F90 @ 5133

Last change on this file since 5133 was 5099, checked in by abarral, 5 months ago

Replace most uses of CPP_DUST by the corresponding logical defined in lmdz_cppkeys_wrapper.F90
Convert several files from .F to .f90 to allow Dust to compile w/o rrtm/ecrad
Create lmdz_yoerad.f90
(lint) Remove "!" on otherwise empty line

File size: 4.6 KB
Line 
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! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
34MODULE MOD_COSP_UTILS
35  USE COSP_KINDS, ONLY: wp
36  USE MOD_COSP_CONFIG
37  IMPLICIT NONE
38
39CONTAINS
40!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
41!------------------- SUBROUTINE COSP_PRECIP_MXRATIO --------------
42!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
43SUBROUTINE 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
102END SUBROUTINE COSP_PRECIP_MXRATIO
103
104
105END MODULE MOD_COSP_UTILS
Note: See TracBrowser for help on using the repository browser.