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

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

New:
---
ocean version including prognostic equation for salinity and equation of state for seawater. Routine buoyancy can be used with both temperature and density.
+ inipar-parameters bc_sa_t, bottom_salinityflux, ocean, sa_surface, sa_vertical_gradient, sa_vertical_gradient_level, top_salinityflux

advec_s_bc, average_3d_data, boundary_conds, buoyancy, check_parameters, data_output_2d, data_output_3d, diffusion_e, flow_statistics, header, init_grid, init_3d_model, modules, netcdf, parin, production_e, prognostic_equations, read_var_list, sum_up_3d_data, swap_timelevel, time_integration, user_interface, write_var_list, write_3d_binary

New:
eqn_state_seawater, init_ocean

Changed:


inipar-parameter use_pt_reference renamed use_reference

hydro_press renamed hyp, routine calc_mean_pt_profile renamed calc_mean_profile

format adjustments for the ocean version (run_control)

advec_particles, buoyancy, calc_liquid_water_content, check_parameters, diffusion_e, diffusivities, header, init_cloud_physics, modules, production_e, prognostic_equations, run_control

Errors:


Bugfix: height above topography instead of height above level k=0 is used for calculating the mixing length (diffusion_e and diffusivities).

Bugfix: error in boundary condition for TKE removed (advec_s_bc)

advec_s_bc, diffusion_e, prognostic_equations

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