Home

Context Navigation

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

Last change on this file since 4182 was 4182, checked in by scharf, 5 years ago
corrected "Former revisions" section minor formatting in "Former revisions" section added "Author" section
Property svn:keywords set to `Id`
File size: 8.8 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-2019 Leibniz Universitaet Hannover
18	!------------------------------------------------------------------------------!
19	!
20	! Current revisions:
21	! -----------------
22	!
23	!
24	! Former revisions:
25	! -----------------
26	! $Id: coriolis.f90 4182 2019-08-22 15:20:23Z scharf $
27	! Corrected "Former revisions" section
28	!
29	! 3655 2019-01-07 16:51:22Z knoop
30	! OpenACC port for SPEC
31	!
32	! Revision 1.1 1997/08/29 08:57:38 raasch
33	! Initial revision
34	!
35	!
36	! Description:
37	! ------------
38	!> Computation of all Coriolis terms in the equations of motion.
39	!>
40	!> @note In this routine the topography is masked, even though this
41	!> is again done in prognostic_equations. However, omitting the masking
42	!> here lead to slightly different results. Reason unknown.
43	!------------------------------------------------------------------------------!
44	MODULE coriolis_mod
45
46
47	PRIVATE
48	PUBLIC coriolis
49
50	INTERFACE coriolis
51	MODULE PROCEDURE coriolis
52	MODULE PROCEDURE coriolis_ij
53	END INTERFACE coriolis
54
55	CONTAINS
56
57
58	!------------------------------------------------------------------------------!
59	! Description:
60	! ------------
61	!> Call for all grid points
62	!------------------------------------------------------------------------------!
63	SUBROUTINE coriolis( component )
64
65	USE arrays_3d, &
66	ONLY: tend, u, ug, v, vg, w
67
68	USE control_parameters, &
69	ONLY: f, fs, message_string
70
71	USE indices, &
72	ONLY: nxl, nxlu, nxr, nyn, nys, nysv, nzb, nzt, wall_flags_0
73
74	USE kinds
75
76	IMPLICIT NONE
77
78	INTEGER(iwp) :: component !<
79	INTEGER(iwp) :: i !< running index x direction
80	INTEGER(iwp) :: j !< running index y direction
81	INTEGER(iwp) :: k !< running index z direction
82
83	REAL(wp) :: flag !< flag to mask topography
84
85	!
86	!-- Compute Coriolis terms for the three velocity components
87	SELECT CASE ( component )
88
89	!
90	!-- u-component
91	CASE ( 1 )
92	!$ACC PARALLEL LOOP COLLAPSE(3) PRIVATE(i, j, k, flag) &
93	!$ACC PRESENT(wall_flags_0) &
94	!$ACC PRESENT(v, w, vg) &
95	!$ACC PRESENT(tend)
96	DO i = nxlu, nxr
97	DO j = nys, nyn
98	DO k = nzb+1, nzt
99	!
100	!-- Predetermine flag to mask topography
101	flag = MERGE( 1.0_wp, 0.0_wp, &
102	BTEST( wall_flags_0(k,j,i), 1 ) )
103
104	tend(k,j,i) = tend(k,j,i) + f * ( 0.25_wp * &
105	( v(k,j,i-1) + v(k,j,i) + v(k,j+1,i-1) + &
106	v(k,j+1,i) ) - vg(k) ) * flag &
107	- fs * ( 0.25_wp * &
108	( w(k-1,j,i-1) + w(k-1,j,i) + w(k,j,i-1) + &
109	w(k,j,i) ) &
110	) * flag
111	ENDDO
112	ENDDO
113	ENDDO
114
115	!
116	!-- v-component
117	CASE ( 2 )
118	!$ACC PARALLEL LOOP COLLAPSE(3) PRIVATE(i, j, k, flag) &
119	!$ACC PRESENT(wall_flags_0) &
120	!$ACC PRESENT(u, ug) &
121	!$ACC PRESENT(tend)
122	DO i = nxl, nxr
123	DO j = nysv, nyn
124	DO k = nzb+1, nzt
125	!
126	!-- Predetermine flag to mask topography
127	flag = MERGE( 1.0_wp, 0.0_wp, &
128	BTEST( wall_flags_0(k,j,i), 2 ) )
129
130	tend(k,j,i) = tend(k,j,i) - f * ( 0.25_wp * &
131	( u(k,j-1,i) + u(k,j,i) + u(k,j-1,i+1) + &
132	u(k,j,i+1) ) - ug(k) ) * flag
133	ENDDO
134	ENDDO
135	ENDDO
136
137	!
138	!-- w-component
139	CASE ( 3 )
140	!$ACC PARALLEL LOOP COLLAPSE(3) PRIVATE(i, j, k, flag) &
141	!$ACC PRESENT(wall_flags_0) &
142	!$ACC PRESENT(u) &
143	!$ACC PRESENT(tend)
144	DO i = nxl, nxr
145	DO j = nys, nyn
146	DO k = nzb+1, nzt
147	!
148	!-- Predetermine flag to mask topography
149	flag = MERGE( 1.0_wp, 0.0_wp, &
150	BTEST( wall_flags_0(k,j,i), 3 ) )
151
152	tend(k,j,i) = tend(k,j,i) + fs * 0.25_wp * &
153	( u(k,j,i) + u(k+1,j,i) + u(k,j,i+1) + &
154	u(k+1,j,i+1) ) * flag
155	ENDDO
156	ENDDO
157	ENDDO
158
159	CASE DEFAULT
160
161	WRITE( message_string, * ) ' wrong component: ', component
162	CALL message( 'coriolis', 'PA0173', 1, 2, 0, 6, 0 )
163
164	END SELECT
165
166	END SUBROUTINE coriolis
167
168
169	!------------------------------------------------------------------------------!
170	! Description:
171	! ------------
172	!> Call for grid point i,j
173	!------------------------------------------------------------------------------!
174	SUBROUTINE coriolis_ij( i, j, component )
175
176	USE arrays_3d, &
177	ONLY: tend, u, ug, v, vg, w
178
179	USE control_parameters, &
180	ONLY: f, fs, message_string
181
182	USE indices, &
183	ONLY: nzb, nzt, wall_flags_0
184
185	USE kinds
186
187	IMPLICIT NONE
188
189	INTEGER(iwp) :: component !<
190	INTEGER(iwp) :: i !< running index x direction
191	INTEGER(iwp) :: j !< running index y direction
192	INTEGER(iwp) :: k !< running index z direction
193
194	REAL(wp) :: flag !< flag to mask topography
195
196	!
197	!-- Compute Coriolis terms for the three velocity components
198	SELECT CASE ( component )
199
200	!
201	!-- u-component
202	CASE ( 1 )
203	DO k = nzb+1, nzt
204	!
205	!-- Predetermine flag to mask topography
206	flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j,i), 1 ) )
207
208	tend(k,j,i) = tend(k,j,i) + f * ( 0.25_wp * &
209	( v(k,j,i-1) + v(k,j,i) + v(k,j+1,i-1) + &
210	v(k,j+1,i) ) - vg(k) &
211	) * flag &
212	- fs * ( 0.25_wp * &
213	( w(k-1,j,i-1) + w(k-1,j,i) + w(k,j,i-1) + &
214	w(k,j,i) ) ) * flag
215	ENDDO
216
217	!
218	!-- v-component
219	CASE ( 2 )
220	DO k = nzb+1, nzt
221	!
222	!-- Predetermine flag to mask topography
223	flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j,i), 2 ) )
224
225	tend(k,j,i) = tend(k,j,i) - f * ( 0.25_wp * &
226	( u(k,j-1,i) + u(k,j,i) + u(k,j-1,i+1) + &
227	u(k,j,i+1) ) - ug(k) ) * flag
228	ENDDO
229
230	!
231	!-- w-component
232	CASE ( 3 )
233	DO k = nzb+1, nzt
234	!
235	!-- Predetermine flag to mask topography
236	flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j,i), 3 ) )
237
238	tend(k,j,i) = tend(k,j,i) + fs * 0.25_wp * &
239	( u(k,j,i) + u(k+1,j,i) + u(k,j,i+1) + &
240	u(k+1,j,i+1) ) * flag
241	ENDDO
242
243	CASE DEFAULT
244
245	WRITE( message_string, * ) ' wrong component: ', component
246	CALL message( 'coriolis', 'PA0173', 1, 2, 0, 6, 0 )
247
248	END SELECT
249
250	END SUBROUTINE coriolis_ij
251
252	END MODULE coriolis_mod

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |