source: palm/tags/release-3.9/SOURCE/advec_w_pw.f90 @ 1320

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

last commit documented

  • Property svn:keywords set to Id
File size: 4.3 KB
Line 
1 MODULE advec_w_pw_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: advec_w_pw.f90 1037 2012-10-22 14:10:22Z raasch $
27!
28! 1036 2012-10-22 13:43:42Z raasch
29! code put under GPL (PALM 3.9)
30!
31! RCS Log replace by Id keyword, revision history cleaned up
32!
33! Revision 1.15  2006/02/23 09:47:01  raasch
34! nzb_2d replaced by nzb_w_inner
35!
36! Revision 1.1  1997/08/11 06:10:29  raasch
37! Initial revision
38!
39!
40! Description:
41! ------------
42! Advection term for w velocity-component using Piacsek and Williams.
43! Vertical advection at the first grid point above the surface is done with
44! normal centred differences, because otherwise no information from the surface
45! would be communicated upwards due to w=0 at k=nzb.
46!------------------------------------------------------------------------------!
47
48    PRIVATE
49    PUBLIC advec_w_pw
50
51    INTERFACE advec_w_pw
52       MODULE PROCEDURE advec_w_pw
53       MODULE PROCEDURE advec_w_pw_ij
54    END INTERFACE advec_w_pw
55 
56 CONTAINS
57
58
59!------------------------------------------------------------------------------!
60! Call for all grid points
61!------------------------------------------------------------------------------!
62    SUBROUTINE advec_w_pw
63
64       USE arrays_3d
65       USE control_parameters
66       USE grid_variables
67       USE indices
68
69       IMPLICIT NONE
70
71       INTEGER ::  i, j, k
72       REAL    ::  gu, gv
73
74 
75       gu = 2.0 * u_gtrans
76       gv = 2.0 * v_gtrans
77       DO  i = nxl, nxr
78          DO  j = nys, nyn
79             DO  k = nzb_w_inner(j,i)+1, nzt
80                tend(k,j,i) = tend(k,j,i) - 0.25 * (                           &
81                         ( w(k,j,i+1) * ( u(k+1,j,i+1) + u(k,j,i+1) - gu )     &
82                         - w(k,j,i-1) * ( u(k+1,j,i) + u(k,j,i) - gu ) ) * ddx &
83                       + ( w(k,j+1,i) * ( v(k+1,j+1,i) + v(k,j+1,i) - gv )     &
84                         - w(k,j-1,i) * ( v(k+1,j,i) + v(k,j,i) - gv ) ) * ddy &
85                       + ( w(k+1,j,i) * ( w(k+1,j,i) + w(k,j,i) )              &
86                         - w(k-1,j,i) * ( w(k,j,i) + w(k-1,j,i) ) )            &
87                                                                  * ddzu(k+1)  &
88                                                   )
89             ENDDO
90          ENDDO
91       ENDDO
92
93    END SUBROUTINE advec_w_pw
94
95
96!------------------------------------------------------------------------------!
97! Call for grid point i,j
98!------------------------------------------------------------------------------!
99    SUBROUTINE advec_w_pw_ij( i, j )
100
101       USE arrays_3d
102       USE control_parameters
103       USE grid_variables
104       USE indices
105
106       IMPLICIT NONE
107
108       INTEGER ::  i, j, k
109       REAL    ::  gu, gv
110
111       gu = 2.0 * u_gtrans
112       gv = 2.0 * v_gtrans
113       DO  k = nzb_w_inner(j,i)+1, nzt
114          tend(k,j,i) = tend(k,j,i) - 0.25 * (                              &
115                         ( w(k,j,i+1) * ( u(k+1,j,i+1) + u(k,j,i+1) - gu )     &
116                         - w(k,j,i-1) * ( u(k+1,j,i) + u(k,j,i) - gu ) ) * ddx &
117                       + ( w(k,j+1,i) * ( v(k+1,j+1,i) + v(k,j+1,i) - gv )     &
118                         - w(k,j-1,i) * ( v(k+1,j,i) + v(k,j,i) - gv ) ) * ddy &
119                       + ( w(k+1,j,i) * ( w(k+1,j,i) + w(k,j,i) )              &
120                         - w(k-1,j,i) * ( w(k,j,i) + w(k-1,j,i) ) )            &
121                                                                  * ddzu(k+1)  &
122                                                )
123       ENDDO
124    END SUBROUTINE advec_w_pw_ij
125
126 END MODULE advec_w_pw_mod
Note: See TracBrowser for help on using the repository browser.