Home

Context Navigation

source: palm/trunk/SOURCE/advec_u_up.f90 @ 2564

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

Rev	Line
[1873]	1	!> @file advec_u_up.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	! -----------------
[1354]	22	!
[2233]	23	!
[1321]	24	! Former revisions:
	25	! -----------------
	26	! $Id: advec_u_up.f90 2233 2017-05-30 18:08:54Z Giersch $
	27	!
[2233]	28	! 2232 2017-05-30 17:47:52Z suehring
	29	! topography representation via flags
	30	!
[2001]	31	! 2000 2016-08-20 18:09:15Z knoop
	32	! Forced header and separation lines into 80 columns
	33	!
[1874]	34	! 1873 2016-04-18 14:50:06Z maronga
	35	! Module renamed (removed _mod)
	36	!
	37	!
[1851]	38	! 1850 2016-04-08 13:29:27Z maronga
	39	! Module renamed
	40	!
	41	!
[1683]	42	! 1682 2015-10-07 23:56:08Z knoop
	43	! Code annotations made doxygen readable
	44	!
[1354]	45	! 1353 2014-04-08 15:21:23Z heinze
	46	! REAL constants provided with KIND-attribute
	47	!
[1321]	48	! 1320 2014-03-20 08:40:49Z raasch
[1320]	49	! ONLY-attribute added to USE-statements,
	50	! kind-parameters added to all INTEGER and REAL declaration statements,
	51	! kinds are defined in new module kinds,
	52	! revision history before 2012 removed,
	53	! comment fields (!:) to be used for variable explanations added to
	54	! all variable declaration statements
[1]	55	!
[1037]	56	! 1036 2012-10-22 13:43:42Z raasch
	57	! code put under GPL (PALM 3.9)
	58	!
[1]	59	! Revision 1.1 1997/08/29 08:55:25 raasch
	60	! Initial revision
	61	!
	62	!
	63	! Description:
	64	! ------------
[1682]	65	!> Advection term for the u velocity-component using upstream scheme.
	66	!> NOTE: vertical advection at k=1 still has wrong grid spacing for w>0!
	67	!> The same problem occurs for all topography boundaries!
[1]	68	!------------------------------------------------------------------------------!
[1682]	69	MODULE advec_u_up_mod
	70
[1]	71
	72	PRIVATE
	73	PUBLIC advec_u_up
	74
	75	INTERFACE advec_u_up
	76	MODULE PROCEDURE advec_u_up
	77	MODULE PROCEDURE advec_u_up_ij
	78	END INTERFACE advec_u_up
	79
	80	CONTAINS
	81
	82
	83	!------------------------------------------------------------------------------!
[1682]	84	! Description:
	85	! ------------
	86	!> Call for all grid points
[1]	87	!------------------------------------------------------------------------------!
	88	SUBROUTINE advec_u_up
	89
[1320]	90	USE arrays_3d, &
	91	ONLY: ddzu, tend, u, v, w
[1]	92
[1320]	93	USE control_parameters, &
	94	ONLY: u_gtrans, v_gtrans
	95
	96	USE grid_variables, &
	97	ONLY: ddx, ddy
	98
	99	USE indices, &
[2232]	100	ONLY: nxlu, nxr, nyn, nys, nzb, nzt, wall_flags_0
[1320]	101
	102	USE kinds
	103
	104
[1]	105	IMPLICIT NONE
	106
[1682]	107	INTEGER(iwp) :: i !<
	108	INTEGER(iwp) :: j !<
	109	INTEGER(iwp) :: k !<
[1]	110
[1682]	111	REAL(wp) :: ukomp !<
	112	REAL(wp) :: vkomp !<
	113	REAL(wp) :: wkomp !<
[1]	114
[1320]	115
[106]	116	DO i = nxlu, nxr
[1]	117	DO j = nys, nyn
[2232]	118	DO k = nzb+1, nzt
[1]	119	!
	120	!-- x-direction
	121	ukomp = u(k,j,i) - u_gtrans
[1353]	122	IF ( ukomp > 0.0_wp ) THEN
[1320]	123	tend(k,j,i) = tend(k,j,i) - ukomp * &
[2232]	124	( u(k,j,i) - u(k,j,i-1) ) * ddx &
	125	* MERGE( 1.0_wp, 0.0_wp, &
	126	BTEST( wall_flags_0(k,j,i), 1 ) )
[1]	127	ELSE
[1320]	128	tend(k,j,i) = tend(k,j,i) - ukomp * &
[2232]	129	( u(k,j,i+1) - u(k,j,i) ) * ddx &
	130	* MERGE( 1.0_wp, 0.0_wp, &
	131	BTEST( wall_flags_0(k,j,i), 1 ) )
[1]	132	ENDIF
	133	!
	134	!-- y-direction
[1353]	135	vkomp = 0.25_wp * ( v(k,j,i) + v(k,j+1,i) + &
[1]	136	v(k,j,i-1) + v(k,j+1,i-1) ) - v_gtrans
[1353]	137	IF ( vkomp > 0.0_wp ) THEN
[1320]	138	tend(k,j,i) = tend(k,j,i) - vkomp * &
[2232]	139	( u(k,j,i) - u(k,j-1,i) ) * ddy &
	140	* MERGE( 1.0_wp, 0.0_wp, &
	141	BTEST( wall_flags_0(k,j,i), 1 ) )
[1]	142	ELSE
[1320]	143	tend(k,j,i) = tend(k,j,i) - vkomp * &
[2232]	144	( u(k,j+1,i) - u(k,j,i) ) * ddy &
	145	* MERGE( 1.0_wp, 0.0_wp, &
	146	BTEST( wall_flags_0(k,j,i), 1 ) )
[1]	147	ENDIF
	148	!
	149	!-- z-direction
[1353]	150	wkomp = 0.25_wp * ( w(k,j,i) + w(k-1,j,i) + &
[1]	151	w(k,j,i-1) + w(k-1,j,i-1) )
[1353]	152	IF ( wkomp > 0.0_wp ) THEN
[1320]	153	tend(k,j,i) = tend(k,j,i) - wkomp * &
[2232]	154	( u(k,j,i) - u(k-1,j,i) ) * ddzu(k) &
	155	* MERGE( 1.0_wp, 0.0_wp, &
	156	BTEST( wall_flags_0(k,j,i), 1 ) )
[1]	157	ELSE
[1320]	158	tend(k,j,i) = tend(k,j,i) - wkomp * &
[2232]	159	( u(k+1,j,i) - u(k,j,i) ) * ddzu(k+1) &
	160	* MERGE( 1.0_wp, 0.0_wp, &
	161	BTEST( wall_flags_0(k,j,i), 1 ) )
[1]	162	ENDIF
	163
	164	ENDDO
	165	ENDDO
	166	ENDDO
	167
	168	END SUBROUTINE advec_u_up
	169
	170
	171	!------------------------------------------------------------------------------!
[1682]	172	! Description:
	173	! ------------
	174	!> Call for grid point i,j
[1]	175	!------------------------------------------------------------------------------!
	176	SUBROUTINE advec_u_up_ij( i, j )
	177
[1320]	178	USE arrays_3d, &
	179	ONLY: ddzu, tend, u, v, w
[1]	180
[1320]	181	USE control_parameters, &
	182	ONLY: u_gtrans, v_gtrans
	183
	184	USE grid_variables, &
	185	ONLY: ddx, ddy
	186
	187	USE indices, &
[2232]	188	ONLY: nzb, nzt, wall_flags_0
[1320]	189
	190	USE kinds
	191
	192
[1]	193	IMPLICIT NONE
	194
[1682]	195	INTEGER(iwp) :: i !<
	196	INTEGER(iwp) :: j !<
	197	INTEGER(iwp) :: k !<
[1]	198
[1682]	199	REAL(wp) :: ukomp !<
	200	REAL(wp) :: vkomp !<
	201	REAL(wp) :: wkomp !<
[1]	202
	203
[2232]	204	DO k = nzb+1, nzt
[1]	205	!
	206	!-- x-direction
	207	ukomp = u(k,j,i) - u_gtrans
[1353]	208	IF ( ukomp > 0.0_wp ) THEN
[1320]	209	tend(k,j,i) = tend(k,j,i) - ukomp * &
[2232]	210	( u(k,j,i) - u(k,j,i-1) ) * ddx &
	211	* MERGE( 1.0_wp, 0.0_wp, &
	212	BTEST( wall_flags_0(k,j,i), 1 ) )
[1]	213	ELSE
[1320]	214	tend(k,j,i) = tend(k,j,i) - ukomp * &
[2232]	215	( u(k,j,i+1) - u(k,j,i) ) * ddx &
	216	* MERGE( 1.0_wp, 0.0_wp, &
	217	BTEST( wall_flags_0(k,j,i), 1 ) )
[1]	218	ENDIF
	219	!
	220	!-- y-direction
[1353]	221	vkomp = 0.25_wp * ( v(k,j,i) + v(k,j+1,i) + v(k,j,i-1) + v(k,j+1,i-1) &
[1]	222	) - v_gtrans
[1353]	223	IF ( vkomp > 0.0_wp ) THEN
[1320]	224	tend(k,j,i) = tend(k,j,i) - vkomp * &
[2232]	225	( u(k,j,i) - u(k,j-1,i) ) * ddy &
	226	* MERGE( 1.0_wp, 0.0_wp, &
	227	BTEST( wall_flags_0(k,j,i), 1 ) )
[1]	228	ELSE
[1320]	229	tend(k,j,i) = tend(k,j,i) - vkomp * &
[2232]	230	( u(k,j+1,i) - u(k,j,i) ) * ddy &
	231	* MERGE( 1.0_wp, 0.0_wp, &
	232	BTEST( wall_flags_0(k,j,i), 1 ) )
[1]	233	ENDIF
	234	!
	235	!-- z-direction
[1353]	236	wkomp = 0.25_wp * ( w(k,j,i) + w(k-1,j,i) + w(k,j,i-1) + w(k-1,j,i-1) )
	237	IF ( wkomp > 0.0_wp ) THEN
[1320]	238	tend(k,j,i) = tend(k,j,i) - wkomp * &
[2232]	239	( u(k,j,i) - u(k-1,j,i) ) * ddzu(k) &
	240	* MERGE( 1.0_wp, 0.0_wp, &
	241	BTEST( wall_flags_0(k,j,i), 1 ) )
[1]	242	ELSE
[1320]	243	tend(k,j,i) = tend(k,j,i) - wkomp * &
[2232]	244	( u(k+1,j,i) - u(k,j,i) ) * ddzu(k+1) &
	245	* MERGE( 1.0_wp, 0.0_wp, &
	246	BTEST( wall_flags_0(k,j,i), 1 ) )
[1]	247	ENDIF
	248
	249	ENDDO
	250
	251	END SUBROUTINE advec_u_up_ij
	252
	253	END MODULE advec_u_up_mod

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |