source: palm/tags/release-3.1b/SOURCE/check_parameters.f90 @ 4429

Last change on this file since 4429 was 4, checked in by raasch, 17 years ago

Id keyword set as property for all *.f90 files

  • Property svn:keywords set to Id
File size: 83.7 KB
Line 
1 SUBROUTINE check_parameters
2
3!------------------------------------------------------------------------------!
4! Actual revisions:
5! -----------------
6!
7!
8! Former revisions:
9! -----------------
10! $Id: check_parameters.f90 4 2007-02-13 11:33:16Z raasch $
11! RCS Log replace by Id keyword, revision history cleaned up
12!
13! Revision 1.61  2006/08/04 14:20:25  raasch
14! do2d_unit and do3d_unit now defined as 2d-arrays, check of
15! use_upstream_for_tke, default value for dt_dopts,
16! generation of file header moved from routines palm and header to here
17!
18! Revision 1.1  1997/08/26 06:29:23  raasch
19! Initial revision
20!
21!
22! Description:
23! ------------
24! Check control parameters and deduce further quantities.
25!------------------------------------------------------------------------------!
26
27    USE arrays_3d
28    USE constants
29    USE control_parameters
30    USE grid_variables
31    USE indices
32    USE model_1d
33    USE netcdf_control
34    USE particle_attributes
35    USE pegrid
36    USE profil_parameter
37    USE statistics
38    USE transpose_indices
39
40    IMPLICIT NONE
41
42    CHARACTER (LEN=1)   ::  sq
43    CHARACTER (LEN=6)   ::  var
44    CHARACTER (LEN=7)   ::  unit
45    CHARACTER (LEN=8)   ::  date
46    CHARACTER (LEN=10)  ::  time
47    CHARACTER (LEN=100) ::  action
48
49    INTEGER ::  i, ilen, intervals, iter, j, k, nnxh, nnyh, position, prec
50    LOGICAL ::  found, ldum
51    REAL    ::  gradient, maxn, maxp
52
53
54!
55!-- Warning, if host is not set
56    IF ( host(1:1) == ' ' )  THEN
57       IF ( myid == 0 )  THEN
58          PRINT*, '+++ WARNING: check_parameters:'
59          PRINT*, '    "host" is not set. Please check that environment', &
60                       ' variable "localhost"'
61          PRINT*, '    is set before running PALM'
62       ENDIF
63    ENDIF
64
65!
66!-- Generate the file header which is used as a header for most of PALM's
67!-- output files
68    CALL DATE_AND_TIME( date, time )
69    run_date = date(7:8)//'-'//date(5:6)//'-'//date(3:4)
70    run_time = time(1:2)//':'//time(3:4)//':'//time(5:6)
71
72    WRITE ( run_description_header, '(A,2X,A,A,A,I2.2,2X,A,A,2X,A,1X,A)' )  &
73              TRIM( version ),'run: ', TRIM( run_identifier ), '.', &
74              runnr, 'host: ', TRIM( host ), run_date, run_time
75
76!
77!-- Check topography setting (check for illegal parameter combinations)
78    IF ( topography /= 'flat' )  THEN
79       action = ' '
80       IF ( scalar_advec /= 'pw-scheme' )  THEN
81          WRITE( action, '(A,A)' )  'scalar_advec = ', scalar_advec
82       ENDIF
83       IF ( momentum_advec /= 'pw-scheme' )  THEN
84          WRITE( action, '(A,A)' )  'momentum_advec = ', momentum_advec
85       ENDIF
86       IF ( psolver == 'multigrid'  .OR.  psolver == 'sor' )  THEN
87          WRITE( action, '(A,A)' )  'psolver = ', psolver
88       ENDIF
89       IF ( sloping_surface )  THEN
90          WRITE( action, '(A)' )  'sloping surface = .TRUE.'
91       ENDIF
92       IF ( galilei_transformation )  THEN
93          WRITE( action, '(A)' )  'galilei_transformation = .TRUE.'
94       ENDIF
95       IF ( cloud_physics )  THEN
96          WRITE( action, '(A)' )  'cloud_physics = .TRUE.'
97       ENDIF
98       IF ( cloud_droplets )  THEN
99          WRITE( action, '(A)' )  'cloud_droplets = .TRUE.'
100       ENDIF
101       IF ( moisture )  THEN
102          WRITE( action, '(A)' )  'moisture = .TRUE.'
103       ENDIF
104       IF ( .NOT. prandtl_layer )  THEN
105          WRITE( action, '(A)' )  'prandtl_layer = .FALSE.'
106       ENDIF
107       IF ( action /= ' ' )  THEN
108          IF ( myid == 0 )  THEN
109             PRINT*, '+++ check_parameters:'
110             PRINT*, '    a non-flat topography does not allow ', TRIM( action )
111          ENDIF
112          CALL local_stop
113       ENDIF
114    ENDIF
115!
116!-- Check whether there are any illegal values
117!-- Pressure solver:
118    IF ( psolver /= 'poisfft'  .AND.  psolver /= 'poisfft_hybrid'  .AND. &
119         psolver /= 'sor'  .AND.  psolver /= 'multigrid' )  THEN
120       IF ( myid == 0 )  THEN
121          PRINT*, '+++ check_parameters:'
122          PRINT*, '    unknown solver for perturbation pressure: psolver=', &
123                  psolver
124       ENDIF
125       CALL local_stop
126    ENDIF
127
128#if defined( __parallel )
129    IF ( psolver == 'poisfft_hybrid'  .AND.  pdims(2) /= 1 )  THEN
130       IF ( myid == 0 )  THEN
131          PRINT*, '+++ check_parameters:'
132          PRINT*, '    psolver="', TRIM( psolver ), '" only works for a ', &
133                       '1d domain-decomposition along x'
134          PRINT*, '    please do not set npey/=1 in the parameter file'
135       ENDIF
136       CALL local_stop
137    ENDIF
138    IF ( ( psolver == 'poisfft_hybrid'  .OR.  psolver == 'multigrid' )  .AND.  &
139         ( nxra > nxr  .OR.  nyna > nyn  .OR.  nza > nz ) )  THEN
140       IF ( myid == 0 )  THEN
141          PRINT*, '+++ check_parameters:'
142          PRINT*, '    psolver="', TRIM( psolver ), '" does not work for ', &
143                       'subdomains with unequal size'
144          PRINT*, '    please set grid_matching = ''strict'' in the parameter',&
145                       ' file'
146       ENDIF
147       CALL local_stop
148    ENDIF
149#else
150    IF ( psolver == 'poisfft_hybrid' )  THEN
151       IF ( myid == 0 )  THEN
152          PRINT*, '+++ check_parameters:'
153          PRINT*, '    psolver="', TRIM( psolver ), '" only works for a ', &
154                       'parallel environment'
155       ENDIF
156       CALL local_stop
157    ENDIF
158#endif
159
160    IF ( psolver == 'multigrid' )  THEN
161       IF ( cycle_mg == 'w' )  THEN
162          gamma_mg = 2
163       ELSEIF ( cycle_mg == 'v' )  THEN
164          gamma_mg = 1
165       ELSE
166          IF ( myid == 0 )  THEN
167             PRINT*, '+++ check_parameters:'
168             PRINT*, '    unknown multigrid cycle: cycle_mg=', cycle_mg
169          ENDIF
170          CALL local_stop
171       ENDIF
172    ENDIF
173
174    IF ( fft_method /= 'singleton-algorithm'  .AND.  &
175         fft_method /= 'temperton-algorithm'  .AND.  &
176         fft_method /= 'system-specific' )  THEN
177       IF ( myid == 0 )  THEN
178          PRINT*, '+++ check_parameters:'
179          PRINT*, '    unknown fft-algorithm: fft_method=', fft_method
180       ENDIF
181       CALL local_stop
182    ENDIF
183
184!
185!-- Advection schemes:
186    IF ( momentum_advec /= 'pw-scheme' .AND. momentum_advec /= 'ups-scheme' ) &
187    THEN
188       IF ( myid == 0 )  PRINT*, '+++ check_parameters:  unknown advection ', &
189                                 'scheme: momentum_advec=', momentum_advec
190       CALL local_stop
191    ENDIF
192    IF ( ( momentum_advec == 'ups-scheme'  .OR.  scalar_advec == 'ups-scheme' )&
193                                      .AND.  timestep_scheme /= 'euler' )  THEN
194       IF ( myid == 0 )  PRINT*, '+++ check_parameters:  momentum_advec=', &
195                                 momentum_advec, ' is not allowed with ', &
196                                 'timestep_scheme=', timestep_scheme
197       CALL local_stop
198    ENDIF
199
200    IF ( scalar_advec /= 'pw-scheme'  .AND.  scalar_advec /= 'bc-scheme'  .AND.&
201         scalar_advec /= 'ups-scheme' )  THEN
202       IF ( myid == 0 )  PRINT*, '+++ check_parameters:  unknown advection ', &
203                                 'scheme: scalar_advec=', scalar_advec
204       CALL local_stop
205    ENDIF
206
207    IF ( use_sgs_for_particles  .AND.  .NOT. use_upstream_for_tke )  THEN
208       use_upstream_for_tke = .TRUE.
209       IF ( myid == 0 )  THEN
210          PRINT*, '+++ WARNING: check_parameters:  use_upstream_for_tke set ', &
211                       '.TRUE. because use_sgs_for_particles = .TRUE.'
212       ENDIF
213    ENDIF
214
215    IF ( use_upstream_for_tke  .AND.  timestep_scheme(1:8) == 'leapfrog' )  THEN
216       IF ( myid == 0 )  THEN
217          PRINT*, '+++ check_parameters:  use_upstream_for_tke = .TRUE. ', &
218                       'not allowed with timestep_scheme=', timestep_scheme
219       ENDIF
220       CALL local_stop
221    ENDIF
222
223!
224!-- Timestep schemes:
225    SELECT CASE ( TRIM( timestep_scheme ) )
226
227       CASE ( 'euler' )
228          intermediate_timestep_count_max = 1
229          asselin_filter_factor           = 0.0
230
231       CASE ( 'leapfrog', 'leapfrog+euler' )
232          intermediate_timestep_count_max = 1
233
234       CASE ( 'runge-kutta-2' )
235          intermediate_timestep_count_max = 2
236          asselin_filter_factor           = 0.0
237
238       CASE ( 'runge-kutta-3' )
239          intermediate_timestep_count_max = 3
240          asselin_filter_factor           = 0.0
241
242       CASE DEFAULT
243          IF ( myid == 0 )  PRINT*, '+++ check_parameters:  unknown timestep ',&
244                                    'scheme: timestep_scheme=', timestep_scheme
245          CALL local_stop
246
247    END SELECT
248
249    IF ( scalar_advec /= 'pw-scheme'  .AND.  timestep_scheme(1:5) == 'runge' ) &
250    THEN
251       IF ( myid == 0 )  THEN
252          PRINT*, '+++ check_parameters:  scalar advection scheme "', &
253                                          TRIM( scalar_advec ), '"'
254          PRINT*, '    does not work with timestep_scheme "', &
255                                          TRIM( timestep_scheme ), '"'
256       ENDIF
257       CALL local_stop
258    ENDIF
259
260    IF ( momentum_advec /= 'pw-scheme' .AND. timestep_scheme(1:5) == 'runge' ) &
261    THEN
262       IF ( myid == 0 )  THEN
263          PRINT*, '+++ check_parameters:  momentum advection scheme "', &
264                                          TRIM( momentum_advec ), '"'
265          PRINT*, '    does not work with timestep_scheme "', &
266                                          TRIM( timestep_scheme ), '"'
267       ENDIF
268       CALL local_stop
269    ENDIF
270
271
272    IF ( initializing_actions == ' ' )  THEN
273       IF ( myid == 0 )  THEN
274          PRINT*, '+++ check parameters:'
275          PRINT*, '    no value found for initializing_actions'
276       ENDIF
277       CALL local_stop
278    ENDIF
279
280    IF ( TRIM( initializing_actions ) /= 'read_restart_data' )  THEN
281!
282!--    No model continuation run; several initialising actions are possible
283       action = initializing_actions
284       DO WHILE ( TRIM( action ) /= '' )
285          position = INDEX( action, ' ' )
286          SELECT CASE ( action(1:position-1) )
287
288             CASE ( 'set_constant_profiles', 'set_1d-model_profiles', &
289                    'initialize_vortex',     'initialize_ptanom' )
290                action = action(position+1:)
291
292             CASE DEFAULT
293                IF ( myid == 0 )  PRINT*, '+++ check_parameters: initializi', &
294                               'ng_action unkown or not allowed: action = "', &
295                               TRIM(action), '"'
296                CALL local_stop
297
298          END SELECT
299       ENDDO
300    ENDIF
301    IF ( INDEX( initializing_actions, 'set_constant_profiles' ) /= 0  .AND. &
302         INDEX( initializing_actions, 'set_1d-model_profiles' ) /= 0 )  THEN
303       IF ( myid == 0 )  PRINT*, '+++ check_parameters: initializing_actions', &
304          '"set_constant_profiles" and "set_1d-model_profiles" are not', &
305          ' allowed simultaneously'
306       CALL local_stop
307    ENDIF
308
309    IF ( cloud_physics  .AND.  .NOT. moisture )  THEN
310       IF ( myid == 0 )  PRINT*, '+++ check_parameters: moisture =', &
311                                 moisture, ' is not allowed with ',  &
312                                 'cloud_physics=', cloud_physics
313       CALL local_stop
314    ENDIF
315
316    IF ( moisture  .AND.  sloping_surface )  THEN
317       IF ( myid == 0 )  PRINT*, '+++ check_parameters: moisture = TRUE', &
318                                 'and hang = TRUE are not',               &
319                                 ' allowed simultaneously' 
320       CALL local_stop       
321    ENDIF
322
323    IF ( moisture  .AND.  scalar_advec == 'ups-scheme' )  THEN
324       IF ( myid == 0 )  PRINT*, '+++ check_parameters: UPS-scheme', &
325                                 'is not implemented for moisture'
326       CALL local_stop       
327    ENDIF
328
329    IF ( passive_scalar  .AND.  moisture )  THEN
330       IF ( myid == 0 )  PRINT*, '+++ check_parameters: moisture = TRUE and', &
331                                 'passive_scalar = TRUE is not allowed ',     &
332                                 'simultaneously'
333       CALL local_stop
334    ENDIF
335
336    IF ( passive_scalar  .AND.  scalar_advec == 'ups-scheme' )  THEN
337       IF ( myid == 0 )  PRINT*, '+++ check_parameters: UPS-scheme', &
338                                 'is not implemented for passive_scalar'
339       CALL local_stop       
340    ENDIF
341
342    IF ( grid_matching /= 'strict'  .AND.  grid_matching /= 'match' )  THEN
343       IF ( myid == 0 )  PRINT*, '+++ check_parameters: illegal value "', &
344                                 TRIM( grid_matching ),                   &
345                                 '" found for parameter grid_matching'
346       CALL local_stop       
347    ENDIF
348
349!
350!-- In case of no model continuation run, check initialising parameters and
351!-- deduce further quantities
352    IF ( TRIM( initializing_actions ) /= 'read_restart_data' )  THEN
353
354!
355!--    Initial profiles for 1D and 3D model, respectively
356       u_init  = ug_surface
357       v_init  = vg_surface
358       pt_init = pt_surface
359       IF ( moisture )        q_init = q_surface
360       IF ( passive_scalar )  q_init = s_surface
361
362!
363!--
364!--    If required, compute initial profile of the geostrophic wind
365!--    (component ug)
366       i = 1
367       gradient = 0.0
368       ug_vertical_gradient_level_ind(1) = 0
369       ug(0) = ug_surface
370       DO  k = 1, nzt+1
371          IF ( ug_vertical_gradient_level(i) < zu(k)  .AND. &
372               ug_vertical_gradient_level(i) >= 0.0 )  THEN
373             gradient = ug_vertical_gradient(i) / 100.0
374             ug_vertical_gradient_level_ind(i) = k - 1
375             i = i + 1
376             IF ( i > 10 )  THEN
377                IF ( myid == 0 )  THEN
378                   PRINT*, '+++ check_parameters: upper bound 10 of array', &
379                           ' "ug_vertical_gradient_level_ind" exceeded'
380                ENDIF
381                CALL local_stop
382             ENDIF
383          ENDIF
384          IF ( gradient /= 0.0 )  THEN
385             IF ( k /= 1 )  THEN
386                ug(k) = ug(k-1) + dzu(k) * gradient
387             ELSE
388                ug(k) = ug_surface + 0.5 * dzu(k) * gradient
389             ENDIF
390          ELSE
391             ug(k) = ug(k-1)
392          ENDIF
393       ENDDO
394
395       u_init = ug
396
397!
398!--    In case of no given gradients for ug, choose a vanishing gradient
399       IF ( ug_vertical_gradient_level(1) == -1.0 )  THEN
400          ug_vertical_gradient_level(1) = 0.0
401       ENDIF 
402
403!
404!--
405!--    If required, compute initial profile of the geostrophic wind
406!--    (component vg)
407       i = 1
408       gradient = 0.0
409       vg_vertical_gradient_level_ind(1) = 0
410       vg(0) = vg_surface
411       DO  k = 1, nzt+1
412          IF ( vg_vertical_gradient_level(i) < zu(k)  .AND. &
413               vg_vertical_gradient_level(i) >= 0.0 )  THEN
414             gradient = vg_vertical_gradient(i) / 100.0
415             vg_vertical_gradient_level_ind(i) = k - 1
416             i = i + 1
417             IF ( i > 10 )  THEN
418                IF ( myid == 0 )  THEN
419                   PRINT*, '+++ check_parameters: upper bound 10 of array', &
420                           ' "vg_vertical_gradient_level_ind" exceeded'
421                ENDIF
422                CALL local_stop
423             ENDIF
424          ENDIF
425          IF ( gradient /= 0.0 )  THEN
426             IF ( k /= 1 )  THEN
427                vg(k) = vg(k-1) + dzu(k) * gradient
428             ELSE
429                vg(k) = vg_surface + 0.5 * dzu(k) * gradient
430             ENDIF
431          ELSE
432             vg(k) = vg(k-1)
433          ENDIF
434       ENDDO
435
436       v_init = vg
437 
438!
439!--    In case of no given gradients for vg, choose a vanishing gradient
440       IF ( vg_vertical_gradient_level(1) == -1.0 )  THEN
441          vg_vertical_gradient_level(1) = 0.0
442       ENDIF
443
444!
445!--    If required, compute initial temperature profile using the given
446!--    temperature gradient
447       i = 1
448       gradient = 0.0
449       pt_vertical_gradient_level_ind(1) = 0
450       DO  k = 1, nzt+1
451          IF ( pt_vertical_gradient_level(i) < zu(k)  .AND. &
452               pt_vertical_gradient_level(i) >= 0.0 )  THEN
453             gradient = pt_vertical_gradient(i) / 100.0
454             pt_vertical_gradient_level_ind(i) = k - 1
455             i = i + 1
456             IF ( i > 10 )  THEN
457                IF ( myid == 0 )  THEN
458                   PRINT*, '+++ check_parameters: upper bound 10 of array', &
459                           ' "pt_vertical_gradient_level_ind" exceeded'
460                ENDIF
461                CALL local_stop
462             ENDIF
463          ENDIF
464          IF ( gradient /= 0.0 )  THEN
465             IF ( k /= 1 )  THEN
466                pt_init(k) = pt_init(k-1) + dzu(k) * gradient
467             ELSE
468                pt_init(k) = pt_init(k-1) + 0.5 * dzu(k) * gradient
469             ENDIF
470          ELSE
471             pt_init(k) = pt_init(k-1)
472          ENDIF
473       ENDDO
474
475!
476!--    In case of no given temperature gradients, choose gradient of neutral
477!--    stratification
478       IF ( pt_vertical_gradient_level(1) == -1.0 )  THEN
479          pt_vertical_gradient_level(1) = 0.0
480       ENDIF
481
482!
483!--    Store temperature gradient at the top boundary for possile Neumann
484!--    boundary condition
485       bc_pt_t_val = ( pt_init(nzt) - pt_init(nzt-1) ) / dzu(nzt)
486
487!
488!--    If required, compute initial humidity or scalar profile using the given
489!--    humidity/scalar gradient. In case of scalar transport, initially store
490!--    values of the scalar parameters on humidity parameters
491       IF ( passive_scalar )  THEN
492          bc_q_b                    = bc_s_b
493          bc_q_t                    = bc_s_t
494          q_surface                 = s_surface
495          q_surface_initial_change  = s_surface_initial_change
496          q_vertical_gradient       = s_vertical_gradient
497          q_vertical_gradient_level = s_vertical_gradient_level
498          surface_waterflux         = surface_scalarflux
499       ENDIF
500
501       IF ( moisture  .OR.  passive_scalar )  THEN
502
503          i = 1
504          gradient = 0.0
505          q_vertical_gradient_level_ind(1) = 0
506          DO  k = 1, nzt+1
507             IF ( q_vertical_gradient_level(i) < zu(k)  .AND. &
508                  q_vertical_gradient_level(i) >= 0.0 )  THEN
509                gradient = q_vertical_gradient(i) / 100.0
510                q_vertical_gradient_level_ind(i) = k - 1
511                i = i + 1
512                IF ( i > 10 )  THEN
513                   IF ( myid == 0 )  THEN
514                      PRINT*, '+++ check_parameters: upper bound 10 of arr', &
515                              'ay "q_vertical_gradient_level_ind" exceeded'
516                   ENDIF
517                   CALL local_stop
518                ENDIF
519             ENDIF
520             IF ( gradient /= 0.0 )  THEN
521                IF ( k /= 1 )  THEN
522                   q_init(k) = q_init(k-1) + dzu(k) * gradient
523                ELSE
524                   q_init(k) = q_init(k-1) + 0.5 * dzu(k) * gradient
525                ENDIF
526             ELSE
527                q_init(k) = q_init(k-1)
528             ENDIF
529          ENDDO
530
531!
532!--       In case of no given humidity gradients, choose zero gradient
533!--       conditions
534          IF ( q_vertical_gradient_level(1) == -1.0 )  THEN
535             q_vertical_gradient_level(1) = 0.0
536          ENDIF
537
538!
539!--       Store humidity gradient at the top boundary for possile Neumann
540!--       boundary condition
541          bc_q_t_val = ( q_init(nzt) - q_init(nzt-1) ) / dzu(nzt)
542
543       ENDIF
544
545    ENDIF
546
547!
548!-- Compute Coriolis parameter
549    f  = 2.0 * omega * SIN( phi / 180.0 * pi )
550    fs = 2.0 * omega * COS( phi / 180.0 * pi )
551
552!
553!-- In case of a given slope, compute the relevant quantities
554    IF ( alpha_surface /= 0.0 )  THEN
555       IF ( ABS( alpha_surface ) > 90.0 )  THEN
556          IF ( myid == 0 )  PRINT*, '+++ check_parameters: ABS( alpha_surface',&
557                                    '=', alpha_surface, ' ) must be < 90.0'
558          CALL local_stop
559       ENDIF
560       sloping_surface = .TRUE.
561       cos_alpha_surface = COS( alpha_surface / 180.0 * pi )
562       sin_alpha_surface = SIN( alpha_surface / 180.0 * pi )
563    ENDIF
564
565!
566!-- Check time step and cfl_factor
567    IF ( dt /= -1.0 )  THEN
568       IF ( dt <= 0.0  .AND.  dt /= -1.0 )  THEN
569          IF ( myid == 0 )  PRINT*, '+++ check_parameters:  dt=', dt, ' <= 0.0'
570          CALL local_stop
571       ENDIF
572       dt_3d = dt
573       dt_fixed = .TRUE.
574    ENDIF
575
576    IF ( cfl_factor <= 0.0  .OR.  cfl_factor > 1.0 )  THEN
577       IF ( cfl_factor == -1.0 )  THEN
578          IF ( momentum_advec == 'ups-scheme'  .OR.  &
579               scalar_advec == 'ups-scheme' )  THEN
580             cfl_factor = 0.8
581          ELSE
582             IF ( timestep_scheme == 'runge-kutta-2' )  THEN
583                cfl_factor = 0.8
584             ELSEIF ( timestep_scheme == 'runge-kutta-3' )  THEN
585                cfl_factor = 0.9
586             ELSE
587                cfl_factor = 0.1
588             ENDIF
589          ENDIF
590       ELSE
591          IF ( myid == 0 )  THEN
592             PRINT*, '+++ check_parameters: cfl_factor=', cfl_factor, &
593                         ' out of range'
594             PRINT*, '+++                   0.0 < cfl_factor <= 1.0 is required'
595          ENDIF
596          CALL local_stop
597       ENDIF
598    ENDIF
599
600!
601!-- Store simulated time at begin
602    simulated_time_at_begin = simulated_time
603
604!
605!-- Set wind speed in the Galilei-transformed system
606    IF ( galilei_transformation )  THEN
607       IF ( use_ug_for_galilei_tr .AND.                &
608            ug_vertical_gradient_level(1) == 0.0 .AND. & 
609            vg_vertical_gradient_level(1) == 0.0 )  THEN
610          u_gtrans = ug_surface
611          v_gtrans = vg_surface
612       ELSEIF ( use_ug_for_galilei_tr .AND.                &
613                ug_vertical_gradient_level(1) /= 0.0 )  THEN
614          IF ( myid == 0 )  THEN
615             PRINT*, '+++ check_parameters:'
616             PRINT*, '    baroclinicity (ug) not allowed'
617             PRINT*, '    simultaneously with galilei transformation'
618          ENDIF
619          CALL local_stop
620       ELSEIF ( use_ug_for_galilei_tr .AND.                &
621                vg_vertical_gradient_level(1) /= 0.0 )  THEN
622          IF ( myid == 0 )  THEN
623             PRINT*, '+++ check_parameters:'
624             PRINT*, '    baroclinicity (vg) not allowed'
625             PRINT*, '    simultaneously with galilei transformation'
626          ENDIF
627          CALL local_stop
628       ELSE
629          IF ( myid == 0 )  THEN
630             PRINT*, '+++ WARNING: check_parameters:'
631             PRINT*, '    variable translation speed used for galilei-tran' // &
632                          'sformation, which'
633             PRINT*, '    may cause instabilities in stably stratified regions'
634          ENDIF
635       ENDIF
636    ENDIF
637
638!
639!-- In case of using a prandtl-layer, calculated (or prescribed) surface
640!-- fluxes have to be used in the diffusion-terms
641    IF ( prandtl_layer )  use_surface_fluxes = .TRUE.
642
643!
644!-- Check boundary conditions and set internal variables:
645!-- Lateral boundary conditions
646    IF ( bc_lr /= 'cyclic'  .AND.  bc_lr /= 'dirichlet/neumann'  .AND. &
647         bc_lr /= 'neumann/dirichlet' )  THEN
648       IF ( myid == 0 )  THEN
649          PRINT*, '+++ check_parameters:'
650          PRINT*, '    unknown boundary condition: bc_lr = ', bc_lr
651       ENDIF
652       CALL local_stop
653    ENDIF
654    IF ( bc_ns /= 'cyclic'  .AND.  bc_ns /= 'dirichlet/neumann'  .AND. &
655         bc_ns /= 'neumann/dirichlet' )  THEN
656       IF ( myid == 0 )  THEN
657          PRINT*, '+++ check_parameters:'
658          PRINT*, '    unknown boundary condition: bc_ns = ', bc_ns
659       ENDIF
660       CALL local_stop
661    ENDIF
662
663!
664!-- Non-cyclic lateral boundaries require the multigrid method and Piascek-
665!-- Willimas advection scheme. Several schemes and tools do not work with
666!-- non-cyclic boundary conditions.
667    IF ( bc_lr /= 'cyclic'  .OR.  bc_ns /= 'cyclic' )  THEN
668       IF ( psolver /= 'multigrid' )  THEN
669          IF ( myid == 0 )  THEN
670             PRINT*, '+++ check_parameters:'
671             PRINT*, '    non-cyclic lateral boundaries do not allow', &
672                          ' psolver = ', psolver 
673          ENDIF
674          CALL local_stop
675       ENDIF
676       IF ( momentum_advec /= 'pw-scheme' )  THEN
677          IF ( myid == 0 )  THEN
678             PRINT*, '+++ check_parameters:'
679             PRINT*, '    non-cyclic lateral boundaries do not allow', &
680                          ' momentum_advec = ', momentum_advec 
681          ENDIF
682          CALL local_stop
683       ENDIF
684       IF ( scalar_advec /= 'pw-scheme' )  THEN
685          IF ( myid == 0 )  THEN
686             PRINT*, '+++ check_parameters:'
687             PRINT*, '    non-cyclic lateral boundaries do not allow', &
688                          ' scalar_advec = ', scalar_advec 
689          ENDIF
690          CALL local_stop
691       ENDIF
692       IF ( galilei_transformation )  THEN
693          IF ( myid == 0 )  THEN
694             PRINT*, '+++ check_parameters:'
695             PRINT*, '    non-cyclic lateral boundaries do not allow', &
696                          ' galilei_transformation = .T.' 
697          ENDIF
698          CALL local_stop
699       ENDIF
700       IF ( conserve_volume_flow )  THEN
701          IF ( myid == 0 )  THEN
702             PRINT*, '+++ check_parameters:'
703             PRINT*, '    non-cyclic lateral boundaries do not allow', &
704                          ' conserve_volume_flow = .T.' 
705          ENDIF
706          CALL local_stop
707       ENDIF
708    ENDIF
709
710!
711!-- Bottom boundary condition for the turbulent Kinetic energy
712    IF ( bc_e_b == 'neumann' )  THEN
713       ibc_e_b = 1
714       IF ( adjust_mixing_length  .AND.  prandtl_layer )  THEN
715          IF ( myid == 0 )  THEN
716             PRINT*, '+++ WARNING: check_parameters:'
717             PRINT*, '    adjust_mixing_length = TRUE and bc_e_b = ', bc_e_b
718          ENDIF
719       ENDIF
720    ELSEIF ( bc_e_b == '(u*)**2+neumann' )  THEN
721       ibc_e_b = 2
722       IF ( .NOT. adjust_mixing_length  .AND.  prandtl_layer )  THEN
723          IF ( myid == 0 )  THEN
724             PRINT*, '+++ WARNING: check_parameters:'
725             PRINT*, '    adjust_mixing_length = FALSE and bc_e_b = ', bc_e_b
726          ENDIF
727       ENDIF
728       IF ( .NOT. prandtl_layer )  THEN
729          bc_e_b = 'neumann'
730          ibc_e_b = 1
731          IF ( myid == 0 )  THEN
732             PRINT*, '+++ WARNING: check_parameters:'
733             PRINT*, '    boundary condition bc_e_b changed to "', bc_e_b, '"'
734          ENDIF
735       ENDIF
736    ELSE
737       IF ( myid == 0 )  THEN
738          PRINT*, '+++ check_parameters:'
739          PRINT*, '    unknown boundary condition: bc_e_b = ', bc_e_b
740       ENDIF
741       CALL local_stop
742    ENDIF
743
744!
745!-- Boundary conditions for perturbation pressure
746    IF ( bc_p_b == 'dirichlet' )  THEN
747       ibc_p_b = 0
748    ELSEIF ( bc_p_b == 'neumann' )  THEN
749       ibc_p_b = 1
750    ELSEIF ( bc_p_b == 'neumann+inhomo' )  THEN
751       ibc_p_b = 2
752    ELSE
753       IF ( myid == 0 )  THEN
754          PRINT*, '+++ check_parameters:'
755          PRINT*, '    unknown boundary condition: bc_p_b = ', bc_p_b
756       ENDIF
757       CALL local_stop
758    ENDIF
759    IF ( ibc_p_b == 2  .AND.  .NOT. prandtl_layer )  THEN
760       IF ( myid == 0 )  THEN
761          PRINT*, '+++ check_parameters:'
762          PRINT*, '    boundary condition: bc_p_b = ', TRIM( bc_p_b ), &
763                       ' not allowed with'
764          PRINT*, '    prandtl_layer = .FALSE.' 
765       ENDIF
766       CALL local_stop
767    ENDIF
768    IF ( bc_p_t == 'dirichlet' )  THEN
769       ibc_p_t = 0
770    ELSEIF ( bc_p_t == 'neumann' )  THEN
771       ibc_p_t = 1
772    ELSE
773       IF ( myid == 0 )  THEN
774          PRINT*, '+++ check_parameters:'
775          PRINT*, '    unknown boundary condition: bc_p_t = ', bc_p_t
776       ENDIF
777       CALL local_stop
778    ENDIF
779
780!
781!-- Boundary conditions for potential temperature
782    IF ( bc_pt_b == 'dirichlet' )  THEN
783       ibc_pt_b = 0
784    ELSEIF ( bc_pt_b == 'neumann' )  THEN
785       ibc_pt_b = 1
786    ELSE
787       IF ( myid == 0 )  THEN
788          PRINT*, '+++ check_parameters:'
789          PRINT*, '    unknown boundary condition: bc_pt_b = ', bc_pt_b
790       ENDIF
791       CALL local_stop
792    ENDIF
793    IF ( bc_pt_t == 'dirichlet' )  THEN
794       ibc_pt_t = 0
795    ELSEIF ( bc_pt_t == 'neumann' )  THEN
796       ibc_pt_t = 1
797    ELSE
798       IF ( myid == 0 )  THEN
799          PRINT*, '+++ check_parameters:'
800          PRINT*, '    unknown boundary condition: bc_pt_t = ', bc_pt_t
801       ENDIF
802       CALL local_stop
803    ENDIF
804
805    IF ( surface_heatflux == 9999999.9 )  constant_heatflux = .FALSE.
806
807!
808!-- A given surface temperature implies Dirichlet boundary condition for
809!-- temperature. In this case specification of a constant heat flux is
810!-- forbidden.
811    IF ( ibc_pt_b == 0  .AND.   constant_heatflux  .AND. &
812         surface_heatflux /= 0.0 )  THEN
813       IF ( myid == 0 )  THEN
814          PRINT*, '+++ check_parameters:'
815          PRINT*, '    boundary_condition: bc_pt_b = ', bc_pt_b
816          PRINT*, '    is not allowed with constant_heatflux = .TRUE.'
817       ENDIF
818       CALL local_stop
819    ENDIF
820    IF ( constant_heatflux  .AND.  pt_surface_initial_change /= 0.0 )  THEN
821       IF ( myid == 0 )  THEN
822          PRINT*, '+++ check_parameters: constant_heatflux = .TRUE. is not'
823          PRINT*, '    allowed with pt_surface_initial_change (/=0) = ', &
824                  pt_surface_initial_change
825       ENDIF
826       CALL local_stop
827    ENDIF
828
829!
830!-- In case of moisture or passive scalar, set boundary conditions for total
831!-- water content / scalar
832    IF ( moisture  .OR.  passive_scalar ) THEN
833       IF ( moisture )  THEN
834          sq = 'q'
835       ELSE
836          sq = 's'
837       ENDIF
838       IF ( bc_q_b == 'dirichlet' )  THEN
839          ibc_q_b = 0
840       ELSEIF ( bc_q_b == 'neumann' )  THEN
841          ibc_q_b = 1
842       ELSE
843          IF ( myid == 0 )  THEN
844             PRINT*, '+++ check_parameters:'
845             PRINT*, '    unknown boundary condition: bc_', sq, '_b = ', bc_q_b
846          ENDIF
847          CALL local_stop
848       ENDIF
849       IF ( bc_q_t == 'dirichlet' )  THEN
850          ibc_q_t = 0
851       ELSEIF ( bc_q_t == 'neumann' )  THEN
852          ibc_q_t = 1
853       ELSE
854          IF ( myid == 0 )  THEN
855             PRINT*, '+++ check_parameters:'
856             PRINT*, '    unknown boundary condition: bc_', sq, '_t = ', bc_q_t
857          ENDIF
858          CALL local_stop
859       ENDIF
860
861       IF ( surface_waterflux == 0.0 )  constant_waterflux = .FALSE.
862
863!
864!--    A given surface humidity implies Dirichlet boundary condition for
865!--    moisture. In this case specification of a constant water flux is
866!--    forbidden.
867       IF ( ibc_q_b == 0  .AND.  constant_waterflux )  THEN
868          IF ( myid == 0 )  THEN
869             PRINT*, '+++ check_parameters:'
870             PRINT*, '    boundary_condition: bc_', sq, '_b = ', bc_q_b
871             PRINT*, '    is not allowed with prescribed surface flux'
872          ENDIF
873          CALL local_stop
874       ENDIF
875       IF ( constant_waterflux  .AND.  q_surface_initial_change /= 0.0 )  THEN
876          IF ( myid == 0 )  THEN
877             PRINT*, '+++ check_parameters: a prescribed surface flux is not'
878             PRINT*, '    allowed with ', sq, '_surface_initial_change (/=0)', &
879                     ' = ', q_surface_initial_change
880          ENDIF
881          CALL local_stop
882       ENDIF
883       
884    ENDIF
885
886!
887!-- Boundary conditions for horizontal components of wind speed
888    IF ( bc_uv_b == 'dirichlet' )  THEN
889       ibc_uv_b = 0
890    ELSEIF ( bc_uv_b == 'neumann' )  THEN
891       ibc_uv_b = 1
892       IF ( prandtl_layer )  THEN
893          IF ( myid == 0 )  THEN
894             PRINT*, '+++ check_parameters:'
895             PRINT*, '    boundary condition: bc_uv_b = ', TRIM( bc_uv_b ), &
896                          ' is not allowed with'
897             PRINT*, '    prandtl_layer = .TRUE.' 
898          ENDIF
899          CALL local_stop
900       ENDIF
901    ELSE
902       IF ( myid == 0 )  THEN
903          PRINT*, '+++ check_parameters:'
904          PRINT*, '    unknown boundary condition: bc_uv_b = ', bc_uv_b
905       ENDIF
906       CALL local_stop
907    ENDIF
908    IF ( bc_uv_t == 'dirichlet' )  THEN
909       ibc_uv_t = 0
910    ELSEIF ( bc_uv_t == 'neumann' )  THEN
911       ibc_uv_t = 1
912    ELSE
913       IF ( myid == 0 )  THEN
914          PRINT*, '+++ check_parameters:'
915          PRINT*, '    unknown boundary condition: bc_uv_t = ', bc_uv_t
916       ENDIF
917       CALL local_stop
918    ENDIF
919
920!
921!-- Compute and check, respectively, the Rayleigh Damping parameter
922    IF ( rayleigh_damping_factor == -1.0 )  THEN
923       IF ( momentum_advec == 'ups-scheme' )  THEN
924          rayleigh_damping_factor = 0.01
925       ELSE
926          rayleigh_damping_factor = 0.0
927       ENDIF
928    ELSE
929       IF ( rayleigh_damping_factor < 0.0 .OR. rayleigh_damping_factor > 1.0 ) &
930       THEN
931          IF ( myid == 0 )  THEN
932             PRINT*, '+++ check_parameters:'
933             PRINT*, '    rayleigh_damping_factor = ', rayleigh_damping_factor,&
934                          ' out of range [0.0,1.0]'
935          ENDIF
936          CALL local_stop
937       ENDIF
938    ENDIF
939
940    IF ( rayleigh_damping_height == -1.0 )  THEN
941       rayleigh_damping_height = 0.66666666666 * zu(nzt)
942    ELSE
943       IF ( rayleigh_damping_height < 0.0  .OR. &
944            rayleigh_damping_height > zu(nzt) )  THEN
945          IF ( myid == 0 )  THEN
946             PRINT*, '+++ check_parameters:'
947             PRINT*, '    rayleigh_damping_height = ', rayleigh_damping_height,&
948                          ' out of range [0.0,', zu(nzt), ']'
949          ENDIF
950          CALL local_stop
951       ENDIF
952    ENDIF
953
954!
955!-- Check limiters for Upstream-Spline scheme
956    IF ( overshoot_limit_u < 0.0  .OR.  overshoot_limit_v < 0.0  .OR.  &
957         overshoot_limit_w < 0.0  .OR.  overshoot_limit_pt < 0.0  .OR. &
958         overshoot_limit_e < 0.0 )  THEN
959       IF ( myid == 0 )  THEN
960          PRINT*, '+++ check_parameters:'
961          PRINT*, '    overshoot_limit_... < 0.0 is not allowed'
962       ENDIF
963       CALL local_stop
964    ENDIF
965    IF ( ups_limit_u < 0.0 .OR. ups_limit_v < 0.0 .OR. ups_limit_w < 0.0 .OR. &
966         ups_limit_pt < 0.0 .OR. ups_limit_e < 0.0 )  THEN
967       IF ( myid == 0 )  THEN
968          PRINT*, '+++ check_parameters:'
969          PRINT*, '    ups_limit_... < 0.0 is not allowed'
970       ENDIF
971       CALL local_stop
972    ENDIF
973
974!
975!-- Check number of chosen statistic regions. More than 10 regions are not
976!-- allowed, because so far no more than 10 corresponding output files can
977!-- be opened (cf. check_open)
978    IF ( statistic_regions > 9  .OR.  statistic_regions < 0 )  THEN
979       IF ( myid == 0 )  THEN
980          PRINT*, '+++ check_parameters: Number of statistic_regions = ', &
981                       statistic_regions+1
982          PRINT*, '    Only 10 regions are allowed'
983       ENDIF
984       CALL local_stop
985    ENDIF
986    IF ( normalizing_region > statistic_regions  .OR. &
987         normalizing_region < 0)  THEN
988       IF ( myid == 0 )  THEN
989          PRINT*, '+++ check_parameters: normalizing_region = ', &
990                       normalizing_region, ' is unknown'
991          PRINT*, '    Must be <= ', statistic_regions
992       ENDIF
993       CALL local_stop
994    ENDIF
995
996!
997!-- Set the default intervals for data output, if necessary
998!-- NOTE: dt_dosp has already been set in package_parin
999    IF ( dt_data_output /= 9999999.9 )  THEN
1000       IF ( dt_dopr           == 9999999.9 )  dt_dopr           = dt_data_output
1001       IF ( dt_dopts          == 9999999.9 )  dt_dopts          = dt_data_output
1002       IF ( dt_do2d_xy        == 9999999.9 )  dt_do2d_xy        = dt_data_output
1003       IF ( dt_do2d_xz        == 9999999.9 )  dt_do2d_xz        = dt_data_output
1004       IF ( dt_do2d_yz        == 9999999.9 )  dt_do2d_yz        = dt_data_output
1005       IF ( dt_do3d           == 9999999.9 )  dt_do3d           = dt_data_output
1006       IF ( dt_data_output_av == 9999999.9 )  dt_data_output_av = dt_data_output
1007    ENDIF
1008
1009!
1010!-- Set the default skip time intervals for data output, if necessary
1011    IF ( skip_time_dopr    == 9999999.9 ) &
1012                                       skip_time_dopr    = skip_time_data_output
1013    IF ( skip_time_dosp    == 9999999.9 ) &
1014                                       skip_time_dosp    = skip_time_data_output
1015    IF ( skip_time_do2d_xy == 9999999.9 ) &
1016                                       skip_time_do2d_xy = skip_time_data_output
1017    IF ( skip_time_do2d_xz == 9999999.9 ) &
1018                                       skip_time_do2d_xz = skip_time_data_output
1019    IF ( skip_time_do2d_yz == 9999999.9 ) &
1020                                       skip_time_do2d_yz = skip_time_data_output
1021    IF ( skip_time_do3d    == 9999999.9 ) &
1022                                       skip_time_do3d    = skip_time_data_output
1023    IF ( skip_time_data_output_av == 9999999.9 ) &
1024                                skip_time_data_output_av = skip_time_data_output
1025
1026!
1027!-- Check the average intervals (first for 3d-data, then for profiles and
1028!-- spectra)
1029    IF ( averaging_interval > dt_data_output_av )  THEN
1030       IF ( myid == 0 )  THEN
1031          PRINT*, '+++ check_parameters: average_interval=',              &
1032                       averaging_interval, ' must be <= dt_data_output=', &
1033                       dt_data_output
1034       ENDIF
1035       CALL local_stop
1036    ENDIF
1037
1038    IF ( averaging_interval_pr == 9999999.9 )  THEN
1039       averaging_interval_pr = averaging_interval
1040    ENDIF
1041
1042    IF ( averaging_interval_pr > dt_dopr )  THEN
1043       IF ( myid == 0 )  THEN
1044          PRINT*, '+++ check_parameters: averaging_interval_pr=', &
1045                       averaging_interval_pr, ' must be <= dt_dopr=', dt_dopr
1046       ENDIF
1047       CALL local_stop
1048    ENDIF
1049
1050    IF ( averaging_interval_sp == 9999999.9 )  THEN
1051       averaging_interval_sp = averaging_interval
1052    ENDIF
1053
1054    IF ( averaging_interval_sp > dt_dosp )  THEN
1055       IF ( myid == 0 )  THEN
1056          PRINT*, '+++ check_parameters: averaging_interval_sp=', &
1057                       averaging_interval_sp, ' must be <= dt_dosp=', dt_dosp
1058       ENDIF
1059       CALL local_stop
1060    ENDIF
1061
1062!
1063!-- Set the default interval for profiles entering the temporal average
1064    IF ( dt_averaging_input_pr == 9999999.9 )  THEN
1065       dt_averaging_input_pr = dt_averaging_input
1066    ENDIF
1067
1068!
1069!-- Set the default interval for the output of timeseries to a reasonable
1070!-- value (tries to minimize the number of calls of flow_statistics)
1071    IF ( dt_dots == 9999999.9 )  THEN
1072       IF ( averaging_interval_pr == 0.0 )  THEN
1073          dt_dots = MIN( dt_run_control, dt_dopr )
1074       ELSE
1075          dt_dots = MIN( dt_run_control, dt_averaging_input_pr )
1076       ENDIF
1077    ENDIF
1078
1079!
1080!-- Check the sample rate for averaging (first for 3d-data, then for profiles)
1081    IF ( dt_averaging_input > averaging_interval )  THEN
1082       IF ( myid == 0 )  THEN
1083          PRINT*, '+++ check_parameters: dt_averaging_input=',                &
1084                       dt_averaging_input, ' must be <= averaging_interval=', &
1085                       averaging_interval
1086       ENDIF
1087       CALL local_stop
1088    ENDIF
1089
1090    IF ( dt_averaging_input_pr > averaging_interval_pr )  THEN
1091       IF ( myid == 0 )  THEN
1092          PRINT*, '+++ check_parameters: dt_averaging_input_pr=', &
1093                       dt_averaging_input_pr,                     &
1094                       ' must be <= averaging_interval_pr=',      &
1095                       averaging_interval_pr
1096       ENDIF
1097       CALL local_stop
1098    ENDIF
1099
1100!
1101!-- Determine the number of output profiles and check whether they are
1102!-- permissible
1103    DO  WHILE ( data_output_pr(dopr_n+1) /= '          ' )
1104
1105       dopr_n = dopr_n + 1
1106       i = dopr_n
1107
1108!
1109!--    Determine internal profile number (for hom, homs)
1110!--    and store height levels
1111       SELECT CASE ( TRIM( data_output_pr(i) ) )
1112
1113          CASE ( 'u', '#u' )
1114             dopr_index(i) = 1
1115             hom(:,2,1,:)  = SPREAD( zu, 2, statistic_regions+1 )
1116             IF ( data_output_pr(i)(1:1) == '#' )  THEN
1117                dopr_initial_index(i) = 5
1118                hom(:,2,5,:)          = SPREAD( zu, 2, statistic_regions+1 )
1119                data_output_pr(i)     = data_output_pr(i)(2:)
1120             ENDIF
1121
1122          CASE ( 'v', '#v' )
1123             dopr_index(i) = 2
1124             hom(:,2,2,:) = SPREAD( zu, 2, statistic_regions+1 )
1125             IF ( data_output_pr(i)(1:1) == '#' )  THEN
1126                dopr_initial_index(i) = 6
1127                hom(:,2,6,:)          = SPREAD( zu, 2, statistic_regions+1 )
1128                data_output_pr(i)     = data_output_pr(i)(2:)
1129             ENDIF
1130
1131          CASE ( 'w' )
1132             dopr_index(i) = 3
1133             hom(:,2,3,:) = SPREAD( zw, 2, statistic_regions+1 )
1134
1135          CASE ( 'pt', '#pt' )
1136             IF ( .NOT. cloud_physics ) THEN
1137                dopr_index(i) = 4
1138                hom(:,2,4,:)  = SPREAD( zu, 2, statistic_regions+1 )
1139                IF ( data_output_pr(i)(1:1) == '#' )  THEN
1140                   dopr_initial_index(i) = 7
1141                   hom(:,2,7,:)          = SPREAD( zu, 2, statistic_regions+1 )
1142                   hom(nzb,2,7,:)        = 0.0    ! weil zu(nzb) negativ ist
1143                   data_output_pr(i)     = data_output_pr(i)(2:)
1144                ENDIF
1145             ELSE
1146                dopr_index(i) = 43
1147                hom(:,2,43,:)  = SPREAD( zu, 2, statistic_regions+1 )
1148                IF ( data_output_pr(i)(1:1) == '#' )  THEN
1149                   dopr_initial_index(i) = 28
1150                   hom(:,2,28,:)         = SPREAD( zu, 2, statistic_regions+1 )
1151                   hom(nzb,2,28,:)       = 0.0    ! weil zu(nzb) negativ ist
1152                   data_output_pr(i)     = data_output_pr(i)(2:)
1153                ENDIF
1154             ENDIF
1155
1156          CASE ( 'e' )
1157             dopr_index(i)  = 8
1158             hom(:,2,8,:)   = SPREAD( zu, 2, statistic_regions+1 )
1159             hom(nzb,2,8,:) = 0.0
1160
1161          CASE ( 'km', '#km' )
1162             dopr_index(i)  = 9
1163             hom(:,2,9,:)   = SPREAD( zu, 2, statistic_regions+1 )
1164             hom(nzb,2,9,:) = 0.0
1165             IF ( data_output_pr(i)(1:1) == '#' )  THEN
1166                dopr_initial_index(i) = 23
1167                hom(:,2,23,:)         = hom(:,2,9,:)
1168                data_output_pr(i)     = data_output_pr(i)(2:)
1169             ENDIF
1170
1171          CASE ( 'kh', '#kh' )
1172             dopr_index(i)   = 10
1173             hom(:,2,10,:)   = SPREAD( zu, 2, statistic_regions+1 )
1174             hom(nzb,2,10,:) = 0.0
1175             IF ( data_output_pr(i)(1:1) == '#' )  THEN
1176                dopr_initial_index(i) = 24
1177                hom(:,2,24,:)         = hom(:,2,10,:)
1178                data_output_pr(i)     = data_output_pr(i)(2:)
1179             ENDIF
1180
1181          CASE ( 'l', '#l' )
1182             dopr_index(i)   = 11
1183             hom(:,2,11,:)   = SPREAD( zu, 2, statistic_regions+1 )
1184             hom(nzb,2,11,:) = 0.0
1185             IF ( data_output_pr(i)(1:1) == '#' )  THEN
1186                dopr_initial_index(i) = 25
1187                hom(:,2,25,:)         = hom(:,2,11,:)
1188                data_output_pr(i)     = data_output_pr(i)(2:)
1189             ENDIF
1190
1191          CASE ( 'w"u"' )
1192             dopr_index(i) = 12
1193             hom(:,2,12,:) = SPREAD( zw, 2, statistic_regions+1 )
1194             IF ( prandtl_layer )  hom(nzb,2,12,:) = zu(1)
1195
1196          CASE ( 'w*u*' )
1197             dopr_index(i) = 13
1198             hom(:,2,13,:) = SPREAD( zw, 2, statistic_regions+1 )
1199
1200          CASE ( 'w"v"' )
1201             dopr_index(i) = 14
1202             hom(:,2,14,:) = SPREAD( zw, 2, statistic_regions+1 )
1203             IF ( prandtl_layer )  hom(nzb,2,14,:) = zu(1)
1204
1205          CASE ( 'w*v*' )
1206             dopr_index(i) = 15
1207             hom(:,2,15,:) = SPREAD( zw, 2, statistic_regions+1 )
1208
1209          CASE ( 'w"pt"' )
1210             dopr_index(i) = 16
1211             hom(:,2,16,:) = SPREAD( zw, 2, statistic_regions+1 )
1212
1213          CASE ( 'w*pt*' )
1214             dopr_index(i) = 17
1215             hom(:,2,17,:) = SPREAD( zw, 2, statistic_regions+1 )
1216
1217          CASE ( 'wpt' )
1218             dopr_index(i) = 18
1219             hom(:,2,18,:) = SPREAD( zw, 2, statistic_regions+1 )
1220
1221          CASE ( 'wu' )
1222             dopr_index(i) = 19
1223             hom(:,2,19,:) = SPREAD( zw, 2, statistic_regions+1 )
1224             IF ( prandtl_layer )  hom(nzb,2,19,:) = zu(1)
1225
1226          CASE ( 'wv' )
1227             dopr_index(i) = 20
1228             hom(:,2,20,:) = SPREAD( zw, 2, statistic_regions+1 )
1229             IF ( prandtl_layer )  hom(nzb,2,20,:) = zu(1)
1230
1231          CASE ( 'w*pt*BC' )
1232             dopr_index(i) = 21
1233             hom(:,2,21,:) = SPREAD( zw, 2, statistic_regions+1 )
1234
1235          CASE ( 'wptBC' )
1236             dopr_index(i) = 22
1237             hom(:,2,22,:) = SPREAD( zw, 2, statistic_regions+1 )
1238
1239          CASE ( 'u*2' )
1240             dopr_index(i) = 30
1241             hom(:,2,30,:) = SPREAD( zu, 2, statistic_regions+1 )
1242
1243          CASE ( 'v*2' )
1244             dopr_index(i) = 31
1245             hom(:,2,31,:) = SPREAD( zu, 2, statistic_regions+1 )
1246
1247          CASE ( 'w*2' )
1248             dopr_index(i) = 32
1249             hom(:,2,32,:) = SPREAD( zw, 2, statistic_regions+1 )
1250
1251          CASE ( 'pt*2' )
1252             dopr_index(i) = 33
1253             hom(:,2,33,:) = SPREAD( zu, 2, statistic_regions+1 )
1254
1255          CASE ( 'e*' )
1256             dopr_index(i) = 34
1257             hom(:,2,34,:) = SPREAD( zu, 2, statistic_regions+1 )
1258
1259          CASE ( 'w*2pt*' )
1260             dopr_index(i) = 35
1261             hom(:,2,35,:) = SPREAD( zw, 2, statistic_regions+1 )
1262
1263          CASE ( 'w*pt*2' )
1264             dopr_index(i) = 36
1265             hom(:,2,36,:) = SPREAD( zw, 2, statistic_regions+1 )
1266
1267          CASE ( 'w*e*' )
1268             dopr_index(i) = 37
1269             hom(:,2,37,:) = SPREAD( zw, 2, statistic_regions+1 )
1270
1271          CASE ( 'w*3' )
1272             dopr_index(i) = 38
1273             hom(:,2,38,:) = SPREAD( zw, 2, statistic_regions+1 )
1274
1275          CASE ( 'Sw' )
1276             dopr_index(i) = 39
1277             hom(:,2,39,:) = SPREAD( zw, 2, statistic_regions+1 )
1278
1279          CASE ( 'q', '#q' )
1280             IF ( .NOT. cloud_physics )  THEN
1281                IF ( myid == 0 )  THEN
1282                   PRINT*, '+++ check_parameters:  data_output_pr = ', &
1283                           data_output_pr(i),                          &
1284                           '    is not implemented for cloud_physics = FALSE'
1285                ENDIF
1286                CALL local_stop
1287             ELSE
1288                dopr_index(i) = 41
1289                hom(:,2,41,:)  = SPREAD( zu, 2, statistic_regions+1 )
1290                IF ( data_output_pr(i)(1:1) == '#' )  THEN
1291                   dopr_initial_index(i) = 26
1292                   hom(:,2,26,:)         = SPREAD( zu, 2, statistic_regions+1 )
1293                   hom(nzb,2,26,:)       = 0.0    ! weil zu(nzb) negativ ist
1294                   data_output_pr(i)     = data_output_pr(i)(2:)
1295                ENDIF
1296             ENDIF
1297
1298          CASE ( 's', '#s' )
1299             IF ( .NOT. passive_scalar )  THEN
1300                IF ( myid == 0 )  THEN
1301                   PRINT*, '+++ check_parameters:  data_output_pr = ', &
1302                           data_output_pr(i),                          &
1303                           '    is not implemented for passive_scalar = FALSE'
1304                ENDIF
1305                CALL local_stop
1306             ELSE
1307                dopr_index(i) = 41
1308                hom(:,2,41,:)  = SPREAD( zu, 2, statistic_regions+1 )
1309                IF ( data_output_pr(i)(1:1) == '#' )  THEN
1310                   dopr_initial_index(i) = 26
1311                   hom(:,2,26,:)         = SPREAD( zu, 2, statistic_regions+1 )
1312                   hom(nzb,2,26,:)       = 0.0    ! weil zu(nzb) negativ ist
1313                   data_output_pr(i)     = data_output_pr(i)(2:)
1314                ENDIF
1315             ENDIF
1316
1317          CASE ( 'qv', '#qv' )
1318             IF ( .NOT. cloud_physics ) THEN
1319                dopr_index(i) = 41
1320                hom(:,2,41,:)  = SPREAD( zu, 2, statistic_regions+1 )
1321                IF ( data_output_pr(i)(1:1) == '#' )  THEN
1322                   dopr_initial_index(i) = 26
1323                   hom(:,2,26,:)         = SPREAD( zu, 2, statistic_regions+1 )
1324                   hom(nzb,2,26,:)       = 0.0    ! weil zu(nzb) negativ ist
1325                   data_output_pr(i)     = data_output_pr(i)(2:)
1326                ENDIF
1327             ELSE
1328                dopr_index(i) = 42
1329                hom(:,2,42,:)  = SPREAD( zu, 2, statistic_regions+1 )
1330                IF ( data_output_pr(i)(1:1) == '#' )  THEN
1331                   dopr_initial_index(i) = 27
1332                   hom(:,2,27,:)         = SPREAD( zu, 2, statistic_regions+1 )
1333                   hom(nzb,2,27,:)       = 0.0    ! weil zu(nzb) negativ ist
1334                   data_output_pr(i)     = data_output_pr(i)(2:)
1335                ENDIF
1336             ENDIF
1337
1338          CASE ( 'lpt', '#lpt' )
1339             IF ( .NOT. cloud_physics ) THEN
1340                IF ( myid == 0 )  THEN
1341                   PRINT*, '+++ check_parameters:  data_output_pr = ', &
1342                           data_output_pr(i),                          &
1343                           '    is not implemented for cloud_physics = FALSE'
1344                ENDIF
1345                CALL local_stop
1346             ELSE
1347                dopr_index(i) = 4
1348                hom(:,2,4,:)  = SPREAD( zu, 2, statistic_regions+1 )
1349                IF ( data_output_pr(i)(1:1) == '#' )  THEN
1350                   dopr_initial_index(i) = 7
1351                   hom(:,2,7,:)          = SPREAD( zu, 2, statistic_regions+1 )
1352                   hom(nzb,2,7,:)        = 0.0    ! weil zu(nzb) negativ ist
1353                   data_output_pr(i)     = data_output_pr(i)(2:)
1354                ENDIF
1355             ENDIF
1356
1357          CASE ( 'vpt', '#vpt' )
1358             dopr_index(i) = 44
1359             hom(:,2,44,:)  = SPREAD( zu, 2, statistic_regions+1 )
1360             IF ( data_output_pr(i)(1:1) == '#' )  THEN
1361                dopr_initial_index(i) = 29
1362                hom(:,2,29,:)         = SPREAD( zu, 2, statistic_regions+1 )
1363                hom(nzb,2,29,:)       = 0.0    ! weil zu(nzb) negativ ist
1364                data_output_pr(i)     = data_output_pr(i)(2:)
1365             ENDIF
1366
1367          CASE ( 'w"vpt"' )
1368             dopr_index(i) = 45
1369             hom(:,2,45,:) = SPREAD( zw, 2, statistic_regions+1 )
1370
1371          CASE ( 'w*vpt*' )
1372             dopr_index(i) = 46
1373             hom(:,2,46,:) = SPREAD( zw, 2, statistic_regions+1 )
1374
1375          CASE ( 'wvpt' )
1376             dopr_index(i) = 47
1377             hom(:,2,47,:) = SPREAD( zw, 2, statistic_regions+1 )
1378
1379          CASE ( 'w"q"' )
1380             IF ( .NOT. cloud_physics ) THEN
1381                IF ( myid == 0 )  THEN
1382                   PRINT*, '+++ check_parameters:  data_output_pr = ', &
1383                           data_output_pr(i),                          &
1384                           '    is not implemented for cloud_physics = FALSE'
1385                ENDIF
1386                CALL local_stop
1387             ELSE
1388                dopr_index(i) = 48
1389                hom(:,2,48,:) = SPREAD( zw, 2, statistic_regions+1 )
1390             ENDIF
1391
1392          CASE ( 'w*q*' )
1393             IF ( .NOT. cloud_physics ) THEN
1394                IF ( myid == 0 )  THEN
1395                   PRINT*, '+++ check_parameters:  data_output_pr = ', &
1396                           data_output_pr(i),                          &
1397                           '    is not implemented for cloud_physics = FALSE'
1398                ENDIF
1399                CALL local_stop
1400             ELSE
1401                dopr_index(i) = 49
1402                hom(:,2,49,:) = SPREAD( zw, 2, statistic_regions+1 )
1403             ENDIF
1404
1405          CASE ( 'wq' )
1406             IF ( .NOT. cloud_physics ) THEN
1407                IF ( myid == 0 )  THEN
1408                   PRINT*, '+++ check_parameters:  data_output_pr = ', &
1409                           data_output_pr(i),                          &
1410                           '    is not implemented for cloud_physics = FALSE'
1411                ENDIF
1412                CALL local_stop
1413             ELSE
1414                dopr_index(i) = 50
1415                hom(:,2,50,:) = SPREAD( zw, 2, statistic_regions+1 )
1416             ENDIF
1417
1418          CASE ( 'w"s"' )
1419             IF ( .NOT. passive_scalar ) THEN
1420                IF ( myid == 0 )  THEN
1421                   PRINT*, '+++ check_parameters:  data_output_pr = ', &
1422                           data_output_pr(i),                          &
1423                           '    is not implemented for passive_scalar = FALSE'
1424                ENDIF
1425                CALL local_stop
1426             ELSE
1427                dopr_index(i) = 48
1428                hom(:,2,48,:) = SPREAD( zw, 2, statistic_regions+1 )
1429             ENDIF
1430
1431          CASE ( 'w*s*' )
1432             IF ( .NOT. passive_scalar ) THEN
1433                IF ( myid == 0 )  THEN
1434                   PRINT*, '+++ check_parameters:  data_output_pr = ', &
1435                           data_output_pr(i),                          &
1436                           '    is not implemented for passive_scalar = FALSE'
1437                ENDIF
1438                CALL local_stop
1439             ELSE
1440                dopr_index(i) = 49
1441                hom(:,2,49,:) = SPREAD( zw, 2, statistic_regions+1 )
1442             ENDIF
1443
1444          CASE ( 'ws' )
1445             IF ( .NOT. passive_scalar ) THEN
1446                IF ( myid == 0 )  THEN
1447                   PRINT*, '+++ check_parameters:  data_output_pr = ', &
1448                           data_output_pr(i),                          &
1449                           '    is not implemented for passive_scalar = FALSE'
1450                ENDIF
1451                CALL local_stop
1452             ELSE
1453                dopr_index(i) = 50
1454                hom(:,2,50,:) = SPREAD( zw, 2, statistic_regions+1 )
1455             ENDIF
1456
1457          CASE ( 'w"qv"' )
1458             IF ( moisture  .AND.  .NOT. cloud_physics ) &
1459             THEN
1460                dopr_index(i) = 48
1461                hom(:,2,48,:) = SPREAD( zw, 2, statistic_regions+1 )
1462             ELSEIF( moisture .AND. cloud_physics ) THEN
1463                dopr_index(i) = 51
1464                hom(:,2,51,:) = SPREAD( zw, 2, statistic_regions+1 )
1465             ELSE
1466                IF ( myid == 0 )  THEN
1467                   PRINT*, '+++ check_parameters:  data_output_pr = ', &
1468                           data_output_pr(i),                          &
1469                           '    is not implemented for cloud_physics = FALSE', &
1470                           '    and                    moisture      = FALSE'
1471                ENDIF
1472                CALL local_stop                   
1473             ENDIF
1474
1475          CASE ( 'w*qv*' )
1476             IF ( moisture  .AND.  .NOT. cloud_physics ) &
1477             THEN
1478                dopr_index(i) = 49
1479                hom(:,2,49,:) = SPREAD( zw, 2, statistic_regions+1 )
1480             ELSEIF( moisture .AND. cloud_physics ) THEN
1481                dopr_index(i) = 52
1482                hom(:,2,52,:) = SPREAD( zw, 2, statistic_regions+1 )
1483             ELSE
1484                IF ( myid == 0 )  THEN
1485                   PRINT*, '+++ check_parameters:  data_output_pr = ',         &
1486                           data_output_pr(i),                                  &
1487                           '    is not implemented for cloud_physics = FALSE', &
1488                           '                       and moisture      = FALSE'
1489                ENDIF
1490                CALL local_stop                   
1491             ENDIF
1492
1493          CASE ( 'wqv' )
1494             IF ( moisture  .AND.  .NOT. cloud_physics ) &
1495             THEN
1496                dopr_index(i) = 50
1497                hom(:,2,50,:) = SPREAD( zw, 2, statistic_regions+1 )
1498             ELSEIF( moisture .AND. cloud_physics ) THEN
1499                dopr_index(i) = 53
1500                hom(:,2,53,:) = SPREAD( zw, 2, statistic_regions+1 )
1501             ELSE
1502                IF ( myid == 0 )  THEN
1503                   PRINT*, '+++ check_parameters:  data_output_pr = ',         &
1504                           data_output_pr(i),                                  &
1505                           '    is not implemented for cloud_physics = FALSE', &
1506                           '                       and moisture      = FALSE'
1507                ENDIF
1508                CALL local_stop                   
1509             ENDIF
1510
1511          CASE ( 'ql' )
1512             IF ( .NOT. cloud_physics  .AND.  .NOT. cloud_droplets )  THEN
1513                IF ( myid == 0 )  THEN
1514                   PRINT*, '+++ check_parameters:  data_output_pr = ', &
1515                           data_output_pr(i),                          &
1516                           '    is not implemented for cloud_physics = FALSE'
1517                ENDIF
1518                CALL local_stop
1519             ELSE
1520                dopr_index(i) = 54
1521                hom(:,2,54,:)  = SPREAD( zu, 2, statistic_regions+1 )
1522             ENDIF
1523
1524          CASE ( 'w*u*u*/dz' )
1525             dopr_index(i) = 55
1526             hom(:,2,55,:) = SPREAD( zu, 2, statistic_regions+1 )
1527
1528          CASE ( 'w*p*/dz' )
1529             dopr_index(i) = 56
1530             hom(:,2,56,:) = SPREAD( zu, 2, statistic_regions+1 )
1531
1532          CASE ( 'w"e/dz' )
1533             dopr_index(i) = 57
1534             hom(:,2,57,:) = SPREAD( zu, 2, statistic_regions+1 )
1535
1536          CASE ( 'u"pt"' )
1537             dopr_index(i) = 58
1538             hom(:,2,58,:) = SPREAD( zu, 2, statistic_regions+1 )
1539
1540          CASE ( 'u*pt*' )
1541             dopr_index(i) = 59
1542             hom(:,2,59,:) = SPREAD( zu, 2, statistic_regions+1 )
1543
1544          CASE ( 'upt_t' )
1545             dopr_index(i) = 60
1546             hom(:,2,60,:) = SPREAD( zu, 2, statistic_regions+1 )
1547
1548          CASE ( 'v"pt"' )
1549             dopr_index(i) = 61
1550             hom(:,2,61,:) = SPREAD( zu, 2, statistic_regions+1 )
1551             
1552          CASE ( 'v*pt*' )
1553             dopr_index(i) = 62
1554             hom(:,2,62,:) = SPREAD( zu, 2, statistic_regions+1 )
1555
1556          CASE ( 'vpt_t' )
1557             dopr_index(i) = 63
1558             hom(:,2,63,:) = SPREAD( zu, 2, statistic_regions+1 )
1559
1560
1561          CASE DEFAULT
1562             IF ( myid == 0 )  THEN
1563                PRINT*, '+++ check_parameters:  unknown output profile:  ', &
1564                        'data_output_pr = ', data_output_pr(i)
1565             ENDIF
1566             CALL local_stop
1567
1568       END SELECT
1569!
1570!--    Check to which of the predefined coordinate systems the profile belongs
1571       DO  k = 1, crmax
1572          IF ( INDEX( cross_profiles(k), ' '//TRIM( data_output_pr(i) )//' ' ) &
1573               /=0 ) &
1574          THEN
1575             dopr_crossindex(i) = k
1576             EXIT
1577          ENDIF
1578       ENDDO
1579!
1580!--    Generate the text for the labels of the PROFIL output file. "-characters
1581!--    must be substituted, otherwise PROFIL would interpret them as TeX
1582!--    control characters
1583       dopr_label(i) = data_output_pr(i)
1584       position = INDEX( dopr_label(i) , '"' )
1585       DO WHILE ( position /= 0 )
1586          dopr_label(i)(position:position) = ''''
1587          position = INDEX( dopr_label(i) , '"' )
1588       ENDDO
1589
1590    ENDDO
1591
1592!
1593!-- y-value range of the coordinate system (PROFIL).
1594!-- x-value range determined in plot_1d.
1595    cross_uymin = 0.0
1596    IF ( z_max_do1d == -1.0 )  THEN
1597       cross_uymax = zu(nzt+1)
1598    ELSEIF ( z_max_do1d < zu(nzb+1)  .OR.  z_max_do1d > zu(nzt+1) )  THEN
1599       IF ( myid == 0 )  PRINT*, '+++ check_parameters:  z_max_do1d=',  &
1600                                 z_max_do1d,' must be >= ', zu(nzb+1),  &
1601                                 ' or <= ', zu(nzt+1)
1602       CALL local_stop
1603    ELSE
1604       cross_uymax = z_max_do1d
1605    ENDIF
1606
1607!
1608!-- Check whether the chosen normalizing factor for the coordinate systems is
1609!-- permissible
1610    DO  i = 1, crmax
1611       SELECT CASE ( TRIM( cross_normalized_x(i) ) )  ! TRIM required on IBM
1612
1613          CASE ( '', 'wpt0', 'ws2', 'tsw2', 'ws3', 'ws2tsw', 'wstsw2' )
1614             j = 0
1615
1616          CASE DEFAULT
1617             IF ( myid == 0 )  THEN
1618                PRINT*, '+++ check_parameters: unknown normalize method'
1619                PRINT*, '    cross_normalized_x="',cross_normalized_x(i),'"'
1620             ENDIF
1621             CALL local_stop
1622
1623       END SELECT
1624       SELECT CASE ( TRIM( cross_normalized_y(i) ) )  ! TRIM required on IBM
1625
1626          CASE ( '', 'z_i' )
1627             j = 0
1628
1629          CASE DEFAULT
1630             IF ( myid == 0 )  THEN
1631                PRINT*, '+++ check_parameters: unknown normalize method'
1632                PRINT*, '    cross_normalized_y="',cross_normalized_y(i),'"'
1633             ENDIF
1634             CALL local_stop
1635
1636       END SELECT
1637    ENDDO
1638!
1639!-- Check normalized y-value range of the coordinate system (PROFIL)
1640    IF ( z_max_do1d_normalized /= -1.0  .AND.  z_max_do1d_normalized <= 0.0 ) &
1641    THEN
1642       IF ( myid == 0 )  PRINT*,'+++ check_parameters:  z_max_do1d_normalize', &
1643                                'd=', z_max_do1d_normalized, ' must be >= 0.0'
1644       CALL local_stop
1645    ENDIF
1646
1647!
1648!-- Determine parameters for time series output and check whether permissible
1649    i = 0
1650    DO  WHILE ( data_output_ts(i+1) /= '          '  .AND.  i+1 <= 100 )
1651
1652       dots_n = dots_n + 1
1653       i = i + 1
1654!
1655!--    Check whether time series is permissible and determine internal number
1656       SELECT CASE ( TRIM( data_output_ts(i) ) )
1657
1658          CASE ( 'E' )
1659             dots_index(i) = 1
1660          CASE ( 'E*' )
1661             dots_index(i) = 2
1662          CASE ( 'dt' )
1663             dots_index(i) = 3
1664          CASE ( 'u*' )
1665             dots_index(i) = 4
1666          CASE ( 'th*' )
1667             dots_index(i) = 5
1668          CASE ( 'umax' )
1669             dots_index(i) = 6
1670          CASE ( 'vmax' )
1671             dots_index(i) = 7
1672          CASE ( 'wmax' )
1673             dots_index(i) = 8
1674          CASE ( 'div_new' )
1675             dots_index(i) = 9
1676          CASE ( 'div_old' )
1677             dots_index(i) = 10
1678          CASE ( 'z_i_wpt' )
1679             dots_index(i) = 11
1680          CASE ( 'z_i_pt' )
1681             dots_index(i) = 12
1682          CASE ( 'w*' )
1683             dots_index(i) = 13
1684          CASE ( 'w"pt"0' )
1685             dots_index(i) = 14
1686          CASE ( 'w"pt"' )
1687             dots_index(i) = 15
1688          CASE ( 'wpt' )
1689             dots_index(i) = 16
1690          CASE ( 'pt(0)' )
1691             dots_index(i) = 17
1692          CASE ( 'pt(zp)' )
1693             dots_index(i) = 18
1694          CASE ( 'splptx'  )
1695             dots_index(i) = 19
1696          CASE ( 'splpty'  )
1697             dots_index(i) = 20
1698          CASE ( 'splptz'  )
1699             dots_index(i) = 21
1700          CASE ( 'L'       )
1701             dots_index(i) = 22
1702
1703          CASE DEFAULT
1704             IF ( myid == 0 )  THEN
1705                PRINT*, '+++ check_parameters:  unknown time series:  ', &
1706                             'data_output_ts = ',&
1707                        data_output_ts(i)
1708             ENDIF
1709             CALL local_stop
1710
1711       END SELECT
1712
1713!
1714!--    Check, to which predefined coordinate system the time series belongs, and
1715!--    store corresponding internal number. Furthermore determine, how many and
1716!--    which graphs are being drawn into the corresponding system
1717       DO  k = 1, crmax
1718          IF ( INDEX( cross_ts_profiles(k), ' ' // TRIM( data_output_ts(i) ) &
1719                      // ' ' ) /=0 )  &
1720          THEN
1721             dots_crossindex(i) = k
1722             cross_ts_number_count(k) = cross_ts_number_count(k) + 1
1723             cross_ts_numbers(cross_ts_number_count(k),k) = dots_index(i)
1724             EXIT
1725          ENDIF
1726       ENDDO
1727
1728    ENDDO
1729
1730!
1731!-- Append user-defined data output variables to the standard data output
1732    IF ( data_output_user(1) /= ' ' )  THEN
1733       i = 1
1734       DO  WHILE ( data_output(i) /= ' '  .AND.  i <= 100 )
1735          i = i + 1
1736       ENDDO
1737       j = 1
1738       DO  WHILE ( data_output_user(j) /= ' '  .AND.  j <= 100 )
1739          IF ( i > 100 )  THEN
1740             IF ( myid == 0 )  THEN
1741                PRINT*, '+++ check_parameters: number of output quantitities', &
1742                             ' given by data_output and data_output_user'
1743                PRINT*, '                      exceeds the limit of 100'
1744             ENDIF
1745             CALL local_stop
1746          ENDIF
1747          data_output(i) = data_output_user(j)
1748          i = i + 1
1749          j = j + 1
1750       ENDDO
1751    ENDIF
1752
1753!
1754!-- Check and set steering parameters for 2d/3d data output and averaging
1755    i   = 1
1756    DO  WHILE ( data_output(i) /= ' '  .AND.  i <= 100 )
1757!
1758!--    Check for data averaging
1759       ilen = LEN_TRIM( data_output(i) )
1760       j = 0                                                 ! no data averaging
1761       IF ( ilen > 3 )  THEN
1762          IF ( data_output(i)(ilen-2:ilen) == '_av' )  THEN
1763             j = 1                                           ! data averaging
1764             data_output(i) = data_output(i)(1:ilen-3)
1765          ENDIF
1766       ENDIF
1767!
1768!--    Check for cross section or volume data
1769       ilen = LEN_TRIM( data_output(i) )
1770       k = 0                                                   ! 3d data
1771       var = data_output(i)(1:ilen)
1772       IF ( ilen > 3 )  THEN
1773          IF ( data_output(i)(ilen-2:ilen) == '_xy'  .OR. &
1774               data_output(i)(ilen-2:ilen) == '_xz'  .OR. &
1775               data_output(i)(ilen-2:ilen) == '_yz' )  THEN
1776             k = 1                                             ! 2d data
1777             var = data_output(i)(1:ilen-3)
1778          ENDIF
1779       ENDIF
1780!
1781!--    Check for allowed value and set units
1782       SELECT CASE ( TRIM( var ) )
1783
1784          CASE ( 'e' )
1785             IF ( constant_diffusion )  THEN
1786                IF ( myid == 0 )  THEN
1787                   PRINT*, '+++ check_parameters: output of "', TRIM( var ), &
1788                                '" requires constant_diffusion = .FALSE.'
1789                ENDIF
1790                CALL local_stop
1791             ENDIF
1792             unit = 'm2/s2'
1793
1794          CASE ( 'pc', 'pr' )
1795             IF ( .NOT. particle_advection )  THEN
1796                IF ( myid == 0 )  THEN
1797                   PRINT*, '+++ check_parameters: output of "', TRIM( var ), &
1798                                '" requires particle package'
1799                   PRINT*, '                      (mrun-option "-p particles")'
1800                ENDIF
1801                CALL local_stop
1802             ENDIF
1803             IF ( TRIM( var ) == 'pc' )  unit = 'number'
1804             IF ( TRIM( var ) == 'pr' )  unit = 'm'
1805
1806          CASE ( 'q', 'vpt' )
1807             IF ( .NOT. moisture )  THEN
1808                IF ( myid == 0 )  THEN
1809                   PRINT*, '+++ check_parameters: output of "', TRIM( var ), &
1810                                '" requires moisture = .TRUE.'
1811                ENDIF
1812                CALL local_stop
1813             ENDIF
1814             IF ( TRIM( var ) == 'q'   )  unit = 'kg/kg'
1815             IF ( TRIM( var ) == 'vpt' )  unit = 'K'
1816
1817          CASE ( 'ql' )
1818             IF ( .NOT. ( cloud_physics  .OR.  cloud_droplets ) )  THEN
1819                IF ( myid == 0 )  THEN
1820                   PRINT*, '+++ check_parameters: output of "', TRIM( var ), &
1821                                '" requires cloud_physics = .TRUE.'
1822                   PRINT*, '                      or cloud_droplets = .TRUE.'
1823                ENDIF
1824                CALL local_stop
1825             ENDIF
1826             unit = 'kg/kg'
1827
1828          CASE ( 'ql_c', 'ql_v', 'ql_vp' )
1829             IF ( .NOT. cloud_droplets )  THEN
1830                IF ( myid == 0 )  THEN
1831                   PRINT*, '+++ check_parameters: output of "', TRIM( var ), &
1832                                '" requires cloud_droplets = .TRUE.'
1833                ENDIF
1834                CALL local_stop
1835             ENDIF
1836             IF ( TRIM( var ) == 'ql_c'  )  unit = 'kg/kg'
1837             IF ( TRIM( var ) == 'ql_v'  )  unit = 'm3'
1838             IF ( TRIM( var ) == 'ql_vp' )  unit = 'none'
1839
1840          CASE ( 'qv' )
1841             IF ( .NOT. cloud_physics )  THEN
1842                IF ( myid == 0 )  THEN
1843                   PRINT*, '+++ check_parameters: output of "', TRIM( var ), &
1844                                '" requires cloud_physics = .TRUE.'
1845                ENDIF
1846                CALL local_stop
1847             ENDIF
1848             unit = 'kg/kg'
1849
1850          CASE ( 's' )
1851             IF ( .NOT. passive_scalar )  THEN
1852                IF ( myid == 0 )  THEN
1853                   PRINT*, '+++ check_parameters: output of "', TRIM( var ), &
1854                                '" requires passive_scalar = .TRUE.'
1855                ENDIF
1856                CALL local_stop
1857             ENDIF
1858             unit = 'conc'
1859
1860          CASE ( 'u*', 't*', 'lwp*' )
1861             IF ( k == 0  .OR.  data_output(i)(ilen-2:ilen) /= '_xy' )  THEN
1862                IF ( myid == 0 )  THEN
1863                   PRINT*, '+++ check_parameters:  illegal value for data_',&
1864                                'output: "', TRIM( var ), '" is only allowed'
1865                   PRINT*, '                       for horizontal cross section'
1866                ENDIF
1867                CALL local_stop
1868             ENDIF
1869             IF ( TRIM( var ) == 'lwp*'  .AND.  .NOT. cloud_physics )  THEN
1870                IF ( myid == 0 )  THEN
1871                   PRINT*, '+++ check_parameters: output of "', TRIM( var ), &
1872                                '" requires cloud_physics = .TRUE.'
1873                ENDIF
1874                CALL local_stop
1875             ENDIF
1876             IF ( TRIM( var ) == 'u*'   )  unit = 'm/s'
1877             IF ( TRIM( var ) == 't*'   )  unit = 'K'
1878             IF ( TRIM( var ) == 'lwp*' )  unit = 'kg/kg*m'
1879
1880          CASE ( 'p', 'pt', 'u', 'v', 'w' )
1881             IF ( TRIM( var ) == 'p'  )  unit = 'Pa'
1882             IF ( TRIM( var ) == 'pt' )  unit = 'K'
1883             IF ( TRIM( var ) == 'u'  )  unit = 'm/s'
1884             IF ( TRIM( var ) == 'v'  )  unit = 'm/s'
1885             IF ( TRIM( var ) == 'w'  )  unit = 'm/s'
1886             CONTINUE
1887
1888          CASE DEFAULT
1889             CALL user_check_data_output( var, unit )
1890
1891             IF ( unit == 'illegal' )  THEN
1892                IF ( myid == 0 )  THEN
1893                   IF ( data_output_user(1) /= ' ' )  THEN
1894                      PRINT*, '+++ check_parameters:  illegal value for data_',&
1895                                   'output or data_output_user: "',            &
1896                                   TRIM( data_output(i) ), '"'
1897                   ELSE
1898                      PRINT*, '+++ check_parameters:  illegal value for data_',&
1899                                   'output: "', TRIM( data_output(i) ), '"'
1900                   ENDIF
1901                ENDIF
1902                CALL local_stop
1903             ENDIF
1904
1905       END SELECT
1906!
1907!--    Set the internal steering parameters appropriately
1908       IF ( k == 0 )  THEN
1909          do3d_no(j)              = do3d_no(j) + 1
1910          do3d(j,do3d_no(j))      = data_output(i)
1911          do3d_unit(j,do3d_no(j)) = unit
1912       ELSE
1913          do2d_no(j)              = do2d_no(j) + 1
1914          do2d(j,do2d_no(j))      = data_output(i)
1915          do2d_unit(j,do2d_no(j)) = unit
1916          IF ( data_output(i)(ilen-2:ilen) == '_xy' )  THEN
1917             data_output_xy(j) = .TRUE.
1918          ENDIF
1919          IF ( data_output(i)(ilen-2:ilen) == '_xz' )  THEN
1920             data_output_xz(j) = .TRUE.
1921          ENDIF
1922          IF ( data_output(i)(ilen-2:ilen) == '_yz' )  THEN
1923             data_output_yz(j) = .TRUE.
1924          ENDIF
1925       ENDIF
1926
1927       IF ( j == 1 )  THEN
1928!
1929!--       Check, if variable is already subject to averaging
1930          found = .FALSE.
1931          DO  k = 1, doav_n
1932             IF ( TRIM( doav(k) ) == TRIM( var ) )  found = .TRUE.
1933          ENDDO
1934
1935          IF ( .NOT. found )  THEN
1936             doav_n = doav_n + 1
1937             doav(doav_n) = var
1938          ENDIF
1939       ENDIF
1940
1941       i = i + 1
1942    ENDDO
1943
1944!
1945!-- Store sectional planes in one shared array
1946    section(:,1) = section_xy
1947    section(:,2) = section_xz
1948    section(:,3) = section_yz
1949
1950!
1951!-- Upper plot limit (grid point value) for 1D profiles
1952    IF ( z_max_do1d == -1.0 )  THEN
1953       nz_do1d = nzt+1
1954    ELSE
1955       DO  k = nzb+1, nzt+1
1956          nz_do1d = k
1957          IF ( zw(k) > z_max_do1d )  EXIT
1958       ENDDO
1959    ENDIF
1960
1961!
1962!-- Upper plot limit for 2D vertical sections
1963    IF ( z_max_do2d == -1.0 )  z_max_do2d = zu(nzt)
1964    IF ( z_max_do2d < zu(nzb+1)  .OR.  z_max_do2d > zu(nzt) )  THEN
1965       IF ( myid == 0 )  PRINT*, '+++ check_parameters:  z_max_do2d=',        &
1966                                 z_max_do2d, ' must be >= ', zu(nzb+1),       &
1967                                 '(zu(nzb+1)) and <= ', zu(nzt), ' (zu(nzt))'
1968       CALL local_stop
1969    ENDIF
1970
1971!
1972!-- Upper plot limit for 3D arrays
1973    IF ( nz_do3d == -9999 )  nz_do3d = nzt + 1
1974
1975!
1976!-- Determine and check accuracy for compressed 3D plot output
1977    IF ( do3d_compress )  THEN
1978!
1979!--    Compression only permissible on T3E machines
1980       IF ( host(1:3) /= 't3e' )  THEN
1981          IF ( myid == 0 )  THEN
1982             PRINT*, '+++ check_parameters: do3d_compress = .TRUE. not allow', &
1983                          'ed on host "', TRIM( host ), '"'
1984          ENDIF
1985          CALL local_stop
1986       ENDIF
1987
1988       i = 1
1989       DO  WHILE ( do3d_comp_prec(i) /= ' ' )
1990
1991          ilen = LEN_TRIM( do3d_comp_prec(i) )
1992          IF ( LLT( do3d_comp_prec(i)(ilen:ilen), '0' ) .OR. &
1993               LGT( do3d_comp_prec(i)(ilen:ilen), '9' ) )  THEN
1994             IF ( myid == 0 )  THEN
1995                PRINT*, '+++ check_parameters: illegal precision: ', &
1996                        'do3d_comp_prec(', i, ')="', TRIM(do3d_comp_prec(i)),'"'
1997             ENDIF
1998             CALL local_stop
1999          ENDIF
2000
2001          prec = IACHAR( do3d_comp_prec(i)(ilen:ilen) ) - IACHAR( '0' )
2002          var = do3d_comp_prec(i)(1:ilen-1)
2003
2004          SELECT CASE ( var )
2005
2006             CASE ( 'u' )
2007                j = 1
2008             CASE ( 'v' )
2009                j = 2
2010             CASE ( 'w' )
2011                j = 3
2012             CASE ( 'p' )
2013                j = 4
2014             CASE ( 'pt' )
2015                j = 5
2016
2017             CASE DEFAULT
2018                IF ( myid == 0 )  THEN
2019                   PRINT*, '+++ check_parameters: unknown variable in ', &
2020                               'assignment'
2021                   PRINT*, '    do3d_comp_prec(', i, ')="', &
2022                           TRIM( do3d_comp_prec(i) ),'"'
2023                ENDIF
2024                CALL local_stop               
2025
2026          END SELECT
2027
2028          plot_3d_precision(j)%precision = prec
2029          i = i + 1
2030
2031       ENDDO
2032    ENDIF
2033
2034!
2035!-- Check the data output format(s)
2036    IF ( data_output_format(1) == ' ' )  THEN
2037!
2038!--    Default value
2039       netcdf_output = .TRUE.
2040    ELSE
2041       i = 1
2042       DO  WHILE ( data_output_format(i) /= ' ' )
2043
2044          SELECT CASE ( data_output_format(i) )
2045
2046             CASE ( 'netcdf' )
2047                netcdf_output = .TRUE.
2048             CASE ( 'iso2d' )
2049                iso2d_output  = .TRUE.
2050             CASE ( 'profil' )
2051                profil_output = .TRUE.
2052             CASE ( 'avs' )
2053                avs_output    = .TRUE.
2054
2055             CASE DEFAULT
2056                IF ( myid == 0 )  THEN
2057                   PRINT*, '+++ check_parameters:'
2058                   PRINT*, '    unknown value for data_output_format "', &
2059                                TRIM( data_output_format(i) ),'"'
2060                ENDIF
2061                CALL local_stop               
2062
2063          END SELECT
2064
2065          i = i + 1
2066          IF ( i > 10 )  EXIT
2067
2068       ENDDO
2069
2070    ENDIF
2071
2072!
2073!-- Check netcdf precison
2074    ldum = .FALSE.
2075    CALL define_netcdf_header( 'ch', ldum, 0 )
2076
2077!
2078!-- Check, whether a constant diffusion coefficient shall be used
2079    IF ( km_constant /= -1.0 )  THEN
2080       IF ( km_constant < 0.0 )  THEN
2081          IF ( myid == 0 )  PRINT*, '+++ check_parameters:  km_constant=', &
2082                                    km_constant, ' < 0.0'
2083          CALL local_stop
2084       ELSE
2085          IF ( prandtl_number < 0.0 )  THEN
2086             IF ( myid == 0 )  PRINT*,'+++ check_parameters:  prandtl_number=',&
2087                                      prandtl_number, ' < 0.0'
2088             CALL local_stop
2089          ENDIF
2090          constant_diffusion = .TRUE.
2091
2092          IF ( prandtl_layer )  THEN
2093             IF ( myid == 0 )  PRINT*, '+++ check_parameters:  prandtl_layer ',&
2094                                       'is not allowed with fixed value of km'
2095             CALL local_stop
2096          ENDIF
2097       ENDIF
2098    ENDIF
2099
2100!
2101!-- In case of non-cyclic lateral boundaries, set the default maximum value
2102!-- for the horizontal diffusivity used within the outflow damping layer,
2103!-- and check/set the width of the damping layer
2104    IF ( bc_lr /= 'cyclic' ) THEN
2105       IF ( km_damp_max == -1.0 )  THEN
2106          km_damp_max = 0.5 * dx
2107       ENDIF
2108       IF ( outflow_damping_width == -1.0 )  THEN
2109          outflow_damping_width = MIN( 20, nx/2 )
2110       ENDIF
2111       IF ( outflow_damping_width <= 0  .OR.  outflow_damping_width > nx )  THEN
2112          IF ( myid == 0 )  PRINT*, '+++ check_parameters: outflow_damping w',&
2113                                    'idth out of range'
2114          CALL local_stop
2115       ENDIF
2116    ENDIF
2117
2118    IF ( bc_ns /= 'cyclic' )  THEN
2119       IF ( km_damp_max == -1.0 )  THEN
2120          km_damp_max = 0.5 * dy
2121       ENDIF
2122       IF ( outflow_damping_width == -1.0 )  THEN
2123          outflow_damping_width = MIN( 20, ny/2 )
2124       ENDIF
2125       IF ( outflow_damping_width <= 0  .OR.  outflow_damping_width > ny )  THEN
2126          IF ( myid == 0 )  PRINT*, '+++ check_parameters: outflow_damping w',&
2127                                    'idth out of range'
2128          CALL local_stop
2129       ENDIF
2130    ENDIF
2131
2132!
2133!-- Check value range for rif
2134    IF ( rif_min >= rif_max )  THEN
2135       IF ( myid == 0 )  PRINT*, '+++ check_parameters:  rif_min=', rif_min, &
2136                                 ' must be less than rif_max=', rif_max
2137       CALL local_stop
2138    ENDIF
2139
2140!
2141!-- Determine upper and lower hight level indices for random perturbations
2142    IF ( disturbance_level_b == -1.0 )  THEN
2143       disturbance_level_b     = zu(nzb+3)
2144       disturbance_level_ind_b = nzb + 3
2145    ELSEIF ( disturbance_level_b < zu(3) )  THEN
2146       IF ( myid == 0 )  PRINT*, '+++ check_parameters:  disturbance_level_b=',&
2147                                 disturbance_level_b, ' must be >= ',zu(3),    &
2148                                 '(zu(3))'
2149       CALL local_stop
2150    ELSEIF ( disturbance_level_b > zu(nzt-2) )  THEN
2151       IF ( myid == 0 )  PRINT*, '+++ check_parameters:  disturbance_level_b=',&
2152                                 disturbance_level_b, ' must be <= ',zu(nzt-2),&
2153                                 '(zu(nzt-2))'
2154       CALL local_stop
2155    ELSE
2156       DO  k = 3, nzt-2
2157          IF ( disturbance_level_b <= zu(k) )  THEN
2158             disturbance_level_ind_b = k
2159             EXIT
2160          ENDIF
2161       ENDDO
2162    ENDIF
2163
2164    IF ( disturbance_level_t == -1.0 )  THEN
2165       disturbance_level_t     = zu(nzt/3)
2166       disturbance_level_ind_t = nzt / 3
2167    ELSEIF ( disturbance_level_t > zu(nzt-2) )  THEN
2168       IF ( myid == 0 )  PRINT*, '+++ check_parameters:  disturbance_level_t=',&
2169                                 disturbance_level_t, ' must be <= ',zu(nzt-2),&
2170                                 '(zu(nzt-2))'
2171       CALL local_stop
2172    ELSEIF ( disturbance_level_t < disturbance_level_b )  THEN
2173       IF ( myid == 0 )  PRINT*, '+++ check_parameters:  disturbance_level_t=',&
2174                                 disturbance_level_t, ' must be >= ',          &
2175                                 'disturbance_level_b=', disturbance_level_b
2176       CALL local_stop
2177    ELSE
2178       DO  k = 3, nzt-2
2179          IF ( disturbance_level_t <= zu(k) )  THEN
2180             disturbance_level_ind_t = k
2181             EXIT
2182          ENDIF
2183       ENDDO
2184    ENDIF
2185
2186!
2187!-- Check again whether the levels determined this way are ok.
2188!-- Error may occur at automatic determination and too few grid points in
2189!-- z-direction.
2190    IF ( disturbance_level_ind_t < disturbance_level_ind_b )  THEN
2191       IF ( myid == 0 )  PRINT*, '+++ check_parameters:  ',                &
2192                                 'disturbance_level_ind_t=',               &
2193                                 disturbance_level_ind_t, ' must be >= ',  &
2194                                 'disturbance_level_ind_b=',               &
2195                                 disturbance_level_ind_b
2196       CALL local_stop
2197    ENDIF
2198
2199!
2200!-- Determine the horizontal index range for random perturbations.
2201!-- In case of non-cyclic horizontal boundaries, no perturbations are imposed
2202!-- near the inflow and the perturbation area is further limited to ...(1)
2203!-- after the initial phase of the flow.
2204    dist_nxl = 0;  dist_nxr = nx
2205    dist_nys = 0;  dist_nyn = ny
2206    IF ( bc_lr /= 'cyclic' )  THEN
2207       IF ( inflow_disturbance_begin == -1 )  THEN
2208          inflow_disturbance_begin = MIN( 10, nx/2 )
2209       ENDIF
2210       IF ( inflow_disturbance_begin < 0  .OR.  inflow_disturbance_begin > nx )&
2211       THEN
2212          IF ( myid == 0 )  PRINT*, '+++ check_parameters: inflow_disturbance',&
2213                                    '_begin out of range'
2214          CALL local_stop
2215       ENDIF
2216       IF ( inflow_disturbance_end == -1 )  THEN
2217          inflow_disturbance_end = MIN( 100, 3*nx/4 )
2218       ENDIF
2219       IF ( inflow_disturbance_end < 0  .OR.  inflow_disturbance_end > nx )    &
2220       THEN
2221          IF ( myid == 0 )  PRINT*, '+++ check_parameters: inflow_disturbance',&
2222                                    '_end out of range'
2223          CALL local_stop
2224       ENDIF
2225    ELSEIF ( bc_ns /= 'cyclic' )  THEN
2226       IF ( inflow_disturbance_begin == -1 )  THEN
2227          inflow_disturbance_begin = MIN( 10, ny/2 )
2228       ENDIF
2229       IF ( inflow_disturbance_begin < 0  .OR.  inflow_disturbance_begin > ny )&
2230       THEN
2231          IF ( myid == 0 )  PRINT*, '+++ check_parameters: inflow_disturbance',&
2232                                    '_begin out of range'
2233          CALL local_stop
2234       ENDIF
2235       IF ( inflow_disturbance_end == -1 )  THEN
2236          inflow_disturbance_end = MIN( 100, 3*ny/4 )
2237       ENDIF
2238       IF ( inflow_disturbance_end < 0  .OR.  inflow_disturbance_end > ny )    &
2239       THEN
2240          IF ( myid == 0 )  PRINT*, '+++ check_parameters: inflow_disturbance',&
2241                                    '_end out of range'
2242          CALL local_stop
2243       ENDIF
2244    ENDIF
2245
2246    IF ( outflow_l )  THEN
2247       dist_nxr    = nx - inflow_disturbance_begin
2248       dist_nxl(1) = nx - inflow_disturbance_end
2249    ELSEIF ( outflow_r )  THEN
2250       dist_nxl    = inflow_disturbance_begin
2251       dist_nxr(1) = inflow_disturbance_end
2252    ELSEIF ( outflow_s )  THEN
2253       dist_nyn    = ny - inflow_disturbance_begin
2254       dist_nys(1) = ny - inflow_disturbance_end
2255    ELSEIF ( outflow_n )  THEN
2256       dist_nys    = inflow_disturbance_begin
2257       dist_nyn(1) = inflow_disturbance_end
2258    ENDIF
2259
2260!
2261!-- Check random generator
2262    IF ( random_generator /= 'system-specific'  .AND. &
2263         random_generator /= 'numerical-recipes' )  THEN
2264       IF ( myid == 0 )  THEN
2265          PRINT*, '+++ check_parameters:'
2266          PRINT*, '    unknown random generator: random_generator=', &
2267                  random_generator
2268       ENDIF
2269       CALL local_stop
2270    ENDIF
2271
2272!
2273!-- Determine damping level index for 1D model
2274    IF ( INDEX( initializing_actions, 'set_1d-model_profiles' ) /= 0 )  THEN
2275       IF ( damp_level_1d == -1.0 )  THEN
2276          damp_level_1d     = zu(nzt+1)
2277          damp_level_ind_1d = nzt + 1
2278       ELSEIF ( damp_level_1d < 0.0  .OR.  damp_level_1d > zu(nzt+1) )  THEN
2279          IF ( myid == 0 )  PRINT*, '+++ check_parameters:  damp_level_1d=', &
2280                                    damp_level_1d, ' must be > 0.0 and < ',  &
2281                                    'zu(nzt+1)', zu(nzt+1)
2282          CALL local_stop
2283       ELSE
2284          DO  k = 1, nzt+1
2285             IF ( damp_level_1d <= zu(k) )  THEN
2286                damp_level_ind_1d = k
2287                EXIT
2288             ENDIF
2289          ENDDO
2290       ENDIF
2291    ENDIF
2292!
2293!-- Check some other 1d-model parameters
2294    IF ( TRIM( mixing_length_1d ) /= 'as_in_3d_model'  .AND. &
2295         TRIM( mixing_length_1d ) /= 'blackadar' )  THEN
2296       IF ( myid == 0 )  PRINT*, '+++ check_parameters: mixing_length_1d = "', &
2297                                 TRIM( mixing_length_1d ), '" is unknown'
2298       CALL local_stop
2299    ENDIF
2300    IF ( TRIM( dissipation_1d ) /= 'as_in_3d_model'  .AND. &
2301         TRIM( dissipation_1d ) /= 'detering' )  THEN
2302       IF ( myid == 0 )  PRINT*, '+++ check_parameters: dissipation_1d = "', &
2303                                 TRIM( dissipation_1d ), '" is unknown'
2304       CALL local_stop
2305    ENDIF
2306
2307!
2308!-- Set time for the next user defined restart (time_restart is the
2309!-- internal parameter for steering restart events)
2310    IF ( restart_time /= 9999999.9 )  THEN
2311       IF ( restart_time > simulated_time )  time_restart = restart_time
2312    ELSE
2313!
2314!--    In case of a restart run, set internal parameter to default (no restart)
2315!--    if the NAMELIST-parameter restart_time is omitted
2316       time_restart = 9999999.9
2317    ENDIF
2318
2319!
2320!-- Set default value of the time needed to terminate a model run
2321    IF ( termination_time_needed == -1.0 )  THEN
2322       IF ( host(1:3) == 'ibm' )  THEN
2323          termination_time_needed = 300.0
2324       ELSE
2325          termination_time_needed = 35.0
2326       ENDIF
2327    ENDIF
2328
2329!
2330!-- Check the time needed to terminate a model run
2331    IF ( host(1:3) == 't3e' )  THEN
2332!
2333!--    Time needed must be at least 30 seconds on all CRAY machines, because
2334!--    MPP_TREMAIN gives the remaining CPU time only in steps of 30 seconds
2335       IF ( termination_time_needed <= 30.0 )  THEN
2336          IF ( myid == 0 )  THEN
2337             PRINT*, '+++ check_parameters:  termination_time_needed', &
2338                      termination_time_needed
2339             PRINT*, '                       must be > 30.0 on host "', host, &
2340                     '"'
2341          ENDIF
2342          CALL local_stop
2343       ENDIF
2344    ELSEIF ( host(1:3) == 'ibm' )  THEN
2345!
2346!--    On IBM-regatta machines the time should be at least 300 seconds,
2347!--    because the job time consumed before executing palm (for compiling,
2348!--    copying of files, etc.) has to be regarded
2349       IF ( termination_time_needed < 300.0 )  THEN
2350          IF ( myid == 0 )  THEN
2351             PRINT*, '+++ WARNING: check_parameters:  termination_time_',  &
2352                         'needed', termination_time_needed
2353             PRINT*, '                                should be >= 300.0', &
2354                         ' on host "', host, '"'
2355          ENDIF
2356       ENDIF
2357    ENDIF
2358
2359
2360 END SUBROUTINE check_parameters
Note: See TracBrowser for help on using the repository browser.