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

Last change on this file since 1002 was 1002, checked in by raasch, 9 years ago

last commit documented

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