Home

Context Navigation

source: palm/trunk/SOURCE/advec_v_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_v_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_v_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:56:05 raasch
60	! Initial revision
61	!
62	!
63	! Description:
64	! ------------
65	!> Advection term for the v 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_v_up_mod
70
71
72	PRIVATE
73	PUBLIC advec_v_up
74
75	INTERFACE advec_v_up
76	MODULE PROCEDURE advec_v_up
77	MODULE PROCEDURE advec_v_up_ij
78	END INTERFACE advec_v_up
79
80	CONTAINS
81
82
83	!------------------------------------------------------------------------------!
84	! Description:
85	! ------------
86	!> Call for all grid points
87	!------------------------------------------------------------------------------!
88	SUBROUTINE advec_v_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: nxl, nxr, nyn, nysv, 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 = nxl, nxr
117	DO j = nysv, nyn
118	DO k = nzb+1, nzt
119	!
120	!-- x-direction
121	ukomp = 0.25_wp * ( u(k,j,i) + u(k,j-1,i) + &
122	u(k,j,i+1) + u(k,j-1,i+1) ) - u_gtrans
123	IF ( ukomp > 0.0_wp ) THEN
124	tend(k,j,i) = tend(k,j,i) - ukomp * &
125	( v(k,j,i) - v(k,j,i-1) ) * ddx &
126	* MERGE( 1.0_wp, 0.0_wp, &
127	BTEST( wall_flags_0(k,j,i), 2 ) )
128	ELSE
129	tend(k,j,i) = tend(k,j,i) - ukomp * &
130	( v(k,j,i+1) - v(k,j,i) ) * ddx &
131	* MERGE( 1.0_wp, 0.0_wp, &
132	BTEST( wall_flags_0(k,j,i), 2 ) )
133	ENDIF
134	!
135	!-- y-direction
136	vkomp = v(k,j,i) - v_gtrans
137	IF ( vkomp > 0.0_wp ) THEN
138	tend(k,j,i) = tend(k,j,i) - vkomp * &
139	( v(k,j,i) - v(k,j-1,i) ) * ddy &
140	* MERGE( 1.0_wp, 0.0_wp, &
141	BTEST( wall_flags_0(k,j,i), 2 ) )
142	ELSE
143	tend(k,j,i) = tend(k,j,i) - vkomp * &
144	( v(k,j+1,i) - v(k,j,i) ) * ddy &
145	* MERGE( 1.0_wp, 0.0_wp, &
146	BTEST( wall_flags_0(k,j,i), 2 ) )
147	ENDIF
148	!
149	!-- z-direction
150	wkomp = 0.25_wp * ( w(k,j,i) + w(k-1,j,i) + &
151	w(k,j-1,i) + w(k-1,j-1,i) )
152	IF ( wkomp > 0.0_wp ) THEN
153	tend(k,j,i) = tend(k,j,i) - wkomp * &
154	( v(k,j,i) - v(k-1,j,i) ) * ddzu(k) &
155	* MERGE( 1.0_wp, 0.0_wp, &
156	BTEST( wall_flags_0(k,j,i), 2 ) )
157	ELSE
158	tend(k,j,i) = tend(k,j,i) - wkomp * &
159	( v(k+1,j,i) - v(k,j,i) ) * ddzu(k+1) &
160	* MERGE( 1.0_wp, 0.0_wp, &
161	BTEST( wall_flags_0(k,j,i), 2 ) )
162	ENDIF
163
164	ENDDO
165	ENDDO
166	ENDDO
167
168	END SUBROUTINE advec_v_up
169
170
171	!------------------------------------------------------------------------------!
172	! Description:
173	! ------------
174	!> Call for grid point i,j
175	!------------------------------------------------------------------------------!
176	SUBROUTINE advec_v_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 = 0.25_wp * ( u(k,j,i) + u(k,j-1,i) + u(k,j,i+1) + u(k,j-1,i+1) &
208	) - u_gtrans
209	IF ( ukomp > 0.0_wp ) THEN
210	tend(k,j,i) = tend(k,j,i) - ukomp * &
211	( v(k,j,i) - v(k,j,i-1) ) * ddx &
212	* MERGE( 1.0_wp, 0.0_wp, &
213	BTEST( wall_flags_0(k,j,i), 2 ) )
214	ELSE
215	tend(k,j,i) = tend(k,j,i) - ukomp * &
216	( v(k,j,i+1) - v(k,j,i) ) * ddx &
217	* MERGE( 1.0_wp, 0.0_wp, &
218	BTEST( wall_flags_0(k,j,i), 2 ) )
219	ENDIF
220	!
221	!-- y-direction
222	vkomp = v(k,j,i) - v_gtrans
223	IF ( vkomp > 0.0_wp ) THEN
224	tend(k,j,i) = tend(k,j,i) - vkomp * &
225	( v(k,j,i) - v(k,j-1,i) ) * ddy &
226	* MERGE( 1.0_wp, 0.0_wp, &
227	BTEST( wall_flags_0(k,j,i), 2 ) )
228	ELSE
229	tend(k,j,i) = tend(k,j,i) - vkomp * &
230	( v(k,j+1,i) - v(k,j,i) ) * ddy &
231	* MERGE( 1.0_wp, 0.0_wp, &
232	BTEST( wall_flags_0(k,j,i), 2 ) )
233	ENDIF
234	!
235	!-- z-direction
236	wkomp = 0.25_wp * ( w(k,j,i) + w(k-1,j,i) + w(k,j-1,i) + w(k-1,j-1,i) )
237	IF ( wkomp > 0.0_wp ) THEN
238	tend(k,j,i) = tend(k,j,i) - wkomp * &
239	( v(k,j,i) - v(k-1,j,i) ) * ddzu(k) &
240	* MERGE( 1.0_wp, 0.0_wp, &
241	BTEST( wall_flags_0(k,j,i), 2 ) )
242	ELSE
243	tend(k,j,i) = tend(k,j,i) - wkomp * &
244	( v(k+1,j,i) - v(k,j,i) ) * ddzu(k+1) &
245	* MERGE( 1.0_wp, 0.0_wp, &
246	BTEST( wall_flags_0(k,j,i), 2 ) )
247	ENDIF
248
249	ENDDO
250
251	END SUBROUTINE advec_v_up_ij
252
253	END MODULE advec_v_up_mod

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |