Home

Context Navigation

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

Last change on this file since 1332 was 1321, checked in by raasch, 11 years ago
last commit documented
Property svn:keywords set to `Id`
File size: 7.0 KB

Rev	Line
[1]	1	MODULE advec_u_up_mod
	2
[1036]	3	!--------------------------------------------------------------------------------!
	4	! This file is part of PALM.
	5	!
	6	! PALM is free software: you can redistribute it and/or modify it under the terms
	7	! of the GNU General Public License as published by the Free Software Foundation,
	8	! either version 3 of the License, or (at your option) any later version.
	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	!
[1310]	17	! Copyright 1997-2014 Leibniz Universitaet Hannover
[1036]	18	!--------------------------------------------------------------------------------!
	19	!
[484]	20	! Current revisions:
[1]	21	! -----------------
[1321]	22	!
	23	!
	24	! Former revisions:
	25	! -----------------
	26	! $Id: advec_u_up.f90 1321 2014-03-20 09:40:40Z suehring $
	27	!
	28	! 1320 2014-03-20 08:40:49Z raasch
[1320]	29	! ONLY-attribute added to USE-statements,
	30	! kind-parameters added to all INTEGER and REAL declaration statements,
	31	! kinds are defined in new module kinds,
	32	! revision history before 2012 removed,
	33	! comment fields (!:) to be used for variable explanations added to
	34	! all variable declaration statements
[1]	35	!
[1037]	36	! 1036 2012-10-22 13:43:42Z raasch
	37	! code put under GPL (PALM 3.9)
	38	!
[1]	39	! Revision 1.1 1997/08/29 08:55:25 raasch
	40	! Initial revision
	41	!
	42	!
	43	! Description:
	44	! ------------
	45	! Advection term for the u velocity-component using upstream scheme.
	46	! NOTE: vertical advection at k=1 still has wrong grid spacing for w>0!
	47	! The same problem occurs for all topography boundaries!
	48	!------------------------------------------------------------------------------!
	49
	50	PRIVATE
	51	PUBLIC advec_u_up
	52
	53	INTERFACE advec_u_up
	54	MODULE PROCEDURE advec_u_up
	55	MODULE PROCEDURE advec_u_up_ij
	56	END INTERFACE advec_u_up
	57
	58	CONTAINS
	59
	60
	61	!------------------------------------------------------------------------------!
	62	! Call for all grid points
	63	!------------------------------------------------------------------------------!
	64	SUBROUTINE advec_u_up
	65
[1320]	66	USE arrays_3d, &
	67	ONLY: ddzu, tend, u, v, w
[1]	68
[1320]	69	USE control_parameters, &
	70	ONLY: u_gtrans, v_gtrans
	71
	72	USE grid_variables, &
	73	ONLY: ddx, ddy
	74
	75	USE indices, &
	76	ONLY: nxlu, nxr, nyn, nys, nzb_u_inner, nzt
	77
	78	USE kinds
	79
	80
[1]	81	IMPLICIT NONE
	82
[1320]	83	INTEGER(iwp) :: i !:
	84	INTEGER(iwp) :: j !:
	85	INTEGER(iwp) :: k !:
[1]	86
[1320]	87	REAL(wp) :: ukomp !:
	88	REAL(wp) :: vkomp !:
	89	REAL(wp) :: wkomp !:
[1]	90
[1320]	91
[106]	92	DO i = nxlu, nxr
[1]	93	DO j = nys, nyn
	94	DO k = nzb_u_inner(j,i)+1, nzt
	95	!
	96	!-- x-direction
	97	ukomp = u(k,j,i) - u_gtrans
	98	IF ( ukomp > 0.0 ) THEN
[1320]	99	tend(k,j,i) = tend(k,j,i) - ukomp * &
[1]	100	( u(k,j,i) - u(k,j,i-1) ) * ddx
	101	ELSE
[1320]	102	tend(k,j,i) = tend(k,j,i) - ukomp * &
[1]	103	( u(k,j,i+1) - u(k,j,i) ) * ddx
	104	ENDIF
	105	!
	106	!-- y-direction
[1320]	107	vkomp = 0.25 * ( v(k,j,i) + v(k,j+1,i) + &
[1]	108	v(k,j,i-1) + v(k,j+1,i-1) ) - v_gtrans
	109	IF ( vkomp > 0.0 ) THEN
[1320]	110	tend(k,j,i) = tend(k,j,i) - vkomp * &
[1]	111	( u(k,j,i) - u(k,j-1,i) ) * ddy
	112	ELSE
[1320]	113	tend(k,j,i) = tend(k,j,i) - vkomp * &
[1]	114	( u(k,j+1,i) - u(k,j,i) ) * ddy
	115	ENDIF
	116	!
	117	!-- z-direction
[1320]	118	wkomp = 0.25 * ( w(k,j,i) + w(k-1,j,i) + &
[1]	119	w(k,j,i-1) + w(k-1,j,i-1) )
	120	IF ( wkomp > 0.0 ) THEN
[1320]	121	tend(k,j,i) = tend(k,j,i) - wkomp * &
[1]	122	( u(k,j,i) - u(k-1,j,i) ) * ddzu(k)
	123	ELSE
[1320]	124	tend(k,j,i) = tend(k,j,i) - wkomp * &
[1]	125	( u(k+1,j,i) - u(k,j,i) ) * ddzu(k+1)
	126	ENDIF
	127
	128	ENDDO
	129	ENDDO
	130	ENDDO
	131
	132	END SUBROUTINE advec_u_up
	133
	134
	135	!------------------------------------------------------------------------------!
	136	! Call for grid point i,j
	137	!------------------------------------------------------------------------------!
	138	SUBROUTINE advec_u_up_ij( i, j )
	139
[1320]	140	USE arrays_3d, &
	141	ONLY: ddzu, tend, u, v, w
[1]	142
[1320]	143	USE control_parameters, &
	144	ONLY: u_gtrans, v_gtrans
	145
	146	USE grid_variables, &
	147	ONLY: ddx, ddy
	148
	149	USE indices, &
	150	ONLY: nzb_u_inner, nzt
	151
	152	USE kinds
	153
	154
[1]	155	IMPLICIT NONE
	156
[1320]	157	INTEGER(iwp) :: i !:
	158	INTEGER(iwp) :: j !:
	159	INTEGER(iwp) :: k !:
[1]	160
[1320]	161	REAL(wp) :: ukomp !:
	162	REAL(wp) :: vkomp !:
	163	REAL(wp) :: wkomp !:
[1]	164
	165
	166	DO k = nzb_u_inner(j,i)+1, nzt
	167	!
	168	!-- x-direction
	169	ukomp = u(k,j,i) - u_gtrans
	170	IF ( ukomp > 0.0 ) THEN
[1320]	171	tend(k,j,i) = tend(k,j,i) - ukomp * &
[1]	172	( u(k,j,i) - u(k,j,i-1) ) * ddx
	173	ELSE
[1320]	174	tend(k,j,i) = tend(k,j,i) - ukomp * &
[1]	175	( u(k,j,i+1) - u(k,j,i) ) * ddx
	176	ENDIF
	177	!
	178	!-- y-direction
[1320]	179	vkomp = 0.25 * ( v(k,j,i) + v(k,j+1,i) + v(k,j,i-1) + v(k,j+1,i-1) &
[1]	180	) - v_gtrans
	181	IF ( vkomp > 0.0 ) THEN
[1320]	182	tend(k,j,i) = tend(k,j,i) - vkomp * &
[1]	183	( u(k,j,i) - u(k,j-1,i) ) * ddy
	184	ELSE
[1320]	185	tend(k,j,i) = tend(k,j,i) - vkomp * &
[1]	186	( u(k,j+1,i) - u(k,j,i) ) * ddy
	187	ENDIF
	188	!
	189	!-- z-direction
	190	wkomp = 0.25 * ( w(k,j,i) + w(k-1,j,i) + w(k,j,i-1) + w(k-1,j,i-1) )
	191	IF ( wkomp > 0.0 ) THEN
[1320]	192	tend(k,j,i) = tend(k,j,i) - wkomp * &
[1]	193	( u(k,j,i) - u(k-1,j,i) ) * ddzu(k)
	194	ELSE
[1320]	195	tend(k,j,i) = tend(k,j,i) - wkomp * &
[1]	196	( u(k+1,j,i) - u(k,j,i) ) * ddzu(k+1)
	197	ENDIF
	198
	199	ENDDO
	200
	201	END SUBROUTINE advec_u_up_ij
	202
	203	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 |