Home

Context Navigation

source: palm/trunk/SOURCE/coriolis.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.0 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-2017 Leibniz Universitaet Hannover
18	!------------------------------------------------------------------------------!
19	!
20	! Current revisions:
21	! -----------------
22	! Adjustments to new topography concept
23	!
24	! Former revisions:
25	! -----------------
26	! $Id: coriolis.f90 2232 2017-05-30 17:47:52Z suehring $
27	!
28	! 2118 2017-01-17 16:38:49Z raasch
29	! OpenACC version of subroutine removed
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	! 1682 2015-10-07 23:56:08Z knoop
42	! Code annotations made doxygen readable
43	!
44	! 1353 2014-04-08 15:21:23Z heinze
45	! REAL constants provided with KIND-attribute
46	!
47	! 1320 2014-03-20 08:40:49Z raasch
48	! ONLY-attribute added to USE-statements,
49	! kind-parameters added to all INTEGER and REAL declaration statements,
50	! kinds are defined in new module kinds,
51	! revision history before 2012 removed,
52	! comment fields (!:) to be used for variable explanations added to
53	! all variable declaration statements
54	!
55	! 1257 2013-11-08 15:18:40Z raasch
56	! openacc loop and loop vector clauses removed
57	!
58	! 1128 2013-04-12 06:19:32Z raasch
59	! loop index bounds in accelerator version replaced by i_left, i_right, j_south,
60	! j_north
61	!
62	! 1036 2012-10-22 13:43:42Z raasch
63	! code put under GPL (PALM 3.9)
64	!
65	! 1015 2012-09-27 09:23:24Z raasch
66	! accelerator version (*_acc) added
67	!
68	! Revision 1.1 1997/08/29 08:57:38 raasch
69	! Initial revision
70	!
71	!
72	! Description:
73	! ------------
74	!> Computation of all Coriolis terms in the equations of motion.
75	!------------------------------------------------------------------------------!
76	MODULE coriolis_mod
77
78
79	PRIVATE
80	PUBLIC coriolis
81
82	INTERFACE coriolis
83	MODULE PROCEDURE coriolis
84	MODULE PROCEDURE coriolis_ij
85	END INTERFACE coriolis
86
87	CONTAINS
88
89
90	!------------------------------------------------------------------------------!
91	! Description:
92	! ------------
93	!> Call for all grid points
94	!------------------------------------------------------------------------------!
95	SUBROUTINE coriolis( component )
96
97	USE arrays_3d, &
98	ONLY: tend, u, ug, v, vg, w
99
100	USE control_parameters, &
101	ONLY: f, fs, message_string
102
103	USE indices, &
104	ONLY: nxl, nxlu, nxr, nyn, nys, nysv, nzb, nzt, wall_flags_0
105
106	USE kinds
107
108	IMPLICIT NONE
109
110	INTEGER(iwp) :: component !<
111	INTEGER(iwp) :: i !< running index x direction
112	INTEGER(iwp) :: j !< running index y direction
113	INTEGER(iwp) :: k !< running index z direction
114
115	REAL(wp) :: flag !< flag to mask topography
116	!
117	!-- Compute Coriolis terms for the three velocity components
118	SELECT CASE ( component )
119
120	!
121	!-- u-component
122	CASE ( 1 )
123	DO i = nxlu, nxr
124	DO j = nys, nyn
125	DO k = nzb+1, nzt
126	!
127	!-- Predetermine flag to mask topography
128	flag = MERGE( 1.0_wp, 0.0_wp, &
129	BTEST( wall_flags_0(k,j,i), 1 ) )
130
131	tend(k,j,i) = tend(k,j,i) + f * ( 0.25_wp * &
132	( v(k,j,i-1) + v(k,j,i) + v(k,j+1,i-1) + &
133	v(k,j+1,i) ) - vg(k) ) * flag &
134	- fs * ( 0.25_wp * &
135	( w(k-1,j,i-1) + w(k-1,j,i) + w(k,j,i-1) + &
136	w(k,j,i) ) &
137	) * flag
138	ENDDO
139	ENDDO
140	ENDDO
141
142	!
143	!-- v-component
144	CASE ( 2 )
145	DO i = nxl, nxr
146	DO j = nysv, nyn
147	DO k = nzb+1, nzt
148	tend(k,j,i) = tend(k,j,i) - f * ( 0.25_wp * &
149	( u(k,j-1,i) + u(k,j,i) + u(k,j-1,i+1) + &
150	u(k,j,i+1) ) - ug(k) ) * &
151	MERGE( 1.0_wp, 0.0_wp, &
152	BTEST( wall_flags_0(k,j,i), 2 ) )
153	ENDDO
154	ENDDO
155	ENDDO
156
157	!
158	!-- w-component
159	CASE ( 3 )
160	DO i = nxl, nxr
161	DO j = nys, nyn
162	DO k = nzb+1, nzt
163	tend(k,j,i) = tend(k,j,i) + fs * 0.25_wp * &
164	( u(k,j,i) + u(k+1,j,i) + u(k,j,i+1) + &
165	u(k+1,j,i+1) ) * &
166	MERGE( 1.0_wp, 0.0_wp, &
167	BTEST( wall_flags_0(k,j,i), 3 ) )
168	ENDDO
169	ENDDO
170	ENDDO
171
172	CASE DEFAULT
173
174	WRITE( message_string, * ) ' wrong component: ', component
175	CALL message( 'coriolis', 'PA0173', 1, 2, 0, 6, 0 )
176
177	END SELECT
178
179	END SUBROUTINE coriolis
180
181
182	!------------------------------------------------------------------------------!
183	! Description:
184	! ------------
185	!> Call for grid point i,j
186	!------------------------------------------------------------------------------!
187	SUBROUTINE coriolis_ij( i, j, component )
188
189	USE arrays_3d, &
190	ONLY: tend, u, ug, v, vg, w
191
192	USE control_parameters, &
193	ONLY: f, fs, message_string
194
195	USE indices, &
196	ONLY: nzb, nzt, wall_flags_0
197
198	USE kinds
199
200	IMPLICIT NONE
201
202	INTEGER(iwp) :: component !<
203	INTEGER(iwp) :: i !< running index x direction
204	INTEGER(iwp) :: j !< running index y direction
205	INTEGER(iwp) :: k !< running index z direction
206
207	REAL(wp) :: flag !< flag to mask topography
208
209	!
210	!-- Compute Coriolis terms for the three velocity components
211	SELECT CASE ( component )
212
213	!
214	!-- u-component
215	CASE ( 1 )
216	DO k = nzb+1, nzt
217	!
218	!-- Predetermine flag to mask topography
219	flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j,i), 1 ) )
220
221	tend(k,j,i) = tend(k,j,i) + f * ( 0.25_wp * &
222	( v(k,j,i-1) + v(k,j,i) + v(k,j+1,i-1) + &
223	v(k,j+1,i) ) - vg(k) ) * flag &
224	- fs * ( 0.25_wp * &
225	( w(k-1,j,i-1) + w(k-1,j,i) + w(k,j,i-1) + &
226	w(k,j,i) ) ) * flag
227	ENDDO
228
229	!
230	!-- v-component
231	CASE ( 2 )
232	DO k = nzb+1, nzt
233	tend(k,j,i) = tend(k,j,i) - f * ( 0.25_wp * &
234	( u(k,j-1,i) + u(k,j,i) + u(k,j-1,i+1) + &
235	u(k,j,i+1) ) - ug(k) ) * &
236	MERGE( 1.0_wp, 0.0_wp, &
237	BTEST( wall_flags_0(k,j,i), 2 ) )
238	ENDDO
239
240	!
241	!-- w-component
242	CASE ( 3 )
243	DO k = nzb+1, nzt
244	tend(k,j,i) = tend(k,j,i) + fs * 0.25_wp * &
245	( u(k,j,i) + u(k+1,j,i) + u(k,j,i+1) + &
246	u(k+1,j,i+1) ) * &
247	MERGE( 1.0_wp, 0.0_wp, &
248	BTEST( wall_flags_0(k,j,i), 3 ) )
249	ENDDO
250
251	CASE DEFAULT
252
253	WRITE( message_string, * ) ' wrong component: ', component
254	CALL message( 'coriolis', 'PA0173', 1, 2, 0, 6, 0 )
255
256	END SELECT
257
258	END SUBROUTINE coriolis_ij
259
260	END MODULE coriolis_mod

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |