Home

Context Navigation

source: palm/trunk/SOURCE/init_1d_model.f90 @ 1695

Last change on this file since 1695 was 1692, checked in by maronga, 9 years ago
last commit documented
Property svn:keywords set to `Id`
File size: 35.8 KB

Line
1	!> @file init_1d_model.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-2015 Leibniz Universitaet Hannover
17	!--------------------------------------------------------------------------------!
18	!
19	! Current revisions:
20	! -----------------
21	!
22	!
23	! Former revisions:
24	! -----------------
25	! $Id: init_1d_model.f90 1692 2015-10-26 16:29:17Z maronga $
26	!
27	! 1691 2015-10-26 16:17:44Z maronga
28	! Renamed prandtl_layer to constant_flux_layer. rif is replaced by ol and zeta.
29	!
30	! 1682 2015-10-07 23:56:08Z knoop
31	! Code annotations made doxygen readable
32	!
33	! 1353 2014-04-08 15:21:23Z heinze
34	! REAL constants provided with KIND-attribute
35	!
36	! 1346 2014-03-27 13:18:20Z heinze
37	! Bugfix: REAL constants provided with KIND-attribute especially in call of
38	! intrinsic function like MAX, MIN, SIGN
39	!
40	! 1322 2014-03-20 16:38:49Z raasch
41	! REAL functions provided with KIND-attribute
42	!
43	! 1320 2014-03-20 08:40:49Z raasch
44	! ONLY-attribute added to USE-statements,
45	! kind-parameters added to all INTEGER and REAL declaration statements,
46	! kinds are defined in new module kinds,
47	! revision history before 2012 removed,
48	! comment fields (!:) to be used for variable explanations added to
49	! all variable declaration statements
50	!
51	! 1036 2012-10-22 13:43:42Z raasch
52	! code put under GPL (PALM 3.9)
53	!
54	! 1015 2012-09-27 09:23:24Z raasch
55	! adjustment of mixing length to the Prandtl mixing length at first grid point
56	! above ground removed
57	!
58	! 1001 2012-09-13 14:08:46Z raasch
59	! all actions concerning leapfrog scheme removed
60	!
61	! 996 2012-09-07 10:41:47Z raasch
62	! little reformatting
63	!
64	! 978 2012-08-09 08:28:32Z fricke
65	! roughness length for scalar quantities z0h1d added
66	!
67	! Revision 1.1 1998/03/09 16:22:10 raasch
68	! Initial revision
69	!
70	!
71	! Description:
72	! ------------
73	!> 1D-model to initialize the 3D-arrays.
74	!> The temperature profile is set as steady and a corresponding steady solution
75	!> of the wind profile is being computed.
76	!> All subroutines required can be found within this file.
77	!>
78	!> @todo harmonize code with new surface_layer_fluxes module
79	!------------------------------------------------------------------------------!
80	SUBROUTINE init_1d_model
81
82
83	USE arrays_3d, &
84	ONLY: l_grid, ug, u_init, vg, v_init, zu
85
86	USE indices, &
87	ONLY: nzb, nzt
88
89	USE kinds
90
91	USE model_1d, &
92	ONLY: e1d, e1d_p, kh1d, km1d, l1d, l_black, qs1d, rif1d, &
93	simulated_time_1d, te_e, te_em, te_u, te_um, te_v, te_vm, ts1d, &
94	u1d, u1d_p, us1d, usws1d, v1d, v1d_p, vsws1d, z01d, z0h1d
95
96	USE control_parameters, &
97	ONLY: constant_diffusion, constant_flux_layer, f, humidity, kappa, &
98	km_constant, mixing_length_1d, passive_scalar, prandtl_number, &
99	roughness_length, simulated_time_chr, z0h_factor
100
101	IMPLICIT NONE
102
103	CHARACTER (LEN=9) :: time_to_string !<
104
105	INTEGER(iwp) :: k !<
106
107	REAL(wp) :: lambda !<
108
109	!
110	!-- Allocate required 1D-arrays
111	ALLOCATE( e1d(nzb:nzt+1), e1d_p(nzb:nzt+1), &
112	kh1d(nzb:nzt+1), km1d(nzb:nzt+1), &
113	l_black(nzb:nzt+1), l1d(nzb:nzt+1), &
114	rif1d(nzb:nzt+1), te_e(nzb:nzt+1), &
115	te_em(nzb:nzt+1), te_u(nzb:nzt+1), te_um(nzb:nzt+1), &
116	te_v(nzb:nzt+1), te_vm(nzb:nzt+1), u1d(nzb:nzt+1), &
117	u1d_p(nzb:nzt+1), v1d(nzb:nzt+1), &
118	v1d_p(nzb:nzt+1) )
119
120	!
121	!-- Initialize arrays
122	IF ( constant_diffusion ) THEN
123	km1d = km_constant
124	kh1d = km_constant / prandtl_number
125	ELSE
126	e1d = 0.0_wp; e1d_p = 0.0_wp
127	kh1d = 0.0_wp; km1d = 0.0_wp
128	rif1d = 0.0_wp
129	!
130	!-- Compute the mixing length
131	l_black(nzb) = 0.0_wp
132
133	IF ( TRIM( mixing_length_1d ) == 'blackadar' ) THEN
134	!
135	!-- Blackadar mixing length
136	IF ( f /= 0.0_wp ) THEN
137	lambda = 2.7E-4_wp * SQRT( ug(nzt+1)2 + vg(nzt+1)2 ) / &
138	ABS( f ) + 1E-10_wp
139	ELSE
140	lambda = 30.0_wp
141	ENDIF
142
143	DO k = nzb+1, nzt+1
144	l_black(k) = kappa * zu(k) / ( 1.0_wp + kappa * zu(k) / lambda )
145	ENDDO
146
147	ELSEIF ( TRIM( mixing_length_1d ) == 'as_in_3d_model' ) THEN
148	!
149	!-- Use the same mixing length as in 3D model
150	l_black(1:nzt) = l_grid
151	l_black(nzt+1) = l_black(nzt)
152
153	ENDIF
154	ENDIF
155	l1d = l_black
156	u1d = u_init
157	u1d_p = u_init
158	v1d = v_init
159	v1d_p = v_init
160
161	!
162	!-- Set initial horizontal velocities at the lowest grid levels to a very small
163	!-- value in order to avoid too small time steps caused by the diffusion limit
164	!-- in the initial phase of a run (at k=1, dz/2 occurs in the limiting formula!)
165	u1d(0:1) = 0.1_wp
166	u1d_p(0:1) = 0.1_wp
167	v1d(0:1) = 0.1_wp
168	v1d_p(0:1) = 0.1_wp
169
170	!
171	!-- For u, theta and the momentum fluxes plausible values are set
172	IF ( constant_flux_layer ) THEN
173	us1d = 0.1_wp ! without initial friction the flow would not change
174	ELSE
175	e1d(nzb+1) = 1.0_wp
176	km1d(nzb+1) = 1.0_wp
177	us1d = 0.0_wp
178	ENDIF
179	ts1d = 0.0_wp
180	usws1d = 0.0_wp
181	vsws1d = 0.0_wp
182	z01d = roughness_length
183	z0h1d = z0h_factor * z01d
184	IF ( humidity .OR. passive_scalar ) qs1d = 0.0_wp
185
186	!
187	!-- Tendencies must be preset in order to avoid runtime errors within the
188	!-- first Runge-Kutta step
189	te_em = 0.0_wp
190	te_um = 0.0_wp
191	te_vm = 0.0_wp
192
193	!
194	!-- Set start time in hh:mm:ss - format
195	simulated_time_chr = time_to_string( simulated_time_1d )
196
197	!
198	!-- Integrate the 1D-model equations using the leap-frog scheme
199	CALL time_integration_1d
200
201
202	END SUBROUTINE init_1d_model
203
204
205
206	!------------------------------------------------------------------------------!
207	! Description:
208	! ------------
209	!> Leap-frog time differencing scheme for the 1D-model.
210	!------------------------------------------------------------------------------!
211
212	SUBROUTINE time_integration_1d
213
214
215	USE arrays_3d, &
216	ONLY: dd2zu, ddzu, ddzw, l_grid, pt_init, q_init, ug, vg, zu
217
218	USE control_parameters, &
219	ONLY: constant_diffusion, constant_flux_layer, dissipation_1d, &
220	humidity, intermediate_timestep_count, &
221	intermediate_timestep_count_max, f, g, ibc_e_b, kappa, &
222	mixing_length_1d, passive_scalar, &
223	simulated_time_chr, timestep_scheme, tsc, zeta_max, zeta_min
224
225	USE indices, &
226	ONLY: nzb, nzb_diff, nzt
227
228	USE kinds
229
230	USE model_1d, &
231	ONLY: current_timestep_number_1d, damp_level_ind_1d, dt_1d, &
232	dt_pr_1d, dt_run_control_1d, e1d, e1d_p, end_time_1d, &
233	kh1d, km1d, l1d, l_black, qs1d, rif1d, simulated_time_1d, &
234	stop_dt_1d, te_e, te_em, te_u, te_um, te_v, te_vm, time_pr_1d, &
235	ts1d, time_run_control_1d, u1d, u1d_p, us1d, usws1d, v1d, &
236	v1d_p, vsws1d, z01d, z0h1d
237
238	USE pegrid
239
240	IMPLICIT NONE
241
242	CHARACTER (LEN=9) :: time_to_string !<
243
244	INTEGER(iwp) :: k !<
245
246	REAL(wp) :: a !<
247	REAL(wp) :: b !<
248	REAL(wp) :: dissipation !<
249	REAL(wp) :: dpt_dz !<
250	REAL(wp) :: flux !<
251	REAL(wp) :: kmzm !<
252	REAL(wp) :: kmzp !<
253	REAL(wp) :: l_stable !<
254	REAL(wp) :: pt_0 !<
255	REAL(wp) :: uv_total !<
256
257	!
258	!-- Determine the time step at the start of a 1D-simulation and
259	!-- determine and printout quantities used for run control
260	CALL timestep_1d
261	CALL run_control_1d
262
263	!
264	!-- Start of time loop
265	DO WHILE ( simulated_time_1d < end_time_1d .AND. .NOT. stop_dt_1d )
266
267	!
268	!-- Depending on the timestep scheme, carry out one or more intermediate
269	!-- timesteps
270
271	intermediate_timestep_count = 0
272	DO WHILE ( intermediate_timestep_count < &
273	intermediate_timestep_count_max )
274
275	intermediate_timestep_count = intermediate_timestep_count + 1
276
277	CALL timestep_scheme_steering
278
279	!
280	!-- Compute all tendency terms. If a Prandtl-layer is simulated, k starts
281	!-- at nzb+2.
282	DO k = nzb_diff, nzt
283
284	kmzm = 0.5_wp * ( km1d(k-1) + km1d(k) )
285	kmzp = 0.5_wp * ( km1d(k) + km1d(k+1) )
286	!
287	!-- u-component
288	te_u(k) = f * ( v1d(k) - vg(k) ) + ( &
289	kmzp * ( u1d(k+1) - u1d(k) ) * ddzu(k+1) &
290	- kmzm * ( u1d(k) - u1d(k-1) ) * ddzu(k) &
291	) * ddzw(k)
292	!
293	!-- v-component
294	te_v(k) = -f * ( u1d(k) - ug(k) ) + ( &
295	kmzp * ( v1d(k+1) - v1d(k) ) * ddzu(k+1) &
296	- kmzm * ( v1d(k) - v1d(k-1) ) * ddzu(k) &
297	) * ddzw(k)
298	ENDDO
299	IF ( .NOT. constant_diffusion ) THEN
300	DO k = nzb_diff, nzt
301	!
302	!-- TKE
303	kmzm = 0.5_wp * ( km1d(k-1) + km1d(k) )
304	kmzp = 0.5_wp * ( km1d(k) + km1d(k+1) )
305	IF ( .NOT. humidity ) THEN
306	pt_0 = pt_init(k)
307	flux = ( pt_init(k+1)-pt_init(k-1) ) * dd2zu(k)
308	ELSE
309	pt_0 = pt_init(k) * ( 1.0_wp + 0.61_wp * q_init(k) )
310	flux = ( ( pt_init(k+1) - pt_init(k-1) ) + &
311	0.61_wp * pt_init(k) * &
312	( q_init(k+1) - q_init(k-1) ) ) * dd2zu(k)
313	ENDIF
314
315	IF ( dissipation_1d == 'detering' ) THEN
316	!
317	!-- According to Detering, c_e=0.064
318	dissipation = 0.064_wp * e1d(k) * SQRT( e1d(k) ) / l1d(k)
319	ELSEIF ( dissipation_1d == 'as_in_3d_model' ) THEN
320	dissipation = ( 0.19_wp + 0.74_wp * l1d(k) / l_grid(k) ) &
321	* e1d(k) * SQRT( e1d(k) ) / l1d(k)
322	ENDIF
323
324	te_e(k) = km1d(k) * ( ( ( u1d(k+1) - u1d(k-1) ) * dd2zu(k) )**2&
325	+ ( ( v1d(k+1) - v1d(k-1) ) * dd2zu(k) )**2&
326	) &
327	- g / pt_0 * kh1d(k) * flux &
328	+ ( &
329	kmzp * ( e1d(k+1) - e1d(k) ) * ddzu(k+1) &
330	- kmzm * ( e1d(k) - e1d(k-1) ) * ddzu(k) &
331	) * ddzw(k) &
332	- dissipation
333	ENDDO
334	ENDIF
335
336	!
337	!-- Tendency terms at the top of the Prandtl-layer.
338	!-- Finite differences of the momentum fluxes are computed using half the
339	!-- normal grid length (2.0*ddzw(k)) for the sake of enhanced accuracy
340	IF ( constant_flux_layer ) THEN
341
342	k = nzb+1
343	kmzm = 0.5_wp * ( km1d(k-1) + km1d(k) )
344	kmzp = 0.5_wp * ( km1d(k) + km1d(k+1) )
345	IF ( .NOT. humidity ) THEN
346	pt_0 = pt_init(k)
347	flux = ( pt_init(k+1)-pt_init(k-1) ) * dd2zu(k)
348	ELSE
349	pt_0 = pt_init(k) * ( 1.0_wp + 0.61_wp * q_init(k) )
350	flux = ( ( pt_init(k+1) - pt_init(k-1) ) + &
351	0.61_wp * pt_init(k) * ( q_init(k+1) - q_init(k-1) ) &
352	) * dd2zu(k)
353	ENDIF
354
355	IF ( dissipation_1d == 'detering' ) THEN
356	!
357	!-- According to Detering, c_e=0.064
358	dissipation = 0.064_wp * e1d(k) * SQRT( e1d(k) ) / l1d(k)
359	ELSEIF ( dissipation_1d == 'as_in_3d_model' ) THEN
360	dissipation = ( 0.19_wp + 0.74_wp * l1d(k) / l_grid(k) ) &
361	* e1d(k) * SQRT( e1d(k) ) / l1d(k)
362	ENDIF
363
364	!
365	!-- u-component
366	te_u(k) = f * ( v1d(k) - vg(k) ) + ( &
367	kmzp * ( u1d(k+1) - u1d(k) ) * ddzu(k+1) + usws1d &
368	) * 2.0_wp * ddzw(k)
369	!
370	!-- v-component
371	te_v(k) = -f * ( u1d(k) - ug(k) ) + ( &
372	kmzp * ( v1d(k+1) - v1d(k) ) * ddzu(k+1) + vsws1d &
373	) * 2.0_wp * ddzw(k)
374	!
375	!-- TKE
376	te_e(k) = km1d(k) * ( ( ( u1d(k+1) - u1d(k-1) ) * dd2zu(k) )**2 &
377	+ ( ( v1d(k+1) - v1d(k-1) ) * dd2zu(k) )**2 &
378	) &
379	- g / pt_0 * kh1d(k) * flux &
380	+ ( &
381	kmzp * ( e1d(k+1) - e1d(k) ) * ddzu(k+1) &
382	- kmzm * ( e1d(k) - e1d(k-1) ) * ddzu(k) &
383	) * ddzw(k) &
384	- dissipation
385	ENDIF
386
387	!
388	!-- Prognostic equations for all 1D variables
389	DO k = nzb+1, nzt
390
391	u1d_p(k) = u1d(k) + dt_1d * ( tsc(2) * te_u(k) + &
392	tsc(3) * te_um(k) )
393	v1d_p(k) = v1d(k) + dt_1d * ( tsc(2) * te_v(k) + &
394	tsc(3) * te_vm(k) )
395
396	ENDDO
397	IF ( .NOT. constant_diffusion ) THEN
398	DO k = nzb+1, nzt
399
400	e1d_p(k) = e1d(k) + dt_1d * ( tsc(2) * te_e(k) + &
401	tsc(3) * te_em(k) )
402
403	ENDDO
404	!
405	!-- Eliminate negative TKE values, which can result from the
406	!-- integration due to numerical inaccuracies. In such cases the TKE
407	!-- value is reduced to 10 percent of its old value.
408	WHERE ( e1d_p < 0.0_wp ) e1d_p = 0.1_wp * e1d
409	ENDIF
410
411	!
412	!-- Calculate tendencies for the next Runge-Kutta step
413	IF ( timestep_scheme(1:5) == 'runge' ) THEN
414	IF ( intermediate_timestep_count == 1 ) THEN
415
416	DO k = nzb+1, nzt
417	te_um(k) = te_u(k)
418	te_vm(k) = te_v(k)
419	ENDDO
420
421	IF ( .NOT. constant_diffusion ) THEN
422	DO k = nzb+1, nzt
423	te_em(k) = te_e(k)
424	ENDDO
425	ENDIF
426
427	ELSEIF ( intermediate_timestep_count < &
428	intermediate_timestep_count_max ) THEN
429
430	DO k = nzb+1, nzt
431	te_um(k) = -9.5625_wp * te_u(k) + 5.3125_wp * te_um(k)
432	te_vm(k) = -9.5625_wp * te_v(k) + 5.3125_wp * te_vm(k)
433	ENDDO
434
435	IF ( .NOT. constant_diffusion ) THEN
436	DO k = nzb+1, nzt
437	te_em(k) = -9.5625_wp * te_e(k) + 5.3125_wp * te_em(k)
438	ENDDO
439	ENDIF
440
441	ENDIF
442	ENDIF
443
444
445	!
446	!-- Boundary conditions for the prognostic variables.
447	!-- At the top boundary (nzt+1) u,v and e keep their initial values
448	!-- (ug(nzt+1), vg(nzt+1), 0), at the bottom boundary the mirror
449	!-- boundary condition applies to u and v.
450	!-- The boundary condition for e is set further below ( (u/cm)*2 ).
451	! u1d_p(nzb) = -u1d_p(nzb+1)
452	! v1d_p(nzb) = -v1d_p(nzb+1)
453
454	u1d_p(nzb) = 0.0_wp
455	v1d_p(nzb) = 0.0_wp
456
457	!
458	!-- Swap the time levels in preparation for the next time step.
459	u1d = u1d_p
460	v1d = v1d_p
461	IF ( .NOT. constant_diffusion ) THEN
462	e1d = e1d_p
463	ENDIF
464
465	!
466	!-- Compute diffusion quantities
467	IF ( .NOT. constant_diffusion ) THEN
468
469	!
470	!-- First compute the vertical fluxes in the Prandtl-layer
471	IF ( constant_flux_layer ) THEN
472	!
473	!-- Compute theta* using Rif numbers of the previous time step
474	IF ( rif1d(1) >= 0.0_wp ) THEN
475	!
476	!-- Stable stratification
477	ts1d = kappa * ( pt_init(nzb+1) - pt_init(nzb) ) / &
478	( LOG( zu(nzb+1) / z0h1d ) + 5.0_wp * rif1d(nzb+1) * &
479	( zu(nzb+1) - z0h1d ) / zu(nzb+1) &
480	)
481	ELSE
482	!
483	!-- Unstable stratification
484	a = SQRT( 1.0_wp - 16.0_wp * rif1d(nzb+1) )
485	b = SQRT( 1.0_wp - 16.0_wp * rif1d(nzb+1) / &
486	zu(nzb+1) * z0h1d )
487	!
488	!-- In the borderline case the formula for stable stratification
489	!-- must be applied, because otherwise a zero division would
490	!-- occur in the argument of the logarithm.
491	IF ( a == 0.0_wp .OR. b == 0.0_wp ) THEN
492	ts1d = kappa * ( pt_init(nzb+1) - pt_init(nzb) ) / &
493	( LOG( zu(nzb+1) / z0h1d ) + &
494	5.0_wp * rif1d(nzb+1) * &
495	( zu(nzb+1) - z0h1d ) / zu(nzb+1) &
496	)
497	ELSE
498	ts1d = kappa * ( pt_init(nzb+1) - pt_init(nzb) ) / &
499	LOG( (a-1.0_wp) / (a+1.0_wp) * &
500	(b+1.0_wp) / (b-1.0_wp) )
501	ENDIF
502	ENDIF
503
504	ENDIF ! constant_flux_layer
505
506	!
507	!-- Compute the Richardson-flux numbers,
508	!-- first at the top of the Prandtl-layer using u* of the previous
509	!-- time step (+1E-30, if u* = 0), then in the remaining area. There
510	!-- the rif-numbers of the previous time step are used.
511
512	IF ( constant_flux_layer ) THEN
513	IF ( .NOT. humidity ) THEN
514	pt_0 = pt_init(nzb+1)
515	flux = ts1d
516	ELSE
517	pt_0 = pt_init(nzb+1) * ( 1.0_wp + 0.61_wp * q_init(nzb+1) )
518	flux = ts1d + 0.61_wp * pt_init(k) * qs1d
519	ENDIF
520	rif1d(nzb+1) = zu(nzb+1) * kappa * g * flux / &
521	( pt_0 * ( us1d**2 + 1E-30_wp ) )
522	ENDIF
523
524	DO k = nzb_diff, nzt
525	IF ( .NOT. humidity ) THEN
526	pt_0 = pt_init(k)
527	flux = ( pt_init(k+1) - pt_init(k-1) ) * dd2zu(k)
528	ELSE
529	pt_0 = pt_init(k) * ( 1.0_wp + 0.61_wp * q_init(k) )
530	flux = ( ( pt_init(k+1) - pt_init(k-1) ) &
531	+ 0.61_wp * pt_init(k) &
532	* ( q_init(k+1) - q_init(k-1) ) &
533	) * dd2zu(k)
534	ENDIF
535	IF ( rif1d(k) >= 0.0_wp ) THEN
536	rif1d(k) = g / pt_0 * flux / &
537	( ( ( u1d(k+1) - u1d(k-1) ) * dd2zu(k) )**2 &
538	+ ( ( v1d(k+1) - v1d(k-1) ) * dd2zu(k) )**2 &
539	+ 1E-30_wp &
540	)
541	ELSE
542	rif1d(k) = g / pt_0 * flux / &
543	( ( ( u1d(k+1) - u1d(k-1) ) * dd2zu(k) )**2 &
544	+ ( ( v1d(k+1) - v1d(k-1) ) * dd2zu(k) )**2 &
545	+ 1E-30_wp &
546	) * ( 1.0_wp - 16.0_wp * rif1d(k) )**0.25_wp
547	ENDIF
548	ENDDO
549	!
550	!-- Richardson-numbers must remain restricted to a realistic value
551	!-- range. It is exceeded excessively for very small velocities
552	!-- (u,v --> 0).
553	WHERE ( rif1d < zeta_min ) rif1d = zeta_min
554	WHERE ( rif1d > zeta_max ) rif1d = zeta_max
555
556	!
557	!-- Compute u* from the absolute velocity value
558	IF ( constant_flux_layer ) THEN
559	uv_total = SQRT( u1d(nzb+1)2 + v1d(nzb+1)2 )
560
561	IF ( rif1d(nzb+1) >= 0.0_wp ) THEN
562	!
563	!-- Stable stratification
564	us1d = kappa * uv_total / ( &
565	LOG( zu(nzb+1) / z01d ) + 5.0_wp * rif1d(nzb+1) * &
566	( zu(nzb+1) - z01d ) / zu(nzb+1) &
567	)
568	ELSE
569	!
570	!-- Unstable stratification
571	a = 1.0_wp / SQRT( SQRT( 1.0_wp - 16.0_wp * rif1d(nzb+1) ) )
572	b = 1.0_wp / SQRT( SQRT( 1.0_wp - 16.0_wp * rif1d(nzb+1) / &
573	zu(nzb+1) * z01d ) )
574	!
575	!-- In the borderline case the formula for stable stratification
576	!-- must be applied, because otherwise a zero division would
577	!-- occur in the argument of the logarithm.
578	IF ( a == 1.0_wp .OR. b == 1.0_wp ) THEN
579	us1d = kappa * uv_total / ( &
580	LOG( zu(nzb+1) / z01d ) + &
581	5.0_wp * rif1d(nzb+1) * ( zu(nzb+1) - z01d ) / &
582	zu(nzb+1) )
583	ELSE
584	us1d = kappa * uv_total / ( &
585	LOG( (1.0_wp+b) / (1.0_wp-b) * (1.0_wp-a) / &
586	(1.0_wp+a) ) + &
587	2.0_wp * ( ATAN( b ) - ATAN( a ) ) &
588	)
589	ENDIF
590	ENDIF
591
592	!
593	!-- Compute the momentum fluxes for the diffusion terms
594	usws1d = - u1d(nzb+1) / uv_total * us1d**2
595	vsws1d = - v1d(nzb+1) / uv_total * us1d**2
596
597	!
598	!-- Boundary condition for the turbulent kinetic energy at the top
599	!-- of the Prandtl-layer. c_m = 0.4 according to Detering.
600	!-- Additional Neumann condition de/dz = 0 at nzb is set to ensure
601	!-- compatibility with the 3D model.
602	IF ( ibc_e_b == 2 ) THEN
603	e1d(nzb+1) = ( us1d / 0.1_wp )**2
604	! e1d(nzb+1) = ( us1d / 0.4_wp )**2 !not used so far, see also
605	!prandtl_fluxes
606	ENDIF
607	e1d(nzb) = e1d(nzb+1)
608
609	IF ( humidity .OR. passive_scalar ) THEN
610	!
611	!-- Compute q*
612	IF ( rif1d(1) >= 0.0_wp ) THEN
613	!
614	!-- Stable stratification
615	qs1d = kappa * ( q_init(nzb+1) - q_init(nzb) ) / &
616	( LOG( zu(nzb+1) / z0h1d ) + 5.0_wp * rif1d(nzb+1) * &
617	( zu(nzb+1) - z0h1d ) / zu(nzb+1) &
618	)
619	ELSE
620	!
621	!-- Unstable stratification
622	a = SQRT( 1.0_wp - 16.0_wp * rif1d(nzb+1) )
623	b = SQRT( 1.0_wp - 16.0_wp * rif1d(nzb+1) / &
624	zu(nzb+1) * z0h1d )
625	!
626	!-- In the borderline case the formula for stable stratification
627	!-- must be applied, because otherwise a zero division would
628	!-- occur in the argument of the logarithm.
629	IF ( a == 1.0_wp .OR. b == 1.0_wp ) THEN
630	qs1d = kappa * ( q_init(nzb+1) - q_init(nzb) ) / &
631	( LOG( zu(nzb+1) / z0h1d ) + &
632	5.0_wp * rif1d(nzb+1) * &
633	( zu(nzb+1) - z0h1d ) / zu(nzb+1) &
634	)
635	ELSE
636	qs1d = kappa * ( q_init(nzb+1) - q_init(nzb) ) / &
637	LOG( (a-1.0_wp) / (a+1.0_wp) * &
638	(b+1.0_wp) / (b-1.0_wp) )
639	ENDIF
640	ENDIF
641	ELSE
642	qs1d = 0.0_wp
643	ENDIF
644
645	ENDIF ! constant_flux_layer
646
647	!
648	!-- Compute the diabatic mixing length
649	IF ( mixing_length_1d == 'blackadar' ) THEN
650	DO k = nzb+1, nzt
651	IF ( rif1d(k) >= 0.0_wp ) THEN
652	l1d(k) = l_black(k) / ( 1.0_wp + 5.0_wp * rif1d(k) )
653	ELSE
654	l1d(k) = l_black(k) * &
655	( 1.0_wp - 16.0_wp * rif1d(k) )**0.25_wp
656	ENDIF
657	l1d(k) = l_black(k)
658	ENDDO
659
660	ELSEIF ( mixing_length_1d == 'as_in_3d_model' ) THEN
661	DO k = nzb+1, nzt
662	dpt_dz = ( pt_init(k+1) - pt_init(k-1) ) * dd2zu(k)
663	IF ( dpt_dz > 0.0_wp ) THEN
664	l_stable = 0.76_wp * SQRT( e1d(k) ) / &
665	SQRT( g / pt_init(k) * dpt_dz ) + 1E-5_wp
666	ELSE
667	l_stable = l_grid(k)
668	ENDIF
669	l1d(k) = MIN( l_grid(k), l_stable )
670	ENDDO
671	ENDIF
672
673	!
674	!-- Compute the diffusion coefficients for momentum via the
675	!-- corresponding Prandtl-layer relationship and according to
676	!-- Prandtl-Kolmogorov, respectively. The unstable stratification is
677	!-- computed via the adiabatic mixing length, for the unstability has
678	!-- already been taken account of via the TKE (cf. also Diss.).
679	IF ( constant_flux_layer ) THEN
680	IF ( rif1d(nzb+1) >= 0.0_wp ) THEN
681	km1d(nzb+1) = us1d * kappa * zu(nzb+1) / &
682	( 1.0_wp + 5.0_wp * rif1d(nzb+1) )
683	ELSE
684	km1d(nzb+1) = us1d * kappa * zu(nzb+1) * &
685	( 1.0_wp - 16.0_wp * rif1d(nzb+1) )**0.25_wp
686	ENDIF
687	ENDIF
688	DO k = nzb_diff, nzt
689	! km1d(k) = 0.4 * SQRT( e1d(k) ) !changed: adjustment to 3D-model
690	km1d(k) = 0.1_wp * SQRT( e1d(k) )
691	IF ( rif1d(k) >= 0.0_wp ) THEN
692	km1d(k) = km1d(k) * l1d(k)
693	ELSE
694	km1d(k) = km1d(k) * l_black(k)
695	ENDIF
696	ENDDO
697
698	!
699	!-- Add damping layer
700	DO k = damp_level_ind_1d+1, nzt+1
701	km1d(k) = 1.1_wp * km1d(k-1)
702	km1d(k) = MIN( km1d(k), 10.0_wp )
703	ENDDO
704
705	!
706	!-- Compute the diffusion coefficient for heat via the relationship
707	!-- kh = phim / phih * km
708	DO k = nzb+1, nzt
709	IF ( rif1d(k) >= 0.0_wp ) THEN
710	kh1d(k) = km1d(k)
711	ELSE
712	kh1d(k) = km1d(k) * ( 1.0_wp - 16.0_wp * rif1d(k) )**0.25_wp
713	ENDIF
714	ENDDO
715
716	ENDIF ! .NOT. constant_diffusion
717
718	ENDDO ! intermediate step loop
719
720	!
721	!-- Increment simulated time and output times
722	current_timestep_number_1d = current_timestep_number_1d + 1
723	simulated_time_1d = simulated_time_1d + dt_1d
724	simulated_time_chr = time_to_string( simulated_time_1d )
725	time_pr_1d = time_pr_1d + dt_1d
726	time_run_control_1d = time_run_control_1d + dt_1d
727
728	!
729	!-- Determine and print out quantities for run control
730	IF ( time_run_control_1d >= dt_run_control_1d ) THEN
731	CALL run_control_1d
732	time_run_control_1d = time_run_control_1d - dt_run_control_1d
733	ENDIF
734
735	!
736	!-- Profile output on file
737	IF ( time_pr_1d >= dt_pr_1d ) THEN
738	CALL print_1d_model
739	time_pr_1d = time_pr_1d - dt_pr_1d
740	ENDIF
741
742	!
743	!-- Determine size of next time step
744	CALL timestep_1d
745
746	ENDDO ! time loop
747
748
749	END SUBROUTINE time_integration_1d
750
751
752	!------------------------------------------------------------------------------!
753	! Description:
754	! ------------
755	!> Compute and print out quantities for run control of the 1D model.
756	!------------------------------------------------------------------------------!
757
758	SUBROUTINE run_control_1d
759
760
761	USE constants, &
762	ONLY: pi
763
764	USE indices, &
765	ONLY: nzb, nzt
766
767	USE kinds
768
769	USE model_1d, &
770	ONLY: current_timestep_number_1d, dt_1d, run_control_header_1d, u1d, &
771	us1d, v1d
772
773	USE pegrid
774
775	USE control_parameters, &
776	ONLY: simulated_time_chr
777
778	IMPLICIT NONE
779
780	INTEGER(iwp) :: k !<
781
782	REAL(wp) :: alpha
783	REAL(wp) :: energy
784	REAL(wp) :: umax
785	REAL(wp) :: uv_total
786	REAL(wp) :: vmax
787
788	!
789	!-- Output
790	IF ( myid == 0 ) THEN
791	!
792	!-- If necessary, write header
793	IF ( .NOT. run_control_header_1d ) THEN
794	CALL check_open( 15 )
795	WRITE ( 15, 100 )
796	run_control_header_1d = .TRUE.
797	ENDIF
798
799	!
800	!-- Compute control quantities
801	!-- grid level nzp is excluded due to mirror boundary condition
802	umax = 0.0_wp; vmax = 0.0_wp; energy = 0.0_wp
803	DO k = nzb+1, nzt+1
804	umax = MAX( ABS( umax ), ABS( u1d(k) ) )
805	vmax = MAX( ABS( vmax ), ABS( v1d(k) ) )
806	energy = energy + 0.5_wp * ( u1d(k)2 + v1d(k)2 )
807	ENDDO
808	energy = energy / REAL( nzt - nzb + 1, KIND=wp )
809
810	uv_total = SQRT( u1d(nzb+1)2 + v1d(nzb+1)2 )
811	IF ( ABS( v1d(nzb+1) ) < 1.0E-5_wp ) THEN
812	alpha = ACOS( SIGN( 1.0_wp , u1d(nzb+1) ) )
813	ELSE
814	alpha = ACOS( u1d(nzb+1) / uv_total )
815	IF ( v1d(nzb+1) <= 0.0_wp ) alpha = 2.0_wp * pi - alpha
816	ENDIF
817	alpha = alpha / ( 2.0_wp * pi ) * 360.0_wp
818
819	WRITE ( 15, 101 ) current_timestep_number_1d, simulated_time_chr, &
820	dt_1d, umax, vmax, us1d, alpha, energy
821	!
822	!-- Write buffer contents to disc immediately
823	CALL local_flush( 15 )
824
825	ENDIF
826
827	!
828	!-- formats
829	100 FORMAT (///'1D-Zeitschrittkontrollausgaben:'/ &
830	&'------------------------------'// &
831	&'ITER. HH:MM:SS DT UMAX VMAX U* ALPHA ENERG.'/ &
832	&'-------------------------------------------------------------')
833	101 FORMAT (I5,2X,A9,1X,F6.2,2X,F6.2,1X,F6.2,2X,F5.3,2X,F5.1,2X,F7.2)
834
835
836	END SUBROUTINE run_control_1d
837
838
839
840	!------------------------------------------------------------------------------!
841	! Description:
842	! ------------
843	!> Compute the time step w.r.t. the diffusion criterion
844	!------------------------------------------------------------------------------!
845
846	SUBROUTINE timestep_1d
847
848
849	USE arrays_3d, &
850	ONLY: dzu, zu
851
852	USE indices, &
853	ONLY: nzb, nzt
854
855	USE kinds
856
857	USE model_1d, &
858	ONLY: dt_1d, dt_max_1d, km1d, old_dt_1d, stop_dt_1d
859
860	USE pegrid
861
862	USE control_parameters, &
863	ONLY: message_string
864
865	IMPLICIT NONE
866
867	INTEGER(iwp) :: k !<
868
869	REAL(wp) :: div !<
870	REAL(wp) :: dt_diff !<
871	REAL(wp) :: fac !<
872	REAL(wp) :: value !<
873
874
875	!
876	!-- Compute the currently feasible time step according to the diffusion
877	!-- criterion. At nzb+1 the half grid length is used.
878	fac = 0.35_wp
879	dt_diff = dt_max_1d
880	DO k = nzb+2, nzt
881	value = fac * dzu(k) * dzu(k) / ( km1d(k) + 1E-20_wp )
882	dt_diff = MIN( value, dt_diff )
883	ENDDO
884	value = fac * zu(nzb+1) * zu(nzb+1) / ( km1d(nzb+1) + 1E-20_wp )
885	dt_1d = MIN( value, dt_diff )
886
887	!
888	!-- Set flag when the time step becomes too small
889	IF ( dt_1d < ( 0.00001_wp * dt_max_1d ) ) THEN
890	stop_dt_1d = .TRUE.
891
892	WRITE( message_string, * ) 'timestep has exceeded the lower limit &', &
893	'dt_1d = ',dt_1d,' s simulation stopped!'
894	CALL message( 'timestep_1d', 'PA0192', 1, 2, 0, 6, 0 )
895
896	ENDIF
897
898	!
899	!-- A more or less simple new time step value is obtained taking only the
900	!-- first two significant digits
901	div = 1000.0_wp
902	DO WHILE ( dt_1d < div )
903	div = div / 10.0_wp
904	ENDDO
905	dt_1d = NINT( dt_1d * 100.0_wp / div ) * div / 100.0_wp
906
907	old_dt_1d = dt_1d
908
909
910	END SUBROUTINE timestep_1d
911
912
913
914	!------------------------------------------------------------------------------!
915	! Description:
916	! ------------
917	!> List output of profiles from the 1D-model
918	!------------------------------------------------------------------------------!
919
920	SUBROUTINE print_1d_model
921
922
923	USE arrays_3d, &
924	ONLY: pt_init, zu
925
926	USE indices, &
927	ONLY: nzb, nzt
928
929	USE kinds
930
931	USE model_1d, &
932	ONLY: e1d, kh1d, km1d, l1d, rif1d, u1d, v1d
933
934	USE pegrid
935
936	USE control_parameters, &
937	ONLY: run_description_header, simulated_time_chr
938
939	IMPLICIT NONE
940
941
942	INTEGER(iwp) :: k !<
943
944
945	IF ( myid == 0 ) THEN
946	!
947	!-- Open list output file for profiles from the 1D-model
948	CALL check_open( 17 )
949
950	!
951	!-- Write Header
952	WRITE ( 17, 100 ) TRIM( run_description_header ), &
953	TRIM( simulated_time_chr )
954	WRITE ( 17, 101 )
955
956	!
957	!-- Write the values
958	WRITE ( 17, 102 )
959	WRITE ( 17, 101 )
960	DO k = nzt+1, nzb, -1
961	WRITE ( 17, 103) k, zu(k), u1d(k), v1d(k), pt_init(k), e1d(k), &
962	rif1d(k), km1d(k), kh1d(k), l1d(k), zu(k), k
963	ENDDO
964	WRITE ( 17, 101 )
965	WRITE ( 17, 102 )
966	WRITE ( 17, 101 )
967
968	!
969	!-- Write buffer contents to disc immediately
970	CALL local_flush( 17 )
971
972	ENDIF
973
974	!
975	!-- Formats
976	100 FORMAT (//1X,A/1X,10('-')/' 1d-model profiles'/ &
977	' Time: ',A)
978	101 FORMAT (1X,79('-'))
979	102 FORMAT (' k zu u v pt e rif Km Kh ', &
980	'l zu k')
981	103 FORMAT (1X,I4,1X,F7.1,1X,F6.2,1X,F6.2,1X,F6.2,1X,F6.2,1X,F5.2,1X,F5.2, &
982	1X,F5.2,1X,F6.2,1X,F7.1,2X,I4)
983
984
985	END SUBROUTINE print_1d_model

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |