Home

Context Navigation

source: palm/trunk/SOURCE/advec_w_up.f90 @ 1336

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

Rev	Line
[1]	1	MODULE advec_w_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_w_up.f90 1321 2014-03-20 09:40:40Z raasch $
	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:56:33 raasch
	40	! Initial revision
	41	!
	42	!
	43	! Description:
	44	! ------------
	45	! Advection term for the w 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_w_up
	52
	53	INTERFACE advec_w_up
	54	MODULE PROCEDURE advec_w_up
	55	MODULE PROCEDURE advec_w_up_ij
	56	END INTERFACE advec_w_up
	57
	58	CONTAINS
	59
	60
	61	!------------------------------------------------------------------------------!
	62	! Call for all grid points
	63	!------------------------------------------------------------------------------!
	64	SUBROUTINE advec_w_up
	65
[1320]	66	USE arrays_3d, &
	67	ONLY: ddzw, 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: nxl, nxr, nyn, nys, nzb_w_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 !:
[1]	89
[1320]	90
[1]	91	DO i = nxl, nxr
	92	DO j = nys, nyn
	93	DO k = nzb_w_inner(j,i)+1, nzt-1
	94	!
	95	!-- x-direction
[1320]	96	ukomp = 0.25 * ( u(k,j,i) + u(k,j,i+1) + &
[1]	97	u(k+1,j,i) + u(k+1,j,i+1) ) - u_gtrans
	98	IF ( ukomp > 0.0 ) THEN
[1320]	99	tend(k,j,i) = tend(k,j,i) - ukomp * &
[1]	100	( w(k,j,i) - w(k,j,i-1) ) * ddx
	101	ELSE
[1320]	102	tend(k,j,i) = tend(k,j,i) - ukomp * &
[1]	103	( w(k,j,i+1) - w(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+1,j,i) + v(k+1,j+1,i) ) - v_gtrans
	109	IF ( vkomp > 0.0 ) THEN
[1320]	110	tend(k,j,i) = tend(k,j,i) - vkomp * &
[1]	111	( w(k,j,i) - w(k,j-1,i) ) * ddy
	112	ELSE
[1320]	113	tend(k,j,i) = tend(k,j,i) - vkomp * &
[1]	114	( w(k,j+1,i) - w(k,j,i) ) * ddy
	115	ENDIF
	116	!
	117	!-- z-direction
	118	IF ( w(k,j,i) > 0.0 ) THEN
[1320]	119	tend(k,j,i) = tend(k,j,i) - w(k,j,i) * &
[1]	120	( w(k,j,i) - w(k-1,j,i) ) * ddzw(k)
	121	ELSE
[1320]	122	tend(k,j,i) = tend(k,j,i) - w(k,j,i) * &
[1]	123	( w(k+1,j,i) - w(k,j,i) ) * ddzw(k+1)
	124	ENDIF
	125
	126	ENDDO
	127	ENDDO
	128	ENDDO
	129
	130	END SUBROUTINE advec_w_up
	131
	132
	133	!------------------------------------------------------------------------------!
	134	! Call for grid point i,j
	135	!------------------------------------------------------------------------------!
	136	SUBROUTINE advec_w_up_ij( i, j )
	137
[1320]	138	USE arrays_3d, &
	139	ONLY: ddzw, tend, u, v, w
[1]	140
[1320]	141	USE control_parameters, &
	142	ONLY: u_gtrans, v_gtrans
	143
	144	USE grid_variables, &
	145	ONLY: ddx, ddy
	146
	147	USE indices, &
	148	ONLY: nzb_w_inner, nzt
	149
	150	USE kinds
	151
	152
[1]	153	IMPLICIT NONE
	154
[1320]	155	INTEGER(iwp) :: i !:
	156	INTEGER(iwp) :: j !:
	157	INTEGER(iwp) :: k !:
[1]	158
[1320]	159	REAL(wp) :: ukomp !:
	160	REAL(wp) :: vkomp !:
[1]	161
[1320]	162
[1]	163	DO k = nzb_w_inner(j,i)+1, nzt-1
	164	!
	165	!-- x-direction
[1320]	166	ukomp = 0.25 * ( u(k,j,i) + u(k,j,i+1) + u(k+1,j,i) + u(k+1,j,i+1) &
[1]	167	) - u_gtrans
	168	IF ( ukomp > 0.0 ) THEN
[1320]	169	tend(k,j,i) = tend(k,j,i) - ukomp * &
[1]	170	( w(k,j,i) - w(k,j,i-1) ) * ddx
	171	ELSE
[1320]	172	tend(k,j,i) = tend(k,j,i) - ukomp * &
[1]	173	( w(k,j,i+1) - w(k,j,i) ) * ddx
	174	ENDIF
	175	!
	176	!-- y-direction
[1320]	177	vkomp = 0.25 * ( v(k,j,i) + v(k,j+1,i) + v(k+1,j,i) + v(k+1,j+1,i) &
[1]	178	) - v_gtrans
	179	IF ( vkomp > 0.0 ) THEN
[1320]	180	tend(k,j,i) = tend(k,j,i) - vkomp * &
[1]	181	( w(k,j,i) - w(k,j-1,i) ) * ddy
	182	ELSE
[1320]	183	tend(k,j,i) = tend(k,j,i) - vkomp * &
[1]	184	( w(k,j+1,i) - w(k,j,i) ) * ddy
	185	ENDIF
	186	!
	187	!-- z-direction
	188	IF ( w(k,j,i) > 0.0 ) THEN
[1320]	189	tend(k,j,i) = tend(k,j,i) - w(k,j,i) * &
[1]	190	( w(k,j,i) - w(k-1,j,i) ) * ddzw(k)
	191	ELSE
[1320]	192	tend(k,j,i) = tend(k,j,i) - w(k,j,i) * &
[1]	193	( w(k+1,j,i) - w(k,j,i) ) * ddzw(k+1)
	194	ENDIF
	195
	196	ENDDO
	197
	198	END SUBROUTINE advec_w_up_ij
	199
	200	END MODULE advec_w_up_mod

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |