Home

Context Navigation

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

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

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |