Home

Context Navigation

subsidence.f90 @ 1825

Last change on this file since 1825 was 1818, checked in by maronga, 9 years ago
last commit documented / copyright update
Property svn:keywords set to `Id`
File size: 13.2 KB

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

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

Context Navigation

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

Download in other formats: