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

Last change on this file since 138 was 138, checked in by letzel, 14 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.