Home

Context Navigation

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

Last change on this file since 1128 was 1128, checked in by raasch, 11 years ago
asynchronous transfer of ghost point data for acc-optimized version
Property svn:keywords set to `Id`
File size: 17.8 KB

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

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |