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

Last change on this file since 1321 was 1321, checked in by raasch, 7 years ago

last commit documented

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