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

Last change on this file since 4090 was 3655, checked in by knoop, 6 years ago

Bugfix: made "unit" and "found" intend INOUT in module interface subroutines + automatic copyright update

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