Home

Context Navigation

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

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

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |