Home

Context Navigation

source: palm/trunk/SOURCE/diffusion_u.f90 @ 2249

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

Rev	Line
[1873]	1	!> @file diffusion_u.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	!
[2101]	17	! Copyright 1997-2017 Leibniz Universitaet Hannover
[2000]	18	!------------------------------------------------------------------------------!
[1036]	19	!
[484]	20	! Current revisions:
[1]	21	! -----------------
[1341]	22	!
[2233]	23	!
[1321]	24	! Former revisions:
	25	! -----------------
	26	! $Id: diffusion_u.f90 2233 2017-05-30 18:08:54Z sward $
	27	!
[2233]	28	! 2232 2017-05-30 17:47:52Z suehring
	29	! Adjustments to new topography and surface concept
	30	!
[2119]	31	! 2118 2017-01-17 16:38:49Z raasch
	32	! OpenACC version of subroutine removed
	33	!
[2038]	34	! 2037 2016-10-26 11:15:40Z knoop
	35	! Anelastic approximation implemented
	36	!
[2001]	37	! 2000 2016-08-20 18:09:15Z knoop
	38	! Forced header and separation lines into 80 columns
	39	!
[1874]	40	! 1873 2016-04-18 14:50:06Z maronga
	41	! Module renamed (removed _mod)
	42	!
[1851]	43	! 1850 2016-04-08 13:29:27Z maronga
	44	! Module renamed
	45	!
[1741]	46	! 1740 2016-01-13 08:19:40Z raasch
	47	! unnecessary calculations of kmzm and kmzp in wall bounded parts removed
	48	!
[1692]	49	! 1691 2015-10-26 16:17:44Z maronga
	50	! Formatting corrections.
	51	!
[1683]	52	! 1682 2015-10-07 23:56:08Z knoop
	53	! Code annotations made doxygen readable
	54	!
[1341]	55	! 1340 2014-03-25 19:45:13Z kanani
	56	! REAL constants defined as wp-kind
	57	!
[1321]	58	! 1320 2014-03-20 08:40:49Z raasch
[1320]	59	! ONLY-attribute added to USE-statements,
	60	! kind-parameters added to all INTEGER and REAL declaration statements,
	61	! kinds are defined in new module kinds,
	62	! revision history before 2012 removed,
	63	! comment fields (!:) to be used for variable explanations added to
	64	! all variable declaration statements
[1321]	65	!
[1258]	66	! 1257 2013-11-08 15:18:40Z raasch
	67	! openacc loop and loop vector clauses removed, declare create moved after
	68	! the FORTRAN declaration statement
	69	!
[1132]	70	! 1128 2013-04-12 06:19:32Z raasch
	71	! loop index bounds in accelerator version replaced by i_left, i_right, j_south,
	72	! j_north
	73	!
[1037]	74	! 1036 2012-10-22 13:43:42Z raasch
	75	! code put under GPL (PALM 3.9)
	76	!
[1017]	77	! 1015 2012-09-27 09:23:24Z raasch
	78	! accelerator version (*_acc) added
	79	!
[1002]	80	! 1001 2012-09-13 14:08:46Z raasch
	81	! arrays comunicated by module instead of parameter list
	82	!
[979]	83	! 978 2012-08-09 08:28:32Z fricke
	84	! outflow damping layer removed
	85	! kmym_x/_y and kmyp_x/_y change to kmym and kmyp
	86	!
[1]	87	! Revision 1.1 1997/09/12 06:23:51 raasch
	88	! Initial revision
	89	!
	90	!
	91	! Description:
	92	! ------------
[1682]	93	!> Diffusion term of the u-component
	94	!> @todo additional damping (needed for non-cyclic bc) causes bad vectorization
	95	!> and slows down the speed on NEC about 5-10%
[1]	96	!------------------------------------------------------------------------------!
[1682]	97	MODULE diffusion_u_mod
	98
[1]	99
	100	PRIVATE
[2118]	101	PUBLIC diffusion_u
[1]	102
	103	INTERFACE diffusion_u
	104	MODULE PROCEDURE diffusion_u
	105	MODULE PROCEDURE diffusion_u_ij
	106	END INTERFACE diffusion_u
	107
	108	CONTAINS
	109
	110
	111	!------------------------------------------------------------------------------!
[1682]	112	! Description:
	113	! ------------
	114	!> Call for all grid points
[1]	115	!------------------------------------------------------------------------------!
[1001]	116	SUBROUTINE diffusion_u
[1]	117
[1320]	118	USE arrays_3d, &
[2232]	119	ONLY: ddzu, ddzw, km, tend, u, v, w, drho_air, rho_air_zw
[1320]	120
	121	USE control_parameters, &
[2232]	122	ONLY: constant_top_momentumflux, use_surface_fluxes, &
[1320]	123	use_top_fluxes
	124
	125	USE grid_variables, &
[2232]	126	ONLY: ddx, ddx2, ddy
[1320]	127
	128	USE indices, &
[2232]	129	ONLY: nxl, nxlu, nxr, nyn, nys, nzb, nzt, wall_flags_0
	130
[1320]	131	USE kinds
[1]	132
[2232]	133	USE surface_mod, &
	134	ONLY : surf_def_h, surf_def_v, surf_lsm_h, surf_lsm_v, surf_usm_h, &
	135	surf_usm_v
	136
[1]	137	IMPLICIT NONE
	138
[2232]	139	INTEGER(iwp) :: i !< running index x direction
	140	INTEGER(iwp) :: j !< running index y direction
	141	INTEGER(iwp) :: k !< running index z direction
	142	INTEGER(iwp) :: l !< running index of surface type, south- or north-facing wall
	143	INTEGER(iwp) :: m !< running index surface elements
	144	INTEGER(iwp) :: surf_e !< End index of surface elements at (j,i)-gridpoint
	145	INTEGER(iwp) :: surf_s !< Start index of surface elements at (j,i)-gridpoint
[1001]	146
[2232]	147	REAL(wp) :: flag !< flag to mask topography grid points
	148	REAL(wp) :: kmym !<
	149	REAL(wp) :: kmyp !<
	150	REAL(wp) :: kmzm !<
	151	REAL(wp) :: kmzp !<
	152	REAL(wp) :: mask_bottom !< flag to mask vertical upward-facing surface
	153	REAL(wp) :: mask_north !< flag to mask vertical surface north of the grid point
	154	REAL(wp) :: mask_south !< flag to mask vertical surface south of the grid point
	155	REAL(wp) :: mask_top !< flag to mask vertical downward-facing surface
[1]	156
[56]	157
[2232]	158
[106]	159	DO i = nxlu, nxr
[1001]	160	DO j = nys, nyn
[1]	161	!
	162	!-- Compute horizontal diffusion
[2232]	163	DO k = nzb+1, nzt
[1]	164	!
[2232]	165	!-- Predetermine flag to mask topography and wall-bounded grid points.
	166	!-- It is sufficient to masked only north- and south-facing surfaces, which
	167	!-- need special treatment for the u-component.
	168	flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j,i), 1 ) )
	169	mask_south = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j-1,i), 1 ) )
	170	mask_north = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j+1,i), 1 ) )
	171	!
[1]	172	!-- Interpolate eddy diffusivities on staggered gridpoints
[1340]	173	kmyp = 0.25_wp * &
[978]	174	( km(k,j,i)+km(k,j+1,i)+km(k,j,i-1)+km(k,j+1,i-1) )
[1340]	175	kmym = 0.25_wp * &
[978]	176	( km(k,j,i)+km(k,j-1,i)+km(k,j,i-1)+km(k,j-1,i-1) )
[1]	177
[1320]	178	tend(k,j,i) = tend(k,j,i) &
[2232]	179	+ 2.0_wp * ( &
	180	km(k,j,i) * ( u(k,j,i+1) - u(k,j,i) ) &
	181	- km(k,j,i-1) * ( u(k,j,i) - u(k,j,i-1) ) &
	182	) * ddx2 * flag &
	183	+ ( mask_north * ( &
	184	kmyp * ( u(k,j+1,i) - u(k,j,i) ) * ddy &
	185	+ kmyp * ( v(k,j+1,i) - v(k,j+1,i-1) ) * ddx &
	186	) &
	187	- mask_south * ( &
	188	kmym * ( u(k,j,i) - u(k,j-1,i) ) * ddy &
	189	+ kmym * ( v(k,j,i) - v(k,j,i-1) ) * ddx &
	190	) &
	191	) * ddy * flag
[1]	192	ENDDO
	193	!
[2232]	194	!-- Add horizontal momentum flux u'v' at north- (l=0) and south-facing (l=1)
	195	!-- surfaces. Note, in the the flat case, loops won't be entered as
	196	!-- start_index > end_index. Furtermore, note, no vertical natural surfaces
	197	!-- so far.
	198	!-- Default-type surfaces
	199	DO l = 0, 1
	200	surf_s = surf_def_v(l)%start_index(j,i)
	201	surf_e = surf_def_v(l)%end_index(j,i)
	202	DO m = surf_s, surf_e
	203	k = surf_def_v(l)%k(m)
	204	tend(k,j,i) = tend(k,j,i) + &
	205	surf_def_v(l)%mom_flux_uv(m) * ddy
	206	ENDDO
	207	ENDDO
	208	!
	209	!-- Natural-type surfaces
	210	DO l = 0, 1
	211	surf_s = surf_lsm_v(l)%start_index(j,i)
	212	surf_e = surf_lsm_v(l)%end_index(j,i)
	213	DO m = surf_s, surf_e
	214	k = surf_lsm_v(l)%k(m)
	215	tend(k,j,i) = tend(k,j,i) + &
	216	surf_lsm_v(l)%mom_flux_uv(m) * ddy
	217	ENDDO
	218	ENDDO
	219	!
	220	!-- Urban-type surfaces
	221	DO l = 0, 1
	222	surf_s = surf_usm_v(l)%start_index(j,i)
	223	surf_e = surf_usm_v(l)%end_index(j,i)
	224	DO m = surf_s, surf_e
	225	k = surf_usm_v(l)%k(m)
	226	tend(k,j,i) = tend(k,j,i) + &
	227	surf_usm_v(l)%mom_flux_uv(m) * ddy
	228	ENDDO
	229	ENDDO
[51]	230
[1]	231	!
[2232]	232	!-- Compute vertical diffusion. In case of simulating a surface layer,
	233	!-- respective grid diffusive fluxes are masked (flag 8) within this
	234	!-- loop, and added further below, else, simple gradient approach is
	235	!-- applied. Model top is also mask if top-momentum flux is given.
	236	DO k = nzb+1, nzt
[1]	237	!
[2232]	238	!-- Determine flags to mask topography below and above. Flag 1 is
	239	!-- used to mask topography in general, and flag 8 implies
	240	!-- information about use_surface_fluxes. Flag 9 is used to control
	241	!-- momentum flux at model top.
	242	mask_bottom = MERGE( 1.0_wp, 0.0_wp, &
	243	BTEST( wall_flags_0(k-1,j,i), 8 ) )
	244	mask_top = MERGE( 1.0_wp, 0.0_wp, &
	245	BTEST( wall_flags_0(k+1,j,i), 8 ) ) * &
	246	MERGE( 1.0_wp, 0.0_wp, &
	247	BTEST( wall_flags_0(k+1,j,i), 9 ) )
	248	flag = MERGE( 1.0_wp, 0.0_wp, &
	249	BTEST( wall_flags_0(k,j,i), 1 ) )
	250	!
[1]	251	!-- Interpolate eddy diffusivities on staggered gridpoints
[1340]	252	kmzp = 0.25_wp * &
[1]	253	( km(k,j,i)+km(k+1,j,i)+km(k,j,i-1)+km(k+1,j,i-1) )
[1340]	254	kmzm = 0.25_wp * &
[1]	255	( km(k,j,i)+km(k-1,j,i)+km(k,j,i-1)+km(k-1,j,i-1) )
	256
[1320]	257	tend(k,j,i) = tend(k,j,i) &
[2232]	258	+ ( kmzp * ( ( u(k+1,j,i) - u(k,j,i) ) * ddzu(k+1) &
	259	+ ( w(k,j,i) - w(k,j,i-1) ) * ddx &
	260	) * rho_air_zw(k) * mask_top &
	261	- kmzm * ( ( u(k,j,i) - u(k-1,j,i) ) * ddzu(k) &
	262	+ ( w(k-1,j,i) - w(k-1,j,i-1) ) * ddx &
	263	) * rho_air_zw(k-1) * mask_bottom &
	264	) * ddzw(k) * drho_air(k) * flag
[1]	265	ENDDO
	266
	267	!
	268	!-- Vertical diffusion at the first grid point above the surface,
	269	!-- if the momentum flux at the bottom is given by the Prandtl law or
	270	!-- if it is prescribed by the user.
	271	!-- Difference quotient of the momentum flux is not formed over half
	272	!-- of the grid spacing (2.0*ddzw(k)) any more, since the comparison
[1320]	273	!-- with other (LES) models showed that the values of the momentum
[1]	274	!-- flux becomes too large in this case.
	275	!-- The term containing w(k-1,..) (see above equation) is removed here
	276	!-- because the vertical velocity is assumed to be zero at the surface.
	277	IF ( use_surface_fluxes ) THEN
	278	!
[2232]	279	!-- Default-type surfaces, upward-facing
	280	surf_s = surf_def_h(0)%start_index(j,i)
	281	surf_e = surf_def_h(0)%end_index(j,i)
	282	DO m = surf_s, surf_e
[1]	283
[2232]	284	k = surf_def_h(0)%k(m)
[1]	285
[2232]	286	tend(k,j,i) = tend(k,j,i) &
	287	+ ( - ( - surf_def_h(0)%usws(m) ) &
	288	) * ddzw(k) * drho_air(k)
	289	ENDDO
[102]	290	!
[2232]	291	!-- Default-type surfaces, dowward-facing
	292	surf_s = surf_def_h(1)%start_index(j,i)
	293	surf_e = surf_def_h(1)%end_index(j,i)
	294	DO m = surf_s, surf_e
	295
	296	k = surf_def_h(1)%k(m)
	297
	298	tend(k,j,i) = tend(k,j,i) &
	299	+ ( - surf_def_h(1)%usws(m) &
	300	) * ddzw(k) * drho_air(k)
	301	ENDDO
[102]	302	!
[2232]	303	!-- Natural-type surfaces, upward-facing
	304	surf_s = surf_lsm_h%start_index(j,i)
	305	surf_e = surf_lsm_h%end_index(j,i)
	306	DO m = surf_s, surf_e
[102]	307
[2232]	308	k = surf_lsm_h%k(m)
	309
	310	tend(k,j,i) = tend(k,j,i) &
	311	+ ( - ( - surf_lsm_h%usws(m) ) &
	312	) * ddzw(k) * drho_air(k)
	313	ENDDO
	314	!
	315	!-- Urban-type surfaces, upward-facing
	316	surf_s = surf_usm_h%start_index(j,i)
	317	surf_e = surf_usm_h%end_index(j,i)
	318	DO m = surf_s, surf_e
	319
	320	k = surf_usm_h%k(m)
	321
	322	tend(k,j,i) = tend(k,j,i) &
	323	+ ( - ( - surf_usm_h%usws(m) ) &
	324	) * ddzw(k) * drho_air(k)
	325	ENDDO
	326
[102]	327	ENDIF
[2232]	328	!
	329	!-- Add momentum flux at model top
	330	IF ( use_top_fluxes ) THEN
	331	surf_s = surf_def_h(2)%start_index(j,i)
	332	surf_e = surf_def_h(2)%end_index(j,i)
	333	DO m = surf_s, surf_e
[102]	334
[2232]	335	k = surf_def_h(2)%k(m)
	336
	337	tend(k,j,i) = tend(k,j,i) &
	338	+ ( - surf_def_h(2)%usws(m) ) * ddzw(k) * drho_air(k)
	339	ENDDO
	340	ENDIF
	341
[1]	342	ENDDO
	343	ENDDO
	344
	345	END SUBROUTINE diffusion_u
	346
	347
	348	!------------------------------------------------------------------------------!
[1682]	349	! Description:
	350	! ------------
	351	!> Call for grid point i,j
[1]	352	!------------------------------------------------------------------------------!
[1001]	353	SUBROUTINE diffusion_u_ij( i, j )
[1]	354
[1320]	355	USE arrays_3d, &
[2232]	356	ONLY: ddzu, ddzw, km, tend, u, v, w, drho_air, rho_air_zw
[1320]	357
	358	USE control_parameters, &
[2232]	359	ONLY: constant_top_momentumflux, use_surface_fluxes, &
	360	use_top_fluxes
[1320]	361
	362	USE grid_variables, &
[2232]	363	ONLY: ddx, ddx2, ddy
[1320]	364
	365	USE indices, &
[2232]	366	ONLY: nzb, nzt, wall_flags_0
	367
[1320]	368	USE kinds
[1]	369
[2232]	370	USE surface_mod, &
	371	ONLY : surf_def_h, surf_def_v, surf_lsm_h, surf_lsm_v, surf_usm_h, &
	372	surf_usm_v
	373
[1]	374	IMPLICIT NONE
	375
[2232]	376	INTEGER(iwp) :: i !< running index x direction
	377	INTEGER(iwp) :: j !< running index y direction
	378	INTEGER(iwp) :: k !< running index z direction
	379	INTEGER(iwp) :: l !< running index of surface type, south- or north-facing wall
	380	INTEGER(iwp) :: m !< running index surface elements
	381	INTEGER(iwp) :: surf_e !< End index of surface elements at (j,i)-gridpoint
	382	INTEGER(iwp) :: surf_s !< Start index of surface elements at (j,i)-gridpoint
[1]	383
[2232]	384	REAL(wp) :: flag !< flag to mask topography grid points
	385	REAL(wp) :: kmym !<
	386	REAL(wp) :: kmyp !<
	387	REAL(wp) :: kmzm !<
	388	REAL(wp) :: kmzp !<
	389	REAL(wp) :: mask_bottom !< flag to mask vertical upward-facing surface
	390	REAL(wp) :: mask_north !< flag to mask vertical surface north of the grid point
	391	REAL(wp) :: mask_south !< flag to mask vertical surface south of the grid point
	392	REAL(wp) :: mask_top !< flag to mask vertical downward-facing surface
	393	!
[1]	394	!-- Compute horizontal diffusion
[2232]	395	DO k = nzb+1, nzt
[1]	396	!
[2232]	397	!-- Predetermine flag to mask topography and wall-bounded grid points.
	398	!-- It is sufficient to masked only north- and south-facing surfaces, which
	399	!-- need special treatment for the u-component.
	400	flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j,i), 1 ) )
	401	mask_south = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j-1,i), 1 ) )
	402	mask_north = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j+1,i), 1 ) )
	403	!
[1]	404	!-- Interpolate eddy diffusivities on staggered gridpoints
[1340]	405	kmyp = 0.25_wp * ( km(k,j,i)+km(k,j+1,i)+km(k,j,i-1)+km(k,j+1,i-1) )
	406	kmym = 0.25_wp * ( km(k,j,i)+km(k,j-1,i)+km(k,j,i-1)+km(k,j-1,i-1) )
[1]	407
[1320]	408	tend(k,j,i) = tend(k,j,i) &
[2232]	409	+ 2.0_wp * ( &
	410	km(k,j,i) * ( u(k,j,i+1) - u(k,j,i) ) &
	411	- km(k,j,i-1) * ( u(k,j,i) - u(k,j,i-1) ) &
	412	) * ddx2 * flag &
	413	+ ( &
	414	mask_north * kmyp * ( ( u(k,j+1,i) - u(k,j,i) ) * ddy &
	415	+ ( v(k,j+1,i) - v(k,j+1,i-1) ) * ddx &
	416	) &
	417	- mask_south * kmym * ( ( u(k,j,i) - u(k,j-1,i) ) * ddy &
	418	+ ( v(k,j,i) - v(k,j,i-1) ) * ddx &
	419	) &
	420	) * ddy * flag
[1]	421	ENDDO
	422
	423	!
[2232]	424	!-- Add horizontal momentum flux u'v' at north- (l=0) and south-facing (l=1)
	425	!-- surfaces. Note, in the the flat case, loops won't be entered as
	426	!-- start_index > end_index. Furtermore, note, no vertical natural surfaces
	427	!-- so far.
	428	!-- Default-type surfaces
	429	DO l = 0, 1
	430	surf_s = surf_def_v(l)%start_index(j,i)
	431	surf_e = surf_def_v(l)%end_index(j,i)
	432	DO m = surf_s, surf_e
	433	k = surf_def_v(l)%k(m)
	434	tend(k,j,i) = tend(k,j,i) + surf_def_v(l)%mom_flux_uv(m) * ddy
	435	ENDDO
	436	ENDDO
[51]	437	!
[2232]	438	!-- Natural-type surfaces
	439	DO l = 0, 1
	440	surf_s = surf_lsm_v(l)%start_index(j,i)
	441	surf_e = surf_lsm_v(l)%end_index(j,i)
	442	DO m = surf_s, surf_e
	443	k = surf_lsm_v(l)%k(m)
	444	tend(k,j,i) = tend(k,j,i) + surf_lsm_v(l)%mom_flux_uv(m) * ddy
	445	ENDDO
	446	ENDDO
[1]	447	!
[2232]	448	!-- Urban-type surfaces
	449	DO l = 0, 1
	450	surf_s = surf_usm_v(l)%start_index(j,i)
	451	surf_e = surf_usm_v(l)%end_index(j,i)
	452	DO m = surf_s, surf_e
	453	k = surf_usm_v(l)%k(m)
	454	tend(k,j,i) = tend(k,j,i) + surf_usm_v(l)%mom_flux_uv(m) * ddy
	455	ENDDO
	456	ENDDO
[1]	457	!
[2232]	458	!-- Compute vertical diffusion. In case of simulating a surface layer,
	459	!-- respective grid diffusive fluxes are masked (flag 8) within this
	460	!-- loop, and added further below, else, simple gradient approach is
	461	!-- applied. Model top is also mask if top-momentum flux is given.
	462	DO k = nzb+1, nzt
	463	!
	464	!-- Determine flags to mask topography below and above. Flag 1 is
	465	!-- used to mask topography in general, and flag 8 implies
	466	!-- information about use_surface_fluxes. Flag 9 is used to control
	467	!-- momentum flux at model top.
	468	mask_bottom = MERGE( 1.0_wp, 0.0_wp, &
	469	BTEST( wall_flags_0(k-1,j,i), 8 ) )
	470	mask_top = MERGE( 1.0_wp, 0.0_wp, &
	471	BTEST( wall_flags_0(k+1,j,i), 8 ) ) * &
	472	MERGE( 1.0_wp, 0.0_wp, &
	473	BTEST( wall_flags_0(k+1,j,i), 9 ) )
	474	flag = MERGE( 1.0_wp, 0.0_wp, &
	475	BTEST( wall_flags_0(k,j,i), 1 ) )
	476	!
[1]	477	!-- Interpolate eddy diffusivities on staggered gridpoints
[1340]	478	kmzp = 0.25_wp * ( km(k,j,i)+km(k+1,j,i)+km(k,j,i-1)+km(k+1,j,i-1) )
	479	kmzm = 0.25_wp * ( km(k,j,i)+km(k-1,j,i)+km(k,j,i-1)+km(k-1,j,i-1) )
[1]	480
[1320]	481	tend(k,j,i) = tend(k,j,i) &
[2232]	482	+ ( kmzp * ( ( u(k+1,j,i) - u(k,j,i) ) * ddzu(k+1) &
	483	+ ( w(k,j,i) - w(k,j,i-1) ) * ddx &
	484	) * rho_air_zw(k) * mask_top &
	485	- kmzm * ( ( u(k,j,i) - u(k-1,j,i) ) * ddzu(k) &
	486	+ ( w(k-1,j,i) - w(k-1,j,i-1) ) * ddx &
	487	) * rho_air_zw(k-1) * mask_bottom &
	488	) * ddzw(k) * drho_air(k) * flag
[1]	489	ENDDO
	490
	491	!
[2232]	492	!-- Vertical diffusion at the first surface grid points, if the
[1]	493	!-- momentum flux at the bottom is given by the Prandtl law or if it is
	494	!-- prescribed by the user.
	495	!-- Difference quotient of the momentum flux is not formed over half of
	496	!-- the grid spacing (2.0*ddzw(k)) any more, since the comparison with
[1320]	497	!-- other (LES) models showed that the values of the momentum flux becomes
[1]	498	!-- too large in this case.
	499	IF ( use_surface_fluxes ) THEN
	500	!
[2232]	501	!-- Default-type surfaces, upward-facing
	502	surf_s = surf_def_h(0)%start_index(j,i)
	503	surf_e = surf_def_h(0)%end_index(j,i)
	504	DO m = surf_s, surf_e
[1]	505
[2232]	506	k = surf_def_h(0)%k(m)
[1]	507
[2232]	508	tend(k,j,i) = tend(k,j,i) &
	509	+ ( - ( - surf_def_h(0)%usws(m) ) &
	510	) * ddzw(k) * drho_air(k)
	511	ENDDO
[102]	512	!
[2232]	513	!-- Default-type surfaces, dowward-facing (except for model-top fluxes)
	514	surf_s = surf_def_h(1)%start_index(j,i)
	515	surf_e = surf_def_h(1)%end_index(j,i)
	516	DO m = surf_s, surf_e
	517
	518	k = surf_def_h(1)%k(m)
	519
	520	tend(k,j,i) = tend(k,j,i) &
	521	+ ( - surf_def_h(1)%usws(m) &
	522	) * ddzw(k) * drho_air(k)
	523	ENDDO
[102]	524	!
[2232]	525	!-- Natural-type surfaces, upward-facing
	526	surf_s = surf_lsm_h%start_index(j,i)
	527	surf_e = surf_lsm_h%end_index(j,i)
	528	DO m = surf_s, surf_e
[102]	529
[2232]	530	k = surf_lsm_h%k(m)
	531
	532	tend(k,j,i) = tend(k,j,i) &
	533	+ ( - ( - surf_lsm_h%usws(m) ) &
	534	) * ddzw(k) * drho_air(k)
	535	ENDDO
	536	!
	537	!-- Urban-type surfaces, upward-facing
	538	surf_s = surf_usm_h%start_index(j,i)
	539	surf_e = surf_usm_h%end_index(j,i)
	540	DO m = surf_s, surf_e
	541
	542	k = surf_usm_h%k(m)
	543
	544	tend(k,j,i) = tend(k,j,i) &
	545	+ ( - ( - surf_usm_h%usws(m) ) &
	546	) * ddzw(k) * drho_air(k)
	547	ENDDO
	548
[102]	549	ENDIF
[2232]	550	!
	551	!-- Add momentum flux at model top
	552	IF ( use_top_fluxes ) THEN
	553	surf_s = surf_def_h(2)%start_index(j,i)
	554	surf_e = surf_def_h(2)%end_index(j,i)
	555	DO m = surf_s, surf_e
[102]	556
[2232]	557	k = surf_def_h(2)%k(m)
	558
	559	tend(k,j,i) = tend(k,j,i) &
	560	+ ( - surf_def_h(2)%usws(m) ) * ddzw(k) * drho_air(k)
	561	ENDDO
	562	ENDIF
	563
	564
[1]	565	END SUBROUTINE diffusion_u_ij
	566
	567	END MODULE diffusion_u_mod

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |