Home

Context Navigation

source: palm/trunk/SOURCE/advec_s_up.f90 @ 2550

Last change on this file since 2550 was 2233, checked in by suehring, 7 years ago
last commit documented
Property svn:keywords set to `Id`
File size: 9.9 KB

Line
1	!> @file advec_s_up.f90
2	!------------------------------------------------------------------------------!
3	! This file is part of PALM.
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_s_up.f90 2233 2017-05-30 18:08:54Z boeske $
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	! 1374 2014-04-25 12:55:07Z raasch
46	! missing variables added to ONLY list
47	!
48	! 1353 2014-04-08 15:21:23Z heinze
49	! REAL constants provided with KIND-attribute
50	!
51	! 1320 2014-03-20 08:40:49Z raasch
52	! ONLY-attribute added to USE-statements,
53	! kind-parameters added to all INTEGER and REAL declaration statements,
54	! kinds are defined in new module kinds,
55	! revision history before 2012 removed,
56	! comment fields (!:) to be used for variable explanations added to
57	! all variable declaration statements
58	!
59	! 1036 2012-10-22 13:43:42Z raasch
60	! code put under GPL (PALM 3.9)
61	!
62	! 1010 2012-09-20 07:59:54Z raasch
63	! cpp switch __nopointer added for pointer free version
64	!
65	! 981 2012-08-09 14:57:44Z maronga
66	! Typo removed
67	!
68	! Revision 1.1 1997/08/29 08:54:33 raasch
69	! Initial revision
70	!
71	!
72	! Description:
73	! ------------
74	!> Advection term for scalar quantities using the Upstream scheme.
75	!> NOTE: vertical advection at k=1 still has wrong grid spacing for w>0!
76	!> The same problem occurs for all topography boundaries!
77	!------------------------------------------------------------------------------!
78	MODULE advec_s_up_mod
79
80
81	PRIVATE
82	PUBLIC advec_s_up
83
84	INTERFACE advec_s_up
85	MODULE PROCEDURE advec_s_up
86	MODULE PROCEDURE advec_s_up_ij
87	END INTERFACE advec_s_up
88
89	CONTAINS
90
91
92	!------------------------------------------------------------------------------!
93	! Description:
94	! ------------
95	!> Call for all grid points
96	!------------------------------------------------------------------------------!
97	SUBROUTINE advec_s_up( sk )
98
99	USE arrays_3d, &
100	ONLY: ddzu, tend, u, v, w
101
102	USE control_parameters, &
103	ONLY: u_gtrans, v_gtrans
104
105	USE grid_variables, &
106	ONLY: ddx, ddy
107
108	USE indices, &
109	ONLY: nxl, nxlg, nxr, nxrg, nyn, nyng, nys, nysg, nzb, nzt, &
110	wall_flags_0
111
112	USE kinds
113
114
115	IMPLICIT NONE
116
117	INTEGER(iwp) :: i !<
118	INTEGER(iwp) :: j !<
119	INTEGER(iwp) :: k !<
120
121	REAL(wp) :: ukomp !<
122	REAL(wp) :: vkomp !<
123	REAL(wp) :: wkomp !<
124	#if defined( __nopointer )
125	REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) :: sk !<
126	#else
127	REAL(wp), DIMENSION(:,:,:), POINTER :: sk
128	#endif
129
130
131	DO i = nxl, nxr
132	DO j = nys, nyn
133	DO k = nzb+1, nzt
134	!
135	!-- x-direction
136	ukomp = 0.5_wp * ( u(k,j,i) + u(k,j,i+1) ) - u_gtrans
137	IF ( ukomp > 0.0_wp ) THEN
138	tend(k,j,i) = tend(k,j,i) - ukomp * &
139	( sk(k,j,i) - sk(k,j,i-1) ) * ddx &
140	* MERGE( 1.0_wp, 0.0_wp, &
141	BTEST( wall_flags_0(k,j,i), 0 ) )
142	ELSE
143	tend(k,j,i) = tend(k,j,i) - ukomp * &
144	( sk(k,j,i+1) - sk(k,j,i) ) * ddx &
145	* MERGE( 1.0_wp, 0.0_wp, &
146	BTEST( wall_flags_0(k,j,i), 0 ) )
147	ENDIF
148	!
149	!-- y-direction
150	vkomp = 0.5_wp * ( v(k,j,i) + v(k,j+1,i) ) - v_gtrans
151	IF ( vkomp > 0.0_wp ) THEN
152	tend(k,j,i) = tend(k,j,i) - vkomp * &
153	( sk(k,j,i) - sk(k,j-1,i) ) * ddy &
154	* MERGE( 1.0_wp, 0.0_wp, &
155	BTEST( wall_flags_0(k,j,i), 0 ) )
156	ELSE
157	tend(k,j,i) = tend(k,j,i) - vkomp * &
158	( sk(k,j+1,i) - sk(k,j,i) ) * ddy &
159	* MERGE( 1.0_wp, 0.0_wp, &
160	BTEST( wall_flags_0(k,j,i), 0 ) )
161	ENDIF
162	!
163	!-- z-direction
164	wkomp = 0.5_wp * ( w(k,j,i) + w(k-1,j,i) )
165	IF ( wkomp > 0.0_wp ) THEN
166	tend(k,j,i) = tend(k,j,i) - wkomp * &
167	( sk(k,j,i) - sk(k-1,j,i) ) * ddzu(k) &
168	* MERGE( 1.0_wp, 0.0_wp, &
169	BTEST( wall_flags_0(k,j,i), 0 ) )
170	ELSE
171	tend(k,j,i) = tend(k,j,i) - wkomp * &
172	( sk(k+1,j,i)-sk(k,j,i) ) * ddzu(k+1) &
173	* MERGE( 1.0_wp, 0.0_wp, &
174	BTEST( wall_flags_0(k,j,i), 0 ) )
175	ENDIF
176
177	ENDDO
178	ENDDO
179	ENDDO
180
181	END SUBROUTINE advec_s_up
182
183
184	!------------------------------------------------------------------------------!
185	! Description:
186	! ------------
187	!> Call for grid point i,j
188	!------------------------------------------------------------------------------!
189	SUBROUTINE advec_s_up_ij( i, j, sk )
190
191	USE arrays_3d, &
192	ONLY: ddzu, tend, u, v, w
193
194	USE control_parameters, &
195	ONLY: u_gtrans, v_gtrans
196
197	USE grid_variables, &
198	ONLY: ddx, ddy
199
200	USE indices, &
201	ONLY: nxlg, nxrg, nyng, nysg, nzb, nzt, wall_flags_0
202
203	USE kinds
204
205
206	IMPLICIT NONE
207
208	INTEGER(iwp) :: i !<
209	INTEGER(iwp) :: j !<
210	INTEGER(iwp) :: k !<
211
212	REAL(wp) :: ukomp !<
213	REAL(wp) :: vkomp !<
214	REAL(wp) :: wkomp !<
215
216	#if defined( __nopointer )
217	REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) :: sk !<
218	#else
219	REAL(wp), DIMENSION(:,:,:), POINTER :: sk
220	#endif
221
222
223	DO k = nzb+1, nzt
224	!
225	!-- x-direction
226	ukomp = 0.5_wp * ( u(k,j,i) + u(k,j,i+1) ) - u_gtrans
227	IF ( ukomp > 0.0_wp ) THEN
228	tend(k,j,i) = tend(k,j,i) - ukomp * &
229	( sk(k,j,i) - sk(k,j,i-1) ) * ddx &
230	* MERGE( 1.0_wp, 0.0_wp, &
231	BTEST( wall_flags_0(k,j,i), 0 ) )
232	ELSE
233	tend(k,j,i) = tend(k,j,i) - ukomp * &
234	( sk(k,j,i+1) - sk(k,j,i) ) * ddx &
235	* MERGE( 1.0_wp, 0.0_wp, &
236	BTEST( wall_flags_0(k,j,i), 0 ) )
237	ENDIF
238	!
239	!-- y-direction
240	vkomp = 0.5_wp * ( v(k,j,i) + v(k,j+1,i) ) - v_gtrans
241	IF ( vkomp > 0.0_wp ) THEN
242	tend(k,j,i) = tend(k,j,i) - vkomp * &
243	( sk(k,j,i) - sk(k,j-1,i) ) * ddy &
244	* MERGE( 1.0_wp, 0.0_wp, &
245	BTEST( wall_flags_0(k,j,i), 0 ) )
246	ELSE
247	tend(k,j,i) = tend(k,j,i) - vkomp * &
248	( sk(k,j+1,i) - sk(k,j,i) ) * ddy &
249	* MERGE( 1.0_wp, 0.0_wp, &
250	BTEST( wall_flags_0(k,j,i), 0 ) )
251	ENDIF
252	!
253	!-- z-direction
254	wkomp = 0.5_wp * ( w(k,j,i) + w(k-1,j,i) )
255	IF ( wkomp > 0.0_wp ) THEN
256	tend(k,j,i) = tend(k,j,i) - wkomp * &
257	( sk(k,j,i) - sk(k-1,j,i) ) * ddzu(k) &
258	* MERGE( 1.0_wp, 0.0_wp, &
259	BTEST( wall_flags_0(k,j,i), 0 ) )
260	ELSE
261	tend(k,j,i) = tend(k,j,i) - wkomp * &
262	( sk(k+1,j,i)-sk(k,j,i) ) * ddzu(k+1) &
263	* MERGE( 1.0_wp, 0.0_wp, &
264	BTEST( wall_flags_0(k,j,i), 0 ) )
265	ENDIF
266
267	ENDDO
268
269	END SUBROUTINE advec_s_up_ij
270
271	END MODULE advec_s_up_mod

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |