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

Last change on this file since 1873 was 1873, checked in by maronga, 5 years ago

revised renaming of modules

  • Property svn:keywords set to Id
File size: 11.0 KB
Line 
1!> @file coriolis.f90
2!--------------------------------------------------------------------------------!
3! This file is part of PALM.
4!
5! PALM is free software: you can redistribute it and/or modify it under the terms
6! of the GNU General Public License as published by the Free Software Foundation,
7! either version 3 of the License, or (at your option) any later version.
8!
9! PALM is distributed in the hope that it will be useful, but WITHOUT ANY
10! WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
11! A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
12!
13! You should have received a copy of the GNU General Public License along with
14! PALM. If not, see <http://www.gnu.org/licenses/>.
15!
16! Copyright 1997-2016 Leibniz Universitaet Hannover
17!--------------------------------------------------------------------------------!
18!
19! Current revisions:
20! -----------------
21! Module renamed (removed _mod)
22!
23!
24! Former revisions:
25! -----------------
26! $Id: coriolis.f90 1873 2016-04-18 14:50:06Z maronga $
27!
28! 1850 2016-04-08 13:29:27Z maronga
29! Module renamed
30!
31!
32! 1682 2015-10-07 23:56:08Z knoop
33! Code annotations made doxygen readable
34!
35! 1353 2014-04-08 15:21:23Z heinze
36! REAL constants provided with KIND-attribute
37!
38! 1320 2014-03-20 08:40:49Z raasch
39! ONLY-attribute added to USE-statements,
40! kind-parameters added to all INTEGER and REAL declaration statements,
41! kinds are defined in new module kinds,
42! revision history before 2012 removed,
43! comment fields (!:) to be used for variable explanations added to
44! all variable declaration statements
45!
46! 1257 2013-11-08 15:18:40Z raasch
47! openacc loop and loop vector clauses removed
48!
49! 1128 2013-04-12 06:19:32Z raasch
50! loop index bounds in accelerator version replaced by i_left, i_right, j_south,
51! j_north
52!
53! 1036 2012-10-22 13:43:42Z raasch
54! code put under GPL (PALM 3.9)
55!
56! 1015 2012-09-27 09:23:24Z raasch
57! accelerator version (*_acc) added
58!
59! Revision 1.1  1997/08/29 08:57:38  raasch
60! Initial revision
61!
62!
63! Description:
64! ------------
65!> Computation of all Coriolis terms in the equations of motion.
66!------------------------------------------------------------------------------!
67 MODULE coriolis_mod
68 
69
70    PRIVATE
71    PUBLIC coriolis, coriolis_acc
72
73    INTERFACE coriolis
74       MODULE PROCEDURE coriolis
75       MODULE PROCEDURE coriolis_ij
76    END INTERFACE coriolis
77
78    INTERFACE coriolis_acc
79       MODULE PROCEDURE coriolis_acc
80    END INTERFACE coriolis_acc
81
82 CONTAINS
83
84
85!------------------------------------------------------------------------------!
86! Description:
87! ------------
88!> Call for all grid points
89!------------------------------------------------------------------------------!
90    SUBROUTINE coriolis( component )
91
92       USE arrays_3d,                                                          &
93           ONLY:  tend, u, ug, v, vg, w
94           
95       USE control_parameters,                                                 &
96           ONLY:  f, fs, message_string
97           
98       USE indices,                                                            &
99           ONLY:  nxl, nxlu, nxr, nyn, nys, nysv, nzb_u_inner, nzb_v_inner,    &
100                  nzb_w_inner, nzt
101                   
102       USE kinds
103
104       IMPLICIT NONE
105
106       INTEGER(iwp) ::  component  !<
107       INTEGER(iwp) ::  i          !<
108       INTEGER(iwp) ::  j          !<
109       INTEGER(iwp) ::  k          !<
110
111
112!
113!--    Compute Coriolis terms for the three velocity components
114       SELECT CASE ( component )
115
116!
117!--       u-component
118          CASE ( 1 )
119             DO  i = nxlu, nxr
120                DO  j = nys, nyn
121                   DO  k = nzb_u_inner(j,i)+1, nzt
122                      tend(k,j,i) = tend(k,j,i) + f  *    ( 0.25_wp *          &
123                                   ( v(k,j,i-1) + v(k,j,i) + v(k,j+1,i-1) +    &
124                                     v(k,j+1,i) ) - vg(k) )                    &
125                                                - fs *    ( 0.25_wp *          &
126                                   ( w(k-1,j,i-1) + w(k-1,j,i) + w(k,j,i-1) +  &
127                                     w(k,j,i)   ) &
128                                                          )
129                   ENDDO
130                ENDDO
131             ENDDO
132
133!
134!--       v-component
135          CASE ( 2 )
136             DO  i = nxl, nxr
137                DO  j = nysv, nyn
138                   DO  k = nzb_v_inner(j,i)+1, nzt
139                      tend(k,j,i) = tend(k,j,i) - f *     ( 0.25_wp *          &
140                                   ( u(k,j-1,i) + u(k,j,i) + u(k,j-1,i+1) +    &
141                                     u(k,j,i+1) ) - ug(k) )
142                   ENDDO
143                ENDDO
144             ENDDO
145
146!
147!--       w-component
148          CASE ( 3 )
149             DO  i = nxl, nxr
150                DO  j = nys, nyn
151                   DO  k = nzb_w_inner(j,i)+1, nzt
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) )
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 all grid points - accelerator version
173!------------------------------------------------------------------------------!
174    SUBROUTINE coriolis_acc( 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:  i_left, i_right, j_north, j_south, nzb_u_inner,              &
184                  nzb_v_inner, nzb_w_inner, nzt
185                   
186       USE kinds
187
188       IMPLICIT NONE
189
190       INTEGER(iwp) ::  component  !<
191       INTEGER(iwp) ::  i          !<
192       INTEGER(iwp) ::  j          !<
193       INTEGER(iwp) ::  k          !<
194
195
196!
197!--    Compute Coriolis terms for the three velocity components
198       SELECT CASE ( component )
199
200!
201!--       u-component
202          CASE ( 1 )
203             !$acc  kernels present( nzb_u_inner, tend, v, vg, w )
204             DO  i = i_left, i_right
205                DO  j = j_south, j_north
206                   DO  k = 1, nzt
207                      IF  ( k > nzb_u_inner(j,i) )  THEN
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                                                   - fs *    ( 0.25_wp *       &
212                                      ( w(k-1,j,i-1) + w(k-1,j,i) + w(k,j,i-1) &
213                                        + w(k,j,i)   )                         &
214                                                             )
215                      ENDIF
216                   ENDDO
217                ENDDO
218             ENDDO
219             !$acc end kernels
220
221!
222!--       v-component
223          CASE ( 2 )
224             !$acc  kernels present( nzb_v_inner, tend, u, ug )
225             DO  i = i_left, i_right
226                DO  j = j_south, j_north
227                   DO  k = 1, nzt
228                      IF  ( k > nzb_v_inner(j,i) )  THEN
229                         tend(k,j,i) = tend(k,j,i) - f *     ( 0.25_wp *       &
230                                      ( u(k,j-1,i) + u(k,j,i) + u(k,j-1,i+1) + &
231                                        u(k,j,i+1) ) - ug(k) )
232                      ENDIF
233                   ENDDO
234                ENDDO
235             ENDDO
236             !$acc end kernels
237
238!
239!--       w-component
240          CASE ( 3 )
241             !$acc  kernels present( nzb_w_inner, tend, u )
242             DO  i = i_left, i_right
243                DO  j = j_south, j_north
244                   DO  k = 1, nzt
245                      IF  ( k > nzb_w_inner(j,i) )  THEN
246                         tend(k,j,i) = tend(k,j,i) + fs * 0.25_wp *            &
247                                      ( u(k,j,i) + u(k+1,j,i) + u(k,j,i+1) +   &
248                                        u(k+1,j,i+1) )
249                      ENDIF
250                   ENDDO
251                ENDDO
252             ENDDO
253             !$acc end kernels
254
255          CASE DEFAULT
256
257             WRITE( message_string, * ) ' wrong component: ', component
258             CALL message( 'coriolis', 'PA0173', 1, 2, 0, 6, 0 )
259
260       END SELECT
261
262    END SUBROUTINE coriolis_acc
263
264
265!------------------------------------------------------------------------------!
266! Description:
267! ------------
268!> Call for grid point i,j
269!------------------------------------------------------------------------------!
270    SUBROUTINE coriolis_ij( i, j, component )
271
272       USE arrays_3d,                                                          &
273           ONLY:  tend, u, ug, v, vg, w
274           
275       USE control_parameters,                                                 &
276           ONLY:  f, fs, message_string
277           
278       USE indices,                                                            &
279           ONLY:  nzb_u_inner, nzb_v_inner, nzb_w_inner, nzt
280           
281       USE kinds
282       
283       IMPLICIT NONE
284
285       INTEGER(iwp) ::  component  !<
286       INTEGER(iwp) ::  i          !<
287       INTEGER(iwp) ::  j          !<
288       INTEGER(iwp) ::  k          !<
289
290!
291!--    Compute Coriolis terms for the three velocity components
292       SELECT CASE ( component )
293
294!
295!--       u-component
296          CASE ( 1 )
297             DO  k = nzb_u_inner(j,i)+1, nzt
298                tend(k,j,i) = tend(k,j,i) + f  *    ( 0.25_wp *                &
299                                ( v(k,j,i-1) + v(k,j,i) + v(k,j+1,i-1) +       &
300                                  v(k,j+1,i) ) - vg(k) )                       &
301                                          - fs *    ( 0.25_wp *                &
302                                ( w(k-1,j,i-1) + w(k-1,j,i) + w(k,j,i-1) +     &
303                                  w(k,j,i)   ) )
304             ENDDO
305
306!
307!--       v-component
308          CASE ( 2 )
309             DO  k = nzb_v_inner(j,i)+1, nzt
310                tend(k,j,i) = tend(k,j,i) - f *     ( 0.25_wp *                &
311                                ( u(k,j-1,i) + u(k,j,i) + u(k,j-1,i+1) +       &
312                                  u(k,j,i+1) ) - ug(k) )
313             ENDDO
314
315!
316!--       w-component
317          CASE ( 3 )
318             DO  k = nzb_w_inner(j,i)+1, nzt
319                tend(k,j,i) = tend(k,j,i) + fs * 0.25_wp *                     &
320                                ( u(k,j,i) + u(k+1,j,i) + u(k,j,i+1) +         &
321                                  u(k+1,j,i+1) )
322             ENDDO
323
324          CASE DEFAULT
325
326             WRITE( message_string, * ) ' wrong component: ', component
327             CALL message( 'coriolis', 'PA0173', 1, 2, 0, 6, 0 )
328
329       END SELECT
330
331    END SUBROUTINE coriolis_ij
332
333 END MODULE coriolis_mod
Note: See TracBrowser for help on using the repository browser.