Home

Context Navigation

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

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

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

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |