Home

Context Navigation

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

Last change on this file since 1320 was 1320, checked in by raasch, 11 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

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	! 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
29	!
30	! Former revisions:
31	! -----------------
32	! $Id: nudging.f90 1320 2014-03-20 08:40:49Z raasch $
33	!
34	! 1318 2014-03-17 13:35:16Z raasch
35	! module interfaces removed
36	!
37	! 1268 2013-12-12 09:47:53Z heinze
38	! bugfix: argument of calc_mean_profile corrected
39	!
40	! 1251 2013-11-07 08:14:30Z heinze
41	! bugfix: calculate dtm and dtp also in vector version
42	!
43	! 1249 2013-11-06 10:45:47Z heinze
44	! remove call of user module
45	! reformatting
46	!
47	! 1241 2013-10-30 11:36:58Z heinze
48	! Initial revision
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
70	USE arrays_3d, &
71	ONLY: ptnudge, qnudge, timenudge, tnudge, unudge, vnudge, wnudge, &
72	zu
73
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
83	IMPLICIT NONE
84
85
86	INTEGER(iwp) :: finput = 90 !:
87	INTEGER(iwp) :: ierrn !:
88	INTEGER(iwp) :: k !:
89	INTEGER(iwp) :: t !:
90
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
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
122	OPEN ( finput, FILE='NUDGING_DATA', STATUS='OLD', &
123	FORM='FORMATTED', IOSTAT=ierrn )
124
125	IF ( ierrn /= 0 ) THEN
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 = "#"
135	ierrn = 1 ! not zero
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
141	READ ( finput, *, IOSTAT=ierrn ) hash, timenudge(t)
142	IF ( ierrn < 0 ) EXIT rloop
143
144	ENDDO
145
146	ierrn = 0
147	READ ( finput, *, IOSTAT=ierrn ) lowheight, lowtnudge, lowunudge, &
148	lowvnudge, lowwnudge , lowptnudge, &
149	lowqnudge
150
151	IF ( ierrn /= 0 ) THEN
152	message_string = 'errors in file NUDGING_DATA'
153	CALL message( 'nudging', 'PA0366', 1, 2, 0, 6, 0 )
154	ENDIF
155
156	ierrn = 0
157	READ ( finput, *, IOSTAT=ierrn ) highheight, hightnudge, highunudge, &
158	highvnudge, highwnudge , highptnudge, &
159	highqnudge
160
161	IF ( ierrn /= 0 ) THEN
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
167	IF ( highheight < zu(k) ) THEN
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
177	READ ( finput, *, IOSTAT=ierrn ) highheight , hightnudge , &
178	highunudge , highvnudge , &
179	highwnudge , highptnudge, &
180	highqnudge
181	IF (ierrn /= 0 ) THEN
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
190	fac = ( highheight - zu(k) ) / ( highheight - lowheight )
191
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
198	ENDDO
199
200	ENDDO rloop
201
202	CLOSE ( finput )
203
204	!
205	!-- Prevent nudging if nudging profiles exhibt too small values
206	!-- not used so far
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
220	USE arrays_3d, &
221	ONLY: pt, ptnudge, q, qnudge, tend, timenudge, tnudge, u, unudge, &
222	v, vnudge
223
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
239	IMPLICIT NONE
240
241	CHARACTER (LEN=*) :: prog_var !:
242
243	REAL(wp) :: currtnudge !:
244	REAL(wp) :: dtm !:
245	REAL(wp) :: dtp !:
246	REAL(wp) :: time !:
247
248	INTEGER(iwp) :: i !:
249	INTEGER(iwp) :: j !:
250	INTEGER(iwp) :: k !:
251	INTEGER(iwp) :: t !:
252
253
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
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
307	CALL calc_mean_profile( pt, 4, 'nudging' )
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
326	CALL calc_mean_profile( q, 41, 'nudging' )
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
358	USE arrays_3d, &
359	ONLY: pt, ptnudge, q, qnudge, tend, timenudge, tnudge, u, unudge, &
360	v, vnudge
361
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
377	IMPLICIT NONE
378
379
380	CHARACTER (LEN=*) :: prog_var !:
381
382	REAL(wp) :: currtnudge !:
383	REAL(wp) :: dtm !:
384	REAL(wp) :: dtp !:
385	REAL(wp) :: time !:
386
387	INTEGER(iwp) :: i !:
388	INTEGER(iwp) :: j !:
389	INTEGER(iwp) :: k !:
390	INTEGER(iwp) :: t !:
391
392
393	t = 1
394	DO WHILE ( time > timenudge(t) )
395	t = t+1
396	ENDDO
397	IF ( time /= timenudge(1) ) THEN
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 |