Home

Context Navigation

source: palm/trunk/SOURCE/subsidence.f90 @ 1404

Last change on this file since 1404 was 1383, checked in by boeske, 11 years ago
last commit documented
Property svn:keywords set to `Id`
File size: 12.0 KB

Line
1	MODULE subsidence_mod
2
3	!--------------------------------------------------------------------------------!
4	! This file is part of PALM.
5	!
6	! PALM is free software: you can redistribute it and/or modify it under the terms
7	! of the GNU General Public License as published by the Free Software Foundation,
8	! either version 3 of the License, or (at your option) any later version.
9	!
10	! PALM is distributed in the hope that it will be useful, but WITHOUT ANY
11	! WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
12	! A PARTICULAR PURPOSE. See the GNU General Public License for more details.
13	!
14	! You should have received a copy of the GNU General Public License along with
15	! PALM. If not, see <http://www.gnu.org/licenses/>.
16	!
17	! Copyright 1997-2014 Leibniz Universitaet Hannover
18	!--------------------------------------------------------------------------------!
19	!
20	! Current revisions:
21	! -----------------
22	!
23	!
24	! Former revisions:
25	! -----------------
26	! $Id: subsidence.f90 1383 2014-04-30 12:17:54Z keck $
27	!
28	! 1382 2014-04-30 12:15:41Z boeske
29	! Changed the weighting factor that is used in the summation of subsidence
30	! tendencies for profile data output from weight_pres to weight_substep
31	! added Neumann boundary conditions for profile data output of subsidence terms
32	! at nzt+1
33	!
34	! 1380 2014-04-28 12:40:45Z heinze
35	! Shifting only necessary in case of scalar Rayleigh damping
36	!
37	! 1365 2014-04-22 15:03:56Z boeske
38	! Summation of subsidence tendencies for data output added
39	! +ls_index, sums_ls_l, tmp_tend
40	!
41	! 1353 2014-04-08 15:21:23Z heinze
42	! REAL constants provided with KIND-attribute
43	!
44	! 1320 2014-03-20 08:40:49Z raasch
45	! ONLY-attribute added to USE-statements,
46	! kind-parameters added to all INTEGER and REAL declaration statements,
47	! kinds are defined in new module kinds,
48	! old module precision_kind is removed,
49	! revision history before 2012 removed,
50	! comment fields (!:) to be used for variable explanations added to
51	! all variable declaration statements
52	!
53	! 1036 2012-10-22 13:43:42Z raasch
54	! code put under GPL (PALM 3.9)
55	!
56	! Revision 3.7 2009-12-11 14:15:58Z heinze
57	! Initial revision
58	!
59	! Description:
60	! ------------
61	! Impact of large-scale subsidence or ascent as tendency term for use
62	! in the prognostic equation of potential temperature. This enables the
63	! construction of a constant boundary layer height z_i with time.
64	!-----------------------------------------------------------------------------!
65
66
67	IMPLICIT NONE
68
69	PRIVATE
70	PUBLIC init_w_subsidence, subsidence
71
72	INTERFACE init_w_subsidence
73	MODULE PROCEDURE init_w_subsidence
74	END INTERFACE init_w_subsidence
75
76	INTERFACE subsidence
77	MODULE PROCEDURE subsidence
78	MODULE PROCEDURE subsidence_ij
79	END INTERFACE subsidence
80
81	CONTAINS
82
83	SUBROUTINE init_w_subsidence
84
85	USE arrays_3d, &
86	ONLY: dzu, w_subs, zu
87
88	USE control_parameters, &
89	ONLY: message_string, ocean, subs_vertical_gradient, &
90	subs_vertical_gradient_level, subs_vertical_gradient_level_i
91
92	USE indices, &
93	ONLY: nzb, nzt
94
95	USE kinds
96
97	IMPLICIT NONE
98
99	INTEGER(iwp) :: i !:
100	INTEGER(iwp) :: k !:
101
102	REAL(wp) :: gradient !:
103	REAL(wp) :: ws_surface !:
104
105	IF ( .NOT. ALLOCATED( w_subs )) THEN
106	ALLOCATE( w_subs(nzb:nzt+1) )
107	w_subs = 0.0_wp
108	ENDIF
109
110	IF ( ocean ) THEN
111	message_string = 'Applying large scale vertical motion is not ' // &
112	'allowed for ocean runs'
113	CALL message( 'init_w_subsidence', 'PA0324', 2, 2, 0, 6, 0 )
114	ENDIF
115
116	!
117	!-- Compute the profile of the subsidence/ascent velocity
118	!-- using the given gradients
119	i = 1
120	gradient = 0.0_wp
121	ws_surface = 0.0_wp
122
123
124	subs_vertical_gradient_level_i(1) = 0
125	DO k = 1, nzt+1
126	IF ( i < 11 ) THEN
127	IF ( subs_vertical_gradient_level(i) < zu(k) .AND. &
128	subs_vertical_gradient_level(i) >= 0.0_wp ) THEN
129	gradient = subs_vertical_gradient(i) / 100.0_wp
130	subs_vertical_gradient_level_i(i) = k - 1
131	i = i + 1
132	ENDIF
133	ENDIF
134	IF ( gradient /= 0.0_wp ) THEN
135	IF ( k /= 1 ) THEN
136	w_subs(k) = w_subs(k-1) + dzu(k) * gradient
137	ELSE
138	w_subs(k) = ws_surface + 0.5_wp * dzu(k) * gradient
139	ENDIF
140	ELSE
141	w_subs(k) = w_subs(k-1)
142	ENDIF
143	ENDDO
144
145	!
146	!-- In case of no given gradients for the subsidence/ascent velocity,
147	!-- choose zero gradient
148	IF ( subs_vertical_gradient_level(1) == -9999999.9_wp ) THEN
149	subs_vertical_gradient_level(1) = 0.0_wp
150	ENDIF
151
152	END SUBROUTINE init_w_subsidence
153
154
155	SUBROUTINE subsidence( tendency, var, var_init, ls_index )
156
157	USE arrays_3d, &
158	ONLY: ddzu, w_subs
159
160	USE control_parameters, &
161	ONLY: dt_3d, intermediate_timestep_count, large_scale_forcing, &
162	scalar_rayleigh_damping
163
164	USE indices, &
165	ONLY: nxl, nxlg, nxr, nxrg, nyn, nyng, nys, nysg, nzb, nzb_s_inner,&
166	nzt
167
168	USE kinds
169
170	USE statistics, &
171	ONLY: sums_ls_l, weight_substep
172
173	IMPLICIT NONE
174
175	INTEGER(iwp) :: i !:
176	INTEGER(iwp) :: j !:
177	INTEGER(iwp) :: k !:
178	INTEGER(iwp) :: ls_index !:
179
180	REAL(wp) :: tmp_tend !:
181	REAL(wp) :: tmp_grad !:
182
183	REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) :: var !:
184	REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) :: tendency !:
185	REAL(wp), DIMENSION(nzb:nzt+1) :: var_init !:
186	REAL(wp), DIMENSION(nzb:nzt+1) :: var_mod !:
187
188	var_mod = var_init
189
190	!
191	!-- Influence of w_subsidence on the current tendency term
192	DO i = nxl, nxr
193	DO j = nys, nyn
194
195	DO k = nzb_s_inner(j,i)+1, nzt
196	IF ( w_subs(k) < 0.0_wp ) THEN ! large-scale subsidence
197	tmp_tend = - w_subs(k) * &
198	( var(k+1,j,i) - var(k,j,i) ) * ddzu(k+1)
199	ELSE ! large-scale ascent
200	tmp_tend = - w_subs(k) * &
201	( var(k,j,i) - var(k-1,j,i) ) * ddzu(k)
202	ENDIF
203
204	tendency(k,j,i) = tendency(k,j,i) + tmp_tend
205
206	IF ( large_scale_forcing ) THEN
207	sums_ls_l(k,ls_index) = sums_ls_l(k,ls_index) + tmp_tend &
208	* weight_substep(intermediate_timestep_count)
209	ENDIF
210	ENDDO
211
212	sums_ls_l(nzt+1,ls_index) = sums_ls_l(nzt,ls_index)
213
214	ENDDO
215	ENDDO
216
217	!
218	!-- Shifting of the initial profile is especially necessary with Rayleigh
219	!-- damping switched on
220	IF ( scalar_rayleigh_damping ) THEN
221	DO k = nzb, nzt
222	IF ( w_subs(k) < 0.0_wp ) THEN ! large-scale subsidence
223	var_mod(k) = var_init(k) - dt_3d * w_subs(k) * &
224	( var_init(k+1) - var_init(k) ) * ddzu(k+1)
225	ENDIF
226	ENDDO
227	!
228	!-- At the upper boundary, the initial profile is shifted with aid of
229	!-- the gradient tmp_grad. (This is ok if the gradients are linear.)
230	IF ( w_subs(nzt) < 0.0_wp ) THEN
231	tmp_grad = ( var_init(nzt+1) - var_init(nzt) ) * ddzu(nzt+1)
232	var_mod(nzt+1) = var_init(nzt+1) - &
233	dt_3d * w_subs(nzt+1) * tmp_grad
234	ENDIF
235
236
237	DO k = nzt+1, nzb+1, -1
238	IF ( w_subs(k) >= 0.0_wp ) THEN ! large-scale ascent
239	var_mod(k) = var_init(k) - dt_3d * w_subs(k) * &
240	( var_init(k) - var_init(k-1) ) * ddzu(k)
241	ENDIF
242	ENDDO
243	!
244	!-- At the lower boundary shifting is not necessary because the
245	!-- subsidence velocity w_subs(nzb) vanishes.
246	IF ( w_subs(nzb+1) >= 0.0_wp ) THEN
247	var_mod(nzb) = var_init(nzb)
248	ENDIF
249
250	var_init = var_mod
251	ENDIF
252
253
254	END SUBROUTINE subsidence
255
256	SUBROUTINE subsidence_ij( i, j, tendency, var, var_init, ls_index )
257
258	USE arrays_3d, &
259	ONLY: ddzu, w_subs
260
261	USE control_parameters, &
262	ONLY: dt_3d, intermediate_timestep_count, large_scale_forcing, &
263	scalar_rayleigh_damping
264
265	USE indices, &
266	ONLY: nxl, nxlg, nxrg, nyng, nys, nysg, nzb_s_inner, nzb, nzt
267
268	USE kinds
269
270	USE statistics, &
271	ONLY: sums_ls_l, weight_substep
272
273	IMPLICIT NONE
274
275	INTEGER(iwp) :: i !:
276	INTEGER(iwp) :: j !:
277	INTEGER(iwp) :: k !:
278	INTEGER(iwp) :: ls_index !:
279
280	REAL(wp) :: tmp_tend !:
281	REAL(wp) :: tmp_grad !:
282
283	REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) :: var !:
284	REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) :: tendency !:
285	REAL(wp), DIMENSION(nzb:nzt+1) :: var_init !:
286	REAL(wp), DIMENSION(nzb:nzt+1) :: var_mod !:
287
288	var_mod = var_init
289
290	!
291	!-- Influence of w_subsidence on the current tendency term
292	DO k = nzb_s_inner(j,i)+1, nzt
293	IF ( w_subs(k) < 0.0_wp ) THEN ! large-scale subsidence
294	tmp_tend = - w_subs(k) * ( var(k+1,j,i) - var(k,j,i) ) * ddzu(k+1)
295	ELSE ! large-scale ascent
296	tmp_tend = - w_subs(k) * ( var(k,j,i) - var(k-1,j,i) ) * ddzu(k)
297	ENDIF
298
299	tendency(k,j,i) = tendency(k,j,i) + tmp_tend
300
301	IF ( large_scale_forcing ) THEN
302	sums_ls_l(k,ls_index) = sums_ls_l(k,ls_index) + tmp_tend &
303	* weight_substep(intermediate_timestep_count)
304	ENDIF
305	ENDDO
306
307	sums_ls_l(nzt+1,ls_index) = sums_ls_l(nzt,ls_index)
308
309
310	!
311	!-- Shifting of the initial profile is especially necessary with Rayleigh
312	!-- damping switched on
313	IF ( scalar_rayleigh_damping ) THEN
314	IF ( i == nxl .AND. j == nys ) THEN ! shifting only once per PE
315
316	DO k = nzb, nzt
317	IF ( w_subs(k) < 0.0_wp ) THEN ! large-scale subsidence
318	var_mod(k) = var_init(k) - dt_3d * w_subs(k) * &
319	( var_init(k+1) - var_init(k) ) * ddzu(k+1)
320	ENDIF
321	ENDDO
322	!
323	!-- At the upper boundary, the initial profile is shifted with aid of
324	!-- the gradient tmp_grad. (This is ok if the gradients are linear.)
325	IF ( w_subs(nzt) < 0.0_wp ) THEN
326	tmp_grad = ( var_init(nzt+1) - var_init(nzt) ) * ddzu(nzt+1)
327	var_mod(nzt+1) = var_init(nzt+1) - &
328	dt_3d * w_subs(nzt+1) * tmp_grad
329	ENDIF
330
331
332	DO k = nzt+1, nzb+1, -1
333	IF ( w_subs(k) >= 0.0_wp ) THEN ! large-scale ascent
334	var_mod(k) = var_init(k) - dt_3d * w_subs(k) * &
335	( var_init(k) - var_init(k-1) ) * ddzu(k)
336	ENDIF
337	ENDDO
338	!
339	!-- At the lower boundary shifting is not necessary because the
340	!-- subsidence velocity w_subs(nzb) vanishes.
341	IF ( w_subs(nzb+1) >= 0.0_wp ) THEN
342	var_mod(nzb) = var_init(nzb)
343	ENDIF
344
345	var_init = var_mod
346
347	ENDIF
348	ENDIF
349
350	END SUBROUTINE subsidence_ij
351
352
353	END MODULE subsidence_mod

Note: See TracBrowser for help on using the repository browser.

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |