Home

Context Navigation

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

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

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |