Home

Context Navigation

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

Last change on this file since 101 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.

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |