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