Home

Context Navigation

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

Last change on this file since 1011 was 1011, checked in by raasch, 12 years ago
last commit documented
Property svn:keywords set to `Id`
File size: 11.1 KB

Rev	Line
[1]	1	MODULE diffusion_s_mod
	2
	3	!------------------------------------------------------------------------------!
[484]	4	! Current revisions:
[1001]	5	! ------------------
[1]	6	!
[1011]	7	!
[1]	8	! Former revisions:
	9	! -----------------
[3]	10	! $Id: diffusion_s.f90 1011 2012-09-20 08:15:29Z 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
	50	PUBLIC diffusion_s
	51
	52	INTERFACE diffusion_s
	53	MODULE PROCEDURE diffusion_s
	54	MODULE PROCEDURE diffusion_s_ij
	55	END INTERFACE diffusion_s
	56
	57	CONTAINS
	58
	59
	60	!------------------------------------------------------------------------------!
	61	! Call for all grid points
	62	!------------------------------------------------------------------------------!
[1001]	63	SUBROUTINE diffusion_s( s, s_flux_b, s_flux_t, wall_s_flux )
[1]	64
[1001]	65	USE arrays_3d
[1]	66	USE control_parameters
	67	USE grid_variables
	68	USE indices
	69
	70	IMPLICIT NONE
	71
	72	INTEGER :: i, j, k
	73	REAL :: vertical_gridspace
[129]	74	REAL :: wall_s_flux(0:4)
[1001]	75	REAL, DIMENSION(nysg:nyng,nxlg:nxrg) :: s_flux_b, s_flux_t
[1010]	76	#if defined( __nopointer )
	77	REAL, DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) :: s
	78	#else
[1001]	79	REAL, DIMENSION(:,:,:), POINTER :: s
[1010]	80	#endif
[1]	81
	82	DO i = nxl, nxr
	83	DO j = nys,nyn
	84	!
	85	!-- Compute horizontal diffusion
[19]	86	DO k = nzb_s_outer(j,i)+1, nzt
[1]	87
	88	tend(k,j,i) = tend(k,j,i) &
	89	+ 0.5 * ( &
	90	( kh(k,j,i) + kh(k,j,i+1) ) * ( s(k,j,i+1)-s(k,j,i) ) &
	91	- ( kh(k,j,i) + kh(k,j,i-1) ) * ( s(k,j,i)-s(k,j,i-1) ) &
	92	) * ddx2 &
	93	+ 0.5 * ( &
	94	( kh(k,j,i) + kh(k,j+1,i) ) * ( s(k,j+1,i)-s(k,j,i) ) &
	95	- ( kh(k,j,i) + kh(k,j-1,i) ) * ( s(k,j,i)-s(k,j-1,i) ) &
	96	) * ddy2
	97	ENDDO
	98
	99	!
	100	!-- Apply prescribed horizontal wall heatflux where necessary
	101	IF ( ( wall_w_x(j,i) .NE. 0.0 ) .OR. ( wall_w_y(j,i) .NE. 0.0 ) ) &
	102	THEN
	103	DO k = nzb_s_inner(j,i)+1, nzb_s_outer(j,i)
	104
	105	tend(k,j,i) = tend(k,j,i) &
[183]	106	+ ( fwxp(j,i) * 0.5 * &
[1]	107	( kh(k,j,i) + kh(k,j,i+1) ) * ( s(k,j,i+1)-s(k,j,i) ) &
[129]	108	+ ( 1.0 - fwxp(j,i) ) * wall_s_flux(1) &
[183]	109	-fwxm(j,i) * 0.5 * &
[1]	110	( kh(k,j,i) + kh(k,j,i-1) ) * ( s(k,j,i)-s(k,j,i-1) ) &
[129]	111	+ ( 1.0 - fwxm(j,i) ) * wall_s_flux(2) &
[1]	112	) * ddx2 &
[183]	113	+ ( fwyp(j,i) * 0.5 * &
[1]	114	( kh(k,j,i) + kh(k,j+1,i) ) * ( s(k,j+1,i)-s(k,j,i) ) &
[129]	115	+ ( 1.0 - fwyp(j,i) ) * wall_s_flux(3) &
[183]	116	-fwym(j,i) * 0.5 * &
[1]	117	( kh(k,j,i) + kh(k,j-1,i) ) * ( s(k,j,i)-s(k,j-1,i) ) &
[129]	118	+ ( 1.0 - fwym(j,i) ) * wall_s_flux(4) &
[1]	119	) * ddy2
	120	ENDDO
	121	ENDIF
	122
	123	!
	124	!-- Compute vertical diffusion. In case that surface fluxes have been
[19]	125	!-- prescribed or computed at bottom and/or top, index k starts/ends at
	126	!-- nzb+2 or nzt-1, respectively.
	127	DO k = nzb_diff_s_inner(j,i), nzt_diff
[1]	128
	129	tend(k,j,i) = tend(k,j,i) &
	130	+ 0.5 * ( &
	131	( kh(k,j,i) + kh(k+1,j,i) ) * ( s(k+1,j,i)-s(k,j,i) ) * ddzu(k+1) &
	132	- ( kh(k,j,i) + kh(k-1,j,i) ) * ( s(k,j,i)-s(k-1,j,i) ) * ddzu(k) &
	133	) * ddzw(k)
	134	ENDDO
	135
	136	!
[19]	137	!-- Vertical diffusion at the first computational gridpoint along
[1]	138	!-- z-direction
	139	IF ( use_surface_fluxes ) THEN
	140
	141	k = nzb_s_inner(j,i)+1
	142
	143	tend(k,j,i) = tend(k,j,i) &
	144	+ ( 0.5 * ( kh(k,j,i)+kh(k+1,j,i) ) &
	145	* ( s(k+1,j,i)-s(k,j,i) ) &
	146	* ddzu(k+1) &
[19]	147	+ s_flux_b(j,i) &
[1]	148	) * ddzw(k)
	149
	150	ENDIF
	151
[19]	152	!
	153	!-- Vertical diffusion at the last computational gridpoint along
	154	!-- z-direction
	155	IF ( use_top_fluxes ) THEN
	156
	157	k = nzt
	158
	159	tend(k,j,i) = tend(k,j,i) &
	160	+ ( - s_flux_t(j,i) &
[20]	161	- 0.5 * ( kh(k-1,j,i)+kh(k,j,i) ) &
	162	* ( s(k,j,i)-s(k-1,j,i) ) &
	163	* ddzu(k) &
[19]	164	) * ddzw(k)
	165
	166	ENDIF
	167
[1]	168	ENDDO
	169	ENDDO
	170
	171	END SUBROUTINE diffusion_s
	172
	173
	174	!------------------------------------------------------------------------------!
	175	! Call for grid point i,j
	176	!------------------------------------------------------------------------------!
[1001]	177	SUBROUTINE diffusion_s_ij( i, j, s, s_flux_b, s_flux_t, wall_s_flux )
[1]	178
[1001]	179	USE arrays_3d
[1]	180	USE control_parameters
	181	USE grid_variables
	182	USE indices
	183
	184	IMPLICIT NONE
	185
	186	INTEGER :: i, j, k
	187	REAL :: vertical_gridspace
[129]	188	REAL :: wall_s_flux(0:4)
[1001]	189	REAL, DIMENSION(nysg:nyng,nxlg:nxrg) :: s_flux_b, s_flux_t
[1010]	190	#if defined( __nopointer )
	191	REAL, DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) :: s
	192	#else
[1001]	193	REAL, DIMENSION(:,:,:), POINTER :: s
[1010]	194	#endif
[1]	195
	196	!
	197	!-- Compute horizontal diffusion
[19]	198	DO k = nzb_s_outer(j,i)+1, nzt
[1]	199
	200	tend(k,j,i) = tend(k,j,i) &
	201	+ 0.5 * ( &
	202	( kh(k,j,i) + kh(k,j,i+1) ) * ( s(k,j,i+1)-s(k,j,i) ) &
	203	- ( kh(k,j,i) + kh(k,j,i-1) ) * ( s(k,j,i)-s(k,j,i-1) ) &
	204	) * ddx2 &
	205	+ 0.5 * ( &
	206	( kh(k,j,i) + kh(k,j+1,i) ) * ( s(k,j+1,i)-s(k,j,i) ) &
	207	- ( kh(k,j,i) + kh(k,j-1,i) ) * ( s(k,j,i)-s(k,j-1,i) ) &
	208	) * ddy2
	209	ENDDO
	210
	211	!
	212	!-- Apply prescribed horizontal wall heatflux where necessary
	213	IF ( ( wall_w_x(j,i) .NE. 0.0 ) .OR. ( wall_w_y(j,i) .NE. 0.0 ) ) &
	214	THEN
	215	DO k = nzb_s_inner(j,i)+1, nzb_s_outer(j,i)
	216
	217	tend(k,j,i) = tend(k,j,i) &
[183]	218	+ ( fwxp(j,i) * 0.5 * &
[1]	219	( kh(k,j,i) + kh(k,j,i+1) ) * ( s(k,j,i+1)-s(k,j,i) ) &
[129]	220	+ ( 1.0 - fwxp(j,i) ) * wall_s_flux(1) &
[183]	221	-fwxm(j,i) * 0.5 * &
[1]	222	( kh(k,j,i) + kh(k,j,i-1) ) * ( s(k,j,i)-s(k,j,i-1) ) &
[129]	223	+ ( 1.0 - fwxm(j,i) ) * wall_s_flux(2) &
[1]	224	) * ddx2 &
[183]	225	+ ( fwyp(j,i) * 0.5 * &
[1]	226	( kh(k,j,i) + kh(k,j+1,i) ) * ( s(k,j+1,i)-s(k,j,i) ) &
[129]	227	+ ( 1.0 - fwyp(j,i) ) * wall_s_flux(3) &
[183]	228	-fwym(j,i) * 0.5 * &
[1]	229	( kh(k,j,i) + kh(k,j-1,i) ) * ( s(k,j,i)-s(k,j-1,i) ) &
[129]	230	+ ( 1.0 - fwym(j,i) ) * wall_s_flux(4) &
[1]	231	) * ddy2
	232	ENDDO
	233	ENDIF
	234
	235	!
	236	!-- Compute vertical diffusion. In case that surface fluxes have been
[19]	237	!-- prescribed or computed at bottom and/or top, index k starts/ends at
	238	!-- nzb+2 or nzt-1, respectively.
	239	DO k = nzb_diff_s_inner(j,i), nzt_diff
[1]	240
	241	tend(k,j,i) = tend(k,j,i) &
	242	+ 0.5 * ( &
	243	( kh(k,j,i) + kh(k+1,j,i) ) * ( s(k+1,j,i)-s(k,j,i) ) * ddzu(k+1) &
	244	- ( kh(k,j,i) + kh(k-1,j,i) ) * ( s(k,j,i)-s(k-1,j,i) ) * ddzu(k) &
	245	) * ddzw(k)
	246	ENDDO
	247
	248	!
[19]	249	!-- Vertical diffusion at the first computational gridpoint along z-direction
[1]	250	IF ( use_surface_fluxes ) THEN
	251
	252	k = nzb_s_inner(j,i)+1
	253
[19]	254	tend(k,j,i) = tend(k,j,i) + ( 0.5 * ( kh(k,j,i)+kh(k+1,j,i) ) &
	255	* ( s(k+1,j,i)-s(k,j,i) ) &
	256	* ddzu(k+1) &
	257	+ s_flux_b(j,i) &
	258	) * ddzw(k)
[1]	259
	260	ENDIF
	261
[19]	262	!
	263	!-- Vertical diffusion at the last computational gridpoint along z-direction
	264	IF ( use_top_fluxes ) THEN
	265
	266	k = nzt
	267
	268	tend(k,j,i) = tend(k,j,i) + ( - s_flux_t(j,i) &
	269	- 0.5 * ( kh(k-1,j,i)+kh(k,j,i) ) &
	270	* ( s(k,j,i)-s(k-1,j,i) ) &
	271	* ddzu(k) &
	272	) * ddzw(k)
	273
	274	ENDIF
	275
[1]	276	END SUBROUTINE diffusion_s_ij
	277
	278	END MODULE diffusion_s_mod

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |