source: palm/trunk/SOURCE/nudging_mod.f90 @ 2053

Last change on this file since 2053 was 2001, checked in by knoop, 8 years ago

last commit documented

  • Property svn:keywords set to Id
File size: 20.0 KB
RevLine 
[1850]1!> @file nudging_mod.f90
[2000]2!------------------------------------------------------------------------------!
[1239]3! This file is part of PALM.
4!
[2000]5! PALM is free software: you can redistribute it and/or modify it under the
6! terms of the GNU General Public License as published by the Free Software
7! Foundation, either version 3 of the License, or (at your option) any later
8! version.
[1239]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!
[1818]17! Copyright 1997-2016 Leibniz Universitaet Hannover
[2000]18!------------------------------------------------------------------------------!
[1239]19!
20! Current revisions:
21! ------------------
[1383]22!
[2001]23!
[1383]24! Former revisions:
25! -----------------
26! $Id: nudging_mod.f90 2001 2016-08-20 18:41:22Z gronemeier $
27!
[2001]28! 2000 2016-08-20 18:09:15Z knoop
29! Forced header and separation lines into 80 columns
30!
[1851]31! 1850 2016-04-08 13:29:27Z maronga
32! Module renamed
33!
34!
[1758]35! 1757 2016-02-22 15:49:32Z maronga
36! Bugfix: allow for using higher vertical resolution in nudging file than grid
37! spacing in the LES model
38!
[1683]39! 1682 2015-10-07 23:56:08Z knoop
40! Code annotations made doxygen readable
41!
[1399]42! 1398 2014-05-07 11:15:00Z heinze
43! Subroutine nudge_ref is extended to set u_init and v_init to the current
44! nudging profiles
45!
[1383]46! 1382 2014-04-30 12:15:41Z boeske
[1382]47! Changed the weighting factor that is used in the summation of nudging
48! tendencies for profile data output from weight_pres to weight_substep,
49! added Neumann boundary conditions for profile data output of nudging terms at
50! nzt+1
[1366]51!
[1381]52! 1380 2014-04-28 12:40:45Z heinze
53! Subroutine nudge_ref added to account for proper upper scalar boundary
54! conditions in case of nudging
55!
[1366]56! 1365 2014-04-22 15:03:56Z boeske
[1365]57! Variable t renamed nt, variable currtnudge renamed tmp_tnudge,
58! summation of nudging tendencies for data output added
59! +sums_ls_l, tmp_tend
60! Added new subroutine calc_tnudge, which calculates the current nudging time
61! scale at each time step
[1354]62!
[1356]63! 1355 2014-04-10 10:21:29Z heinze
64! Error message specified.
65!
[1354]66! 1353 2014-04-08 15:21:23Z heinze
67! REAL constants provided with KIND-attribute
68!
[1321]69! 1320 2014-03-20 08:40:49Z raasch
[1320]70! ONLY-attribute added to USE-statements,
71! kind-parameters added to all INTEGER and REAL declaration statements,
72! kinds are defined in new module kinds,
73! old module precision_kind is removed,
74! revision history before 2012 removed,
75! comment fields (!:) to be used for variable explanations added to
76! all variable declaration statements
[1239]77!
[1319]78! 1318 2014-03-17 13:35:16Z raasch
79! module interfaces removed
80!
[1269]81! 1268 2013-12-12 09:47:53Z heinze
82! bugfix: argument of calc_mean_profile corrected
83!
[1252]84! 1251 2013-11-07 08:14:30Z heinze
85! bugfix: calculate dtm and dtp also in vector version
86!
[1250]87! 1249 2013-11-06 10:45:47Z heinze
88! remove call of user module
89! reformatting
90!
[1242]91! 1241 2013-10-30 11:36:58Z heinze
92! Initial revision
[1239]93!
94! Description:
95! ------------
[1682]96!> Nudges u, v, pt and q to given profiles on a relaxation timescale tnudge.
97!> Profiles are read in from NUDGIN_DATA. Code is based on Neggers et al. (2012)
98!> and also part of DALES and UCLA-LES.
[1239]99!--------------------------------------------------------------------------------!
[1682]100 MODULE nudge_mod
101 
[1239]102
103    PRIVATE
[1380]104    PUBLIC init_nudge, calc_tnudge, nudge, nudge_ref
[1239]105    SAVE
106
107    INTERFACE nudge
108       MODULE PROCEDURE nudge
109       MODULE PROCEDURE nudge_ij
110    END INTERFACE nudge
111
112 CONTAINS
113
[1682]114!------------------------------------------------------------------------------!
115! Description:
116! ------------
117!> @todo Missing subroutine description.
118!------------------------------------------------------------------------------!
[1239]119    SUBROUTINE init_nudge
120
[1320]121       USE arrays_3d,                                                          &
[1365]122           ONLY:  ptnudge, qnudge, timenudge, tmp_tnudge, tnudge, unudge,      &
123                  vnudge, wnudge, zu
[1239]124
[1320]125       USE control_parameters,                                                 &
126           ONLY:  dt_3d, lptnudge, lqnudge, lunudge, lvnudge, lwnudge,         &
127                   message_string, ntnudge
128
129       USE indices,                                                            &
130           ONLY:  nzb, nzt
131
132       USE kinds
133
[1239]134       IMPLICIT NONE
135
136
[1682]137       INTEGER(iwp) ::  finput = 90  !<
138       INTEGER(iwp) ::  ierrn        !<
139       INTEGER(iwp) ::  k            !<
140       INTEGER(iwp) ::  nt            !<
[1239]141
[1682]142       CHARACTER(1) ::  hash     !<
[1320]143
[1682]144       REAL(wp) ::  highheight   !<
145       REAL(wp) ::  highqnudge   !<
146       REAL(wp) ::  highptnudge  !<
147       REAL(wp) ::  highunudge   !<
148       REAL(wp) ::  highvnudge   !<
149       REAL(wp) ::  highwnudge   !<
150       REAL(wp) ::  hightnudge   !<
[1320]151
[1682]152       REAL(wp) ::  lowheight    !<
153       REAL(wp) ::  lowqnudge    !<
154       REAL(wp) ::  lowptnudge   !<
155       REAL(wp) ::  lowunudge    !<
156       REAL(wp) ::  lowvnudge    !<
157       REAL(wp) ::  lowwnudge    !<
158       REAL(wp) ::  lowtnudge    !<
[1320]159
[1682]160       REAL(wp) ::  fac          !<
[1320]161
[1239]162       ALLOCATE( ptnudge(nzb:nzt+1,1:ntnudge), qnudge(nzb:nzt+1,1:ntnudge), &
163                 tnudge(nzb:nzt+1,1:ntnudge), unudge(nzb:nzt+1,1:ntnudge),  &
164                 vnudge(nzb:nzt+1,1:ntnudge), wnudge(nzb:nzt+1,1:ntnudge)  )
165
[1365]166       ALLOCATE( tmp_tnudge(nzb:nzt) )
167
[1239]168       ALLOCATE( timenudge(0:ntnudge) )
169
[1353]170       ptnudge = 0.0_wp; qnudge = 0.0_wp; tnudge = 0.0_wp; unudge = 0.0_wp
171       vnudge = 0.0_wp; wnudge = 0.0_wp; timenudge = 0.0_wp
[1365]172!
173!--    Initialize array tmp_nudge with a current nudging time scale of 6 hours
174       tmp_tnudge = 21600.0_wp
[1239]175
[1365]176       nt = 0
[1249]177       OPEN ( finput, FILE='NUDGING_DATA', STATUS='OLD', &
178              FORM='FORMATTED', IOSTAT=ierrn )
[1239]179
[1249]180       IF ( ierrn /= 0 )  THEN
[1239]181          message_string = 'file NUDGING_DATA does not exist'
182          CALL message( 'nudging', 'PA0365', 1, 2, 0, 6, 0 )
183       ENDIF
184
185       ierrn = 0
186
187 rloop:DO
[1365]188          nt = nt + 1
[1239]189          hash = "#"
[1320]190          ierrn = 1 ! not zero
[1239]191!
192!--       Search for the next line consisting of "# time",
193!--       from there onwards the profiles will be read
194          DO WHILE ( .NOT. ( hash == "#" .AND. ierrn == 0 ) ) 
195         
[1365]196            READ ( finput, *, IOSTAT=ierrn ) hash, timenudge(nt)
[1249]197            IF ( ierrn < 0 )  EXIT rloop
[1239]198
199          ENDDO
200
201          ierrn = 0
[1249]202          READ ( finput, *, IOSTAT=ierrn ) lowheight, lowtnudge, lowunudge,   &
203                                           lowvnudge, lowwnudge , lowptnudge, &
204                                           lowqnudge
[1239]205
[1249]206          IF ( ierrn /= 0 )  THEN
[1239]207             message_string = 'errors in file NUDGING_DATA'
208             CALL message( 'nudging', 'PA0366', 1, 2, 0, 6, 0 )
209          ENDIF
210
211          ierrn = 0
[1249]212          READ ( finput, *, IOSTAT=ierrn ) highheight, hightnudge, highunudge,   &
213                                           highvnudge, highwnudge , highptnudge, &
214                                           highqnudge
[1239]215
[1249]216          IF ( ierrn /= 0 )  THEN
[1239]217             message_string = 'errors in file NUDGING_DATA'
218             CALL message( 'nudging', 'PA0366', 1, 2, 0, 6, 0 )
219          ENDIF
220
221          DO  k = nzb, nzt+1
[1757]222             DO WHILE ( highheight < zu(k) )
[1239]223                lowheight  = highheight
224                lowtnudge  = hightnudge
225                lowunudge  = highunudge
226                lowvnudge  = highvnudge
227                lowwnudge  = highwnudge
228                lowptnudge = highptnudge
229                lowqnudge  = highqnudge
230 
231                ierrn = 0
[1249]232                READ ( finput, *, IOSTAT=ierrn )  highheight , hightnudge , &
233                                                  highunudge , highvnudge , &
234                                                  highwnudge , highptnudge, &
235                                                  highqnudge
236                IF (ierrn /= 0 )  THEN
[1355]237                   WRITE( message_string, * ) 'zu(nzt+1) = ', zu(nzt+1), 'm is ',&
238                        'higher than the maximum height in NUDING_DATA which ',  &
239                        'is ', lowheight, 'm. Interpolation on PALM ',           &
240                        'grid is not possible.'
241                   CALL message( 'nudging', 'PA0364', 1, 2, 0, 6, 0 )
[1239]242                ENDIF
[1757]243             ENDDO
[1239]244
245!
246!--          Interpolation of prescribed profiles in space
247
[1249]248             fac = ( highheight - zu(k) ) / ( highheight - lowheight )
[1239]249
[1365]250             tnudge(k,nt)  = fac * lowtnudge  + ( 1.0_wp - fac ) * hightnudge
251             unudge(k,nt)  = fac * lowunudge  + ( 1.0_wp - fac ) * highunudge
252             vnudge(k,nt)  = fac * lowvnudge  + ( 1.0_wp - fac ) * highvnudge
253             wnudge(k,nt)  = fac * lowwnudge  + ( 1.0_wp - fac ) * highwnudge
254             ptnudge(k,nt) = fac * lowptnudge + ( 1.0_wp - fac ) * highptnudge
255             qnudge(k,nt)  = fac * lowqnudge  + ( 1.0_wp - fac ) * highqnudge
[1239]256          ENDDO
257
258       ENDDO rloop
259
[1249]260       CLOSE ( finput )
[1239]261
262!
263!--    Prevent nudging if nudging profiles exhibt too small values
[1241]264!--    not used so far
[1353]265       lptnudge  = ANY( ABS( ptnudge ) > 1.0e-8_wp )
266       lqnudge   = ANY( ABS( qnudge )  > 1.0e-8_wp )
267       lunudge   = ANY( ABS( unudge )  > 1.0e-8_wp )
268       lvnudge   = ANY( ABS( vnudge )  > 1.0e-8_wp )
269       lwnudge   = ANY( ABS( wnudge )  > 1.0e-8_wp )
[1239]270
271    END SUBROUTINE init_nudge
272
[1365]273
[1682]274!------------------------------------------------------------------------------!
275! Description:
276! ------------
277!> @todo Missing subroutine description.
278!------------------------------------------------------------------------------!
[1365]279    SUBROUTINE calc_tnudge ( time )
280
281       USE arrays_3d,                                                          &
282           ONLY:  timenudge, tmp_tnudge, tnudge
283
284       USE control_parameters,                                                 &
285           ONLY:  dt_3d 
286
287       USE indices,                                                            &
288           ONLY:  nzb, nzt
289
290       USE kinds
291
292       IMPLICIT NONE
293
294
[1682]295       REAL(wp) ::  dtm         !<
296       REAL(wp) ::  dtp         !<
297       REAL(wp) ::  time        !<
[1365]298
[1682]299       INTEGER(iwp) ::  k   !<
300       INTEGER(iwp) ::  nt  !<
[1365]301
302       nt = 1
303       DO WHILE ( time > timenudge(nt) )
304         nt = nt+1
305       ENDDO
306       IF ( time /= timenudge(1) ) THEN
307         nt = nt-1
308       ENDIF
309
310       dtm = ( time - timenudge(nt) ) / ( timenudge(nt+1) - timenudge(nt) )
311       dtp = ( timenudge(nt+1) - time ) / ( timenudge(nt+1) - timenudge(nt) )
312
313       DO  k = nzb, nzt
314          tmp_tnudge(k) = MAX( dt_3d, tnudge(k,nt) * dtp + tnudge(k,nt+1) * dtm )
315       ENDDO
316
317    END SUBROUTINE calc_tnudge
318
[1239]319!------------------------------------------------------------------------------!
[1682]320! Description:
321! ------------
322!> Call for all grid points
[1239]323!------------------------------------------------------------------------------!
324    SUBROUTINE nudge ( time, prog_var )
325
[1320]326       USE arrays_3d,                                                          &
[1365]327           ONLY:  pt, ptnudge, q, qnudge, tend, timenudge, tmp_tnudge, tnudge, &
328                  u, unudge, v, vnudge
[1239]329
[1320]330       USE control_parameters,                                                 &
[1365]331           ONLY:  dt_3d, intermediate_timestep_count, message_string
[1320]332
333       USE indices,                                                            &
334           ONLY:  nxl, nxr, nys, nyn, nzb, nzb_u_inner, nzt
335
[1365]336       USE kinds
[1320]337
338       USE statistics,                                                         &
[1382]339           ONLY:  hom, sums_ls_l, weight_substep
[1320]340
[1239]341       IMPLICIT NONE
342
[1682]343       CHARACTER (LEN=*) ::  prog_var  !<
[1239]344
[1682]345       REAL(wp) ::  tmp_tend    !<
346       REAL(wp) ::  dtm         !<
347       REAL(wp) ::  dtp         !<
348       REAL(wp) ::  time        !<
[1239]349
[1682]350       INTEGER(iwp) ::  i  !<
351       INTEGER(iwp) ::  j  !<
352       INTEGER(iwp) ::  k  !<
353       INTEGER(iwp) ::  nt  !<
[1239]354
355
[1365]356       nt = 1
357       DO WHILE ( time > timenudge(nt) )
358         nt = nt+1
[1251]359       ENDDO
360       IF ( time /= timenudge(1) ) THEN
[1365]361         nt = nt-1
[1251]362       ENDIF
363
[1365]364       dtm = ( time - timenudge(nt) ) / ( timenudge(nt+1) - timenudge(nt) )
365       dtp = ( timenudge(nt+1) - time ) / ( timenudge(nt+1) - timenudge(nt) )
[1251]366
[1239]367       SELECT CASE ( prog_var )
368
369          CASE ( 'u' )
370
371             DO  i = nxl, nxr
372                DO  j = nys, nyn
[1382]373
[1239]374                   DO  k = nzb_u_inner(j,i)+1, nzt
375
[1365]376                      tmp_tend = - ( hom(k,1,1,0) - ( unudge(k,nt) * dtp +     &
377                                     unudge(k,nt+1) * dtm ) ) / tmp_tnudge(k)
[1239]378
[1365]379                      tend(k,j,i) = tend(k,j,i) + tmp_tend
[1239]380
[1365]381                      sums_ls_l(k,6) = sums_ls_l(k,6) + tmp_tend *             &
[1382]382                                     weight_substep(intermediate_timestep_count)
[1239]383                   ENDDO
[1382]384                 
385                   sums_ls_l(nzt+1,6) = sums_ls_l(nzt,6)
386 
[1239]387                ENDDO
388            ENDDO
389
390          CASE ( 'v' )
391
392             DO  i = nxl, nxr
393                DO  j = nys, nyn
[1382]394
[1239]395                   DO  k = nzb_u_inner(j,i)+1, nzt
396
[1365]397                      tmp_tend = - ( hom(k,1,2,0) - ( vnudge(k,nt) * dtp +     &
398                                     vnudge(k,nt+1) * dtm ) ) / tmp_tnudge(k)
[1239]399
[1365]400                      tend(k,j,i) = tend(k,j,i) + tmp_tend
[1239]401
[1365]402                      sums_ls_l(k,7) = sums_ls_l(k,7) + tmp_tend *             &
[1382]403                                     weight_substep(intermediate_timestep_count)
[1239]404                   ENDDO
[1382]405                 
406                   sums_ls_l(nzt+1,7) = sums_ls_l(nzt,7)
407
[1239]408                ENDDO
409            ENDDO
410
411          CASE ( 'pt' )
412
413             DO  i = nxl, nxr
414                DO  j = nys, nyn
[1382]415
[1239]416                   DO  k = nzb_u_inner(j,i)+1, nzt
417
[1365]418                      tmp_tend = - ( hom(k,1,4,0) - ( ptnudge(k,nt) * dtp +    &
419                                     ptnudge(k,nt+1) * dtm ) ) / tmp_tnudge(k)
[1239]420
[1365]421                      tend(k,j,i) = tend(k,j,i) + tmp_tend
[1239]422
[1365]423                      sums_ls_l(k,4) = sums_ls_l(k,4) + tmp_tend *             &
[1382]424                                     weight_substep(intermediate_timestep_count)
[1239]425                   ENDDO
[1382]426
427                   sums_ls_l(nzt+1,4) = sums_ls_l(nzt,4)
428
[1239]429                ENDDO
430            ENDDO
431
432          CASE ( 'q' )
433
434             DO  i = nxl, nxr
435                DO  j = nys, nyn
[1382]436
[1239]437                   DO  k = nzb_u_inner(j,i)+1, nzt
438
[1365]439                      tmp_tend = - ( hom(k,1,41,0) - ( qnudge(k,nt) * dtp +    &
440                                     qnudge(k,nt+1) * dtm ) ) / tmp_tnudge(k)
[1239]441
[1365]442                      tend(k,j,i) = tend(k,j,i) + tmp_tend
[1239]443
[1365]444                      sums_ls_l(k,5) = sums_ls_l(k,5) + tmp_tend *             &
[1382]445                                     weight_substep(intermediate_timestep_count)
[1239]446                   ENDDO
[1382]447                 
448                   sums_ls_l(nzt+1,5) = sums_ls_l(nzt,5)
449
[1239]450                ENDDO
451            ENDDO
452
453          CASE DEFAULT
454             message_string = 'unknown prognostic variable "' // prog_var // '"'
455             CALL message( 'nudge', 'PA0367', 1, 2, 0, 6, 0 )
456
457       END SELECT
458
459    END SUBROUTINE nudge
460
461
462!------------------------------------------------------------------------------!
[1682]463! Description:
464! ------------
465!> Call for grid point i,j
[1239]466!------------------------------------------------------------------------------!
467
468    SUBROUTINE nudge_ij( i, j, time, prog_var )
469
[1320]470       USE arrays_3d,                                                          &
[1365]471           ONLY:  pt, ptnudge, q, qnudge, tend, timenudge, tmp_tnudge, tnudge, &
472                  u, unudge, v, vnudge
[1239]473
[1320]474       USE control_parameters,                                                 &
[1365]475           ONLY:  dt_3d, intermediate_timestep_count, message_string
[1320]476
477       USE indices,                                                            &
478           ONLY:  nxl, nxr, nys, nyn, nzb, nzb_u_inner, nzt
479
[1365]480       USE kinds
[1320]481
482       USE statistics,                                                         &
[1382]483           ONLY:  hom, sums_ls_l, weight_substep
[1320]484
[1239]485       IMPLICIT NONE
486
487
[1682]488       CHARACTER (LEN=*) ::  prog_var  !<
[1239]489
[1682]490       REAL(wp) ::  tmp_tend    !<
491       REAL(wp) ::  dtm         !<
492       REAL(wp) ::  dtp         !<
493       REAL(wp) ::  time        !<
[1239]494
[1682]495       INTEGER(iwp) ::  i  !<
496       INTEGER(iwp) ::  j  !<
497       INTEGER(iwp) ::  k  !<
498       INTEGER(iwp) ::  nt  !<
[1239]499
[1320]500
[1365]501       nt = 1
502       DO WHILE ( time > timenudge(nt) )
503         nt = nt+1
[1239]504       ENDDO
[1249]505       IF ( time /= timenudge(1) )  THEN
[1365]506         nt = nt-1
[1239]507       ENDIF
508
[1365]509       dtm = ( time - timenudge(nt) ) / ( timenudge(nt+1) - timenudge(nt) )
510       dtp = ( timenudge(nt+1) - time ) / ( timenudge(nt+1) - timenudge(nt) )
[1239]511
512       SELECT CASE ( prog_var )
513
514          CASE ( 'u' )
515
516             DO  k = nzb_u_inner(j,i)+1, nzt
517
[1365]518                tmp_tend = - ( hom(k,1,1,0) - ( unudge(k,nt) * dtp +           &
519                               unudge(k,nt+1) * dtm ) ) / tmp_tnudge(k)
[1239]520
[1365]521                tend(k,j,i) = tend(k,j,i) + tmp_tend
522
523                sums_ls_l(k,6) = sums_ls_l(k,6) + tmp_tend                     &
[1382]524                                 * weight_substep(intermediate_timestep_count)
[1239]525             ENDDO
526
[1382]527             sums_ls_l(nzt+1,6) = sums_ls_l(nzt,6)
528
[1239]529          CASE ( 'v' )
530
531             DO  k = nzb_u_inner(j,i)+1, nzt
532
[1365]533                tmp_tend = - ( hom(k,1,2,0) - ( vnudge(k,nt) * dtp +           &
534                               vnudge(k,nt+1) * dtm ) ) / tmp_tnudge(k)
[1239]535
[1365]536                tend(k,j,i) = tend(k,j,i) + tmp_tend
537
538                sums_ls_l(k,7) = sums_ls_l(k,7) + tmp_tend                     &
[1382]539                                 * weight_substep(intermediate_timestep_count)
[1239]540             ENDDO
541
[1382]542             sums_ls_l(nzt+1,7) = sums_ls_l(nzt,7)
[1239]543
544          CASE ( 'pt' )
545
546             DO  k = nzb_u_inner(j,i)+1, nzt
547
[1365]548                tmp_tend = - ( hom(k,1,4,0) - ( ptnudge(k,nt) * dtp +          &
549                               ptnudge(k,nt+1) * dtm ) ) / tmp_tnudge(k)
[1239]550
[1365]551                tend(k,j,i) = tend(k,j,i) + tmp_tend
552
553                sums_ls_l(k,4) = sums_ls_l(k,4) + tmp_tend                     &
[1382]554                                 * weight_substep(intermediate_timestep_count)
[1239]555             ENDDO
556
[1382]557             sums_ls_l(nzt+1,4) = sums_ls_l(nzt,4)
[1239]558
[1382]559
[1239]560          CASE ( 'q' )
561
562             DO  k = nzb_u_inner(j,i)+1, nzt
563
[1365]564                tmp_tend = - ( hom(k,1,41,0) - ( qnudge(k,nt) * dtp +          &
565                               qnudge(k,nt+1) * dtm ) ) / tmp_tnudge(k)
[1239]566
[1365]567                tend(k,j,i) = tend(k,j,i) + tmp_tend
568
569                sums_ls_l(k,5) = sums_ls_l(k,5) + tmp_tend                     &
[1382]570                                 * weight_substep(intermediate_timestep_count)
[1239]571             ENDDO
572
[1382]573             sums_ls_l(nzt+1,5) = sums_ls_l(nzt,5)
574
[1239]575          CASE DEFAULT
576             message_string = 'unknown prognostic variable "' // prog_var // '"'
577             CALL message( 'nudge', 'PA0367', 1, 2, 0, 6, 0 )
578
579       END SELECT
580
581
582    END SUBROUTINE nudge_ij
583
[1380]584
[1682]585!------------------------------------------------------------------------------!
586! Description:
587! ------------
588!> @todo Missing subroutine description.
589!------------------------------------------------------------------------------!
[1380]590    SUBROUTINE nudge_ref ( time )
591
592       USE arrays_3d,                                                          &
[1398]593           ONLY:  time_vert, ptnudge, pt_init, qnudge, q_init, unudge, u_init, &
594                  vnudge, v_init
[1380]595
596       USE kinds
597
598
599       IMPLICIT NONE
600
[1682]601       INTEGER(iwp) ::  nt                    !<
[1380]602
[1682]603       REAL(wp)             ::  fac           !<
604       REAL(wp), INTENT(in) ::  time          !<
[1380]605
606!
607!--    Interpolation in time of NUDGING_DATA for pt_init and q_init. This is
608!--    needed for correct upper boundary conditions for pt and q and in case that
609!      large scale subsidence as well as scalar Rayleigh-damping are used
610       nt = 1
611       DO WHILE ( time > time_vert(nt) )
612          nt = nt + 1
613       ENDDO
614       IF ( time /= time_vert(nt) )  THEN
615        nt = nt - 1
616       ENDIF
617
618       fac = ( time-time_vert(nt) ) / ( time_vert(nt+1)-time_vert(nt) )
619
620       pt_init = ptnudge(:,nt) + fac * ( ptnudge(:,nt+1) - ptnudge(:,nt) )
621       q_init  = qnudge(:,nt) + fac * ( qnudge(:,nt+1) - qnudge(:,nt) )
[1398]622       u_init  = unudge(:,nt) + fac * ( unudge(:,nt+1) - unudge(:,nt) )
623       v_init  = vnudge(:,nt) + fac * ( vnudge(:,nt+1) - vnudge(:,nt) )
[1380]624
625    END SUBROUTINE nudge_ref
626
[1239]627 END MODULE nudge_mod
Note: See TracBrowser for help on using the repository browser.