Context Navigation

← Previous Revision
Next Revision →
Blame
Revision Log

prec_scops.F

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

Note: See TracBrowser for help on using the repository browser.

Download in other formats:

Original Format