Home

Context Navigation

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

Last change on this file since 1964 was 1961, checked in by suehring, 8 years ago
last commit documented
Property svn:keywords set to `Id`
File size: 36.4 KB

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

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |