Home

Context Navigation

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

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

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

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |