Home

Context Navigation

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

Last change on this file since 2001 was 2001, checked in by knoop, 8 years ago
last commit documented
Property svn:keywords set to `Id`
File size: 22.9 KB

Rev	Line
[1873]	1	!> @file diffusion_w.f90
[2000]	2	!------------------------------------------------------------------------------!
[1036]	3	! This file is part of PALM.
	4	!
[2000]	5	! PALM is free software: you can redistribute it and/or modify it under the
	6	! terms of the GNU General Public License as published by the Free Software
	7	! Foundation, either version 3 of the License, or (at your option) any later
	8	! version.
[1036]	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	!
[1818]	17	! Copyright 1997-2016 Leibniz Universitaet Hannover
[2000]	18	!------------------------------------------------------------------------------!
[1036]	19	!
[484]	20	! Current revisions:
[1]	21	! -----------------
[1341]	22	!
[2001]	23	!
[1321]	24	! Former revisions:
	25	! -----------------
	26	! $Id: diffusion_w.f90 2001 2016-08-20 18:41:22Z knoop $
	27	!
[2001]	28	! 2000 2016-08-20 18:09:15Z knoop
	29	! Forced header and separation lines into 80 columns
	30	!
[1874]	31	! 1873 2016-04-18 14:50:06Z maronga
	32	! Module renamed (removed _mod)
	33	!
	34	!
[1851]	35	! 1850 2016-04-08 13:29:27Z maronga
	36	! Module renamed
	37	!
	38	!
[1683]	39	! 1682 2015-10-07 23:56:08Z knoop
	40	! Code annotations made doxygen readable
	41	!
[1375]	42	! 1374 2014-04-25 12:55:07Z raasch
	43	! vsws + vswst removed from acc-present-list
	44	!
[1354]	45	! 1353 2014-04-08 15:21:23Z heinze
	46	! REAL constants provided with KIND-attribute
	47	!
[1341]	48	! 1340 2014-03-25 19:45:13Z kanani
	49	! REAL constants defined as wp-kind
	50	!
[1323]	51	! 1322 2014-03-20 16:38:49Z raasch
	52	! REAL constants defined as wp-kind
	53	!
[1321]	54	! 1320 2014-03-20 08:40:49Z raasch
[1320]	55	! ONLY-attribute added to USE-statements,
	56	! kind-parameters added to all INTEGER and REAL declaration statements,
	57	! kinds are defined in new module kinds,
	58	! revision history before 2012 removed,
	59	! comment fields (!:) to be used for variable explanations added to
	60	! all variable declaration statements
[1]	61	!
[1258]	62	! 1257 2013-11-08 15:18:40Z raasch
	63	! openacc loop and loop vector clauses removed, declare create moved after
	64	! the FORTRAN declaration statement
	65	!
[1132]	66	! 1128 2013-04-12 06:19:32Z raasch
	67	! loop index bounds in accelerator version replaced by i_left, i_right, j_south,
	68	! j_north
	69	!
[1037]	70	! 1036 2012-10-22 13:43:42Z raasch
	71	! code put under GPL (PALM 3.9)
	72	!
[1017]	73	! 1015 2012-09-27 09:23:24Z raasch
	74	! accelerator version (*_acc) added
	75	!
[1002]	76	! 1001 2012-09-13 14:08:46Z raasch
	77	! arrays comunicated by module instead of parameter list
	78	!
[979]	79	! 978 2012-08-09 08:28:32Z fricke
	80	! outflow damping layer removed
	81	! kmxm_x/_z and kmxp_x/_z change to kmxm and kmxp
	82	! kmym_y/_z and kmyp_y/_z change to kmym and kmyp
	83	!
[1]	84	! Revision 1.1 1997/09/12 06:24:11 raasch
	85	! Initial revision
	86	!
	87	!
	88	! Description:
	89	! ------------
[1682]	90	!> Diffusion term of the w-component
[1]	91	!------------------------------------------------------------------------------!
[1682]	92	MODULE diffusion_w_mod
	93
[1]	94
[1320]	95	USE wall_fluxes_mod, &
	96	ONLY : wall_fluxes, wall_fluxes_acc
[56]	97
[1]	98	PRIVATE
[1015]	99	PUBLIC diffusion_w, diffusion_w_acc
[1]	100
	101	INTERFACE diffusion_w
	102	MODULE PROCEDURE diffusion_w
	103	MODULE PROCEDURE diffusion_w_ij
	104	END INTERFACE diffusion_w
	105
[1015]	106	INTERFACE diffusion_w_acc
	107	MODULE PROCEDURE diffusion_w_acc
	108	END INTERFACE diffusion_w_acc
	109
[1]	110	CONTAINS
	111
	112
	113	!------------------------------------------------------------------------------!
[1682]	114	! Description:
	115	! ------------
	116	!> Call for all grid points
[1]	117	!------------------------------------------------------------------------------!
[1001]	118	SUBROUTINE diffusion_w
[1]	119
[1320]	120	USE arrays_3d, &
	121	ONLY : ddzu, ddzw, km, tend, u, v, w
	122
	123	USE control_parameters, &
	124	ONLY : topography
	125
	126	USE grid_variables, &
	127	ONLY : ddx, ddy, fwxm, fwxp, fwym, fwyp, wall_w_x, wall_w_y
	128
	129	USE indices, &
	130	ONLY : nxl, nxr, nyn, nys, nzb, nzb_w_inner, nzb_w_outer, nzt
	131
	132	USE kinds
[1]	133
	134	IMPLICIT NONE
	135
[1682]	136	INTEGER(iwp) :: i !<
	137	INTEGER(iwp) :: j !<
	138	INTEGER(iwp) :: k !<
[1320]	139
[1682]	140	REAL(wp) :: kmxm !<
	141	REAL(wp) :: kmxp !<
	142	REAL(wp) :: kmym !<
	143	REAL(wp) :: kmyp !<
[1001]	144
[1682]	145	REAL(wp), DIMENSION(nzb:nzt+1,nys:nyn,nxl:nxr) :: wsus !<
	146	REAL(wp), DIMENSION(nzb:nzt+1,nys:nyn,nxl:nxr) :: wsvs !<
[1]	147
	148
[56]	149	!
	150	!-- First calculate horizontal momentum flux w'u' and/or w'v' at vertical
	151	!-- walls, if neccessary
	152	IF ( topography /= 'flat' ) THEN
[1320]	153	CALL wall_fluxes( wsus, 0.0_wp, 0.0_wp, 0.0_wp, 1.0_wp, nzb_w_inner, &
[56]	154	nzb_w_outer, wall_w_x )
[1320]	155	CALL wall_fluxes( wsvs, 0.0_wp, 0.0_wp, 1.0_wp, 0.0_wp, nzb_w_inner, &
[56]	156	nzb_w_outer, wall_w_y )
	157	ENDIF
	158
[1]	159	DO i = nxl, nxr
	160	DO j = nys, nyn
	161	DO k = nzb_w_outer(j,i)+1, nzt-1
	162	!
	163	!-- Interpolate eddy diffusivities on staggered gridpoints
[1322]	164	kmxp = 0.25_wp * &
[978]	165	( km(k,j,i)+km(k,j,i+1)+km(k+1,j,i)+km(k+1,j,i+1) )
[1322]	166	kmxm = 0.25_wp * &
[978]	167	( km(k,j,i)+km(k,j,i-1)+km(k+1,j,i)+km(k+1,j,i-1) )
[1322]	168	kmyp = 0.25_wp * &
[978]	169	( km(k,j,i)+km(k+1,j,i)+km(k,j+1,i)+km(k+1,j+1,i) )
[1322]	170	kmym = 0.25_wp * &
[978]	171	( km(k,j,i)+km(k+1,j,i)+km(k,j-1,i)+km(k+1,j-1,i) )
[1]	172
	173	tend(k,j,i) = tend(k,j,i) &
[978]	174	& + ( kmxp * ( w(k,j,i+1) - w(k,j,i) ) * ddx &
	175	& + kmxp * ( u(k+1,j,i+1) - u(k,j,i+1) ) * ddzu(k+1) &
	176	& - kmxm * ( w(k,j,i) - w(k,j,i-1) ) * ddx &
	177	& - kmxm * ( u(k+1,j,i) - u(k,j,i) ) * ddzu(k+1) &
[1]	178	& ) * ddx &
[978]	179	& + ( kmyp * ( w(k,j+1,i) - w(k,j,i) ) * ddy &
	180	& + kmyp * ( v(k+1,j+1,i) - v(k,j+1,i) ) * ddzu(k+1) &
	181	& - kmym * ( w(k,j,i) - w(k,j-1,i) ) * ddy &
	182	& - kmym * ( v(k+1,j,i) - v(k,j,i) ) * ddzu(k+1) &
[1]	183	& ) * ddy &
[1322]	184	& + 2.0_wp * ( &
[1]	185	& km(k+1,j,i) * ( w(k+1,j,i) - w(k,j,i) ) * ddzw(k+1) &
	186	& - km(k,j,i) * ( w(k,j,i) - w(k-1,j,i) ) * ddzw(k) &
[1340]	187	& ) * ddzu(k+1)
[1]	188	ENDDO
	189
	190	!
	191	!-- Wall functions at all vertical walls, where necessary
[1340]	192	IF ( wall_w_x(j,i) /= 0.0_wp .OR. wall_w_y(j,i) /= 0.0_wp ) THEN
[51]	193
[1]	194	DO k = nzb_w_inner(j,i)+1, nzb_w_outer(j,i)
	195	!
	196	!-- Interpolate eddy diffusivities on staggered gridpoints
[1322]	197	kmxp = 0.25_wp * &
[978]	198	( km(k,j,i)+km(k,j,i+1)+km(k+1,j,i)+km(k+1,j,i+1) )
[1322]	199	kmxm = 0.25_wp * &
[978]	200	( km(k,j,i)+km(k,j,i-1)+km(k+1,j,i)+km(k+1,j,i-1) )
[1322]	201	kmyp = 0.25_wp * &
[978]	202	( km(k,j,i)+km(k+1,j,i)+km(k,j+1,i)+km(k+1,j+1,i) )
[1322]	203	kmym = 0.25_wp * &
[978]	204	( km(k,j,i)+km(k+1,j,i)+km(k,j-1,i)+km(k+1,j-1,i) )
[1]	205
	206	tend(k,j,i) = tend(k,j,i) &
	207	+ ( fwxp(j,i) * ( &
[978]	208	kmxp * ( w(k,j,i+1) - w(k,j,i) ) * ddx &
	209	+ kmxp * ( u(k+1,j,i+1) - u(k,j,i+1) ) * ddzu(k+1) &
[1]	210	) &
	211	- fwxm(j,i) * ( &
[978]	212	kmxm * ( w(k,j,i) - w(k,j,i-1) ) * ddx &
	213	+ kmxm * ( u(k+1,j,i) - u(k,j,i) ) * ddzu(k+1) &
[1]	214	) &
[56]	215	+ wall_w_x(j,i) * wsus(k,j,i) &
[1]	216	) * ddx &
	217	+ ( fwyp(j,i) * ( &
[978]	218	kmyp * ( w(k,j+1,i) - w(k,j,i) ) * ddy &
	219	+ kmyp * ( v(k+1,j+1,i) - v(k,j+1,i) ) * ddzu(k+1) &
[1]	220	) &
	221	- fwym(j,i) * ( &
[978]	222	kmym * ( w(k,j,i) - w(k,j-1,i) ) * ddy &
	223	+ kmym * ( v(k+1,j,i) - v(k,j,i) ) * ddzu(k+1) &
[1]	224	) &
[56]	225	+ wall_w_y(j,i) * wsvs(k,j,i) &
[1]	226	) * ddy &
[1340]	227	+ 2.0_wp * ( &
[1]	228	km(k+1,j,i) * ( w(k+1,j,i) - w(k,j,i) ) * ddzw(k+1) &
	229	- km(k,j,i) * ( w(k,j,i) - w(k-1,j,i) ) * ddzw(k) &
[1340]	230	) * ddzu(k+1)
[1]	231	ENDDO
	232	ENDIF
	233
	234	ENDDO
	235	ENDDO
	236
	237	END SUBROUTINE diffusion_w
	238
	239
	240	!------------------------------------------------------------------------------!
[1682]	241	! Description:
	242	! ------------
	243	!> Call for all grid points - accelerator version
[1015]	244	!------------------------------------------------------------------------------!
	245	SUBROUTINE diffusion_w_acc
	246
[1320]	247	USE arrays_3d, &
	248	ONLY : ddzu, ddzw, km, tend, u, v, w
	249
	250	USE control_parameters, &
	251	ONLY : topography
	252
	253	USE grid_variables, &
	254	ONLY : ddx, ddy, fwxm, fwxp, fwym, fwyp, wall_w_x, wall_w_y
	255
	256	USE indices, &
	257	ONLY : i_left, i_right, j_north, j_south, nxl, nxr, nyn, nys, nzb, &
	258	nzb_w_inner, nzb_w_outer, nzt
	259
	260	USE kinds
[1015]	261
	262	IMPLICIT NONE
	263
[1682]	264	INTEGER(iwp) :: i !<
	265	INTEGER(iwp) :: j !<
	266	INTEGER(iwp) :: k !<
[1320]	267
[1682]	268	REAL(wp) :: kmxm !<
	269	REAL(wp) :: kmxp !<
	270	REAL(wp) :: kmym !<
	271	REAL(wp) :: kmyp !<
[1015]	272
[1682]	273	REAL(wp), DIMENSION(nzb:nzt+1,nys:nyn,nxl:nxr) :: wsus !<
	274	REAL(wp), DIMENSION(nzb:nzt+1,nys:nyn,nxl:nxr) :: wsvs !<
[1015]	275	!$acc declare create ( wsus, wsvs )
	276
	277	!
	278	!-- First calculate horizontal momentum flux w'u' and/or w'v' at vertical
	279	!-- walls, if neccessary
	280	IF ( topography /= 'flat' ) THEN
[1320]	281	CALL wall_fluxes_acc( wsus, 0.0_wp, 0.0_wp, 0.0_wp, 1.0_wp, &
	282	nzb_w_inner, nzb_w_outer, wall_w_x )
	283	CALL wall_fluxes_acc( wsvs, 0.0_wp, 0.0_wp, 0.0_wp, 1.0_wp, &
	284	nzb_w_inner, nzb_w_outer, wall_w_y )
[1015]	285	ENDIF
	286
[1374]	287	!$acc kernels present ( u, v, w, km, tend ) &
[1015]	288	!$acc present ( ddzu, ddzw, fwxm, fwxp, fwym, fwyp, wall_w_x, wall_w_y ) &
	289	!$acc present ( nzb_w_inner, nzb_w_outer )
[1128]	290	DO i = i_left, i_right
	291	DO j = j_south, j_north
[1015]	292	DO k = 1, nzt
	293	IF ( k > nzb_w_outer(j,i) ) THEN
	294	!
	295	!-- Interpolate eddy diffusivities on staggered gridpoints
[1322]	296	kmxp = 0.25_wp * &
[1015]	297	( km(k,j,i)+km(k,j,i+1)+km(k+1,j,i)+km(k+1,j,i+1) )
[1322]	298	kmxm = 0.25_wp * &
[1015]	299	( km(k,j,i)+km(k,j,i-1)+km(k+1,j,i)+km(k+1,j,i-1) )
[1322]	300	kmyp = 0.25_wp * &
[1015]	301	( km(k,j,i)+km(k+1,j,i)+km(k,j+1,i)+km(k+1,j+1,i) )
[1322]	302	kmym = 0.25_wp * &
[1015]	303	( km(k,j,i)+km(k+1,j,i)+km(k,j-1,i)+km(k+1,j-1,i) )
	304
	305	tend(k,j,i) = tend(k,j,i) &
	306	& + ( kmxp * ( w(k,j,i+1) - w(k,j,i) ) * ddx &
	307	& + kmxp * ( u(k+1,j,i+1) - u(k,j,i+1) ) * ddzu(k+1) &
	308	& - kmxm * ( w(k,j,i) - w(k,j,i-1) ) * ddx &
	309	& - kmxm * ( u(k+1,j,i) - u(k,j,i) ) * ddzu(k+1) &
	310	& ) * ddx &
	311	& + ( kmyp * ( w(k,j+1,i) - w(k,j,i) ) * ddy &
	312	& + kmyp * ( v(k+1,j+1,i) - v(k,j+1,i) ) * ddzu(k+1) &
	313	& - kmym * ( w(k,j,i) - w(k,j-1,i) ) * ddy &
	314	& - kmym * ( v(k+1,j,i) - v(k,j,i) ) * ddzu(k+1) &
	315	& ) * ddy &
[1322]	316	& + 2.0_wp * ( &
[1015]	317	& km(k+1,j,i) * ( w(k+1,j,i) - w(k,j,i) ) * ddzw(k+1) &
	318	& - km(k,j,i) * ( w(k,j,i) - w(k-1,j,i) ) * ddzw(k) &
[1340]	319	& ) * ddzu(k+1)
[1015]	320	ENDIF
	321	ENDDO
	322
	323	!
	324	!-- Wall functions at all vertical walls, where necessary
	325	DO k = 1,nzt
	326
	327	IF ( k > nzb_w_inner(j,i) .AND. k <= nzb_w_outer(j,i) .AND. &
[1340]	328	wall_w_x(j,i) /= 0.0_wp .AND. wall_w_y(j,i) /= 0.0_wp ) THEN
[1015]	329	!
	330	!-- Interpolate eddy diffusivities on staggered gridpoints
[1322]	331	kmxp = 0.25_wp * &
[1015]	332	( km(k,j,i)+km(k,j,i+1)+km(k+1,j,i)+km(k+1,j,i+1) )
[1322]	333	kmxm = 0.25_wp * &
[1015]	334	( km(k,j,i)+km(k,j,i-1)+km(k+1,j,i)+km(k+1,j,i-1) )
[1322]	335	kmyp = 0.25_wp * &
[1015]	336	( km(k,j,i)+km(k+1,j,i)+km(k,j+1,i)+km(k+1,j+1,i) )
[1322]	337	kmym = 0.25_wp * &
[1015]	338	( km(k,j,i)+km(k+1,j,i)+km(k,j-1,i)+km(k+1,j-1,i) )
	339
	340	tend(k,j,i) = tend(k,j,i) &
	341	+ ( fwxp(j,i) * ( &
	342	kmxp * ( w(k,j,i+1) - w(k,j,i) ) * ddx &
	343	+ kmxp * ( u(k+1,j,i+1) - u(k,j,i+1) ) * ddzu(k+1) &
	344	) &
	345	- fwxm(j,i) * ( &
	346	kmxm * ( w(k,j,i) - w(k,j,i-1) ) * ddx &
	347	+ kmxm * ( u(k+1,j,i) - u(k,j,i) ) * ddzu(k+1) &
	348	) &
	349	+ wall_w_x(j,i) * wsus(k,j,i) &
	350	) * ddx &
	351	+ ( fwyp(j,i) * ( &
	352	kmyp * ( w(k,j+1,i) - w(k,j,i) ) * ddy &
	353	+ kmyp * ( v(k+1,j+1,i) - v(k,j+1,i) ) * ddzu(k+1) &
	354	) &
	355	- fwym(j,i) * ( &
	356	kmym * ( w(k,j,i) - w(k,j-1,i) ) * ddy &
	357	+ kmym * ( v(k+1,j,i) - v(k,j,i) ) * ddzu(k+1) &
	358	) &
	359	+ wall_w_y(j,i) * wsvs(k,j,i) &
	360	) * ddy &
[1340]	361	+ 2.0_wp * ( &
[1015]	362	km(k+1,j,i) * ( w(k+1,j,i) - w(k,j,i) ) * ddzw(k+1) &
	363	- km(k,j,i) * ( w(k,j,i) - w(k-1,j,i) ) * ddzw(k) &
[1340]	364	) * ddzu(k+1)
[1015]	365	ENDIF
	366	ENDDO
	367
	368	ENDDO
	369	ENDDO
	370	!$acc end kernels
	371
	372	END SUBROUTINE diffusion_w_acc
	373
	374
	375	!------------------------------------------------------------------------------!
[1682]	376	! Description:
	377	! ------------
	378	!> Call for grid point i,j
[1]	379	!------------------------------------------------------------------------------!
[1001]	380	SUBROUTINE diffusion_w_ij( i, j )
[1]	381
[1320]	382	USE arrays_3d, &
	383	ONLY : ddzu, ddzw, km, tend, u, v, w
	384
	385	USE control_parameters, &
	386	ONLY : topography
	387
	388	USE grid_variables, &
	389	ONLY : ddx, ddy, fwxm, fwxp, fwym, fwyp, wall_w_x, wall_w_y
	390
	391	USE indices, &
	392	ONLY : nxl, nxr, nyn, nys, nzb, nzb_w_inner, nzb_w_outer, nzt
	393
	394	USE kinds
[1]	395
	396	IMPLICIT NONE
	397
[1682]	398	INTEGER(iwp) :: i !<
	399	INTEGER(iwp) :: j !<
	400	INTEGER(iwp) :: k !<
[1320]	401
[1682]	402	REAL(wp) :: kmxm !<
	403	REAL(wp) :: kmxp !<
	404	REAL(wp) :: kmym !<
	405	REAL(wp) :: kmyp !<
[1]	406
[1320]	407	REAL(wp), DIMENSION(nzb:nzt+1) :: wsus
	408	REAL(wp), DIMENSION(nzb:nzt+1) :: wsvs
[1]	409
[1001]	410
[1]	411	DO k = nzb_w_outer(j,i)+1, nzt-1
	412	!
	413	!-- Interpolate eddy diffusivities on staggered gridpoints
[1322]	414	kmxp = 0.25_wp * ( km(k,j,i)+km(k,j,i+1)+km(k+1,j,i)+km(k+1,j,i+1) )
	415	kmxm = 0.25_wp * ( km(k,j,i)+km(k,j,i-1)+km(k+1,j,i)+km(k+1,j,i-1) )
	416	kmyp = 0.25_wp * ( km(k,j,i)+km(k+1,j,i)+km(k,j+1,i)+km(k+1,j+1,i) )
	417	kmym = 0.25_wp * ( km(k,j,i)+km(k+1,j,i)+km(k,j-1,i)+km(k+1,j-1,i) )
[1]	418
	419	tend(k,j,i) = tend(k,j,i) &
[978]	420	& + ( kmxp * ( w(k,j,i+1) - w(k,j,i) ) * ddx &
	421	& + kmxp * ( u(k+1,j,i+1) - u(k,j,i+1) ) * ddzu(k+1) &
	422	& - kmxm * ( w(k,j,i) - w(k,j,i-1) ) * ddx &
	423	& - kmxm * ( u(k+1,j,i) - u(k,j,i) ) * ddzu(k+1) &
[1]	424	& ) * ddx &
[978]	425	& + ( kmyp * ( w(k,j+1,i) - w(k,j,i) ) * ddy &
	426	& + kmyp * ( v(k+1,j+1,i) - v(k,j+1,i) ) * ddzu(k+1) &
	427	& - kmym * ( w(k,j,i) - w(k,j-1,i) ) * ddy &
	428	& - kmym * ( v(k+1,j,i) - v(k,j,i) ) * ddzu(k+1) &
[1]	429	& ) * ddy &
[1322]	430	& + 2.0_wp * ( &
[1]	431	& km(k+1,j,i) * ( w(k+1,j,i) - w(k,j,i) ) * ddzw(k+1) &
	432	& - km(k,j,i) * ( w(k,j,i) - w(k-1,j,i) ) * ddzw(k) &
[1340]	433	& ) * ddzu(k+1)
[1]	434	ENDDO
	435
	436	!
	437	!-- Wall functions at all vertical walls, where necessary
[1340]	438	IF ( wall_w_x(j,i) /= 0.0_wp .OR. wall_w_y(j,i) /= 0.0_wp ) THEN
[51]	439
	440	!
	441	!-- Calculate the horizontal momentum fluxes w'u' and/or w'v'
[1340]	442	IF ( wall_w_x(j,i) /= 0.0_wp ) THEN
[1320]	443	CALL wall_fluxes( i, j, nzb_w_inner(j,i)+1, nzb_w_outer(j,i), &
	444	wsus, 0.0_wp, 0.0_wp, 0.0_wp, 1.0_wp )
[51]	445	ELSE
[1340]	446	wsus = 0.0_wp
[51]	447	ENDIF
	448
[1340]	449	IF ( wall_w_y(j,i) /= 0.0_wp ) THEN
[1320]	450	CALL wall_fluxes( i, j, nzb_w_inner(j,i)+1, nzb_w_outer(j,i), &
	451	wsvs, 0.0_wp, 0.0_wp, 1.0_wp, 0.0_wp )
[51]	452	ELSE
[1340]	453	wsvs = 0.0_wp
[51]	454	ENDIF
	455
[1]	456	DO k = nzb_w_inner(j,i)+1, nzb_w_outer(j,i)
	457	!
	458	!-- Interpolate eddy diffusivities on staggered gridpoints
[1322]	459	kmxp = 0.25_wp * ( km(k,j,i)+km(k,j,i+1)+km(k+1,j,i)+km(k+1,j,i+1) )
	460	kmxm = 0.25_wp * ( km(k,j,i)+km(k,j,i-1)+km(k+1,j,i)+km(k+1,j,i-1) )
	461	kmyp = 0.25_wp * ( km(k,j,i)+km(k+1,j,i)+km(k,j+1,i)+km(k+1,j+1,i) )
	462	kmym = 0.25_wp * ( km(k,j,i)+km(k+1,j,i)+km(k,j-1,i)+km(k+1,j-1,i) )
[1]	463
	464	tend(k,j,i) = tend(k,j,i) &
	465	+ ( fwxp(j,i) * ( &
[978]	466	kmxp * ( w(k,j,i+1) - w(k,j,i) ) * ddx &
	467	+ kmxp * ( u(k+1,j,i+1) - u(k,j,i+1) ) * ddzu(k+1) &
[1]	468	) &
	469	- fwxm(j,i) * ( &
[978]	470	kmxm * ( w(k,j,i) - w(k,j,i-1) ) * ddx &
	471	+ kmxm * ( u(k+1,j,i) - u(k,j,i) ) * ddzu(k+1) &
[1]	472	) &
[51]	473	+ wall_w_x(j,i) * wsus(k) &
[1]	474	) * ddx &
	475	+ ( fwyp(j,i) * ( &
[978]	476	kmyp * ( w(k,j+1,i) - w(k,j,i) ) * ddy &
	477	+ kmyp * ( v(k+1,j+1,i) - v(k,j+1,i) ) * ddzu(k+1) &
[1]	478	) &
	479	- fwym(j,i) * ( &
[978]	480	kmym * ( w(k,j,i) - w(k,j-1,i) ) * ddy &
	481	+ kmym * ( v(k+1,j,i) - v(k,j,i) ) * ddzu(k+1) &
[1]	482	) &
[51]	483	+ wall_w_y(j,i) * wsvs(k) &
[1]	484	) * ddy &
[1340]	485	+ 2.0_wp * ( &
[1]	486	km(k+1,j,i) * ( w(k+1,j,i) - w(k,j,i) ) * ddzw(k+1) &
	487	- km(k,j,i) * ( w(k,j,i) - w(k-1,j,i) ) * ddzw(k) &
[1340]	488	) * ddzu(k+1)
[1]	489	ENDDO
	490	ENDIF
	491
	492	END SUBROUTINE diffusion_w_ij
	493
[1323]	494	END MODULE diffusion_w_mod

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |