Home

Context Navigation

source: palm/trunk/SOURCE/diffusion_w.f90 @ 993

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

Rev	Line
[1]	1	MODULE diffusion_w_mod
	2
	3	!------------------------------------------------------------------------------!
[484]	4	! Current revisions:
[1]	5	! -----------------
	6	!
[979]	7	!
[1]	8	! Former revisions:
	9	! -----------------
[3]	10	! $Id: diffusion_w.f90 979 2012-08-09 08:50:11Z hoffmann $
[39]	11	!
[979]	12	! 978 2012-08-09 08:28:32Z fricke
	13	! outflow damping layer removed
	14	! kmxm_x/_z and kmxp_x/_z change to kmxm and kmxp
	15	! kmym_y/_z and kmyp_y/_z change to kmym and kmyp
	16	!
[668]	17	! 667 2010-12-23 12:06:00Z suehring/gryschka
	18	! nxl-1, nxr+1, nys-1, nyn+1 replaced by nxlg, nxrg, nysg, nyng
	19	!
[392]	20	! 366 2009-08-25 08:06:27Z raasch
	21	! bc_lr/bc_ns replaced by bc_lr_cyc/bc_ns_cyc
	22	!
[77]	23	! 75 2007-03-22 09:54:05Z raasch
	24	! Wall functions now include diabatic conditions, call of routine wall_fluxes,
	25	! z0 removed from argument list
	26	!
[39]	27	! 20 2007-02-26 00:12:32Z raasch
	28	! Bugfix: ddzw dimensioned 1:nzt"+1"
	29	!
[3]	30	! RCS Log replace by Id keyword, revision history cleaned up
	31	!
[1]	32	! Revision 1.12 2006/02/23 10:38:03 raasch
	33	! nzb_2d replaced by nzb_w_outer, wall functions added for all vertical walls,
	34	! +z0 in argument list
	35	! WARNING: loops containing the MAX function are still not properly vectorized!
	36	!
	37	! Revision 1.1 1997/09/12 06:24:11 raasch
	38	! Initial revision
	39	!
	40	!
	41	! Description:
	42	! ------------
	43	! Diffusion term of the w-component
	44	!------------------------------------------------------------------------------!
	45
[56]	46	USE wall_fluxes_mod
	47
[1]	48	PRIVATE
	49	PUBLIC diffusion_w
	50
	51	INTERFACE diffusion_w
	52	MODULE PROCEDURE diffusion_w
	53	MODULE PROCEDURE diffusion_w_ij
	54	END INTERFACE diffusion_w
	55
	56	CONTAINS
	57
	58
	59	!------------------------------------------------------------------------------!
	60	! Call for all grid points
	61	!------------------------------------------------------------------------------!
[978]	62	SUBROUTINE diffusion_w( ddzu, ddzw, km, tend, u, v, w )
[1]	63
	64	USE control_parameters
	65	USE grid_variables
	66	USE indices
	67
	68	IMPLICIT NONE
	69
	70	INTEGER :: i, j, k
[978]	71	REAL :: kmxm, kmxp, kmym, kmyp
	72	REAL :: ddzu(1:nzt+1), ddzw(1:nzt+1)
[667]	73	REAL :: tend(nzb:nzt+1,nysg:nyng,nxlg:nxrg)
[1]	74	REAL, DIMENSION(:,:,:), POINTER :: km, u, v, w
[56]	75	REAL, DIMENSION(nzb:nzt+1,nys:nyn,nxl:nxr) :: wsus, wsvs
[1]	76
	77
[56]	78	!
	79	!-- First calculate horizontal momentum flux w'u' and/or w'v' at vertical
	80	!-- walls, if neccessary
	81	IF ( topography /= 'flat' ) THEN
[75]	82	CALL wall_fluxes( wsus, 0.0, 0.0, 0.0, 1.0, nzb_w_inner, &
[56]	83	nzb_w_outer, wall_w_x )
[75]	84	CALL wall_fluxes( wsvs, 0.0, 0.0, 1.0, 0.0, nzb_w_inner, &
[56]	85	nzb_w_outer, wall_w_y )
	86	ENDIF
	87
[1]	88	DO i = nxl, nxr
	89	DO j = nys, nyn
	90	DO k = nzb_w_outer(j,i)+1, nzt-1
	91	!
	92	!-- Interpolate eddy diffusivities on staggered gridpoints
[978]	93	kmxp = 0.25 * &
	94	( km(k,j,i)+km(k,j,i+1)+km(k+1,j,i)+km(k+1,j,i+1) )
	95	kmxm = 0.25 * &
	96	( km(k,j,i)+km(k,j,i-1)+km(k+1,j,i)+km(k+1,j,i-1) )
	97	kmyp = 0.25 * &
	98	( km(k,j,i)+km(k+1,j,i)+km(k,j+1,i)+km(k+1,j+1,i) )
	99	kmym = 0.25 * &
	100	( km(k,j,i)+km(k+1,j,i)+km(k,j-1,i)+km(k+1,j-1,i) )
[1]	101
	102	tend(k,j,i) = tend(k,j,i) &
[978]	103	& + ( kmxp * ( w(k,j,i+1) - w(k,j,i) ) * ddx &
	104	& + kmxp * ( u(k+1,j,i+1) - u(k,j,i+1) ) * ddzu(k+1) &
	105	& - kmxm * ( w(k,j,i) - w(k,j,i-1) ) * ddx &
	106	& - kmxm * ( u(k+1,j,i) - u(k,j,i) ) * ddzu(k+1) &
[1]	107	& ) * ddx &
[978]	108	& + ( kmyp * ( w(k,j+1,i) - w(k,j,i) ) * ddy &
	109	& + kmyp * ( v(k+1,j+1,i) - v(k,j+1,i) ) * ddzu(k+1) &
	110	& - kmym * ( w(k,j,i) - w(k,j-1,i) ) * ddy &
	111	& - kmym * ( v(k+1,j,i) - v(k,j,i) ) * ddzu(k+1) &
[1]	112	& ) * ddy &
	113	& + 2.0 * ( &
	114	& km(k+1,j,i) * ( w(k+1,j,i) - w(k,j,i) ) * ddzw(k+1) &
	115	& - km(k,j,i) * ( w(k,j,i) - w(k-1,j,i) ) * ddzw(k) &
	116	& ) * ddzu(k+1)
	117	ENDDO
	118
	119	!
	120	!-- Wall functions at all vertical walls, where necessary
	121	IF ( wall_w_x(j,i) /= 0.0 .OR. wall_w_y(j,i) /= 0.0 ) THEN
[51]	122
[1]	123	DO k = nzb_w_inner(j,i)+1, nzb_w_outer(j,i)
	124	!
	125	!-- Interpolate eddy diffusivities on staggered gridpoints
[978]	126	kmxp = 0.25 * &
	127	( km(k,j,i)+km(k,j,i+1)+km(k+1,j,i)+km(k+1,j,i+1) )
	128	kmxm = 0.25 * &
	129	( km(k,j,i)+km(k,j,i-1)+km(k+1,j,i)+km(k+1,j,i-1) )
	130	kmyp = 0.25 * &
	131	( km(k,j,i)+km(k+1,j,i)+km(k,j+1,i)+km(k+1,j+1,i) )
	132	kmym = 0.25 * &
	133	( km(k,j,i)+km(k+1,j,i)+km(k,j-1,i)+km(k+1,j-1,i) )
[1]	134
	135	tend(k,j,i) = tend(k,j,i) &
	136	+ ( fwxp(j,i) * ( &
[978]	137	kmxp * ( w(k,j,i+1) - w(k,j,i) ) * ddx &
	138	+ kmxp * ( u(k+1,j,i+1) - u(k,j,i+1) ) * ddzu(k+1) &
[1]	139	) &
	140	- fwxm(j,i) * ( &
[978]	141	kmxm * ( w(k,j,i) - w(k,j,i-1) ) * ddx &
	142	+ kmxm * ( u(k+1,j,i) - u(k,j,i) ) * ddzu(k+1) &
[1]	143	) &
[56]	144	+ wall_w_x(j,i) * wsus(k,j,i) &
[1]	145	) * ddx &
	146	+ ( fwyp(j,i) * ( &
[978]	147	kmyp * ( w(k,j+1,i) - w(k,j,i) ) * ddy &
	148	+ kmyp * ( v(k+1,j+1,i) - v(k,j+1,i) ) * ddzu(k+1) &
[1]	149	) &
	150	- fwym(j,i) * ( &
[978]	151	kmym * ( w(k,j,i) - w(k,j-1,i) ) * ddy &
	152	+ kmym * ( v(k+1,j,i) - v(k,j,i) ) * ddzu(k+1) &
[1]	153	) &
[56]	154	+ wall_w_y(j,i) * wsvs(k,j,i) &
[1]	155	) * ddy &
	156	+ 2.0 * ( &
	157	km(k+1,j,i) * ( w(k+1,j,i) - w(k,j,i) ) * ddzw(k+1) &
	158	- km(k,j,i) * ( w(k,j,i) - w(k-1,j,i) ) * ddzw(k) &
	159	) * ddzu(k+1)
	160	ENDDO
	161	ENDIF
	162
	163	ENDDO
	164	ENDDO
	165
	166	END SUBROUTINE diffusion_w
	167
	168
	169	!------------------------------------------------------------------------------!
	170	! Call for grid point i,j
	171	!------------------------------------------------------------------------------!
[978]	172	SUBROUTINE diffusion_w_ij( i, j, ddzu, ddzw, km, tend, u, v, w )
[1]	173
	174	USE control_parameters
	175	USE grid_variables
	176	USE indices
	177
	178	IMPLICIT NONE
	179
	180	INTEGER :: i, j, k
[978]	181	REAL :: kmxm, kmxp, kmym, kmyp
	182	REAL :: ddzu(1:nzt+1), ddzw(1:nzt+1)
[667]	183	REAL :: tend(nzb:nzt+1,nysg:nyng,nxlg:nxrg)
[51]	184	REAL, DIMENSION(nzb:nzt+1) :: wsus, wsvs
[1]	185	REAL, DIMENSION(:,:,:), POINTER :: km, u, v, w
	186
	187
	188	DO k = nzb_w_outer(j,i)+1, nzt-1
	189	!
	190	!-- Interpolate eddy diffusivities on staggered gridpoints
[978]	191	kmxp = 0.25 * ( km(k,j,i)+km(k,j,i+1)+km(k+1,j,i)+km(k+1,j,i+1) )
	192	kmxm = 0.25 * ( km(k,j,i)+km(k,j,i-1)+km(k+1,j,i)+km(k+1,j,i-1) )
	193	kmyp = 0.25 * ( km(k,j,i)+km(k+1,j,i)+km(k,j+1,i)+km(k+1,j+1,i) )
	194	kmym = 0.25 * ( km(k,j,i)+km(k+1,j,i)+km(k,j-1,i)+km(k+1,j-1,i) )
[1]	195
	196	tend(k,j,i) = tend(k,j,i) &
[978]	197	& + ( kmxp * ( w(k,j,i+1) - w(k,j,i) ) * ddx &
	198	& + kmxp * ( u(k+1,j,i+1) - u(k,j,i+1) ) * ddzu(k+1) &
	199	& - kmxm * ( w(k,j,i) - w(k,j,i-1) ) * ddx &
	200	& - kmxm * ( u(k+1,j,i) - u(k,j,i) ) * ddzu(k+1) &
[1]	201	& ) * ddx &
[978]	202	& + ( kmyp * ( w(k,j+1,i) - w(k,j,i) ) * ddy &
	203	& + kmyp * ( v(k+1,j+1,i) - v(k,j+1,i) ) * ddzu(k+1) &
	204	& - kmym * ( w(k,j,i) - w(k,j-1,i) ) * ddy &
	205	& - kmym * ( v(k+1,j,i) - v(k,j,i) ) * ddzu(k+1) &
[1]	206	& ) * ddy &
	207	& + 2.0 * ( &
	208	& km(k+1,j,i) * ( w(k+1,j,i) - w(k,j,i) ) * ddzw(k+1) &
	209	& - km(k,j,i) * ( w(k,j,i) - w(k-1,j,i) ) * ddzw(k) &
	210	& ) * ddzu(k+1)
	211	ENDDO
	212
	213	!
	214	!-- Wall functions at all vertical walls, where necessary
	215	IF ( wall_w_x(j,i) /= 0.0 .OR. wall_w_y(j,i) /= 0.0 ) THEN
[51]	216
	217	!
	218	!-- Calculate the horizontal momentum fluxes w'u' and/or w'v'
	219	IF ( wall_w_x(j,i) /= 0.0 ) THEN
	220	CALL wall_fluxes( i, j, nzb_w_inner(j,i)+1, nzb_w_outer(j,i), &
	221	wsus, 0.0, 0.0, 0.0, 1.0 )
	222	ELSE
	223	wsus = 0.0
	224	ENDIF
	225
	226	IF ( wall_w_y(j,i) /= 0.0 ) THEN
	227	CALL wall_fluxes( i, j, nzb_w_inner(j,i)+1, nzb_w_outer(j,i), &
	228	wsvs, 0.0, 0.0, 1.0, 0.0 )
	229	ELSE
	230	wsvs = 0.0
	231	ENDIF
	232
[1]	233	DO k = nzb_w_inner(j,i)+1, nzb_w_outer(j,i)
	234	!
	235	!-- Interpolate eddy diffusivities on staggered gridpoints
[978]	236	kmxp = 0.25 * ( km(k,j,i)+km(k,j,i+1)+km(k+1,j,i)+km(k+1,j,i+1) )
	237	kmxm = 0.25 * ( km(k,j,i)+km(k,j,i-1)+km(k+1,j,i)+km(k+1,j,i-1) )
	238	kmyp = 0.25 * ( km(k,j,i)+km(k+1,j,i)+km(k,j+1,i)+km(k+1,j+1,i) )
	239	kmym = 0.25 * ( km(k,j,i)+km(k+1,j,i)+km(k,j-1,i)+km(k+1,j-1,i) )
[1]	240
	241	tend(k,j,i) = tend(k,j,i) &
	242	+ ( fwxp(j,i) * ( &
[978]	243	kmxp * ( w(k,j,i+1) - w(k,j,i) ) * ddx &
	244	+ kmxp * ( u(k+1,j,i+1) - u(k,j,i+1) ) * ddzu(k+1) &
[1]	245	) &
	246	- fwxm(j,i) * ( &
[978]	247	kmxm * ( w(k,j,i) - w(k,j,i-1) ) * ddx &
	248	+ kmxm * ( u(k+1,j,i) - u(k,j,i) ) * ddzu(k+1) &
[1]	249	) &
[51]	250	+ wall_w_x(j,i) * wsus(k) &
[1]	251	) * ddx &
	252	+ ( fwyp(j,i) * ( &
[978]	253	kmyp * ( w(k,j+1,i) - w(k,j,i) ) * ddy &
	254	+ kmyp * ( v(k+1,j+1,i) - v(k,j+1,i) ) * ddzu(k+1) &
[1]	255	) &
	256	- fwym(j,i) * ( &
[978]	257	kmym * ( w(k,j,i) - w(k,j-1,i) ) * ddy &
	258	+ kmym * ( v(k+1,j,i) - v(k,j,i) ) * ddzu(k+1) &
[1]	259	) &
[51]	260	+ wall_w_y(j,i) * wsvs(k) &
[1]	261	) * ddy &
	262	+ 2.0 * ( &
	263	km(k+1,j,i) * ( w(k+1,j,i) - w(k,j,i) ) * ddzw(k+1) &
	264	- km(k,j,i) * ( w(k,j,i) - w(k-1,j,i) ) * ddzw(k) &
	265	) * ddzu(k+1)
	266	ENDDO
	267	ENDIF
	268
	269	END SUBROUTINE diffusion_w_ij
	270
	271	END MODULE diffusion_w_mod

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |