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

Last change on this file since 1320 was 1320, checked in by raasch, 7 years ago

ONLY-attribute added to USE-statements,
kind-parameters added to all INTEGER and REAL declaration statements,
kinds are defined in new module kinds,
old module precision_kind is removed,
revision history before 2012 removed,
comment fields (!:) to be used for variable explanations added to all variable declaration statements

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