Home

Context Navigation

source: palm/trunk/SOURCE/diffusion_v.f90 @ 2696

Last change on this file since 2696 was 2696, checked in by kanani, 6 years ago
Merge of branch palm4u into trunk
Property svn:keywords set to `Id`
File size: 24.0 KB

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

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |