Home

Context Navigation

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

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

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

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |