Home

Context Navigation

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

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

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

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |