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

Last change on this file since 2001 was 2001, checked in by knoop, 5 years ago

last commit documented

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