source: LMDZ4/trunk/libf/cosp/pf_to_mr.F @ 3782

Last change on this file since 3782 was 1279, checked in by Laurent Fairhead, 15 years ago

Merged LMDZ4-dev branch changes r1241:1278 into the trunk
Running trunk and LMDZ4-dev in LMDZOR configuration on local
machine (sequential) and SX8 (4-proc) yields identical results
(restart and restartphy are identical binarily)
Log history from r1241 to r1278 is available by switching to
source:LMDZ4/branches/LMDZ4-dev-20091210

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