Home

Context Navigation

source: palm/trunk/SOURCE/coriolis.f90 @ 2032

Last change on this file since 2032 was 2001, checked in by knoop, 8 years ago
last commit documented
Property svn:keywords set to `Id`
File size: 11.1 KB

Line
1	!> @file coriolis.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-2016 Leibniz Universitaet Hannover
18	!------------------------------------------------------------------------------!
19	!
20	! Current revisions:
21	! -----------------
22	!
23	!
24	! Former revisions:
25	! -----------------
26	! $Id: coriolis.f90 2001 2016-08-20 18:41:22Z knoop $
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	! 1353 2014-04-08 15:21:23Z heinze
43	! REAL constants provided with KIND-attribute
44	!
45	! 1320 2014-03-20 08:40:49Z raasch
46	! ONLY-attribute added to USE-statements,
47	! kind-parameters added to all INTEGER and REAL declaration statements,
48	! kinds are defined in new module kinds,
49	! revision history before 2012 removed,
50	! comment fields (!:) to be used for variable explanations added to
51	! all variable declaration statements
52	!
53	! 1257 2013-11-08 15:18:40Z raasch
54	! openacc loop and loop vector clauses removed
55	!
56	! 1128 2013-04-12 06:19:32Z raasch
57	! loop index bounds in accelerator version replaced by i_left, i_right, j_south,
58	! j_north
59	!
60	! 1036 2012-10-22 13:43:42Z raasch
61	! code put under GPL (PALM 3.9)
62	!
63	! 1015 2012-09-27 09:23:24Z raasch
64	! accelerator version (*_acc) added
65	!
66	! Revision 1.1 1997/08/29 08:57:38 raasch
67	! Initial revision
68	!
69	!
70	! Description:
71	! ------------
72	!> Computation of all Coriolis terms in the equations of motion.
73	!------------------------------------------------------------------------------!
74	MODULE coriolis_mod
75
76
77	PRIVATE
78	PUBLIC coriolis, coriolis_acc
79
80	INTERFACE coriolis
81	MODULE PROCEDURE coriolis
82	MODULE PROCEDURE coriolis_ij
83	END INTERFACE coriolis
84
85	INTERFACE coriolis_acc
86	MODULE PROCEDURE coriolis_acc
87	END INTERFACE coriolis_acc
88
89	CONTAINS
90
91
92	!------------------------------------------------------------------------------!
93	! Description:
94	! ------------
95	!> Call for all grid points
96	!------------------------------------------------------------------------------!
97	SUBROUTINE coriolis( component )
98
99	USE arrays_3d, &
100	ONLY: tend, u, ug, v, vg, w
101
102	USE control_parameters, &
103	ONLY: f, fs, message_string
104
105	USE indices, &
106	ONLY: nxl, nxlu, nxr, nyn, nys, nysv, nzb_u_inner, nzb_v_inner, &
107	nzb_w_inner, nzt
108
109	USE kinds
110
111	IMPLICIT NONE
112
113	INTEGER(iwp) :: component !<
114	INTEGER(iwp) :: i !<
115	INTEGER(iwp) :: j !<
116	INTEGER(iwp) :: k !<
117
118
119	!
120	!-- Compute Coriolis terms for the three velocity components
121	SELECT CASE ( component )
122
123	!
124	!-- u-component
125	CASE ( 1 )
126	DO i = nxlu, nxr
127	DO j = nys, nyn
128	DO k = nzb_u_inner(j,i)+1, nzt
129	tend(k,j,i) = tend(k,j,i) + f * ( 0.25_wp * &
130	( v(k,j,i-1) + v(k,j,i) + v(k,j+1,i-1) + &
131	v(k,j+1,i) ) - vg(k) ) &
132	- fs * ( 0.25_wp * &
133	( w(k-1,j,i-1) + w(k-1,j,i) + w(k,j,i-1) + &
134	w(k,j,i) ) &
135	)
136	ENDDO
137	ENDDO
138	ENDDO
139
140	!
141	!-- v-component
142	CASE ( 2 )
143	DO i = nxl, nxr
144	DO j = nysv, nyn
145	DO k = nzb_v_inner(j,i)+1, nzt
146	tend(k,j,i) = tend(k,j,i) - f * ( 0.25_wp * &
147	( u(k,j-1,i) + u(k,j,i) + u(k,j-1,i+1) + &
148	u(k,j,i+1) ) - ug(k) )
149	ENDDO
150	ENDDO
151	ENDDO
152
153	!
154	!-- w-component
155	CASE ( 3 )
156	DO i = nxl, nxr
157	DO j = nys, nyn
158	DO k = nzb_w_inner(j,i)+1, nzt
159	tend(k,j,i) = tend(k,j,i) + fs * 0.25_wp * &
160	( u(k,j,i) + u(k+1,j,i) + u(k,j,i+1) + &
161	u(k+1,j,i+1) )
162	ENDDO
163	ENDDO
164	ENDDO
165
166	CASE DEFAULT
167
168	WRITE( message_string, * ) ' wrong component: ', component
169	CALL message( 'coriolis', 'PA0173', 1, 2, 0, 6, 0 )
170
171	END SELECT
172
173	END SUBROUTINE coriolis
174
175
176	!------------------------------------------------------------------------------!
177	! Description:
178	! ------------
179	!> Call for all grid points - accelerator version
180	!------------------------------------------------------------------------------!
181	SUBROUTINE coriolis_acc( component )
182
183	USE arrays_3d, &
184	ONLY: tend, u, ug, v, vg, w
185
186	USE control_parameters, &
187	ONLY: f, fs, message_string
188
189	USE indices, &
190	ONLY: i_left, i_right, j_north, j_south, nzb_u_inner, &
191	nzb_v_inner, nzb_w_inner, nzt
192
193	USE kinds
194
195	IMPLICIT NONE
196
197	INTEGER(iwp) :: component !<
198	INTEGER(iwp) :: i !<
199	INTEGER(iwp) :: j !<
200	INTEGER(iwp) :: k !<
201
202
203	!
204	!-- Compute Coriolis terms for the three velocity components
205	SELECT CASE ( component )
206
207	!
208	!-- u-component
209	CASE ( 1 )
210	!$acc kernels present( nzb_u_inner, tend, v, vg, w )
211	DO i = i_left, i_right
212	DO j = j_south, j_north
213	DO k = 1, nzt
214	IF ( k > nzb_u_inner(j,i) ) THEN
215	tend(k,j,i) = tend(k,j,i) + f * ( 0.25_wp * &
216	( v(k,j,i-1) + v(k,j,i) + v(k,j+1,i-1) + &
217	v(k,j+1,i) ) - vg(k) ) &
218	- fs * ( 0.25_wp * &
219	( w(k-1,j,i-1) + w(k-1,j,i) + w(k,j,i-1) &
220	+ w(k,j,i) ) &
221	)
222	ENDIF
223	ENDDO
224	ENDDO
225	ENDDO
226	!$acc end kernels
227
228	!
229	!-- v-component
230	CASE ( 2 )
231	!$acc kernels present( nzb_v_inner, tend, u, ug )
232	DO i = i_left, i_right
233	DO j = j_south, j_north
234	DO k = 1, nzt
235	IF ( k > nzb_v_inner(j,i) ) THEN
236	tend(k,j,i) = tend(k,j,i) - f * ( 0.25_wp * &
237	( u(k,j-1,i) + u(k,j,i) + u(k,j-1,i+1) + &
238	u(k,j,i+1) ) - ug(k) )
239	ENDIF
240	ENDDO
241	ENDDO
242	ENDDO
243	!$acc end kernels
244
245	!
246	!-- w-component
247	CASE ( 3 )
248	!$acc kernels present( nzb_w_inner, tend, u )
249	DO i = i_left, i_right
250	DO j = j_south, j_north
251	DO k = 1, nzt
252	IF ( k > nzb_w_inner(j,i) ) THEN
253	tend(k,j,i) = tend(k,j,i) + fs * 0.25_wp * &
254	( u(k,j,i) + u(k+1,j,i) + u(k,j,i+1) + &
255	u(k+1,j,i+1) )
256	ENDIF
257	ENDDO
258	ENDDO
259	ENDDO
260	!$acc end kernels
261
262	CASE DEFAULT
263
264	WRITE( message_string, * ) ' wrong component: ', component
265	CALL message( 'coriolis', 'PA0173', 1, 2, 0, 6, 0 )
266
267	END SELECT
268
269	END SUBROUTINE coriolis_acc
270
271
272	!------------------------------------------------------------------------------!
273	! Description:
274	! ------------
275	!> Call for grid point i,j
276	!------------------------------------------------------------------------------!
277	SUBROUTINE coriolis_ij( i, j, component )
278
279	USE arrays_3d, &
280	ONLY: tend, u, ug, v, vg, w
281
282	USE control_parameters, &
283	ONLY: f, fs, message_string
284
285	USE indices, &
286	ONLY: nzb_u_inner, nzb_v_inner, nzb_w_inner, nzt
287
288	USE kinds
289
290	IMPLICIT NONE
291
292	INTEGER(iwp) :: component !<
293	INTEGER(iwp) :: i !<
294	INTEGER(iwp) :: j !<
295	INTEGER(iwp) :: k !<
296
297	!
298	!-- Compute Coriolis terms for the three velocity components
299	SELECT CASE ( component )
300
301	!
302	!-- u-component
303	CASE ( 1 )
304	DO k = nzb_u_inner(j,i)+1, nzt
305	tend(k,j,i) = tend(k,j,i) + f * ( 0.25_wp * &
306	( v(k,j,i-1) + v(k,j,i) + v(k,j+1,i-1) + &
307	v(k,j+1,i) ) - vg(k) ) &
308	- fs * ( 0.25_wp * &
309	( w(k-1,j,i-1) + w(k-1,j,i) + w(k,j,i-1) + &
310	w(k,j,i) ) )
311	ENDDO
312
313	!
314	!-- v-component
315	CASE ( 2 )
316	DO k = nzb_v_inner(j,i)+1, nzt
317	tend(k,j,i) = tend(k,j,i) - f * ( 0.25_wp * &
318	( u(k,j-1,i) + u(k,j,i) + u(k,j-1,i+1) + &
319	u(k,j,i+1) ) - ug(k) )
320	ENDDO
321
322	!
323	!-- w-component
324	CASE ( 3 )
325	DO k = nzb_w_inner(j,i)+1, nzt
326	tend(k,j,i) = tend(k,j,i) + fs * 0.25_wp * &
327	( u(k,j,i) + u(k+1,j,i) + u(k,j,i+1) + &
328	u(k+1,j,i+1) )
329	ENDDO
330
331	CASE DEFAULT
332
333	WRITE( message_string, * ) ' wrong component: ', component
334	CALL message( 'coriolis', 'PA0173', 1, 2, 0, 6, 0 )
335
336	END SELECT
337
338	END SUBROUTINE coriolis_ij
339
340	END MODULE coriolis_mod

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |