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

Last change on this file since 1318 was 1318, checked in by raasch, 8 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.