Home


About us
PALM
PALM-4U
Installation
Release notes
Documentation
Getting Help
Gallery
Developers area

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

Last change on this file since 1374 was 1374, checked in by raasch, 10 years ago

bugfixes:
missing variables added to ONLY lists in USE statements (advec_s_bc, advec_s_pw, advec_s_up, advec_ws, buoyancy, diffusion_e, diffusion_s, fft_xy, flow_statistics, palm, prognostic_equations)
missing module kinds added (cuda_fft_interfaces)
dpk renamed dp (fft_xy)
missing dependency for check_open added (Makefile)
variables removed from acc-present-list (diffusion_e, diffusion_w, diffusivities, production_e, wall_fluxes)
syntax errors removed from openacc-branch (flow_statistics)
USE-statement for nopointer-case added (swap_timelevel)
  • Property svn:keywords set to Id
File size: 7.5 KB
Line 
1 MODULE advec_s_up_mod
2
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!
17! Copyright 1997-2014 Leibniz Universitaet Hannover
18!--------------------------------------------------------------------------------!
19!
20! Current revisions:
21! -----------------
22! missing variables added to ONLY list
23!
24! Former revisions:
25! -----------------
26! $Id: advec_s_up.f90 1374 2014-04-25 12:55:07Z raasch $
27!
28! 1353 2014-04-08 15:21:23Z heinze
29! REAL constants provided with KIND-attribute
30!
31! 1320 2014-03-20 08:40:49Z raasch
32! ONLY-attribute added to USE-statements,
33! kind-parameters added to all INTEGER and REAL declaration statements,
34! kinds are defined in new module kinds,
35! revision history before 2012 removed,
36! comment fields (!:) to be used for variable explanations added to
37! all variable declaration statements
38!
39! 1036 2012-10-22 13:43:42Z raasch
40! code put under GPL (PALM 3.9)
41!
42! 1010 2012-09-20 07:59:54Z raasch
43! cpp switch __nopointer added for pointer free version
44!
45! 981 2012-08-09 14:57:44Z maronga
46! Typo removed
47!
48! Revision 1.1  1997/08/29 08:54:33  raasch
49! Initial revision
50!
51!
52! Description:
53! ------------
54! Advection term for scalar quantities using the Upstream scheme.
55! NOTE: vertical advection at k=1 still has wrong grid spacing for w>0!
56!       The same problem occurs for all topography boundaries!
57!------------------------------------------------------------------------------!
58
59    PRIVATE
60    PUBLIC advec_s_up
61
62    INTERFACE advec_s_up
63       MODULE PROCEDURE advec_s_up
64       MODULE PROCEDURE advec_s_up_ij
65    END INTERFACE advec_s_up
66
67 CONTAINS
68
69
70!------------------------------------------------------------------------------!
71! Call for all grid points
72!------------------------------------------------------------------------------!
73    SUBROUTINE advec_s_up( sk )
74
75       USE arrays_3d,                                                          &
76           ONLY:  ddzu, tend, u, v, w
77
78       USE control_parameters,                                                 &
79           ONLY:  u_gtrans, v_gtrans
80
81       USE grid_variables,                                                     &
82           ONLY:  ddx, ddy
83
84       USE indices,                                                            &
85           ONLY:  nxl, nxlg, nxr, nxrg, nyn, nyng, nys, nysg, nzb, nzb_s_inner,&
86                  nzt
87
88       USE kinds
89
90
91       IMPLICIT NONE
92
93       INTEGER(iwp) ::  i !:
94       INTEGER(iwp) ::  j !:
95       INTEGER(iwp) ::  k !:
96
97       REAL(wp) ::  ukomp !:
98       REAL(wp) ::  vkomp !:
99       REAL(wp) ::  wkomp !:
100#if defined( __nopointer )
101       REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ::  sk !:
102#else
103       REAL(wp), DIMENSION(:,:,:), POINTER ::  sk
104#endif
105
106
107       DO  i = nxl, nxr
108          DO  j = nys, nyn
109             DO  k = nzb_s_inner(j,i)+1, nzt
110!
111!--             x-direction
112                ukomp = 0.5_wp * ( u(k,j,i) + u(k,j,i+1) ) - u_gtrans
113                IF ( ukomp > 0.0_wp )  THEN
114                   tend(k,j,i) = tend(k,j,i) - ukomp *                         &
115                                         ( sk(k,j,i) - sk(k,j,i-1) ) * ddx
116                ELSE
117                   tend(k,j,i) = tend(k,j,i) - ukomp *                         &
118                                         ( sk(k,j,i+1) - sk(k,j,i) ) * ddx
119                ENDIF
120!
121!--             y-direction
122                vkomp = 0.5_wp * ( v(k,j,i) + v(k,j+1,i) ) - v_gtrans
123                IF ( vkomp > 0.0_wp )  THEN
124                   tend(k,j,i) = tend(k,j,i) - vkomp *                         &
125                                         ( sk(k,j,i) - sk(k,j-1,i) ) * ddy
126                ELSE
127                   tend(k,j,i) = tend(k,j,i) - vkomp *                         &
128                                         ( sk(k,j+1,i) - sk(k,j,i) ) * ddy
129                ENDIF
130!
131!--             z-direction
132                wkomp = 0.5_wp * ( w(k,j,i) + w(k-1,j,i) )
133                IF ( wkomp > 0.0_wp )  THEN
134                   tend(k,j,i) = tend(k,j,i) - wkomp *                         &
135                                         ( sk(k,j,i) - sk(k-1,j,i) ) * ddzu(k)
136                ELSE
137                   tend(k,j,i) = tend(k,j,i) - wkomp *                         &
138                                         ( sk(k+1,j,i)-sk(k,j,i) ) * ddzu(k+1)
139                ENDIF
140
141             ENDDO
142          ENDDO
143       ENDDO
144
145    END SUBROUTINE advec_s_up
146
147
148!------------------------------------------------------------------------------!
149! Call for grid point i,j
150!------------------------------------------------------------------------------!
151    SUBROUTINE advec_s_up_ij( i, j, sk )
152
153       USE arrays_3d,                                                          &
154           ONLY:  ddzu, tend, u, v, w
155
156       USE control_parameters,                                                 &
157           ONLY:  u_gtrans, v_gtrans
158
159       USE grid_variables,                                                     &
160           ONLY:  ddx, ddy
161
162       USE indices,                                                            &
163           ONLY:  nxlg, nxrg, nyng, nysg, nzb, nzb_s_inner, nzt
164
165       USE kinds
166
167
168       IMPLICIT NONE
169
170       INTEGER(iwp) ::  i !:
171       INTEGER(iwp) ::  j !:
172       INTEGER(iwp) ::  k !:
173
174       REAL(wp) ::  ukomp !:
175       REAL(wp) ::  vkomp !:
176       REAL(wp) ::  wkomp !:
177       
178#if defined( __nopointer )
179       REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ::  sk !:
180#else
181       REAL(wp), DIMENSION(:,:,:), POINTER ::  sk
182#endif
183
184
185       DO  k = nzb_s_inner(j,i)+1, nzt
186!
187!--       x-direction
188          ukomp = 0.5_wp * ( u(k,j,i) + u(k,j,i+1) ) - u_gtrans
189          IF ( ukomp > 0.0_wp )  THEN
190             tend(k,j,i) = tend(k,j,i) - ukomp *                               &
191                                         ( sk(k,j,i) - sk(k,j,i-1) ) * ddx
192          ELSE
193             tend(k,j,i) = tend(k,j,i) - ukomp *                               &
194                                         ( sk(k,j,i+1) - sk(k,j,i) ) * ddx
195          ENDIF
196!
197!--       y-direction
198          vkomp = 0.5_wp * ( v(k,j,i) + v(k,j+1,i) ) - v_gtrans
199          IF ( vkomp > 0.0_wp )  THEN
200             tend(k,j,i) = tend(k,j,i) - vkomp *                               &
201                                         ( sk(k,j,i) - sk(k,j-1,i) ) * ddy
202          ELSE
203             tend(k,j,i) = tend(k,j,i) - vkomp *                               &
204                                         ( sk(k,j+1,i) - sk(k,j,i) ) * ddy
205          ENDIF
206!
207!--       z-direction
208          wkomp = 0.5_wp * ( w(k,j,i) + w(k-1,j,i) )
209          IF ( wkomp > 0.0_wp )  THEN
210             tend(k,j,i) = tend(k,j,i) - wkomp *                               &
211                                         ( sk(k,j,i) - sk(k-1,j,i) ) * ddzu(k)
212          ELSE
213             tend(k,j,i) = tend(k,j,i) - wkomp *                               &
214                                         ( sk(k+1,j,i)-sk(k,j,i) ) * ddzu(k+1)
215          ENDIF
216
217       ENDDO
218
219    END SUBROUTINE advec_s_up_ij
220
221 END MODULE advec_s_up_mod
Note: See TracBrowser for help on using the repository browser.
                                                                                                                                                                                                                                                                                                                                                                               
  | Impressum | ©Leibniz Universität Hannover |