Home

Context Navigation

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

Last change on this file since 2232 was 2232, checked in by suehring, 7 years ago
Adjustments according new topography and surface-modelling concept implemented
Property svn:keywords set to `Id`
File size: 9.8 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	! topography representation via flags
23	!
24	! Former revisions:
25	! -----------------
26	! $Id: advec_s_up.f90 2232 2017-05-30 17:47:52Z suehring $
27	!
28	! 2000 2016-08-20 18:09:15Z knoop
29	! Forced header and separation lines into 80 columns
30	!
31	! 1873 2016-04-18 14:50:06Z maronga
32	! Module renamed (removed _mod)
33	!
34	!
35	! 1850 2016-04-08 13:29:27Z maronga
36	! Module renamed
37	!
38	!
39	! 1682 2015-10-07 23:56:08Z knoop
40	! Code annotations made doxygen readable
41	!
42	! 1374 2014-04-25 12:55:07Z raasch
43	! missing variables added to ONLY list
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	! 1010 2012-09-20 07:59:54Z raasch
60	! cpp switch __nopointer added for pointer free version
61	!
62	! 981 2012-08-09 14:57:44Z maronga
63	! Typo removed
64	!
65	! Revision 1.1 1997/08/29 08:54:33 raasch
66	! Initial revision
67	!
68	!
69	! Description:
70	! ------------
71	!> Advection term for scalar quantities using the Upstream scheme.
72	!> NOTE: vertical advection at k=1 still has wrong grid spacing for w>0!
73	!> The same problem occurs for all topography boundaries!
74	!------------------------------------------------------------------------------!
75	MODULE advec_s_up_mod
76
77
78	PRIVATE
79	PUBLIC advec_s_up
80
81	INTERFACE advec_s_up
82	MODULE PROCEDURE advec_s_up
83	MODULE PROCEDURE advec_s_up_ij
84	END INTERFACE advec_s_up
85
86	CONTAINS
87
88
89	!------------------------------------------------------------------------------!
90	! Description:
91	! ------------
92	!> Call for all grid points
93	!------------------------------------------------------------------------------!
94	SUBROUTINE advec_s_up( sk )
95
96	USE arrays_3d, &
97	ONLY: ddzu, tend, u, v, w
98
99	USE control_parameters, &
100	ONLY: u_gtrans, v_gtrans
101
102	USE grid_variables, &
103	ONLY: ddx, ddy
104
105	USE indices, &
106	ONLY: nxl, nxlg, nxr, nxrg, nyn, nyng, nys, nysg, nzb, nzt, &
107	wall_flags_0
108
109	USE kinds
110
111
112	IMPLICIT NONE
113
114	INTEGER(iwp) :: i !<
115	INTEGER(iwp) :: j !<
116	INTEGER(iwp) :: k !<
117
118	REAL(wp) :: ukomp !<
119	REAL(wp) :: vkomp !<
120	REAL(wp) :: wkomp !<
121	#if defined( __nopointer )
122	REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) :: sk !<
123	#else
124	REAL(wp), DIMENSION(:,:,:), POINTER :: sk
125	#endif
126
127
128	DO i = nxl, nxr
129	DO j = nys, nyn
130	DO k = nzb+1, nzt
131	!
132	!-- x-direction
133	ukomp = 0.5_wp * ( u(k,j,i) + u(k,j,i+1) ) - u_gtrans
134	IF ( ukomp > 0.0_wp ) THEN
135	tend(k,j,i) = tend(k,j,i) - ukomp * &
136	( sk(k,j,i) - sk(k,j,i-1) ) * ddx &
137	* MERGE( 1.0_wp, 0.0_wp, &
138	BTEST( wall_flags_0(k,j,i), 0 ) )
139	ELSE
140	tend(k,j,i) = tend(k,j,i) - ukomp * &
141	( sk(k,j,i+1) - sk(k,j,i) ) * ddx &
142	* MERGE( 1.0_wp, 0.0_wp, &
143	BTEST( wall_flags_0(k,j,i), 0 ) )
144	ENDIF
145	!
146	!-- y-direction
147	vkomp = 0.5_wp * ( v(k,j,i) + v(k,j+1,i) ) - v_gtrans
148	IF ( vkomp > 0.0_wp ) THEN
149	tend(k,j,i) = tend(k,j,i) - vkomp * &
150	( sk(k,j,i) - sk(k,j-1,i) ) * ddy &
151	* MERGE( 1.0_wp, 0.0_wp, &
152	BTEST( wall_flags_0(k,j,i), 0 ) )
153	ELSE
154	tend(k,j,i) = tend(k,j,i) - vkomp * &
155	( sk(k,j+1,i) - sk(k,j,i) ) * ddy &
156	* MERGE( 1.0_wp, 0.0_wp, &
157	BTEST( wall_flags_0(k,j,i), 0 ) )
158	ENDIF
159	!
160	!-- z-direction
161	wkomp = 0.5_wp * ( w(k,j,i) + w(k-1,j,i) )
162	IF ( wkomp > 0.0_wp ) THEN
163	tend(k,j,i) = tend(k,j,i) - wkomp * &
164	( sk(k,j,i) - sk(k-1,j,i) ) * ddzu(k) &
165	* MERGE( 1.0_wp, 0.0_wp, &
166	BTEST( wall_flags_0(k,j,i), 0 ) )
167	ELSE
168	tend(k,j,i) = tend(k,j,i) - wkomp * &
169	( sk(k+1,j,i)-sk(k,j,i) ) * ddzu(k+1) &
170	* MERGE( 1.0_wp, 0.0_wp, &
171	BTEST( wall_flags_0(k,j,i), 0 ) )
172	ENDIF
173
174	ENDDO
175	ENDDO
176	ENDDO
177
178	END SUBROUTINE advec_s_up
179
180
181	!------------------------------------------------------------------------------!
182	! Description:
183	! ------------
184	!> Call for grid point i,j
185	!------------------------------------------------------------------------------!
186	SUBROUTINE advec_s_up_ij( i, j, sk )
187
188	USE arrays_3d, &
189	ONLY: ddzu, tend, u, v, w
190
191	USE control_parameters, &
192	ONLY: u_gtrans, v_gtrans
193
194	USE grid_variables, &
195	ONLY: ddx, ddy
196
197	USE indices, &
198	ONLY: nxlg, nxrg, nyng, nysg, nzb, nzt, wall_flags_0
199
200	USE kinds
201
202
203	IMPLICIT NONE
204
205	INTEGER(iwp) :: i !<
206	INTEGER(iwp) :: j !<
207	INTEGER(iwp) :: k !<
208
209	REAL(wp) :: ukomp !<
210	REAL(wp) :: vkomp !<
211	REAL(wp) :: wkomp !<
212
213	#if defined( __nopointer )
214	REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) :: sk !<
215	#else
216	REAL(wp), DIMENSION(:,:,:), POINTER :: sk
217	#endif
218
219
220	DO k = nzb+1, nzt
221	!
222	!-- x-direction
223	ukomp = 0.5_wp * ( u(k,j,i) + u(k,j,i+1) ) - u_gtrans
224	IF ( ukomp > 0.0_wp ) THEN
225	tend(k,j,i) = tend(k,j,i) - ukomp * &
226	( sk(k,j,i) - sk(k,j,i-1) ) * ddx &
227	* MERGE( 1.0_wp, 0.0_wp, &
228	BTEST( wall_flags_0(k,j,i), 0 ) )
229	ELSE
230	tend(k,j,i) = tend(k,j,i) - ukomp * &
231	( sk(k,j,i+1) - sk(k,j,i) ) * ddx &
232	* MERGE( 1.0_wp, 0.0_wp, &
233	BTEST( wall_flags_0(k,j,i), 0 ) )
234	ENDIF
235	!
236	!-- y-direction
237	vkomp = 0.5_wp * ( v(k,j,i) + v(k,j+1,i) ) - v_gtrans
238	IF ( vkomp > 0.0_wp ) THEN
239	tend(k,j,i) = tend(k,j,i) - vkomp * &
240	( sk(k,j,i) - sk(k,j-1,i) ) * ddy &
241	* MERGE( 1.0_wp, 0.0_wp, &
242	BTEST( wall_flags_0(k,j,i), 0 ) )
243	ELSE
244	tend(k,j,i) = tend(k,j,i) - vkomp * &
245	( sk(k,j+1,i) - sk(k,j,i) ) * ddy &
246	* MERGE( 1.0_wp, 0.0_wp, &
247	BTEST( wall_flags_0(k,j,i), 0 ) )
248	ENDIF
249	!
250	!-- z-direction
251	wkomp = 0.5_wp * ( w(k,j,i) + w(k-1,j,i) )
252	IF ( wkomp > 0.0_wp ) THEN
253	tend(k,j,i) = tend(k,j,i) - wkomp * &
254	( sk(k,j,i) - sk(k-1,j,i) ) * ddzu(k) &
255	* MERGE( 1.0_wp, 0.0_wp, &
256	BTEST( wall_flags_0(k,j,i), 0 ) )
257	ELSE
258	tend(k,j,i) = tend(k,j,i) - wkomp * &
259	( sk(k+1,j,i)-sk(k,j,i) ) * ddzu(k+1) &
260	* MERGE( 1.0_wp, 0.0_wp, &
261	BTEST( wall_flags_0(k,j,i), 0 ) )
262	ENDIF
263
264	ENDDO
265
266	END SUBROUTINE advec_s_up_ij
267
268	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 |