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

Last change on this file since 1001 was 982, checked in by maronga, 12 years ago

last commit documented

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