source: palm/trunk/SOURCE/diffusion_w.f90 @ 2118

Last change on this file since 2118 was 2118, checked in by raasch, 4 years ago

all OpenACC directives and related parts removed from the code

  • Property svn:keywords set to Id
File size: 16.5 KB
Line 
1!> @file diffusion_w.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-2017 Leibniz Universitaet Hannover
18!------------------------------------------------------------------------------!
19!
20! Current revisions:
21! -----------------
22! OpenACC version of subroutine removed
23!
24! Former revisions:
25! -----------------
26! $Id: diffusion_w.f90 2118 2017-01-17 16:38:49Z raasch $
27!
28! 2037 2016-10-26 11:15:40Z knoop
29! Anelastic approximation implemented
30!
31! 2000 2016-08-20 18:09:15Z knoop
32! Forced header and separation lines into 80 columns
33!
34! 1873 2016-04-18 14:50:06Z maronga
35! Module renamed (removed _mod)
36!
37! 1850 2016-04-08 13:29:27Z maronga
38! Module renamed
39!
40! 1682 2015-10-07 23:56:08Z knoop
41! Code annotations made doxygen readable
42!
43! 1374 2014-04-25 12:55:07Z raasch
44! vsws + vswst removed from acc-present-list
45!
46! 1353 2014-04-08 15:21:23Z heinze
47! REAL constants provided with KIND-attribute
48!
49! 1340 2014-03-25 19:45:13Z kanani
50! REAL constants defined as wp-kind
51!
52! 1322 2014-03-20 16:38:49Z raasch
53! REAL constants defined as wp-kind
54!
55! 1320 2014-03-20 08:40:49Z raasch
56! ONLY-attribute added to USE-statements,
57! kind-parameters added to all INTEGER and REAL declaration statements,
58! kinds are defined in new module kinds,
59! revision history before 2012 removed,
60! comment fields (!:) to be used for variable explanations added to
61! all variable declaration statements
62!
63! 1257 2013-11-08 15:18:40Z raasch
64! openacc loop and loop vector clauses removed, declare create moved after
65! the FORTRAN declaration statement
66!
67! 1128 2013-04-12 06:19:32Z raasch
68! loop index bounds in accelerator version replaced by i_left, i_right, j_south,
69! j_north
70!
71! 1036 2012-10-22 13:43:42Z raasch
72! code put under GPL (PALM 3.9)
73!
74! 1015 2012-09-27 09:23:24Z raasch
75! accelerator version (*_acc) added
76!
77! 1001 2012-09-13 14:08:46Z raasch
78! arrays comunicated by module instead of parameter list
79!
80! 978 2012-08-09 08:28:32Z fricke
81! outflow damping layer removed
82! kmxm_x/_z and kmxp_x/_z change to kmxm and kmxp
83! kmym_y/_z and kmyp_y/_z change to kmym and kmyp
84!
85! Revision 1.1  1997/09/12 06:24:11  raasch
86! Initial revision
87!
88!
89! Description:
90! ------------
91!> Diffusion term of the w-component
92!------------------------------------------------------------------------------!
93 MODULE diffusion_w_mod
94 
95
96    USE wall_fluxes_mod,                                                       &
97        ONLY :  wall_fluxes
98
99    PRIVATE
100    PUBLIC diffusion_w
101
102    INTERFACE diffusion_w
103       MODULE PROCEDURE diffusion_w
104       MODULE PROCEDURE diffusion_w_ij
105    END INTERFACE diffusion_w
106
107 CONTAINS
108
109
110!------------------------------------------------------------------------------!
111! Description:
112! ------------
113!> Call for all grid points
114!------------------------------------------------------------------------------!
115    SUBROUTINE diffusion_w
116
117       USE arrays_3d,                                                          &         
118           ONLY :  ddzu, ddzw, km, tend, u, v, w, drho_air_zw, rho_air
119           
120       USE control_parameters,                                                 & 
121           ONLY :  topography
122           
123       USE grid_variables,                                                     &     
124           ONLY :  ddx, ddy, fwxm, fwxp, fwym, fwyp, wall_w_x, wall_w_y
125           
126       USE indices,                                                            &           
127           ONLY :  nxl, nxr, nyn, nys, nzb, nzb_w_inner, nzb_w_outer, nzt
128           
129       USE kinds
130
131       IMPLICIT NONE
132
133       INTEGER(iwp) ::  i     !<
134       INTEGER(iwp) ::  j     !<
135       INTEGER(iwp) ::  k     !<
136       
137       REAL(wp) ::  kmxm  !<
138       REAL(wp) ::  kmxp  !<
139       REAL(wp) ::  kmym  !<
140       REAL(wp) ::  kmyp  !<
141
142       REAL(wp), DIMENSION(nzb:nzt+1,nys:nyn,nxl:nxr) ::  wsus  !<
143       REAL(wp), DIMENSION(nzb:nzt+1,nys:nyn,nxl:nxr) ::  wsvs  !<
144
145
146!
147!--    First calculate horizontal momentum flux w'u' and/or w'v' at vertical
148!--    walls, if neccessary
149       IF ( topography /= 'flat' )  THEN
150          CALL wall_fluxes( wsus, 0.0_wp, 0.0_wp, 0.0_wp, 1.0_wp, nzb_w_inner,             &
151                            nzb_w_outer, wall_w_x )
152          CALL wall_fluxes( wsvs, 0.0_wp, 0.0_wp, 1.0_wp, 0.0_wp, nzb_w_inner,             &
153                            nzb_w_outer, wall_w_y )
154       ENDIF
155
156       DO  i = nxl, nxr
157          DO  j = nys, nyn
158             DO  k = nzb_w_outer(j,i)+1, nzt-1
159!
160!--             Interpolate eddy diffusivities on staggered gridpoints
161                kmxp = 0.25_wp *                                               &
162                       ( km(k,j,i)+km(k,j,i+1)+km(k+1,j,i)+km(k+1,j,i+1) )
163                kmxm = 0.25_wp *                                               &
164                       ( km(k,j,i)+km(k,j,i-1)+km(k+1,j,i)+km(k+1,j,i-1) )
165                kmyp = 0.25_wp *                                               &
166                       ( km(k,j,i)+km(k+1,j,i)+km(k,j+1,i)+km(k+1,j+1,i) )
167                kmym = 0.25_wp *                                               &
168                       ( km(k,j,i)+km(k+1,j,i)+km(k,j-1,i)+km(k+1,j-1,i) )
169
170                tend(k,j,i) = tend(k,j,i)                                      &
171                      & + ( kmxp * ( w(k,j,i+1)   - w(k,j,i)   ) * ddx         &
172                      &   + kmxp * ( u(k+1,j,i+1) - u(k,j,i+1) ) * ddzu(k+1)   &
173                      &   - kmxm * ( w(k,j,i)   - w(k,j,i-1) ) * ddx           &
174                      &   - kmxm * ( u(k+1,j,i) - u(k,j,i)   ) * ddzu(k+1)     &
175                      &   ) * ddx                                              &
176                      & + ( kmyp * ( w(k,j+1,i)   - w(k,j,i)   ) * ddy         &
177                      &   + kmyp * ( v(k+1,j+1,i) - v(k,j+1,i) ) * ddzu(k+1)   &
178                      &   - kmym * ( w(k,j,i)   - w(k,j-1,i) ) * ddy           &
179                      &   - kmym * ( v(k+1,j,i) - v(k,j,i)   ) * ddzu(k+1)     &
180                      &   ) * ddy                                              &
181                      & + 2.0_wp * (                                           &
182                      &   km(k+1,j,i) * ( w(k+1,j,i) - w(k,j,i) ) * ddzw(k+1)  &
183                      &               * rho_air(k+1)                           &
184                      & - km(k,j,i)   * ( w(k,j,i)   - w(k-1,j,i) ) * ddzw(k)  &
185                      &               * rho_air(k)                             &
186                      &            ) * ddzu(k+1) * drho_air_zw(k)
187             ENDDO
188
189!
190!--          Wall functions at all vertical walls, where necessary
191             IF ( wall_w_x(j,i) /= 0.0_wp  .OR.  wall_w_y(j,i) /= 0.0_wp )  THEN
192
193                DO  k = nzb_w_inner(j,i)+1, nzb_w_outer(j,i)
194!
195!--                Interpolate eddy diffusivities on staggered gridpoints
196                   kmxp = 0.25_wp *                                            &
197                          ( km(k,j,i)+km(k,j,i+1)+km(k+1,j,i)+km(k+1,j,i+1) )
198                   kmxm = 0.25_wp *                                            &
199                          ( km(k,j,i)+km(k,j,i-1)+km(k+1,j,i)+km(k+1,j,i-1) )
200                   kmyp = 0.25_wp *                                            &
201                          ( km(k,j,i)+km(k+1,j,i)+km(k,j+1,i)+km(k+1,j+1,i) )
202                   kmym = 0.25_wp *                                            &
203                          ( km(k,j,i)+km(k+1,j,i)+km(k,j-1,i)+km(k+1,j-1,i) )
204
205                   tend(k,j,i) = tend(k,j,i)                                   &
206                                 + (   fwxp(j,i) * (                           &
207                            kmxp * ( w(k,j,i+1)   - w(k,j,i)   ) * ddx         &
208                          + kmxp * ( u(k+1,j,i+1) - u(k,j,i+1) ) * ddzu(k+1)   &
209                                                   )                           &
210                                     - fwxm(j,i) * (                           &
211                            kmxm * ( w(k,j,i)     - w(k,j,i-1) ) * ddx         &
212                          + kmxm * ( u(k+1,j,i)   - u(k,j,i)   ) * ddzu(k+1)   &
213                                                   )                           &
214                                     + wall_w_x(j,i) * wsus(k,j,i)             &
215                                   ) * ddx                                     &
216                                 + (   fwyp(j,i) * (                           &
217                            kmyp * ( w(k,j+1,i)   - w(k,j,i)   ) * ddy         &
218                          + kmyp * ( v(k+1,j+1,i) - v(k,j+1,i) ) * ddzu(k+1)   &
219                                                   )                           &
220                                     - fwym(j,i) * (                           &
221                            kmym * ( w(k,j,i)     - w(k,j-1,i) ) * ddy         &
222                          + kmym * ( v(k+1,j,i)   - v(k,j,i)   ) * ddzu(k+1)   &
223                                                   )                           &
224                                     + wall_w_y(j,i) * wsvs(k,j,i)             &
225                                   ) * ddy                                     &
226                                 + 2.0_wp * (                                  &
227                           km(k+1,j,i) * ( w(k+1,j,i) - w(k,j,i) ) * ddzw(k+1) &
228                                       * rho_air(k+1)                          &
229                         - km(k,j,i)   * ( w(k,j,i)   - w(k-1,j,i) ) * ddzw(k) &
230                                       * rho_air(k)                            &
231                                            ) * ddzu(k+1) * drho_air_zw(k)
232                ENDDO
233             ENDIF
234
235          ENDDO
236       ENDDO
237
238    END SUBROUTINE diffusion_w
239
240
241!------------------------------------------------------------------------------!
242! Description:
243! ------------
244!> Call for grid point i,j
245!------------------------------------------------------------------------------!
246    SUBROUTINE diffusion_w_ij( i, j )
247
248       USE arrays_3d,                                                          &         
249           ONLY :  ddzu, ddzw, km, tend, u, v, w, drho_air_zw, rho_air
250           
251       USE control_parameters,                                                 & 
252           ONLY :  topography
253           
254       USE grid_variables,                                                     &     
255           ONLY :  ddx, ddy, fwxm, fwxp, fwym, fwyp, wall_w_x, wall_w_y
256           
257       USE indices,                                                            &           
258           ONLY :  nxl, nxr, nyn, nys, nzb, nzb_w_inner, nzb_w_outer, nzt
259           
260       USE kinds
261
262       IMPLICIT NONE
263
264       INTEGER(iwp) ::  i     !<
265       INTEGER(iwp) ::  j     !<
266       INTEGER(iwp) ::  k     !<
267       
268       REAL(wp) ::  kmxm  !<
269       REAL(wp) ::  kmxp  !<
270       REAL(wp) ::  kmym  !<
271       REAL(wp) ::  kmyp  !<
272
273       REAL(wp), DIMENSION(nzb:nzt+1) ::  wsus
274       REAL(wp), DIMENSION(nzb:nzt+1) ::  wsvs
275
276
277       DO  k = nzb_w_outer(j,i)+1, nzt-1
278!
279!--       Interpolate eddy diffusivities on staggered gridpoints
280          kmxp = 0.25_wp * ( km(k,j,i)+km(k,j,i+1)+km(k+1,j,i)+km(k+1,j,i+1) )
281          kmxm = 0.25_wp * ( km(k,j,i)+km(k,j,i-1)+km(k+1,j,i)+km(k+1,j,i-1) )
282          kmyp = 0.25_wp * ( km(k,j,i)+km(k+1,j,i)+km(k,j+1,i)+km(k+1,j+1,i) )
283          kmym = 0.25_wp * ( km(k,j,i)+km(k+1,j,i)+km(k,j-1,i)+km(k+1,j-1,i) )
284
285          tend(k,j,i) = tend(k,j,i)                                            &
286                      & + ( kmxp * ( w(k,j,i+1)   - w(k,j,i)   ) * ddx         &
287                      &   + kmxp * ( u(k+1,j,i+1) - u(k,j,i+1) ) * ddzu(k+1)   &
288                      &   - kmxm * ( w(k,j,i)   - w(k,j,i-1) ) * ddx           &
289                      &   - kmxm * ( u(k+1,j,i) - u(k,j,i)   ) * ddzu(k+1)     &
290                      &   ) * ddx                                              &
291                      & + ( kmyp * ( w(k,j+1,i)   - w(k,j,i)   ) * ddy         &
292                      &   + kmyp * ( v(k+1,j+1,i) - v(k,j+1,i) ) * ddzu(k+1)   &
293                      &   - kmym * ( w(k,j,i)   - w(k,j-1,i) ) * ddy           &
294                      &   - kmym * ( v(k+1,j,i) - v(k,j,i)   ) * ddzu(k+1)     &
295                      &   ) * ddy                                              &
296                      & + 2.0_wp * (                                           &
297                      &   km(k+1,j,i) * ( w(k+1,j,i) - w(k,j,i) ) * ddzw(k+1)  &
298                      &               * rho_air(k+1)                           &
299                      & - km(k,j,i)   * ( w(k,j,i)   - w(k-1,j,i) ) * ddzw(k)  &
300                      &               * rho_air(k)                             &
301                      &            ) * ddzu(k+1) * drho_air_zw(k)
302       ENDDO
303
304!
305!--    Wall functions at all vertical walls, where necessary
306       IF ( wall_w_x(j,i) /= 0.0_wp  .OR.  wall_w_y(j,i) /= 0.0_wp )  THEN
307
308!
309!--       Calculate the horizontal momentum fluxes w'u' and/or w'v'
310          IF ( wall_w_x(j,i) /= 0.0_wp )  THEN
311             CALL wall_fluxes( i, j, nzb_w_inner(j,i)+1, nzb_w_outer(j,i),     &
312                               wsus, 0.0_wp, 0.0_wp, 0.0_wp, 1.0_wp )
313          ELSE
314             wsus = 0.0_wp
315          ENDIF
316
317          IF ( wall_w_y(j,i) /= 0.0_wp )  THEN
318             CALL wall_fluxes( i, j, nzb_w_inner(j,i)+1, nzb_w_outer(j,i),     &
319                               wsvs, 0.0_wp, 0.0_wp, 1.0_wp, 0.0_wp )
320          ELSE
321             wsvs = 0.0_wp
322          ENDIF
323
324          DO  k = nzb_w_inner(j,i)+1, nzb_w_outer(j,i)
325!
326!--          Interpolate eddy diffusivities on staggered gridpoints
327             kmxp = 0.25_wp * ( km(k,j,i)+km(k,j,i+1)+km(k+1,j,i)+km(k+1,j,i+1) )
328             kmxm = 0.25_wp * ( km(k,j,i)+km(k,j,i-1)+km(k+1,j,i)+km(k+1,j,i-1) )
329             kmyp = 0.25_wp * ( km(k,j,i)+km(k+1,j,i)+km(k,j+1,i)+km(k+1,j+1,i) )
330             kmym = 0.25_wp * ( km(k,j,i)+km(k+1,j,i)+km(k,j-1,i)+km(k+1,j-1,i) )
331
332             tend(k,j,i) = tend(k,j,i)                                         &
333                                 + (   fwxp(j,i) * (                           &
334                            kmxp * ( w(k,j,i+1)   - w(k,j,i)   ) * ddx         &
335                          + kmxp * ( u(k+1,j,i+1) - u(k,j,i+1) ) * ddzu(k+1)   &
336                                                   )                           &
337                                     - fwxm(j,i) * (                           &
338                            kmxm * ( w(k,j,i)     - w(k,j,i-1) ) * ddx         &
339                          + kmxm * ( u(k+1,j,i)   - u(k,j,i)   ) * ddzu(k+1)   &
340                                                   )                           &
341                                     + wall_w_x(j,i) * wsus(k)                 &
342                                   ) * ddx                                     &
343                                 + (   fwyp(j,i) * (                           &
344                            kmyp * ( w(k,j+1,i)   - w(k,j,i)   ) * ddy         &
345                          + kmyp * ( v(k+1,j+1,i) - v(k,j+1,i) ) * ddzu(k+1)   &
346                                                   )                           &
347                                     - fwym(j,i) * (                           &
348                            kmym * ( w(k,j,i)     - w(k,j-1,i) ) * ddy         &
349                          + kmym * ( v(k+1,j,i)   - v(k,j,i)   ) * ddzu(k+1)   &
350                                                   )                           &
351                                     + wall_w_y(j,i) * wsvs(k)                 &
352                                   ) * ddy                                     &
353                                 + 2.0_wp * (                                  &
354                           km(k+1,j,i) * ( w(k+1,j,i) - w(k,j,i) ) * ddzw(k+1) &
355                                       * rho_air(k+1)                          &
356                         - km(k,j,i)   * ( w(k,j,i)   - w(k-1,j,i) ) * ddzw(k) &
357                                       * rho_air(k)                            &
358                                            ) * ddzu(k+1) * drho_air_zw(k)
359          ENDDO
360       ENDIF
361
362    END SUBROUTINE diffusion_w_ij
363
364 END MODULE diffusion_w_mod
Note: See TracBrowser for help on using the repository browser.