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

Last change on this file since 1340 was 1340, checked in by kanani, 10 years ago

REAL constants defined as wp-kind

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