Home

Context Navigation

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

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

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |