Home

Context Navigation

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

Last change on this file since 1251 was 1251, checked in by heinze, 10 years ago
bugfix: calculate dtm and dtp also in vector version
Property svn:keywords set to `Id`
File size: 12.0 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	!
	17	! Copyright 1997-2012 Leibniz University Hannover
	18	!--------------------------------------------------------------------------------!
	19	!
	20	! Current revisions:
	21	! ------------------
[1251]	22	! bugfix: calculate dtm and dtp also in vector version
[1239]	23	!
	24	! Former revisions:
	25	! -----------------
	26	! $Id: nudging.f90 1251 2013-11-07 08:14:30Z heinze $
	27	!
[1250]	28	! 1249 2013-11-06 10:45:47Z heinze
	29	! remove call of user module
	30	! reformatting
	31	!
[1242]	32	! 1241 2013-10-30 11:36:58Z heinze
	33	! Initial revision
[1239]	34	!
	35	! Description:
	36	! ------------
	37	! Nudges u, v, pt and q to given profiles on a relaxation timescale tnudge.
	38	! Profiles are read in from NUDGIN_DATA. Code is based on Neggers et al. (2012)
	39	! and also part of DALES and UCLA-LES.
	40	!--------------------------------------------------------------------------------!
	41
	42	PRIVATE
	43	PUBLIC init_nudge, nudge
	44	SAVE
	45
	46	INTERFACE nudge
	47	MODULE PROCEDURE nudge
	48	MODULE PROCEDURE nudge_ij
	49	END INTERFACE nudge
	50
	51	CONTAINS
	52
	53	SUBROUTINE init_nudge
	54
	55	USE arrays_3d
	56	USE control_parameters
	57	USE cpulog
	58	USE indices
	59	USE interfaces
	60	USE pegrid
	61
	62	IMPLICIT NONE
	63
	64	INTEGER :: finput = 90, ierrn, k, t
	65
	66	CHARACTER(1) :: hash
	67	REAL :: highheight, highqnudge, highptnudge, highunudge, highvnudge, &
	68	highwnudge, hightnudge
	69	REAL :: lowheight, lowqnudge, lowptnudge, lowunudge, lowvnudge, &
	70	lowwnudge, lowtnudge
	71	REAL :: fac
	72
	73	ALLOCATE( ptnudge(nzb:nzt+1,1:ntnudge), qnudge(nzb:nzt+1,1:ntnudge), &
	74	tnudge(nzb:nzt+1,1:ntnudge), unudge(nzb:nzt+1,1:ntnudge), &
	75	vnudge(nzb:nzt+1,1:ntnudge), wnudge(nzb:nzt+1,1:ntnudge) )
	76
	77	ALLOCATE( timenudge(0:ntnudge) )
	78
	79
	80	ptnudge = 0.0; qnudge = 0.0; tnudge = 0.0; unudge = 0.0
	81	vnudge = 0.0; wnudge = 0.0; timenudge = 0.0
	82
	83	t = 0
[1249]	84	OPEN ( finput, FILE='NUDGING_DATA', STATUS='OLD', &
	85	FORM='FORMATTED', IOSTAT=ierrn )
[1239]	86
[1249]	87	IF ( ierrn /= 0 ) THEN
[1239]	88	message_string = 'file NUDGING_DATA does not exist'
	89	CALL message( 'nudging', 'PA0365', 1, 2, 0, 6, 0 )
	90	ENDIF
	91
	92	ierrn = 0
	93
	94	rloop:DO
	95	t = t + 1
	96	hash = "#"
	97	ierrn = 1 ! not zero
	98	!
	99	!-- Search for the next line consisting of "# time",
	100	!-- from there onwards the profiles will be read
	101	DO WHILE ( .NOT. ( hash == "#" .AND. ierrn == 0 ) )
	102
[1249]	103	READ ( finput, *, IOSTAT=ierrn ) hash, timenudge(t)
	104	IF ( ierrn < 0 ) EXIT rloop
[1239]	105
	106	ENDDO
	107
	108	ierrn = 0
[1249]	109	READ ( finput, *, IOSTAT=ierrn ) lowheight, lowtnudge, lowunudge, &
	110	lowvnudge, lowwnudge , lowptnudge, &
	111	lowqnudge
[1239]	112
[1249]	113	IF ( ierrn /= 0 ) THEN
[1239]	114	message_string = 'errors in file NUDGING_DATA'
	115	CALL message( 'nudging', 'PA0366', 1, 2, 0, 6, 0 )
	116	ENDIF
	117
	118	ierrn = 0
[1249]	119	READ ( finput, *, IOSTAT=ierrn ) highheight, hightnudge, highunudge, &
	120	highvnudge, highwnudge , highptnudge, &
	121	highqnudge
[1239]	122
[1249]	123	IF ( ierrn /= 0 ) THEN
[1239]	124	message_string = 'errors in file NUDGING_DATA'
	125	CALL message( 'nudging', 'PA0366', 1, 2, 0, 6, 0 )
	126	ENDIF
	127
	128	DO k = nzb, nzt+1
[1249]	129	IF ( highheight < zu(k) ) THEN
[1239]	130	lowheight = highheight
	131	lowtnudge = hightnudge
	132	lowunudge = highunudge
	133	lowvnudge = highvnudge
	134	lowwnudge = highwnudge
	135	lowptnudge = highptnudge
	136	lowqnudge = highqnudge
	137
	138	ierrn = 0
[1249]	139	READ ( finput, *, IOSTAT=ierrn ) highheight , hightnudge , &
	140	highunudge , highvnudge , &
	141	highwnudge , highptnudge, &
	142	highqnudge
	143	IF (ierrn /= 0 ) THEN
[1239]	144	message_string = 'errors in file NUDGING_DATA'
	145	CALL message( 'nudging', 'PA0366', 1, 2, 0, 6, 0 )
	146	ENDIF
	147	ENDIF
	148
	149	!
	150	!-- Interpolation of prescribed profiles in space
	151
[1249]	152	fac = ( highheight - zu(k) ) / ( highheight - lowheight )
[1239]	153
[1249]	154	tnudge(k,t) = fac * lowtnudge + ( 1 - fac ) * hightnudge
	155	unudge(k,t) = fac * lowunudge + ( 1 - fac ) * highunudge
	156	vnudge(k,t) = fac * lowvnudge + ( 1 - fac ) * highvnudge
	157	wnudge(k,t) = fac * lowwnudge + ( 1 - fac ) * highwnudge
	158	ptnudge(k,t) = fac * lowptnudge + ( 1 - fac ) * highptnudge
	159	qnudge(k,t) = fac * lowqnudge + ( 1 - fac ) * highqnudge
[1239]	160	ENDDO
	161
	162	ENDDO rloop
	163
[1249]	164	CLOSE ( finput )
[1239]	165
	166	!
	167	!-- Prevent nudging if nudging profiles exhibt too small values
[1241]	168	!-- not used so far
[1239]	169	lptnudge = ANY( ABS( ptnudge ) > 1e-8 )
	170	lqnudge = ANY( ABS( qnudge ) > 1e-8 )
	171	lunudge = ANY( ABS( unudge ) > 1e-8 )
	172	lvnudge = ANY( ABS( vnudge ) > 1e-8 )
	173	lwnudge = ANY( ABS( wnudge ) > 1e-8 )
	174
	175	END SUBROUTINE init_nudge
	176
	177	!------------------------------------------------------------------------------!
	178	! Call for all grid points
	179	!------------------------------------------------------------------------------!
	180	SUBROUTINE nudge ( time, prog_var )
	181
	182	USE arrays_3d
	183	USE buoyancy_mod
	184	USE control_parameters
	185	USE cpulog
	186	USE indices
	187	USE interfaces
	188	USE pegrid
	189	USE statistics
	190
	191	IMPLICIT NONE
	192
	193	CHARACTER (LEN=*) :: prog_var
	194
	195	REAL :: currtnudge, dtm, dtp, time
	196
	197	INTEGER :: i, j, k, t
	198
	199
[1251]	200	t = 1
	201	DO WHILE ( time > timenudge(t) )
	202	t = t+1
	203	ENDDO
	204	IF ( time /= timenudge(1) ) THEN
	205	t = t-1
	206	ENDIF
	207
	208	dtm = ( time - timenudge(t) ) / ( timenudge(t+1) - timenudge(t) )
	209	dtp = ( timenudge(t+1) - time ) / ( timenudge(t+1) - timenudge(t) )
	210
[1239]	211	SELECT CASE ( prog_var )
	212
	213	CASE ( 'u' )
	214
	215	CALL calc_mean_profile( u, 1, 'nudging' )
	216
	217	DO i = nxl, nxr
	218	DO j = nys, nyn
	219	DO k = nzb_u_inner(j,i)+1, nzt
	220
	221	currtnudge = MAX( dt_3d, tnudge(k,t) * dtp + &
	222	tnudge(k,t+1) * dtm )
	223
	224
	225	tend(k,j,i) = tend(k,j,i) - ( hom(k,1,1,0) - &
	226	( unudge(k,t) * dtp + &
	227	unudge(k,t+1) * dtm ) ) / currtnudge
	228	ENDDO
	229	ENDDO
	230	ENDDO
	231
	232	CASE ( 'v' )
	233
	234	CALL calc_mean_profile( v, 2, 'nudging' )
	235
	236	DO i = nxl, nxr
	237	DO j = nys, nyn
	238	DO k = nzb_u_inner(j,i)+1, nzt
	239
	240	currtnudge = MAX( dt_3d, tnudge(k,t) * dtp + &
	241	tnudge(k,t+1) * dtm )
	242
	243
	244	tend(k,j,i) = tend(k,j,i) - ( hom(k,1,2,0) - &
	245	( vnudge(k,t) * dtp + &
	246	vnudge(k,t+1) * dtm ) ) / currtnudge
	247	ENDDO
	248	ENDDO
	249	ENDDO
	250
	251	CASE ( 'pt' )
	252
	253	CALL calc_mean_profile( v, 4, 'nudging' )
	254
	255	DO i = nxl, nxr
	256	DO j = nys, nyn
	257	DO k = nzb_u_inner(j,i)+1, nzt
	258
	259	currtnudge = MAX( dt_3d, tnudge(k,t) * dtp + &
	260	tnudge(k,t+1) * dtm )
	261
	262
	263	tend(k,j,i) = tend(k,j,i) - ( hom(k,1,4,0) - &
	264	( ptnudge(k,t) * dtp + &
	265	ptnudge(k,t+1) * dtm ) ) / currtnudge
	266	ENDDO
	267	ENDDO
	268	ENDDO
	269
	270	CASE ( 'q' )
	271
	272	CALL calc_mean_profile( v, 41, 'nudging' )
	273
	274	DO i = nxl, nxr
	275	DO j = nys, nyn
	276	DO k = nzb_u_inner(j,i)+1, nzt
	277
	278	currtnudge = MAX( dt_3d, tnudge(k,t) * dtp + &
	279	tnudge(k,t+1) * dtm )
	280
	281
	282	tend(k,j,i) = tend(k,j,i) - ( hom(k,1,41,0) - &
	283	( qnudge(k,t) * dtp + &
	284	qnudge(k,t+1) * dtm ) ) / currtnudge
	285	ENDDO
	286	ENDDO
	287	ENDDO
	288
	289	CASE DEFAULT
	290	message_string = 'unknown prognostic variable "' // prog_var // '"'
	291	CALL message( 'nudge', 'PA0367', 1, 2, 0, 6, 0 )
	292
	293	END SELECT
	294
	295	END SUBROUTINE nudge
	296
	297
	298	!------------------------------------------------------------------------------!
	299	! Call for grid point i,j
	300	!------------------------------------------------------------------------------!
	301
	302	SUBROUTINE nudge_ij( i, j, time, prog_var )
	303
	304	USE arrays_3d
	305	USE buoyancy_mod
	306	USE control_parameters
	307	USE cpulog
	308	USE indices
	309	USE interfaces
	310	USE pegrid
	311	USE statistics
	312
	313	IMPLICIT NONE
	314
	315	CHARACTER (LEN=*) :: prog_var
	316
	317	REAL :: currtnudge, dtm, dtp, time
	318
	319	INTEGER :: i, j, k, t
	320
	321
	322	t = 1
	323	DO WHILE ( time > timenudge(t) )
	324	t = t+1
	325	ENDDO
[1249]	326	IF ( time /= timenudge(1) ) THEN
[1239]	327	t = t-1
	328	ENDIF
	329
	330	dtm = ( time - timenudge(t) ) / ( timenudge(t+1) - timenudge(t) )
	331	dtp = ( timenudge(t+1) - time ) / ( timenudge(t+1) - timenudge(t) )
	332
	333	SELECT CASE ( prog_var )
	334
	335	CASE ( 'u' )
	336
	337	CALL calc_mean_profile( u, 1, 'nudging' )
	338
	339	DO k = nzb_u_inner(j,i)+1, nzt
	340
	341	currtnudge = MAX( dt_3d, tnudge(k,t) * dtp + tnudge(k,t+1) * dtm )
	342
	343	tend(k,j,i) = tend(k,j,i) - ( hom(k,1,1,0) - &
	344	( unudge(k,t) * dtp + &
	345	unudge(k,t+1) * dtm ) ) / currtnudge
	346	ENDDO
	347
	348	CASE ( 'v' )
	349
	350	CALL calc_mean_profile( v, 2, 'nudging' )
	351
	352	DO k = nzb_u_inner(j,i)+1, nzt
	353
	354	currtnudge = MAX( dt_3d, tnudge(k,t) * dtp + tnudge(k,t+1) * dtm )
	355
	356	tend(k,j,i) = tend(k,j,i) - ( hom(k,1,2,0) - &
	357	( vnudge(k,t) * dtp + &
	358	vnudge(k,t+1) * dtm ) ) / currtnudge
	359	ENDDO
	360
	361
	362	CASE ( 'pt' )
	363
	364	CALL calc_mean_profile( pt, 4, 'nudging' )
	365
	366	DO k = nzb_u_inner(j,i)+1, nzt
	367
	368	currtnudge = MAX( dt_3d, tnudge(k,t) * dtp + tnudge(k,t+1) * dtm )
	369
	370	tend(k,j,i) = tend(k,j,i) - ( hom(k,1,4,0) - &
	371	( ptnudge(k,t) * dtp + &
	372	ptnudge(k,t+1) * dtm ) ) / currtnudge
	373	ENDDO
	374
	375
	376	CASE ( 'q' )
	377
	378	CALL calc_mean_profile( q, 41, 'nudging' )
	379
	380	DO k = nzb_u_inner(j,i)+1, nzt
	381
	382	currtnudge = MAX( dt_3d, tnudge(k,t) * dtp + tnudge(k,t+1) * dtm )
	383
	384	tend(k,j,i) = tend(k,j,i) - ( hom(k,1,41,0) - &
	385	( qnudge(k,t) * dtp + &
	386	qnudge(k,t+1) * dtm ) ) / currtnudge
	387	ENDDO
	388
	389	CASE DEFAULT
	390	message_string = 'unknown prognostic variable "' // prog_var // '"'
	391	CALL message( 'nudge', 'PA0367', 1, 2, 0, 6, 0 )
	392
	393	END SELECT
	394
	395
	396	END SUBROUTINE nudge_ij
	397
	398	END MODULE nudge_mod

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |