Home

Context Navigation

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

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

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

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |