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

Last change on this file since 1017 was 1017, checked in by raasch, 9 years ago

last commit documented

  • Property svn:keywords set to Id
File size: 8.3 KB
Line 
1 MODULE coriolis_mod
2
3!------------------------------------------------------------------------------!
4! Current revisions:
5! -----------------
6!
7!
8! Former revisions:
9! -----------------
10! $Id: coriolis.f90 1017 2012-09-27 11:28:50Z raasch $
11!
12! 1015 2012-09-27 09:23:24Z raasch
13! accelerator version (*_acc) added
14!
15! 254 2009-03-05 15:33:42Z heinze
16! Output of messages replaced by message handling routine.
17!
18! 106 2007-08-16 14:30:26Z raasch
19! loops for u and v are starting from index nxlu, nysv, respectively (needed
20! for non-cyclic boundary conditions)
21!
22! 75 2007-03-22 09:54:05Z raasch
23! uxrp, vynp eliminated
24!
25! RCS Log replace by Id keyword, revision history cleaned up
26!
27! Revision 1.12  2006/02/23 10:08:57  raasch
28! nzb_2d replaced by nzb_u/v/w_inner
29!
30! Revision 1.1  1997/08/29 08:57:38  raasch
31! Initial revision
32!
33!
34! Description:
35! ------------
36! Computation of all Coriolis terms in the equations of motion.
37!------------------------------------------------------------------------------!
38
39    PRIVATE
40    PUBLIC coriolis, coriolis_acc
41
42    INTERFACE coriolis
43       MODULE PROCEDURE coriolis
44       MODULE PROCEDURE coriolis_ij
45    END INTERFACE coriolis
46
47    INTERFACE coriolis_acc
48       MODULE PROCEDURE coriolis_acc
49    END INTERFACE coriolis_acc
50
51 CONTAINS
52
53
54!------------------------------------------------------------------------------!
55! Call for all grid points
56!------------------------------------------------------------------------------!
57    SUBROUTINE coriolis( component )
58
59       USE arrays_3d
60       USE control_parameters
61       USE indices
62       USE pegrid
63
64       IMPLICIT NONE
65
66       INTEGER ::  component, i, j, k
67
68
69!
70!--    Compute Coriolis terms for the three velocity components
71       SELECT CASE ( component )
72
73!
74!--       u-component
75          CASE ( 1 )
76             DO  i = nxlu, nxr
77                DO  j = nys, nyn
78                   DO  k = nzb_u_inner(j,i)+1, nzt
79                      tend(k,j,i) = tend(k,j,i) + f  *    ( 0.25 *            &
80                                   ( v(k,j,i-1) + v(k,j,i) + v(k,j+1,i-1) +   &
81                                     v(k,j+1,i) ) - vg(k) )                   &
82                                             - fs *    ( 0.25 *               &
83                                   ( w(k-1,j,i-1) + w(k-1,j,i) + w(k,j,i-1) + &
84                                     w(k,j,i)   ) &
85                                                          )
86                   ENDDO
87                ENDDO
88             ENDDO
89
90!
91!--       v-component
92          CASE ( 2 )
93             DO  i = nxl, nxr
94                DO  j = nysv, nyn
95                   DO  k = nzb_v_inner(j,i)+1, nzt
96                      tend(k,j,i) = tend(k,j,i) - f *     ( 0.25 *          &
97                                   ( u(k,j-1,i) + u(k,j,i) + u(k,j-1,i+1) + &
98                                     u(k,j,i+1) ) - ug(k) )
99                   ENDDO
100                ENDDO
101             ENDDO
102
103!
104!--       w-component
105          CASE ( 3 )
106             DO  i = nxl, nxr
107                DO  j = nys, nyn
108                   DO  k = nzb_w_inner(j,i)+1, nzt
109                      tend(k,j,i) = tend(k,j,i) + fs * 0.25 *             &
110                                   ( u(k,j,i) + u(k+1,j,i) + u(k,j,i+1) + &
111                                     u(k+1,j,i+1) )
112                   ENDDO
113                ENDDO
114             ENDDO
115
116          CASE DEFAULT
117
118             WRITE( message_string, * ) ' wrong component: ', component
119             CALL message( 'coriolis', 'PA0173', 1, 2, 0, 6, 0 )
120
121       END SELECT
122
123    END SUBROUTINE coriolis
124
125
126!------------------------------------------------------------------------------!
127! Call for all grid points - accelerator version
128!------------------------------------------------------------------------------!
129    SUBROUTINE coriolis_acc( component )
130
131       USE arrays_3d
132       USE control_parameters
133       USE indices
134       USE pegrid
135
136       IMPLICIT NONE
137
138       INTEGER ::  component, i, j, k
139
140
141!
142!--    Compute Coriolis terms for the three velocity components
143       SELECT CASE ( component )
144
145!
146!--       u-component
147          CASE ( 1 )
148             !$acc  kernels present( nzb_u_inner, tend, v, vg, w )
149             !$acc  loop
150             DO  i = nxlu, nxr
151                DO  j = nys, nyn
152                   !$acc loop vector( 32 )
153                   DO  k = 1, nzt
154                      IF  ( k > nzb_u_inner(j,i) )  THEN
155                         tend(k,j,i) = tend(k,j,i) + f  *    ( 0.25 *          &
156                                      ( v(k,j,i-1) + v(k,j,i) + v(k,j+1,i-1) + &
157                                        v(k,j+1,i) ) - vg(k) )                 &
158                                                - fs *    ( 0.25 *             &
159                                      ( w(k-1,j,i-1) + w(k-1,j,i) + w(k,j,i-1) &
160                                        + w(k,j,i)   )                         &
161                                                             )
162                      ENDIF
163                   ENDDO
164                ENDDO
165             ENDDO
166             !$acc end kernels
167
168!
169!--       v-component
170          CASE ( 2 )
171             !$acc  kernels present( nzb_v_inner, tend, u, ug )
172             !$acc  loop
173             DO  i = nxl, nxr
174                DO  j = nysv, nyn
175                   !$acc loop vector( 32 )
176                   DO  k = 1, nzt
177                      IF  ( k > nzb_v_inner(j,i) )  THEN
178                         tend(k,j,i) = tend(k,j,i) - f *     ( 0.25 *          &
179                                      ( u(k,j-1,i) + u(k,j,i) + u(k,j-1,i+1) + &
180                                        u(k,j,i+1) ) - ug(k) )
181                      ENDIF
182                   ENDDO
183                ENDDO
184             ENDDO
185             !$acc end kernels
186
187!
188!--       w-component
189          CASE ( 3 )
190             !$acc  kernels present( nzb_w_inner, tend, u )
191             !$acc  loop
192             DO  i = nxl, nxr
193                DO  j = nys, nyn
194                   !$acc loop vector( 32 )
195                   DO  k = 1, nzt
196                      IF  ( k > nzb_w_inner(j,i) )  THEN
197                         tend(k,j,i) = tend(k,j,i) + fs * 0.25 *             &
198                                      ( u(k,j,i) + u(k+1,j,i) + u(k,j,i+1) + &
199                                        u(k+1,j,i+1) )
200                      ENDIF
201                   ENDDO
202                ENDDO
203             ENDDO
204             !$acc end kernels
205
206          CASE DEFAULT
207
208             WRITE( message_string, * ) ' wrong component: ', component
209             CALL message( 'coriolis', 'PA0173', 1, 2, 0, 6, 0 )
210
211       END SELECT
212
213    END SUBROUTINE coriolis_acc
214
215
216!------------------------------------------------------------------------------!
217! Call for grid point i,j
218!------------------------------------------------------------------------------!
219    SUBROUTINE coriolis_ij( i, j, component )
220
221       USE arrays_3d
222       USE control_parameters
223       USE indices
224       USE pegrid
225
226       IMPLICIT NONE
227
228       INTEGER ::  component, i, j, k
229
230!
231!--    Compute Coriolis terms for the three velocity components
232       SELECT CASE ( component )
233
234!
235!--       u-component
236          CASE ( 1 )
237             DO  k = nzb_u_inner(j,i)+1, nzt
238                tend(k,j,i) = tend(k,j,i) + f  *    ( 0.25 *               &
239                                ( v(k,j,i-1) + v(k,j,i) + v(k,j+1,i-1) +   &
240                                  v(k,j+1,i) ) - vg(k) )                   &
241                                          - fs *    ( 0.25 *               &
242                                ( w(k-1,j,i-1) + w(k-1,j,i) + w(k,j,i-1) + &
243                                  w(k,j,i)   ) &
244                                                    )
245             ENDDO
246
247!
248!--       v-component
249          CASE ( 2 )
250             DO  k = nzb_v_inner(j,i)+1, nzt
251                tend(k,j,i) = tend(k,j,i) - f *     ( 0.25 *             &
252                                ( u(k,j-1,i) + u(k,j,i) + u(k,j-1,i+1) + &
253                                  u(k,j,i+1) ) - ug(k) )
254             ENDDO
255
256!
257!--       w-component
258          CASE ( 3 )
259             DO  k = nzb_w_inner(j,i)+1, nzt
260                tend(k,j,i) = tend(k,j,i) + fs * 0.25 * &
261                                ( u(k,j,i) + u(k+1,j,i) + u(k,j,i+1) + &
262                                  u(k+1,j,i+1) )
263             ENDDO
264
265          CASE DEFAULT
266
267             WRITE( message_string, * ) ' wrong component: ', component
268             CALL message( 'coriolis', 'PA0173', 1, 2, 0, 6, 0 )
269
270       END SELECT
271
272    END SUBROUTINE coriolis_ij
273
274 END MODULE coriolis_mod
Note: See TracBrowser for help on using the repository browser.