Home

Context Navigation

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

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

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |