Home

Context Navigation

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

Last change on this file since 1463 was 1341, checked in by kanani, 11 years ago
last commit documented
Property svn:keywords set to `Id`
File size: 15.4 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-2014 Leibniz Universitaet Hannover
18	!--------------------------------------------------------------------------------!
19	!
20	! Current revisions:
21	! -----------------
22	!
23	!
24	! Former revisions:
25	! -----------------
26	! $Id: plant_canopy_model.f90 1341 2014-03-25 19:48:09Z suehring $
27	!
28	! 1340 2014-03-25 19:45:13Z kanani
29	! REAL constants defined as wp-kind
30	!
31	! 1320 2014-03-20 08:40:49Z raasch
32	! ONLY-attribute added to USE-statements,
33	! kind-parameters added to all INTEGER and REAL declaration statements,
34	! kinds are defined in new module kinds,
35	! old module precision_kind is removed,
36	! revision history before 2012 removed,
37	! comment fields (!:) to be used for variable explanations added to
38	! all variable declaration statements
39	!
40	! 1036 2012-10-22 13:43:42Z raasch
41	! code put under GPL (PALM 3.9)
42	!
43	! 138 2007-11-28 10:03:58Z letzel
44	! Initial revision
45	!
46	! Description:
47	! ------------
48	! Evaluation of sinks and sources of momentum, heat and scalar concentration
49	! due to canopy elements
50	!------------------------------------------------------------------------------!
51
52	PRIVATE
53	PUBLIC plant_canopy_model
54
55	INTERFACE plant_canopy_model
56	MODULE PROCEDURE plant_canopy_model
57	MODULE PROCEDURE plant_canopy_model_ij
58	END INTERFACE plant_canopy_model
59
60	CONTAINS
61
62
63	!------------------------------------------------------------------------------!
64	! Call for all grid points
65	!------------------------------------------------------------------------------!
66	SUBROUTINE plant_canopy_model( component )
67
68	USE arrays_3d, &
69	ONLY: canopy_heat_flux, cdc, dzw, e, lad_s, lad_u, lad_v, lad_w, &
70	q, sec, sls, tend, u, v, w
71
72	USE control_parameters, &
73	ONLY: pch_index, message_string
74
75	USE indices, &
76	ONLY: nxl, nxlu, nxr, nys, nysv, nyn, nzb_s_inner, nzb_u_inner, &
77	nzb_v_inner, nzb_w_inner
78
79	USE kinds
80
81	IMPLICIT NONE
82
83	INTEGER(iwp) :: component !:
84	INTEGER(iwp) :: i !:
85	INTEGER(iwp) :: j !:
86	INTEGER(iwp) :: k !:
87
88	!
89	!-- Compute drag for the three velocity components and the SGS-TKE
90	SELECT CASE ( component )
91
92	!
93	!-- u-component
94	CASE ( 1 )
95	DO i = nxlu, nxr
96	DO j = nys, nyn
97	DO k = nzb_u_inner(j,i)+1, pch_index
98	tend(k,j,i) = tend(k,j,i) - &
99	cdc(k,j,i) * lad_u(k,j,i) * &
100	SQRT( u(k,j,i)**2 + &
101	( ( v(k,j,i-1) + &
102	v(k,j,i) + &
103	v(k,j+1,i) + &
104	v(k,j+1,i-1) ) &
105	/ 4.0_wp )**2 + &
106	( ( w(k-1,j,i-1) + &
107	w(k-1,j,i) + &
108	w(k,j,i-1) + &
109	w(k,j,i) ) &
110	/ 4.0_wp )*2 ) &
111	u(k,j,i)
112	ENDDO
113	ENDDO
114	ENDDO
115
116	!
117	!-- v-component
118	CASE ( 2 )
119	DO i = nxl, nxr
120	DO j = nysv, nyn
121	DO k = nzb_v_inner(j,i)+1, pch_index
122	tend(k,j,i) = tend(k,j,i) - &
123	cdc(k,j,i) * lad_v(k,j,i) * &
124	SQRT( ( ( u(k,j-1,i) + &
125	u(k,j-1,i+1) + &
126	u(k,j,i) + &
127	u(k,j,i+1) ) &
128	/ 4.0_wp )**2 + &
129	v(k,j,i)**2 + &
130	( ( w(k-1,j-1,i) + &
131	w(k-1,j,i) + &
132	w(k,j-1,i) + &
133	w(k,j,i) ) &
134	/ 4.0_wp )*2 ) &
135	v(k,j,i)
136	ENDDO
137	ENDDO
138	ENDDO
139
140	!
141	!-- w-component
142	CASE ( 3 )
143	DO i = nxl, nxr
144	DO j = nys, nyn
145	DO k = nzb_w_inner(j,i)+1, pch_index
146	tend(k,j,i) = tend(k,j,i) - &
147	cdc(k,j,i) * lad_w(k,j,i) * &
148	SQRT( ( ( u(k,j,i) + &
149	u(k,j,i+1) + &
150	u(k+1,j,i) + &
151	u(k+1,j,i+1) ) &
152	/ 4.0_wp )**2 + &
153	( ( v(k,j,i) + &
154	v(k,j+1,i) + &
155	v(k+1,j,i) + &
156	v(k+1,j+1,i) ) &
157	/ 4.0_wp )**2 + &
158	w(k,j,i)*2 ) &
159	w(k,j,i)
160	ENDDO
161	ENDDO
162	ENDDO
163
164	!
165	!-- potential temperature
166	CASE ( 4 )
167	DO i = nxl, nxr
168	DO j = nys, nyn
169	DO k = nzb_s_inner(j,i)+1, pch_index
170	tend(k,j,i) = tend(k,j,i) + &
171	( canopy_heat_flux(k,j,i) - &
172	canopy_heat_flux(k-1,j,i) ) / &
173	dzw(k)
174	ENDDO
175	ENDDO
176	ENDDO
177
178	!
179	!-- scalar concentration
180	CASE ( 5 )
181	DO i = nxl, nxr
182	DO j = nys, nyn
183	DO k = nzb_s_inner(j,i)+1, pch_index
184	tend(k,j,i) = tend(k,j,i) - &
185	sec(k,j,i) * lad_s(k,j,i) * &
186	SQRT( ( ( u(k,j,i) + &
187	u(k,j,i+1) ) &
188	/ 2.0_wp )**2 + &
189	( ( v(k,j,i) + &
190	v(k,j+1,i) ) &
191	/ 2.0_wp )**2 + &
192	( ( w(k-1,j,i) + &
193	w(k,j,i) ) &
194	/ 2.0_wp )*2 ) &
195	( q(k,j,i) - sls(k,j,i) )
196	ENDDO
197	ENDDO
198	ENDDO
199
200	!
201	!-- sgs-tke
202	CASE ( 6 )
203	DO i = nxl, nxr
204	DO j = nys, nyn
205	DO k = nzb_s_inner(j,i)+1, pch_index
206	tend(k,j,i) = tend(k,j,i) - &
207	2.0_wp * cdc(k,j,i) * lad_s(k,j,i) * &
208	SQRT( ( ( u(k,j,i) + &
209	u(k,j,i+1) ) &
210	/ 2.0_wp )**2 + &
211	( ( v(k,j,i) + &
212	v(k,j+1,i) ) &
213	/ 2.0_wp )**2 + &
214	( ( w(k,j,i) + &
215	w(k+1,j,i) ) &
216	/ 2.0_wp )*2 ) &
217	e(k,j,i)
218	ENDDO
219	ENDDO
220	ENDDO
221
222	CASE DEFAULT
223
224	WRITE( message_string, * ) 'wrong component: ', component
225	CALL message( 'plant_canopy_model', 'PA0279', 1, 2, 0, 6, 0 )
226
227	END SELECT
228
229	END SUBROUTINE plant_canopy_model
230
231
232	!------------------------------------------------------------------------------!
233	! Call for grid point i,j
234	!------------------------------------------------------------------------------!
235	SUBROUTINE plant_canopy_model_ij( i, j, component )
236
237	USE arrays_3d, &
238	ONLY: canopy_heat_flux, cdc, dzw, e, lad_s, lad_u, lad_v, lad_w, &
239	q, sec, sls, tend, u, v, w
240
241	USE control_parameters, &
242	ONLY: pch_index, message_string
243
244	USE indices, &
245	ONLY: nxl, nxlu, nxr, nys, nysv, nyn, nzb_s_inner, nzb_u_inner, &
246	nzb_v_inner, nzb_w_inner
247
248	USE kinds
249
250	IMPLICIT NONE
251
252	INTEGER(iwp) :: component !:
253	INTEGER(iwp) :: i !:
254	INTEGER(iwp) :: j !:
255	INTEGER(iwp) :: k !:
256
257	!
258	!-- Compute drag for the three velocity components
259	SELECT CASE ( component )
260
261	!
262	!-- u-component
263	CASE ( 1 )
264	DO k = nzb_u_inner(j,i)+1, pch_index
265	tend(k,j,i) = tend(k,j,i) - &
266	cdc(k,j,i) * lad_u(k,j,i) * &
267	SQRT( u(k,j,i)**2 + &
268	( ( v(k,j,i-1) + &
269	v(k,j,i) + &
270	v(k,j+1,i) + &
271	v(k,j+1,i-1) ) &
272	/ 4.0_wp )**2 + &
273	( ( w(k-1,j,i-1) + &
274	w(k-1,j,i) + &
275	w(k,j,i-1) + &
276	w(k,j,i) ) &
277	/ 4.0_wp )*2 ) &
278	u(k,j,i)
279	ENDDO
280
281	!
282	!-- v-component
283	CASE ( 2 )
284	DO k = nzb_v_inner(j,i)+1, pch_index
285	tend(k,j,i) = tend(k,j,i) - &
286	cdc(k,j,i) * lad_v(k,j,i) * &
287	SQRT( ( ( u(k,j-1,i) + &
288	u(k,j-1,i+1) + &
289	u(k,j,i) + &
290	u(k,j,i+1) ) &
291	/ 4.0_wp )**2 + &
292	v(k,j,i)**2 + &
293	( ( w(k-1,j-1,i) + &
294	w(k-1,j,i) + &
295	w(k,j-1,i) + &
296	w(k,j,i) ) &
297	/ 4.0_wp )*2 ) &
298	v(k,j,i)
299	ENDDO
300
301	!
302	!-- w-component
303	CASE ( 3 )
304	DO k = nzb_w_inner(j,i)+1, pch_index
305	tend(k,j,i) = tend(k,j,i) - &
306	cdc(k,j,i) * lad_w(k,j,i) * &
307	SQRT( ( ( u(k,j,i) + &
308	u(k,j,i+1) + &
309	u(k+1,j,i) + &
310	u(k+1,j,i+1) ) &
311	/ 4.0_wp )**2 + &
312	( ( v(k,j,i) + &
313	v(k,j+1,i) + &
314	v(k+1,j,i) + &
315	v(k+1,j+1,i) ) &
316	/ 4.0_wp )**2 + &
317	w(k,j,i)*2 ) &
318	w(k,j,i)
319
320	ENDDO
321
322	!
323	!-- potential temperature
324	CASE ( 4 )
325	DO k = nzb_s_inner(j,i)+1, pch_index
326	tend(k,j,i) = tend(k,j,i) + &
327	( canopy_heat_flux(k,j,i) - &
328	canopy_heat_flux(k-1,j,i) ) / &
329	dzw(k)
330	ENDDO
331
332
333	!
334	!-- scalar concentration
335	CASE ( 5 )
336	DO k = nzb_s_inner(j,i)+1, pch_index
337	tend(k,j,i) = tend(k,j,i) - &
338	sec(k,j,i) * lad_s(k,j,i) * &
339	SQRT( ( ( u(k,j,i) + &
340	u(k,j,i+1) ) &
341	/ 2.0_wp )**2 + &
342	( ( v(k,j,i) + &
343	v(k,j+1,i) ) &
344	/ 2.0_wp )**2 + &
345	( ( w(k-1,j,i) + &
346	w(k,j,i) ) &
347	/ 2.0_wp )*2 ) &
348	( q(k,j,i) - sls(k,j,i) )
349	ENDDO
350
351	!
352	!-- sgs-tke
353	CASE ( 6 )
354	DO k = nzb_s_inner(j,i)+1, pch_index
355	tend(k,j,i) = tend(k,j,i) - &
356	2.0_wp * cdc(k,j,i) * lad_s(k,j,i) * &
357	SQRT( ( ( u(k,j,i) + &
358	u(k,j,i+1) ) &
359	/ 2.0_wp )**2 + &
360	( ( v(k,j,i) + &
361	v(k,j+1,i) ) &
362	/ 2.0_wp )**2 + &
363	( ( w(k,j,i) + &
364	w(k+1,j,i) ) &
365	/ 2.0_wp )*2 ) &
366	e(k,j,i)
367	ENDDO
368
369	CASE DEFAULT
370
371	WRITE( message_string, * ) 'wrong component: ', component
372	CALL message( 'plant_canopy_model', 'PA0279', 1, 2, 0, 6, 0 )
373
374	END SELECT
375
376	END SUBROUTINE plant_canopy_model_ij
377
378	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 |