source: palm/trunk/SOURCE/advec_v_pw.f90 @ 4180

Last change on this file since 4180 was 4180, checked in by scharf, 5 years ago

removed comments in 'Former revisions' section that are older than 01.01.2019

  • Property svn:keywords set to Id
File size: 5.5 KB
Line 
1!> @file advec_v_pw.f90
2!------------------------------------------------------------------------------!
3!------------------------------------------------------------------------------!
4! This file is part of the PALM model system.
5!
6! PALM is free software: you can redistribute it and/or modify it under the
7! terms of the GNU General Public License as published by the Free Software
8! Foundation, either version 3 of the License, or (at your option) any later
9! version.
10!
11! PALM is distributed in the hope that it will be useful, but WITHOUT ANY
12! WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
13! A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
14!
15! You should have received a copy of the GNU General Public License along with
16! PALM. If not, see <http://www.gnu.org/licenses/>.
17!
18! Copyright 1997-2019 Leibniz Universitaet Hannover
19!------------------------------------------------------------------------------!
20!
21! Current revisions:
22! -----------------
23!
24!
25! Former revisions:
26! -----------------
27! $Id: advec_v_pw.f90 4180 2019-08-21 14:37:54Z scharf $
28! variables documented
29!
30!
31! Description:
32! ------------
33!> Advection term for v velocity-component using Piacsek and Williams.
34!> Vertical advection at the first grid point above the surface is done with
35!> normal centred differences, because otherwise no information from the surface
36!> would be communicated upwards due to w=0 at K=nzb.
37!------------------------------------------------------------------------------!
38 MODULE advec_v_pw_mod
39 
40
41    PRIVATE
42    PUBLIC advec_v_pw
43
44    INTERFACE advec_v_pw
45       MODULE PROCEDURE advec_v_pw
46       MODULE PROCEDURE advec_v_pw_ij
47    END INTERFACE advec_v_pw
48 
49 CONTAINS
50
51
52!------------------------------------------------------------------------------!
53! Description:
54! ------------
55!> Call for all grid points
56!------------------------------------------------------------------------------!
57    SUBROUTINE advec_v_pw
58
59       USE arrays_3d,                                                          &
60           ONLY:  ddzw, tend, u, v, w
61
62       USE control_parameters,                                                 &
63           ONLY:  u_gtrans, v_gtrans
64
65       USE grid_variables,                                                     &
66           ONLY:  ddx, ddy
67
68       USE indices,                                                            &
69           ONLY:  nxl, nxr, nyn, nysv, nzb, nzt
70
71       USE kinds
72
73
74       IMPLICIT NONE
75
76       INTEGER(iwp) ::  i !< grid index along x-direction
77       INTEGER(iwp) ::  j !< grid index along y-direction
78       INTEGER(iwp) ::  k !< grid index along z-direction
79       
80       REAL(wp)    ::  gu !< Galilei-transformation velocity along x
81       REAL(wp)    ::  gv !< Galilei-transformation velocity along y
82 
83
84       gu = 2.0_wp * u_gtrans
85       gv = 2.0_wp * v_gtrans
86       DO  i = nxl, nxr
87          DO  j = nysv, nyn
88             DO  k = nzb+1, nzt
89                tend(k,j,i) = tend(k,j,i) - 0.25_wp * (                        &
90                         ( v(k,j,i+1) * ( u(k,j-1,i+1) + u(k,j,i+1) - gu )     &
91                         - v(k,j,i-1) * ( u(k,j-1,i) + u(k,j,i) - gu ) ) * ddx &
92                       + ( v(k,j+1,i) * ( v(k,j+1,i) + v(k,j,i) - gv )         &
93                         - v(k,j-1,i) * ( v(k,j,i) + v(k,j-1,i) - gv ) ) * ddy &
94                       + ( v(k+1,j,i) * ( w(k,j-1,i) + w(k,j,i) )              &
95                         - v(k-1,j,i) * ( w(k-1,j-1,i) + w(k-1,j,i) ) )        &
96                                                                  * ddzw(k)    &
97                                                      )
98             ENDDO
99          ENDDO
100       ENDDO
101
102    END SUBROUTINE advec_v_pw
103
104
105!------------------------------------------------------------------------------!
106! Description:
107! ------------
108!> Call for grid point i,j
109!------------------------------------------------------------------------------!
110    SUBROUTINE advec_v_pw_ij( i, j )
111
112       USE arrays_3d,                                                          &
113           ONLY:  ddzw, tend, u, v, w
114
115       USE control_parameters,                                                 &
116           ONLY:  u_gtrans, v_gtrans
117
118       USE grid_variables,                                                     &
119           ONLY:  ddx, ddy
120
121       USE indices,                                                            &
122           ONLY:  nzb, nzt
123
124       USE kinds
125
126
127       IMPLICIT NONE
128
129       INTEGER(iwp) ::  i !< grid index along x-direction
130       INTEGER(iwp) ::  j !< grid index along y-direction
131       INTEGER(iwp) ::  k !< grid index along z-direction
132       
133       REAL(wp)    ::  gu !< Galilei-transformation velocity along x
134       REAL(wp)    ::  gv !< Galilei-transformation velocity along y
135
136
137       gu = 2.0_wp * u_gtrans
138       gv = 2.0_wp * v_gtrans
139       DO  k = nzb+1, nzt
140          tend(k,j,i) = tend(k,j,i) - 0.25_wp * (                              &
141                         ( v(k,j,i+1) * ( u(k,j-1,i+1) + u(k,j,i+1) - gu )     &
142                         - v(k,j,i-1) * ( u(k,j-1,i) + u(k,j,i) - gu ) ) * ddx &
143                       + ( v(k,j+1,i) * ( v(k,j+1,i) + v(k,j,i) - gv )         &
144                         - v(k,j-1,i) * ( v(k,j,i) + v(k,j-1,i) - gv ) ) * ddy &
145                       + ( v(k+1,j,i) * ( w(k,j-1,i) + w(k,j,i) )              &
146                         - v(k-1,j,i) * ( w(k-1,j-1,i) + w(k-1,j,i) ) )        &
147                                                                  * ddzw(k)    &
148                                                )
149       ENDDO
150 
151    END SUBROUTINE advec_v_pw_ij
152
153 END MODULE advec_v_pw_mod
154 
Note: See TracBrowser for help on using the repository browser.