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

Last change on this file since 4 was 4, checked in by raasch, 15 years ago

Id keyword set as property for all *.f90 files

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