Home

Context Navigation

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

Last change on this file since 3186 was 3183, checked in by suehring, 6 years ago
last commit documented
Property svn:keywords set to `Id`
File size: 9.4 KB

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

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |