Home

Context Navigation

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

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

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

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |