Home

Context Navigation

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

Last change on this file since 1350 was 1347, checked in by heinze, 11 years ago
last commit documented
Property svn:keywords set to `Id`
File size: 34.2 KB

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

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |