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

Last change on this file since 1 was 1, checked in by raasch, 15 years ago

Initial repository layout and content

File size: 5.6 KB
Line 
1 MODULE advec_s_up_mod
2
3!------------------------------------------------------------------------------!
4! Actual revisions:
5! -----------------
6!
7!
8! Forner revisions:
9! -----------------
10! $Log: advec_s_up.f90,v $
11! Revision 1.11  2006/02/23 09:43:44  raasch
12! nzb_2d replaced by nzb_s_inner
13!
14! Revision 1.10  2004/01/30 10:10:39  raasch
15! Scalar lower k index nzb replaced by 2d-array nzb_2d
16!
17! Revision 1.9  2003/03/12 16:16:25  raasch
18! Full code replaced in the call for all gridpoints instead of calling the
19! _ij version (required by NEC, because otherwise no vectorization)
20!
21! Revision 1.8  2002/06/11 12:23:31  raasch
22! Former subroutine changed to a module which allows to be called for all grid
23! points of a single vertical column with index i,j or for all grid points by
24! using function overloading.
25! Array sk now declared as a pointer.
26!
27! Revision 1.7  2001/03/29 17:30:31  raasch
28! Translation of remaining German identifiers (variables, subroutines, etc.)
29!
30! Revision 1.6  2001/01/22 04:43:56  raasch
31! Module test_variables removed
32!
33! Revision 1.5  2000/01/20 09:16:59  letzel
34! All comments translated into English
35!
36! Revision 1.4  1998/07/06 12:03:46  raasch
37! + USE test_variables
38!
39! Revision 1.3  1998/04/21 15:52:14  raasch
40! Galilei-Transformation eingebaut
41!
42! Revision 1.2  1997/09/09 08:27:24  raasch
43! Kehrwerte der Gitterweiten implementiert
44!
45! Revision 1.1  1997/08/29 08:54:33  raasch
46! Initial revision
47!
48!
49! Description:
50! ------------
51! Advection term for scalar quantities using the Upstream scheme.
52! NOTE: vertical advection at k=1 still has wrong grid spacing for w>0!
53!       The same problem occurs for all topography boundaries!
54!------------------------------------------------------------------------------!
55
56    PRIVATE
57    PUBLIC advec_s_up
58
59    INTERFACE advec_s_up
60       MODULE PROCEDURE advec_s_up
61       MODULE PROCEDURE advec_s_up_ij
62    END INTERFACE advec_s_up
63
64 CONTAINS
65
66
67!------------------------------------------------------------------------------!
68! Call for all grid points
69!------------------------------------------------------------------------------!
70    SUBROUTINE advec_s_up( sk )
71
72       USE arrays_3d
73       USE control_parameters
74       USE grid_variables
75       USE indices
76
77       IMPLICIT NONE
78
79       INTEGER ::  i, j, k
80
81       REAL ::  ukomp, vkomp, wkomp
82       REAL, DIMENSION(:,:,:), POINTER ::  sk
83
84
85       DO  i = nxl, nxr
86          DO  j = nys, nyn
87             DO  k = nzb_s_inner(j,i)+1, nzt
88!
89!--             x-direction
90                ukomp = 0.5 * ( u(k,j,i) + u(k,j,i+1) ) - u_gtrans
91                IF ( ukomp > 0.0 )  THEN
92                   tend(k,j,i) = tend(k,j,i) - ukomp * &
93                                         ( sk(k,j,i) - sk(k,j,i-1) ) * ddx
94                ELSE
95                   tend(k,j,i) = tend(k,j,i) - ukomp * &
96                                         ( sk(k,j,i+1) - sk(k,j,i) ) * ddx
97                ENDIF
98!
99!--             y-direction
100                vkomp = 0.5 * ( v(k,j,i) + v(k,j+1,i) ) - v_gtrans
101                IF ( vkomp > 0.0 )  THEN
102                   tend(k,j,i) = tend(k,j,i) - vkomp * &
103                                         ( sk(k,j,i) - sk(k,j-1,i) ) * ddy
104                ELSE
105                   tend(k,j,i) = tend(k,j,i) - vkomp * &
106                                         ( sk(k,j+1,i) - sk(k,j,i) ) * ddy
107                ENDIF
108!
109!--             z-direction
110                wkomp = 0.5 * ( w(k,j,i) + w(k-1,j,i) )
111                IF ( wkomp > 0.0 )  THEN
112                   tend(k,j,i) = tend(k,j,i) - wkomp * &
113                                         ( sk(k,j,i) - sk(k-1,j,i) ) * ddzu(k)
114                ELSE
115                   tend(k,j,i) = tend(k,j,i) - wkomp * &
116                                         ( sk(k+1,j,i)-sk(k,j,i) ) * ddzu(k+1)
117                ENDIF
118
119             ENDDO
120          ENDDO
121       ENDDO
122
123    END SUBROUTINE advec_s_up
124
125
126!------------------------------------------------------------------------------!
127! Call for grid point i,j
128!------------------------------------------------------------------------------!
129    SUBROUTINE advec_s_up_ij( i, j, sk )
130
131       USE arrays_3d
132       USE control_parameters
133       USE grid_variables
134       USE indices
135
136       IMPLICIT NONE
137
138       INTEGER ::  i, j, k
139
140       REAL ::  ukomp, vkomp, wkomp
141       REAL, DIMENSION(:,:,:), POINTER ::  sk
142
143
144       DO  k = nzb_s_inner(j,i)+1, nzt
145!
146!--       x-direction
147          ukomp = 0.5 * ( u(k,j,i) + u(k,j,i+1) ) - u_gtrans
148          IF ( ukomp > 0.0 )  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 * ( v(k,j,i) + v(k,j+1,i) ) - v_gtrans
158          IF ( vkomp > 0.0 )  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 * ( w(k,j,i) + w(k-1,j,i) )
168          IF ( wkomp > 0.0 )  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
178    END SUBROUTINE advec_s_up_ij
179
180 END MODULE advec_s_up_mod
Note: See TracBrowser for help on using the repository browser.