Home

Context Navigation

source: palm/trunk/SOURCE/nudging.f90 @ 1386

Last change on this file since 1386 was 1383, checked in by boeske, 11 years ago
last commit documented
Property svn:keywords set to `Id`
File size: 18.6 KB

Rev	Line
[1239]	1	MODULE nudge_mod
	2
	3	!--------------------------------------------------------------------------------!
	4	! This file is part of PALM.
	5	!
	6	! PALM is free software: you can redistribute it and/or modify it under the terms
	7	! of the GNU General Public License as published by the Free Software Foundation,
	8	! either version 3 of the License, or (at your option) any later version.
	9	!
	10	! PALM is distributed in the hope that it will be useful, but WITHOUT ANY
	11	! WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
	12	! A PARTICULAR PURPOSE. See the GNU General Public License for more details.
	13	!
	14	! You should have received a copy of the GNU General Public License along with
	15	! PALM. If not, see <http://www.gnu.org/licenses/>.
	16	!
[1310]	17	! Copyright 1997-2014 Leibniz Universitaet Hannover
[1239]	18	!--------------------------------------------------------------------------------!
	19	!
	20	! Current revisions:
	21	! ------------------
[1383]	22	!
	23	!
	24	! Former revisions:
	25	! -----------------
	26	! $Id: nudging.f90 1383 2014-04-30 12:17:54Z boeske $
	27	!
	28	! 1382 2014-04-30 12:15:41Z boeske
[1382]	29	! Changed the weighting factor that is used in the summation of nudging
	30	! tendencies for profile data output from weight_pres to weight_substep,
	31	! added Neumann boundary conditions for profile data output of nudging terms at
	32	! nzt+1
[1366]	33	!
[1381]	34	! 1380 2014-04-28 12:40:45Z heinze
	35	! Subroutine nudge_ref added to account for proper upper scalar boundary
	36	! conditions in case of nudging
	37	!
[1366]	38	! 1365 2014-04-22 15:03:56Z boeske
[1365]	39	! Variable t renamed nt, variable currtnudge renamed tmp_tnudge,
	40	! summation of nudging tendencies for data output added
	41	! +sums_ls_l, tmp_tend
	42	! Added new subroutine calc_tnudge, which calculates the current nudging time
	43	! scale at each time step
[1354]	44	!
[1356]	45	! 1355 2014-04-10 10:21:29Z heinze
	46	! Error message specified.
	47	!
[1354]	48	! 1353 2014-04-08 15:21:23Z heinze
	49	! REAL constants provided with KIND-attribute
	50	!
[1321]	51	! 1320 2014-03-20 08:40:49Z raasch
[1320]	52	! ONLY-attribute added to USE-statements,
	53	! kind-parameters added to all INTEGER and REAL declaration statements,
	54	! kinds are defined in new module kinds,
	55	! old module precision_kind is removed,
	56	! revision history before 2012 removed,
	57	! comment fields (!:) to be used for variable explanations added to
	58	! all variable declaration statements
[1239]	59	!
[1319]	60	! 1318 2014-03-17 13:35:16Z raasch
	61	! module interfaces removed
	62	!
[1269]	63	! 1268 2013-12-12 09:47:53Z heinze
	64	! bugfix: argument of calc_mean_profile corrected
	65	!
[1252]	66	! 1251 2013-11-07 08:14:30Z heinze
	67	! bugfix: calculate dtm and dtp also in vector version
	68	!
[1250]	69	! 1249 2013-11-06 10:45:47Z heinze
	70	! remove call of user module
	71	! reformatting
	72	!
[1242]	73	! 1241 2013-10-30 11:36:58Z heinze
	74	! Initial revision
[1239]	75	!
	76	! Description:
	77	! ------------
	78	! Nudges u, v, pt and q to given profiles on a relaxation timescale tnudge.
	79	! Profiles are read in from NUDGIN_DATA. Code is based on Neggers et al. (2012)
	80	! and also part of DALES and UCLA-LES.
	81	!--------------------------------------------------------------------------------!
	82
	83	PRIVATE
[1380]	84	PUBLIC init_nudge, calc_tnudge, nudge, nudge_ref
[1239]	85	SAVE
	86
	87	INTERFACE nudge
	88	MODULE PROCEDURE nudge
	89	MODULE PROCEDURE nudge_ij
	90	END INTERFACE nudge
	91
	92	CONTAINS
	93
	94	SUBROUTINE init_nudge
	95
[1320]	96	USE arrays_3d, &
[1365]	97	ONLY: ptnudge, qnudge, timenudge, tmp_tnudge, tnudge, unudge, &
	98	vnudge, wnudge, zu
[1239]	99
[1320]	100	USE control_parameters, &
	101	ONLY: dt_3d, lptnudge, lqnudge, lunudge, lvnudge, lwnudge, &
	102	message_string, ntnudge
	103
	104	USE indices, &
	105	ONLY: nzb, nzt
	106
	107	USE kinds
	108
[1239]	109	IMPLICIT NONE
	110
	111
[1320]	112	INTEGER(iwp) :: finput = 90 !:
	113	INTEGER(iwp) :: ierrn !:
	114	INTEGER(iwp) :: k !:
[1365]	115	INTEGER(iwp) :: nt !:
[1239]	116
[1320]	117	CHARACTER(1) :: hash !:
	118
	119	REAL(wp) :: highheight !:
	120	REAL(wp) :: highqnudge !:
	121	REAL(wp) :: highptnudge !:
	122	REAL(wp) :: highunudge !:
	123	REAL(wp) :: highvnudge !:
	124	REAL(wp) :: highwnudge !:
	125	REAL(wp) :: hightnudge !:
	126
	127	REAL(wp) :: lowheight !:
	128	REAL(wp) :: lowqnudge !:
	129	REAL(wp) :: lowptnudge !:
	130	REAL(wp) :: lowunudge !:
	131	REAL(wp) :: lowvnudge !:
	132	REAL(wp) :: lowwnudge !:
	133	REAL(wp) :: lowtnudge !:
	134
	135	REAL(wp) :: fac !:
	136
[1239]	137	ALLOCATE( ptnudge(nzb:nzt+1,1:ntnudge), qnudge(nzb:nzt+1,1:ntnudge), &
	138	tnudge(nzb:nzt+1,1:ntnudge), unudge(nzb:nzt+1,1:ntnudge), &
	139	vnudge(nzb:nzt+1,1:ntnudge), wnudge(nzb:nzt+1,1:ntnudge) )
	140
[1365]	141	ALLOCATE( tmp_tnudge(nzb:nzt) )
	142
[1239]	143	ALLOCATE( timenudge(0:ntnudge) )
	144
[1353]	145	ptnudge = 0.0_wp; qnudge = 0.0_wp; tnudge = 0.0_wp; unudge = 0.0_wp
	146	vnudge = 0.0_wp; wnudge = 0.0_wp; timenudge = 0.0_wp
[1365]	147	!
	148	!-- Initialize array tmp_nudge with a current nudging time scale of 6 hours
	149	tmp_tnudge = 21600.0_wp
[1239]	150
[1365]	151	nt = 0
[1249]	152	OPEN ( finput, FILE='NUDGING_DATA', STATUS='OLD', &
	153	FORM='FORMATTED', IOSTAT=ierrn )
[1239]	154
[1249]	155	IF ( ierrn /= 0 ) THEN
[1239]	156	message_string = 'file NUDGING_DATA does not exist'
	157	CALL message( 'nudging', 'PA0365', 1, 2, 0, 6, 0 )
	158	ENDIF
	159
	160	ierrn = 0
	161
	162	rloop:DO
[1365]	163	nt = nt + 1
[1239]	164	hash = "#"
[1320]	165	ierrn = 1 ! not zero
[1239]	166	!
	167	!-- Search for the next line consisting of "# time",
	168	!-- from there onwards the profiles will be read
	169	DO WHILE ( .NOT. ( hash == "#" .AND. ierrn == 0 ) )
	170
[1365]	171	READ ( finput, *, IOSTAT=ierrn ) hash, timenudge(nt)
[1249]	172	IF ( ierrn < 0 ) EXIT rloop
[1239]	173
	174	ENDDO
	175
	176	ierrn = 0
[1249]	177	READ ( finput, *, IOSTAT=ierrn ) lowheight, lowtnudge, lowunudge, &
	178	lowvnudge, lowwnudge , lowptnudge, &
	179	lowqnudge
[1239]	180
[1249]	181	IF ( ierrn /= 0 ) THEN
[1239]	182	message_string = 'errors in file NUDGING_DATA'
	183	CALL message( 'nudging', 'PA0366', 1, 2, 0, 6, 0 )
	184	ENDIF
	185
	186	ierrn = 0
[1249]	187	READ ( finput, *, IOSTAT=ierrn ) highheight, hightnudge, highunudge, &
	188	highvnudge, highwnudge , highptnudge, &
	189	highqnudge
[1239]	190
[1249]	191	IF ( ierrn /= 0 ) THEN
[1239]	192	message_string = 'errors in file NUDGING_DATA'
	193	CALL message( 'nudging', 'PA0366', 1, 2, 0, 6, 0 )
	194	ENDIF
	195
	196	DO k = nzb, nzt+1
[1249]	197	IF ( highheight < zu(k) ) THEN
[1239]	198	lowheight = highheight
	199	lowtnudge = hightnudge
	200	lowunudge = highunudge
	201	lowvnudge = highvnudge
	202	lowwnudge = highwnudge
	203	lowptnudge = highptnudge
	204	lowqnudge = highqnudge
	205
	206	ierrn = 0
[1249]	207	READ ( finput, *, IOSTAT=ierrn ) highheight , hightnudge , &
	208	highunudge , highvnudge , &
	209	highwnudge , highptnudge, &
	210	highqnudge
	211	IF (ierrn /= 0 ) THEN
[1355]	212	WRITE( message_string, * ) 'zu(nzt+1) = ', zu(nzt+1), 'm is ',&
	213	'higher than the maximum height in NUDING_DATA which ', &
	214	'is ', lowheight, 'm. Interpolation on PALM ', &
	215	'grid is not possible.'
	216	CALL message( 'nudging', 'PA0364', 1, 2, 0, 6, 0 )
[1239]	217	ENDIF
	218	ENDIF
	219
	220	!
	221	!-- Interpolation of prescribed profiles in space
	222
[1249]	223	fac = ( highheight - zu(k) ) / ( highheight - lowheight )
[1239]	224
[1365]	225	tnudge(k,nt) = fac * lowtnudge + ( 1.0_wp - fac ) * hightnudge
	226	unudge(k,nt) = fac * lowunudge + ( 1.0_wp - fac ) * highunudge
	227	vnudge(k,nt) = fac * lowvnudge + ( 1.0_wp - fac ) * highvnudge
	228	wnudge(k,nt) = fac * lowwnudge + ( 1.0_wp - fac ) * highwnudge
	229	ptnudge(k,nt) = fac * lowptnudge + ( 1.0_wp - fac ) * highptnudge
	230	qnudge(k,nt) = fac * lowqnudge + ( 1.0_wp - fac ) * highqnudge
[1239]	231	ENDDO
	232
	233	ENDDO rloop
	234
[1249]	235	CLOSE ( finput )
[1239]	236
	237	!
	238	!-- Prevent nudging if nudging profiles exhibt too small values
[1241]	239	!-- not used so far
[1353]	240	lptnudge = ANY( ABS( ptnudge ) > 1.0e-8_wp )
	241	lqnudge = ANY( ABS( qnudge ) > 1.0e-8_wp )
	242	lunudge = ANY( ABS( unudge ) > 1.0e-8_wp )
	243	lvnudge = ANY( ABS( vnudge ) > 1.0e-8_wp )
	244	lwnudge = ANY( ABS( wnudge ) > 1.0e-8_wp )
[1239]	245
	246	END SUBROUTINE init_nudge
	247
[1365]	248
	249	SUBROUTINE calc_tnudge ( time )
	250
	251	USE arrays_3d, &
	252	ONLY: timenudge, tmp_tnudge, tnudge
	253
	254	USE control_parameters, &
	255	ONLY: dt_3d
	256
	257	USE indices, &
	258	ONLY: nzb, nzt
	259
	260	USE kinds
	261
	262	IMPLICIT NONE
	263
	264
	265	REAL(wp) :: dtm !:
	266	REAL(wp) :: dtp !:
	267	REAL(wp) :: time !:
	268
	269	INTEGER(iwp) :: k !:
	270	INTEGER(iwp) :: nt !:
	271
	272	nt = 1
	273	DO WHILE ( time > timenudge(nt) )
	274	nt = nt+1
	275	ENDDO
	276	IF ( time /= timenudge(1) ) THEN
	277	nt = nt-1
	278	ENDIF
	279
	280	dtm = ( time - timenudge(nt) ) / ( timenudge(nt+1) - timenudge(nt) )
	281	dtp = ( timenudge(nt+1) - time ) / ( timenudge(nt+1) - timenudge(nt) )
	282
	283	DO k = nzb, nzt
	284	tmp_tnudge(k) = MAX( dt_3d, tnudge(k,nt) * dtp + tnudge(k,nt+1) * dtm )
	285	ENDDO
	286
	287	END SUBROUTINE calc_tnudge
	288
[1239]	289	!------------------------------------------------------------------------------!
	290	! Call for all grid points
	291	!------------------------------------------------------------------------------!
	292	SUBROUTINE nudge ( time, prog_var )
	293
[1320]	294	USE arrays_3d, &
[1365]	295	ONLY: pt, ptnudge, q, qnudge, tend, timenudge, tmp_tnudge, tnudge, &
	296	u, unudge, v, vnudge
[1239]	297
[1320]	298	USE control_parameters, &
[1365]	299	ONLY: dt_3d, intermediate_timestep_count, message_string
[1320]	300
	301	USE indices, &
	302	ONLY: nxl, nxr, nys, nyn, nzb, nzb_u_inner, nzt
	303
[1365]	304	USE kinds
[1320]	305
	306	USE statistics, &
[1382]	307	ONLY: hom, sums_ls_l, weight_substep
[1320]	308
[1239]	309	IMPLICIT NONE
	310
[1320]	311	CHARACTER (LEN=*) :: prog_var !:
[1239]	312
[1365]	313	REAL(wp) :: tmp_tend !:
[1320]	314	REAL(wp) :: dtm !:
	315	REAL(wp) :: dtp !:
	316	REAL(wp) :: time !:
[1239]	317
[1320]	318	INTEGER(iwp) :: i !:
	319	INTEGER(iwp) :: j !:
	320	INTEGER(iwp) :: k !:
[1365]	321	INTEGER(iwp) :: nt !:
[1239]	322
	323
[1365]	324	nt = 1
	325	DO WHILE ( time > timenudge(nt) )
	326	nt = nt+1
[1251]	327	ENDDO
	328	IF ( time /= timenudge(1) ) THEN
[1365]	329	nt = nt-1
[1251]	330	ENDIF
	331
[1365]	332	dtm = ( time - timenudge(nt) ) / ( timenudge(nt+1) - timenudge(nt) )
	333	dtp = ( timenudge(nt+1) - time ) / ( timenudge(nt+1) - timenudge(nt) )
[1251]	334
[1239]	335	SELECT CASE ( prog_var )
	336
	337	CASE ( 'u' )
	338
	339	DO i = nxl, nxr
	340	DO j = nys, nyn
[1382]	341
[1239]	342	DO k = nzb_u_inner(j,i)+1, nzt
	343
[1365]	344	tmp_tend = - ( hom(k,1,1,0) - ( unudge(k,nt) * dtp + &
	345	unudge(k,nt+1) * dtm ) ) / tmp_tnudge(k)
[1239]	346
[1365]	347	tend(k,j,i) = tend(k,j,i) + tmp_tend
[1239]	348
[1365]	349	sums_ls_l(k,6) = sums_ls_l(k,6) + tmp_tend * &
[1382]	350	weight_substep(intermediate_timestep_count)
[1239]	351	ENDDO
[1382]	352
	353	sums_ls_l(nzt+1,6) = sums_ls_l(nzt,6)
	354
[1239]	355	ENDDO
	356	ENDDO
	357
	358	CASE ( 'v' )
	359
	360	DO i = nxl, nxr
	361	DO j = nys, nyn
[1382]	362
[1239]	363	DO k = nzb_u_inner(j,i)+1, nzt
	364
[1365]	365	tmp_tend = - ( hom(k,1,2,0) - ( vnudge(k,nt) * dtp + &
	366	vnudge(k,nt+1) * dtm ) ) / tmp_tnudge(k)
[1239]	367
[1365]	368	tend(k,j,i) = tend(k,j,i) + tmp_tend
[1239]	369
[1365]	370	sums_ls_l(k,7) = sums_ls_l(k,7) + tmp_tend * &
[1382]	371	weight_substep(intermediate_timestep_count)
[1239]	372	ENDDO
[1382]	373
	374	sums_ls_l(nzt+1,7) = sums_ls_l(nzt,7)
	375
[1239]	376	ENDDO
	377	ENDDO
	378
	379	CASE ( 'pt' )
	380
	381	DO i = nxl, nxr
	382	DO j = nys, nyn
[1382]	383
[1239]	384	DO k = nzb_u_inner(j,i)+1, nzt
	385
[1365]	386	tmp_tend = - ( hom(k,1,4,0) - ( ptnudge(k,nt) * dtp + &
	387	ptnudge(k,nt+1) * dtm ) ) / tmp_tnudge(k)
[1239]	388
[1365]	389	tend(k,j,i) = tend(k,j,i) + tmp_tend
[1239]	390
[1365]	391	sums_ls_l(k,4) = sums_ls_l(k,4) + tmp_tend * &
[1382]	392	weight_substep(intermediate_timestep_count)
[1239]	393	ENDDO
[1382]	394
	395	sums_ls_l(nzt+1,4) = sums_ls_l(nzt,4)
	396
[1239]	397	ENDDO
	398	ENDDO
	399
	400	CASE ( 'q' )
	401
	402	DO i = nxl, nxr
	403	DO j = nys, nyn
[1382]	404
[1239]	405	DO k = nzb_u_inner(j,i)+1, nzt
	406
[1365]	407	tmp_tend = - ( hom(k,1,41,0) - ( qnudge(k,nt) * dtp + &
	408	qnudge(k,nt+1) * dtm ) ) / tmp_tnudge(k)
[1239]	409
[1365]	410	tend(k,j,i) = tend(k,j,i) + tmp_tend
[1239]	411
[1365]	412	sums_ls_l(k,5) = sums_ls_l(k,5) + tmp_tend * &
[1382]	413	weight_substep(intermediate_timestep_count)
[1239]	414	ENDDO
[1382]	415
	416	sums_ls_l(nzt+1,5) = sums_ls_l(nzt,5)
	417
[1239]	418	ENDDO
	419	ENDDO
	420
	421	CASE DEFAULT
	422	message_string = 'unknown prognostic variable "' // prog_var // '"'
	423	CALL message( 'nudge', 'PA0367', 1, 2, 0, 6, 0 )
	424
	425	END SELECT
	426
	427	END SUBROUTINE nudge
	428
	429
	430	!------------------------------------------------------------------------------!
	431	! Call for grid point i,j
	432	!------------------------------------------------------------------------------!
	433
	434	SUBROUTINE nudge_ij( i, j, time, prog_var )
	435
[1320]	436	USE arrays_3d, &
[1365]	437	ONLY: pt, ptnudge, q, qnudge, tend, timenudge, tmp_tnudge, tnudge, &
	438	u, unudge, v, vnudge
[1239]	439
[1320]	440	USE control_parameters, &
[1365]	441	ONLY: dt_3d, intermediate_timestep_count, message_string
[1320]	442
	443	USE indices, &
	444	ONLY: nxl, nxr, nys, nyn, nzb, nzb_u_inner, nzt
	445
[1365]	446	USE kinds
[1320]	447
	448	USE statistics, &
[1382]	449	ONLY: hom, sums_ls_l, weight_substep
[1320]	450
[1239]	451	IMPLICIT NONE
	452
	453
[1320]	454	CHARACTER (LEN=*) :: prog_var !:
[1239]	455
[1365]	456	REAL(wp) :: tmp_tend !:
[1320]	457	REAL(wp) :: dtm !:
	458	REAL(wp) :: dtp !:
	459	REAL(wp) :: time !:
[1239]	460
[1320]	461	INTEGER(iwp) :: i !:
	462	INTEGER(iwp) :: j !:
	463	INTEGER(iwp) :: k !:
[1365]	464	INTEGER(iwp) :: nt !:
[1239]	465
[1320]	466
[1365]	467	nt = 1
	468	DO WHILE ( time > timenudge(nt) )
	469	nt = nt+1
[1239]	470	ENDDO
[1249]	471	IF ( time /= timenudge(1) ) THEN
[1365]	472	nt = nt-1
[1239]	473	ENDIF
	474
[1365]	475	dtm = ( time - timenudge(nt) ) / ( timenudge(nt+1) - timenudge(nt) )
	476	dtp = ( timenudge(nt+1) - time ) / ( timenudge(nt+1) - timenudge(nt) )
[1239]	477
	478	SELECT CASE ( prog_var )
	479
	480	CASE ( 'u' )
	481
	482	DO k = nzb_u_inner(j,i)+1, nzt
	483
[1365]	484	tmp_tend = - ( hom(k,1,1,0) - ( unudge(k,nt) * dtp + &
	485	unudge(k,nt+1) * dtm ) ) / tmp_tnudge(k)
[1239]	486
[1365]	487	tend(k,j,i) = tend(k,j,i) + tmp_tend
	488
	489	sums_ls_l(k,6) = sums_ls_l(k,6) + tmp_tend &
[1382]	490	* weight_substep(intermediate_timestep_count)
[1239]	491	ENDDO
	492
[1382]	493	sums_ls_l(nzt+1,6) = sums_ls_l(nzt,6)
	494
[1239]	495	CASE ( 'v' )
	496
	497	DO k = nzb_u_inner(j,i)+1, nzt
	498
[1365]	499	tmp_tend = - ( hom(k,1,2,0) - ( vnudge(k,nt) * dtp + &
	500	vnudge(k,nt+1) * dtm ) ) / tmp_tnudge(k)
[1239]	501
[1365]	502	tend(k,j,i) = tend(k,j,i) + tmp_tend
	503
	504	sums_ls_l(k,7) = sums_ls_l(k,7) + tmp_tend &
[1382]	505	* weight_substep(intermediate_timestep_count)
[1239]	506	ENDDO
	507
[1382]	508	sums_ls_l(nzt+1,7) = sums_ls_l(nzt,7)
[1239]	509
	510	CASE ( 'pt' )
	511
	512	DO k = nzb_u_inner(j,i)+1, nzt
	513
[1365]	514	tmp_tend = - ( hom(k,1,4,0) - ( ptnudge(k,nt) * dtp + &
	515	ptnudge(k,nt+1) * dtm ) ) / tmp_tnudge(k)
[1239]	516
[1365]	517	tend(k,j,i) = tend(k,j,i) + tmp_tend
	518
	519	sums_ls_l(k,4) = sums_ls_l(k,4) + tmp_tend &
[1382]	520	* weight_substep(intermediate_timestep_count)
[1239]	521	ENDDO
	522
[1382]	523	sums_ls_l(nzt+1,4) = sums_ls_l(nzt,4)
[1239]	524
[1382]	525
[1239]	526	CASE ( 'q' )
	527
	528	DO k = nzb_u_inner(j,i)+1, nzt
	529
[1365]	530	tmp_tend = - ( hom(k,1,41,0) - ( qnudge(k,nt) * dtp + &
	531	qnudge(k,nt+1) * dtm ) ) / tmp_tnudge(k)
[1239]	532
[1365]	533	tend(k,j,i) = tend(k,j,i) + tmp_tend
	534
	535	sums_ls_l(k,5) = sums_ls_l(k,5) + tmp_tend &
[1382]	536	* weight_substep(intermediate_timestep_count)
[1239]	537	ENDDO
	538
[1382]	539	sums_ls_l(nzt+1,5) = sums_ls_l(nzt,5)
	540
[1239]	541	CASE DEFAULT
	542	message_string = 'unknown prognostic variable "' // prog_var // '"'
	543	CALL message( 'nudge', 'PA0367', 1, 2, 0, 6, 0 )
	544
	545	END SELECT
	546
	547
	548	END SUBROUTINE nudge_ij
	549
[1380]	550
	551	SUBROUTINE nudge_ref ( time )
	552
	553	USE arrays_3d, &
	554	ONLY: time_vert, ptnudge, pt_init, qnudge, q_init
	555
	556	USE kinds
	557
	558
	559	IMPLICIT NONE
	560
	561	INTEGER(iwp) :: nt !:
	562
	563	REAL(wp) :: fac !:
	564	REAL(wp), INTENT(in) :: time !:
	565
	566	!
	567	!-- Interpolation in time of NUDGING_DATA for pt_init and q_init. This is
	568	!-- needed for correct upper boundary conditions for pt and q and in case that
	569	! large scale subsidence as well as scalar Rayleigh-damping are used
	570	nt = 1
	571	DO WHILE ( time > time_vert(nt) )
	572	nt = nt + 1
	573	ENDDO
	574	IF ( time /= time_vert(nt) ) THEN
	575	nt = nt - 1
	576	ENDIF
	577
	578	fac = ( time-time_vert(nt) ) / ( time_vert(nt+1)-time_vert(nt) )
	579
	580	pt_init = ptnudge(:,nt) + fac * ( ptnudge(:,nt+1) - ptnudge(:,nt) )
	581	q_init = qnudge(:,nt) + fac * ( qnudge(:,nt+1) - qnudge(:,nt) )
	582
	583	END SUBROUTINE nudge_ref
	584
	585
[1239]	586	END MODULE nudge_mod

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |