Home

Context Navigation

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

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

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |