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

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

last commit documented

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