Home

Context Navigation

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

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

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |