Home

Context Navigation

source: palm/trunk/SOURCE/advec_s_up.f90 @ 3585

Last change on this file since 3585 was 3547, checked in by suehring, 6 years ago
variable description added some routines
Property svn:keywords set to `Id`
File size: 8.7 KB

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

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |