Home

Context Navigation

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

Last change on this file since 2037 was 2037, checked in by knoop, 8 years ago
Anelastic approximation implemented
Property svn:keywords set to `Id`
File size: 24.1 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	! -----------------
[2037]	22	! Anelastic approximation implemented
[1341]	23	!
[1321]	24	! Former revisions:
	25	! -----------------
	26	! $Id: diffusion_w.f90 2037 2016-10-26 11:15:40Z 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, &
[2037]	121	ONLY : ddzu, ddzw, km, tend, u, v, w, drho_air_zw, rho_air
[1320]	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) &
[2037]	186	& * rho_air(k+1) &
[1]	187	& - km(k,j,i) * ( w(k,j,i) - w(k-1,j,i) ) * ddzw(k) &
[2037]	188	& * rho_air(k) &
	189	& ) * ddzu(k+1) * drho_air_zw(k)
[1]	190	ENDDO
	191
	192	!
	193	!-- Wall functions at all vertical walls, where necessary
[1340]	194	IF ( wall_w_x(j,i) /= 0.0_wp .OR. wall_w_y(j,i) /= 0.0_wp ) THEN
[51]	195
[1]	196	DO k = nzb_w_inner(j,i)+1, nzb_w_outer(j,i)
	197	!
	198	!-- Interpolate eddy diffusivities on staggered gridpoints
[1322]	199	kmxp = 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	kmxm = 0.25_wp * &
[978]	202	( km(k,j,i)+km(k,j,i-1)+km(k+1,j,i)+km(k+1,j,i-1) )
[1322]	203	kmyp = 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) )
[1322]	205	kmym = 0.25_wp * &
[978]	206	( km(k,j,i)+km(k+1,j,i)+km(k,j-1,i)+km(k+1,j-1,i) )
[1]	207
	208	tend(k,j,i) = tend(k,j,i) &
	209	+ ( fwxp(j,i) * ( &
[978]	210	kmxp * ( w(k,j,i+1) - w(k,j,i) ) * ddx &
	211	+ kmxp * ( u(k+1,j,i+1) - u(k,j,i+1) ) * ddzu(k+1) &
[1]	212	) &
	213	- fwxm(j,i) * ( &
[978]	214	kmxm * ( w(k,j,i) - w(k,j,i-1) ) * ddx &
	215	+ kmxm * ( u(k+1,j,i) - u(k,j,i) ) * ddzu(k+1) &
[1]	216	) &
[56]	217	+ wall_w_x(j,i) * wsus(k,j,i) &
[1]	218	) * ddx &
	219	+ ( fwyp(j,i) * ( &
[978]	220	kmyp * ( w(k,j+1,i) - w(k,j,i) ) * ddy &
	221	+ kmyp * ( v(k+1,j+1,i) - v(k,j+1,i) ) * ddzu(k+1) &
[1]	222	) &
	223	- fwym(j,i) * ( &
[978]	224	kmym * ( w(k,j,i) - w(k,j-1,i) ) * ddy &
	225	+ kmym * ( v(k+1,j,i) - v(k,j,i) ) * ddzu(k+1) &
[1]	226	) &
[56]	227	+ wall_w_y(j,i) * wsvs(k,j,i) &
[1]	228	) * ddy &
[1340]	229	+ 2.0_wp * ( &
[1]	230	km(k+1,j,i) * ( w(k+1,j,i) - w(k,j,i) ) * ddzw(k+1) &
[2037]	231	* rho_air(k+1) &
[1]	232	- km(k,j,i) * ( w(k,j,i) - w(k-1,j,i) ) * ddzw(k) &
[2037]	233	* rho_air(k) &
	234	) * ddzu(k+1) * drho_air_zw(k)
[1]	235	ENDDO
	236	ENDIF
	237
	238	ENDDO
	239	ENDDO
	240
	241	END SUBROUTINE diffusion_w
	242
	243
	244	!------------------------------------------------------------------------------!
[1682]	245	! Description:
	246	! ------------
	247	!> Call for all grid points - accelerator version
[1015]	248	!------------------------------------------------------------------------------!
	249	SUBROUTINE diffusion_w_acc
	250
[1320]	251	USE arrays_3d, &
[2037]	252	ONLY : ddzu, ddzw, km, tend, u, v, w, drho_air_zw, rho_air
[1320]	253
	254	USE control_parameters, &
	255	ONLY : topography
	256
	257	USE grid_variables, &
	258	ONLY : ddx, ddy, fwxm, fwxp, fwym, fwyp, wall_w_x, wall_w_y
	259
	260	USE indices, &
	261	ONLY : i_left, i_right, j_north, j_south, nxl, nxr, nyn, nys, nzb, &
	262	nzb_w_inner, nzb_w_outer, nzt
	263
	264	USE kinds
[1015]	265
	266	IMPLICIT NONE
	267
[1682]	268	INTEGER(iwp) :: i !<
	269	INTEGER(iwp) :: j !<
	270	INTEGER(iwp) :: k !<
[1320]	271
[1682]	272	REAL(wp) :: kmxm !<
	273	REAL(wp) :: kmxp !<
	274	REAL(wp) :: kmym !<
	275	REAL(wp) :: kmyp !<
[1015]	276
[1682]	277	REAL(wp), DIMENSION(nzb:nzt+1,nys:nyn,nxl:nxr) :: wsus !<
	278	REAL(wp), DIMENSION(nzb:nzt+1,nys:nyn,nxl:nxr) :: wsvs !<
[1015]	279	!$acc declare create ( wsus, wsvs )
	280
	281	!
	282	!-- First calculate horizontal momentum flux w'u' and/or w'v' at vertical
	283	!-- walls, if neccessary
	284	IF ( topography /= 'flat' ) THEN
[1320]	285	CALL wall_fluxes_acc( wsus, 0.0_wp, 0.0_wp, 0.0_wp, 1.0_wp, &
	286	nzb_w_inner, nzb_w_outer, wall_w_x )
	287	CALL wall_fluxes_acc( wsvs, 0.0_wp, 0.0_wp, 0.0_wp, 1.0_wp, &
	288	nzb_w_inner, nzb_w_outer, wall_w_y )
[1015]	289	ENDIF
	290
[1374]	291	!$acc kernels present ( u, v, w, km, tend ) &
[1015]	292	!$acc present ( ddzu, ddzw, fwxm, fwxp, fwym, fwyp, wall_w_x, wall_w_y ) &
	293	!$acc present ( nzb_w_inner, nzb_w_outer )
[1128]	294	DO i = i_left, i_right
	295	DO j = j_south, j_north
[1015]	296	DO k = 1, nzt
	297	IF ( k > nzb_w_outer(j,i) ) THEN
	298	!
	299	!-- Interpolate eddy diffusivities on staggered gridpoints
[1322]	300	kmxp = 0.25_wp * &
[1015]	301	( km(k,j,i)+km(k,j,i+1)+km(k+1,j,i)+km(k+1,j,i+1) )
[1322]	302	kmxm = 0.25_wp * &
[1015]	303	( km(k,j,i)+km(k,j,i-1)+km(k+1,j,i)+km(k+1,j,i-1) )
[1322]	304	kmyp = 0.25_wp * &
[1015]	305	( km(k,j,i)+km(k+1,j,i)+km(k,j+1,i)+km(k+1,j+1,i) )
[1322]	306	kmym = 0.25_wp * &
[1015]	307	( km(k,j,i)+km(k+1,j,i)+km(k,j-1,i)+km(k+1,j-1,i) )
	308
	309	tend(k,j,i) = tend(k,j,i) &
	310	& + ( kmxp * ( w(k,j,i+1) - w(k,j,i) ) * ddx &
	311	& + kmxp * ( u(k+1,j,i+1) - u(k,j,i+1) ) * ddzu(k+1) &
	312	& - kmxm * ( w(k,j,i) - w(k,j,i-1) ) * ddx &
	313	& - kmxm * ( u(k+1,j,i) - u(k,j,i) ) * ddzu(k+1) &
	314	& ) * ddx &
	315	& + ( kmyp * ( w(k,j+1,i) - w(k,j,i) ) * ddy &
	316	& + kmyp * ( v(k+1,j+1,i) - v(k,j+1,i) ) * ddzu(k+1) &
	317	& - kmym * ( w(k,j,i) - w(k,j-1,i) ) * ddy &
	318	& - kmym * ( v(k+1,j,i) - v(k,j,i) ) * ddzu(k+1) &
	319	& ) * ddy &
[1322]	320	& + 2.0_wp * ( &
[1015]	321	& km(k+1,j,i) * ( w(k+1,j,i) - w(k,j,i) ) * ddzw(k+1) &
[2037]	322	& * rho_air(k+1) &
[1015]	323	& - km(k,j,i) * ( w(k,j,i) - w(k-1,j,i) ) * ddzw(k) &
[2037]	324	& * rho_air(k) &
	325	& ) * ddzu(k+1) * drho_air_zw(k)
[1015]	326	ENDIF
	327	ENDDO
	328
	329	!
	330	!-- Wall functions at all vertical walls, where necessary
	331	DO k = 1,nzt
	332
	333	IF ( k > nzb_w_inner(j,i) .AND. k <= nzb_w_outer(j,i) .AND. &
[1340]	334	wall_w_x(j,i) /= 0.0_wp .AND. wall_w_y(j,i) /= 0.0_wp ) THEN
[1015]	335	!
	336	!-- Interpolate eddy diffusivities on staggered gridpoints
[1322]	337	kmxp = 0.25_wp * &
[1015]	338	( km(k,j,i)+km(k,j,i+1)+km(k+1,j,i)+km(k+1,j,i+1) )
[1322]	339	kmxm = 0.25_wp * &
[1015]	340	( km(k,j,i)+km(k,j,i-1)+km(k+1,j,i)+km(k+1,j,i-1) )
[1322]	341	kmyp = 0.25_wp * &
[1015]	342	( km(k,j,i)+km(k+1,j,i)+km(k,j+1,i)+km(k+1,j+1,i) )
[1322]	343	kmym = 0.25_wp * &
[1015]	344	( km(k,j,i)+km(k+1,j,i)+km(k,j-1,i)+km(k+1,j-1,i) )
	345
	346	tend(k,j,i) = tend(k,j,i) &
	347	+ ( fwxp(j,i) * ( &
	348	kmxp * ( w(k,j,i+1) - w(k,j,i) ) * ddx &
	349	+ kmxp * ( u(k+1,j,i+1) - u(k,j,i+1) ) * ddzu(k+1) &
	350	) &
	351	- fwxm(j,i) * ( &
	352	kmxm * ( w(k,j,i) - w(k,j,i-1) ) * ddx &
	353	+ kmxm * ( u(k+1,j,i) - u(k,j,i) ) * ddzu(k+1) &
	354	) &
	355	+ wall_w_x(j,i) * wsus(k,j,i) &
	356	) * ddx &
	357	+ ( fwyp(j,i) * ( &
	358	kmyp * ( w(k,j+1,i) - w(k,j,i) ) * ddy &
	359	+ kmyp * ( v(k+1,j+1,i) - v(k,j+1,i) ) * ddzu(k+1) &
	360	) &
	361	- fwym(j,i) * ( &
	362	kmym * ( w(k,j,i) - w(k,j-1,i) ) * ddy &
	363	+ kmym * ( v(k+1,j,i) - v(k,j,i) ) * ddzu(k+1) &
	364	) &
	365	+ wall_w_y(j,i) * wsvs(k,j,i) &
	366	) * ddy &
[1340]	367	+ 2.0_wp * ( &
[1015]	368	km(k+1,j,i) * ( w(k+1,j,i) - w(k,j,i) ) * ddzw(k+1) &
[2037]	369	* rho_air(k+1) &
[1015]	370	- km(k,j,i) * ( w(k,j,i) - w(k-1,j,i) ) * ddzw(k) &
[2037]	371	* rho_air(k) &
	372	) * ddzu(k+1) * drho_air_zw(k)
[1015]	373	ENDIF
	374	ENDDO
	375
	376	ENDDO
	377	ENDDO
	378	!$acc end kernels
	379
	380	END SUBROUTINE diffusion_w_acc
	381
	382
	383	!------------------------------------------------------------------------------!
[1682]	384	! Description:
	385	! ------------
	386	!> Call for grid point i,j
[1]	387	!------------------------------------------------------------------------------!
[1001]	388	SUBROUTINE diffusion_w_ij( i, j )
[1]	389
[1320]	390	USE arrays_3d, &
[2037]	391	ONLY : ddzu, ddzw, km, tend, u, v, w, drho_air_zw, rho_air
[1320]	392
	393	USE control_parameters, &
	394	ONLY : topography
	395
	396	USE grid_variables, &
	397	ONLY : ddx, ddy, fwxm, fwxp, fwym, fwyp, wall_w_x, wall_w_y
	398
	399	USE indices, &
	400	ONLY : nxl, nxr, nyn, nys, nzb, nzb_w_inner, nzb_w_outer, nzt
	401
	402	USE kinds
[1]	403
	404	IMPLICIT NONE
	405
[1682]	406	INTEGER(iwp) :: i !<
	407	INTEGER(iwp) :: j !<
	408	INTEGER(iwp) :: k !<
[1320]	409
[1682]	410	REAL(wp) :: kmxm !<
	411	REAL(wp) :: kmxp !<
	412	REAL(wp) :: kmym !<
	413	REAL(wp) :: kmyp !<
[1]	414
[1320]	415	REAL(wp), DIMENSION(nzb:nzt+1) :: wsus
	416	REAL(wp), DIMENSION(nzb:nzt+1) :: wsvs
[1]	417
[1001]	418
[1]	419	DO k = nzb_w_outer(j,i)+1, nzt-1
	420	!
	421	!-- Interpolate eddy diffusivities on staggered gridpoints
[1322]	422	kmxp = 0.25_wp * ( km(k,j,i)+km(k,j,i+1)+km(k+1,j,i)+km(k+1,j,i+1) )
	423	kmxm = 0.25_wp * ( km(k,j,i)+km(k,j,i-1)+km(k+1,j,i)+km(k+1,j,i-1) )
	424	kmyp = 0.25_wp * ( km(k,j,i)+km(k+1,j,i)+km(k,j+1,i)+km(k+1,j+1,i) )
	425	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]	426
	427	tend(k,j,i) = tend(k,j,i) &
[978]	428	& + ( kmxp * ( w(k,j,i+1) - w(k,j,i) ) * ddx &
	429	& + kmxp * ( u(k+1,j,i+1) - u(k,j,i+1) ) * ddzu(k+1) &
	430	& - kmxm * ( w(k,j,i) - w(k,j,i-1) ) * ddx &
	431	& - kmxm * ( u(k+1,j,i) - u(k,j,i) ) * ddzu(k+1) &
[1]	432	& ) * ddx &
[978]	433	& + ( kmyp * ( w(k,j+1,i) - w(k,j,i) ) * ddy &
	434	& + kmyp * ( v(k+1,j+1,i) - v(k,j+1,i) ) * ddzu(k+1) &
	435	& - kmym * ( w(k,j,i) - w(k,j-1,i) ) * ddy &
	436	& - kmym * ( v(k+1,j,i) - v(k,j,i) ) * ddzu(k+1) &
[1]	437	& ) * ddy &
[1322]	438	& + 2.0_wp * ( &
[1]	439	& km(k+1,j,i) * ( w(k+1,j,i) - w(k,j,i) ) * ddzw(k+1) &
[2037]	440	& * rho_air(k+1) &
[1]	441	& - km(k,j,i) * ( w(k,j,i) - w(k-1,j,i) ) * ddzw(k) &
[2037]	442	& * rho_air(k) &
	443	& ) * ddzu(k+1) * drho_air_zw(k)
[1]	444	ENDDO
	445
	446	!
	447	!-- Wall functions at all vertical walls, where necessary
[1340]	448	IF ( wall_w_x(j,i) /= 0.0_wp .OR. wall_w_y(j,i) /= 0.0_wp ) THEN
[51]	449
	450	!
	451	!-- Calculate the horizontal momentum fluxes w'u' and/or w'v'
[1340]	452	IF ( wall_w_x(j,i) /= 0.0_wp ) THEN
[1320]	453	CALL wall_fluxes( i, j, nzb_w_inner(j,i)+1, nzb_w_outer(j,i), &
	454	wsus, 0.0_wp, 0.0_wp, 0.0_wp, 1.0_wp )
[51]	455	ELSE
[1340]	456	wsus = 0.0_wp
[51]	457	ENDIF
	458
[1340]	459	IF ( wall_w_y(j,i) /= 0.0_wp ) THEN
[1320]	460	CALL wall_fluxes( i, j, nzb_w_inner(j,i)+1, nzb_w_outer(j,i), &
	461	wsvs, 0.0_wp, 0.0_wp, 1.0_wp, 0.0_wp )
[51]	462	ELSE
[1340]	463	wsvs = 0.0_wp
[51]	464	ENDIF
	465
[1]	466	DO k = nzb_w_inner(j,i)+1, nzb_w_outer(j,i)
	467	!
	468	!-- Interpolate eddy diffusivities on staggered gridpoints
[1322]	469	kmxp = 0.25_wp * ( km(k,j,i)+km(k,j,i+1)+km(k+1,j,i)+km(k+1,j,i+1) )
	470	kmxm = 0.25_wp * ( km(k,j,i)+km(k,j,i-1)+km(k+1,j,i)+km(k+1,j,i-1) )
	471	kmyp = 0.25_wp * ( km(k,j,i)+km(k+1,j,i)+km(k,j+1,i)+km(k+1,j+1,i) )
	472	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]	473
	474	tend(k,j,i) = tend(k,j,i) &
	475	+ ( fwxp(j,i) * ( &
[978]	476	kmxp * ( w(k,j,i+1) - w(k,j,i) ) * ddx &
	477	+ kmxp * ( u(k+1,j,i+1) - u(k,j,i+1) ) * ddzu(k+1) &
[1]	478	) &
	479	- fwxm(j,i) * ( &
[978]	480	kmxm * ( w(k,j,i) - w(k,j,i-1) ) * ddx &
	481	+ kmxm * ( u(k+1,j,i) - u(k,j,i) ) * ddzu(k+1) &
[1]	482	) &
[51]	483	+ wall_w_x(j,i) * wsus(k) &
[1]	484	) * ddx &
	485	+ ( fwyp(j,i) * ( &
[978]	486	kmyp * ( w(k,j+1,i) - w(k,j,i) ) * ddy &
	487	+ kmyp * ( v(k+1,j+1,i) - v(k,j+1,i) ) * ddzu(k+1) &
[1]	488	) &
	489	- fwym(j,i) * ( &
[978]	490	kmym * ( w(k,j,i) - w(k,j-1,i) ) * ddy &
	491	+ kmym * ( v(k+1,j,i) - v(k,j,i) ) * ddzu(k+1) &
[1]	492	) &
[51]	493	+ wall_w_y(j,i) * wsvs(k) &
[1]	494	) * ddy &
[1340]	495	+ 2.0_wp * ( &
[1]	496	km(k+1,j,i) * ( w(k+1,j,i) - w(k,j,i) ) * ddzw(k+1) &
[2037]	497	* rho_air(k+1) &
[1]	498	- km(k,j,i) * ( w(k,j,i) - w(k-1,j,i) ) * ddzw(k) &
[2037]	499	* rho_air(k) &
	500	) * ddzu(k+1) * drho_air_zw(k)
[1]	501	ENDDO
	502	ENDIF
	503
	504	END SUBROUTINE diffusion_w_ij
	505
[1323]	506	END MODULE diffusion_w_mod

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |