Home

Context Navigation

diffusion_s.f90 @ 1257

Last change on this file since 1257 was 1257, checked in by raasch, 10 years ago

New:
---

openACC porting of timestep calculation
(modules, timestep, time_integration)

Changed:

openACC loop directives and vector clauses removed (because they do not give any performance improvement with PGI
compiler versions > 13.6)
(advec_ws, buoyancy, coriolis, diffusion_e, diffusion_s, diffusion_u, diffusion_v, diffusion_w, diffusivities, exchange_horiz, fft_xy, pres, production_e, transpose, tridia_solver, wall_fluxes)

openACC loop independent clauses added
(boundary_conds, prandtl_fluxes, pres)

openACC declare create statements moved after FORTRAN declaration statement
(diffusion_u, diffusion_v, diffusion_w, fft_xy, poisfft, production_e, tridia_solver)

openACC end parallel replaced by end parallel loop
(flow_statistics, pres)

openACC "kernels do" replaced by "kernels loop"
(prandtl_fluxes)

output format for theta* changed to avoid output of *
(run_control)

Errors:

bugfix for calculation of advective timestep (old version may cause wrong timesteps in case of
vertixcally stretched grids)
Attention: standard run-control output has changed!
(timestep)

Property svn:keywords set to Id

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

Note: See TracBrowser for help on using the repository browser.

Context Navigation

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

Download in other formats: