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

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

Id keyword set as property for all *.f90 files

  • Property svn:keywords set to Id
File size: 4.5 KB
Line 
1 MODULE advec_s_up_mod
2
3!------------------------------------------------------------------------------!
4! Actual revisions:
5! -----------------
6!
7!
8! Forner revisions:
9! -----------------
10! $Id: advec_s_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:43:44  raasch
14! nzb_2d replaced by nzb_s_inner
15!
16! Revision 1.1  1997/08/29 08:54:33  raasch
17! Initial revision
18!
19!
20! Description:
21! ------------
22! Advection term for scalar quantities using the 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_s_up
29
30    INTERFACE advec_s_up
31       MODULE PROCEDURE advec_s_up
32       MODULE PROCEDURE advec_s_up_ij
33    END INTERFACE advec_s_up
34
35 CONTAINS
36
37
38!------------------------------------------------------------------------------!
39! Call for all grid points
40!------------------------------------------------------------------------------!
41    SUBROUTINE advec_s_up( sk )
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
52       REAL ::  ukomp, vkomp, wkomp
53       REAL, DIMENSION(:,:,:), POINTER ::  sk
54
55
56       DO  i = nxl, nxr
57          DO  j = nys, nyn
58             DO  k = nzb_s_inner(j,i)+1, nzt
59!
60!--             x-direction
61                ukomp = 0.5 * ( u(k,j,i) + u(k,j,i+1) ) - u_gtrans
62                IF ( ukomp > 0.0 )  THEN
63                   tend(k,j,i) = tend(k,j,i) - ukomp * &
64                                         ( sk(k,j,i) - sk(k,j,i-1) ) * ddx
65                ELSE
66                   tend(k,j,i) = tend(k,j,i) - ukomp * &
67                                         ( sk(k,j,i+1) - sk(k,j,i) ) * ddx
68                ENDIF
69!
70!--             y-direction
71                vkomp = 0.5 * ( v(k,j,i) + v(k,j+1,i) ) - v_gtrans
72                IF ( vkomp > 0.0 )  THEN
73                   tend(k,j,i) = tend(k,j,i) - vkomp * &
74                                         ( sk(k,j,i) - sk(k,j-1,i) ) * ddy
75                ELSE
76                   tend(k,j,i) = tend(k,j,i) - vkomp * &
77                                         ( sk(k,j+1,i) - sk(k,j,i) ) * ddy
78                ENDIF
79!
80!--             z-direction
81                wkomp = 0.5 * ( w(k,j,i) + w(k-1,j,i) )
82                IF ( wkomp > 0.0 )  THEN
83                   tend(k,j,i) = tend(k,j,i) - wkomp * &
84                                         ( sk(k,j,i) - sk(k-1,j,i) ) * ddzu(k)
85                ELSE
86                   tend(k,j,i) = tend(k,j,i) - wkomp * &
87                                         ( sk(k+1,j,i)-sk(k,j,i) ) * ddzu(k+1)
88                ENDIF
89
90             ENDDO
91          ENDDO
92       ENDDO
93
94    END SUBROUTINE advec_s_up
95
96
97!------------------------------------------------------------------------------!
98! Call for grid point i,j
99!------------------------------------------------------------------------------!
100    SUBROUTINE advec_s_up_ij( i, j, sk )
101
102       USE arrays_3d
103       USE control_parameters
104       USE grid_variables
105       USE indices
106
107       IMPLICIT NONE
108
109       INTEGER ::  i, j, k
110
111       REAL ::  ukomp, vkomp, wkomp
112       REAL, DIMENSION(:,:,:), POINTER ::  sk
113
114
115       DO  k = nzb_s_inner(j,i)+1, nzt
116!
117!--       x-direction
118          ukomp = 0.5 * ( u(k,j,i) + u(k,j,i+1) ) - u_gtrans
119          IF ( ukomp > 0.0 )  THEN
120             tend(k,j,i) = tend(k,j,i) - ukomp * &
121                                         ( sk(k,j,i) - sk(k,j,i-1) ) * ddx
122          ELSE
123             tend(k,j,i) = tend(k,j,i) - ukomp * &
124                                         ( sk(k,j,i+1) - sk(k,j,i) ) * ddx
125          ENDIF
126!
127!--       y-direction
128          vkomp = 0.5 * ( v(k,j,i) + v(k,j+1,i) ) - v_gtrans
129          IF ( vkomp > 0.0 )  THEN
130             tend(k,j,i) = tend(k,j,i) - vkomp * &
131                                         ( sk(k,j,i) - sk(k,j-1,i) ) * ddy
132          ELSE
133             tend(k,j,i) = tend(k,j,i) - vkomp * &
134                                         ( sk(k,j+1,i) - sk(k,j,i) ) * ddy
135          ENDIF
136!
137!--       z-direction
138          wkomp = 0.5 * ( w(k,j,i) + w(k-1,j,i) )
139          IF ( wkomp > 0.0 )  THEN
140             tend(k,j,i) = tend(k,j,i) - wkomp * &
141                                         ( sk(k,j,i) - sk(k-1,j,i) ) * ddzu(k)
142          ELSE
143             tend(k,j,i) = tend(k,j,i) - wkomp * &
144                                         ( sk(k+1,j,i)-sk(k,j,i) ) * ddzu(k+1)
145          ENDIF
146
147       ENDDO
148
149    END SUBROUTINE advec_s_up_ij
150
151 END MODULE advec_s_up_mod
Note: See TracBrowser for help on using the repository browser.