Home

Context Navigation

source: palm/trunk/SOURCE/advec_u_up.f90 @ 2699

Last change on this file since 2699 was 2696, checked in by kanani, 7 years ago
Merge of branch palm4u into trunk
Property svn:keywords set to `Id`
File size: 9.5 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
6	! terms of the GNU General Public License as published by the Free Software
7	! Foundation, either version 3 of the License, or (at your option) any later
8	! 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-2017 Leibniz Universitaet Hannover
18	!------------------------------------------------------------------------------!
19	!
20	! Current revisions:
21	! -----------------
22	!
23	!
24	! Former revisions:
25	! -----------------
26	! $Id: advec_u_up.f90 2696 2017-12-14 17:12:51Z kanani $
27	!
28	! 2232 2017-05-30 17:47:52Z suehring
29	! topography representation via flags
30	!
31	! 2000 2016-08-20 18:09:15Z knoop
32	! Forced header and separation lines into 80 columns
33	!
34	! 1873 2016-04-18 14:50:06Z maronga
35	! Module renamed (removed _mod)
36	!
37	!
38	! 1850 2016-04-08 13:29:27Z maronga
39	! Module renamed
40	!
41	!
42	! 1682 2015-10-07 23:56:08Z knoop
43	! Code annotations made doxygen readable
44	!
45	! 1353 2014-04-08 15:21:23Z heinze
46	! REAL constants provided with KIND-attribute
47	!
48	! 1320 2014-03-20 08:40:49Z raasch
49	! ONLY-attribute added to USE-statements,
50	! kind-parameters added to all INTEGER and REAL declaration statements,
51	! kinds are defined in new module kinds,
52	! revision history before 2012 removed,
53	! comment fields (!:) to be used for variable explanations added to
54	! all variable declaration statements
55	!
56	! 1036 2012-10-22 13:43:42Z raasch
57	! code put under GPL (PALM 3.9)
58	!
59	! Revision 1.1 1997/08/29 08:55:25 raasch
60	! Initial revision
61	!
62	!
63	! Description:
64	! ------------
65	!> Advection term for the u velocity-component using upstream scheme.
66	!> NOTE: vertical advection at k=1 still has wrong grid spacing for w>0!
67	!> The same problem occurs for all topography boundaries!
68	!------------------------------------------------------------------------------!
69	MODULE advec_u_up_mod
70
71
72	PRIVATE
73	PUBLIC advec_u_up
74
75	INTERFACE advec_u_up
76	MODULE PROCEDURE advec_u_up
77	MODULE PROCEDURE advec_u_up_ij
78	END INTERFACE advec_u_up
79
80	CONTAINS
81
82
83	!------------------------------------------------------------------------------!
84	! Description:
85	! ------------
86	!> Call for all grid points
87	!------------------------------------------------------------------------------!
88	SUBROUTINE advec_u_up
89
90	USE arrays_3d, &
91	ONLY: ddzu, tend, u, v, w
92
93	USE control_parameters, &
94	ONLY: u_gtrans, v_gtrans
95
96	USE grid_variables, &
97	ONLY: ddx, ddy
98
99	USE indices, &
100	ONLY: nxlu, nxr, nyn, nys, nzb, nzt, wall_flags_0
101
102	USE kinds
103
104
105	IMPLICIT NONE
106
107	INTEGER(iwp) :: i !<
108	INTEGER(iwp) :: j !<
109	INTEGER(iwp) :: k !<
110
111	REAL(wp) :: ukomp !<
112	REAL(wp) :: vkomp !<
113	REAL(wp) :: wkomp !<
114
115
116	DO i = nxlu, nxr
117	DO j = nys, nyn
118	DO k = nzb+1, nzt
119	!
120	!-- x-direction
121	ukomp = u(k,j,i) - u_gtrans
122	IF ( ukomp > 0.0_wp ) THEN
123	tend(k,j,i) = tend(k,j,i) - ukomp * &
124	( u(k,j,i) - u(k,j,i-1) ) * ddx &
125	* MERGE( 1.0_wp, 0.0_wp, &
126	BTEST( wall_flags_0(k,j,i), 1 ) )
127	ELSE
128	tend(k,j,i) = tend(k,j,i) - ukomp * &
129	( u(k,j,i+1) - u(k,j,i) ) * ddx &
130	* MERGE( 1.0_wp, 0.0_wp, &
131	BTEST( wall_flags_0(k,j,i), 1 ) )
132	ENDIF
133	!
134	!-- y-direction
135	vkomp = 0.25_wp * ( v(k,j,i) + v(k,j+1,i) + &
136	v(k,j,i-1) + v(k,j+1,i-1) ) - v_gtrans
137	IF ( vkomp > 0.0_wp ) THEN
138	tend(k,j,i) = tend(k,j,i) - vkomp * &
139	( u(k,j,i) - u(k,j-1,i) ) * ddy &
140	* MERGE( 1.0_wp, 0.0_wp, &
141	BTEST( wall_flags_0(k,j,i), 1 ) )
142	ELSE
143	tend(k,j,i) = tend(k,j,i) - vkomp * &
144	( u(k,j+1,i) - u(k,j,i) ) * ddy &
145	* MERGE( 1.0_wp, 0.0_wp, &
146	BTEST( wall_flags_0(k,j,i), 1 ) )
147	ENDIF
148	!
149	!-- z-direction
150	wkomp = 0.25_wp * ( w(k,j,i) + w(k-1,j,i) + &
151	w(k,j,i-1) + w(k-1,j,i-1) )
152	IF ( wkomp > 0.0_wp ) THEN
153	tend(k,j,i) = tend(k,j,i) - wkomp * &
154	( u(k,j,i) - u(k-1,j,i) ) * ddzu(k) &
155	* MERGE( 1.0_wp, 0.0_wp, &
156	BTEST( wall_flags_0(k,j,i), 1 ) )
157	ELSE
158	tend(k,j,i) = tend(k,j,i) - wkomp * &
159	( u(k+1,j,i) - u(k,j,i) ) * ddzu(k+1) &
160	* MERGE( 1.0_wp, 0.0_wp, &
161	BTEST( wall_flags_0(k,j,i), 1 ) )
162	ENDIF
163
164	ENDDO
165	ENDDO
166	ENDDO
167
168	END SUBROUTINE advec_u_up
169
170
171	!------------------------------------------------------------------------------!
172	! Description:
173	! ------------
174	!> Call for grid point i,j
175	!------------------------------------------------------------------------------!
176	SUBROUTINE advec_u_up_ij( i, j )
177
178	USE arrays_3d, &
179	ONLY: ddzu, tend, u, v, w
180
181	USE control_parameters, &
182	ONLY: u_gtrans, v_gtrans
183
184	USE grid_variables, &
185	ONLY: ddx, ddy
186
187	USE indices, &
188	ONLY: nzb, nzt, wall_flags_0
189
190	USE kinds
191
192
193	IMPLICIT NONE
194
195	INTEGER(iwp) :: i !<
196	INTEGER(iwp) :: j !<
197	INTEGER(iwp) :: k !<
198
199	REAL(wp) :: ukomp !<
200	REAL(wp) :: vkomp !<
201	REAL(wp) :: wkomp !<
202
203
204	DO k = nzb+1, nzt
205	!
206	!-- x-direction
207	ukomp = u(k,j,i) - u_gtrans
208	IF ( ukomp > 0.0_wp ) THEN
209	tend(k,j,i) = tend(k,j,i) - ukomp * &
210	( u(k,j,i) - u(k,j,i-1) ) * ddx &
211	* MERGE( 1.0_wp, 0.0_wp, &
212	BTEST( wall_flags_0(k,j,i), 1 ) )
213	ELSE
214	tend(k,j,i) = tend(k,j,i) - ukomp * &
215	( u(k,j,i+1) - u(k,j,i) ) * ddx &
216	* MERGE( 1.0_wp, 0.0_wp, &
217	BTEST( wall_flags_0(k,j,i), 1 ) )
218	ENDIF
219	!
220	!-- y-direction
221	vkomp = 0.25_wp * ( v(k,j,i) + v(k,j+1,i) + v(k,j,i-1) + v(k,j+1,i-1) &
222	) - v_gtrans
223	IF ( vkomp > 0.0_wp ) THEN
224	tend(k,j,i) = tend(k,j,i) - vkomp * &
225	( u(k,j,i) - u(k,j-1,i) ) * ddy &
226	* MERGE( 1.0_wp, 0.0_wp, &
227	BTEST( wall_flags_0(k,j,i), 1 ) )
228	ELSE
229	tend(k,j,i) = tend(k,j,i) - vkomp * &
230	( u(k,j+1,i) - u(k,j,i) ) * ddy &
231	* MERGE( 1.0_wp, 0.0_wp, &
232	BTEST( wall_flags_0(k,j,i), 1 ) )
233	ENDIF
234	!
235	!-- z-direction
236	wkomp = 0.25_wp * ( w(k,j,i) + w(k-1,j,i) + w(k,j,i-1) + w(k-1,j,i-1) )
237	IF ( wkomp > 0.0_wp ) THEN
238	tend(k,j,i) = tend(k,j,i) - wkomp * &
239	( u(k,j,i) - u(k-1,j,i) ) * ddzu(k) &
240	* MERGE( 1.0_wp, 0.0_wp, &
241	BTEST( wall_flags_0(k,j,i), 1 ) )
242	ELSE
243	tend(k,j,i) = tend(k,j,i) - wkomp * &
244	( u(k+1,j,i) - u(k,j,i) ) * ddzu(k+1) &
245	* MERGE( 1.0_wp, 0.0_wp, &
246	BTEST( wall_flags_0(k,j,i), 1 ) )
247	ENDIF
248
249	ENDDO
250
251	END SUBROUTINE advec_u_up_ij
252
253	END MODULE advec_u_up_mod

Note: See TracBrowser for help on using the repository browser.

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |