source: LMDZ4/trunk/libf/cosp/prec_scops.F @ 5308

Last change on this file since 5308 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: 8.2 KB
RevLine 
[1262]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 prec_scops(npoints,nlev,ncol,ls_p_rate,cv_p_rate,
26     &                      frac_out,prec_frac)
27
28
29      implicit none
30
31      INTEGER npoints       !  number of model points in the horizontal
32      INTEGER nlev          !  number of model levels in column
33      INTEGER ncol          !  number of subcolumns
34
35      INTEGER i,j,ilev,ibox,cv_col
36     
37      REAL ls_p_rate(npoints,nlev),cv_p_rate(npoints,nlev)
38
39      REAL frac_out(npoints,ncol,nlev) ! boxes gridbox divided up into
40                              ! Equivalent of BOX in original version, but
41                              ! indexed by column then row, rather than
42                              ! by row then column
43                              !TOA to SURFACE!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
44      REAL prec_frac(npoints,ncol,nlev) ! 0 -> clear sky
45                                        ! 1 -> LS precipitation
46                                        ! 2 -> CONV precipitation
47                                        ! 3 -> both
48                                        !TOA to SURFACE!!!!!!!!!!!!!!!!!!
49                                       
50      INTEGER flag_ls, flag_cv
51      INTEGER frac_out_ls(npoints,ncol),frac_out_cv(npoints,ncol) !flag variables for
52                       ! stratiform cloud and convective cloud in the vertical column
53
54      cv_col = 0.05*ncol
55      if (cv_col .eq. 0) cv_col=1
56 
57      do ilev=1,nlev
58      do ibox=1,ncol
59        do j=1,npoints
60        prec_frac(j,ibox,ilev) = 0
61        enddo
62      enddo
63      enddo
64     
65      do j=1,npoints
66       do ibox=1,ncol
67       frac_out_ls(j,ibox)=0
68       frac_out_cv(j,ibox)=0
69       flag_ls=0
70       flag_cv=0
71        do ilev=1,nlev
72         if (frac_out(j,ibox,ilev) .eq. 1) then
73          flag_ls=1
74         endif
75         if (frac_out(j,ibox,ilev) .eq. 2) then
76          flag_cv=1
77         endif
78        enddo !loop over nlev
79        if (flag_ls .eq. 1) then
80         frac_out_ls(j,ibox)=1
81        endif
82        if (flag_cv .eq. 1) then
83         frac_out_cv(j,ibox)=1
84        endif
85       enddo  ! loop over ncol
86      enddo ! loop over npoints
87
88!      initialize the top layer     
89       do j=1,npoints
90        flag_ls=0
91        flag_cv=0
92       
93        if (ls_p_rate(j,1) .gt. 0.) then
94         do ibox=1,ncol ! possibility ONE
95          if (frac_out(j,ibox,1) .eq. 1) then
96           prec_frac(j,ibox,1) = 1
97           flag_ls=1
98          endif
99         enddo ! loop over ncol
100         if (flag_ls .eq. 0) then ! possibility THREE
101          do ibox=1,ncol
102           if (frac_out(j,ibox,2) .eq. 1) then
103            prec_frac(j,ibox,1) = 1
104            flag_ls=1
105           endif
106          enddo ! loop over ncol
107         endif
108         if (flag_ls .eq. 0) then ! possibility Four
109          do ibox=1,ncol
110           if (frac_out_ls(j,ibox) .eq. 1) then
111            prec_frac(j,ibox,1) = 1
112            flag_ls=1
113           endif
114          enddo ! loop over ncol
115         endif
116         if (flag_ls .eq. 0) then ! possibility Five
117          do ibox=1,ncol
118!         prec_frac(j,1:ncol,1) = 1
119          prec_frac(j,ibox,1) = 1
120          enddo ! loop over ncol
121         endif
122        endif
123       ! There is large scale precipitation
124         
125        if (cv_p_rate(j,1) .gt. 0.) then
126         do ibox=1,ncol ! possibility ONE
127          if (frac_out(j,ibox,1) .eq. 2) then
128           if (prec_frac(j,ibox,1) .eq. 0) then
129            prec_frac(j,ibox,1) = 2
130           else
131            prec_frac(j,ibox,1) = 3
132           endif
133           flag_cv=1
134          endif
135         enddo ! loop over ncol
136         if (flag_cv .eq. 0) then ! possibility THREE
137          do ibox=1,ncol
138           if (frac_out(j,ibox,2) .eq. 2) then
139            if (prec_frac(j,ibox,1) .eq. 0) then
140             prec_frac(j,ibox,1) = 2
141            else
142             prec_frac(j,ibox,1) = 3
143            endif
144            flag_cv=1
145           endif
146          enddo ! loop over ncol
147         endif
148         if (flag_cv .eq. 0) then ! possibility Four
149          do ibox=1,ncol
150           if (frac_out_cv(j,ibox) .eq. 1) then
151            if (prec_frac(j,ibox,1) .eq. 0) then
152             prec_frac(j,ibox,1) = 2
153            else
154             prec_frac(j,ibox,1) = 3
155            endif
156            flag_cv=1
157           endif
158          enddo ! loop over ncol
159         endif
160         if (flag_cv .eq. 0) then  ! possibility Five
161          do ibox=1,cv_col
162            if (prec_frac(j,ibox,1) .eq. 0) then
163             prec_frac(j,ibox,1) = 2
164            else
165             prec_frac(j,ibox,1) = 3
166            endif
167          enddo !loop over cv_col
168         endif
169        endif
170       ! There is convective precipitation
171       
172       enddo ! loop over npoints
173!      end of initializing the top layer
174
175!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
176
177!     working on the levels from top to surface
178      do ilev=2,nlev
179       do j=1,npoints
180        flag_ls=0
181        flag_cv=0
182       
183        if (ls_p_rate(j,ilev) .gt. 0.) then
184         do ibox=1,ncol ! possibility ONE&TWO
185          if ((frac_out(j,ibox,ilev) .eq. 1) .or.
186     &       ((prec_frac(j,ibox,ilev-1) .eq. 1)
187     &       .or. (prec_frac(j,ibox,ilev-1) .eq. 3))) then
188           prec_frac(j,ibox,ilev) = 1
189           flag_ls=1
190          endif
191         enddo ! loop over ncol
192         if ((flag_ls .eq. 0) .and. (ilev .lt. nlev)) then ! possibility THREE
193          do ibox=1,ncol
194           if (frac_out(j,ibox,ilev+1) .eq. 1) then
195            prec_frac(j,ibox,ilev) = 1
196            flag_ls=1
197           endif
198          enddo ! loop over ncol
199         endif
200         if (flag_ls .eq. 0) then ! possibility Four
201          do ibox=1,ncol
202           if (frac_out_ls(j,ibox) .eq. 1) then
203            prec_frac(j,ibox,ilev) = 1
204            flag_ls=1
205           endif
206          enddo ! loop over ncol
207         endif
208         if (flag_ls .eq. 0) then ! possibility Five
209          do ibox=1,ncol
210!         prec_frac(j,1:ncol,ilev) = 1
211          prec_frac(j,ibox,ilev) = 1
212          enddo ! loop over ncol
213         endif
214        endif ! There is large scale precipitation
215       
216        if (cv_p_rate(j,ilev) .gt. 0.) then
217         do ibox=1,ncol ! possibility ONE&TWO
218          if ((frac_out(j,ibox,ilev) .eq. 2) .or.
219     &       ((prec_frac(j,ibox,ilev-1) .eq. 2)
220     &       .or. (prec_frac(j,ibox,ilev-1) .eq. 3))) then
221            if (prec_frac(j,ibox,ilev) .eq. 0) then
222             prec_frac(j,ibox,ilev) = 2
223            else
224             prec_frac(j,ibox,ilev) = 3
225            endif
226           flag_cv=1
227          endif
228         enddo ! loop over ncol
229         if ((flag_cv .eq. 0) .and. (ilev .lt. nlev)) then ! possibility THREE
230          do ibox=1,ncol
231           if (frac_out(j,ibox,ilev+1) .eq. 2) then
232            if (prec_frac(j,ibox,ilev) .eq. 0) then
233             prec_frac(j,ibox,ilev) = 2
234            else
235             prec_frac(j,ibox,ilev) = 3
236            endif
237            flag_cv=1
238           endif
239          enddo ! loop over ncol
240         endif
241         if (flag_cv .eq. 0) then ! possibility Four
242          do ibox=1,ncol
243           if (frac_out_cv(j,ibox) .eq. 1) then
244            if (prec_frac(j,ibox,ilev) .eq. 0) then
245             prec_frac(j,ibox,ilev) = 2
246            else
247             prec_frac(j,ibox,ilev) = 3
248            endif
249            flag_cv=1
250           endif
251          enddo ! loop over ncol
252         endif
253         if (flag_cv .eq. 0) then  ! possibility Five
254          do ibox=1,cv_col
255            if (prec_frac(j,ibox,ilev) .eq. 0) then
256             prec_frac(j,ibox,ilev) = 2
257            else
258             prec_frac(j,ibox,ilev) = 3
259            endif
260          enddo !loop over cv_col
261         endif
262        endif ! There is convective precipitation
263
264       enddo ! loop over npoints
265      enddo ! loop over nlev
266
267      end
268
Note: See TracBrowser for help on using the repository browser.