Home

Context Navigation

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

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

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |