source: palm/trunk/SOURCE/diffusion_s_mod.f90 @ 1867

Last change on this file since 1867 was 1851, checked in by maronga, 9 years ago

last commit documented

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