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

Last change on this file since 4360 was 4360, checked in by suehring, 16 months ago

Bugfix in output of time-averaged plant-canopy quanities; Output of plant-canopy data only where tall canopy is defined; land-surface model: fix wrong location strings; tests: update urban test case; all source code files: copyright update

  • Property svn:keywords set to Id
File size: 7.4 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-2020 Leibniz Universitaet Hannover
18!------------------------------------------------------------------------------!
19!
20! Current revisions:
21! -----------------
22!
23!
24! Former revisions:
25! -----------------
26! $Id: advec_s_up.f90 4360 2020-01-07 11:25:50Z suehring $
27! Corrected "Former revisions" section
28!
29! 3927 2019-04-23 13:24:29Z raasch
30! pointer attribute removed from scalar 3d-array for performance reasons
31!
32! 3665 2019-01-10 08:28:24Z raasch
33! unused variables removed
34!
35! 3655 2019-01-07 16:51:22Z knoop
36! nopointer option removed
37!
38! Revision 1.1  1997/08/29 08:54:33  raasch
39! Initial revision
40!
41!
42! Description:
43! ------------
44!> Advection term for scalar quantities using the Upstream scheme.
45!> NOTE: vertical advection at k=1 still has wrong grid spacing for w>0!
46!>       The same problem occurs for all topography boundaries!
47!------------------------------------------------------------------------------!
48 MODULE advec_s_up_mod
49 
50
51    PRIVATE
52    PUBLIC advec_s_up
53
54    INTERFACE advec_s_up
55       MODULE PROCEDURE advec_s_up
56       MODULE PROCEDURE advec_s_up_ij
57    END INTERFACE advec_s_up
58
59 CONTAINS
60
61
62!------------------------------------------------------------------------------!
63! Description:
64! ------------
65!> Call for all grid points
66!------------------------------------------------------------------------------!
67    SUBROUTINE advec_s_up( sk )
68
69       USE arrays_3d,                                                          &
70           ONLY:  ddzu, tend, u, v, w
71
72       USE control_parameters,                                                 &
73           ONLY:  u_gtrans, v_gtrans
74
75       USE grid_variables,                                                     &
76           ONLY:  ddx, ddy
77
78       USE indices,                                                            &
79           ONLY:  nxl, nxlg, nxr, nxrg, nyn, nyng, nys, nysg, nzb, nzt
80
81       USE kinds
82
83
84       IMPLICIT NONE
85
86       INTEGER(iwp) ::  i !< grid index along x-direction
87       INTEGER(iwp) ::  j !< grid index along y-direction
88       INTEGER(iwp) ::  k !< grid index along z-direction
89
90       REAL(wp) ::  ukomp !< advection velocity along x-direction
91       REAL(wp) ::  vkomp !< advection velocity along y-direction
92       REAL(wp) ::  wkomp !< advection velocity along z-direction
93
94       REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ::  sk !< treated scalar
95
96
97       DO  i = nxl, nxr
98          DO  j = nys, nyn
99             DO  k = nzb+1, nzt
100!
101!--             x-direction
102                ukomp = 0.5_wp * ( u(k,j,i) + u(k,j,i+1) ) - u_gtrans
103                IF ( ukomp > 0.0_wp )  THEN
104                   tend(k,j,i) = tend(k,j,i) - ukomp *                         &
105                                         ( sk(k,j,i) - sk(k,j,i-1) ) * ddx
106                ELSE
107                   tend(k,j,i) = tend(k,j,i) - ukomp *                         &
108                                         ( sk(k,j,i+1) - sk(k,j,i) ) * ddx
109                ENDIF
110!
111!--             y-direction
112                vkomp = 0.5_wp * ( v(k,j,i) + v(k,j+1,i) ) - v_gtrans
113                IF ( vkomp > 0.0_wp )  THEN
114                   tend(k,j,i) = tend(k,j,i) - vkomp *                         &
115                                         ( sk(k,j,i) - sk(k,j-1,i) ) * ddy
116                ELSE
117                   tend(k,j,i) = tend(k,j,i) - vkomp *                         &
118                                         ( sk(k,j+1,i) - sk(k,j,i) ) * ddy
119                ENDIF
120!
121!--             z-direction
122                wkomp = 0.5_wp * ( w(k,j,i) + w(k-1,j,i) )
123                IF ( wkomp > 0.0_wp )  THEN
124                   tend(k,j,i) = tend(k,j,i) - wkomp *                         &
125                                         ( sk(k,j,i) - sk(k-1,j,i) ) * ddzu(k)
126                ELSE
127                   tend(k,j,i) = tend(k,j,i) - wkomp *                         &
128                                         ( sk(k+1,j,i)-sk(k,j,i) ) * ddzu(k+1)
129                ENDIF
130
131             ENDDO
132          ENDDO
133       ENDDO
134
135    END SUBROUTINE advec_s_up
136
137
138!------------------------------------------------------------------------------!
139! Description:
140! ------------
141!> Call for grid point i,j
142!------------------------------------------------------------------------------!
143    SUBROUTINE advec_s_up_ij( i, j, sk )
144
145       USE arrays_3d,                                                          &
146           ONLY:  ddzu, tend, u, v, w
147
148       USE control_parameters,                                                 &
149           ONLY:  u_gtrans, v_gtrans
150
151       USE grid_variables,                                                     &
152           ONLY:  ddx, ddy
153
154       USE indices,                                                            &
155           ONLY:  nxlg, nxrg, nyng, nysg, nzb, nzt
156
157       USE kinds
158
159
160       IMPLICIT NONE
161
162       INTEGER(iwp) ::  i !< grid index along x-direction
163       INTEGER(iwp) ::  j !< grid index along y-direction
164       INTEGER(iwp) ::  k !< grid index along z-direction
165
166       REAL(wp) ::  ukomp !< advection velocity along x-direction
167       REAL(wp) ::  vkomp !< advection velocity along y-direction
168       REAL(wp) ::  wkomp !< advection velocity along z-direction
169       
170       REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ::  sk !< treated scalar
171
172
173       DO  k = nzb+1, nzt
174!
175!--       x-direction
176          ukomp = 0.5_wp * ( u(k,j,i) + u(k,j,i+1) ) - u_gtrans
177          IF ( ukomp > 0.0_wp )  THEN
178             tend(k,j,i) = tend(k,j,i) - ukomp *                               &
179                                         ( sk(k,j,i) - sk(k,j,i-1) ) * ddx
180          ELSE
181             tend(k,j,i) = tend(k,j,i) - ukomp *                               &
182                                         ( sk(k,j,i+1) - sk(k,j,i) ) * ddx
183          ENDIF
184!
185!--       y-direction
186          vkomp = 0.5_wp * ( v(k,j,i) + v(k,j+1,i) ) - v_gtrans
187          IF ( vkomp > 0.0_wp )  THEN
188             tend(k,j,i) = tend(k,j,i) - vkomp *                               &
189                                         ( sk(k,j,i) - sk(k,j-1,i) ) * ddy
190          ELSE
191             tend(k,j,i) = tend(k,j,i) - vkomp *                               &
192                                         ( sk(k,j+1,i) - sk(k,j,i) ) * ddy
193          ENDIF
194!
195!--       z-direction
196          wkomp = 0.5_wp * ( w(k,j,i) + w(k-1,j,i) )
197          IF ( wkomp > 0.0_wp )  THEN
198             tend(k,j,i) = tend(k,j,i) - wkomp *                               &
199                                         ( sk(k,j,i) - sk(k-1,j,i) ) * ddzu(k)
200          ELSE
201             tend(k,j,i) = tend(k,j,i) - wkomp *                               &
202                                         ( sk(k+1,j,i)-sk(k,j,i) ) * ddzu(k+1)
203          ENDIF
204
205       ENDDO
206
207    END SUBROUTINE advec_s_up_ij
208
209 END MODULE advec_s_up_mod
Note: See TracBrowser for help on using the repository browser.