Home

Context Navigation

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

Last change on this file since 138 was 138, checked in by letzel, 16 years ago
Plant canopy model of Watanabe (2004,BLM 112,307-341) added.
Property svn:keywords set to `Id`
File size: 10.5 KB

Line
1	MODULE plant_canopy_model_mod
2
3	!------------------------------------------------------------------------------!
4	! Actual revisions:
5	! -----------------
6	! Initial revision
7	!
8	! Former revisions:
9	! -----------------
10	! $Id: plant_canopy_model.f90 138 2007-11-28 10:03:58Z letzel $
11	!
12	! Description:
13	! ------------
14	! Evaluation of the drag due to vegetation
15	!------------------------------------------------------------------------------!
16
17	PRIVATE
18	PUBLIC plant_canopy_model
19
20	INTERFACE plant_canopy_model
21	MODULE PROCEDURE plant_canopy_model
22	MODULE PROCEDURE plant_canopy_model_ij
23	END INTERFACE plant_canopy_model
24
25	CONTAINS
26
27
28	!------------------------------------------------------------------------------!
29	! Call for all grid points
30	!------------------------------------------------------------------------------!
31	SUBROUTINE plant_canopy_model( component )
32
33	USE arrays_3d
34	USE control_parameters
35	USE indices
36	USE pegrid
37
38	IMPLICIT NONE
39
40	INTEGER :: component, i, j, k
41
42	!
43	!-- Compute drag for the three velocity components and the SGS-TKE
44	SELECT CASE ( component )
45
46	!
47	!-- u-component
48	CASE ( 1 )
49	DO i = nxlu, nxr
50	DO j = nys, nyn
51	DO k = nzb_u_inner(j,i)+1, pch_index
52	tend(k,j,i) = tend(k,j,i) - &
53	cdc(k,j,i) * lad_u(k,j,i) * &
54	SQRT( u(k,j,i)**2 + &
55	( ( v(k,j,i-1) + &
56	v(k,j,i) + &
57	v(k,j+1,i) + &
58	v(k,j+1,i+1) ) &
59	/ 4.0 )**2 + &
60	( ( w(k-1,j,i-1) + &
61	w(k-1,j,i) + &
62	w(k,j,i-1) + &
63	w(k,j,i) ) &
64	/ 4.0 )*2 ) &
65	u(k,j,i)
66	ENDDO
67	ENDDO
68	ENDDO
69
70	!
71	!-- v-component
72	CASE ( 2 )
73	DO i = nxl, nxr
74	DO j = nysv, nyn
75	DO k = nzb_v_inner(j,i)+1, pch_index
76	tend(k,j,i) = tend(k,j,i) - &
77	cdc(k,j,i) * lad_v(k,j,i) * &
78	SQRT( ( ( u(k,j-1,i) + &
79	u(k,j-1,i+1) + &
80	u(k,j,i) + &
81	u(k,j,i+1) ) &
82	/ 4.0 )**2 + &
83	v(k,j,i)**2 + &
84	( ( w(k-1,j-1,i) + &
85	w(k-1,j,i) + &
86	w(k,j-1,i) + &
87	w(k,j,i) ) &
88	/ 4.0 )*2 ) &
89	v(k,j,i)
90	ENDDO
91	ENDDO
92	ENDDO
93
94	!
95	!-- w-component
96	CASE ( 3 )
97	DO i = nxl, nxr
98	DO j = nys, nyn
99	DO k = nzb_w_inner(j,i)+1, pch_index
100	tend(k,j,i) = tend(k,j,i) - &
101	cdc(k,j,i) * lad_w(k,j,i) * &
102	SQRT( ( ( u(k,j,i) + &
103	u(k,j,i+1) + &
104	u(k+1,j,i) + &
105	u(k+1,j,i+1) ) &
106	/ 4.0 )**2 + &
107	( ( v(k,j,i) + &
108	v(k,j+1,i) + &
109	v(k+1,j,i) + &
110	v(k+1,j+1,i) ) &
111	/ 4.0 )**2 + &
112	w(k,j,i)*2 ) &
113	w(k,j,i)
114	ENDDO
115	ENDDO
116	ENDDO
117
118	!
119	!-- sgs-tke
120	CASE ( 4 )
121	DO i = nxl, nxr
122	DO j = nys, nyn
123	DO k = nzb_s_inner(j,i)+1, pch_index
124	tend(k,j,i) = tend(k,j,i) - &
125	2.0 * cdc(k,j,i) * lad_s(k,j,i) * &
126	SQRT( ( ( u(k,j,i) + &
127	u(k,j,i+1) ) &
128	/ 2.0 )**2 + &
129	( ( v(k,j,i) + &
130	v(k,j+1,i) ) &
131	/ 2.0 )**2 + &
132	( ( w(k,j,i) + &
133	w(k+1,j,i) ) &
134	/ 2.0 )*2 ) &
135	e(k,j,i)
136	ENDDO
137	ENDDO
138	ENDDO
139
140	CASE DEFAULT
141
142	IF ( myid == 0 ) PRINT*,'+++ pcm: wrong component: ', &
143	component
144	CALL local_stop
145
146	END SELECT
147
148	END SUBROUTINE plant_canopy_model
149
150
151	!------------------------------------------------------------------------------!
152	! Call for grid point i,j
153	!------------------------------------------------------------------------------!
154	SUBROUTINE plant_canopy_model_ij( i, j, component )
155
156	USE arrays_3d
157	USE control_parameters
158	USE indices
159	USE pegrid
160
161	IMPLICIT NONE
162
163	INTEGER :: component, i, j, k
164
165	IF ( drag_coefficient /= 0.0 ) THEN
166
167	!
168	!-- Compute drag for the three velocity components
169	SELECT CASE ( component )
170
171	!
172	!-- u-component
173	CASE ( 1 )
174	DO k = nzb_u_inner(j,i)+1, pch_index
175	tend(k,j,i) = tend(k,j,i) - &
176	cdc(k,j,i) * lad_u(k,j,i) * &
177	SQRT( u(k,j,i)**2 + &
178	( ( v(k,j,i-1) + &
179	v(k,j,i) + &
180	v(k,j+1,i) + &
181	v(k,j+1,i+1) ) &
182	/ 4.0 )**2 + &
183	( ( w(k-1,j,i-1) + &
184	w(k-1,j,i) + &
185	w(k,j,i-1) + &
186	w(k,j,i) ) &
187	/ 4.0 )*2 ) &
188	u(k,j,i)
189	ENDDO
190
191	!
192	!-- v-component
193	CASE ( 2 )
194	DO k = nzb_v_inner(j,i)+1, pch_index
195	tend(k,j,i) = tend(k,j,i) - &
196	cdc(k,j,i) * lad_v(k,j,i) * &
197	SQRT( ( ( u(k,j-1,i) + &
198	u(k,j-1,i+1) + &
199	u(k,j,i) + &
200	u(k,j,i+1) ) &
201	/ 4.0 )**2 + &
202	v(k,j,i)**2 + &
203	( ( w(k-1,j-1,i) + &
204	w(k-1,j,i) + &
205	w(k,j-1,i) + &
206	w(k,j,i) ) &
207	/ 4.0 )*2 ) &
208	v(k,j,i)
209	ENDDO
210
211	!
212	!-- w-component
213	CASE ( 3 )
214	DO k = nzb_w_inner(j,i)+1, pch_index
215	tend(k,j,i) = tend(k,j,i) - &
216	cdc(k,j,i) * lad_w(k,j,i) * &
217	SQRT( ( ( u(k,j,i) + &
218	u(k,j,i+1) + &
219	u(k+1,j,i) + &
220	u(k+1,j,i+1) ) &
221	/ 4.0 )**2 + &
222	( ( v(k,j,i) + &
223	v(k,j+1,i) + &
224	v(k+1,j,i) + &
225	v(k+1,j+1,i) ) &
226	/ 4.0 )**2 + &
227	w(k,j,i)*2 ) &
228	w(k,j,i)
229
230	ENDDO
231
232	!
233	!-- sgs-tke
234	CASE ( 4 )
235	DO k = nzb_s_inner(j,i)+1, pch_index
236	tend(k,j,i) = tend(k,j,i) - &
237	2.0 * cdc(k,j,i) * lad_s(k,j,i) * &
238	SQRT( ( ( u(k,j,i) + &
239	u(k,j,i+1) ) &
240	/ 2.0 )**2 + &
241	( ( v(k,j,i) + &
242	v(k,j+1,i) ) &
243	/ 2.0 )**2 + &
244	( ( w(k,j,i) + &
245	w(k+1,j,i) ) &
246	/ 2.0 )*2 ) &
247	e(k,j,i)
248
249	ENDDO
250
251	CASE DEFAULT
252
253	IF ( myid == 0 ) PRINT*,'+++ pcm: wrong component: ', &
254	component
255	CALL local_stop
256
257	END SELECT
258
259	ENDIF
260
261	END SUBROUTINE plant_canopy_model_ij
262
263	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 |