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

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

pointer free version can be generated with cpp switch nopointer

  • Property svn:keywords set to Id
File size: 11.0 KB
Line 
1 MODULE diffusion_s_mod
2
3!------------------------------------------------------------------------------!
4! Current revisions:
5! ------------------
6! cpp switch __nopointer added for pointer free version
7!
8! Former revisions:
9! -----------------
10! $Id: diffusion_s.f90 1010 2012-09-20 07:59:54Z 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#if defined( __nopointer )
74       REAL, DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ::  s
75#else
76       REAL, DIMENSION(:,:,:), POINTER ::  s
77#endif
78
79       DO  i = nxl, nxr
80          DO  j = nys,nyn
81!
82!--          Compute horizontal diffusion
83             DO  k = nzb_s_outer(j,i)+1, nzt
84
85                tend(k,j,i) = tend(k,j,i)                                     &
86                                          + 0.5 * (                           &
87                        ( kh(k,j,i) + kh(k,j,i+1) ) * ( s(k,j,i+1)-s(k,j,i) ) &
88                      - ( kh(k,j,i) + kh(k,j,i-1) ) * ( s(k,j,i)-s(k,j,i-1) ) &
89                                                  ) * ddx2                    &
90                                          + 0.5 * (                           &
91                        ( kh(k,j,i) + kh(k,j+1,i) ) * ( s(k,j+1,i)-s(k,j,i) ) &
92                      - ( kh(k,j,i) + kh(k,j-1,i) ) * ( s(k,j,i)-s(k,j-1,i) ) &
93                                                  ) * ddy2
94             ENDDO
95
96!
97!--          Apply prescribed horizontal wall heatflux where necessary
98             IF ( ( wall_w_x(j,i) .NE. 0.0 ) .OR. ( wall_w_y(j,i) .NE. 0.0 ) ) &
99             THEN
100                DO  k = nzb_s_inner(j,i)+1, nzb_s_outer(j,i)
101
102                   tend(k,j,i) = tend(k,j,i)                                  &
103                                                + ( fwxp(j,i) * 0.5 *         &
104                        ( kh(k,j,i) + kh(k,j,i+1) ) * ( s(k,j,i+1)-s(k,j,i) ) &
105                        + ( 1.0 - fwxp(j,i) ) * wall_s_flux(1)                &
106                                                   -fwxm(j,i) * 0.5 *         &
107                        ( kh(k,j,i) + kh(k,j,i-1) ) * ( s(k,j,i)-s(k,j,i-1) ) &
108                        + ( 1.0 - fwxm(j,i) ) * wall_s_flux(2)                &
109                                                  ) * ddx2                    &
110                                                + ( fwyp(j,i) * 0.5 *         &
111                        ( kh(k,j,i) + kh(k,j+1,i) ) * ( s(k,j+1,i)-s(k,j,i) ) &
112                        + ( 1.0 - fwyp(j,i) ) * wall_s_flux(3)                &
113                                                   -fwym(j,i) * 0.5 *         &
114                        ( kh(k,j,i) + kh(k,j-1,i) ) * ( s(k,j,i)-s(k,j-1,i) ) &
115                        + ( 1.0 - fwym(j,i) ) * wall_s_flux(4)                &
116                                                  ) * ddy2
117                ENDDO
118             ENDIF
119
120!
121!--          Compute vertical diffusion. In case that surface fluxes have been
122!--          prescribed or computed at bottom and/or top, index k starts/ends at
123!--          nzb+2 or nzt-1, respectively.
124             DO  k = nzb_diff_s_inner(j,i), nzt_diff
125
126                tend(k,j,i) = tend(k,j,i)                                     &
127                                       + 0.5 * (                              &
128            ( kh(k,j,i) + kh(k+1,j,i) ) * ( s(k+1,j,i)-s(k,j,i) ) * ddzu(k+1) &
129          - ( kh(k,j,i) + kh(k-1,j,i) ) * ( s(k,j,i)-s(k-1,j,i) ) * ddzu(k)   &
130                                               ) * ddzw(k)
131             ENDDO
132
133!
134!--          Vertical diffusion at the first computational gridpoint along
135!--          z-direction
136             IF ( use_surface_fluxes )  THEN
137
138                k = nzb_s_inner(j,i)+1
139
140                tend(k,j,i) = tend(k,j,i)                                     &
141                                       + ( 0.5 * ( kh(k,j,i)+kh(k+1,j,i) )    &
142                                               * ( s(k+1,j,i)-s(k,j,i) )      &
143                                               * ddzu(k+1)                    &
144                                           + s_flux_b(j,i)                    &
145                                         ) * ddzw(k)
146
147             ENDIF
148
149!
150!--          Vertical diffusion at the last computational gridpoint along
151!--          z-direction
152             IF ( use_top_fluxes )  THEN
153
154                k = nzt
155
156                tend(k,j,i) = tend(k,j,i)                                     &
157                                       + ( - s_flux_t(j,i)                    &
158                                           - 0.5 * ( kh(k-1,j,i)+kh(k,j,i) )  &
159                                                 * ( s(k,j,i)-s(k-1,j,i) )    &
160                                                 * ddzu(k)                    &
161                                         ) * ddzw(k)
162
163             ENDIF
164
165          ENDDO
166       ENDDO
167
168    END SUBROUTINE diffusion_s
169
170
171!------------------------------------------------------------------------------!
172! Call for grid point i,j
173!------------------------------------------------------------------------------!
174    SUBROUTINE diffusion_s_ij( i, j, s, s_flux_b, s_flux_t, wall_s_flux )
175
176       USE arrays_3d
177       USE control_parameters
178       USE grid_variables
179       USE indices
180
181       IMPLICIT NONE
182
183       INTEGER ::  i, j, k
184       REAL    ::  vertical_gridspace
185       REAL    ::  wall_s_flux(0:4)
186       REAL, DIMENSION(nysg:nyng,nxlg:nxrg) ::  s_flux_b, s_flux_t
187#if defined( __nopointer )
188       REAL, DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ::  s
189#else
190       REAL, DIMENSION(:,:,:), POINTER ::  s
191#endif
192
193!
194!--    Compute horizontal diffusion
195       DO  k = nzb_s_outer(j,i)+1, nzt
196
197          tend(k,j,i) = tend(k,j,i)                                           &
198                                          + 0.5 * (                           &
199                        ( kh(k,j,i) + kh(k,j,i+1) ) * ( s(k,j,i+1)-s(k,j,i) ) &
200                      - ( kh(k,j,i) + kh(k,j,i-1) ) * ( s(k,j,i)-s(k,j,i-1) ) &
201                                                  ) * ddx2                    &
202                                          + 0.5 * (                           &
203                        ( kh(k,j,i) + kh(k,j+1,i) ) * ( s(k,j+1,i)-s(k,j,i) ) &
204                      - ( kh(k,j,i) + kh(k,j-1,i) ) * ( s(k,j,i)-s(k,j-1,i) ) &
205                                                  ) * ddy2
206       ENDDO
207
208!
209!--    Apply prescribed horizontal wall heatflux where necessary
210       IF ( ( wall_w_x(j,i) .NE. 0.0 ) .OR. ( wall_w_y(j,i) .NE. 0.0 ) ) &
211       THEN
212          DO  k = nzb_s_inner(j,i)+1, nzb_s_outer(j,i)
213
214             tend(k,j,i) = tend(k,j,i)                                        &
215                                                + ( fwxp(j,i) * 0.5 *         &
216                        ( kh(k,j,i) + kh(k,j,i+1) ) * ( s(k,j,i+1)-s(k,j,i) ) &
217                        + ( 1.0 - fwxp(j,i) ) * wall_s_flux(1)                &
218                                                   -fwxm(j,i) * 0.5 *         &
219                        ( kh(k,j,i) + kh(k,j,i-1) ) * ( s(k,j,i)-s(k,j,i-1) ) &
220                        + ( 1.0 - fwxm(j,i) ) * wall_s_flux(2)                &
221                                                  ) * ddx2                    &
222                                                + ( fwyp(j,i) * 0.5 *         &
223                        ( kh(k,j,i) + kh(k,j+1,i) ) * ( s(k,j+1,i)-s(k,j,i) ) &
224                        + ( 1.0 - fwyp(j,i) ) * wall_s_flux(3)                &
225                                                   -fwym(j,i) * 0.5 *         &
226                        ( kh(k,j,i) + kh(k,j-1,i) ) * ( s(k,j,i)-s(k,j-1,i) ) &
227                        + ( 1.0 - fwym(j,i) ) * wall_s_flux(4)                &
228                                                  ) * ddy2
229          ENDDO
230       ENDIF
231
232!
233!--    Compute vertical diffusion. In case that surface fluxes have been
234!--    prescribed or computed at bottom and/or top, index k starts/ends at
235!--    nzb+2 or nzt-1, respectively.
236       DO  k = nzb_diff_s_inner(j,i), nzt_diff
237
238          tend(k,j,i) = tend(k,j,i)                                           &
239                                       + 0.5 * (                              &
240            ( kh(k,j,i) + kh(k+1,j,i) ) * ( s(k+1,j,i)-s(k,j,i) ) * ddzu(k+1) &
241          - ( kh(k,j,i) + kh(k-1,j,i) ) * ( s(k,j,i)-s(k-1,j,i) ) * ddzu(k)   &
242                                               ) * ddzw(k)
243       ENDDO
244
245!
246!--    Vertical diffusion at the first computational gridpoint along z-direction
247       IF ( use_surface_fluxes )  THEN
248
249          k = nzb_s_inner(j,i)+1
250
251          tend(k,j,i) = tend(k,j,i) + ( 0.5 * ( kh(k,j,i)+kh(k+1,j,i) )  &
252                                            * ( s(k+1,j,i)-s(k,j,i) )    &
253                                            * ddzu(k+1)                  &
254                                        + s_flux_b(j,i)                  &
255                                      ) * ddzw(k)
256
257       ENDIF
258
259!
260!--    Vertical diffusion at the last computational gridpoint along z-direction
261       IF ( use_top_fluxes )  THEN
262
263          k = nzt
264
265          tend(k,j,i) = tend(k,j,i) + ( - s_flux_t(j,i)                  &
266                                      - 0.5 * ( kh(k-1,j,i)+kh(k,j,i) )  &
267                                            * ( s(k,j,i)-s(k-1,j,i) )    &
268                                            * ddzu(k)                    &
269                                      ) * ddzw(k)
270
271       ENDIF
272
273    END SUBROUTINE diffusion_s_ij
274
275 END MODULE diffusion_s_mod
Note: See TracBrowser for help on using the repository browser.