Home

Context Navigation

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

Last change on this file since 4020 was 3655, checked in by knoop, 6 years ago
Bugfix: made "unit" and "found" intend INOUT in module interface subroutines + automatic copyright update
Property svn:keywords set to `Id`
File size: 26.2 KB

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

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |