Home

Context Navigation

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

Last change on this file since 1016 was 1015, checked in by raasch, 12 years ago
Starting with changes required for GPU optimization. OpenACC statements for using NVIDIA GPUs added. Adjustment of mixing length to the Prandtl mixing length at first grid point above ground removed. mask array is set zero for ghost boundaries
Property svn:keywords set to `Id`
File size: 16.8 KB

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

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |