Home

Context Navigation

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

Last change on this file since 1092 was 1092, checked in by raasch, 11 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.

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |