Home

Context Navigation

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

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

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |