Home

Context Navigation

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

Last change on this file since 4068 was 3655, checked in by knoop, 6 years ago
Bugfix: made "unit" and "found" intend INOUT in module interface subroutines + automatic copyright update
Property svn:keywords set to `Id`
File size: 15.8 KB

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

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |