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

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

comments prepared for 3.1c

  • Property svn:keywords set to Id
File size: 10.5 KB
Line 
1 MODULE diffusion_s_mod
2
3!------------------------------------------------------------------------------!
4! Actual revisions:
5! -----------------
6!
7!
8! Former revisions:
9! -----------------
10! $Id: diffusion_s.f90 39 2007-03-01 12:46:59Z raasch $
11!
12! 20 2007-02-26 00:12:32Z raasch
13! Bugfix: ddzw dimensioned 1:nzt"+1"
14! Calculation extended for gridpoint nzt, fluxes can be given at top,
15! +s_flux_t in parameter list, s_flux renamed s_flux_b
16!
17! RCS Log replace by Id keyword, revision history cleaned up
18!
19! Revision 1.8  2006/02/23 10:34:17  raasch
20! nzb_2d replaced by nzb_s_outer in horizontal diffusion and by nzb_s_inner
21! or nzb_diff_s_inner, respectively, in vertical diffusion, prescribed surface
22! fluxes at vertically oriented topography
23!
24! Revision 1.1  2000/04/13 14:54:02  schroeter
25! Initial revision
26!
27!
28! Description:
29! ------------
30! Diffusion term of scalar quantities (temperature and water content)
31!------------------------------------------------------------------------------!
32
33    PRIVATE
34    PUBLIC diffusion_s
35
36    INTERFACE diffusion_s
37       MODULE PROCEDURE diffusion_s
38       MODULE PROCEDURE diffusion_s_ij
39    END INTERFACE diffusion_s
40
41 CONTAINS
42
43
44!------------------------------------------------------------------------------!
45! Call for all grid points
46!------------------------------------------------------------------------------!
47    SUBROUTINE diffusion_s( ddzu, ddzw, kh, s, s_flux_b, s_flux_t, tend )
48
49       USE control_parameters
50       USE grid_variables
51       USE indices
52
53       IMPLICIT NONE
54
55       INTEGER ::  i, j, k
56       REAL    ::  vertical_gridspace
57       REAL    ::  ddzu(1:nzt+1), ddzw(1:nzt+1)
58       REAL    ::  tend(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1)
59       REAL, DIMENSION(:,:),   POINTER ::  s_flux_b, s_flux_t
60       REAL, DIMENSION(:,:,:), POINTER ::  kh, s
61
62       DO  i = nxl, nxr
63          DO  j = nys,nyn
64!
65!--          Compute horizontal diffusion
66             DO  k = nzb_s_outer(j,i)+1, nzt
67
68                tend(k,j,i) = tend(k,j,i)                                     &
69                                          + 0.5 * (                           &
70                        ( kh(k,j,i) + kh(k,j,i+1) ) * ( s(k,j,i+1)-s(k,j,i) ) &
71                      - ( kh(k,j,i) + kh(k,j,i-1) ) * ( s(k,j,i)-s(k,j,i-1) ) &
72                                                  ) * ddx2                    &
73                                          + 0.5 * (                           &
74                        ( kh(k,j,i) + kh(k,j+1,i) ) * ( s(k,j+1,i)-s(k,j,i) ) &
75                      - ( kh(k,j,i) + kh(k,j-1,i) ) * ( s(k,j,i)-s(k,j-1,i) ) &
76                                                  ) * ddy2
77             ENDDO
78
79!
80!--          Apply prescribed horizontal wall heatflux where necessary
81             IF ( ( wall_w_x(j,i) .NE. 0.0 ) .OR. ( wall_w_y(j,i) .NE. 0.0 ) ) &
82             THEN
83                DO  k = nzb_s_inner(j,i)+1, nzb_s_outer(j,i)
84
85                   tend(k,j,i) = tend(k,j,i)                                  &
86                                          + 0.5 * ( fwxp(j,i) *               &
87                        ( kh(k,j,i) + kh(k,j,i+1) ) * ( s(k,j,i+1)-s(k,j,i) ) &
88                        - ( 1.0 - fwxp(j,i) ) * wall_heatflux(1)              &
89                                                   -fwxm(j,i) *               &
90                        ( kh(k,j,i) + kh(k,j,i-1) ) * ( s(k,j,i)-s(k,j,i-1) ) &
91                        + ( 1.0 - fwxm(j,i) ) * wall_heatflux(3)              &
92                                                  ) * ddx2                    &
93                                          + 0.5 * ( fwyp(j,i) *               &
94                        ( kh(k,j,i) + kh(k,j+1,i) ) * ( s(k,j+1,i)-s(k,j,i) ) &
95                        - ( 1.0 - fwyp(j,i) ) * wall_heatflux(2)              &
96                                                   -fwym(j,i) *               &
97                        ( kh(k,j,i) + kh(k,j-1,i) ) * ( s(k,j,i)-s(k,j-1,i) ) &
98                        + ( 1.0 - fwym(j,i) ) * wall_heatflux(4)              &
99                                                  ) * ddy2
100                ENDDO
101             ENDIF
102
103!
104!--          Compute vertical diffusion. In case that surface fluxes have been
105!--          prescribed or computed at bottom and/or top, index k starts/ends at
106!--          nzb+2 or nzt-1, respectively.
107             DO  k = nzb_diff_s_inner(j,i), nzt_diff
108
109                tend(k,j,i) = tend(k,j,i)                                     &
110                                       + 0.5 * (                              &
111            ( kh(k,j,i) + kh(k+1,j,i) ) * ( s(k+1,j,i)-s(k,j,i) ) * ddzu(k+1) &
112          - ( kh(k,j,i) + kh(k-1,j,i) ) * ( s(k,j,i)-s(k-1,j,i) ) * ddzu(k)   &
113                                               ) * ddzw(k)
114             ENDDO
115
116!
117!--          Vertical diffusion at the first computational gridpoint along
118!--          z-direction
119             IF ( use_surface_fluxes )  THEN
120
121                k = nzb_s_inner(j,i)+1
122
123                tend(k,j,i) = tend(k,j,i)                                     &
124                                       + ( 0.5 * ( kh(k,j,i)+kh(k+1,j,i) )    &
125                                               * ( s(k+1,j,i)-s(k,j,i) )      &
126                                               * ddzu(k+1)                    &
127                                           + s_flux_b(j,i)                    &
128                                         ) * ddzw(k)
129
130             ENDIF
131
132!
133!--          Vertical diffusion at the last computational gridpoint along
134!--          z-direction
135             IF ( use_top_fluxes )  THEN
136
137                k = nzt
138
139                tend(k,j,i) = tend(k,j,i)                                     &
140                                       + ( - s_flux_t(j,i)                    &
141                                           - 0.5 * ( kh(k-1,j,i)+kh(k,j,i) )  &
142                                                 * ( s(k,j,i)-s(k-1,j,i) )    &
143                                                 * ddzu(k)                    &
144                                         ) * ddzw(k)
145
146             ENDIF
147
148          ENDDO
149       ENDDO
150
151    END SUBROUTINE diffusion_s
152
153
154!------------------------------------------------------------------------------!
155! Call for grid point i,j
156!------------------------------------------------------------------------------!
157    SUBROUTINE diffusion_s_ij( i, j, ddzu, ddzw, kh, s, s_flux_b, s_flux_t, &
158                               tend )
159
160       USE control_parameters
161       USE grid_variables
162       USE indices
163
164       IMPLICIT NONE
165
166       INTEGER ::  i, j, k
167       REAL    ::  vertical_gridspace
168       REAL    ::  ddzu(1:nzt+1), ddzw(1:nzt+1)
169       REAL    ::  tend(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1)
170       REAL, DIMENSION(:,:),   POINTER ::  s_flux_b, s_flux_t
171       REAL, DIMENSION(:,:,:), POINTER ::  kh, s
172
173!
174!--    Compute horizontal diffusion
175       DO  k = nzb_s_outer(j,i)+1, nzt
176
177          tend(k,j,i) = tend(k,j,i)                                           &
178                                          + 0.5 * (                           &
179                        ( kh(k,j,i) + kh(k,j,i+1) ) * ( s(k,j,i+1)-s(k,j,i) ) &
180                      - ( kh(k,j,i) + kh(k,j,i-1) ) * ( s(k,j,i)-s(k,j,i-1) ) &
181                                                  ) * ddx2                    &
182                                          + 0.5 * (                           &
183                        ( kh(k,j,i) + kh(k,j+1,i) ) * ( s(k,j+1,i)-s(k,j,i) ) &
184                      - ( kh(k,j,i) + kh(k,j-1,i) ) * ( s(k,j,i)-s(k,j-1,i) ) &
185                                                  ) * ddy2
186       ENDDO
187
188!
189!--    Apply prescribed horizontal wall heatflux where necessary
190       IF ( ( wall_w_x(j,i) .NE. 0.0 ) .OR. ( wall_w_y(j,i) .NE. 0.0 ) ) &
191       THEN
192          DO  k = nzb_s_inner(j,i)+1, nzb_s_outer(j,i)
193
194             tend(k,j,i) = tend(k,j,i)                                        &
195                                          + 0.5 * ( fwxp(j,i) *               &
196                        ( kh(k,j,i) + kh(k,j,i+1) ) * ( s(k,j,i+1)-s(k,j,i) ) &
197                        - ( 1.0 - fwxp(j,i) ) * wall_heatflux(1)              &
198                                                   -fwxm(j,i) *               &
199                        ( kh(k,j,i) + kh(k,j,i-1) ) * ( s(k,j,i)-s(k,j,i-1) ) &
200                        + ( 1.0 - fwxm(j,i) ) * wall_heatflux(3)              &
201                                                  ) * ddx2                    &
202                                          + 0.5 * ( fwyp(j,i) *               &
203                        ( kh(k,j,i) + kh(k,j+1,i) ) * ( s(k,j+1,i)-s(k,j,i) ) &
204                        - ( 1.0 - fwyp(j,i) ) * wall_heatflux(2)              &
205                                                   -fwym(j,i) *               &
206                        ( kh(k,j,i) + kh(k,j-1,i) ) * ( s(k,j,i)-s(k,j-1,i) ) &
207                        + ( 1.0 - fwym(j,i) ) * wall_heatflux(4)              &
208                                                  ) * ddy2
209          ENDDO
210       ENDIF
211
212!
213!--    Compute vertical diffusion. In case that surface fluxes have been
214!--    prescribed or computed at bottom and/or top, index k starts/ends at
215!--    nzb+2 or nzt-1, respectively.
216       DO  k = nzb_diff_s_inner(j,i), nzt_diff
217
218          tend(k,j,i) = tend(k,j,i)                                           &
219                                       + 0.5 * (                              &
220            ( kh(k,j,i) + kh(k+1,j,i) ) * ( s(k+1,j,i)-s(k,j,i) ) * ddzu(k+1) &
221          - ( kh(k,j,i) + kh(k-1,j,i) ) * ( s(k,j,i)-s(k-1,j,i) ) * ddzu(k)   &
222                                               ) * ddzw(k)
223       ENDDO
224
225!
226!--    Vertical diffusion at the first computational gridpoint along z-direction
227       IF ( use_surface_fluxes )  THEN
228
229          k = nzb_s_inner(j,i)+1
230
231          tend(k,j,i) = tend(k,j,i) + ( 0.5 * ( kh(k,j,i)+kh(k+1,j,i) )  &
232                                            * ( s(k+1,j,i)-s(k,j,i) )    &
233                                            * ddzu(k+1)                  &
234                                        + s_flux_b(j,i)                  &
235                                      ) * ddzw(k)
236
237       ENDIF
238
239!
240!--    Vertical diffusion at the last computational gridpoint along z-direction
241       IF ( use_top_fluxes )  THEN
242
243          k = nzt
244
245          tend(k,j,i) = tend(k,j,i) + ( - s_flux_t(j,i)                  &
246                                      - 0.5 * ( kh(k-1,j,i)+kh(k,j,i) )  &
247                                            * ( s(k,j,i)-s(k-1,j,i) )    &
248                                            * ddzu(k)                    &
249                                      ) * ddzw(k)
250
251       ENDIF
252
253    END SUBROUTINE diffusion_s_ij
254
255 END MODULE diffusion_s_mod
Note: See TracBrowser for help on using the repository browser.