source: palm/trunk/SOURCE/diffusion_s.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: 9.9 KB
Line 
1 MODULE diffusion_s_mod
2
3!------------------------------------------------------------------------------!
4! Actual revisions:
5! -----------------
6!
7!
8! Former revisions:
9! -----------------
10! $Log: diffusion_s.f90,v $
11! Revision 1.8  2006/02/23 10:34:17  raasch
12! nzb_2d replaced by nzb_s_outer in horizontal diffusion and by nzb_s_inner
13! or nzb_diff_s_inner, respectively, in vertical diffusion, prescribed surface
14! fluxes at vertically oriented topography
15!
16! Revision 1.7  2004/01/30 10:20:56  raasch
17! Scalar lower k index nzb replaced by 2d-array nzb_2d
18!
19! Revision 1.6  2003/03/12 16:25:32  raasch
20! Full code replaced in the call for all gridpoints instead of calling the
21! _ij version (required by NEC, because otherwise no vectorization)
22!
23! Revision 1.5  2002/06/11 12:52:41  raasch
24! Former subroutine changed to a module which allows to be called for all grid
25! points of a single vertical column with index i,j or for all grid points by
26! using function overloading.
27!
28! Revision 1.4  2001/03/30 07:11:44  raasch
29! Translation of remaining German identifiers (variables, subroutines, etc.)
30!
31! Revision 1.3  2001/01/25 06:58:14  raasch
32! Variable "prandtl_layer replaced by "use_surface_fluxes"
33!
34! Revision 1.2  2000/07/03 12:57:13  raasch
35! dummy arguments, whose corresponding actual arguments are pointers,
36! are now also defined as pointers,
37! all comments translated into English
38!
39! Revision 1.1  2000/04/13 14:54:02  schroeter
40! Initial revision
41!
42!
43! Description:
44! ------------
45! Diffusion term of scalar quantities (temperature and water content)
46!------------------------------------------------------------------------------!
47
48    PRIVATE
49    PUBLIC diffusion_s
50
51    INTERFACE diffusion_s
52       MODULE PROCEDURE diffusion_s
53       MODULE PROCEDURE diffusion_s_ij
54    END INTERFACE diffusion_s
55
56 CONTAINS
57
58
59!------------------------------------------------------------------------------!
60! Call for all grid points
61!------------------------------------------------------------------------------!
62    SUBROUTINE diffusion_s( ddzu, ddzw, kh, s, s_flux, tend )
63
64       USE control_parameters
65       USE grid_variables
66       USE indices
67
68       IMPLICIT NONE
69
70       INTEGER ::  i, j, k
71       REAL    ::  vertical_gridspace
72       REAL    ::  ddzu(1:nzt+1), ddzw(1:nzt)
73       REAL    ::  tend(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1)
74       REAL, DIMENSION(:,:),   POINTER ::  s_flux
75       REAL, DIMENSION(:,:,:), POINTER ::  kh, s
76
77       DO  i = nxl, nxr
78          DO  j = nys,nyn
79!
80!--          Compute horizontal diffusion
81             DO  k = nzb_s_outer(j,i)+1, nzt-1
82
83                tend(k,j,i) = tend(k,j,i)                                     &
84                                          + 0.5 * (                           &
85                        ( kh(k,j,i) + kh(k,j,i+1) ) * ( s(k,j,i+1)-s(k,j,i) ) &
86                      - ( kh(k,j,i) + kh(k,j,i-1) ) * ( s(k,j,i)-s(k,j,i-1) ) &
87                                                  ) * ddx2                    &
88                                          + 0.5 * (                           &
89                        ( kh(k,j,i) + kh(k,j+1,i) ) * ( s(k,j+1,i)-s(k,j,i) ) &
90                      - ( kh(k,j,i) + kh(k,j-1,i) ) * ( s(k,j,i)-s(k,j-1,i) ) &
91                                                  ) * ddy2
92             ENDDO
93
94!
95!--          Apply prescribed horizontal wall heatflux where necessary
96             IF ( ( wall_w_x(j,i) .NE. 0.0 ) .OR. ( wall_w_y(j,i) .NE. 0.0 ) ) &
97             THEN
98                DO  k = nzb_s_inner(j,i)+1, nzb_s_outer(j,i)
99
100                   tend(k,j,i) = tend(k,j,i)                                  &
101                                          + 0.5 * ( fwxp(j,i) *               &
102                        ( kh(k,j,i) + kh(k,j,i+1) ) * ( s(k,j,i+1)-s(k,j,i) ) &
103                        - ( 1.0 - fwxp(j,i) ) * wall_heatflux(1)              &
104                                                   -fwxm(j,i) *               &
105                        ( kh(k,j,i) + kh(k,j,i-1) ) * ( s(k,j,i)-s(k,j,i-1) ) &
106                        + ( 1.0 - fwxm(j,i) ) * wall_heatflux(3)              &
107                                                  ) * ddx2                    &
108                                          + 0.5 * ( fwyp(j,i) *               &
109                        ( kh(k,j,i) + kh(k,j+1,i) ) * ( s(k,j+1,i)-s(k,j,i) ) &
110                        - ( 1.0 - fwyp(j,i) ) * wall_heatflux(2)              &
111                                                   -fwym(j,i) *               &
112                        ( kh(k,j,i) + kh(k,j-1,i) ) * ( s(k,j,i)-s(k,j-1,i) ) &
113                        + ( 1.0 - fwym(j,i) ) * wall_heatflux(4)              &
114                                                  ) * ddy2
115                ENDDO
116             ENDIF
117
118!
119!--          Compute vertical diffusion. In case that surface fluxes have been
120!--          presribed or computed, index k starts at nzb+2.
121             DO  k = nzb_diff_s_inner(j,i), nzt-1
122
123                tend(k,j,i) = tend(k,j,i)                                     &
124                                       + 0.5 * (                              &
125            ( kh(k,j,i) + kh(k+1,j,i) ) * ( s(k+1,j,i)-s(k,j,i) ) * ddzu(k+1) &
126          - ( kh(k,j,i) + kh(k-1,j,i) ) * ( s(k,j,i)-s(k-1,j,i) ) * ddzu(k)   &
127                                               ) * ddzw(k)
128             ENDDO
129
130!
131!--          Vertical diffusion at the first computational gridpoint in &
132!--          z-direction
133             IF ( use_surface_fluxes )  THEN
134
135                k = nzb_s_inner(j,i)+1
136
137                tend(k,j,i) = tend(k,j,i)                                     &
138                                       + ( 0.5 * ( kh(k,j,i)+kh(k+1,j,i) )    &
139                                               * ( s(k+1,j,i)-s(k,j,i) )      &
140                                               * ddzu(k+1)                    &
141                                           + s_flux(j,i)                      &
142                                         ) * ddzw(k)
143
144             ENDIF
145
146          ENDDO
147       ENDDO
148
149    END SUBROUTINE diffusion_s
150
151
152!------------------------------------------------------------------------------!
153! Call for grid point i,j
154!------------------------------------------------------------------------------!
155    SUBROUTINE diffusion_s_ij( i, j, ddzu, ddzw, kh, s, s_flux, tend )
156
157       USE control_parameters
158       USE grid_variables
159       USE indices
160
161       IMPLICIT NONE
162
163       INTEGER ::  i, j, k
164       REAL    ::  vertical_gridspace
165       REAL    ::  ddzu(1:nzt+1), ddzw(1:nzt)
166       REAL    ::  tend(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1)
167       REAL, DIMENSION(:,:),   POINTER ::  s_flux
168       REAL, DIMENSION(:,:,:), POINTER ::  kh, s
169
170!
171!--    Compute horizontal diffusion
172       DO  k = nzb_s_outer(j,i)+1, nzt-1
173
174          tend(k,j,i) = tend(k,j,i)                                           &
175                                          + 0.5 * (                           &
176                        ( kh(k,j,i) + kh(k,j,i+1) ) * ( s(k,j,i+1)-s(k,j,i) ) &
177                      - ( kh(k,j,i) + kh(k,j,i-1) ) * ( s(k,j,i)-s(k,j,i-1) ) &
178                                                  ) * ddx2                    &
179                                          + 0.5 * (                           &
180                        ( kh(k,j,i) + kh(k,j+1,i) ) * ( s(k,j+1,i)-s(k,j,i) ) &
181                      - ( kh(k,j,i) + kh(k,j-1,i) ) * ( s(k,j,i)-s(k,j-1,i) ) &
182                                                  ) * ddy2
183       ENDDO
184
185!
186!--    Apply prescribed horizontal wall heatflux where necessary
187       IF ( ( wall_w_x(j,i) .NE. 0.0 ) .OR. ( wall_w_y(j,i) .NE. 0.0 ) ) &
188       THEN
189          DO  k = nzb_s_inner(j,i)+1, nzb_s_outer(j,i)
190
191             tend(k,j,i) = tend(k,j,i)                                        &
192                                          + 0.5 * ( fwxp(j,i) *               &
193                        ( kh(k,j,i) + kh(k,j,i+1) ) * ( s(k,j,i+1)-s(k,j,i) ) &
194                        - ( 1.0 - fwxp(j,i) ) * wall_heatflux(1)              &
195                                                   -fwxm(j,i) *               &
196                        ( kh(k,j,i) + kh(k,j,i-1) ) * ( s(k,j,i)-s(k,j,i-1) ) &
197                        + ( 1.0 - fwxm(j,i) ) * wall_heatflux(3)              &
198                                                  ) * ddx2                    &
199                                          + 0.5 * ( fwyp(j,i) *               &
200                        ( kh(k,j,i) + kh(k,j+1,i) ) * ( s(k,j+1,i)-s(k,j,i) ) &
201                        - ( 1.0 - fwyp(j,i) ) * wall_heatflux(2)              &
202                                                   -fwym(j,i) *               &
203                        ( kh(k,j,i) + kh(k,j-1,i) ) * ( s(k,j,i)-s(k,j-1,i) ) &
204                        + ( 1.0 - fwym(j,i) ) * wall_heatflux(4)              &
205                                                  ) * ddy2
206          ENDDO
207       ENDIF
208
209!
210!--    Compute vertical diffusion. In case that surface fluxes have been
211!--    presribed or computed, index k starts at nzb+2.
212       DO  k = nzb_diff_s_inner(j,i), nzt-1
213
214          tend(k,j,i) = tend(k,j,i)                                           &
215                                       + 0.5 * (                              &
216            ( kh(k,j,i) + kh(k+1,j,i) ) * ( s(k+1,j,i)-s(k,j,i) ) * ddzu(k+1) &
217          - ( kh(k,j,i) + kh(k-1,j,i) ) * ( s(k,j,i)-s(k-1,j,i) ) * ddzu(k)   &
218                                               ) * ddzw(k)
219       ENDDO
220
221!
222!--    Vertical diffusion at the first computational gridpoint in z-direction
223       IF ( use_surface_fluxes )  THEN
224
225          k = nzb_s_inner(j,i)+1
226
227          tend(k,j,i) = tend(k,j,i)                                           &
228                                       + ( 0.5 * ( kh(k,j,i)+kh(k+1,j,i) )    &
229                                               * ( s(k+1,j,i)-s(k,j,i) )      &
230                                               * ddzu(k+1)                    &
231                                           + s_flux(j,i)                      &
232                                         ) * ddzw(k)
233
234       ENDIF
235
236    END SUBROUTINE diffusion_s_ij
237
238 END MODULE diffusion_s_mod
Note: See TracBrowser for help on using the repository browser.