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

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

asynchronous transfer of ghost point data for acc-optimized version

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