Home

Context Navigation

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

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

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |