source: LMDZ6/branches/IPSLCM6.0.15/libf/phylmd/cosp/pf_to_mr.F @ 3373

Last change on this file since 3373 was 2428, checked in by idelkadi, 9 years ago

Mise a jour du simulateur COSP (passage de la version v3.2 a la version v1.4) :

  • mise a jour des sources pour ISCCP, CALIPSO et PARASOL
  • prise en compte des changements de phases pour les nuages (Calipso)
  • rajout de plusieurs diagnostiques (fraction nuageuse en fonction de la temperature, ...)

http://lmdz.lmd.jussieu.fr/Members/aidelkadi/cosp

  • Property copyright set to
    Name of program: LMDZ
    Creation date: 1984
    Version: LMDZ5
    License: CeCILL version 2
    Holder: Laboratoire de m\'et\'eorologie dynamique, CNRS, UMR 8539
    See the license file in the root directory
File size: 5.6 KB
Line 
1! (c) 2008, Lawrence Livermore National Security Limited Liability Corporation.
2! All rights reserved.
3! $Revision: 23 $, $Date: 2011-03-31 15:41:37 +0200 (jeu. 31 mars 2011) $
4! $URL: http://cfmip-obs-sim.googlecode.com/svn/stable/v1.4.0/llnl/pf_to_mr.f $
5!
6! Redistribution and use in source and binary forms, with or without modification, are permitted
7! provided that the following conditions are met:
8!
9!     * Redistributions of source code must retain the above copyright notice, this list
10!       of conditions and the following disclaimer.
11!     * 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 materials
13!       provided with the distribution.
14!     * Neither the name of the Lawrence Livermore National Security Limited Liability Corporation
15!       nor the names of its contributors may be used to endorse or promote products derived from
16!       this software without specific prior written permission.
17!
18! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR
19! IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
20! FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR
21! CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
22! DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
23! DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER
24! IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT
25! OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
26     
27      subroutine pf_to_mr(npoints,nlev,ncol,rain_ls,snow_ls,grpl_ls,
28     &                    rain_cv,snow_cv,prec_frac,
29     &                    p,t,mx_rain_ls,mx_snow_ls,mx_grpl_ls,
30     &                    mx_rain_cv,mx_snow_cv)
31
32
33      implicit none
34
35      INTEGER npoints       !  number of model points in the horizontal
36      INTEGER nlev          !  number of model levels in column
37      INTEGER ncol          !  number of subcolumns
38
39      INTEGER j,ilev,ibox
40     
41      REAL rain_ls(npoints,nlev),snow_ls(npoints,nlev) ! large-scale precip. flux
42      REAL grpl_ls(npoints,nlev)
43      REAL rain_cv(npoints,nlev),snow_cv(npoints,nlev) ! convective precip. flux
44
45      REAL prec_frac(npoints,ncol,nlev) ! 0 -> clear sky
46                                        ! 1 -> LS precipitation
47                                        ! 2 -> CONV precipitation
48                                        ! 3 -> both
49      REAL mx_rain_ls(npoints,ncol,nlev),mx_snow_ls(npoints,ncol,nlev)
50      REAL mx_grpl_ls(npoints,ncol,nlev)
51      REAL mx_rain_cv(npoints,ncol,nlev),mx_snow_cv(npoints,ncol,nlev)
52      REAL p(npoints,nlev),t(npoints,nlev)
53      REAL ar,as,ag,br,bs,bg,nr,ns,ng,rho0,rhor,rhos,rhog,rho
54      REAL term1r,term1s,term1g,term2r,term2s,term2g,term3
55      REAL term4r_ls,term4s_ls,term4g_ls,term4r_cv,term4s_cv
56      REAL term1x2r,term1x2s,term1x2g,t123r,t123s,t123g
57     
58      ! method from Khairoutdinov and Randall (2003 JAS)
59
60      ! --- List of constants from Appendix B
61      ! Constant in fall speed formula
62      ar=842.
63      as=4.84
64      ag=94.5
65      ! Exponent in fall speed formula
66      br=0.8
67      bs=0.25
68      bg=0.5
69      ! Intercept parameter
70      nr=8.*1000.*1000.
71      ns=3.*1000.*1000.
72      ng=4.*1000.*1000.
73      ! Densities for air and hydrometeors
74      rho0=1.29
75      rhor=1000.
76      rhos=100.
77      rhog=400.
78      ! Term 1 of Eq. (A19).
79      term1r=ar*17.8379/6.
80      term1s=as*8.28508/6.
81      term1g=ag*11.6317/6.
82      ! Term 2 of Eq. (A19).
83      term2r=(3.14159265*rhor*nr)**(-br/4.)
84      term2s=(3.14159265*rhos*ns)**(-bs/4.)
85      term2g=(3.14159265*rhog*ng)**(-bg/4.)
86     
87      term1x2r=term1r*term2r
88      term1x2s=term1s*term2s
89      term1x2g=term1g*term2g
90      do ilev=1,nlev
91        do j=1,npoints
92            rho=p(j,ilev)/(287.05*t(j,ilev))
93            term3=(rho0/rho)**0.5
94            ! Term 4 of Eq. (A19).
95            t123r=term1x2r*term3
96            t123s=term1x2s*term3
97            t123g=term1x2g*term3
98            term4r_ls=rain_ls(j,ilev)/(t123r)
99            term4s_ls=snow_ls(j,ilev)/(t123s)
100            term4g_ls=grpl_ls(j,ilev)/(t123g)
101            term4r_cv=rain_cv(j,ilev)/(t123r)
102            term4s_cv=snow_cv(j,ilev)/(t123s)
103            do ibox=1,ncol
104                mx_rain_ls(j,ibox,ilev)=0.
105                mx_snow_ls(j,ibox,ilev)=0.
106                mx_grpl_ls(j,ibox,ilev)=0.
107                mx_rain_cv(j,ibox,ilev)=0.
108                mx_snow_cv(j,ibox,ilev)=0.
109                if ((prec_frac(j,ibox,ilev) .eq. 1.) .or.
110     &              (prec_frac(j,ibox,ilev) .eq. 3.)) then
111                    mx_rain_ls(j,ibox,ilev)=
112     &                     (term4r_ls**(1./(1.+br/4.)))/rho
113                    mx_snow_ls(j,ibox,ilev)=
114     &                     (term4s_ls**(1./(1.+bs/4.)))/rho
115                    mx_grpl_ls(j,ibox,ilev)=
116     &                     (term4g_ls**(1./(1.+bg/4.)))/rho
117                endif
118                if ((prec_frac(j,ibox,ilev) .eq. 2.) .or.
119     &              (prec_frac(j,ibox,ilev) .eq. 3.)) then
120                    mx_rain_cv(j,ibox,ilev)=
121     &                     (term4r_cv**(1./(1.+br/4.)))/rho
122                    mx_snow_cv(j,ibox,ilev)=
123     &                     (term4s_cv**(1./(1.+bs/4.)))/rho
124                endif
125            enddo ! loop over ncol
126        enddo ! loop over npoints
127      enddo ! loop over nlev
128 
129      end
130
Note: See TracBrowser for help on using the repository browser.