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

Last change on this file since 2118 was 2118, checked in by raasch, 5 years ago

all OpenACC directives and related parts removed from the code

  • Property svn:keywords set to Id
File size: 14.7 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-2017 Leibniz Universitaet Hannover
18!------------------------------------------------------------------------------!
19!
20! Current revisions:
21! ------------------
22! OpenACC version of subroutine removed
23!
24! Former revisions:
25! -----------------
26! $Id: diffusion_s.f90 2118 2017-01-17 16:38:49Z raasch $
27!
28! 2037 2016-10-26 11:15:40Z knoop
29! Anelastic approximation implemented
30!
31! 2000 2016-08-20 18:09:15Z knoop
32! Forced header and separation lines into 80 columns
33!
34! 1873 2016-04-18 14:50:06Z maronga
35! Module renamed (removed _mod)
36!
37! 1850 2016-04-08 13:29:27Z maronga
38! Module renamed
39!
40! 1691 2015-10-26 16:17:44Z maronga
41! Formatting corrections.
42!
43! 1682 2015-10-07 23:56:08Z knoop
44! Code annotations made doxygen readable
45!
46! 1374 2014-04-25 12:55:07Z raasch
47! missing variables added to ONLY list
48!
49! 1340 2014-03-25 19:45:13Z kanani
50! REAL constants defined as wp-kind
51!
52! 1320 2014-03-20 08:40:49Z raasch
53! ONLY-attribute added to USE-statements,
54! kind-parameters added to all INTEGER and REAL declaration statements,
55! kinds are defined in new module kinds,
56! revision history before 2012 removed,
57! comment fields (!:) to be used for variable explanations added to
58! all variable declaration statements
59!
60! 1257 2013-11-08 15:18:40Z raasch
61! openacc loop and loop vector clauses removed
62!
63! 1128 2013-04-12 06:19:32Z raasch
64! loop index bounds in accelerator version replaced by i_left, i_right, j_south,
65! j_north
66!
67! 1092 2013-02-02 11:24:22Z raasch
68! unused variables removed
69!
70! 1036 2012-10-22 13:43:42Z raasch
71! code put under GPL (PALM 3.9)
72!
73! 1015 2012-09-27 09:23:24Z raasch
74! accelerator version (*_acc) added
75!
76! 1010 2012-09-20 07:59:54Z raasch
77! cpp switch __nopointer added for pointer free version
78!
79! 1001 2012-09-13 14:08:46Z raasch
80! some arrays comunicated by module instead of parameter list
81!
82! Revision 1.1  2000/04/13 14:54:02  schroeter
83! Initial revision
84!
85!
86! Description:
87! ------------
88!> Diffusion term of scalar quantities (temperature and water content)
89!------------------------------------------------------------------------------!
90 MODULE diffusion_s_mod
91 
92
93    PRIVATE
94    PUBLIC diffusion_s
95
96    INTERFACE diffusion_s
97       MODULE PROCEDURE diffusion_s
98       MODULE PROCEDURE diffusion_s_ij
99    END INTERFACE diffusion_s
100
101 CONTAINS
102
103
104!------------------------------------------------------------------------------!
105! Description:
106! ------------
107!> Call for all grid points
108!------------------------------------------------------------------------------!
109    SUBROUTINE diffusion_s( s, s_flux_b, s_flux_t, wall_s_flux )
110
111       USE arrays_3d,                                                          &
112           ONLY:  ddzu, ddzw, kh, tend, drho_air, rho_air_zw
113       
114       USE control_parameters,                                                 & 
115           ONLY: use_surface_fluxes, use_top_fluxes
116       
117       USE grid_variables,                                                     &
118           ONLY:  ddx2, ddy2, fwxm, fwxp, fwym, fwyp, wall_w_x, wall_w_y
119       
120       USE indices,                                                            &
121           ONLY:  nxl, nxlg, nxr, nxrg, nyn, nyng, nys, nysg, nzb,             &
122                  nzb_diff_s_inner, nzb_s_inner, nzb_s_outer, nzt, nzt_diff
123       
124       USE kinds
125
126       IMPLICIT NONE
127
128       INTEGER(iwp) ::  i                 !<
129       INTEGER(iwp) ::  j                 !<
130       INTEGER(iwp) ::  k                 !<
131       REAL(wp)     ::  wall_s_flux(0:4)  !<
132       REAL(wp), DIMENSION(nysg:nyng,nxlg:nxrg) ::  s_flux_b, s_flux_t !<
133#if defined( __nopointer )
134       REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ::  s  !<
135#else
136       REAL(wp), DIMENSION(:,:,:), POINTER ::  s  !<
137#endif
138
139       DO  i = nxl, nxr
140          DO  j = nys,nyn
141!
142!--          Compute horizontal diffusion
143             DO  k = nzb_s_outer(j,i)+1, nzt
144
145                tend(k,j,i) = tend(k,j,i)                                      &
146                                          + 0.5_wp * (                         &
147                        ( kh(k,j,i) + kh(k,j,i+1) ) * ( s(k,j,i+1)-s(k,j,i) )  &
148                      - ( kh(k,j,i) + kh(k,j,i-1) ) * ( s(k,j,i)-s(k,j,i-1) )  &
149                                                     ) * ddx2                  &
150                                          + 0.5_wp * (                         &
151                        ( kh(k,j,i) + kh(k,j+1,i) ) * ( s(k,j+1,i)-s(k,j,i) )  &
152                      - ( kh(k,j,i) + kh(k,j-1,i) ) * ( s(k,j,i)-s(k,j-1,i) )  &
153                                                     ) * ddy2
154             ENDDO
155
156!
157!--          Apply prescribed horizontal wall heatflux where necessary
158             IF ( ( wall_w_x(j,i) /= 0.0_wp ) .OR. ( wall_w_y(j,i) /= 0.0_wp ) &
159                )  THEN
160                DO  k = nzb_s_inner(j,i)+1, nzb_s_outer(j,i)
161
162                   tend(k,j,i) = tend(k,j,i)                                   &
163                                                + ( fwxp(j,i) * 0.5_wp *       &
164                        ( kh(k,j,i) + kh(k,j,i+1) ) * ( s(k,j,i+1)-s(k,j,i) )  &
165                        + ( 1.0_wp - fwxp(j,i) ) * wall_s_flux(1)              &
166                                                   -fwxm(j,i) * 0.5_wp *       &
167                        ( kh(k,j,i) + kh(k,j,i-1) ) * ( s(k,j,i)-s(k,j,i-1) )  &
168                        + ( 1.0_wp - fwxm(j,i) ) * wall_s_flux(2)              &
169                                                  ) * ddx2                     &
170                                                + ( fwyp(j,i) * 0.5_wp *       &
171                        ( kh(k,j,i) + kh(k,j+1,i) ) * ( s(k,j+1,i)-s(k,j,i) )  &
172                        + ( 1.0_wp - fwyp(j,i) ) * wall_s_flux(3)              &
173                                                   -fwym(j,i) * 0.5_wp *       &
174                        ( kh(k,j,i) + kh(k,j-1,i) ) * ( s(k,j,i)-s(k,j-1,i) )  &
175                        + ( 1.0_wp - fwym(j,i) ) * wall_s_flux(4)              &
176                                                  ) * ddy2
177                ENDDO
178             ENDIF
179
180!
181!--          Compute vertical diffusion. In case that surface fluxes have been
182!--          prescribed or computed at bottom and/or top, index k starts/ends at
183!--          nzb+2 or nzt-1, respectively.
184             DO  k = nzb_diff_s_inner(j,i), nzt_diff
185
186                tend(k,j,i) = tend(k,j,i)                                      &
187                                       + 0.5_wp * (                            &
188            ( kh(k,j,i) + kh(k+1,j,i) ) * ( s(k+1,j,i)-s(k,j,i) ) * ddzu(k+1)  &
189                                                            * rho_air_zw(k)    &
190          - ( kh(k,j,i) + kh(k-1,j,i) ) * ( s(k,j,i)-s(k-1,j,i) ) * ddzu(k)    &
191                                                            * rho_air_zw(k-1)  &
192                                                  ) * ddzw(k) * drho_air(k)
193             ENDDO
194
195!
196!--          Vertical diffusion at the first computational gridpoint along
197!--          z-direction
198             IF ( use_surface_fluxes )  THEN
199
200                k = nzb_s_inner(j,i)+1
201
202                tend(k,j,i) = tend(k,j,i)                                      &
203                                       + ( 0.5_wp * ( kh(k,j,i)+kh(k+1,j,i) )  &
204                                                  * ( s(k+1,j,i)-s(k,j,i) )    &
205                                                  * ddzu(k+1)                  &
206                                                  * rho_air_zw(k)              &
207                                           + s_flux_b(j,i)                     &
208                                         ) * ddzw(k) * drho_air(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                                                    * rho_air_zw(k-1)          &
225                                         ) * ddzw(k) * drho_air(k)
226
227             ENDIF
228
229          ENDDO
230       ENDDO
231
232    END SUBROUTINE diffusion_s
233
234
235!------------------------------------------------------------------------------!
236! Description:
237! ------------
238!> Call for grid point i,j
239!------------------------------------------------------------------------------!
240    SUBROUTINE diffusion_s_ij( i, j, s, s_flux_b, s_flux_t, wall_s_flux )
241
242       USE arrays_3d,                                                          &
243           ONLY:  ddzu, ddzw, kh, tend, drho_air, rho_air_zw
244           
245       USE control_parameters,                                                 & 
246           ONLY: use_surface_fluxes, use_top_fluxes
247       
248       USE grid_variables,                                                     &
249           ONLY:  ddx2, ddy2, fwxm, fwxp, fwym, fwyp, wall_w_x, wall_w_y
250       
251       USE indices,                                                            &
252           ONLY:  nxlg, nxrg, nyng, nysg, nzb, nzb_diff_s_inner, nzb_s_inner,  &
253                  nzb_s_outer, nzt, nzt_diff
254       
255       USE kinds
256
257       IMPLICIT NONE
258
259       INTEGER(iwp) ::  i                 !<
260       INTEGER(iwp) ::  j                 !<
261       INTEGER(iwp) ::  k                 !<
262       REAL(wp)     ::  wall_s_flux(0:4)  !<
263       REAL(wp), DIMENSION(nysg:nyng,nxlg:nxrg) ::  s_flux_b  !<
264       REAL(wp), DIMENSION(nysg:nyng,nxlg:nxrg) ::  s_flux_t  !<
265#if defined( __nopointer )
266       REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ::  s !<
267#else
268       REAL(wp), DIMENSION(:,:,:), POINTER ::  s  !<
269#endif
270
271!
272!--    Compute horizontal diffusion
273       DO  k = nzb_s_outer(j,i)+1, nzt
274
275          tend(k,j,i) = tend(k,j,i)                                            &
276                                          + 0.5_wp * (                         &
277                        ( kh(k,j,i) + kh(k,j,i+1) ) * ( s(k,j,i+1)-s(k,j,i) )  &
278                      - ( kh(k,j,i) + kh(k,j,i-1) ) * ( s(k,j,i)-s(k,j,i-1) )  &
279                                                     ) * ddx2                  &
280                                          + 0.5_wp * (                         &
281                        ( kh(k,j,i) + kh(k,j+1,i) ) * ( s(k,j+1,i)-s(k,j,i) )  &
282                      - ( kh(k,j,i) + kh(k,j-1,i) ) * ( s(k,j,i)-s(k,j-1,i) )  &
283                                                     ) * ddy2
284       ENDDO
285
286!
287!--    Apply prescribed horizontal wall heatflux where necessary
288       IF ( ( wall_w_x(j,i) /= 0.0_wp ) .OR. ( wall_w_y(j,i) /= 0.0_wp ) )     &
289       THEN
290          DO  k = nzb_s_inner(j,i)+1, nzb_s_outer(j,i)
291
292             tend(k,j,i) = tend(k,j,i)                                         &
293                                                + ( fwxp(j,i) * 0.5_wp *       &
294                        ( kh(k,j,i) + kh(k,j,i+1) ) * ( s(k,j,i+1)-s(k,j,i) )  &
295                        + ( 1.0_wp - fwxp(j,i) ) * wall_s_flux(1)              &
296                                                   -fwxm(j,i) * 0.5_wp *       &
297                        ( kh(k,j,i) + kh(k,j,i-1) ) * ( s(k,j,i)-s(k,j,i-1) )  &
298                        + ( 1.0_wp - fwxm(j,i) ) * wall_s_flux(2)              &
299                                                  ) * ddx2                     &
300                                                + ( fwyp(j,i) * 0.5_wp *       &
301                        ( kh(k,j,i) + kh(k,j+1,i) ) * ( s(k,j+1,i)-s(k,j,i) )  &
302                        + ( 1.0_wp - fwyp(j,i) ) * wall_s_flux(3)              &
303                                                   -fwym(j,i) * 0.5_wp *       &
304                        ( kh(k,j,i) + kh(k,j-1,i) ) * ( s(k,j,i)-s(k,j-1,i) )  &
305                        + ( 1.0_wp - fwym(j,i) ) * wall_s_flux(4)              &
306                                                  ) * ddy2
307          ENDDO
308       ENDIF
309
310!
311!--    Compute vertical diffusion. In case that surface fluxes have been
312!--    prescribed or computed at bottom and/or top, index k starts/ends at
313!--    nzb+2 or nzt-1, respectively.
314       DO  k = nzb_diff_s_inner(j,i), nzt_diff
315
316          tend(k,j,i) = tend(k,j,i)                                            &
317                                       + 0.5_wp * (                            &
318            ( kh(k,j,i) + kh(k+1,j,i) ) * ( s(k+1,j,i)-s(k,j,i) ) * ddzu(k+1)  &
319                                                            * rho_air_zw(k)    &
320          - ( kh(k,j,i) + kh(k-1,j,i) ) * ( s(k,j,i)-s(k-1,j,i) ) * ddzu(k)    &
321                                                            * rho_air_zw(k-1)  &
322                                                  ) * ddzw(k) * drho_air(k)
323       ENDDO
324
325!
326!--    Vertical diffusion at the first computational gridpoint along z-direction
327       IF ( use_surface_fluxes )  THEN
328
329          k = nzb_s_inner(j,i)+1
330
331          tend(k,j,i) = tend(k,j,i) + ( 0.5_wp * ( kh(k,j,i)+kh(k+1,j,i) )     &
332                                               * ( s(k+1,j,i)-s(k,j,i) )       &
333                                               * ddzu(k+1)                     &
334                                               * rho_air_zw(k)                 &
335                                        + s_flux_b(j,i)                        &
336                                      ) * ddzw(k) * drho_air(k)
337
338       ENDIF
339
340!
341!--    Vertical diffusion at the last computational gridpoint along z-direction
342       IF ( use_top_fluxes )  THEN
343
344          k = nzt
345
346          tend(k,j,i) = tend(k,j,i) + ( - s_flux_t(j,i)                        &
347                                      - 0.5_wp * ( kh(k-1,j,i)+kh(k,j,i) )     &
348                                               * ( s(k,j,i)-s(k-1,j,i) )       &
349                                               * ddzu(k)                       &
350                                               * rho_air_zw(k-1)               &
351                                      ) * ddzw(k) * drho_air(k)
352
353       ENDIF
354
355    END SUBROUTINE diffusion_s_ij
356
357 END MODULE diffusion_s_mod
Note: See TracBrowser for help on using the repository browser.