source: palm/trunk/SOURCE/advec_w_up.f90 @ 4

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

Id keyword set as property for all *.f90 files

  • Property svn:keywords set to Id
File size: 4.6 KB
Line 
1 MODULE advec_w_up_mod
2
3!------------------------------------------------------------------------------!
4! Actual revisions:
5! -----------------
6!
7!
8! Former revisions:
9! -----------------
10! $Id: advec_w_up.f90 4 2007-02-13 11:33:16Z raasch $
11! RCS Log replace by Id keyword, revision history cleaned up
12!
13! Revision 1.11  2006/02/23 09:47:23  raasch
14! *** empty log message ***
15!
16! Revision 1.1  1997/08/29 08:56:33  raasch
17! Initial revision
18!
19!
20! Description:
21! ------------
22! Advection term for the w velocity-component using upstream scheme.
23! NOTE: vertical advection at k=1 still has wrong grid spacing for w>0
24!       The same problem occurs for all topography boundaries!
25!------------------------------------------------------------------------------!
26
27    PRIVATE
28    PUBLIC advec_w_up
29
30    INTERFACE advec_w_up
31       MODULE PROCEDURE advec_w_up
32       MODULE PROCEDURE advec_w_up_ij
33    END INTERFACE advec_w_up
34
35 CONTAINS
36
37
38!------------------------------------------------------------------------------!
39! Call for all grid points
40!------------------------------------------------------------------------------!
41    SUBROUTINE advec_w_up
42
43       USE arrays_3d
44       USE control_parameters
45       USE grid_variables
46       USE indices
47
48       IMPLICIT NONE
49
50       INTEGER ::  i, j, k
51       REAL    ::  ukomp, vkomp
52
53
54       DO  i = nxl, nxr
55          DO  j = nys, nyn
56             DO  k = nzb_w_inner(j,i)+1, nzt-1
57!
58!--             x-direction
59                ukomp = 0.25 * ( u(k,j,i)   + u(k,j,i+1) + &
60                                 u(k+1,j,i) + u(k+1,j,i+1) ) - u_gtrans
61                IF ( ukomp > 0.0 )  THEN
62                   tend(k,j,i) = tend(k,j,i) - ukomp * &
63                                         ( w(k,j,i) - w(k,j,i-1) ) * ddx
64                ELSE
65                   tend(k,j,i) = tend(k,j,i) - ukomp * &
66                                         ( w(k,j,i+1) - w(k,j,i) ) * ddx
67                ENDIF
68!
69!--             y-direction
70                vkomp = 0.25 * ( v(k,j,i) + v(k,j+1,i) + &
71                                 v(k+1,j,i) + v(k+1,j+1,i) ) - v_gtrans
72                IF ( vkomp > 0.0 )  THEN
73                   tend(k,j,i) = tend(k,j,i) - vkomp * &
74                                         ( w(k,j,i) - w(k,j-1,i) ) * ddy
75                ELSE
76                   tend(k,j,i) = tend(k,j,i) - vkomp * &
77                                         ( w(k,j+1,i) - w(k,j,i) ) * ddy
78                ENDIF
79!
80!--             z-direction
81                IF ( w(k,j,i) > 0.0 )  THEN
82                   tend(k,j,i) = tend(k,j,i) - w(k,j,i) * &
83                                         ( w(k,j,i) - w(k-1,j,i) ) * ddzw(k)
84                ELSE
85                   tend(k,j,i) = tend(k,j,i) - w(k,j,i) * &
86                                         ( w(k+1,j,i) - w(k,j,i) ) * ddzw(k+1)
87                ENDIF
88
89             ENDDO
90          ENDDO
91       ENDDO
92
93    END SUBROUTINE advec_w_up
94
95
96!------------------------------------------------------------------------------!
97! Call for grid point i,j
98!------------------------------------------------------------------------------!
99    SUBROUTINE advec_w_up_ij( i, j )
100
101       USE arrays_3d
102       USE control_parameters
103       USE grid_variables
104       USE indices
105
106       IMPLICIT NONE
107
108       INTEGER ::  i, j, k
109       REAL    ::  ukomp, vkomp
110
111
112       DO  k = nzb_w_inner(j,i)+1, nzt-1
113!
114!--       x-direction
115          ukomp = 0.25 * ( u(k,j,i) + u(k,j,i+1) + u(k+1,j,i) + u(k+1,j,i+1) &
116                         ) - u_gtrans
117          IF ( ukomp > 0.0 )  THEN
118             tend(k,j,i) = tend(k,j,i) - ukomp * &
119                                         ( w(k,j,i) - w(k,j,i-1) ) * ddx
120          ELSE
121             tend(k,j,i) = tend(k,j,i) - ukomp * &
122                                         ( w(k,j,i+1) - w(k,j,i) ) * ddx
123          ENDIF
124!
125!--       y-direction
126          vkomp = 0.25 * ( v(k,j,i) + v(k,j+1,i) + v(k+1,j,i) + v(k+1,j+1,i) &
127                         ) - v_gtrans
128          IF ( vkomp > 0.0 )  THEN
129             tend(k,j,i) = tend(k,j,i) - vkomp * &
130                                         ( w(k,j,i) - w(k,j-1,i) ) * ddy
131          ELSE
132             tend(k,j,i) = tend(k,j,i) - vkomp * &
133                                         ( w(k,j+1,i) - w(k,j,i) ) * ddy
134          ENDIF
135!
136!--       z-direction
137          IF ( w(k,j,i) > 0.0 )  THEN
138             tend(k,j,i) = tend(k,j,i) - w(k,j,i) * &
139                                         ( w(k,j,i) - w(k-1,j,i) ) * ddzw(k)
140          ELSE
141             tend(k,j,i) = tend(k,j,i) - w(k,j,i) * &
142                                         ( w(k+1,j,i) - w(k,j,i) ) * ddzw(k+1)
143          ENDIF
144
145       ENDDO
146
147    END SUBROUTINE advec_w_up_ij
148
149 END MODULE advec_w_up_mod
Note: See TracBrowser for help on using the repository browser.