Home

Context Navigation

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

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

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |