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

Last change on this file since 2017 was 2001, checked in by knoop, 8 years ago

last commit documented

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