source: palm/trunk/SOURCE/diffusion_s.f90 @ 1257

Last change on this file since 1257 was 1257, checked in by raasch, 8 years ago

New:
---

openACC porting of timestep calculation
(modules, timestep, time_integration)

Changed:


openACC loop directives and vector clauses removed (because they do not give any performance improvement with PGI
compiler versions > 13.6)
(advec_ws, buoyancy, coriolis, diffusion_e, diffusion_s, diffusion_u, diffusion_v, diffusion_w, diffusivities, exchange_horiz, fft_xy, pres, production_e, transpose, tridia_solver, wall_fluxes)

openACC loop independent clauses added
(boundary_conds, prandtl_fluxes, pres)

openACC declare create statements moved after FORTRAN declaration statement
(diffusion_u, diffusion_v, diffusion_w, fft_xy, poisfft, production_e, tridia_solver)

openACC end parallel replaced by end parallel loop
(flow_statistics, pres)

openACC "kernels do" replaced by "kernels loop"
(prandtl_fluxes)

output format for theta* changed to avoid output of *
(run_control)

Errors:


bugfix for calculation of advective timestep (old version may cause wrong timesteps in case of
vertixcally stretched grids)
Attention: standard run-control output has changed!
(timestep)

  • Property svn:keywords set to Id
File size: 17.7 KB
Line 
1 MODULE diffusion_s_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-2012  Leibniz University Hannover
18!--------------------------------------------------------------------------------!
19!
20! Current revisions:
21! ------------------
22! openacc loop and loop vector clauses removed
23!
24! Former revisions:
25! -----------------
26! $Id: diffusion_s.f90 1257 2013-11-08 15:18:40Z raasch $
27!
28! 1128 2013-04-12 06:19:32Z raasch
29! loop index bounds in accelerator version replaced by i_left, i_right, j_south,
30! j_north
31!
32! 1092 2013-02-02 11:24:22Z raasch
33! unused variables removed
34!
35! 1036 2012-10-22 13:43:42Z raasch
36! code put under GPL (PALM 3.9)
37!
38! 1015 2012-09-27 09:23:24Z raasch
39! accelerator version (*_acc) added
40!
41! 1010 2012-09-20 07:59:54Z raasch
42! cpp switch __nopointer added for pointer free version
43!
44! 1001 2012-09-13 14:08:46Z raasch
45! some arrays comunicated by module instead of parameter list
46!
47! 667 2010-12-23 12:06:00Z suehring/gryschka
48! nxl-1, nxr+1, nys-1, nyn+1 replaced by nxlg, nxrg, nysg, nyng
49!
50! 183 2008-08-04 15:39:12Z letzel
51! bugfix: calculation of fluxes at vertical surfaces
52!
53! 129 2007-10-30 12:12:24Z letzel
54! replace wall_heatflux by wall_s_flux that is now included in the parameter
55! list, bugfix for assignment of fluxes at walls
56!
57! 20 2007-02-26 00:12:32Z raasch
58! Bugfix: ddzw dimensioned 1:nzt"+1"
59! Calculation extended for gridpoint nzt, fluxes can be given at top,
60! +s_flux_t in parameter list, s_flux renamed s_flux_b
61!
62! RCS Log replace by Id keyword, revision history cleaned up
63!
64! Revision 1.8  2006/02/23 10:34:17  raasch
65! nzb_2d replaced by nzb_s_outer in horizontal diffusion and by nzb_s_inner
66! or nzb_diff_s_inner, respectively, in vertical diffusion, prescribed surface
67! fluxes at vertically oriented topography
68!
69! Revision 1.1  2000/04/13 14:54:02  schroeter
70! Initial revision
71!
72!
73! Description:
74! ------------
75! Diffusion term of scalar quantities (temperature and water content)
76!------------------------------------------------------------------------------!
77
78    PRIVATE
79    PUBLIC diffusion_s, diffusion_s_acc
80
81    INTERFACE diffusion_s
82       MODULE PROCEDURE diffusion_s
83       MODULE PROCEDURE diffusion_s_ij
84    END INTERFACE diffusion_s
85
86    INTERFACE diffusion_s_acc
87       MODULE PROCEDURE diffusion_s_acc
88    END INTERFACE diffusion_s_acc
89
90 CONTAINS
91
92
93!------------------------------------------------------------------------------!
94! Call for all grid points
95!------------------------------------------------------------------------------!
96    SUBROUTINE diffusion_s( s, s_flux_b, s_flux_t, wall_s_flux )
97
98       USE arrays_3d
99       USE control_parameters
100       USE grid_variables
101       USE indices
102
103       IMPLICIT NONE
104
105       INTEGER ::  i, j, k
106       REAL    ::  wall_s_flux(0:4)
107       REAL, DIMENSION(nysg:nyng,nxlg:nxrg) ::  s_flux_b, s_flux_t
108#if defined( __nopointer )
109       REAL, DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ::  s
110#else
111       REAL, DIMENSION(:,:,:), POINTER ::  s
112#endif
113
114       DO  i = nxl, nxr
115          DO  j = nys,nyn
116!
117!--          Compute horizontal diffusion
118             DO  k = nzb_s_outer(j,i)+1, nzt
119
120                tend(k,j,i) = tend(k,j,i)                                     &
121                                          + 0.5 * (                           &
122                        ( kh(k,j,i) + kh(k,j,i+1) ) * ( s(k,j,i+1)-s(k,j,i) ) &
123                      - ( kh(k,j,i) + kh(k,j,i-1) ) * ( s(k,j,i)-s(k,j,i-1) ) &
124                                                  ) * ddx2                    &
125                                          + 0.5 * (                           &
126                        ( kh(k,j,i) + kh(k,j+1,i) ) * ( s(k,j+1,i)-s(k,j,i) ) &
127                      - ( kh(k,j,i) + kh(k,j-1,i) ) * ( s(k,j,i)-s(k,j-1,i) ) &
128                                                  ) * ddy2
129             ENDDO
130
131!
132!--          Apply prescribed horizontal wall heatflux where necessary
133             IF ( ( wall_w_x(j,i) .NE. 0.0 ) .OR. ( wall_w_y(j,i) .NE. 0.0 ) ) &
134             THEN
135                DO  k = nzb_s_inner(j,i)+1, nzb_s_outer(j,i)
136
137                   tend(k,j,i) = tend(k,j,i)                                  &
138                                                + ( fwxp(j,i) * 0.5 *         &
139                        ( kh(k,j,i) + kh(k,j,i+1) ) * ( s(k,j,i+1)-s(k,j,i) ) &
140                        + ( 1.0 - fwxp(j,i) ) * wall_s_flux(1)                &
141                                                   -fwxm(j,i) * 0.5 *         &
142                        ( kh(k,j,i) + kh(k,j,i-1) ) * ( s(k,j,i)-s(k,j,i-1) ) &
143                        + ( 1.0 - fwxm(j,i) ) * wall_s_flux(2)                &
144                                                  ) * ddx2                    &
145                                                + ( fwyp(j,i) * 0.5 *         &
146                        ( kh(k,j,i) + kh(k,j+1,i) ) * ( s(k,j+1,i)-s(k,j,i) ) &
147                        + ( 1.0 - fwyp(j,i) ) * wall_s_flux(3)                &
148                                                   -fwym(j,i) * 0.5 *         &
149                        ( kh(k,j,i) + kh(k,j-1,i) ) * ( s(k,j,i)-s(k,j-1,i) ) &
150                        + ( 1.0 - fwym(j,i) ) * wall_s_flux(4)                &
151                                                  ) * ddy2
152                ENDDO
153             ENDIF
154
155!
156!--          Compute vertical diffusion. In case that surface fluxes have been
157!--          prescribed or computed at bottom and/or top, index k starts/ends at
158!--          nzb+2 or nzt-1, respectively.
159             DO  k = nzb_diff_s_inner(j,i), nzt_diff
160
161                tend(k,j,i) = tend(k,j,i)                                     &
162                                       + 0.5 * (                              &
163            ( kh(k,j,i) + kh(k+1,j,i) ) * ( s(k+1,j,i)-s(k,j,i) ) * ddzu(k+1) &
164          - ( kh(k,j,i) + kh(k-1,j,i) ) * ( s(k,j,i)-s(k-1,j,i) ) * ddzu(k)   &
165                                               ) * ddzw(k)
166             ENDDO
167
168!
169!--          Vertical diffusion at the first computational gridpoint along
170!--          z-direction
171             IF ( use_surface_fluxes )  THEN
172
173                k = nzb_s_inner(j,i)+1
174
175                tend(k,j,i) = tend(k,j,i)                                     &
176                                       + ( 0.5 * ( kh(k,j,i)+kh(k+1,j,i) )    &
177                                               * ( s(k+1,j,i)-s(k,j,i) )      &
178                                               * ddzu(k+1)                    &
179                                           + s_flux_b(j,i)                    &
180                                         ) * ddzw(k)
181
182             ENDIF
183
184!
185!--          Vertical diffusion at the last computational gridpoint along
186!--          z-direction
187             IF ( use_top_fluxes )  THEN
188
189                k = nzt
190
191                tend(k,j,i) = tend(k,j,i)                                     &
192                                       + ( - s_flux_t(j,i)                    &
193                                           - 0.5 * ( kh(k-1,j,i)+kh(k,j,i) )  &
194                                                 * ( s(k,j,i)-s(k-1,j,i) )    &
195                                                 * ddzu(k)                    &
196                                         ) * ddzw(k)
197
198             ENDIF
199
200          ENDDO
201       ENDDO
202
203    END SUBROUTINE diffusion_s
204
205
206!------------------------------------------------------------------------------!
207! Call for all grid points - accelerator version
208!------------------------------------------------------------------------------!
209    SUBROUTINE diffusion_s_acc( s, s_flux_b, s_flux_t, wall_s_flux )
210
211       USE arrays_3d
212       USE control_parameters
213       USE grid_variables
214       USE indices
215
216       IMPLICIT NONE
217
218       INTEGER ::  i, j, k
219       REAL    ::  wall_s_flux(0:4)
220       REAL, DIMENSION(nysg:nyng,nxlg:nxrg) ::  s_flux_b, s_flux_t
221#if defined( __nopointer )
222       REAL, DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ::  s
223#else
224       REAL, DIMENSION(:,:,:), POINTER ::  s
225#endif
226
227       !$acc kernels present( ddzu, ddzw, fwxm, fwxp, fwym, fwyp, kh )        &
228       !$acc         present( nzb_diff_s_inner, nzb_s_inner, nzb_s_outer, s ) &
229       !$acc         present( s_flux_b, s_flux_t, tend, wall_s_flux )         &
230       !$acc         present( wall_w_x, wall_w_y )
231       DO  i = i_left, i_right
232          DO  j = j_south, j_north
233!
234!--          Compute horizontal diffusion
235             DO  k = 1, nzt
236                IF ( k > nzb_s_outer(j,i) )  THEN
237
238                   tend(k,j,i) = tend(k,j,i)                                  &
239                                          + 0.5 * (                           &
240                        ( kh(k,j,i) + kh(k,j,i+1) ) * ( s(k,j,i+1)-s(k,j,i) ) &
241                      - ( kh(k,j,i) + kh(k,j,i-1) ) * ( s(k,j,i)-s(k,j,i-1) ) &
242                                                  ) * ddx2                    &
243                                          + 0.5 * (                           &
244                        ( kh(k,j,i) + kh(k,j+1,i) ) * ( s(k,j+1,i)-s(k,j,i) ) &
245                      - ( kh(k,j,i) + kh(k,j-1,i) ) * ( s(k,j,i)-s(k,j-1,i) ) &
246                                                  ) * ddy2
247                ENDIF
248             ENDDO
249
250!
251!--          Apply prescribed horizontal wall heatflux where necessary
252             DO  k = 1, nzt
253                IF ( k > nzb_s_inner(j,i)  .AND.  k <= nzb_s_outer(j,i)  .AND. &
254                     ( wall_w_x(j,i) /= 0.0  .OR.  wall_w_y(j,i) /= 0.0 ) )    &
255                THEN
256                   tend(k,j,i) = tend(k,j,i)                                  &
257                                                + ( fwxp(j,i) * 0.5 *         &
258                        ( kh(k,j,i) + kh(k,j,i+1) ) * ( s(k,j,i+1)-s(k,j,i) ) &
259                        + ( 1.0 - fwxp(j,i) ) * wall_s_flux(1)                &
260                                                   -fwxm(j,i) * 0.5 *         &
261                        ( kh(k,j,i) + kh(k,j,i-1) ) * ( s(k,j,i)-s(k,j,i-1) ) &
262                        + ( 1.0 - fwxm(j,i) ) * wall_s_flux(2)                &
263                                                  ) * ddx2                    &
264                                                + ( fwyp(j,i) * 0.5 *         &
265                        ( kh(k,j,i) + kh(k,j+1,i) ) * ( s(k,j+1,i)-s(k,j,i) ) &
266                        + ( 1.0 - fwyp(j,i) ) * wall_s_flux(3)                &
267                                                   -fwym(j,i) * 0.5 *         &
268                        ( kh(k,j,i) + kh(k,j-1,i) ) * ( s(k,j,i)-s(k,j-1,i) ) &
269                        + ( 1.0 - fwym(j,i) ) * wall_s_flux(4)                &
270                                                  ) * ddy2
271                ENDIF
272             ENDDO
273
274!
275!--          Compute vertical diffusion. In case that surface fluxes have been
276!--          prescribed or computed at bottom and/or top, index k starts/ends at
277!--          nzb+2 or nzt-1, respectively.
278             DO  k = 1, nzt_diff
279                IF ( k >= nzb_diff_s_inner(j,i) )  THEN
280                   tend(k,j,i) = tend(k,j,i)                                  &
281                                       + 0.5 * (                              &
282            ( kh(k,j,i) + kh(k+1,j,i) ) * ( s(k+1,j,i)-s(k,j,i) ) * ddzu(k+1) &
283          - ( kh(k,j,i) + kh(k-1,j,i) ) * ( s(k,j,i)-s(k-1,j,i) ) * ddzu(k)   &
284                                               ) * ddzw(k)
285                ENDIF
286             ENDDO
287
288!
289!--          Vertical diffusion at the first computational gridpoint along
290!--          z-direction
291             DO  k = 1, nzt
292                IF ( use_surface_fluxes  .AND.  k == nzb_s_inner(j,i)+1 )  THEN
293                   tend(k,j,i) = tend(k,j,i)                                  &
294                                          + ( 0.5 * ( kh(k,j,i)+kh(k+1,j,i) ) &
295                                                  * ( s(k+1,j,i)-s(k,j,i) )   &
296                                                  * ddzu(k+1)                 &
297                                              + s_flux_b(j,i)                 &
298                                            ) * ddzw(k)
299                ENDIF
300
301!
302!--             Vertical diffusion at the last computational gridpoint along
303!--             z-direction
304                IF ( use_top_fluxes  .AND.  k == nzt )  THEN
305                   tend(k,j,i) = tend(k,j,i)                                   &
306                                          + ( - s_flux_t(j,i)                  &
307                                              - 0.5 * ( kh(k-1,j,i)+kh(k,j,i) )&
308                                                    * ( s(k,j,i)-s(k-1,j,i) )  &
309                                                    * ddzu(k)                  &
310                                            ) * ddzw(k)
311                ENDIF
312             ENDDO
313
314          ENDDO
315       ENDDO
316       !$acc end kernels
317
318    END SUBROUTINE diffusion_s_acc
319
320
321!------------------------------------------------------------------------------!
322! Call for grid point i,j
323!------------------------------------------------------------------------------!
324    SUBROUTINE diffusion_s_ij( i, j, s, s_flux_b, s_flux_t, wall_s_flux )
325
326       USE arrays_3d
327       USE control_parameters
328       USE grid_variables
329       USE indices
330
331       IMPLICIT NONE
332
333       INTEGER ::  i, j, k
334       REAL    ::  wall_s_flux(0:4)
335       REAL, DIMENSION(nysg:nyng,nxlg:nxrg) ::  s_flux_b, s_flux_t
336#if defined( __nopointer )
337       REAL, DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ::  s
338#else
339       REAL, DIMENSION(:,:,:), POINTER ::  s
340#endif
341
342!
343!--    Compute horizontal diffusion
344       DO  k = nzb_s_outer(j,i)+1, nzt
345
346          tend(k,j,i) = tend(k,j,i)                                           &
347                                          + 0.5 * (                           &
348                        ( kh(k,j,i) + kh(k,j,i+1) ) * ( s(k,j,i+1)-s(k,j,i) ) &
349                      - ( kh(k,j,i) + kh(k,j,i-1) ) * ( s(k,j,i)-s(k,j,i-1) ) &
350                                                  ) * ddx2                    &
351                                          + 0.5 * (                           &
352                        ( kh(k,j,i) + kh(k,j+1,i) ) * ( s(k,j+1,i)-s(k,j,i) ) &
353                      - ( kh(k,j,i) + kh(k,j-1,i) ) * ( s(k,j,i)-s(k,j-1,i) ) &
354                                                  ) * ddy2
355       ENDDO
356
357!
358!--    Apply prescribed horizontal wall heatflux where necessary
359       IF ( ( wall_w_x(j,i) .NE. 0.0 ) .OR. ( wall_w_y(j,i) .NE. 0.0 ) ) &
360       THEN
361          DO  k = nzb_s_inner(j,i)+1, nzb_s_outer(j,i)
362
363             tend(k,j,i) = tend(k,j,i)                                        &
364                                                + ( fwxp(j,i) * 0.5 *         &
365                        ( kh(k,j,i) + kh(k,j,i+1) ) * ( s(k,j,i+1)-s(k,j,i) ) &
366                        + ( 1.0 - fwxp(j,i) ) * wall_s_flux(1)                &
367                                                   -fwxm(j,i) * 0.5 *         &
368                        ( kh(k,j,i) + kh(k,j,i-1) ) * ( s(k,j,i)-s(k,j,i-1) ) &
369                        + ( 1.0 - fwxm(j,i) ) * wall_s_flux(2)                &
370                                                  ) * ddx2                    &
371                                                + ( fwyp(j,i) * 0.5 *         &
372                        ( kh(k,j,i) + kh(k,j+1,i) ) * ( s(k,j+1,i)-s(k,j,i) ) &
373                        + ( 1.0 - fwyp(j,i) ) * wall_s_flux(3)                &
374                                                   -fwym(j,i) * 0.5 *         &
375                        ( kh(k,j,i) + kh(k,j-1,i) ) * ( s(k,j,i)-s(k,j-1,i) ) &
376                        + ( 1.0 - fwym(j,i) ) * wall_s_flux(4)                &
377                                                  ) * ddy2
378          ENDDO
379       ENDIF
380
381!
382!--    Compute vertical diffusion. In case that surface fluxes have been
383!--    prescribed or computed at bottom and/or top, index k starts/ends at
384!--    nzb+2 or nzt-1, respectively.
385       DO  k = nzb_diff_s_inner(j,i), nzt_diff
386
387          tend(k,j,i) = tend(k,j,i)                                           &
388                                       + 0.5 * (                              &
389            ( kh(k,j,i) + kh(k+1,j,i) ) * ( s(k+1,j,i)-s(k,j,i) ) * ddzu(k+1) &
390          - ( kh(k,j,i) + kh(k-1,j,i) ) * ( s(k,j,i)-s(k-1,j,i) ) * ddzu(k)   &
391                                               ) * ddzw(k)
392       ENDDO
393
394!
395!--    Vertical diffusion at the first computational gridpoint along z-direction
396       IF ( use_surface_fluxes )  THEN
397
398          k = nzb_s_inner(j,i)+1
399
400          tend(k,j,i) = tend(k,j,i) + ( 0.5 * ( kh(k,j,i)+kh(k+1,j,i) )  &
401                                            * ( s(k+1,j,i)-s(k,j,i) )    &
402                                            * ddzu(k+1)                  &
403                                        + s_flux_b(j,i)                  &
404                                      ) * ddzw(k)
405
406       ENDIF
407
408!
409!--    Vertical diffusion at the last computational gridpoint along z-direction
410       IF ( use_top_fluxes )  THEN
411
412          k = nzt
413
414          tend(k,j,i) = tend(k,j,i) + ( - s_flux_t(j,i)                  &
415                                      - 0.5 * ( kh(k-1,j,i)+kh(k,j,i) )  &
416                                            * ( s(k,j,i)-s(k-1,j,i) )    &
417                                            * ddzu(k)                    &
418                                      ) * ddzw(k)
419
420       ENDIF
421
422    END SUBROUTINE diffusion_s_ij
423
424 END MODULE diffusion_s_mod
Note: See TracBrowser for help on using the repository browser.