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

Last change on this file since 1018 was 1011, checked in by raasch, 12 years ago

last commit documented

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