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

Last change on this file since 1875 was 1874, checked in by maronga, 9 years ago

last commit documented

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