Home

Context Navigation

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

Last change on this file since 1014 was 1011, checked in by raasch, 12 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.

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |