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