Home

Context Navigation

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

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

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |