My Project
 All Classes Files Functions Variables Macros
prec_scops.F
Go to the documentation of this file.
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