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

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

Forced header and separation lines into 80 columns

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