Home

Context Navigation

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

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

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |