source: palm/trunk/SOURCE/advec_u_up.f90

Last change on this file was 4828, checked in by Giersch, 3 years ago

Copyright updated to year 2021, interface pmc_sort removed to accelarate the nesting code

  • Property svn:keywords set to Id
File size: 6.3 KB
Line 
1!> @file advec_u_up.f90
2!--------------------------------------------------------------------------------------------------!
3! This file is part of the PALM model system.
4!
5! PALM is free software: you can redistribute it and/or modify it under the terms of the GNU General
6! Public License as published by the Free Software Foundation, either version 3 of the License, or
7! (at your option) any later version.
8!
9! PALM is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the
10! implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General
11! Public License for more details.
12!
13! You should have received a copy of the GNU General Public License along with PALM. If not, see
14! <http://www.gnu.org/licenses/>.
15!
16! Copyright 1997-2021 Leibniz Universitaet Hannover
17!--------------------------------------------------------------------------------------------------!
18!
19! Current revisions:
20! -----------------
21!
22!
23! Former revisions:
24! -----------------
25! $Id: advec_u_up.f90 4828 2021-01-05 11:21:41Z banzhafs $
26! file re-formatted to follow the PALM coding standard
27!
28! 4360 2020-01-07 11:25:50Z suehring
29! Corrected "Former revisions" section
30!
31! 3655 2019-01-07 16:51:22Z knoop
32! variables documented
33!
34! Revision 1.1  1997/08/29 08:55:25  raasch
35! Initial revision
36!
37!
38! Description:
39! ------------
40!> Advection term for the u velocity-component using upstream scheme.
41!> NOTE: vertical advection at k=1 still has wrong grid spacing for w>0!
42!>       The same problem occurs for all topography boundaries!
43!--------------------------------------------------------------------------------------------------!
44 MODULE advec_u_up_mod
45
46
47    PRIVATE
48    PUBLIC advec_u_up
49
50    INTERFACE advec_u_up
51       MODULE PROCEDURE advec_u_up
52       MODULE PROCEDURE advec_u_up_ij
53    END INTERFACE advec_u_up
54
55 CONTAINS
56
57
58!--------------------------------------------------------------------------------------------------!
59! Description:
60! ------------
61!> Call for all grid points
62!--------------------------------------------------------------------------------------------------!
63 SUBROUTINE advec_u_up
64
65    USE arrays_3d,                                                                                 &
66        ONLY:  ddzu, tend, u, v, w
67
68    USE control_parameters,                                                                        &
69        ONLY:  u_gtrans, v_gtrans
70
71    USE grid_variables,                                                                            &
72        ONLY:  ddx, ddy
73
74    USE indices,                                                                                   &
75        ONLY:  nxlu, nxr, nyn, nys, nzb, nzt
76
77    USE kinds
78
79
80    IMPLICIT NONE
81
82    INTEGER(iwp) ::  i !< grid index along x-direction
83    INTEGER(iwp) ::  j !< grid index along y-direction
84    INTEGER(iwp) ::  k !< grid index along z-direction
85
86    REAL(wp) ::  ukomp !< advection velocity along x-direction
87    REAL(wp) ::  vkomp !< advection velocity along y-direction
88    REAL(wp) ::  wkomp !< advection velocity along z-direction
89
90
91    DO  i = nxlu, nxr
92       DO  j = nys, nyn
93          DO  k = nzb+1, nzt
94!
95!--          x-direction
96             ukomp = u(k,j,i) - u_gtrans
97             IF ( ukomp > 0.0_wp )  THEN
98                tend(k,j,i) = tend(k,j,i) - ukomp * ( u(k,j,i) - u(k,j,i-1) ) * ddx
99             ELSE
100                tend(k,j,i) = tend(k,j,i) - ukomp * ( u(k,j,i+1) - u(k,j,i) ) * ddx
101             ENDIF
102!
103!--          y-direction
104             vkomp = 0.25_wp * ( v(k,j,i) + v(k,j+1,i) + v(k,j,i-1) + v(k,j+1,i-1) ) - v_gtrans
105             IF ( vkomp > 0.0_wp )  THEN
106                tend(k,j,i) = tend(k,j,i) - vkomp * ( u(k,j,i) - u(k,j-1,i) ) * ddy
107             ELSE
108                tend(k,j,i) = tend(k,j,i) - vkomp * ( u(k,j+1,i) - u(k,j,i) ) * ddy
109             ENDIF
110!
111!--          z-direction
112             wkomp = 0.25_wp * ( w(k,j,i) + w(k-1,j,i) + w(k,j,i-1) + w(k-1,j,i-1) )
113             IF ( wkomp > 0.0_wp )  THEN
114                tend(k,j,i) = tend(k,j,i) - wkomp * ( u(k,j,i) - u(k-1,j,i) ) * ddzu(k)
115             ELSE
116                tend(k,j,i) = tend(k,j,i) - wkomp * ( u(k+1,j,i) - u(k,j,i) ) * ddzu(k+1)
117             ENDIF
118
119          ENDDO
120       ENDDO
121    ENDDO
122
123 END SUBROUTINE advec_u_up
124
125
126!--------------------------------------------------------------------------------------------------!
127! Description:
128! ------------
129!> Call for grid point i,j
130!--------------------------------------------------------------------------------------------------!
131 SUBROUTINE advec_u_up_ij( i, j )
132
133    USE arrays_3d,                                                                                 &
134        ONLY:  ddzu, tend, u, v, w
135
136    USE control_parameters,                                                                        &
137        ONLY:  u_gtrans, v_gtrans
138
139    USE grid_variables,                                                                            &
140        ONLY:  ddx, ddy
141
142    USE indices,                                                                                   &
143        ONLY:  nzb, nzt
144
145    USE kinds
146
147
148    IMPLICIT NONE
149
150    INTEGER(iwp) ::  i !< grid index along x-direction
151    INTEGER(iwp) ::  j !< grid index along y-direction
152    INTEGER(iwp) ::  k !< grid index along z-direction
153
154    REAL(wp) ::  ukomp !< advection velocity along x-direction
155    REAL(wp) ::  vkomp !< advection velocity along y-direction
156    REAL(wp) ::  wkomp !< advection velocity along z-direction
157
158
159    DO  k = nzb+1, nzt
160!
161!--    x-direction
162       ukomp = u(k,j,i) - u_gtrans
163       IF ( ukomp > 0.0_wp )  THEN
164          tend(k,j,i) = tend(k,j,i) - ukomp * ( u(k,j,i) - u(k,j,i-1) ) * ddx
165       ELSE
166          tend(k,j,i) = tend(k,j,i) - ukomp * ( u(k,j,i+1) - u(k,j,i) ) * ddx
167       ENDIF
168!
169!--    y-direction
170       vkomp = 0.25_wp * ( v(k,j,i) + v(k,j+1,i) + v(k,j,i-1) + v(k,j+1,i-1) ) - v_gtrans
171       IF ( vkomp > 0.0_wp )  THEN
172          tend(k,j,i) = tend(k,j,i) - vkomp * ( u(k,j,i) - u(k,j-1,i) ) * ddy
173       ELSE
174          tend(k,j,i) = tend(k,j,i) - vkomp * ( u(k,j+1,i) - u(k,j,i) ) * ddy
175       ENDIF
176!
177!--    z-direction
178       wkomp = 0.25_wp * ( w(k,j,i) + w(k-1,j,i) + w(k,j,i-1) + w(k-1,j,i-1) )
179       IF ( wkomp > 0.0_wp )  THEN
180          tend(k,j,i) = tend(k,j,i) - wkomp * ( u(k,j,i) - u(k-1,j,i) ) * ddzu(k)
181       ELSE
182          tend(k,j,i) = tend(k,j,i) - wkomp * ( u(k+1,j,i) - u(k,j,i) ) * ddzu(k+1)
183       ENDIF
184
185    ENDDO
186
187 END SUBROUTINE advec_u_up_ij
188
189 END MODULE advec_u_up_mod
Note: See TracBrowser for help on using the repository browser.