Home

Context Navigation

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

Last change on this file since 4506 was 4360, checked in by suehring, 5 years ago
Bugfix in output of time-averaged plant-canopy quanities; Output of plant-canopy data only where tall canopy is defined; land-surface model: fix wrong location strings; tests: update urban test case; all source code files: copyright update
Property svn:keywords set to `Id`
File size: 11.6 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-2020 Leibniz Universitaet Hannover
18	!------------------------------------------------------------------------------!
19	!
20	! Current revisions:
21	! -----------------
22	!
23	!
24	! Former revisions:
25	! -----------------
26	! $Id: coriolis.f90 4360 2020-01-07 11:25:50Z schwenkel $
27	! Introduction of wall_flags_total_0, which currently sets bits based on static
28	! topography information used in wall_flags_static_0
29	!
30	! 4329 2019-12-10 15:46:36Z motisi
31	! Renamed wall_flags_0 to wall_flags_static_0
32	!
33	! 4196 2019-08-29 11:02:06Z gronemeier
34	! Consider rotation of model domain
35	!
36	! 4182 2019-08-22 15:20:23Z scharf
37	! Corrected "Former revisions" section
38	!
39	! 3655 2019-01-07 16:51:22Z knoop
40	! OpenACC port for SPEC
41	!
42	! Revision 1.1 1997/08/29 08:57:38 raasch
43	! Initial revision
44	!
45	!
46	! Description:
47	! ------------
48	!> Computation of all Coriolis terms in the equations of motion.
49	!>
50	!> @note In this routine the topography is masked, even though this
51	!> is again done in prognostic_equations. However, omitting the masking
52	!> here lead to slightly different results. Reason unknown.
53	!------------------------------------------------------------------------------!
54	MODULE coriolis_mod
55
56
57	PRIVATE
58	PUBLIC coriolis
59
60	INTERFACE coriolis
61	MODULE PROCEDURE coriolis
62	MODULE PROCEDURE coriolis_ij
63	END INTERFACE coriolis
64
65	CONTAINS
66
67
68	!------------------------------------------------------------------------------!
69	! Description:
70	! ------------
71	!> Call for all grid points
72	!------------------------------------------------------------------------------!
73	SUBROUTINE coriolis( component )
74
75	USE arrays_3d, &
76	ONLY: tend, u, ug, v, vg, w
77
78	USE basic_constants_and_equations_mod, &
79	ONLY: pi
80
81	USE control_parameters, &
82	ONLY: f, fs, message_string, rotation_angle
83
84	USE indices, &
85	ONLY: nxl, nxlu, nxr, nyn, nys, nysv, nzb, nzt, &
86	wall_flags_total_0
87
88	USE kinds
89
90	IMPLICIT NONE
91
92	INTEGER(iwp) :: component !< component of momentum equation
93	INTEGER(iwp) :: i !< running index x direction
94	INTEGER(iwp) :: j !< running index y direction
95	INTEGER(iwp) :: k !< running index z direction
96
97	REAL(wp) :: cos_rot_angle !< cosine of model rotation angle
98	REAL(wp) :: flag !< flag to mask topography
99	REAL(wp) :: sin_rot_angle !< sine of model rotation angle
100
101	!
102	!-- Precalculate cosine and sine of rotation angle
103	cos_rot_angle = COS( rotation_angle * pi / 180.0_wp )
104	sin_rot_angle = SIN( rotation_angle * pi / 180.0_wp )
105
106	!
107	!-- Compute Coriolis terms for the three velocity components
108	SELECT CASE ( component )
109
110	!
111	!-- u-component
112	CASE ( 1 )
113	!$ACC PARALLEL LOOP COLLAPSE(3) PRIVATE(i, j, k, flag) &
114	!$ACC PRESENT(wall_flags_total_0) &
115	!$ACC PRESENT(v, w, vg) &
116	!$ACC PRESENT(tend)
117	DO i = nxlu, nxr
118	DO j = nys, nyn
119	DO k = nzb+1, nzt
120	!
121	!-- Predetermine flag to mask topography
122	flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 1 ) )
123
124	tend(k,j,i) = tend(k,j,i) + flag * &
125	( f &
126	* ( 0.25_wp * ( v(k,j,i-1) + v(k,j,i) + v(k,j+1,i-1) + v(k,j+1,i) ) &
127	- vg(k) ) &
128	- fs * cos_rot_angle &
129	* 0.25_wp * ( w(k-1,j,i-1) + w(k-1,j,i) + w(k,j,i-1) + w(k,j,i) ) &
130	)
131	ENDDO
132	ENDDO
133	ENDDO
134
135	!
136	!-- v-component
137	CASE ( 2 )
138	!$ACC PARALLEL LOOP COLLAPSE(3) PRIVATE(i, j, k, flag) &
139	!$ACC PRESENT(wall_flags_total_0) &
140	!$ACC PRESENT(u, w, ug) &
141	!$ACC PRESENT(tend)
142	DO i = nxl, nxr
143	DO j = nysv, nyn
144	DO k = nzb+1, nzt
145	!
146	!-- Predetermine flag to mask topography
147	flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 2 ) )
148
149	tend(k,j,i) = tend(k,j,i) - flag * &
150	( f &
151	* ( 0.25_wp * ( u(k,j-1,i) + u(k,j,i) + u(k,j-1,i+1) + u(k,j,i+1) ) &
152	- ug(k) ) &
153	+ fs * sin_rot_angle &
154	* 0.25_wp * ( w(k,j,i) + w(k-1,j,i) + w(k,j-1,i) + w(k-1,j-1,i) ) &
155	)
156	ENDDO
157	ENDDO
158	ENDDO
159
160	!
161	!-- w-component
162	CASE ( 3 )
163	!$ACC PARALLEL LOOP COLLAPSE(3) PRIVATE(i, j, k, flag) &
164	!$ACC PRESENT(wall_flags_total_0) &
165	!$ACC PRESENT(u, v) &
166	!$ACC PRESENT(tend)
167	DO i = nxl, nxr
168	DO j = nys, nyn
169	DO k = nzb+1, nzt
170	!
171	!-- Predetermine flag to mask topography
172	flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 3 ) )
173
174	tend(k,j,i) = tend(k,j,i) &
175	+ fs * 0.25_wp * flag &
176	* ( cos_rot_angle &
177	* ( u(k,j,i) + u(k+1,j,i) + u(k,j,i+1) + u(k+1,j,i+1) ) &
178	+ sin_rot_angle &
179	* ( v(k,j,i) + v(k+1,j,i) + v(k,j+1,i) + v(k+1,j+1,i) ) &
180	)
181	ENDDO
182	ENDDO
183	ENDDO
184
185	CASE DEFAULT
186
187	WRITE( message_string, * ) ' wrong component: ', component
188	CALL message( 'coriolis', 'PA0173', 1, 2, 0, 6, 0 )
189
190	END SELECT
191
192	END SUBROUTINE coriolis
193
194
195	!------------------------------------------------------------------------------!
196	! Description:
197	! ------------
198	!> Call for grid point i,j
199	!------------------------------------------------------------------------------!
200	SUBROUTINE coriolis_ij( i, j, component )
201
202	USE arrays_3d, &
203	ONLY: tend, u, ug, v, vg, w
204
205	USE basic_constants_and_equations_mod, &
206	ONLY: pi
207
208	USE control_parameters, &
209	ONLY: f, fs, message_string, rotation_angle
210
211	USE indices, &
212	ONLY: nzb, nzt, wall_flags_total_0
213
214	USE kinds
215
216	IMPLICIT NONE
217
218	INTEGER(iwp) :: component !< component of momentum equation
219	INTEGER(iwp) :: i !< running index x direction
220	INTEGER(iwp) :: j !< running index y direction
221	INTEGER(iwp) :: k !< running index z direction
222
223	REAL(wp) :: cos_rot_angle !< cosine of model rotation angle
224	REAL(wp) :: flag !< flag to mask topography
225	REAL(wp) :: sin_rot_angle !< sine of model rotation angle
226
227	!
228	!-- Precalculate cosine and sine of rotation angle
229	cos_rot_angle = COS( rotation_angle * pi / 180.0_wp )
230	sin_rot_angle = SIN( rotation_angle * pi / 180.0_wp )
231
232	!
233	!-- Compute Coriolis terms for the three velocity components
234	SELECT CASE ( component )
235
236	!
237	!-- u-component
238	CASE ( 1 )
239	DO k = nzb+1, nzt
240	!
241	!-- Predetermine flag to mask topography
242	flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 1 ) )
243
244	tend(k,j,i) = tend(k,j,i) + flag * &
245	( f &
246	* ( 0.25_wp * ( v(k,j,i-1) + v(k,j,i) + v(k,j+1,i-1) + v(k,j+1,i) ) &
247	- vg(k) ) &
248	- fs * cos_rot_angle &
249	* 0.25_wp * ( w(k-1,j,i-1) + w(k-1,j,i) + w(k,j,i-1) + w(k,j,i) ) &
250	)
251	ENDDO
252
253	!
254	!-- v-component
255	CASE ( 2 )
256	DO k = nzb+1, nzt
257	!
258	!-- Predetermine flag to mask topography
259	flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 2 ) )
260
261	tend(k,j,i) = tend(k,j,i) - flag * &
262	( f &
263	* ( 0.25_wp * ( u(k,j-1,i) + u(k,j,i) + u(k,j-1,i+1) + u(k,j,i+1) ) &
264	- ug(k) ) &
265	+ fs * sin_rot_angle &
266	* 0.25_wp * ( w(k,j,i) + w(k-1,j,i) + w(k,j-1,i) + w(k-1,j-1,i) ) &
267	)
268	ENDDO
269
270	!
271	!-- w-component
272	CASE ( 3 )
273	DO k = nzb+1, nzt
274	!
275	!-- Predetermine flag to mask topography
276	flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 3 ) )
277
278	tend(k,j,i) = tend(k,j,i) &
279	+ fs * 0.25_wp * flag &
280	* ( cos_rot_angle &
281	* ( u(k,j,i) + u(k+1,j,i) + u(k,j,i+1) + u(k+1,j,i+1) ) &
282	+ sin_rot_angle &
283	* ( v(k,j,i) + v(k+1,j,i) + v(k,j+1,i) + v(k+1,j+1,i) ) &
284	)
285	ENDDO
286
287	CASE DEFAULT
288
289	WRITE( message_string, * ) ' wrong component: ', component
290	CALL message( 'coriolis', 'PA0173', 1, 2, 0, 6, 0 )
291
292	END SELECT
293
294	END SUBROUTINE coriolis_ij
295
296	END MODULE coriolis_mod

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |