Home

Context Navigation

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

Last change on this file since 1634 was 1354, checked in by heinze, 11 years ago
last commit documented
Property svn:keywords set to `Id`
File size: 10.7 KB

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

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |