source: palm/trunk/SOURCE/check_parameters.f90 @ 31

Last change on this file since 31 was 20, checked in by raasch, 17 years ago

new parameter use_top_fluxes, Bugfix: ddzw dimensioned 1:nzt+1

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