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

Last change on this file since 1092 was 1092, checked in by raasch, 9 years ago

unused variables remove from several routines

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