Home

Context Navigation

source: palm/trunk/SOURCE/plant_canopy_model.f90 @ 1036

Last change on this file since 1036 was 1036, checked in by raasch, 11 years ago
code has been put under the GNU General Public License (v3)
Property svn:keywords set to `Id`
File size: 14.2 KB

Line
1	MODULE plant_canopy_model_mod
2
3	!--------------------------------------------------------------------------------!
4	! This file is part of PALM.
5	!
6	! PALM is free software: you can redistribute it and/or modify it under the terms
7	! of the GNU General Public License as published by the Free Software Foundation,
8	! either version 3 of the License, or (at your option) any later version.
9	!
10	! PALM is distributed in the hope that it will be useful, but WITHOUT ANY
11	! WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
12	! A PARTICULAR PURPOSE. See the GNU General Public License for more details.
13	!
14	! You should have received a copy of the GNU General Public License along with
15	! PALM. If not, see <http://www.gnu.org/licenses/>.
16	!
17	! Copyright 1997-2012 Leibniz University Hannover
18	!--------------------------------------------------------------------------------!
19	!
20	! Current revisions:
21	! -----------------
22	!
23	!
24	! Former revisions:
25	! -----------------
26	! $Id: plant_canopy_model.f90 1036 2012-10-22 13:43:42Z raasch $
27	!
28	! 257 2009-03-11 15:17:42Z heinze
29	! Output of messages replaced by message handling routine.
30	! Bugfix: remove IF statement in plant_canopy_model_ij
31	!
32	! 153 2008-03-19 09:41:30Z steinfeld
33	! heat sources within the forest canopy are added, which represent the
34	! rate of heat input into the air from the forest leaves, evaluation of sinks
35	! and sources for scalar concentration due to canopy elements
36	!
37	! 138 2007-11-28 10:03:58Z letzel
38	! Initial revision
39	!
40	! Description:
41	! ------------
42	! Evaluation of sinks and sources of momentum, heat and scalar concentration
43	! due to canopy elements
44	!------------------------------------------------------------------------------!
45
46	PRIVATE
47	PUBLIC plant_canopy_model
48
49	INTERFACE plant_canopy_model
50	MODULE PROCEDURE plant_canopy_model
51	MODULE PROCEDURE plant_canopy_model_ij
52	END INTERFACE plant_canopy_model
53
54	CONTAINS
55
56
57	!------------------------------------------------------------------------------!
58	! Call for all grid points
59	!------------------------------------------------------------------------------!
60	SUBROUTINE plant_canopy_model( component )
61
62	USE arrays_3d
63	USE control_parameters
64	USE indices
65	USE pegrid
66
67	IMPLICIT NONE
68
69	INTEGER :: component, i, j, k
70
71	!
72	!-- Compute drag for the three velocity components and the SGS-TKE
73	SELECT CASE ( component )
74
75	!
76	!-- u-component
77	CASE ( 1 )
78	DO i = nxlu, nxr
79	DO j = nys, nyn
80	DO k = nzb_u_inner(j,i)+1, pch_index
81	tend(k,j,i) = tend(k,j,i) - &
82	cdc(k,j,i) * lad_u(k,j,i) * &
83	SQRT( u(k,j,i)**2 + &
84	( ( v(k,j,i-1) + &
85	v(k,j,i) + &
86	v(k,j+1,i) + &
87	v(k,j+1,i-1) ) &
88	/ 4.0 )**2 + &
89	( ( w(k-1,j,i-1) + &
90	w(k-1,j,i) + &
91	w(k,j,i-1) + &
92	w(k,j,i) ) &
93	/ 4.0 )*2 ) &
94	u(k,j,i)
95	ENDDO
96	ENDDO
97	ENDDO
98
99	!
100	!-- v-component
101	CASE ( 2 )
102	DO i = nxl, nxr
103	DO j = nysv, nyn
104	DO k = nzb_v_inner(j,i)+1, pch_index
105	tend(k,j,i) = tend(k,j,i) - &
106	cdc(k,j,i) * lad_v(k,j,i) * &
107	SQRT( ( ( u(k,j-1,i) + &
108	u(k,j-1,i+1) + &
109	u(k,j,i) + &
110	u(k,j,i+1) ) &
111	/ 4.0 )**2 + &
112	v(k,j,i)**2 + &
113	( ( w(k-1,j-1,i) + &
114	w(k-1,j,i) + &
115	w(k,j-1,i) + &
116	w(k,j,i) ) &
117	/ 4.0 )*2 ) &
118	v(k,j,i)
119	ENDDO
120	ENDDO
121	ENDDO
122
123	!
124	!-- w-component
125	CASE ( 3 )
126	DO i = nxl, nxr
127	DO j = nys, nyn
128	DO k = nzb_w_inner(j,i)+1, pch_index
129	tend(k,j,i) = tend(k,j,i) - &
130	cdc(k,j,i) * lad_w(k,j,i) * &
131	SQRT( ( ( u(k,j,i) + &
132	u(k,j,i+1) + &
133	u(k+1,j,i) + &
134	u(k+1,j,i+1) ) &
135	/ 4.0 )**2 + &
136	( ( v(k,j,i) + &
137	v(k,j+1,i) + &
138	v(k+1,j,i) + &
139	v(k+1,j+1,i) ) &
140	/ 4.0 )**2 + &
141	w(k,j,i)*2 ) &
142	w(k,j,i)
143	ENDDO
144	ENDDO
145	ENDDO
146
147	!
148	!-- potential temperature
149	CASE ( 4 )
150	DO i = nxl, nxr
151	DO j = nys, nyn
152	DO k = nzb_s_inner(j,i)+1, pch_index
153	tend(k,j,i) = tend(k,j,i) + &
154	( canopy_heat_flux(k,j,i) - &
155	canopy_heat_flux(k-1,j,i) ) / &
156	dzw(k)
157	ENDDO
158	ENDDO
159	ENDDO
160
161	!
162	!-- scalar concentration
163	CASE ( 5 )
164	DO i = nxl, nxr
165	DO j = nys, nyn
166	DO k = nzb_s_inner(j,i)+1, pch_index
167	tend(k,j,i) = tend(k,j,i) - &
168	sec(k,j,i) * lad_s(k,j,i) * &
169	SQRT( ( ( u(k,j,i) + &
170	u(k,j,i+1) ) &
171	/ 2.0 )**2 + &
172	( ( v(k,j,i) + &
173	v(k,j+1,i) ) &
174	/ 2.0 )**2 + &
175	( ( w(k-1,j,i) + &
176	w(k,j,i) ) &
177	/ 2.0 )*2 ) &
178	( q(k,j,i) - sls(k,j,i) )
179	ENDDO
180	ENDDO
181	ENDDO
182
183	!
184	!-- sgs-tke
185	CASE ( 6 )
186	DO i = nxl, nxr
187	DO j = nys, nyn
188	DO k = nzb_s_inner(j,i)+1, pch_index
189	tend(k,j,i) = tend(k,j,i) - &
190	2.0 * cdc(k,j,i) * lad_s(k,j,i) * &
191	SQRT( ( ( u(k,j,i) + &
192	u(k,j,i+1) ) &
193	/ 2.0 )**2 + &
194	( ( v(k,j,i) + &
195	v(k,j+1,i) ) &
196	/ 2.0 )**2 + &
197	( ( w(k,j,i) + &
198	w(k+1,j,i) ) &
199	/ 2.0 )*2 ) &
200	e(k,j,i)
201	ENDDO
202	ENDDO
203	ENDDO
204
205	CASE DEFAULT
206
207	WRITE( message_string, * ) 'wrong component: ', component
208	CALL message( 'plant_canopy_model', 'PA0279', 1, 2, 0, 6, 0 )
209
210	END SELECT
211
212	END SUBROUTINE plant_canopy_model
213
214
215	!------------------------------------------------------------------------------!
216	! Call for grid point i,j
217	!------------------------------------------------------------------------------!
218	SUBROUTINE plant_canopy_model_ij( i, j, component )
219
220	USE arrays_3d
221	USE control_parameters
222	USE indices
223	USE pegrid
224
225	IMPLICIT NONE
226
227	INTEGER :: component, i, j, k
228
229	!
230	!-- Compute drag for the three velocity components
231	SELECT CASE ( component )
232
233	!
234	!-- u-component
235	CASE ( 1 )
236	DO k = nzb_u_inner(j,i)+1, pch_index
237	tend(k,j,i) = tend(k,j,i) - &
238	cdc(k,j,i) * lad_u(k,j,i) * &
239	SQRT( u(k,j,i)**2 + &
240	( ( v(k,j,i-1) + &
241	v(k,j,i) + &
242	v(k,j+1,i) + &
243	v(k,j+1,i-1) ) &
244	/ 4.0 )**2 + &
245	( ( w(k-1,j,i-1) + &
246	w(k-1,j,i) + &
247	w(k,j,i-1) + &
248	w(k,j,i) ) &
249	/ 4.0 )*2 ) &
250	u(k,j,i)
251	ENDDO
252
253	!
254	!-- v-component
255	CASE ( 2 )
256	DO k = nzb_v_inner(j,i)+1, pch_index
257	tend(k,j,i) = tend(k,j,i) - &
258	cdc(k,j,i) * lad_v(k,j,i) * &
259	SQRT( ( ( u(k,j-1,i) + &
260	u(k,j-1,i+1) + &
261	u(k,j,i) + &
262	u(k,j,i+1) ) &
263	/ 4.0 )**2 + &
264	v(k,j,i)**2 + &
265	( ( w(k-1,j-1,i) + &
266	w(k-1,j,i) + &
267	w(k,j-1,i) + &
268	w(k,j,i) ) &
269	/ 4.0 )*2 ) &
270	v(k,j,i)
271	ENDDO
272
273	!
274	!-- w-component
275	CASE ( 3 )
276	DO k = nzb_w_inner(j,i)+1, pch_index
277	tend(k,j,i) = tend(k,j,i) - &
278	cdc(k,j,i) * lad_w(k,j,i) * &
279	SQRT( ( ( u(k,j,i) + &
280	u(k,j,i+1) + &
281	u(k+1,j,i) + &
282	u(k+1,j,i+1) ) &
283	/ 4.0 )**2 + &
284	( ( v(k,j,i) + &
285	v(k,j+1,i) + &
286	v(k+1,j,i) + &
287	v(k+1,j+1,i) ) &
288	/ 4.0 )**2 + &
289	w(k,j,i)*2 ) &
290	w(k,j,i)
291
292	ENDDO
293
294	!
295	!-- potential temperature
296	CASE ( 4 )
297	DO k = nzb_s_inner(j,i)+1, pch_index
298	tend(k,j,i) = tend(k,j,i) + &
299	( canopy_heat_flux(k,j,i) - &
300	canopy_heat_flux(k-1,j,i) ) / &
301	dzw(k)
302	ENDDO
303
304
305	!
306	!-- scalar concentration
307	CASE ( 5 )
308	DO k = nzb_s_inner(j,i)+1, pch_index
309	tend(k,j,i) = tend(k,j,i) - &
310	sec(k,j,i) * lad_s(k,j,i) * &
311	SQRT( ( ( u(k,j,i) + &
312	u(k,j,i+1) ) &
313	/ 2.0 )**2 + &
314	( ( v(k,j,i) + &
315	v(k,j+1,i) ) &
316	/ 2.0 )**2 + &
317	( ( w(k-1,j,i) + &
318	w(k,j,i) ) &
319	/ 2.0 )*2 ) &
320	( q(k,j,i) - sls(k,j,i) )
321	ENDDO
322
323	!
324	!-- sgs-tke
325	CASE ( 6 )
326	DO k = nzb_s_inner(j,i)+1, pch_index
327	tend(k,j,i) = tend(k,j,i) - &
328	2.0 * cdc(k,j,i) * lad_s(k,j,i) * &
329	SQRT( ( ( u(k,j,i) + &
330	u(k,j,i+1) ) &
331	/ 2.0 )**2 + &
332	( ( v(k,j,i) + &
333	v(k,j+1,i) ) &
334	/ 2.0 )**2 + &
335	( ( w(k,j,i) + &
336	w(k+1,j,i) ) &
337	/ 2.0 )*2 ) &
338	e(k,j,i)
339	ENDDO
340
341	CASE DEFAULT
342
343	WRITE( message_string, * ) 'wrong component: ', component
344	CALL message( 'plant_canopy_model', 'PA0279', 1, 2, 0, 6, 0 )
345
346	END SELECT
347
348	END SUBROUTINE plant_canopy_model_ij
349
350	END MODULE plant_canopy_model_mod

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |