Home

Context Navigation

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

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

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |