source: palm/trunk/SOURCE/synthetic_turbulence_generator_mod.f90 @ 4291

Last change on this file since 4291 was 4182, checked in by scharf, 5 years ago
  • corrected "Former revisions" section
  • minor formatting in "Former revisions" section
  • added "Author" section
  • Property svn:keywords set to Id
File size: 96.4 KB
Line 
1!> @synthetic_turbulence_generator_mod.f90
2!------------------------------------------------------------------------------!
3! This file is part of the PALM model system.
4!
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.
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 2017-2019 Leibniz Universitaet Hannover
18!------------------------------------------------------------------------------!
19!
20! Current revisions:
21! -----------------
22!
23!
24! Former revisions:
25! -----------------
26! $Id: synthetic_turbulence_generator_mod.f90 4182 2019-08-22 15:20:23Z moh.hefny $
27! Corrected "Former revisions" section
28!
29! 4148 2019-08-08 11:26:00Z suehring
30! Remove unused variable
31!
32! 4144 2019-08-06 09:11:47Z raasch
33! relational operators .EQ., .NE., etc. replaced by ==, /=, etc.
34!
35! 4071 2019-07-03 20:02:00Z suehring
36! Bugfix, initialize mean_inflow_profiles in case turbulence and inflow
37! information is not read from file.
38!
39! 4022 2019-06-12 11:52:39Z suehring
40! Several bugfixes and improvements
41! - revise bias correction of the imposed perturbations (correction via volume
42!   flow can create instabilities in case the mean volume flow is close to zero)
43! - introduce lower limits in calculation of coefficient matrix, else the
44!   calculation may become numerically unstable
45! - impose perturbations every timestep, even though no new set of perturbations
46!   is generated in case dt_stg_call /= dt_3d
47! - Implement a gradual decrease of Reynolds stress and length scales above
48!   ABL height (within 1 length scale above ABL depth to 1/10) rather than a
49!   discontinuous decrease
50! - Bugfix in non-nested case: use ABL height for parametrized turbulence
51!
52! 3987 2019-05-22 09:52:13Z kanani
53! Introduce alternative switch for debug output during timestepping
54!
55! 3938 2019-04-29 16:06:25Z suehring
56! Remove unused variables
57!
58! 3937 2019-04-29 15:09:07Z suehring
59! Minor bugfix in case of a very early restart where mc_factor is sill not
60! present.
61! Some modification and fixing of potential bugs in the calculation of scaling
62! parameters used for synthetic turbulence parametrization.
63!
64! 3909 2019-04-17 09:13:25Z suehring
65! Minor bugfix for last commit
66!
67! 3900 2019-04-16 15:17:43Z suehring
68! Missing re-calculation of perturbation seeds in case of restarts
69!
70! 3891 2019-04-12 17:52:01Z suehring
71! Bugfix in initialization in case of restart runs.
72!
73! 3885 2019-04-11 11:29:34Z kanani
74! Changes related to global restructuring of location messages and introduction
75! of additional debug messages
76!
77!
78! removed unused variables
79!
80! 3719 2019-02-06 13:10:18Z kanani
81! Removed log_point measurement from stg_init, since this part is counted to
82! log_point(2) 'initialisation' already. Moved other log_points to calls of
83! the subroutines in time_integration for better overview.
84!
85! 2259 2017-06-08 09:09:11Z gronemeier
86! Initial revision
87!
88! Authors:
89! --------
90! @author Tobias Gronemeier, Matthias Suehring, Atsushi Inagaki, Micha Gryschka, Christoph Knigge
91!
92!
93! Description:
94! ------------
95!> The module generates turbulence at the inflow boundary based on a method by
96!> Xie and Castro (2008) utilizing a Lund rotation (Lund, 1998) and a mass-flux
97!> correction by Kim et al. (2013).
98!> The turbulence is correlated based on length scales in y- and z-direction and
99!> a time scale for each velocity component. The profiles of length and time
100!> scales, mean u, v, w, e and pt, and all components of the Reynolds stress
101!> tensor can be either read from file STG_PROFILES, or will be parametrized
102!> within the boundary layer.
103!>
104!> @todo test restart
105!>       enable cyclic_fill
106!>       implement turbulence generation for e and pt
107!> @todo Input of height-constant length scales via namelist
108!> @note <Enter notes on the module>
109!> @bug  Height information from input file is not used. Profiles from input
110!>       must match with current PALM grid.
111!>       In case of restart, velocity seeds differ from precursor run if a11,
112!>       a22, or a33 are zero.
113!------------------------------------------------------------------------------!
114 MODULE synthetic_turbulence_generator_mod
115
116
117    USE arrays_3d,                                                             &
118        ONLY:  dzw,                                                            &
119               ddzw,                                                           &
120               drho_air,                                                       &
121               mean_inflow_profiles,                                           &
122               q,                                                              &
123               q_init,                                                         &
124               pt,                                                             &
125               pt_init,                                                        &
126               u,                                                              &
127               u_init,                                                         &
128               v,                                                              &
129               v_init,                                                         &
130               w,                                                              & 
131               zu,                                                             &
132               zw
133
134    USE basic_constants_and_equations_mod,                                     &
135        ONLY:  g,                                                              &
136               kappa,                                                          &
137               pi
138
139    USE control_parameters,                                                    &
140        ONLY:  bc_lr,                                                          &
141               bc_ns,                                                          &
142               child_domain,                                                   &
143               coupling_char,                                                  &
144               debug_output_timestep,                                          &
145               dt_3d,                                                          &
146               e_init,                                                         &
147               humidity,                                                       &
148               initializing_actions,                                           &
149               intermediate_timestep_count,                                    &
150               intermediate_timestep_count_max,                                &
151               length,                                                         &
152               message_string,                                                 &
153               nesting_offline,                                                &
154               neutral,                                                        &
155               num_mean_inflow_profiles,                                       &
156               rans_mode,                                                      &
157               restart_string,                                                 &
158               syn_turb_gen,                                                   &
159               time_since_reference_point,                                     &
160               turbulent_inflow
161               
162    USE grid_variables,                                                        &
163        ONLY:  ddx,                                                            &
164               ddy,                                                            & 
165               dx,                                                             &
166               dy
167
168    USE indices,                                                               &
169        ONLY:  nbgp,                                                           & 
170               nz,                                                             & 
171               nzb,                                                            &
172               nzt,                                                            &
173               nx,                                                             & 
174               nxl,                                                            & 
175               nxlu,                                                           &
176               nxlg,                                                           & 
177               nxr,                                                            & 
178               nxrg,                                                           &
179               ny,                                                             &
180               nys,                                                            &
181               nysv,                                                           &
182               nyn,                                                            &
183               nyng,                                                           &
184               nysg,                                                           &
185               wall_flags_0
186
187    USE kinds
188
189#if defined( __parallel )  &&  !defined( __mpifh )
190    USE MPI
191#endif
192
193    USE nesting_offl_mod,                                                      &
194        ONLY:  nesting_offl_calc_zi,                                           &
195               zi_ribulk
196
197    USE pegrid,                                                                &
198        ONLY:  comm1dx,                                                        &
199               comm1dy,                                                        &
200               comm2d,                                                         &
201               ierr,                                                           &
202               myidx,                                                          &
203               myidy,                                                          &
204               pdims
205       
206    USE pmc_interface,                                                         &
207        ONLY : rans_mode_parent
208
209    USE transpose_indices,                                                     &
210        ONLY: nzb_x,                                                           &
211              nzt_x
212
213
214    IMPLICIT NONE
215
216#if defined( __parallel )  &&  defined( __mpifh )
217    INCLUDE "mpif.h"
218#endif
219
220
221    LOGICAL ::  velocity_seed_initialized = .FALSE.     !< true after first call of stg_main
222    LOGICAL ::  parametrize_inflow_turbulence = .FALSE. !< flag indicating that inflow turbulence is either read from file (.FALSE.) or if it parametrized
223    LOGICAL ::  use_syn_turb_gen = .FALSE.              !< switch to use synthetic turbulence generator
224
225    INTEGER(iwp) ::  id_stg_left        !< left lateral boundary core id in case of turbulence generator
226    INTEGER(iwp) ::  id_stg_north       !< north lateral boundary core id in case of turbulence generator
227    INTEGER(iwp) ::  id_stg_right       !< right lateral boundary core id in case of turbulence generator
228    INTEGER(iwp) ::  id_stg_south       !< south lateral boundary core id in case of turbulence generator
229    INTEGER(iwp) ::  stg_type_xz        !< MPI type for full z range
230    INTEGER(iwp) ::  stg_type_xz_small  !< MPI type for small z range
231    INTEGER(iwp) ::  stg_type_yz        !< MPI type for full z range
232    INTEGER(iwp) ::  stg_type_yz_small  !< MPI type for small z range
233    INTEGER(iwp) ::  merg               !< maximum length scale (in gp)
234    INTEGER(iwp) ::  mergp              !< merg + nbgp
235    INTEGER(iwp) ::  nzb_x_stg          !< lower bound of z coordinate (required for transposing z on PEs along x)
236    INTEGER(iwp) ::  nzt_x_stg          !< upper bound of z coordinate (required for transposing z on PEs along x)
237    INTEGER(iwp) ::  nzb_y_stg          !< lower bound of z coordinate (required for transposing z on PEs along y)
238    INTEGER(iwp) ::  nzt_y_stg          !< upper bound of z coordinate (required for transposing z on PEs along y)
239
240    INTEGER(iwp), DIMENSION(3) ::  nr_non_topo_xz = 0 !< number of non-topography grid points at xz cross-sections,
241                                                      !< required for bias correction of imposed perturbations
242    INTEGER(iwp), DIMENSION(3) ::  nr_non_topo_yz = 0 !< number of non-topography grid points at yz cross-sections,
243                                                      !< required for bias correction of imposed perturbations
244   
245    INTEGER(iwp), DIMENSION(:), ALLOCATABLE ::  displs_xz      !< displacement for MPI_GATHERV
246    INTEGER(iwp), DIMENSION(:), ALLOCATABLE ::  recv_count_xz  !< receive count for MPI_GATHERV
247    INTEGER(iwp), DIMENSION(:), ALLOCATABLE ::  displs_yz      !< displacement for MPI_GATHERV
248    INTEGER(iwp), DIMENSION(:), ALLOCATABLE ::  recv_count_yz  !< receive count for MPI_GATHERV
249    INTEGER(iwp), DIMENSION(:), ALLOCATABLE ::  nux            !< length scale of u in x direction (in gp)
250    INTEGER(iwp), DIMENSION(:), ALLOCATABLE ::  nuy            !< length scale of u in y direction (in gp)
251    INTEGER(iwp), DIMENSION(:), ALLOCATABLE ::  nuz            !< length scale of u in z direction (in gp)
252    INTEGER(iwp), DIMENSION(:), ALLOCATABLE ::  nvx            !< length scale of v in x direction (in gp)
253    INTEGER(iwp), DIMENSION(:), ALLOCATABLE ::  nvy            !< length scale of v in y direction (in gp)
254    INTEGER(iwp), DIMENSION(:), ALLOCATABLE ::  nvz            !< length scale of v in z direction (in gp)
255    INTEGER(iwp), DIMENSION(:), ALLOCATABLE ::  nwx            !< length scale of w in x direction (in gp)
256    INTEGER(iwp), DIMENSION(:), ALLOCATABLE ::  nwy            !< length scale of w in y direction (in gp)
257    INTEGER(iwp), DIMENSION(:), ALLOCATABLE ::  nwz            !< length scale of w in z direction (in gp)
258    INTEGER(iwp), DIMENSION(:), ALLOCATABLE ::  seed           !< seed of random number for rn-generator
259
260    REAL(wp) ::  blend                    !< value to create gradually and smooth blending of Reynolds stress and length
261                                          !< scales above the boundary layer
262    REAL(wp) ::  blend_coeff = -2.3_wp    !< coefficient used to ensure that blending functions decreases to 1/10 after
263                                          !< one length scale above ABL top
264    REAL(wp) ::  d_l                      !< blend_coeff/length_scale
265    REAL(wp) ::  length_scale             !< length scale, default is 8 x minimum grid spacing
266    REAL(wp) ::  dt_stg_adjust = 300.0_wp !< time interval for adjusting turbulence statistics
267    REAL(wp) ::  dt_stg_call = 5.0_wp     !< time interval for calling synthetic turbulence generator
268    REAL(wp) ::  scale_l                  !< scaling parameter used for turbulence parametrization - Obukhov length
269    REAL(wp) ::  scale_us                 !< scaling parameter used for turbulence parametrization - friction velocity
270    REAL(wp) ::  scale_wm                 !< scaling parameter used for turbulence parametrization - momentum scale 
271    REAL(wp) ::  time_stg_adjust = 0.0_wp !< time counter for adjusting turbulence information   
272    REAL(wp) ::  time_stg_call = 0.0_wp   !< time counter for calling generator   
273   
274    REAL(wp), DIMENSION(3) ::  mc_factor = 1.0_wp !< correction factor for the u,v,w-components to maintain original mass flux
275   
276   
277    REAL(wp),DIMENSION(:), ALLOCATABLE ::  r11              !< Reynolds parameter
278    REAL(wp),DIMENSION(:), ALLOCATABLE ::  r21              !< Reynolds parameter
279    REAL(wp),DIMENSION(:), ALLOCATABLE ::  r22              !< Reynolds parameter
280    REAL(wp),DIMENSION(:), ALLOCATABLE ::  r31              !< Reynolds parameter
281    REAL(wp),DIMENSION(:), ALLOCATABLE ::  r32              !< Reynolds parameter
282    REAL(wp),DIMENSION(:), ALLOCATABLE ::  r33              !< Reynolds parameter
283   
284    REAL(wp), DIMENSION(:), ALLOCATABLE ::  a11             !< coefficient for Lund rotation
285    REAL(wp), DIMENSION(:), ALLOCATABLE ::  a21             !< coefficient for Lund rotation
286    REAL(wp), DIMENSION(:), ALLOCATABLE ::  a22             !< coefficient for Lund rotation
287    REAL(wp), DIMENSION(:), ALLOCATABLE ::  a31             !< coefficient for Lund rotation
288    REAL(wp), DIMENSION(:), ALLOCATABLE ::  a32             !< coefficient for Lund rotation
289    REAL(wp), DIMENSION(:), ALLOCATABLE ::  a33             !< coefficient for Lund rotation
290    REAL(wp), DIMENSION(:), ALLOCATABLE ::  tu              !< Lagrangian time scale of u
291    REAL(wp), DIMENSION(:), ALLOCATABLE ::  tv              !< Lagrangian time scale of v
292    REAL(wp), DIMENSION(:), ALLOCATABLE ::  tw              !< Lagrangian time scale of w
293
294    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  bux           !< filter function for u in x direction
295    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  buy           !< filter function for u in y direction
296    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  buz           !< filter function for u in z direction
297    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  bvx           !< filter function for v in x direction
298    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  bvy           !< filter function for v in y direction
299    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  bvz           !< filter function for v in z direction
300    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  bwx           !< filter function for w in y direction
301    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  bwy           !< filter function for w in y direction
302    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  bwz           !< filter function for w in z direction
303    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  fu_xz         !< velocity seed for u at xz plane
304    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  fuo_xz        !< velocity seed for u at xz plane with new random number
305    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  fu_yz         !< velocity seed for u at yz plane
306    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  fuo_yz        !< velocity seed for u at yz plane with new random number
307    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  fv_xz         !< velocity seed for v at xz plane
308    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  fvo_xz        !< velocity seed for v at xz plane with new random number
309    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  fv_yz         !< velocity seed for v at yz plane
310    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  fvo_yz        !< velocity seed for v at yz plane with new random number
311    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  fw_xz         !< velocity seed for w at xz plane
312    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  fwo_xz        !< velocity seed for w at xz plane with new random number
313    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  fw_yz         !< velocity seed for w at yz plane
314    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  fwo_yz        !< velocity seed for w at yz plane with new random number
315   
316    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  dist_xz     !< imposed disturbances at north/south boundary
317    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  dist_yz     !< imposed disturbances at north/south boundary
318
319!
320!-- PALM interfaces:
321!-- Adjust time and lenght scales, Reynolds stress, and filter functions
322    INTERFACE stg_adjust
323       MODULE PROCEDURE stg_adjust
324    END INTERFACE stg_adjust
325!
326!-- Input parameter checks to be done in check_parameters
327    INTERFACE stg_check_parameters
328       MODULE PROCEDURE stg_check_parameters
329    END INTERFACE stg_check_parameters
330
331!
332!-- Calculate filter functions
333    INTERFACE stg_filter_func
334       MODULE PROCEDURE stg_filter_func
335    END INTERFACE stg_filter_func
336
337!
338!-- Generate velocity seeds at south and north domain boundary
339    INTERFACE stg_generate_seed_xz
340       MODULE PROCEDURE stg_generate_seed_xz
341    END INTERFACE stg_generate_seed_xz
342!
343!-- Generate velocity seeds at left and/or right domain boundary
344    INTERFACE stg_generate_seed_yz
345       MODULE PROCEDURE stg_generate_seed_yz
346    END INTERFACE stg_generate_seed_yz
347
348!
349!-- Output of information to the header file
350    INTERFACE stg_header
351       MODULE PROCEDURE stg_header
352    END INTERFACE stg_header
353
354!
355!-- Initialization actions
356    INTERFACE stg_init
357       MODULE PROCEDURE stg_init
358    END INTERFACE stg_init
359
360!
361!-- Main procedure of synth. turb. gen.
362    INTERFACE stg_main
363       MODULE PROCEDURE stg_main
364    END INTERFACE stg_main
365
366!
367!-- Reading of NAMELIST parameters
368    INTERFACE stg_parin
369       MODULE PROCEDURE stg_parin
370    END INTERFACE stg_parin
371
372!
373!-- Reading of parameters for restart runs
374    INTERFACE stg_rrd_global
375       MODULE PROCEDURE stg_rrd_global
376    END INTERFACE stg_rrd_global
377
378!
379!-- Writing of binary output for restart runs
380    INTERFACE stg_wrd_global
381       MODULE PROCEDURE stg_wrd_global
382    END INTERFACE stg_wrd_global
383
384    SAVE
385
386    PRIVATE
387
388!
389!-- Public interfaces
390    PUBLIC  stg_adjust, stg_check_parameters, stg_header, stg_init, stg_main,  &
391            stg_parin, stg_rrd_global, stg_wrd_global
392
393!
394!-- Public variables
395    PUBLIC  dt_stg_call, dt_stg_adjust, id_stg_left, id_stg_north,             &
396            id_stg_right, id_stg_south, parametrize_inflow_turbulence,         &
397            time_stg_adjust, time_stg_call, use_syn_turb_gen
398
399
400 CONTAINS
401
402
403!------------------------------------------------------------------------------!
404! Description:
405! ------------
406!> Check parameters routine for synthetic turbulence generator
407!------------------------------------------------------------------------------!
408 SUBROUTINE stg_check_parameters
409
410    IMPLICIT NONE
411
412    IF ( .NOT. use_syn_turb_gen  .AND.  .NOT. rans_mode  .AND.                 &
413          nesting_offline )  THEN
414       message_string = 'Synthetic turbulence generator is required ' //       &
415                        'if offline nesting is applied and PALM operates ' //  &
416                        'in LES mode.'
417       CALL message( 'stg_check_parameters', 'PA0520', 0, 0, 0, 6, 0 )
418    ENDIF
419
420    IF ( .NOT. use_syn_turb_gen  .AND.  child_domain                           &
421         .AND. rans_mode_parent  .AND.  .NOT. rans_mode )  THEN
422       message_string = 'Synthetic turbulence generator is required ' //       &
423                        'when nesting is applied and parent operates in '  //  &
424                        'RANS-mode but current child in LES mode.'
425       CALL message( 'stg_check_parameters', 'PA0524', 1, 2, 0, 6, 0 )
426    ENDIF
427
428    IF ( use_syn_turb_gen )  THEN
429
430       IF ( child_domain  .AND.  .NOT. rans_mode  .AND.                        &
431                                 .NOT. rans_mode_parent )  THEN
432          message_string = 'Using synthetic turbulence generator ' //          &
433                           'is not allowed in LES-LES nesting.'
434          CALL message( 'stg_check_parameters', 'PA0620', 1, 2, 0, 6, 0 )
435       
436       ENDIF
437       
438       IF ( child_domain  .AND.  rans_mode  .AND.                              &
439                                 rans_mode_parent )  THEN
440          message_string = 'Using synthetic turbulence generator ' //          &
441                           'is not allowed in RANS-RANS nesting.'
442          CALL message( 'stg_check_parameters', 'PA0621', 1, 2, 0, 6, 0 )
443       
444       ENDIF
445   
446       IF ( .NOT. nesting_offline  .AND.  .NOT. child_domain )  THEN
447       
448          IF ( INDEX( initializing_actions, 'set_constant_profiles' ) == 0     &
449        .AND.  INDEX( initializing_actions, 'read_restart_data' ) == 0 )  THEN
450             message_string = 'Using synthetic turbulence generator ' //       &
451                            'requires %initializing_actions = '         //     &
452                            '"set_constant_profiles" or "read_restart_data"' //&
453                            ', if not offline nesting is applied.'
454             CALL message( 'stg_check_parameters', 'PA0015', 1, 2, 0, 6, 0 )
455          ENDIF
456
457          IF ( bc_lr /= 'dirichlet/radiation' )  THEN
458             message_string = 'Using synthetic turbulence generator ' //       &
459                              'requires &bc_lr = "dirichlet/radiation", ' //   &
460                              'if not offline nesting is applied.'
461             CALL message( 'stg_check_parameters', 'PA0035', 1, 2, 0, 6, 0 )
462          ENDIF
463          IF ( bc_ns /= 'cyclic' )  THEN
464             message_string = 'Using synthetic turbulence generator ' //       &
465                              'requires &bc_ns = "cyclic", ' //                &
466                              'if not offline nesting is applied.'
467             CALL message( 'stg_check_parameters', 'PA0037', 1, 2, 0, 6, 0 )
468          ENDIF
469
470       ENDIF
471
472       IF ( turbulent_inflow )  THEN
473          message_string = 'Using synthetic turbulence generator ' //          &
474                           'in combination &with turbulent_inflow = .T. '//    &
475                              'is not allowed'
476          CALL message( 'stg_check_parameters', 'PA0039', 1, 2, 0, 6, 0 )
477       ENDIF
478
479    ENDIF
480
481 END SUBROUTINE stg_check_parameters
482
483
484!------------------------------------------------------------------------------!
485! Description:
486! ------------
487!> Header output for synthetic turbulence generator
488!------------------------------------------------------------------------------!
489 SUBROUTINE stg_header ( io )
490
491
492    IMPLICIT NONE
493
494    INTEGER(iwp), INTENT(IN) ::  io   !< Unit of the output file
495
496!
497!-- Write synthetic turbulence generator Header
498    WRITE( io, 1 )
499    IF ( use_syn_turb_gen )  THEN
500       WRITE( io, 2 )
501    ELSE
502       WRITE( io, 3 )
503    ENDIF
504   
505    IF ( parametrize_inflow_turbulence )  THEN
506       WRITE( io, 4 ) dt_stg_adjust
507    ELSE
508       WRITE( io, 5 )
509    ENDIF
510
5111   FORMAT (//' Synthetic turbulence generator information:'/                  &
512              ' ------------------------------------------'/)
5132   FORMAT ('    synthetic turbulence generator is switched on')
5143   FORMAT ('    synthetic turbulence generator is switched off')
5154   FORMAT ('    imposed turbulence statistics are parametrized and ajdusted to boundary-layer development each ', F8.2, ' s' )
5165   FORMAT ('    imposed turbulence is read from file' )
517
518 END SUBROUTINE stg_header
519
520
521!------------------------------------------------------------------------------!
522! Description:
523! ------------
524!> Initialization of the synthetic turbulence generator
525!------------------------------------------------------------------------------!
526 SUBROUTINE stg_init
527
528    IMPLICIT NONE
529
530    LOGICAL ::  file_stg_exist = .FALSE. !< flag indicating whether parameter file for Reynolds stress and length scales exist
531
532#if defined( __parallel )
533    INTEGER(KIND=MPI_ADDRESS_KIND) :: extent !< extent of new MPI type
534    INTEGER(KIND=MPI_ADDRESS_KIND) :: tob=0  !< dummy variable
535#endif
536
537    INTEGER(iwp) :: i                        !> grid index in x-direction
538    INTEGER(iwp) :: j                        !> loop index
539    INTEGER(iwp) :: k                        !< index
540    INTEGER(iwp) :: newtype                  !< dummy MPI type
541    INTEGER(iwp) :: realsize                 !< size of REAL variables
542    INTEGER(iwp) :: nseed                    !< dimension of random number seed
543    INTEGER(iwp) :: startseed = 1234567890   !< start seed for random number generator
544   
545    INTEGER(iwp), DIMENSION(3) ::  nr_non_topo_xz_l = 0 !< number of non-topography grid points at xz-cross-section on subdomain
546    INTEGER(iwp), DIMENSION(3) ::  nr_non_topo_yz_l = 0 !< number of non-topography grid points at yz-cross-section on subdomain
547!
548!-- Dummy variables used for reading profiles
549    REAL(wp) :: d1      !< u profile
550    REAL(wp) :: d2      !< v profile
551    REAL(wp) :: d3      !< w profile
552    REAL(wp) :: d5      !< e profile
553    REAL(wp) :: luy     !< length scale for u in y direction
554    REAL(wp) :: luz     !< length scale for u in z direction
555    REAL(wp) :: lvy     !< length scale for v in y direction
556    REAL(wp) :: lvz     !< length scale for v in z direction
557    REAL(wp) :: lwy     !< length scale for w in y direction
558    REAL(wp) :: lwz     !< length scale for w in z direction
559    REAL(wp) :: nnz     !< increment used to determine processor decomposition of z-axis along x and y direction
560    REAL(wp) :: zz      !< height
561
562
563#if defined( __parallel )
564    CALL MPI_BARRIER( comm2d, ierr )
565#endif
566
567#if defined( __parallel )
568!
569!-- Determine processor decomposition of z-axis along x- and y-direction
570    nnz = nz / pdims(1)
571    nzb_x_stg = 1 + myidx * INT( nnz )
572    nzt_x_stg = ( myidx + 1 ) * INT( nnz )
573
574    IF ( MOD( nz , pdims(1) ) /= 0  .AND.  myidx == id_stg_right )             &
575       nzt_x_stg = nzt_x_stg + myidx * ( nnz - INT( nnz ) )
576
577    IF ( nesting_offline   .OR.  ( child_domain  .AND.  rans_mode_parent       &
578                            .AND.  .NOT.  rans_mode ) )  THEN
579       nnz = nz / pdims(2)
580       nzb_y_stg = 1 + myidy * INT( nnz )
581       nzt_y_stg = ( myidy + 1 ) * INT( nnz )
582
583       IF ( MOD( nz , pdims(2) ) /= 0  .AND.  myidy == id_stg_north )          &
584          nzt_y_stg = nzt_y_stg + myidy * ( nnz - INT( nnz ) )
585    ENDIF
586
587!
588!-- Define MPI type used in stg_generate_seed_yz to gather vertical splitted
589!-- velocity seeds
590    CALL MPI_TYPE_SIZE( MPI_REAL, realsize, ierr )
591    extent = 1 * realsize
592!
593!-- Set-up MPI datatyp to involve all cores for turbulence generation at yz
594!-- layer
595!-- stg_type_yz: yz-slice with vertical bounds nzb:nzt+1
596    CALL MPI_TYPE_CREATE_SUBARRAY( 2, [nzt-nzb+2,nyng-nysg+1],                 &
597            [1,nyng-nysg+1], [0,0], MPI_ORDER_FORTRAN, MPI_REAL, newtype, ierr )
598    CALL MPI_TYPE_CREATE_RESIZED( newtype, tob, extent, stg_type_yz, ierr )
599    CALL MPI_TYPE_COMMIT( stg_type_yz, ierr )
600    CALL MPI_TYPE_FREE( newtype, ierr )
601
602    ! stg_type_yz_small: yz-slice with vertical bounds nzb_x_stg:nzt_x_stg+1
603    CALL MPI_TYPE_CREATE_SUBARRAY( 2, [nzt_x_stg-nzb_x_stg+2,nyng-nysg+1],     &
604            [1,nyng-nysg+1], [0,0], MPI_ORDER_FORTRAN, MPI_REAL, newtype, ierr )
605    CALL MPI_TYPE_CREATE_RESIZED( newtype, tob, extent, stg_type_yz_small, ierr )
606    CALL MPI_TYPE_COMMIT( stg_type_yz_small, ierr )
607    CALL MPI_TYPE_FREE( newtype, ierr )
608
609    ! receive count and displacement for MPI_GATHERV in stg_generate_seed_yz
610    ALLOCATE( recv_count_yz(pdims(1)), displs_yz(pdims(1)) )
611
612    recv_count_yz           = nzt_x_stg-nzb_x_stg + 1
613    recv_count_yz(pdims(1)) = recv_count_yz(pdims(1)) + 1
614
615    DO  j = 1, pdims(1)
616       displs_yz(j) = 0 + (nzt_x_stg-nzb_x_stg+1) * (j-1)
617    ENDDO
618!
619!-- Set-up MPI datatyp to involve all cores for turbulence generation at xz
620!-- layer
621!-- stg_type_xz: xz-slice with vertical bounds nzb:nzt+1
622    IF ( nesting_offline  .OR.  ( child_domain .AND.  rans_mode_parent         &
623                           .AND.  .NOT.  rans_mode ) )  THEN
624       CALL MPI_TYPE_CREATE_SUBARRAY( 2, [nzt-nzb+2,nxrg-nxlg+1],              &
625               [1,nxrg-nxlg+1], [0,0], MPI_ORDER_FORTRAN, MPI_REAL, newtype, ierr )
626       CALL MPI_TYPE_CREATE_RESIZED( newtype, tob, extent, stg_type_xz, ierr )
627       CALL MPI_TYPE_COMMIT( stg_type_xz, ierr )
628       CALL MPI_TYPE_FREE( newtype, ierr )
629
630       ! stg_type_yz_small: xz-slice with vertical bounds nzb_x_stg:nzt_x_stg+1
631       CALL MPI_TYPE_CREATE_SUBARRAY( 2, [nzt_y_stg-nzb_y_stg+2,nxrg-nxlg+1],  &
632               [1,nxrg-nxlg+1], [0,0], MPI_ORDER_FORTRAN, MPI_REAL, newtype, ierr )
633       CALL MPI_TYPE_CREATE_RESIZED( newtype, tob, extent, stg_type_xz_small, ierr )
634       CALL MPI_TYPE_COMMIT( stg_type_xz_small, ierr )
635       CALL MPI_TYPE_FREE( newtype, ierr )
636
637       ! receive count and displacement for MPI_GATHERV in stg_generate_seed_yz
638       ALLOCATE( recv_count_xz(pdims(2)), displs_xz(pdims(2)) )
639
640       recv_count_xz           = nzt_y_stg-nzb_y_stg + 1
641       recv_count_xz(pdims(2)) = recv_count_xz(pdims(2)) + 1
642
643       DO  j = 1, pdims(2)
644          displs_xz(j) = 0 + (nzt_y_stg-nzb_y_stg+1) * (j-1)
645       ENDDO
646
647    ENDIF
648
649#endif
650!
651!-- Define seed of random number
652    CALL RANDOM_SEED()
653    CALL RANDOM_SEED( size=nseed )
654    ALLOCATE( seed(1:nseed) )
655    DO  j = 1, nseed
656       seed(j) = startseed + j
657    ENDDO
658    CALL RANDOM_SEED(put=seed)
659!
660!-- Allocate required arrays.
661!-- In case no offline nesting or self nesting is used, the arrary
662!-- mean_inflow profiles is required. Check if it is already allocated, else
663!-- allocate and initialize it appropriately. Note, in case turbulence and
664!-- inflow information is read from file, mean_inflow_profiles is already
665!-- allocated and initialized appropriately.
666    IF ( .NOT. nesting_offline  .AND.  .NOT.  child_domain )  THEN
667       IF ( .NOT. ALLOCATED( mean_inflow_profiles ) )  THEN
668          ALLOCATE( mean_inflow_profiles(nzb:nzt+1,1:num_mean_inflow_profiles) )
669          mean_inflow_profiles = 0.0_wp
670          mean_inflow_profiles(:,1) = u_init
671          mean_inflow_profiles(:,2) = v_init
672!
673!--       Even though potential temperature and humidity are not perturbed,
674!--       they need to be initialized appropriately.
675          IF ( .NOT. neutral )                                                 &
676             mean_inflow_profiles(:,4) = pt_init
677          IF ( humidity )                                                      &
678             mean_inflow_profiles(:,6) = q_init       
679       ENDIF   
680    ENDIF
681
682    ALLOCATE ( a11(nzb:nzt+1), a21(nzb:nzt+1), a22(nzb:nzt+1),                 &
683               a31(nzb:nzt+1), a32(nzb:nzt+1), a33(nzb:nzt+1),                 &
684               nux(nzb:nzt+1), nuy(nzb:nzt+1), nuz(nzb:nzt+1),                 &
685               nvx(nzb:nzt+1), nvy(nzb:nzt+1), nvz(nzb:nzt+1),                 &
686               nwx(nzb:nzt+1), nwy(nzb:nzt+1), nwz(nzb:nzt+1),                 &
687               r11(nzb:nzt+1), r21(nzb:nzt+1), r22(nzb:nzt+1),                 &
688               r31(nzb:nzt+1), r32(nzb:nzt+1), r33(nzb:nzt+1),                 &
689               tu(nzb:nzt+1),  tv(nzb:nzt+1),  tw(nzb:nzt+1)   )
690               
691    ALLOCATE ( dist_xz(nzb:nzt+1,nxlg:nxrg,3) )
692    ALLOCATE ( dist_yz(nzb:nzt+1,nysg:nyng,3) )
693    dist_xz = 0.0_wp
694    dist_yz = 0.0_wp
695!
696!-- Read inflow profile
697!-- Height levels of profiles in input profile is as follows:
698!-- zu: luy, luz, tu, lvy, lvz, tv, r11, r21, r22, d1, d2, d5
699!-- zw: lwy, lwz, tw, r31, r32, r33, d3
700!-- WARNING: zz is not used at the moment
701    INQUIRE( FILE = 'STG_PROFILES' // TRIM( coupling_char ),                   &
702             EXIST = file_stg_exist  )
703
704    IF ( file_stg_exist )  THEN
705
706       OPEN( 90, FILE='STG_PROFILES'//TRIM( coupling_char ), STATUS='OLD',     &
707                      FORM='FORMATTED')
708!
709!--    Skip header
710       READ( 90, * )
711
712       DO  k = nzb+1, nzt+1
713          READ( 90, * ) zz, luy, luz, tu(k), lvy, lvz, tv(k), lwy, lwz, tw(k), &
714                        r11(k), r21(k), r22(k), r31(k), r32(k), r33(k),        &
715                        d1, d2, d3, d5
716
717!
718!--       Convert length scales from meter to number of grid points.
719          nuy(k) = INT( luy * ddy )
720          nuz(k) = INT( luz * ddzw(k) )
721          nvy(k) = INT( lvy * ddy )
722          nvz(k) = INT( lvz * ddzw(k) )
723          nwy(k) = INT( lwy * ddy )
724          nwz(k) = INT( lwz * ddzw(k) )
725!
726!--       Workaround, assume isotropic turbulence
727          nwx(k) = nwy(k)
728          nvx(k) = nvy(k)
729          nux(k) = nuy(k)
730!
731!--       Save Mean inflow profiles
732          IF ( TRIM( initializing_actions ) /= 'read_restart_data' ) THEN
733             mean_inflow_profiles(k,1) = d1
734             mean_inflow_profiles(k,2) = d2
735            !  mean_inflow_profiles(k,4) = d4
736             mean_inflow_profiles(k,5) = d5
737          ENDIF
738       ENDDO
739!
740!--    Set lenght scales at surface grid point
741       nuy(nzb) = nuy(nzb+1) 
742       nuz(nzb) = nuz(nzb+1)
743       nvy(nzb) = nvy(nzb+1)
744       nvz(nzb) = nvz(nzb+1)
745       nwy(nzb) = nwy(nzb+1)
746       nwz(nzb) = nwz(nzb+1)
747       
748       CLOSE( 90 )
749!
750!--    Calculate coefficient matrix from Reynolds stress tensor 
751!--    (Lund rotation)
752       CALL calc_coeff_matrix
753!
754!-- No information about turbulence and its length scales are available.
755!-- Instead, parametrize turbulence which is imposed at the boundaries.
756!-- Set flag which indicates that turbulence is parametrized, which is done
757!-- later when energy-balance models are already initialized. This is
758!-- because the STG needs information about surface properties such as
759!-- roughness to build 'realistic' turbulence profiles.
760    ELSE
761!
762!--    Define length scale for the imposed turbulence, which is defined as
763!--    8 times the minimum grid spacing
764       length_scale = 8.0_wp * MIN( dx, dy, MINVAL( dzw ) )
765!
766!--    Define constant to gradually decrease length scales and Reynolds stress
767!--    above ABL top. Assure that no zero length scales are used.
768       d_l = blend_coeff / MAX( length_scale, dx, dy, MINVAL( dzw ) )
769!
770!--    Set flag indicating that turbulence is parametrized
771       parametrize_inflow_turbulence = .TRUE.
772!
773!--    In case of dirichlet inflow boundary conditions only at one lateral
774!--    boundary, i.e. in the case no offline or self nesting is applied but
775!--    synthetic turbulence shall be parametrized nevertheless, the
776!--    boundary-layer depth need to determined first.
777       IF ( .NOT. nesting_offline  .AND.  .NOT.  child_domain )                &
778          CALL nesting_offl_calc_zi
779!
780!--    Determine boundary-layer depth, which is used to initialize lenght
781!--    scales
782       CALL calc_scaling_variables
783!
784!--    Initialize lenght and time scales, which in turn are used
785!--    to initialize the filter functions.
786       CALL calc_length_and_time_scale
787!
788!--    Parametrize Reynolds-stress tensor, diagonal elements as well
789!--    as r21 (v'u'), r31 (w'u'), r32 (w'v'). Parametrization follows
790!--    Rotach et al. (1996) and is based on boundary-layer depth,
791!--    friction velocity and velocity scale.
792       CALL parametrize_reynolds_stress
793!     
794!--    Calculate coefficient matrix from Reynolds stress tensor 
795!--    (Lund rotation)
796       CALL calc_coeff_matrix
797           
798    ENDIF
799
800!
801!-- Assign initial profiles. Note, this is only required if turbulent
802!-- inflow from the left is desired, not in case of any of the
803!-- nesting (offline or self nesting) approaches.
804    IF ( .NOT. nesting_offline  .AND.  .NOT.  child_domain )  THEN
805       u_init = mean_inflow_profiles(:,1)
806       v_init = mean_inflow_profiles(:,2)
807      !pt_init = mean_inflow_profiles(:,4)
808       e_init = MAXVAL( mean_inflow_profiles(:,5) )
809    ENDIF
810   
811!
812!-- Define the size of the filter functions and allocate them.
813    merg = 0
814
815    ! arrays must be large enough to cover the largest length scale
816    DO  k = nzb, nzt+1
817       j = MAX( ABS(nux(k)), ABS(nuy(k)), ABS(nuz(k)), &
818                ABS(nvx(k)), ABS(nvy(k)), ABS(nvz(k)), &
819                ABS(nwx(k)), ABS(nwy(k)), ABS(nwz(k))  )
820       IF ( j > merg )  merg = j
821    ENDDO
822
823    merg  = 2 * merg
824    mergp = merg + nbgp
825
826    ALLOCATE ( bux(-merg:merg,nzb:nzt+1),                                      &
827               buy(-merg:merg,nzb:nzt+1),                                      &
828               buz(-merg:merg,nzb:nzt+1),                                      &
829               bvx(-merg:merg,nzb:nzt+1),                                      &
830               bvy(-merg:merg,nzb:nzt+1),                                      &
831               bvz(-merg:merg,nzb:nzt+1),                                      &
832               bwx(-merg:merg,nzb:nzt+1),                                      &
833               bwy(-merg:merg,nzb:nzt+1),                                      &
834               bwz(-merg:merg,nzb:nzt+1)  )
835
836!
837!-- Allocate velocity seeds for turbulence at xz-layer
838    ALLOCATE ( fu_xz( nzb:nzt+1,nxlg:nxrg), fuo_xz(nzb:nzt+1,nxlg:nxrg),       &
839               fv_xz( nzb:nzt+1,nxlg:nxrg), fvo_xz(nzb:nzt+1,nxlg:nxrg),       &
840               fw_xz( nzb:nzt+1,nxlg:nxrg), fwo_xz(nzb:nzt+1,nxlg:nxrg)  )
841
842!
843!-- Allocate velocity seeds for turbulence at yz-layer
844    ALLOCATE ( fu_yz( nzb:nzt+1,nysg:nyng), fuo_yz(nzb:nzt+1,nysg:nyng),       &
845               fv_yz( nzb:nzt+1,nysg:nyng), fvo_yz(nzb:nzt+1,nysg:nyng),       &
846               fw_yz( nzb:nzt+1,nysg:nyng), fwo_yz(nzb:nzt+1,nysg:nyng)  )
847
848    fu_xz  = 0.0_wp
849    fuo_xz = 0.0_wp
850    fv_xz  = 0.0_wp
851    fvo_xz = 0.0_wp
852    fw_xz  = 0.0_wp
853    fwo_xz = 0.0_wp
854
855    fu_yz  = 0.0_wp
856    fuo_yz = 0.0_wp
857    fv_yz  = 0.0_wp
858    fvo_yz = 0.0_wp
859    fw_yz  = 0.0_wp
860    fwo_yz = 0.0_wp
861
862!
863!-- Create filter functions
864    CALL stg_filter_func( nux, bux ) !filter ux
865    CALL stg_filter_func( nuy, buy ) !filter uy
866    CALL stg_filter_func( nuz, buz ) !filter uz
867    CALL stg_filter_func( nvx, bvx ) !filter vx
868    CALL stg_filter_func( nvy, bvy ) !filter vy
869    CALL stg_filter_func( nvz, bvz ) !filter vz
870    CALL stg_filter_func( nwx, bwx ) !filter wx
871    CALL stg_filter_func( nwy, bwy ) !filter wy
872    CALL stg_filter_func( nwz, bwz ) !filter wz
873
874#if defined( __parallel )
875    CALL MPI_BARRIER( comm2d, ierr )
876#endif
877
878!
879!-- In case of restart, calculate velocity seeds fu, fv, fw from former
880!   time step.
881!   Bug: fu, fv, fw are different in those heights where a11, a22, a33
882!        are 0 compared to the prerun. This is mostly for k=nzt+1.
883    IF ( TRIM( initializing_actions ) == 'read_restart_data' )  THEN
884       IF ( myidx == id_stg_left  .OR.  myidx == id_stg_right )  THEN
885
886          IF ( myidx == id_stg_left  )  i = -1
887          IF ( myidx == id_stg_right )  i = nxr+1
888
889          DO  j = nysg, nyng
890             DO  k = nzb, nzt+1
891                IF  ( a11(k) /= 0.0_wp )  THEN
892                   fu_yz(k,j) = ( u(k,j,i) - u_init(k) ) / a11(k)
893                ELSE
894                   fu_yz(k,j) = 0.0_wp
895                ENDIF
896
897                IF  ( a22(k) /= 0.0_wp )  THEN
898                   fv_yz(k,j) = ( v(k,j,i) -                                  &
899                                  a21(k) * fu_yz(k,j) - v_init(k) ) / a22(k)
900                ELSE
901                   fv_yz(k,j) = 0.0_wp
902                ENDIF
903
904                IF  ( a33(k) /= 0.0_wp )  THEN
905                   fw_yz(k,j) = ( w(k,j,i) -                                   &
906                                  a31(k) * fu_yz(k,j) - a32(k) *               &
907                                  fv_yz(k,j) ) / a33(k)
908                ELSE
909                   fw_yz = 0._wp
910                ENDIF
911
912             ENDDO
913          ENDDO
914       ENDIF
915       
916       IF ( myidy == id_stg_south  .OR.  myidy == id_stg_north )  THEN
917
918          IF ( myidy == id_stg_south )  j = -1
919          IF ( myidy == id_stg_north )  j = nyn+1
920
921          DO  i = nxlg, nxrg
922             DO  k = nzb, nzt+1
923
924                IF  ( a11(k) /= 0.0_wp )  THEN
925                   fu_xz(k,i) = ( u(k,j,i) - u_init(k) ) / a11(k)
926                ELSE
927                   fu_xz(k,i) = 0.0_wp
928                ENDIF
929
930                IF  ( a22(k) /= 0.0_wp )  THEN
931                   fv_xz(k,i) = ( v(k,j,i) -                                   &
932                                  a21(k) * fu_xz(k,i) - v_init(k) ) / a22(k)
933                ELSE
934                   fv_xz(k,i) = 0.0_wp
935                ENDIF
936
937                IF  ( a33(k) /= 0.0_wp )  THEN
938                   fw_xz(k,i) = ( w(k,j,i) -                                   &
939                                  a31(k) * fu_xz(k,i) -                        &
940                                  a32(k) * fv_xz(k,i) ) / a33(k)
941                ELSE
942                   fw_xz = 0._wp
943                ENDIF
944
945             ENDDO
946          ENDDO
947       ENDIF
948    ENDIF
949!
950!-- Count the number of non-topography grid points at the boundaries where
951!-- perturbations are imposed. This number is later used for bias corrections
952!-- of the perturbations, i.e. to force that their mean is zero. Please note,
953!-- due to the asymetry of u and v along x and y direction, respectively,
954!-- different cases must be distinguished.
955    IF ( myidx == id_stg_left  .OR.  myidx == id_stg_right )  THEN
956!
957!--    Number of grid points where perturbations are imposed on u
958       IF ( myidx == id_stg_left  )  i = nxl
959       IF ( myidx == id_stg_right )  i = nxr+1
960       
961       nr_non_topo_yz_l(1) = SUM(                                              &
962                          MERGE( 1, 0,                                         &
963                                 BTEST( wall_flags_0(nzb:nzt,nys:nyn,i), 1 ) ) )
964!
965!--    Number of grid points where perturbations are imposed on v and w                                   
966       IF ( myidx == id_stg_left  )  i = nxl-1
967       IF ( myidx == id_stg_right )  i = nxr+1
968       
969       nr_non_topo_yz_l(2) = SUM(                                              &
970                          MERGE( 1, 0,                                         &
971                                 BTEST( wall_flags_0(nzb:nzt,nysv:nyn,i), 2 ) ) )
972       nr_non_topo_yz_l(3) = SUM(                                              &
973                          MERGE( 1, 0,                                         &
974                                 BTEST( wall_flags_0(nzb:nzt,nys:nyn,i), 3 ) ) )
975                                   
976#if defined( __parallel )
977       CALL MPI_ALLREDUCE( nr_non_topo_yz_l, nr_non_topo_yz, 3, MPI_INTEGER,   &
978                           MPI_SUM, comm1dy, ierr )
979#else
980       nr_non_topo_yz = nr_non_topo_yz_l
981#endif 
982    ENDIF
983   
984    IF ( myidy == id_stg_south  .OR.  myidy == id_stg_north )  THEN
985!
986!--    Number of grid points where perturbations are imposed on v
987       IF ( myidy == id_stg_south )  j = nys
988       IF ( myidy == id_stg_north )  j = nyn+1
989       
990       nr_non_topo_xz_l(2) = SUM(                                              &
991                          MERGE( 1, 0,                                         &
992                                 BTEST( wall_flags_0(nzb:nzt,j,nxl:nxr), 2 ) ) )
993!
994!--    Number of grid points where perturbations are imposed on u and w
995       IF ( myidy == id_stg_south )  j = nys-1
996       IF ( myidy == id_stg_north )  j = nyn+1
997       
998       nr_non_topo_xz_l(1) = SUM(                                              &
999                          MERGE( 1, 0,                                         &
1000                                 BTEST( wall_flags_0(nzb:nzt,j,nxlu:nxr), 1 ) ) )
1001       nr_non_topo_xz_l(3) = SUM(                                              &
1002                          MERGE( 1, 0,                                         &
1003                                 BTEST( wall_flags_0(nzb:nzt,j,nxl:nxr), 3 ) ) )
1004                                   
1005#if defined( __parallel )
1006       CALL MPI_ALLREDUCE( nr_non_topo_xz_l, nr_non_topo_xz, 3, MPI_INTEGER,   &
1007                           MPI_SUM, comm1dx, ierr )
1008#else
1009       nr_non_topo_xz = nr_non_topo_xz_l
1010#endif 
1011    ENDIF
1012
1013
1014 END SUBROUTINE stg_init
1015
1016
1017!------------------------------------------------------------------------------!
1018! Description:
1019! ------------
1020!> Calculate filter function bxx from length scale nxx following Eg.9 and 10
1021!> (Xie and Castro, 2008)
1022!------------------------------------------------------------------------------!
1023 SUBROUTINE stg_filter_func( nxx, bxx )
1024
1025
1026    IMPLICIT NONE
1027
1028    INTEGER(iwp) :: k         !< loop index
1029    INTEGER(iwp) :: n_k       !< length scale nXX in height k
1030    INTEGER(iwp) :: n_k2      !< n_k * 2
1031    INTEGER(iwp) :: nf        !< index for length scales
1032
1033    REAL(wp) :: bdenom        !< denominator for filter functions bXX
1034    REAL(wp) :: qsi = 1.0_wp  !< minimization factor
1035
1036    INTEGER(iwp), DIMENSION(:) :: nxx(nzb:nzt+1)           !< length scale (in gp)
1037
1038    REAL(wp), DIMENSION(:,:) :: bxx(-merg:merg,nzb:nzt+1)  !< filter function
1039
1040
1041    bxx = 0.0_wp
1042
1043    DO  k = nzb, nzt+1
1044       bdenom = 0.0_wp
1045       n_k    = nxx(k)
1046       IF ( n_k /= 0 )  THEN
1047          n_k2 = n_k * 2
1048
1049!
1050!--       ( Eq.10 )^2
1051          DO  nf = -n_k2, n_k2
1052             bdenom = bdenom + EXP( -qsi * pi * ABS(nf) / n_k )**2
1053          ENDDO
1054
1055!
1056!--       ( Eq.9 )
1057          bdenom = SQRT( bdenom )
1058          DO  nf = -n_k2, n_k2
1059             bxx(nf,k) = EXP( -qsi * pi * ABS(nf) / n_k ) / bdenom
1060          ENDDO
1061       ENDIF
1062    ENDDO
1063
1064 END SUBROUTINE stg_filter_func
1065
1066
1067!------------------------------------------------------------------------------!
1068! Description:
1069! ------------
1070!> Parin for &stg_par for synthetic turbulence generator
1071!------------------------------------------------------------------------------!
1072 SUBROUTINE stg_parin
1073
1074
1075    IMPLICIT NONE
1076
1077    CHARACTER (LEN=80) ::  line   !< dummy string that contains the current line of the parameter file
1078
1079
1080    NAMELIST /stg_par/  dt_stg_adjust, dt_stg_call, use_syn_turb_gen
1081
1082    line = ' '
1083
1084!
1085!-- Try to find stg package
1086    REWIND ( 11 )
1087    line = ' '
1088    DO WHILE ( INDEX( line, '&stg_par' ) == 0 )
1089       READ ( 11, '(A)', END=20 )  line
1090    ENDDO
1091    BACKSPACE ( 11 )
1092
1093!
1094!-- Read namelist
1095    READ ( 11, stg_par, ERR = 10, END = 20 )
1096
1097!
1098!-- Set flag that indicates that the synthetic turbulence generator is switched
1099!-- on
1100    syn_turb_gen = .TRUE.
1101    GOTO 20
1102
1103 10 BACKSPACE( 11 )
1104    READ( 11 , '(A)') line
1105    CALL parin_fail_message( 'stg_par', line )
1106
1107 20 CONTINUE
1108
1109 END SUBROUTINE stg_parin
1110
1111
1112!------------------------------------------------------------------------------!
1113! Description:
1114! ------------
1115!> This routine reads the respective restart data.
1116!------------------------------------------------------------------------------!
1117 SUBROUTINE stg_rrd_global( found )
1118
1119
1120    IMPLICIT NONE
1121
1122    LOGICAL, INTENT(OUT)  ::  found !< flag indicating if variable was found
1123
1124
1125    found = .TRUE.
1126
1127
1128    SELECT CASE ( restart_string(1:length) )
1129         
1130       CASE ( 'time_stg_adjust' )
1131          READ ( 13 )  time_stg_adjust
1132         
1133       CASE ( 'time_stg_call' )
1134          READ ( 13 )  time_stg_call
1135         
1136       CASE ( 'use_syn_turb_gen' )
1137          READ ( 13 )  use_syn_turb_gen
1138
1139       CASE DEFAULT
1140
1141          found = .FALSE.
1142
1143    END SELECT
1144
1145
1146 END SUBROUTINE stg_rrd_global
1147
1148
1149!------------------------------------------------------------------------------!
1150! Description:
1151! ------------
1152!> This routine writes the respective restart data.
1153!------------------------------------------------------------------------------!
1154 SUBROUTINE stg_wrd_global
1155
1156
1157    IMPLICIT NONE
1158   
1159    CALL wrd_write_string( 'time_stg_adjust' )
1160    WRITE ( 14 )  time_stg_adjust
1161   
1162    CALL wrd_write_string( 'time_stg_call' )
1163    WRITE ( 14 )  time_stg_call
1164
1165    CALL wrd_write_string( 'use_syn_turb_gen' )
1166    WRITE ( 14 )  use_syn_turb_gen
1167
1168
1169 END SUBROUTINE stg_wrd_global
1170
1171
1172!------------------------------------------------------------------------------!
1173! Description:
1174! ------------
1175!> Create turbulent inflow fields for u, v, w with prescribed length scales and
1176!> Reynolds stress tensor after a method of Xie and Castro (2008), modified
1177!> following suggestions of Kim et al. (2013), and using a Lund rotation
1178!> (Lund, 1998).
1179!------------------------------------------------------------------------------!
1180 SUBROUTINE stg_main
1181
1182    IMPLICIT NONE
1183
1184    INTEGER(iwp) :: i           !< grid index in x-direction
1185    INTEGER(iwp) :: j           !< loop index in y-direction
1186    INTEGER(iwp) :: k           !< loop index in z-direction
1187   
1188    LOGICAL  :: stg_call = .FALSE. !< control flag indicating whether turbulence was updated or only restored from last call
1189
1190    REAL(wp) :: dt_stg          !< wheighted subtimestep
1191   
1192    REAL(wp), DIMENSION(3) :: mc_factor_l   !< local mass flux correction factor
1193
1194    IF ( debug_output_timestep )  CALL debug_message( 'stg_main', 'start' )
1195!
1196!-- Calculate time step which is needed for filter functions
1197    dt_stg = MAX( dt_3d, dt_stg_call )
1198!
1199!-- Check if synthetic turbulence generator needs to be called and new
1200!-- perturbations need to be created or if old disturbances can be imposed
1201!-- again.
1202    IF ( time_stg_call >= dt_stg_call  .AND.                                  &
1203         intermediate_timestep_count == intermediate_timestep_count_max  )  THEN
1204       stg_call = .TRUE.
1205    ELSE
1206       stg_call = .FALSE.
1207    ENDIF
1208!
1209!-- Initial value of fu, fv, fw
1210    IF ( time_since_reference_point == 0.0_wp .AND. .NOT. velocity_seed_initialized )  THEN
1211       CALL stg_generate_seed_yz( nuy, nuz, buy, buz, fu_yz, id_stg_left )
1212       CALL stg_generate_seed_yz( nvy, nvz, bvy, bvz, fv_yz, id_stg_left )
1213       CALL stg_generate_seed_yz( nwy, nwz, bwy, bwz, fw_yz, id_stg_left )
1214
1215       IF ( nesting_offline  .OR.  ( child_domain .AND.  rans_mode_parent      &
1216                                .AND.  .NOT.  rans_mode ) )  THEN
1217!
1218!--       Generate turbulence at right boundary
1219          CALL stg_generate_seed_yz( nuy, nuz, buy, buz, fu_yz, id_stg_right )
1220          CALL stg_generate_seed_yz( nvy, nvz, bvy, bvz, fv_yz, id_stg_right )
1221          CALL stg_generate_seed_yz( nwy, nwz, bwy, bwz, fw_yz, id_stg_right )
1222!
1223!--       Generate turbulence at north boundary
1224          CALL stg_generate_seed_xz( nux, nuz, bux, buz, fu_xz, id_stg_north )
1225          CALL stg_generate_seed_xz( nvx, nvz, bvx, bvz, fv_xz, id_stg_north )
1226          CALL stg_generate_seed_xz( nwx, nwz, bwx, bwz, fw_xz, id_stg_north )
1227!
1228!--       Generate turbulence at south boundary
1229          CALL stg_generate_seed_xz( nux, nuz, bux, buz, fu_xz, id_stg_south )
1230          CALL stg_generate_seed_xz( nvx, nvz, bvx, bvz, fv_xz, id_stg_south )
1231          CALL stg_generate_seed_xz( nwx, nwz, bwx, bwz, fw_xz, id_stg_south )
1232       ENDIF
1233       velocity_seed_initialized = .TRUE.
1234    ENDIF
1235   
1236!
1237!-- New set of fu, fv, fw
1238    IF ( stg_call )  THEN
1239!     
1240!--    Generate turbulence at left boundary (required in all applications,
1241!--    i.e. offline nesting and turbulent inflow from the left)
1242       CALL stg_generate_seed_yz( nuy, nuz, buy, buz, fuo_yz, id_stg_left )
1243       CALL stg_generate_seed_yz( nvy, nvz, bvy, bvz, fvo_yz, id_stg_left )
1244       CALL stg_generate_seed_yz( nwy, nwz, bwy, bwz, fwo_yz, id_stg_left )
1245       
1246       IF ( nesting_offline  .OR.  ( child_domain .AND.  rans_mode_parent      &
1247                             .AND.  .NOT.  rans_mode ) )  THEN
1248!     
1249!--       Generate turbulence at right boundary
1250          CALL stg_generate_seed_yz( nuy, nuz, buy, buz, fuo_yz, id_stg_right )
1251          CALL stg_generate_seed_yz( nvy, nvz, bvy, bvz, fvo_yz, id_stg_right )
1252          CALL stg_generate_seed_yz( nwy, nwz, bwy, bwz, fwo_yz, id_stg_right )
1253!     
1254!--       Generate turbulence at north boundary
1255          CALL stg_generate_seed_xz( nux, nuz, bux, buz, fuo_xz, id_stg_north )
1256          CALL stg_generate_seed_xz( nvx, nvz, bvx, bvz, fvo_xz, id_stg_north )
1257          CALL stg_generate_seed_xz( nwx, nwz, bwx, bwz, fwo_xz, id_stg_north )
1258!     
1259!--       Generate turbulence at south boundary
1260          CALL stg_generate_seed_xz( nux, nuz, bux, buz, fuo_xz, id_stg_south )
1261          CALL stg_generate_seed_xz( nvx, nvz, bvx, bvz, fvo_xz, id_stg_south )
1262          CALL stg_generate_seed_xz( nwx, nwz, bwx, bwz, fwo_xz, id_stg_south )
1263       ENDIF
1264    ENDIF
1265   
1266!
1267!-- Turbulence generation at left and or right boundary
1268    IF ( myidx == id_stg_left  .OR.  myidx == id_stg_right )  THEN
1269!
1270!--    Calculate new set of perturbations. Do this only at last RK3-substep and
1271!--    when dt_stg_call is exceeded. Else the old set of perturbations is
1272!--    imposed
1273       IF ( stg_call )  THEN
1274       
1275          DO  j = nysg, nyng
1276             DO  k = nzb, nzt + 1
1277!     
1278!--             Update fu, fv, fw following Eq. 14 of Xie and Castro (2008)
1279                IF ( tu(k) == 0.0_wp )  THEN
1280                   fu_yz(k,j) = fuo_yz(k,j)
1281                ELSE
1282                   fu_yz(k,j) = fu_yz(k,j) * EXP( -pi * dt_stg * 0.5_wp / tu(k) ) + &
1283                            fuo_yz(k,j) * SQRT( 1.0_wp - EXP( -pi * dt_stg / tu(k) ) )
1284                ENDIF
1285       
1286                IF ( tv(k) == 0.0_wp )  THEN
1287                   fv_yz(k,j) = fvo_yz(k,j)
1288                ELSE
1289                   fv_yz(k,j) = fv_yz(k,j) * EXP( -pi * dt_stg * 0.5_wp / tv(k) ) + &
1290                            fvo_yz(k,j) * SQRT( 1.0_wp - EXP( -pi * dt_stg / tv(k) ) )
1291                ENDIF
1292       
1293                IF ( tw(k) == 0.0_wp )  THEN
1294                   fw_yz(k,j) = fwo_yz(k,j)
1295                ELSE
1296                   fw_yz(k,j) = fw_yz(k,j) * EXP( -pi * dt_stg * 0.5_wp / tw(k) ) + &
1297                            fwo_yz(k,j) * SQRT( 1.0_wp - EXP( -pi * dt_stg / tw(k) ) )
1298                ENDIF
1299             ENDDO
1300          ENDDO
1301         
1302          dist_yz(nzb,:,1) = 0.0_wp
1303          dist_yz(nzb,:,2) = 0.0_wp
1304          dist_yz(nzb,:,3) = 0.0_wp
1305         
1306          IF ( myidx == id_stg_left  )  i = nxl
1307          IF ( myidx == id_stg_right )  i = nxr+1       
1308          DO  j = nysg, nyng
1309             DO  k = nzb+1, nzt + 1
1310!     
1311!--             Lund rotation following Eq. 17 in Xie and Castro (2008).
1312!--             Additional factors are added to improve the variance of v and w
1313                dist_yz(k,j,1) = MIN( a11(k) * fu_yz(k,j), 3.0_wp ) *          &
1314                                    MERGE( 1.0_wp, 0.0_wp,                     &
1315                                           BTEST( wall_flags_0(k,j,i), 1 ) )   
1316             ENDDO
1317          ENDDO
1318         
1319          IF ( myidx == id_stg_left  )  i = nxl-1
1320          IF ( myidx == id_stg_right )  i = nxr+1
1321          DO  j = nysg, nyng
1322             DO  k = nzb+1, nzt + 1
1323!     
1324!--             Lund rotation following Eq. 17 in Xie and Castro (2008).
1325!--             Additional factors are added to improve the variance of v and w
1326!--             experimental test of 1.2                                       
1327                dist_yz(k,j,2) = MIN( ( SQRT( a22(k) / MAXVAL(a22) )           &
1328                                      * 1.2_wp )                               &
1329                                     * (   a21(k) * fu_yz(k,j)                 &
1330                                         + a22(k) * fv_yz(k,j) ), 3.0_wp ) *   &
1331                                    MERGE( 1.0_wp, 0.0_wp,                     &
1332                                           BTEST( wall_flags_0(k,j,i), 2 ) )   
1333                dist_yz(k,j,3) = MIN( ( SQRT(a33(k) / MAXVAL(a33) )            &
1334                                      * 1.3_wp )                               &
1335                                    * (   a31(k) * fu_yz(k,j)                  &
1336                                        + a32(k) * fv_yz(k,j)                  &
1337                                        + a33(k) * fw_yz(k,j) ), 3.0_wp )  *   &
1338                                    MERGE( 1.0_wp, 0.0_wp,                     &
1339                                           BTEST( wall_flags_0(k,j,i), 3 ) )
1340             ENDDO
1341          ENDDO
1342       ENDIF
1343
1344!
1345!--    Mass flux correction following Kim et al. (2013)
1346!--    This correction factor insures that the mass flux is preserved at the
1347!--    inflow boundary. First, calculate mean value of the imposed
1348!--    perturbations at yz boundary.
1349!--    Note, this needs to be done only after the last RK3-substep, else
1350!--    the boundary values won't be accessed.
1351       IF ( intermediate_timestep_count == intermediate_timestep_count_max )  THEN
1352          mc_factor_l   = 0.0_wp
1353          mc_factor     = 0.0_wp
1354!       
1355!--       Sum up the original volume flows (with and without perturbations).
1356!--       Note, for non-normal components (here v and w) it is actually no
1357!--       volume flow.
1358          IF ( myidx == id_stg_left  )  i = nxl
1359          IF ( myidx == id_stg_right )  i = nxr+1
1360         
1361          mc_factor_l(1) = SUM( dist_yz(nzb:nzt,nys:nyn,1)                     &
1362                         * MERGE( 1.0_wp, 0.0_wp,                              &
1363                                  BTEST( wall_flags_0(nzb:nzt,nys:nyn,i), 1 ) ) )
1364       
1365          IF ( myidx == id_stg_left  )  i = nxl-1
1366          IF ( myidx == id_stg_right )  i = nxr+1
1367         
1368          mc_factor_l(2) = SUM( dist_yz(nzb:nzt,nysv:nyn,2)                    &
1369                          * MERGE( 1.0_wp, 0.0_wp,                             &
1370                                   BTEST( wall_flags_0(nzb:nzt,nysv:nyn,i), 2 ) ) )
1371          mc_factor_l(3) = SUM( dist_yz(nzb:nzt,nys:nyn,3)                     &
1372                          * MERGE( 1.0_wp, 0.0_wp,                             &
1373                                   BTEST( wall_flags_0(nzb:nzt,nys:nyn,i), 3 ) ) )
1374         
1375#if defined( __parallel )
1376          CALL MPI_ALLREDUCE( mc_factor_l, mc_factor,                          &
1377                              3, MPI_REAL, MPI_SUM, comm1dy, ierr )           
1378#else                                                                         
1379          mc_factor   = mc_factor_l                                           
1380#endif
1381!     
1382!--       Calculate correction factor and force zero mean perturbations.
1383          mc_factor = mc_factor / REAL( nr_non_topo_yz, KIND = wp )           
1384                                                                               
1385          IF ( myidx == id_stg_left  )  i = nxl                               
1386          IF ( myidx == id_stg_right )  i = nxr+1                             
1387                                                                               
1388          dist_yz(:,:,1) = ( dist_yz(:,:,1) - mc_factor(1) )                   &
1389                        * MERGE( 1.0_wp, 0.0_wp,                               &
1390                                 BTEST( wall_flags_0(:,:,i), 1 ) )             
1391                                                                               
1392                                                                               
1393          IF ( myidx == id_stg_left  )  i = nxl-1                             
1394          IF ( myidx == id_stg_right )  i = nxr+1                             
1395                                                                               
1396          dist_yz(:,:,2) = ( dist_yz(:,:,2) - mc_factor(2) )                   &
1397                        * MERGE( 1.0_wp, 0.0_wp,                               &
1398                                 BTEST( wall_flags_0(:,:,i), 2 ) )             
1399                                                                               
1400          dist_yz(:,:,3) = ( dist_yz(:,:,3) - mc_factor(3) )                   &
1401                        * MERGE( 1.0_wp, 0.0_wp,                               &
1402                                 BTEST( wall_flags_0(:,:,i), 3 ) )
1403!     
1404!--       Add disturbances
1405          IF ( myidx == id_stg_left  )  THEN
1406!     
1407!--          For the left boundary distinguish between mesoscale offline / self
1408!--          nesting and turbulent inflow at the left boundary only. In the latter
1409!--          case turbulence is imposed on the mean inflow profiles.
1410             IF ( .NOT. nesting_offline  .AND.  .NOT. child_domain )  THEN 
1411!           
1412!--             Add disturbance at the inflow
1413                DO  j = nysg, nyng
1414                   DO  k = nzb, nzt+1
1415                      u(k,j,-nbgp+1:0) = ( mean_inflow_profiles(k,1) +         &
1416                                           dist_yz(k,j,1)             )        &
1417                                   * MERGE( 1.0_wp, 0.0_wp,                    &
1418                                            BTEST( wall_flags_0(k,j,0), 1 ) ) 
1419                      v(k,j,-nbgp:-1)  = ( mean_inflow_profiles(k,2) +         &
1420                                           dist_yz(k,j,2)             )        &
1421                                   * MERGE( 1.0_wp, 0.0_wp,                    &
1422                                            BTEST( wall_flags_0(k,j,-1), 2 ) ) 
1423                      w(k,j,-nbgp:-1)  =   dist_yz(k,j,3)                      &
1424                                   * MERGE( 1.0_wp, 0.0_wp,                    &
1425                                            BTEST( wall_flags_0(k,j,-1), 3 ) )
1426                   ENDDO
1427                ENDDO
1428             ELSE
1429             
1430                DO  j = nys, nyn
1431                   DO  k = nzb+1, nzt
1432                      u(k,j,0)   = ( u(k,j,0) + dist_yz(k,j,1) )               &
1433                                 * MERGE( 1.0_wp, 0.0_wp,                      &
1434                                          BTEST( wall_flags_0(k,j,0), 1 ) )
1435                      u(k,j,-1)  = u(k,j,0)
1436                      v(k,j,-1)  = ( v(k,j,-1)  + dist_yz(k,j,2)  )            &
1437                                 * MERGE( 1.0_wp, 0.0_wp,                      &
1438                                          BTEST( wall_flags_0(k,j,-1), 2 ) )
1439                      w(k,j,-1)  = ( w(k,j,-1)  + dist_yz(k,j,3) )             &
1440                                 * MERGE( 1.0_wp, 0.0_wp,                      &
1441                                          BTEST( wall_flags_0(k,j,-1), 3 ) )
1442                   ENDDO
1443                ENDDO
1444             ENDIF
1445          ENDIF
1446          IF ( myidx == id_stg_right  )  THEN
1447             DO  j = nys, nyn
1448                DO  k = nzb+1, nzt
1449                   u(k,j,nxr+1) = ( u(k,j,nxr+1) + dist_yz(k,j,1) )            &
1450                                  * MERGE( 1.0_wp, 0.0_wp,                     &
1451                                           BTEST( wall_flags_0(k,j,nxr+1), 1 ) ) 
1452                   v(k,j,nxr+1) = ( v(k,j,nxr+1) + dist_yz(k,j,2) )            &
1453                                  * MERGE( 1.0_wp, 0.0_wp,                     &
1454                                           BTEST( wall_flags_0(k,j,nxr+1), 2 ) )
1455                   w(k,j,nxr+1) = ( w(k,j,nxr+1) + dist_yz(k,j,3) )            &
1456                                  * MERGE( 1.0_wp, 0.0_wp,                     &
1457                                           BTEST( wall_flags_0(k,j,nxr+1), 3 ) )
1458                ENDDO
1459             ENDDO
1460          ENDIF
1461       ENDIF
1462    ENDIF
1463!
1464!-- Turbulence generation at north and south boundary
1465    IF ( myidy == id_stg_north  .OR.  myidy == id_stg_south )  THEN
1466!
1467!--    Calculate new set of perturbations. Do this only at last RK3-substep and
1468!--    when dt_stg_call is exceeded. Else the old set of perturbations is
1469!--    imposed
1470       IF ( stg_call )  THEN
1471          DO  i = nxlg, nxrg
1472             DO  k = nzb, nzt + 1
1473!         
1474!--             Update fu, fv, fw following Eq. 14 of Xie and Castro (2008)
1475                IF ( tu(k) == 0.0_wp )  THEN
1476                   fu_xz(k,i) = fuo_xz(k,i)
1477                ELSE
1478                   fu_xz(k,i) = fu_xz(k,i) * EXP( -pi * dt_stg * 0.5_wp / tu(k) ) +     &
1479                            fuo_xz(k,i) * SQRT( 1.0_wp - EXP( -pi * dt_stg / tu(k) ) )
1480                ENDIF
1481         
1482                IF ( tv(k) == 0.0_wp )  THEN
1483                   fv_xz(k,i) = fvo_xz(k,i)
1484                ELSE
1485                   fv_xz(k,i) = fv_xz(k,i) * EXP( -pi * dt_stg * 0.5_wp / tv(k) ) +     &
1486                         fvo_xz(k,i) * SQRT( 1.0_wp - EXP( -pi * dt_stg / tv(k) ) )
1487                ENDIF
1488               
1489                IF ( tw(k) == 0.0_wp )  THEN
1490                   fw_xz(k,i) = fwo_xz(k,i)
1491                ELSE
1492                   fw_xz(k,i) = fw_xz(k,i) * EXP( -pi * dt_stg * 0.5_wp / tw(k) ) +     &
1493                         fwo_xz(k,i) * SQRT( 1.0_wp - EXP( -pi * dt_stg / tw(k) ) )
1494                ENDIF
1495             ENDDO
1496          ENDDO
1497         
1498         
1499          dist_xz(nzb,:,1) = 0.0_wp
1500          dist_xz(nzb,:,2) = 0.0_wp
1501          dist_xz(nzb,:,3) = 0.0_wp
1502         
1503          IF ( myidy == id_stg_south  ) j = nys
1504          IF ( myidy == id_stg_north )  j = nyn+1
1505          DO  i = nxlg, nxrg
1506             DO  k = nzb+1, nzt + 1
1507!         
1508!--             Lund rotation following Eq. 17 in Xie and Castro (2008).
1509!--             Additional factors are added to improve the variance of v and w
1510                !experimental test of 1.2                                         
1511                dist_xz(k,i,2) = MIN( ( SQRT( a22(k) / MAXVAL(a22) )           &
1512                                      * 1.2_wp )                               &
1513                                     * (   a21(k) * fu_xz(k,i)                 &
1514                                         + a22(k) * fv_xz(k,i) ), 3.0_wp ) *   &
1515                                    MERGE( 1.0_wp, 0.0_wp,                     &
1516                                           BTEST( wall_flags_0(k,j,i), 2 ) )   
1517             ENDDO
1518          ENDDO
1519         
1520          IF ( myidy == id_stg_south  ) j = nys-1
1521          IF ( myidy == id_stg_north )  j = nyn+1
1522          DO  i = nxlg, nxrg
1523             DO  k = nzb+1, nzt + 1
1524!         
1525!--             Lund rotation following Eq. 17 in Xie and Castro (2008).
1526!--             Additional factors are added to improve the variance of v and w
1527                dist_xz(k,i,1) = MIN( a11(k) * fu_xz(k,i), 3.0_wp ) *          &
1528                                    MERGE( 1.0_wp, 0.0_wp,                     &
1529                                           BTEST( wall_flags_0(k,j,i), 1 ) )   
1530         
1531                dist_xz(k,i,3) = MIN( ( SQRT(a33(k) / MAXVAL(a33) )            &
1532                                      * 1.3_wp )                               &
1533                                    * (   a31(k) * fu_xz(k,i)                  &
1534                                        + a32(k) * fv_xz(k,i)                  &
1535                                        + a33(k) * fw_xz(k,i) ), 3.0_wp )  *   &
1536                                    MERGE( 1.0_wp, 0.0_wp,                     &
1537                                           BTEST( wall_flags_0(k,j,i), 3 ) ) 
1538             ENDDO
1539          ENDDO
1540       ENDIF
1541
1542!
1543!--    Mass flux correction following Kim et al. (2013)
1544!--    This correction factor insures that the mass flux is preserved at the
1545!--    inflow boundary. First, calculate mean value of the imposed
1546!--    perturbations at yz boundary.
1547!--    Note, this needs to be done only after the last RK3-substep, else
1548!--    the boundary values won't be accessed.
1549       IF ( intermediate_timestep_count == intermediate_timestep_count_max )  THEN
1550          mc_factor_l   = 0.0_wp
1551          mc_factor     = 0.0_wp
1552         
1553          IF ( myidy == id_stg_south  ) j = nys
1554          IF ( myidy == id_stg_north )  j = nyn+1
1555         
1556          mc_factor_l(2) = SUM( dist_xz(nzb:nzt,nxl:nxr,2)                     &
1557                         * MERGE( 1.0_wp, 0.0_wp,                              &
1558                                  BTEST( wall_flags_0(nzb:nzt,j,nxl:nxr), 2 ) ) )
1559         
1560          IF ( myidy == id_stg_south  ) j = nys-1
1561          IF ( myidy == id_stg_north )  j = nyn+1
1562         
1563          mc_factor_l(1) = SUM( dist_xz(nzb:nzt,nxlu:nxr,1)                    &
1564                         * MERGE( 1.0_wp, 0.0_wp,                              &
1565                                  BTEST( wall_flags_0(nzb:nzt,j,nxlu:nxr), 1 ) ) )
1566          mc_factor_l(3) = SUM( dist_xz(nzb:nzt,nxl:nxr,3)                     &
1567                         * MERGE( 1.0_wp, 0.0_wp,                              &
1568                                  BTEST( wall_flags_0(nzb:nzt,j,nxl:nxr), 3 ) ) )
1569         
1570#if defined( __parallel )
1571          CALL MPI_ALLREDUCE( mc_factor_l, mc_factor,                          &
1572                              3, MPI_REAL, MPI_SUM, comm1dx, ierr )
1573#else     
1574          mc_factor   = mc_factor_l
1575#endif
1576         
1577          mc_factor = mc_factor / REAL( nr_non_topo_xz, KIND = wp )
1578         
1579          IF ( myidy == id_stg_south  ) j = nys
1580          IF ( myidy == id_stg_north )  j = nyn+1
1581         
1582          dist_xz(:,:,2)   = ( dist_xz(:,:,2) - mc_factor(2) )                 &
1583                           * MERGE( 1.0_wp, 0.0_wp,                            &
1584                                    BTEST( wall_flags_0(:,j,:), 2 ) )         
1585                                                                               
1586                                                                               
1587          IF ( myidy == id_stg_south  ) j = nys-1                             
1588          IF ( myidy == id_stg_north )  j = nyn+1                             
1589                                                                               
1590          dist_xz(:,:,1)   = ( dist_xz(:,:,1) - mc_factor(1) )                 &
1591                           * MERGE( 1.0_wp, 0.0_wp,                            &
1592                                    BTEST( wall_flags_0(:,j,:), 1 ) )         
1593                                                                               
1594          dist_xz(:,:,3)   = ( dist_xz(:,:,3) - mc_factor(3) )                 &
1595                           * MERGE( 1.0_wp, 0.0_wp,                            &
1596                                    BTEST( wall_flags_0(:,j,:), 3 ) )     
1597!         
1598!--       Add disturbances
1599          IF ( myidy == id_stg_south  )  THEN
1600             DO  i = nxl, nxr
1601                DO  k = nzb+1, nzt
1602                   u(k,-1,i) = ( u(k,-1,i) + dist_xz(k,i,1) )                  &
1603                                        * MERGE( 1.0_wp, 0.0_wp,               &
1604                                                 BTEST( wall_flags_0(k,-1,i), 1 ) )
1605                   v(k,0,i)  = ( v(k,0,i)  + dist_xz(k,i,2)  )                 &
1606                                        * MERGE( 1.0_wp, 0.0_wp,               &
1607                                                 BTEST( wall_flags_0(k,0,i), 2 ) )
1608                   v(k,-1,i) = v(k,0,i)
1609                   w(k,-1,i) = ( w(k,-1,i) + dist_xz(k,i,3)  )                 &
1610                                        * MERGE( 1.0_wp, 0.0_wp,               &
1611                                                 BTEST( wall_flags_0(k,-1,i), 3 ) )
1612                ENDDO
1613             ENDDO
1614          ENDIF
1615          IF ( myidy == id_stg_north  )  THEN
1616         
1617             DO  i = nxl, nxr
1618                DO  k = nzb+1, nzt
1619                   u(k,nyn+1,i) = ( u(k,nyn+1,i) + dist_xz(k,i,1) )            &
1620                                     * MERGE( 1.0_wp, 0.0_wp,                  &
1621                                             BTEST( wall_flags_0(k,nyn+1,i), 1 ) )
1622                   v(k,nyn+1,i) = ( v(k,nyn+1,i) + dist_xz(k,i,2) )            &
1623                                     * MERGE( 1.0_wp, 0.0_wp,                  &
1624                                              BTEST( wall_flags_0(k,nyn+1,i), 2 ) )
1625                   w(k,nyn+1,i) = ( w(k,nyn+1,i) + dist_xz(k,i,3) )            &
1626                                     * MERGE( 1.0_wp, 0.0_wp,                  &
1627                                              BTEST( wall_flags_0(k,nyn+1,i), 3 ) )
1628                ENDDO
1629             ENDDO
1630          ENDIF
1631       ENDIF
1632    ENDIF
1633!
1634!-- Finally, set time counter for calling STG to zero
1635    IF ( stg_call )  time_stg_call = 0.0_wp
1636
1637    IF ( debug_output_timestep )  CALL debug_message( 'stg_main', 'end' )
1638
1639 END SUBROUTINE stg_main
1640
1641!------------------------------------------------------------------------------!
1642! Description:
1643! ------------
1644!> Generate a set of random number rand_it wich is equal on each PE
1645!> and calculate the velocity seed f_n.
1646!> f_n is splitted in vertical direction by the number of PEs in x-direction and
1647!> and each PE calculates a vertical subsection of f_n. At the the end, all
1648!> parts are collected to form the full array.
1649!------------------------------------------------------------------------------!
1650 SUBROUTINE stg_generate_seed_yz( n_y, n_z, b_y, b_z, f_n, id )
1651
1652    IMPLICIT NONE
1653
1654    INTEGER(iwp) :: id          !< core ids at respective boundaries
1655    INTEGER(iwp) :: j           !< loop index in y-direction
1656    INTEGER(iwp) :: jj          !< loop index in y-direction
1657    INTEGER(iwp) :: k           !< loop index in z-direction
1658    INTEGER(iwp) :: kk          !< loop index in z-direction
1659    INTEGER(iwp) :: send_count  !< send count for MPI_GATHERV
1660
1661    INTEGER(iwp), DIMENSION(nzb:nzt+1) :: n_y    !< length scale in y-direction
1662    INTEGER(iwp), DIMENSION(nzb:nzt+1) :: n_z    !< length scale in z-direction
1663    INTEGER(iwp), DIMENSION(nzb:nzt+1) :: n_y2   !< n_y*2
1664    INTEGER(iwp), DIMENSION(nzb:nzt+1) :: n_z2   !< n_z*2
1665
1666    REAL(wp) :: nyz_inv         !< inverse of number of grid points in yz-slice
1667    REAL(wp) :: rand_av         !< average of random number
1668    REAL(wp) :: rand_sigma_inv  !< inverse of stdev of random number
1669
1670    REAL(wp), DIMENSION(-merg:merg,nzb:nzt+1)    :: b_y     !< filter function in y-direction
1671    REAL(wp), DIMENSION(-merg:merg,nzb:nzt+1)    :: b_z     !< filter function in z-direction
1672    REAL(wp), DIMENSION(nzb_x_stg:nzt_x_stg+1,nysg:nyng) :: f_n_l   !<  local velocity seed
1673    REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng)     :: f_n     !<  velocity seed
1674    REAL(wp), DIMENSION(:,:), ALLOCATABLE        :: rand_it !<  random number
1675
1676
1677!
1678!-- Generate random numbers using a seed generated in stg_init.
1679!-- The set of random numbers are modified to have an average of 0 and
1680!-- unit variance.
1681    ALLOCATE( rand_it(nzb-mergp:nzt+1+mergp,-mergp:ny+mergp) )
1682
1683    rand_av        = 0.0_wp
1684    rand_sigma_inv = 0.0_wp
1685    nyz_inv        = 1.0_wp / REAL( ( nzt+1 - nzb+1 ) * ( ny+1 ), KIND=wp )
1686
1687    DO  j = 0, ny
1688       DO  k = nzb, nzt+1
1689          CALL RANDOM_NUMBER( rand_it(k,j) )
1690          rand_av = rand_av + rand_it(k,j)
1691       ENDDO
1692    ENDDO
1693
1694    rand_av = rand_av * nyz_inv
1695
1696    DO  j = 0, ny
1697       DO  k = nzb, nzt+1
1698          rand_it(k,j)   = rand_it(k,j) - rand_av
1699          rand_sigma_inv = rand_sigma_inv + rand_it(k,j) ** 2
1700       ENDDO
1701    ENDDO
1702
1703    rand_sigma_inv = 1.0_wp / SQRT(rand_sigma_inv * nyz_inv)
1704
1705    DO  j = 0, ny
1706       DO  k = nzb, nzt+1
1707          rand_it(k,j) = rand_it(k,j) * rand_sigma_inv
1708       ENDDO
1709    ENDDO
1710
1711!
1712!-- Periodic fill of random number in space
1713    DO  j = 0, ny
1714       DO  k = 1, mergp
1715          rand_it(nzb  -k,j) = rand_it(nzt+2-k,j)    ! bottom margin
1716          rand_it(nzt+1+k,j) = rand_it(nzb+k-1,j)    ! top margin
1717       ENDDO
1718    ENDDO
1719    DO  j = 1, mergp
1720       DO  k = nzb-mergp, nzt+1+mergp
1721          rand_it(k,  -j) = rand_it(k,ny-j+1)        ! south margin
1722          rand_it(k,ny+j) = rand_it(k,   j-1)        ! north margin
1723       ENDDO
1724    ENDDO
1725
1726!
1727!-- Generate velocity seed following Eq.6 of Xie and Castro (2008)
1728    n_y2 = n_y * 2
1729    n_z2 = n_z * 2
1730    f_n_l  = 0.0_wp
1731
1732    DO  j = nysg, nyng
1733       DO  k = nzb_x_stg, nzt_x_stg+1
1734          DO  jj = -n_y2(k), n_y2(k)
1735             DO  kk = -n_z2(k), n_z2(k)
1736                f_n_l(k,j) = f_n_l(k,j)                                        &
1737                           + b_y(jj,k) * b_z(kk,k) * rand_it(k+kk,j+jj)
1738             ENDDO
1739          ENDDO
1740       ENDDO
1741    ENDDO
1742
1743    DEALLOCATE( rand_it )
1744!
1745!-- Gather velocity seeds of full subdomain
1746    send_count = nzt_x_stg - nzb_x_stg + 1
1747    IF ( nzt_x_stg == nzt )  send_count = send_count + 1
1748
1749#if defined( __parallel )
1750    CALL MPI_GATHERV( f_n_l(nzb_x_stg,nysg), send_count, stg_type_yz_small,    &
1751                      f_n(nzb+1,nysg), recv_count_yz, displs_yz, stg_type_yz,  &
1752                      id, comm1dx, ierr )
1753#else
1754    f_n(nzb+1:nzt+1,nysg:nyng) = f_n_l(nzb_x_stg:nzt_x_stg+1,nysg:nyng)
1755#endif
1756
1757
1758 END SUBROUTINE stg_generate_seed_yz
1759
1760
1761
1762
1763!------------------------------------------------------------------------------!
1764! Description:
1765! ------------
1766!> Generate a set of random number rand_it wich is equal on each PE
1767!> and calculate the velocity seed f_n.
1768!> f_n is splitted in vertical direction by the number of PEs in y-direction and
1769!> and each PE calculates a vertical subsection of f_n. At the the end, all
1770!> parts are collected to form the full array.
1771!------------------------------------------------------------------------------!
1772 SUBROUTINE stg_generate_seed_xz( n_x, n_z, b_x, b_z, f_n, id )
1773
1774    IMPLICIT NONE
1775
1776    INTEGER(iwp) :: id          !< core ids at respective boundaries
1777    INTEGER(iwp) :: i           !< loop index in x-direction
1778    INTEGER(iwp) :: ii          !< loop index in x-direction
1779    INTEGER(iwp) :: k           !< loop index in z-direction
1780    INTEGER(iwp) :: kk          !< loop index in z-direction
1781    INTEGER(iwp) :: send_count  !< send count for MPI_GATHERV
1782
1783    INTEGER(iwp), DIMENSION(nzb:nzt+1) :: n_x    !< length scale in x-direction
1784    INTEGER(iwp), DIMENSION(nzb:nzt+1) :: n_z    !< length scale in z-direction
1785    INTEGER(iwp), DIMENSION(nzb:nzt+1) :: n_x2   !< n_x*2
1786    INTEGER(iwp), DIMENSION(nzb:nzt+1) :: n_z2   !< n_z*2
1787
1788    REAL(wp) :: nxz_inv         !< inverse of number of grid points in xz-slice
1789    REAL(wp) :: rand_av         !< average of random number
1790    REAL(wp) :: rand_sigma_inv  !< inverse of stdev of random number
1791
1792    REAL(wp), DIMENSION(-merg:merg,nzb:nzt+1)    :: b_x     !< filter function in x-direction
1793    REAL(wp), DIMENSION(-merg:merg,nzb:nzt+1)    :: b_z     !< filter function in z-direction
1794    REAL(wp), DIMENSION(nzb_y_stg:nzt_y_stg+1,nxlg:nxrg) :: f_n_l   !<  local velocity seed
1795    REAL(wp), DIMENSION(nzb:nzt+1,nxlg:nxrg)     :: f_n     !<  velocity seed
1796    REAL(wp), DIMENSION(:,:), ALLOCATABLE        :: rand_it !<  random number
1797
1798
1799!
1800!-- Generate random numbers using a seed generated in stg_init.
1801!-- The set of random numbers are modified to have an average of 0 and
1802!-- unit variance.
1803    ALLOCATE( rand_it(nzb-mergp:nzt+1+mergp,-mergp:nx+mergp) )
1804
1805    rand_av        = 0.0_wp
1806    rand_sigma_inv = 0.0_wp
1807    nxz_inv        = 1.0_wp / REAL( ( nzt+1 - nzb+1 ) * ( nx+1 ), KIND=wp )
1808
1809    DO  i = 0, nx
1810       DO  k = nzb, nzt+1
1811          CALL RANDOM_NUMBER( rand_it(k,i) )
1812          rand_av = rand_av + rand_it(k,i)
1813       ENDDO
1814    ENDDO
1815
1816    rand_av = rand_av * nxz_inv
1817
1818    DO  i = 0, nx
1819       DO  k = nzb, nzt+1
1820          rand_it(k,i)   = rand_it(k,i) - rand_av
1821          rand_sigma_inv = rand_sigma_inv + rand_it(k,i) ** 2
1822       ENDDO
1823    ENDDO
1824
1825    rand_sigma_inv = 1.0_wp / SQRT(rand_sigma_inv * nxz_inv)
1826
1827    DO  i = 0, nx
1828       DO  k = nzb, nzt+1
1829          rand_it(k,i) = rand_it(k,i) * rand_sigma_inv
1830       ENDDO
1831    ENDDO
1832
1833!
1834!-- Periodic fill of random number in space
1835    DO  i = 0, nx
1836       DO  k = 1, mergp
1837          rand_it(nzb-k,i)   = rand_it(nzt+2-k,i)    ! bottom margin
1838          rand_it(nzt+1+k,i) = rand_it(nzb+k-1,i)    ! top margin
1839       ENDDO
1840    ENDDO
1841    DO  i = 1, mergp
1842       DO  k = nzb-mergp, nzt+1+mergp
1843          rand_it(k,-i)   = rand_it(k,nx-i+1)        ! left margin
1844          rand_it(k,nx+i) = rand_it(k,i-1)           ! right margin
1845       ENDDO
1846    ENDDO
1847
1848!
1849!-- Generate velocity seed following Eq.6 of Xie and Castro (2008)
1850    n_x2 = n_x * 2
1851    n_z2 = n_z * 2
1852    f_n_l  = 0.0_wp
1853
1854    DO  i = nxlg, nxrg
1855       DO  k = nzb_y_stg, nzt_y_stg+1
1856          DO  ii = -n_x2(k), n_x2(k)
1857             DO  kk = -n_z2(k), n_z2(k)
1858                f_n_l(k,i) = f_n_l(k,i)                                        &
1859                           + b_x(ii,k) * b_z(kk,k) * rand_it(k+kk,i+ii)
1860             ENDDO
1861          ENDDO
1862       ENDDO
1863    ENDDO
1864
1865    DEALLOCATE( rand_it )
1866
1867!
1868!-- Gather velocity seeds of full subdomain
1869    send_count = nzt_y_stg - nzb_y_stg + 1
1870    IF ( nzt_y_stg == nzt )  send_count = send_count + 1
1871
1872
1873#if defined( __parallel )
1874    CALL MPI_GATHERV( f_n_l(nzb_y_stg,nxlg), send_count, stg_type_xz_small,    &
1875                      f_n(nzb+1,nxlg), recv_count_xz, displs_xz, stg_type_xz,  &
1876                      id, comm1dy, ierr )
1877#else
1878    f_n(nzb+1:nzt+1,nxlg:nxrg) = f_n_l(nzb_y_stg:nzt_y_stg+1,nxlg:nxrg)
1879#endif
1880
1881
1882 END SUBROUTINE stg_generate_seed_xz
1883
1884!------------------------------------------------------------------------------!
1885! Description:
1886! ------------
1887!> Parametrization of the Reynolds stress tensor, following the parametrization
1888!> described in Rotach et al. (1996), which is applied in state-of-the-art
1889!> dispserion modelling. Please note, the parametrization does not distinguish
1890!> between along-wind and cross-wind turbulence.
1891!------------------------------------------------------------------------------!
1892 SUBROUTINE parametrize_reynolds_stress
1893
1894    IMPLICIT NONE
1895
1896    INTEGER(iwp) :: k            !< loop index in z-direction
1897   
1898    REAL(wp)     ::  zzi         !< ratio of z/zi
1899   
1900    DO  k = nzb+1, nzt+1
1901!
1902!--    Calculate function to gradually decrease Reynolds stress above ABL top.
1903!--    The function decreases to 1/10 after one length scale above the
1904!--    ABL top.
1905       blend = MIN( 1.0_wp, EXP( d_l * zu(k) - d_l * zi_ribulk ) )
1906!
1907!--    Determine normalized height coordinate
1908       zzi = zu(k) / zi_ribulk
1909!
1910!--    u'u' and v'v'. Assume isotropy. Note, add a small negative number
1911!--    to the denominator, else the merge-function can crash if scale_l is
1912!--    zero.
1913       r11(k) = scale_us**2 * (                                                &
1914                   MERGE( 0.35_wp * ABS(                                       &
1915                        - zi_ribulk / ( kappa * scale_l - 10E-4_wp )           &
1916                                       )**( 2.0_wp / 3.0_wp ),                 &
1917                          0.0_wp,                                              &
1918                          scale_l < 0.0_wp )                                   &
1919                 + 5.0_wp - 4.0_wp * zzi                                       &
1920                              ) * blend                                       
1921                                                                               
1922       r22(k) = r11(k)                                                         
1923!                                                                             
1924!--    w'w'                                                                   
1925       r33(k) = scale_wm**2 * (                                                &
1926                   1.5_wp * zzi**( 2.0_wp / 3.0_wp ) * EXP( -2.0_wp * zzi )    &
1927                 + ( 1.7_wp - zzi ) * ( scale_us / scale_wm )**2               &                     
1928                              )  * blend                                       
1929!                                                                             
1930!--    u'w' and v'w'. Assume isotropy.                                         
1931       r31(k) = - scale_us**2 * ( 1.01_wp - MIN( zzi, 1.0_wp ) ) * blend
1932       r32(k) = r31(k)
1933!
1934!--    For u'v' no parametrization exist so far - ?. For simplicity assume
1935!--    a similar profile as for u'w'.
1936       r21(k) = r31(k)
1937    ENDDO
1938
1939!
1940!-- Set bottom boundary condition   
1941    r11(nzb) = r11(nzb+1)
1942    r22(nzb) = r22(nzb+1)
1943    r33(nzb) = r33(nzb+1)
1944
1945    r21(nzb) = r11(nzb+1)
1946    r31(nzb) = r31(nzb+1)
1947    r32(nzb) = r32(nzb+1)
1948   
1949
1950 END SUBROUTINE parametrize_reynolds_stress 
1951 
1952!------------------------------------------------------------------------------!
1953! Description:
1954! ------------
1955!> Calculate the coefficient matrix from the Lund rotation.
1956!------------------------------------------------------------------------------!
1957 SUBROUTINE calc_coeff_matrix
1958
1959    IMPLICIT NONE
1960
1961    INTEGER(iwp) :: k   !< loop index in z-direction
1962   
1963!
1964!-- Calculate coefficient matrix. Split loops to allow for loop vectorization.
1965    DO  k = nzb+1, nzt+1
1966       IF ( r11(k) > 10E-6_wp )  THEN
1967          a11(k) = SQRT( r11(k) ) 
1968          a21(k) = r21(k) / a11(k)
1969          a31(k) = r31(k) / a11(k)
1970       ELSE
1971          a11(k) = 10E-8_wp
1972          a21(k) = 10E-8_wp
1973          a31(k) = 10E-8_wp
1974       ENDIF
1975    ENDDO
1976    DO  k = nzb+1, nzt+1
1977       a22(k) = r22(k) - a21(k)**2 
1978       IF ( a22(k) > 10E-6_wp )  THEN
1979          a22(k) = SQRT( a22(k) )
1980          a32(k) = r32(k) - a21(k) * a31(k) / a22(k)
1981       ELSE
1982          a22(k) = 10E-8_wp
1983          a32(k) = 10E-8_wp
1984       ENDIF
1985    ENDDO
1986    DO  k = nzb+1, nzt+1
1987       a33(k) = r33(k) - a31(k)**2 - a32(k)**2
1988       IF ( a33(k) > 10E-6_wp )  THEN
1989          a33(k) =  SQRT( a33(k) )
1990       ELSE
1991          a33(k) = 10E-8_wp
1992       ENDIF
1993    ENDDO   
1994!
1995!-- Set bottom boundary condition
1996    a11(nzb) = a11(nzb+1)
1997    a22(nzb) = a22(nzb+1)
1998    a21(nzb) = a21(nzb+1)
1999    a33(nzb) = a33(nzb+1)   
2000    a31(nzb) = a31(nzb+1)
2001    a32(nzb) = a32(nzb+1)   
2002
2003 END SUBROUTINE calc_coeff_matrix
2004 
2005!------------------------------------------------------------------------------!
2006! Description:
2007! ------------
2008!> This routine controls the re-adjustment of the turbulence statistics used
2009!> for generating turbulence at the lateral boundaries. 
2010!------------------------------------------------------------------------------!
2011 SUBROUTINE stg_adjust
2012
2013    IMPLICIT NONE
2014
2015
2016    IF ( debug_output_timestep )  CALL debug_message( 'stg_adjust', 'start' )
2017!
2018!-- In case of dirichlet inflow boundary conditions only at one lateral
2019!-- boundary, i.e. in the case no offline or self nesting is applied but
2020!-- synthetic turbulence shall be parametrized nevertheless, the
2021!-- boundary-layer depth need to determined first.
2022    IF ( .NOT. nesting_offline  .AND.  .NOT.  child_domain )                   &
2023       CALL nesting_offl_calc_zi   
2024!
2025!-- Compute scaling parameters (domain-averaged), such as friction velocity
2026!-- are calculated.
2027    CALL calc_scaling_variables
2028!
2029!-- Set length and time scales depending on boundary-layer height
2030    CALL calc_length_and_time_scale
2031!
2032!-- Parametrize Reynolds-stress tensor, diagonal elements as well
2033!-- as r21 (v'u'), r31 (w'u'), r32 (w'v'). Parametrization follows
2034!-- Rotach et al. (1996) and is based on boundary-layer depth,
2035!-- friction velocity and velocity scale.
2036    CALL parametrize_reynolds_stress
2037!
2038!-- Calculate coefficient matrix from Reynolds stress tensor 
2039!-- (Lund rotation)
2040    CALL calc_coeff_matrix
2041!
2042!-- Determine filter functions on basis of updated length scales
2043    CALL stg_filter_func( nux, bux ) !filter ux
2044    CALL stg_filter_func( nuy, buy ) !filter uy
2045    CALL stg_filter_func( nuz, buz ) !filter uz
2046    CALL stg_filter_func( nvx, bvx ) !filter vx
2047    CALL stg_filter_func( nvy, bvy ) !filter vy
2048    CALL stg_filter_func( nvz, bvz ) !filter vz
2049    CALL stg_filter_func( nwx, bwx ) !filter wx
2050    CALL stg_filter_func( nwy, bwy ) !filter wy
2051    CALL stg_filter_func( nwz, bwz ) !filter wz
2052!
2053!-- Reset time counter for controlling next adjustment to zero
2054    time_stg_adjust = 0.0_wp
2055
2056    IF ( debug_output_timestep )  CALL debug_message( 'stg_adjust', 'end' )
2057   
2058 END SUBROUTINE stg_adjust 
2059 
2060 
2061!------------------------------------------------------------------------------!
2062! Description:
2063! ------------
2064!> Calculates turbuluent length and time scales if these are not available
2065!> from measurements.
2066!------------------------------------------------------------------------------!
2067 SUBROUTINE calc_length_and_time_scale
2068
2069    IMPLICIT NONE
2070
2071
2072    INTEGER(iwp) ::  k !< loop index in z-direction
2073   
2074    REAL(wp) ::  length_scale_dum     !< effectively used length scale
2075   
2076!
2077!-- In initial call the boundary-layer depth can be zero. This case, set
2078!-- minimum value for boundary-layer depth, to setup length scales correctly.
2079    zi_ribulk = MAX( zi_ribulk, zw(nzb+2) )
2080!
2081!-- Set-up default turbulent length scales. From the numerical point of
2082!-- view the imposed perturbations should not be immediately dissipated
2083!-- by the numerics. The numerical dissipation, however, acts on scales
2084!-- up to 8 x the grid spacing. For this reason, set the turbulence
2085!-- length scale to 8 time the grid spacing. Further, above the boundary
2086!-- layer height, set turbulence lenght scales to zero (equivalent to not
2087!-- imposing any perturbations) in order to save computational costs.
2088!-- Typical time scales are derived by assuming Taylors's hypothesis,
2089!-- using the length scales and the mean profiles of u- and v-component.
2090    DO  k = nzb+1, nzt+1
2091!
2092!--    Determine blending parameter. Within the boundary layer length scales
2093!--    are constant, while above lengths scales approach gradully zero,
2094!--    i.e. imposed turbulence is not correlated in space and time,
2095!--    just white noise, which saves computations power as the loops for the
2096!--    computation of the filter functions depend on the length scales.
2097!--    The value decreases to 1/10 after one length scale above the
2098!--    ABL top.
2099       blend = MIN( 1.0_wp, EXP( d_l * zu(k) - d_l * zi_ribulk ) )
2100!
2101!--    Assume isotropic turbulence length scales
2102       nux(k) = MAX( INT( length_scale * ddx     ), 1 ) * blend
2103       nuy(k) = MAX( INT( length_scale * ddy     ), 1 ) * blend       
2104       nvx(k) = MAX( INT( length_scale * ddx     ), 1 ) * blend
2105       nvy(k) = MAX( INT( length_scale * ddy     ), 1 ) * blend       
2106       nwx(k) = MAX( INT( length_scale * ddx     ), 1 ) * blend
2107       nwy(k) = MAX( INT( length_scale * ddy     ), 1 ) * blend       
2108!
2109!--    Along the vertical direction limit the length scale further by the
2110!--    boundary-layer depth to assure that no length scales larger than
2111!--    the boundary-layer depth are used
2112       length_scale_dum = MIN( length_scale, zi_ribulk )
2113       
2114       nuz(k) = MAX( INT( length_scale_dum * ddzw(k) ), 1 ) * blend
2115       nvz(k) = MAX( INT( length_scale_dum * ddzw(k) ), 1 ) * blend
2116       nwz(k) = MAX( INT( length_scale_dum * ddzw(k) ), 1 ) * blend
2117!
2118!--    Limit time scales, else they become very larger for low wind speed,
2119!--    imposing long-living inflow perturbations which in turn propagate
2120!--    further into the model domain. Use u_init and v_init to calculate
2121!--    the time scales, which will be equal to the inflow profiles, both,
2122!--    in offline nesting mode or in dirichlet/radiation mode.
2123       tu(k)  = MIN( dt_stg_adjust, length_scale /                          &
2124                               ( ABS( u_init(k) ) + 0.1_wp ) ) * blend 
2125       tv(k)  = MIN( dt_stg_adjust, length_scale /                          &
2126                               ( ABS( v_init(k) ) + 0.1_wp ) ) * blend
2127!
2128!--    Time scale of w-component is a mixture from u- and v-component.
2129       tw(k)  = SQRT( tu(k)**2 + tv(k)**2 ) * blend
2130     
2131    ENDDO
2132!
2133!-- Set bottom boundary condition for the length and time scales
2134    nux(nzb) = nux(nzb+1)
2135    nuy(nzb) = nuy(nzb+1)
2136    nuz(nzb) = nuz(nzb+1)
2137    nvx(nzb) = nvx(nzb+1)
2138    nvy(nzb) = nvy(nzb+1)
2139    nvz(nzb) = nvz(nzb+1)
2140    nwx(nzb) = nwx(nzb+1)
2141    nwy(nzb) = nwy(nzb+1)
2142    nwz(nzb) = nwz(nzb+1)
2143
2144    tu(nzb)  = tu(nzb+1)
2145    tv(nzb)  = tv(nzb+1)
2146    tw(nzb)  = tw(nzb+1)
2147
2148
2149 END SUBROUTINE calc_length_and_time_scale 
2150
2151!------------------------------------------------------------------------------!
2152! Description:
2153! ------------
2154!> Calculate scaling variables which are used for turbulence parametrization
2155!> according to Rotach et al. (1996). Scaling variables are: friction velocity,
2156!> boundary-layer depth, momentum velocity scale, and Obukhov length.
2157!------------------------------------------------------------------------------!
2158 SUBROUTINE calc_scaling_variables
2159       
2160    USE surface_mod,                                                           &
2161        ONLY:  surf_def_h, surf_lsm_h, surf_usm_h
2162
2163    IMPLICIT NONE
2164
2165    INTEGER(iwp) :: i            !< loop index in x-direction
2166    INTEGER(iwp) :: j            !< loop index in y-direction
2167    INTEGER(iwp) :: k            !< loop index in z-direction
2168    INTEGER(iwp) :: m            !< surface element index
2169
2170    REAL(wp) ::  friction_vel_l         !< mean friction veloctiy on subdomain
2171    REAL(wp) ::  pt_surf_mean           !< mean near surface temperature (at 1st grid point)
2172    REAL(wp) ::  pt_surf_mean_l         !< mean near surface temperature (at 1st grid point) on subdomain
2173    REAL(wp) ::  scale_l_l              !< mean Obukhov lenght on subdomain
2174    REAL(wp) ::  shf_mean               !< mean surface sensible heat flux
2175    REAL(wp) ::  shf_mean_l             !< mean surface sensible heat flux on subdomain
2176    REAL(wp) ::  w_convective           !< convective velocity scale
2177   
2178!
2179!-- Calculate mean friction velocity, velocity scale, heat flux and
2180!-- near-surface temperature in the model domain. 
2181    pt_surf_mean_l = 0.0_wp
2182    shf_mean_l     = 0.0_wp
2183    scale_l_l      = 0.0_wp
2184    friction_vel_l = 0.0_wp
2185    DO  m = 1, surf_def_h(0)%ns
2186       i = surf_def_h(0)%i(m)
2187       j = surf_def_h(0)%j(m)
2188       k = surf_def_h(0)%k(m)
2189       friction_vel_l = friction_vel_l  + surf_def_h(0)%us(m)
2190       shf_mean_l     = shf_mean_l      + surf_def_h(0)%shf(m) * drho_air(k)
2191       scale_l_l      = scale_l_l       + surf_def_h(0)%ol(m)
2192       pt_surf_mean_l = pt_surf_mean_l  + pt(k,j,i)
2193    ENDDO   
2194    DO  m = 1, surf_lsm_h%ns
2195       i = surf_lsm_h%i(m)
2196       j = surf_lsm_h%j(m)
2197       k = surf_lsm_h%k(m)
2198       friction_vel_l = friction_vel_l  + surf_lsm_h%us(m)
2199       shf_mean_l     = shf_mean_l      + surf_lsm_h%shf(m) * drho_air(k)
2200       scale_l_l      = scale_l_l       + surf_lsm_h%ol(m)
2201       pt_surf_mean_l = pt_surf_mean_l  + pt(k,j,i)
2202    ENDDO
2203    DO  m = 1, surf_usm_h%ns
2204       i = surf_usm_h%i(m)
2205       j = surf_usm_h%j(m)
2206       k = surf_usm_h%k(m)
2207       friction_vel_l = friction_vel_l  + surf_usm_h%us(m)
2208       shf_mean_l     = shf_mean_l      + surf_usm_h%shf(m) * drho_air(k)
2209       scale_l_l      = scale_l_l       + surf_usm_h%ol(m)
2210       pt_surf_mean_l = pt_surf_mean_l  + pt(k,j,i)
2211    ENDDO
2212   
2213#if defined( __parallel )
2214    CALL MPI_ALLREDUCE( friction_vel_l, scale_us,     1, MPI_REAL, MPI_SUM,    &
2215                        comm2d, ierr )
2216    CALL MPI_ALLREDUCE( shf_mean_l, shf_mean,         1, MPI_REAL, MPI_SUM,    &
2217                        comm2d, ierr )
2218    CALL MPI_ALLREDUCE( scale_l_l, scale_l,           1, MPI_REAL, MPI_SUM,    &
2219                        comm2d, ierr )
2220    CALL MPI_ALLREDUCE( pt_surf_mean_l, pt_surf_mean, 1, MPI_REAL, MPI_SUM,    &
2221                        comm2d, ierr )
2222#else
2223    scale_us     = friction_vel_l
2224    shf_mean     = shf_mean_l
2225    scale_l      = scale_l_l
2226    pt_surf_mean = pt_surf_mean_l
2227#endif
2228
2229    scale_us     = scale_us     / REAL( ( nx + 1 ) * ( ny + 1 ), KIND = wp )
2230    shf_mean     = shf_mean     / REAL( ( nx + 1 ) * ( ny + 1 ), KIND = wp )
2231    scale_l      = scale_l      / REAL( ( nx + 1 ) * ( ny + 1 ), KIND = wp )
2232    pt_surf_mean = pt_surf_mean / REAL( ( nx + 1 ) * ( ny + 1 ), KIND = wp )   
2233!
2234!-- Compute mean convective velocity scale. Note, in case the mean heat flux
2235!-- is negative, set convective velocity scale to zero.
2236    IF ( shf_mean > 0.0_wp )  THEN
2237       w_convective = ( g * shf_mean * zi_ribulk / pt_surf_mean )**( 1.0_wp / 3.0_wp )
2238    ELSE
2239       w_convective = 0.0_wp
2240    ENDIF
2241!
2242!-- Finally, in order to consider also neutral or stable stratification,
2243!-- compute momentum velocity scale from u* and convective velocity scale,
2244!-- according to Rotach et al. (1996).
2245    scale_wm = ( scale_us**3 + 0.6_wp * w_convective**3 )**( 1.0_wp / 3.0_wp )
2246   
2247 END SUBROUTINE calc_scaling_variables
2248
2249 END MODULE synthetic_turbulence_generator_mod
Note: See TracBrowser for help on using the repository browser.