Context Navigation

prec_scops.F @ 1

Last change on this file since 1 was 1, checked in by emillour, 14 years ago
Import initial LMDZ5
File size: 8.2 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 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.

Download in other formats:

Original Format