Home

Context Navigation

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

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

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |