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

Last change on this file since 4178 was 3655, checked in by knoop, 3 years ago

Bugfix: made "unit" and "found" intend INOUT in module interface subroutines + automatic copyright update

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