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

Last change on this file since 1319 was 1319, checked in by raasch, 8 years ago

last commit documented

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