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

Last change on this file since 1036 was 1036, checked in by raasch, 9 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.