Home

Context Navigation

source: palm/trunk/SOURCE/subsidence_mod.f90 @ 1862

Last change on this file since 1862 was 1862, checked in by hoffmann, 8 years ago
bugfix in subsidence_mod
Property svn:keywords set to `Id`
File size: 13.5 KB

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

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |