source: palm/trunk/SOURCE/header.f90 @ 869

Last change on this file since 869 was 869, checked in by raasch, 12 years ago

last commit documented

  • Property svn:keywords set to Id
File size: 79.7 KB
Line 
1 SUBROUTINE header
2
3!------------------------------------------------------------------------------!
4! Current revisions:
5! -----------------
6!
7!
8! Former revisions:
9! -----------------
10! $Id: header.f90 869 2012-03-28 12:21:50Z raasch $
11!
12! 868 2012-03-28 12:21:07Z raasch
13! translation velocity in Galilean transformation changed to 0.6 * ug
14!
15! 833 2012-02-22 08:55:55Z maronga
16! Adjusted format for leaf area density
17!
18! 828 2012-02-21 12:00:36Z raasch
19! output of dissipation_classes + radius_classes
20!
21! 825 2012-02-19 03:03:44Z raasch
22! Output of cloud physics parameters/quantities complemented and restructured
23!
24! 767 2011-10-14 06:39:12Z raasch
25! Output of given initial u,v-profiles
26!
27! 759 2011-09-15 13:58:31Z raasch
28! output of maximum number of parallel io streams
29!
30! 707 2011-03-29 11:39:40Z raasch
31! bc_lr/ns replaced by bc_lr/ns_cyc
32!
33! 667 2010-12-23 12:06:00Z suehring/gryschka
34! Output of advection scheme.
35! Modified output of Prandtl-layer height.
36!
37! 580 2010-10-05 13:59:11Z heinze
38! Renaming of ws_vertical_gradient to subs_vertical_gradient,
39! ws_vertical_gradient_level to subs_vertical_gradient_level and
40! ws_vertical_gradient_level_ind to subs_vertical_gradient_level_i
41!
42! 493 2010-03-01 08:30:24Z raasch
43! NetCDF data output format extendend for NetCDF4/HDF5
44!
45! 449 2010-02-02 11:23:59Z raasch
46! +large scale vertical motion (subsidence/ascent)
47! Bugfix: index problem concerning gradient_level indices removed
48!
49! 410 2009-12-04 17:05:40Z letzel
50! Masked data output: + dt_domask, mask_01~20_x|y|z, mask_01~20_x|y|z_loop,
51! mask_scale|_x|y|z, masks, skip_time_domask
52!
53! 346 2009-07-06 10:13:41Z raasch
54! initializing_actions='read_data_for_recycling' renamed to 'cyclic_fill'
55! Coupling with independent precursor runs.
56! Output of messages replaced by message handling routine.
57! Output of several additional dvr parameters
58! +canyon_height, canyon_width_x, canyon_width_y, canyon_wall_left,
59! canyon_wall_south, conserve_volume_flow_mode, dp_external, dp_level_b,
60! dp_smooth, dpdxy, u_bulk, v_bulk
61! topography_grid_convention moved from user_header
62! small bugfix concerning 3d 64bit netcdf output format
63!
64! 206 2008-10-13 14:59:11Z raasch
65! Bugfix: error in zu index in case of section_xy = -1
66!
67! 198 2008-09-17 08:55:28Z raasch
68! Format adjustments allowing output of larger revision numbers
69!
70! 197 2008-09-16 15:29:03Z raasch
71! allow 100 spectra levels instead of 10 for consistency with
72! define_netcdf_header,
73! bugfix in the output of the characteristic levels of potential temperature,
74! geostrophic wind, scalar concentration, humidity and leaf area density,
75! output of turbulence recycling informations
76!
77! 138 2007-11-28 10:03:58Z letzel
78! Allow new case bc_uv_t = 'dirichlet_0' for channel flow.
79! Allow two instead of one digit to specify isosurface and slicer variables.
80! Output of sorting frequency of particles
81!
82! 108 2007-08-24 15:10:38Z letzel
83! Output of informations for coupled model runs (boundary conditions etc.)
84! + output of momentumfluxes at the top boundary
85! Rayleigh damping for ocean, e_init
86!
87! 97 2007-06-21 08:23:15Z raasch
88! Adjustments for the ocean version.
89! use_pt_reference renamed use_reference
90!
91! 87 2007-05-22 15:46:47Z raasch
92! Bugfix: output of use_upstream_for_tke
93!
94! 82 2007-04-16 15:40:52Z raasch
95! Preprocessor strings for different linux clusters changed to "lc",
96! routine local_flush is used for buffer flushing
97!
98! 76 2007-03-29 00:58:32Z raasch
99! Output of netcdf_64bit_3d, particles-package is now part of the default code,
100! output of the loop optimization method, moisture renamed humidity,
101! output of subversion revision number
102!
103! 19 2007-02-23 04:53:48Z raasch
104! Output of scalar flux applied at top boundary
105!
106! RCS Log replace by Id keyword, revision history cleaned up
107!
108! Revision 1.63  2006/08/22 13:53:13  raasch
109! Output of dz_max
110!
111! Revision 1.1  1997/08/11 06:17:20  raasch
112! Initial revision
113!
114!
115! Description:
116! ------------
117! Writing a header with all important informations about the actual run.
118! This subroutine is called three times, two times at the beginning
119! (writing information on files RUN_CONTROL and HEADER) and one time at the
120! end of the run, then writing additional information about CPU-usage on file
121! header.
122!-----------------------------------------------------------------------------!
123
124    USE arrays_3d
125    USE control_parameters
126    USE cloud_parameters
127    USE cpulog
128    USE dvrp_variables
129    USE grid_variables
130    USE indices
131    USE model_1d
132    USE particle_attributes
133    USE pegrid
134    USE subsidence_mod
135    USE spectrum
136
137    IMPLICIT NONE
138
139    CHARACTER (LEN=1)  ::  prec
140    CHARACTER (LEN=2)  ::  do2d_mode
141    CHARACTER (LEN=5)  ::  section_chr
142    CHARACTER (LEN=9)  ::  time_to_string
143    CHARACTER (LEN=10) ::  coor_chr, host_chr
144    CHARACTER (LEN=16) ::  begin_chr
145    CHARACTER (LEN=23) ::  ver_rev
146    CHARACTER (LEN=40) ::  output_format
147    CHARACTER (LEN=70) ::  char1, char2, dopr_chr, &
148                           do2d_xy, do2d_xz, do2d_yz, do3d_chr, &
149                           domask_chr, run_classification
150    CHARACTER (LEN=86) ::  coordinates, gradients, learde, slices,  &
151                           temperatures, ugcomponent, vgcomponent
152    CHARACTER (LEN=85) ::  roben, runten
153
154    CHARACTER (LEN=1), DIMENSION(1:3) ::  dir = (/ 'x', 'y', 'z' /)
155
156    INTEGER ::  av, bh, blx, bly, bxl, bxr, byn, bys, ch, count, cwx, cwy,  &
157         cxl, cxr, cyn, cys, dim, i, ihost, io, j, l, ll, m, mpi_type
158    REAL    ::  cpuseconds_per_simulated_second
159
160!
161!-- Open the output file. At the end of the simulation, output is directed
162!-- to unit 19.
163    IF ( ( runnr == 0 .OR. force_print_header )  .AND. &
164         .NOT. simulated_time_at_begin /= simulated_time )  THEN
165       io = 15   !  header output on file RUN_CONTROL
166    ELSE
167       io = 19   !  header output on file HEADER
168    ENDIF
169    CALL check_open( io )
170
171!
172!-- At the end of the run, output file (HEADER) will be rewritten with
173!-- new informations
174    IF ( io == 19 .AND. simulated_time_at_begin /= simulated_time ) REWIND( 19 )
175
176!
177!-- Determine kind of model run
178    IF ( TRIM( initializing_actions ) == 'read_restart_data' )  THEN
179       run_classification = '3D - restart run'
180    ELSEIF ( TRIM( initializing_actions ) == 'cyclic_fill' )  THEN
181       run_classification = '3D - run with cyclic fill of 3D - prerun data'
182    ELSEIF ( INDEX( initializing_actions, 'set_constant_profiles' ) /= 0 )  THEN
183       run_classification = '3D - run without 1D - prerun'
184    ELSEIF ( INDEX( initializing_actions, 'set_1d-model_profiles' ) /= 0 )  THEN
185       run_classification = '3D - run with 1D - prerun'
186    ELSEIF ( INDEX( initializing_actions, 'by_user' ) /=0 )  THEN
187       run_classification = '3D - run initialized by user'
188    ELSE
189       message_string = ' unknown action(s): ' // TRIM( initializing_actions )
190       CALL message( 'header', 'PA0191', 0, 0, 0, 6, 0 )
191    ENDIF
192    IF ( ocean )  THEN
193       run_classification = 'ocean - ' // run_classification
194    ELSE
195       run_classification = 'atmosphere - ' // run_classification
196    ENDIF
197
198!
199!-- Run-identification, date, time, host
200    host_chr = host(1:10)
201    ver_rev = TRIM( version ) // '  ' // TRIM( revision )
202    WRITE ( io, 100 )  ver_rev, TRIM( run_classification )
203    IF ( TRIM( coupling_mode ) /= 'uncoupled' )  THEN
204#if defined( __mpi2 )
205       mpi_type = 2
206#else
207       mpi_type = 1
208#endif
209       WRITE ( io, 101 )  mpi_type, coupling_mode
210    ENDIF
211    WRITE ( io, 102 )  run_date, run_identifier, run_time, runnr, &
212                       ADJUSTR( host_chr )
213#if defined( __parallel )
214    IF ( npex == -1  .AND.  pdims(2) /= 1 )  THEN
215       char1 = 'calculated'
216    ELSEIF ( ( host(1:3) == 'ibm'  .OR.  host(1:3) == 'nec'  .OR.  &
217               host(1:2) == 'lc' )  .AND.                          &
218             npex == -1  .AND.  pdims(2) == 1 )  THEN
219       char1 = 'forced'
220    ELSE
221       char1 = 'predefined'
222    ENDIF
223    IF ( threads_per_task == 1 )  THEN
224       WRITE ( io, 103 )  numprocs, pdims(1), pdims(2), TRIM( char1 )
225    ELSE
226       WRITE ( io, 104 )  numprocs*threads_per_task, numprocs, &
227                          threads_per_task, pdims(1), pdims(2), TRIM( char1 )
228    ENDIF
229    IF ( ( host(1:3) == 'ibm'  .OR.  host(1:3) == 'nec'  .OR.    &
230           host(1:2) == 'lc'   .OR.  host(1:3) == 'dec' )  .AND. &
231         npex == -1  .AND.  pdims(2) == 1 )                      &
232    THEN
233       WRITE ( io, 106 )
234    ELSEIF ( pdims(2) == 1 )  THEN
235       WRITE ( io, 107 )  'x'
236    ELSEIF ( pdims(1) == 1 )  THEN
237       WRITE ( io, 107 )  'y'
238    ENDIF
239    IF ( use_seperate_pe_for_dvrp_output )  WRITE ( io, 105 )
240    IF ( numprocs /= maximum_parallel_io_streams )  THEN
241       WRITE ( io, 108 )  maximum_parallel_io_streams
242    ENDIF
243#endif
244    WRITE ( io, 99 )
245
246!
247!-- Numerical schemes
248    WRITE ( io, 110 )
249    IF ( psolver(1:7) == 'poisfft' )  THEN
250       WRITE ( io, 111 )  TRIM( fft_method )
251       IF ( psolver == 'poisfft_hybrid' )  WRITE ( io, 138 )
252    ELSEIF ( psolver == 'sor' )  THEN
253       WRITE ( io, 112 )  nsor_ini, nsor, omega_sor
254    ELSEIF ( psolver == 'multigrid' )  THEN
255       WRITE ( io, 135 )  cycle_mg, maximum_grid_level, ngsrb
256       IF ( mg_cycles == -1 )  THEN
257          WRITE ( io, 140 )  residual_limit
258       ELSE
259          WRITE ( io, 141 )  mg_cycles
260       ENDIF
261       IF ( mg_switch_to_pe0_level == 0 )  THEN
262          WRITE ( io, 136 )  nxr_mg(1)-nxl_mg(1)+1, nyn_mg(1)-nys_mg(1)+1, &
263                             nzt_mg(1)
264       ELSEIF (  mg_switch_to_pe0_level /= -1 )  THEN
265          WRITE ( io, 137 )  mg_switch_to_pe0_level,            &
266                             mg_loc_ind(2,0)-mg_loc_ind(1,0)+1, &
267                             mg_loc_ind(4,0)-mg_loc_ind(3,0)+1, &
268                             nzt_mg(mg_switch_to_pe0_level),    &
269                             nxr_mg(1)-nxl_mg(1)+1, nyn_mg(1)-nys_mg(1)+1, &
270                             nzt_mg(1)
271       ENDIF
272    ENDIF
273    IF ( call_psolver_at_all_substeps  .AND. timestep_scheme(1:5) == 'runge' ) &
274    THEN
275       WRITE ( io, 142 )
276    ENDIF
277
278    IF ( momentum_advec == 'pw-scheme' )  THEN
279       WRITE ( io, 113 )
280    ELSEIF (momentum_advec == 'ws-scheme' ) THEN
281       WRITE ( io, 503 )
282    ELSEIF (momentum_advec == 'ups-scheme' ) THEN
283       WRITE ( io, 114 )
284       IF ( cut_spline_overshoot )  WRITE ( io, 124 )
285       IF ( overshoot_limit_u /= 0.0  .OR.  overshoot_limit_v /= 0.0  .OR. &
286            overshoot_limit_w /= 0.0 )  THEN
287          WRITE ( io, 127 )  overshoot_limit_u, overshoot_limit_v, &
288                             overshoot_limit_w
289       ENDIF
290       IF ( ups_limit_u /= 0.0  .OR.  ups_limit_v /= 0.0  .OR. &
291            ups_limit_w /= 0.0 )                               &
292       THEN
293          WRITE ( io, 125 )  ups_limit_u, ups_limit_v, ups_limit_w
294       ENDIF
295       IF ( long_filter_factor /= 0.0 )  WRITE ( io, 115 )  long_filter_factor
296    ENDIF
297    IF ( scalar_advec == 'pw-scheme' )  THEN
298       WRITE ( io, 116 )
299    ELSEIF ( scalar_advec == 'ws-scheme' )  THEN
300       WRITE ( io, 504 )
301    ELSEIF ( scalar_advec == 'ups-scheme' )  THEN
302       WRITE ( io, 117 )
303       IF ( cut_spline_overshoot )  WRITE ( io, 124 )
304       IF ( overshoot_limit_e /= 0.0  .OR.  overshoot_limit_pt /= 0.0 )  THEN
305          WRITE ( io, 128 )  overshoot_limit_e, overshoot_limit_pt
306       ENDIF
307       IF ( ups_limit_e /= 0.0  .OR.  ups_limit_pt /= 0.0 )  THEN
308          WRITE ( io, 126 )  ups_limit_e, ups_limit_pt
309       ENDIF
310    ELSE
311       WRITE ( io, 118 )
312    ENDIF
313
314    WRITE ( io, 139 )  TRIM( loop_optimization )
315
316    IF ( galilei_transformation )  THEN
317       IF ( use_ug_for_galilei_tr )  THEN
318          char1 = '0.6 * geostrophic wind'
319       ELSE
320          char1 = 'mean wind in model domain'
321       ENDIF
322       IF ( simulated_time_at_begin == simulated_time )  THEN
323          char2 = 'at the start of the run'
324       ELSE
325          char2 = 'at the end of the run'
326       ENDIF
327       WRITE ( io, 119 )  TRIM( char1 ), TRIM( char2 ), &
328                          advected_distance_x/1000.0, advected_distance_y/1000.0
329    ENDIF
330    IF ( timestep_scheme == 'leapfrog' )  THEN
331       WRITE ( io, 120 )
332    ELSEIF ( timestep_scheme == 'leapfrog+euler' )  THEN
333       WRITE ( io, 121 )
334    ELSE
335       WRITE ( io, 122 )  timestep_scheme
336    ENDIF
337    IF ( use_upstream_for_tke )  WRITE ( io, 143 )
338    IF ( rayleigh_damping_factor /= 0.0 )  THEN
339       IF ( .NOT. ocean )  THEN
340          WRITE ( io, 123 )  'above', rayleigh_damping_height, &
341               rayleigh_damping_factor
342       ELSE
343          WRITE ( io, 123 )  'below', rayleigh_damping_height, &
344               rayleigh_damping_factor
345       ENDIF
346    ENDIF
347    IF ( humidity )  THEN
348       IF ( .NOT. cloud_physics )  THEN
349          WRITE ( io, 129 )
350       ELSE
351          WRITE ( io, 130 )
352       ENDIF
353    ENDIF
354    IF ( passive_scalar )  WRITE ( io, 134 )
355    IF ( conserve_volume_flow )  THEN
356       WRITE ( io, 150 )  conserve_volume_flow_mode
357       IF ( TRIM( conserve_volume_flow_mode ) == 'bulk_velocity' )  THEN
358          WRITE ( io, 151 )  u_bulk, v_bulk
359       ENDIF
360    ELSEIF ( dp_external )  THEN
361       IF ( dp_smooth )  THEN
362          WRITE ( io, 152 )  dpdxy, dp_level_b, ', vertically smoothed.'
363       ELSE
364          WRITE ( io, 152 )  dpdxy, dp_level_b, '.'
365       ENDIF
366    ENDIF
367    IF ( large_scale_subsidence )  THEN
368        WRITE ( io, 153 )
369        WRITE ( io, 154 )
370    ENDIF
371    WRITE ( io, 99 )
372
373!
374!-- Runtime and timestep informations
375    WRITE ( io, 200 )
376    IF ( .NOT. dt_fixed )  THEN
377       WRITE ( io, 201 )  dt_max, cfl_factor
378    ELSE
379       WRITE ( io, 202 )  dt
380    ENDIF
381    WRITE ( io, 203 )  simulated_time_at_begin, end_time
382
383    IF ( time_restart /= 9999999.9  .AND. &
384         simulated_time_at_begin == simulated_time )  THEN
385       IF ( dt_restart == 9999999.9 )  THEN
386          WRITE ( io, 204 )  ' Restart at:       ',time_restart
387       ELSE
388          WRITE ( io, 205 )  ' Restart at:       ',time_restart, dt_restart
389       ENDIF
390    ENDIF
391
392    IF ( simulated_time_at_begin /= simulated_time )  THEN
393       i = MAX ( log_point_s(10)%counts, 1 )
394       IF ( ( simulated_time - simulated_time_at_begin ) == 0.0 )  THEN
395          cpuseconds_per_simulated_second = 0.0
396       ELSE
397          cpuseconds_per_simulated_second = log_point_s(10)%sum / &
398                                            ( simulated_time -    &
399                                              simulated_time_at_begin )
400       ENDIF
401       WRITE ( io, 206 )  simulated_time, log_point_s(10)%sum, &
402                          log_point_s(10)%sum / REAL( i ),     &
403                          cpuseconds_per_simulated_second
404       IF ( time_restart /= 9999999.9  .AND.  time_restart < end_time )  THEN
405          IF ( dt_restart == 9999999.9 )  THEN
406             WRITE ( io, 204 )  ' Next restart at:  ',time_restart
407          ELSE
408             WRITE ( io, 205 )  ' Next restart at:  ',time_restart, dt_restart
409          ENDIF
410       ENDIF
411    ENDIF
412
413!
414!-- Start time for coupled runs, if independent precursor runs for atmosphere
415!-- and ocean are used. In this case, coupling_start_time defines the time
416!-- when the coupling is switched on.
417    IF ( coupling_start_time /= 0.0 )  THEN
418       IF ( coupling_start_time >= simulated_time_at_begin )  THEN
419          char1 = 'Precursor run for a coupled atmosphere-ocean run'
420       ELSE
421          char1 = 'Coupled atmosphere-ocean run following independent ' // &
422                  'precursor runs'
423       ENDIF
424       WRITE ( io, 207 )  char1, coupling_start_time
425    ENDIF
426
427!
428!-- Computational grid
429    IF ( .NOT. ocean )  THEN
430       WRITE ( io, 250 )  dx, dy, dz, (nx+1)*dx, (ny+1)*dy, zu(nzt+1)
431       IF ( dz_stretch_level_index < nzt+1 )  THEN
432          WRITE ( io, 252 )  dz_stretch_level, dz_stretch_level_index, &
433                             dz_stretch_factor, dz_max
434       ENDIF
435    ELSE
436       WRITE ( io, 250 )  dx, dy, dz, (nx+1)*dx, (ny+1)*dy, zu(0)
437       IF ( dz_stretch_level_index > 0 )  THEN
438          WRITE ( io, 252 )  dz_stretch_level, dz_stretch_level_index, &
439                             dz_stretch_factor, dz_max
440       ENDIF
441    ENDIF
442    WRITE ( io, 254 )  nx, ny, nzt+1, MIN( nnx, nx+1 ), MIN( nny, ny+1 ), &
443                       MIN( nnz+2, nzt+2 )
444    IF ( numprocs > 1 )  THEN
445       IF ( nxa == nx  .AND.  nya == ny  .AND.  nza == nz )  THEN
446          WRITE ( io, 255 )
447       ELSE
448          WRITE ( io, 256 )  nnx-(nxa-nx), nny-(nya-ny), nzt+2
449       ENDIF
450    ENDIF
451    IF ( sloping_surface )  WRITE ( io, 260 )  alpha_surface
452
453!
454!-- Topography
455    WRITE ( io, 270 )  topography
456    SELECT CASE ( TRIM( topography ) )
457
458       CASE ( 'flat' )
459          ! no actions necessary
460
461       CASE ( 'single_building' )
462          blx = INT( building_length_x / dx )
463          bly = INT( building_length_y / dy )
464          bh  = INT( building_height / dz )
465
466          IF ( building_wall_left == 9999999.9 )  THEN
467             building_wall_left = ( nx + 1 - blx ) / 2 * dx
468          ENDIF
469          bxl = INT ( building_wall_left / dx + 0.5 )
470          bxr = bxl + blx
471
472          IF ( building_wall_south == 9999999.9 )  THEN
473             building_wall_south = ( ny + 1 - bly ) / 2 * dy
474          ENDIF
475          bys = INT ( building_wall_south / dy + 0.5 )
476          byn = bys + bly
477
478          WRITE ( io, 271 )  building_length_x, building_length_y, &
479                             building_height, bxl, bxr, bys, byn
480
481       CASE ( 'single_street_canyon' )
482          ch  = NINT( canyon_height / dz )
483          IF ( canyon_width_x /= 9999999.9 )  THEN
484!
485!--          Street canyon in y direction
486             cwx = NINT( canyon_width_x / dx )
487             IF ( canyon_wall_left == 9999999.9 )  THEN
488                canyon_wall_left = ( nx + 1 - cwx ) / 2 * dx
489             ENDIF
490             cxl = NINT( canyon_wall_left / dx )
491             cxr = cxl + cwx
492             WRITE ( io, 272 )  'y', canyon_height, ch, 'u', cxl, cxr
493
494          ELSEIF ( canyon_width_y /= 9999999.9 )  THEN
495!
496!--          Street canyon in x direction
497             cwy = NINT( canyon_width_y / dy )
498             IF ( canyon_wall_south == 9999999.9 )  THEN
499                canyon_wall_south = ( ny + 1 - cwy ) / 2 * dy
500             ENDIF
501             cys = NINT( canyon_wall_south / dy )
502             cyn = cys + cwy
503             WRITE ( io, 272 )  'x', canyon_height, ch, 'v', cys, cyn
504          ENDIF
505
506    END SELECT
507
508    IF ( TRIM( topography ) /= 'flat' )  THEN
509       IF ( TRIM( topography_grid_convention ) == ' ' )  THEN
510          IF ( TRIM( topography ) == 'single_building' .OR.  &
511               TRIM( topography ) == 'single_street_canyon' )  THEN
512             WRITE ( io, 278 )
513          ELSEIF ( TRIM( topography ) == 'read_from_file' )  THEN
514             WRITE ( io, 279 )
515          ENDIF
516       ELSEIF ( TRIM( topography_grid_convention ) == 'cell_edge' )  THEN
517          WRITE ( io, 278 )
518       ELSEIF ( TRIM( topography_grid_convention ) == 'cell_center' )  THEN
519          WRITE ( io, 279 )
520       ENDIF
521    ENDIF
522
523    IF ( plant_canopy ) THEN
524
525       WRITE ( io, 280 ) canopy_mode, pch_index, drag_coefficient
526       IF ( passive_scalar ) THEN
527          WRITE ( io, 281 ) scalar_exchange_coefficient,   &
528                            leaf_surface_concentration
529       ENDIF
530
531!
532!--    Heat flux at the top of vegetation
533       WRITE ( io, 282 ) cthf
534
535!
536!--    Leaf area density profile
537!--    Building output strings, starting with surface value
538       WRITE ( learde, '(F6.4)' )  lad_surface
539       gradients = '------'
540       slices = '     0'
541       coordinates = '   0.0'
542       i = 1
543       DO  WHILE ( lad_vertical_gradient_level_ind(i) /= -9999 )
544
545          WRITE (coor_chr,'(F7.2)')  lad(lad_vertical_gradient_level_ind(i))
546          learde = TRIM( learde ) // ' ' // TRIM( coor_chr )
547
548          WRITE (coor_chr,'(F7.2)')  lad_vertical_gradient(i)
549          gradients = TRIM( gradients ) // ' ' // TRIM( coor_chr )
550
551          WRITE (coor_chr,'(I7)')  lad_vertical_gradient_level_ind(i)
552          slices = TRIM( slices ) // ' ' // TRIM( coor_chr )
553
554          WRITE (coor_chr,'(F7.1)')  lad_vertical_gradient_level(i)
555          coordinates = TRIM( coordinates ) // ' '  // TRIM( coor_chr )
556
557          i = i + 1
558       ENDDO
559
560       WRITE ( io, 283 )  TRIM( coordinates ), TRIM( learde ), &
561                          TRIM( gradients ), TRIM( slices )
562
563    ENDIF
564
565!
566!-- Boundary conditions
567    IF ( ibc_p_b == 0 )  THEN
568       runten = 'p(0)     = 0      |'
569    ELSEIF ( ibc_p_b == 1 )  THEN
570       runten = 'p(0)     = p(1)   |'
571    ELSE
572       runten = 'p(0)     = p(1) +R|'
573    ENDIF
574    IF ( ibc_p_t == 0 )  THEN
575       roben  = 'p(nzt+1) = 0      |'
576    ELSE
577       roben  = 'p(nzt+1) = p(nzt) |'
578    ENDIF
579
580    IF ( ibc_uv_b == 0 )  THEN
581       runten = TRIM( runten ) // ' uv(0)     = -uv(1)                |'
582    ELSE
583       runten = TRIM( runten ) // ' uv(0)     = uv(1)                 |'
584    ENDIF
585    IF ( TRIM( bc_uv_t ) == 'dirichlet_0' )  THEN
586       roben  = TRIM( roben  ) // ' uv(nzt+1) = 0                     |'
587    ELSEIF ( ibc_uv_t == 0 )  THEN
588       roben  = TRIM( roben  ) // ' uv(nzt+1) = ug(nzt+1), vg(nzt+1)  |'
589    ELSE
590       roben  = TRIM( roben  ) // ' uv(nzt+1) = uv(nzt)               |'
591    ENDIF
592
593    IF ( ibc_pt_b == 0 )  THEN
594       runten = TRIM( runten ) // ' pt(0)   = pt_surface'
595    ELSEIF ( ibc_pt_b == 1 )  THEN
596       runten = TRIM( runten ) // ' pt(0)   = pt(1)'
597    ELSEIF ( ibc_pt_b == 2 )  THEN
598       runten = TRIM( runten ) // ' pt(0) = from coupled model'
599    ENDIF
600    IF ( ibc_pt_t == 0 )  THEN
601       roben  = TRIM( roben  ) // ' pt(nzt+1) = pt_top'
602    ELSEIF( ibc_pt_t == 1 )  THEN
603       roben  = TRIM( roben  ) // ' pt(nzt+1) = pt(nzt)'
604    ELSEIF( ibc_pt_t == 2 )  THEN
605       roben  = TRIM( roben  ) // ' pt(nzt+1) = pt(nzt) + dpt/dz_ini'
606
607    ENDIF
608
609    WRITE ( io, 300 )  runten, roben
610
611    IF ( .NOT. constant_diffusion )  THEN
612       IF ( ibc_e_b == 1 )  THEN
613          runten = 'e(0)     = e(1)'
614       ELSE
615          runten = 'e(0)     = e(1) = (u*/0.1)**2'
616       ENDIF
617       roben = 'e(nzt+1) = e(nzt) = e(nzt-1)'
618
619       WRITE ( io, 301 )  'e', runten, roben       
620
621    ENDIF
622
623    IF ( ocean )  THEN
624       runten = 'sa(0)    = sa(1)'
625       IF ( ibc_sa_t == 0 )  THEN
626          roben =  'sa(nzt+1) = sa_surface'
627       ELSE
628          roben =  'sa(nzt+1) = sa(nzt)'
629       ENDIF
630       WRITE ( io, 301 ) 'sa', runten, roben
631    ENDIF
632
633    IF ( humidity )  THEN
634       IF ( ibc_q_b == 0 )  THEN
635          runten = 'q(0)     = q_surface'
636       ELSE
637          runten = 'q(0)     = q(1)'
638       ENDIF
639       IF ( ibc_q_t == 0 )  THEN
640          roben =  'q(nzt)   = q_top'
641       ELSE
642          roben =  'q(nzt)   = q(nzt-1) + dq/dz'
643       ENDIF
644       WRITE ( io, 301 ) 'q', runten, roben
645    ENDIF
646
647    IF ( passive_scalar )  THEN
648       IF ( ibc_q_b == 0 )  THEN
649          runten = 's(0)     = s_surface'
650       ELSE
651          runten = 's(0)     = s(1)'
652       ENDIF
653       IF ( ibc_q_t == 0 )  THEN
654          roben =  's(nzt)   = s_top'
655       ELSE
656          roben =  's(nzt)   = s(nzt-1) + ds/dz'
657       ENDIF
658       WRITE ( io, 301 ) 's', runten, roben
659    ENDIF
660
661    IF ( use_surface_fluxes )  THEN
662       WRITE ( io, 303 )
663       IF ( constant_heatflux )  THEN
664          WRITE ( io, 306 )  surface_heatflux
665          IF ( random_heatflux )  WRITE ( io, 307 )
666       ENDIF
667       IF ( humidity  .AND.  constant_waterflux )  THEN
668          WRITE ( io, 311 ) surface_waterflux
669       ENDIF
670       IF ( passive_scalar  .AND.  constant_waterflux )  THEN
671          WRITE ( io, 313 ) surface_waterflux
672       ENDIF
673    ENDIF
674
675    IF ( use_top_fluxes )  THEN
676       WRITE ( io, 304 )
677       IF ( coupling_mode == 'uncoupled' )  THEN
678          WRITE ( io, 320 )  top_momentumflux_u, top_momentumflux_v
679          IF ( constant_top_heatflux )  THEN
680             WRITE ( io, 306 )  top_heatflux
681          ENDIF
682       ELSEIF ( coupling_mode == 'ocean_to_atmosphere' )  THEN
683          WRITE ( io, 316 )
684       ENDIF
685       IF ( ocean  .AND.  constant_top_salinityflux )  THEN
686          WRITE ( io, 309 )  top_salinityflux
687       ENDIF
688       IF ( humidity  .OR.  passive_scalar )  THEN
689          WRITE ( io, 315 )
690       ENDIF
691    ENDIF
692
693    IF ( prandtl_layer )  THEN
694       WRITE ( io, 305 )  (zu(1)-zu(0)), roughness_length, kappa, &
695                          rif_min, rif_max
696       IF ( .NOT. constant_heatflux )  WRITE ( io, 308 )
697       IF ( humidity  .AND.  .NOT. constant_waterflux )  THEN
698          WRITE ( io, 312 )
699       ENDIF
700       IF ( passive_scalar  .AND.  .NOT. constant_waterflux )  THEN
701          WRITE ( io, 314 )
702       ENDIF
703    ELSE
704       IF ( INDEX(initializing_actions, 'set_1d-model_profiles') /= 0 )  THEN
705          WRITE ( io, 310 )  rif_min, rif_max
706       ENDIF
707    ENDIF
708
709    WRITE ( io, 317 )  bc_lr, bc_ns
710    IF ( .NOT. bc_lr_cyc  .OR.  .NOT. bc_ns_cyc )  THEN
711       WRITE ( io, 318 )  outflow_damping_width, km_damp_max
712       IF ( turbulent_inflow )  THEN
713          WRITE ( io, 319 )  recycling_width, recycling_plane, &
714                             inflow_damping_height, inflow_damping_width
715       ENDIF
716    ENDIF
717
718!
719!-- Listing of 1D-profiles
720    WRITE ( io, 325 )  dt_dopr_listing
721    IF ( averaging_interval_pr /= 0.0 )  THEN
722       WRITE ( io, 326 )  averaging_interval_pr, dt_averaging_input_pr
723    ENDIF
724
725!
726!-- DATA output
727    WRITE ( io, 330 )
728    IF ( averaging_interval_pr /= 0.0 )  THEN
729       WRITE ( io, 326 )  averaging_interval_pr, dt_averaging_input_pr
730    ENDIF
731
732!
733!-- 1D-profiles
734    dopr_chr = 'Profile:'
735    IF ( dopr_n /= 0 )  THEN
736       WRITE ( io, 331 )
737
738       output_format = ''
739       IF ( netcdf_output )  THEN
740          IF ( netcdf_data_format == 1 )  THEN
741             output_format = 'NetCDF classic'
742          ELSE
743             output_format = 'NetCDF 64bit offset'
744          ENDIF
745       ENDIF
746       IF ( profil_output )  THEN
747          IF ( netcdf_output )  THEN
748             output_format = TRIM( output_format ) // ' and profil'
749          ELSE
750             output_format = 'profil'
751          ENDIF
752       ENDIF
753       WRITE ( io, 344 )  output_format
754
755       DO  i = 1, dopr_n
756          dopr_chr = TRIM( dopr_chr ) // ' ' // TRIM( data_output_pr(i) ) // ','
757          IF ( LEN_TRIM( dopr_chr ) >= 60 )  THEN
758             WRITE ( io, 332 )  dopr_chr
759             dopr_chr = '       :'
760          ENDIF
761       ENDDO
762
763       IF ( dopr_chr /= '' )  THEN
764          WRITE ( io, 332 )  dopr_chr
765       ENDIF
766       WRITE ( io, 333 )  dt_dopr, averaging_interval_pr, dt_averaging_input_pr
767       IF ( skip_time_dopr /= 0.0 )  WRITE ( io, 339 )  skip_time_dopr
768    ENDIF
769
770!
771!-- 2D-arrays
772    DO  av = 0, 1
773
774       i = 1
775       do2d_xy = ''
776       do2d_xz = ''
777       do2d_yz = ''
778       DO  WHILE ( do2d(av,i) /= ' ' )
779
780          l = MAX( 2, LEN_TRIM( do2d(av,i) ) )
781          do2d_mode = do2d(av,i)(l-1:l)
782
783          SELECT CASE ( do2d_mode )
784             CASE ( 'xy' )
785                ll = LEN_TRIM( do2d_xy )
786                do2d_xy = do2d_xy(1:ll) // ' ' // do2d(av,i)(1:l-3) // ','
787             CASE ( 'xz' )
788                ll = LEN_TRIM( do2d_xz )
789                do2d_xz = do2d_xz(1:ll) // ' ' // do2d(av,i)(1:l-3) // ','
790             CASE ( 'yz' )
791                ll = LEN_TRIM( do2d_yz )
792                do2d_yz = do2d_yz(1:ll) // ' ' // do2d(av,i)(1:l-3) // ','
793          END SELECT
794
795          i = i + 1
796
797       ENDDO
798
799       IF ( ( ( do2d_xy /= ''  .AND.  section(1,1) /= -9999 )  .OR.    &
800              ( do2d_xz /= ''  .AND.  section(1,2) /= -9999 )  .OR.    &
801              ( do2d_yz /= ''  .AND.  section(1,3) /= -9999 ) )  .AND. &
802            ( netcdf_output  .OR.  iso2d_output ) )  THEN
803
804          IF (  av == 0 )  THEN
805             WRITE ( io, 334 )  ''
806          ELSE
807             WRITE ( io, 334 )  '(time-averaged)'
808          ENDIF
809
810          IF ( do2d_at_begin )  THEN
811             begin_chr = 'and at the start'
812          ELSE
813             begin_chr = ''
814          ENDIF
815
816          output_format = ''
817          IF ( netcdf_output )  THEN
818             IF ( netcdf_data_format == 1 )  THEN
819                output_format = 'NetCDF classic'
820             ELSEIF ( netcdf_data_format == 2 )  THEN
821                output_format = 'NetCDF 64bit offset'
822             ELSEIF ( netcdf_data_format == 3 )  THEN
823                output_format = 'NetCDF4/HDF5'
824             ELSEIF ( netcdf_data_format == 4 )  THEN
825                output_format = 'NetCDF4/HDF5 clasic'
826             ENDIF
827          ENDIF
828          IF ( iso2d_output )  THEN
829             IF ( netcdf_output )  THEN
830                output_format = TRIM( output_format ) // ' and iso2d'
831             ELSE
832                output_format = 'iso2d'
833             ENDIF
834          ENDIF
835          WRITE ( io, 344 )  output_format
836
837          IF ( do2d_xy /= ''  .AND.  section(1,1) /= -9999 )  THEN
838             i = 1
839             slices = '/'
840             coordinates = '/'
841!
842!--          Building strings with index and coordinate informations of the
843!--          slices
844             DO  WHILE ( section(i,1) /= -9999 )
845
846                WRITE (section_chr,'(I5)')  section(i,1)
847                section_chr = ADJUSTL( section_chr )
848                slices = TRIM( slices ) // TRIM( section_chr ) // '/'
849
850                IF ( section(i,1) == -1 )  THEN
851                   WRITE (coor_chr,'(F10.1)')  -1.0
852                ELSE
853                   WRITE (coor_chr,'(F10.1)')  zu(section(i,1))
854                ENDIF
855                coor_chr = ADJUSTL( coor_chr )
856                coordinates = TRIM( coordinates ) // TRIM( coor_chr ) // '/'
857
858                i = i + 1
859             ENDDO
860             IF ( av == 0 )  THEN
861                WRITE ( io, 335 )  'XY', do2d_xy, dt_do2d_xy, &
862                                   TRIM( begin_chr ), 'k', TRIM( slices ), &
863                                   TRIM( coordinates )
864                IF ( skip_time_do2d_xy /= 0.0 )  THEN
865                   WRITE ( io, 339 )  skip_time_do2d_xy
866                ENDIF
867             ELSE
868                WRITE ( io, 342 )  'XY', do2d_xy, dt_data_output_av, &
869                                   TRIM( begin_chr ), averaging_interval, &
870                                   dt_averaging_input, 'k', TRIM( slices ), &
871                                   TRIM( coordinates )
872                IF ( skip_time_data_output_av /= 0.0 )  THEN
873                   WRITE ( io, 339 )  skip_time_data_output_av
874                ENDIF
875             ENDIF
876
877          ENDIF
878
879          IF ( do2d_xz /= ''  .AND.  section(1,2) /= -9999 )  THEN
880             i = 1
881             slices = '/'
882             coordinates = '/'
883!
884!--          Building strings with index and coordinate informations of the
885!--          slices
886             DO  WHILE ( section(i,2) /= -9999 )
887
888                WRITE (section_chr,'(I5)')  section(i,2)
889                section_chr = ADJUSTL( section_chr )
890                slices = TRIM( slices ) // TRIM( section_chr ) // '/'
891
892                WRITE (coor_chr,'(F10.1)')  section(i,2) * dy
893                coor_chr = ADJUSTL( coor_chr )
894                coordinates = TRIM( coordinates ) // TRIM( coor_chr ) // '/'
895
896                i = i + 1
897             ENDDO
898             IF ( av == 0 )  THEN
899                WRITE ( io, 335 )  'XZ', do2d_xz, dt_do2d_xz, &
900                                   TRIM( begin_chr ), 'j', TRIM( slices ), &
901                                   TRIM( coordinates )
902                IF ( skip_time_do2d_xz /= 0.0 )  THEN
903                   WRITE ( io, 339 )  skip_time_do2d_xz
904                ENDIF
905             ELSE
906                WRITE ( io, 342 )  'XZ', do2d_xz, dt_data_output_av, &
907                                   TRIM( begin_chr ), averaging_interval, &
908                                   dt_averaging_input, 'j', TRIM( slices ), &
909                                   TRIM( coordinates )
910                IF ( skip_time_data_output_av /= 0.0 )  THEN
911                   WRITE ( io, 339 )  skip_time_data_output_av
912                ENDIF
913             ENDIF
914          ENDIF
915
916          IF ( do2d_yz /= ''  .AND.  section(1,3) /= -9999 )  THEN
917             i = 1
918             slices = '/'
919             coordinates = '/'
920!
921!--          Building strings with index and coordinate informations of the
922!--          slices
923             DO  WHILE ( section(i,3) /= -9999 )
924
925                WRITE (section_chr,'(I5)')  section(i,3)
926                section_chr = ADJUSTL( section_chr )
927                slices = TRIM( slices ) // TRIM( section_chr ) // '/'
928
929                WRITE (coor_chr,'(F10.1)')  section(i,3) * dx
930                coor_chr = ADJUSTL( coor_chr )
931                coordinates = TRIM( coordinates ) // TRIM( coor_chr ) // '/'
932
933                i = i + 1
934             ENDDO
935             IF ( av == 0 )  THEN
936                WRITE ( io, 335 )  'YZ', do2d_yz, dt_do2d_yz, &
937                                   TRIM( begin_chr ), 'i', TRIM( slices ), &
938                                   TRIM( coordinates )
939                IF ( skip_time_do2d_yz /= 0.0 )  THEN
940                   WRITE ( io, 339 )  skip_time_do2d_yz
941                ENDIF
942             ELSE
943                WRITE ( io, 342 )  'YZ', do2d_yz, dt_data_output_av, &
944                                   TRIM( begin_chr ), averaging_interval, &
945                                   dt_averaging_input, 'i', TRIM( slices ), &
946                                   TRIM( coordinates )
947                IF ( skip_time_data_output_av /= 0.0 )  THEN
948                   WRITE ( io, 339 )  skip_time_data_output_av
949                ENDIF
950             ENDIF
951          ENDIF
952
953       ENDIF
954
955    ENDDO
956
957!
958!-- 3d-arrays
959    DO  av = 0, 1
960
961       i = 1
962       do3d_chr = ''
963       DO  WHILE ( do3d(av,i) /= ' ' )
964
965          do3d_chr = TRIM( do3d_chr ) // ' ' // TRIM( do3d(av,i) ) // ','
966          i = i + 1
967
968       ENDDO
969
970       IF ( do3d_chr /= '' )  THEN
971          IF ( av == 0 )  THEN
972             WRITE ( io, 336 )  ''
973          ELSE
974             WRITE ( io, 336 )  '(time-averaged)'
975          ENDIF
976
977          output_format = ''
978          IF ( netcdf_output )  THEN
979             IF ( netcdf_data_format == 1 )  THEN
980                output_format = 'NetCDF classic'
981             ELSEIF ( netcdf_data_format == 2 )  THEN
982                output_format = 'NetCDF 64bit offset'
983             ELSEIF ( netcdf_data_format == 3 )  THEN
984                output_format = 'NetCDF4/HDF5'
985             ELSEIF ( netcdf_data_format == 4 )  THEN
986                output_format = 'NetCDF4/HDF5 clasic'
987             ENDIF
988          ENDIF
989          IF ( avs_output )  THEN
990             IF ( netcdf_output )  THEN
991                output_format = TRIM( output_format ) // ' and avs'
992             ELSE
993                output_format = 'avs'
994             ENDIF
995          ENDIF
996          WRITE ( io, 344 )  output_format
997
998          IF ( do3d_at_begin )  THEN
999             begin_chr = 'and at the start'
1000          ELSE
1001             begin_chr = ''
1002          ENDIF
1003          IF ( av == 0 )  THEN
1004             WRITE ( io, 337 )  do3d_chr, dt_do3d, TRIM( begin_chr ), &
1005                                zu(nz_do3d), nz_do3d
1006          ELSE
1007             WRITE ( io, 343 )  do3d_chr, dt_data_output_av,           &
1008                                TRIM( begin_chr ), averaging_interval, &
1009                                dt_averaging_input, zu(nz_do3d), nz_do3d
1010          ENDIF
1011
1012          IF ( do3d_compress )  THEN
1013             do3d_chr = ''
1014             i = 1
1015             DO WHILE ( do3d(av,i) /= ' ' )
1016
1017                SELECT CASE ( do3d(av,i) )
1018                   CASE ( 'u' )
1019                      j = 1
1020                   CASE ( 'v' )
1021                      j = 2
1022                   CASE ( 'w' )
1023                      j = 3
1024                   CASE ( 'p' )
1025                      j = 4
1026                   CASE ( 'pt' )
1027                      j = 5
1028                END SELECT
1029                WRITE ( prec, '(I1)' )  plot_3d_precision(j)%precision
1030                do3d_chr = TRIM( do3d_chr ) // ' ' // TRIM( do3d(av,i) ) // &
1031                           ':' // prec // ','
1032                i = i + 1
1033
1034             ENDDO
1035             WRITE ( io, 338 )  do3d_chr
1036
1037          ENDIF
1038
1039          IF ( av == 0 )  THEN
1040             IF ( skip_time_do3d /= 0.0 )  THEN
1041                WRITE ( io, 339 )  skip_time_do3d
1042             ENDIF
1043          ELSE
1044             IF ( skip_time_data_output_av /= 0.0 )  THEN
1045                WRITE ( io, 339 )  skip_time_data_output_av
1046             ENDIF
1047          ENDIF
1048
1049       ENDIF
1050
1051    ENDDO
1052
1053!
1054!-- masked arrays
1055    IF ( masks > 0 )  WRITE ( io, 345 )  &
1056         mask_scale_x, mask_scale_y, mask_scale_z
1057    DO  mid = 1, masks
1058       DO  av = 0, 1
1059
1060          i = 1
1061          domask_chr = ''
1062          DO  WHILE ( domask(mid,av,i) /= ' ' )
1063             domask_chr = TRIM( domask_chr ) // ' ' //  &
1064                          TRIM( domask(mid,av,i) ) // ','
1065             i = i + 1
1066          ENDDO
1067
1068          IF ( domask_chr /= '' )  THEN
1069             IF ( av == 0 )  THEN
1070                WRITE ( io, 346 )  '', mid
1071             ELSE
1072                WRITE ( io, 346 )  ' (time-averaged)', mid
1073             ENDIF
1074
1075             output_format = ''
1076             IF ( netcdf_output )  THEN
1077                IF ( netcdf_data_format == 1 )  THEN
1078                   output_format = 'NetCDF classic'
1079                ELSEIF ( netcdf_data_format == 2 )  THEN
1080                   output_format = 'NetCDF 64bit offset'
1081                ELSEIF ( netcdf_data_format == 3 )  THEN
1082                   output_format = 'NetCDF4/HDF5'
1083                ELSEIF ( netcdf_data_format == 4 )  THEN
1084                   output_format = 'NetCDF4/HDF5 clasic'
1085                ENDIF
1086             ENDIF
1087             WRITE ( io, 344 )  output_format
1088
1089             IF ( av == 0 )  THEN
1090                WRITE ( io, 347 )  domask_chr, dt_domask(mid)
1091             ELSE
1092                WRITE ( io, 348 )  domask_chr, dt_data_output_av, &
1093                                   averaging_interval, dt_averaging_input
1094             ENDIF
1095
1096             IF ( av == 0 )  THEN
1097                IF ( skip_time_domask(mid) /= 0.0 )  THEN
1098                   WRITE ( io, 339 )  skip_time_domask(mid)
1099                ENDIF
1100             ELSE
1101                IF ( skip_time_data_output_av /= 0.0 )  THEN
1102                   WRITE ( io, 339 )  skip_time_data_output_av
1103                ENDIF
1104             ENDIF
1105!
1106!--          output locations
1107             DO  dim = 1, 3
1108                IF ( mask(mid,dim,1) >= 0.0 )  THEN
1109                   count = 0
1110                   DO  WHILE ( mask(mid,dim,count+1) >= 0.0 )
1111                      count = count + 1
1112                   ENDDO
1113                   WRITE ( io, 349 )  dir(dim), dir(dim), mid, dir(dim), &
1114                                      mask(mid,dim,:count)
1115                ELSEIF ( mask_loop(mid,dim,1) < 0.0 .AND.  &
1116                         mask_loop(mid,dim,2) < 0.0 .AND.  &
1117                         mask_loop(mid,dim,3) == 0.0 )  THEN
1118                   WRITE ( io, 350 )  dir(dim), dir(dim)
1119                ELSEIF ( mask_loop(mid,dim,3) == 0.0 )  THEN
1120                   WRITE ( io, 351 )  dir(dim), dir(dim), mid, dir(dim), &
1121                                      mask_loop(mid,dim,1:2)
1122                ELSE
1123                   WRITE ( io, 351 )  dir(dim), dir(dim), mid, dir(dim), &
1124                                      mask_loop(mid,dim,1:3)
1125                ENDIF
1126             ENDDO
1127          ENDIF
1128
1129       ENDDO
1130    ENDDO
1131
1132!
1133!-- Timeseries
1134    IF ( dt_dots /= 9999999.9 )  THEN
1135       WRITE ( io, 340 )
1136
1137       output_format = ''
1138       IF ( netcdf_output )  THEN
1139          IF ( netcdf_data_format == 1 )  THEN
1140             output_format = 'NetCDF classic'
1141          ELSE
1142             output_format = 'NetCDF 64bit offset'
1143          ENDIF
1144       ENDIF
1145       IF ( profil_output )  THEN
1146          IF ( netcdf_output )  THEN
1147             output_format = TRIM( output_format ) // ' and profil'
1148          ELSE
1149             output_format = 'profil'
1150          ENDIF
1151       ENDIF
1152       WRITE ( io, 344 )  output_format
1153       WRITE ( io, 341 )  dt_dots
1154    ENDIF
1155
1156#if defined( __dvrp_graphics )
1157!
1158!-- Dvrp-output
1159    IF ( dt_dvrp /= 9999999.9 )  THEN
1160       WRITE ( io, 360 )  dt_dvrp, TRIM( dvrp_output ), TRIM( dvrp_host ), &
1161                          TRIM( dvrp_username ), TRIM( dvrp_directory )
1162       i = 1
1163       l = 0
1164       m = 0
1165       DO WHILE ( mode_dvrp(i) /= ' ' )
1166          IF ( mode_dvrp(i)(1:10) == 'isosurface' )  THEN
1167             READ ( mode_dvrp(i), '(10X,I2)' )  j
1168             l = l + 1
1169             IF ( do3d(0,j) /= ' ' )  THEN
1170                WRITE ( io, 361 )  TRIM( do3d(0,j) ), threshold(l), &
1171                                   isosurface_color(:,l)
1172             ENDIF
1173          ELSEIF ( mode_dvrp(i)(1:6) == 'slicer' )  THEN
1174             READ ( mode_dvrp(i), '(6X,I2)' )  j
1175             m = m + 1
1176             IF ( do2d(0,j) /= ' ' )  THEN
1177                WRITE ( io, 362 )  TRIM( do2d(0,j) ), &
1178                                   slicer_range_limits_dvrp(:,m)
1179             ENDIF
1180          ELSEIF ( mode_dvrp(i)(1:9) == 'particles' )  THEN
1181             WRITE ( io, 363 )  dvrp_psize
1182             IF ( particle_dvrpsize /= 'none' )  THEN
1183                WRITE ( io, 364 )  'size', TRIM( particle_dvrpsize ), &
1184                                   dvrpsize_interval
1185             ENDIF
1186             IF ( particle_color /= 'none' )  THEN
1187                WRITE ( io, 364 )  'color', TRIM( particle_color ), &
1188                                   color_interval
1189             ENDIF
1190          ENDIF
1191          i = i + 1
1192       ENDDO
1193
1194       WRITE ( io, 365 )  groundplate_color, superelevation_x, &
1195                          superelevation_y, superelevation, clip_dvrp_l, &
1196                          clip_dvrp_r, clip_dvrp_s, clip_dvrp_n
1197
1198       IF ( TRIM( topography ) /= 'flat' )  THEN
1199          WRITE ( io, 366 )  topography_color
1200          IF ( cluster_size > 1 )  THEN
1201             WRITE ( io, 367 )  cluster_size
1202          ENDIF
1203       ENDIF
1204
1205    ENDIF
1206#endif
1207
1208#if defined( __spectra )
1209!
1210!-- Spectra output
1211    IF ( dt_dosp /= 9999999.9 ) THEN
1212       WRITE ( io, 370 )
1213
1214       output_format = ''
1215       IF ( netcdf_output )  THEN
1216          IF ( netcdf_data_format == 1 )  THEN
1217             output_format = 'NetCDF classic'
1218          ELSE
1219             output_format = 'NetCDF 64bit offset'
1220          ENDIF
1221       ENDIF
1222       IF ( profil_output )  THEN
1223          IF ( netcdf_output )  THEN
1224             output_format = TRIM( output_format ) // ' and profil'
1225          ELSE
1226             output_format = 'profil'
1227          ENDIF
1228       ENDIF
1229       WRITE ( io, 344 )  output_format
1230       WRITE ( io, 371 )  dt_dosp
1231       IF ( skip_time_dosp /= 0.0 )  WRITE ( io, 339 )  skip_time_dosp
1232       WRITE ( io, 372 )  ( data_output_sp(i), i = 1,10 ),     &
1233                          ( spectra_direction(i), i = 1,10 ),  &
1234                          ( comp_spectra_level(i), i = 1,100 ), &
1235                          ( plot_spectra_level(i), i = 1,100 ), &
1236                          averaging_interval_sp, dt_averaging_input_pr
1237    ENDIF
1238#endif
1239
1240    WRITE ( io, 99 )
1241
1242!
1243!-- Physical quantities
1244    WRITE ( io, 400 )
1245
1246!
1247!-- Geostrophic parameters
1248    WRITE ( io, 410 )  omega, phi, f, fs
1249
1250!
1251!-- Other quantities
1252    WRITE ( io, 411 )  g
1253    IF ( use_reference )  THEN
1254       IF ( ocean )  THEN
1255          WRITE ( io, 412 )  prho_reference
1256       ELSE
1257          WRITE ( io, 413 )  pt_reference
1258       ENDIF
1259    ENDIF
1260
1261!
1262!-- Cloud physics parameters
1263    IF ( cloud_physics ) THEN
1264       WRITE ( io, 415 )
1265       WRITE ( io, 416 ) surface_pressure, r_d, rho_surface, cp, l_v
1266    ENDIF
1267
1268!-- Profile of the geostrophic wind (component ug)
1269!-- Building output strings
1270    WRITE ( ugcomponent, '(F6.2)' )  ug_surface
1271    gradients = '------'
1272    slices = '     0'
1273    coordinates = '   0.0'
1274    i = 1
1275    DO  WHILE ( ug_vertical_gradient_level_ind(i) /= -9999 )
1276     
1277       WRITE (coor_chr,'(F6.2,1X)')  ug(ug_vertical_gradient_level_ind(i))
1278       ugcomponent = TRIM( ugcomponent ) // '  ' // TRIM( coor_chr )
1279
1280       WRITE (coor_chr,'(F6.2,1X)')  ug_vertical_gradient(i)
1281       gradients = TRIM( gradients ) // '  ' // TRIM( coor_chr )
1282
1283       WRITE (coor_chr,'(I6,1X)')  ug_vertical_gradient_level_ind(i)
1284       slices = TRIM( slices ) // '  ' // TRIM( coor_chr )
1285
1286       WRITE (coor_chr,'(F6.1,1X)')  ug_vertical_gradient_level(i)
1287       coordinates = TRIM( coordinates ) // '  ' // TRIM( coor_chr )
1288
1289       IF ( i == 10 )  THEN
1290          EXIT
1291       ELSE
1292          i = i + 1
1293       ENDIF
1294
1295    ENDDO
1296
1297    WRITE ( io, 423 )  TRIM( coordinates ), TRIM( ugcomponent ), &
1298                       TRIM( gradients ), TRIM( slices )
1299
1300!-- Profile of the geostrophic wind (component vg)
1301!-- Building output strings
1302    WRITE ( vgcomponent, '(F6.2)' )  vg_surface
1303    gradients = '------'
1304    slices = '     0'
1305    coordinates = '   0.0'
1306    i = 1
1307    DO  WHILE ( vg_vertical_gradient_level_ind(i) /= -9999 )
1308
1309       WRITE (coor_chr,'(F6.2,1X)')  vg(vg_vertical_gradient_level_ind(i))
1310       vgcomponent = TRIM( vgcomponent ) // '  ' // TRIM( coor_chr )
1311
1312       WRITE (coor_chr,'(F6.2,1X)')  vg_vertical_gradient(i)
1313       gradients = TRIM( gradients ) // '  ' // TRIM( coor_chr )
1314
1315       WRITE (coor_chr,'(I6,1X)')  vg_vertical_gradient_level_ind(i)
1316       slices = TRIM( slices ) // '  ' // TRIM( coor_chr )
1317
1318       WRITE (coor_chr,'(F6.1,1X)')  vg_vertical_gradient_level(i)
1319       coordinates = TRIM( coordinates ) // '  ' // TRIM( coor_chr )
1320
1321       IF ( i == 10 )  THEN
1322          EXIT
1323       ELSE
1324          i = i + 1
1325       ENDIF
1326 
1327    ENDDO
1328
1329    WRITE ( io, 424 )  TRIM( coordinates ), TRIM( vgcomponent ), &
1330                       TRIM( gradients ), TRIM( slices )
1331
1332!
1333!-- Initial wind profiles
1334    IF ( u_profile(1) /= 9999999.9 )  WRITE ( io, 427 )
1335
1336!
1337!-- Initial temperature profile
1338!-- Building output strings, starting with surface temperature
1339    WRITE ( temperatures, '(F6.2)' )  pt_surface
1340    gradients = '------'
1341    slices = '     0'
1342    coordinates = '   0.0'
1343    i = 1
1344    DO  WHILE ( pt_vertical_gradient_level_ind(i) /= -9999 )
1345
1346       WRITE (coor_chr,'(F7.2)')  pt_init(pt_vertical_gradient_level_ind(i))
1347       temperatures = TRIM( temperatures ) // ' ' // TRIM( coor_chr )
1348
1349       WRITE (coor_chr,'(F7.2)')  pt_vertical_gradient(i)
1350       gradients = TRIM( gradients ) // ' ' // TRIM( coor_chr )
1351
1352       WRITE (coor_chr,'(I7)')  pt_vertical_gradient_level_ind(i)
1353       slices = TRIM( slices ) // ' ' // TRIM( coor_chr )
1354
1355       WRITE (coor_chr,'(F7.1)')  pt_vertical_gradient_level(i)
1356       coordinates = TRIM( coordinates ) // ' '  // TRIM( coor_chr )
1357
1358       IF ( i == 10 )  THEN
1359          EXIT
1360       ELSE
1361          i = i + 1
1362       ENDIF
1363
1364    ENDDO
1365
1366    WRITE ( io, 420 )  TRIM( coordinates ), TRIM( temperatures ), &
1367                       TRIM( gradients ), TRIM( slices )
1368
1369!
1370!-- Initial humidity profile
1371!-- Building output strings, starting with surface humidity
1372    IF ( humidity  .OR.  passive_scalar )  THEN
1373       WRITE ( temperatures, '(E8.1)' )  q_surface
1374       gradients = '--------'
1375       slices = '       0'
1376       coordinates = '     0.0'
1377       i = 1
1378       DO  WHILE ( q_vertical_gradient_level_ind(i) /= -9999 )
1379         
1380          WRITE (coor_chr,'(E8.1,4X)')  q_init(q_vertical_gradient_level_ind(i))
1381          temperatures = TRIM( temperatures ) // '  ' // TRIM( coor_chr )
1382
1383          WRITE (coor_chr,'(E8.1,4X)')  q_vertical_gradient(i)
1384          gradients = TRIM( gradients ) // '  ' // TRIM( coor_chr )
1385         
1386          WRITE (coor_chr,'(I8,4X)')  q_vertical_gradient_level_ind(i)
1387          slices = TRIM( slices ) // '  ' // TRIM( coor_chr )
1388         
1389          WRITE (coor_chr,'(F8.1,4X)')  q_vertical_gradient_level(i)
1390          coordinates = TRIM( coordinates ) // '  '  // TRIM( coor_chr )
1391
1392          IF ( i == 10 )  THEN
1393             EXIT
1394          ELSE
1395             i = i + 1
1396          ENDIF
1397
1398       ENDDO
1399
1400       IF ( humidity )  THEN
1401          WRITE ( io, 421 )  TRIM( coordinates ), TRIM( temperatures ), &
1402                             TRIM( gradients ), TRIM( slices )
1403       ELSE
1404          WRITE ( io, 422 )  TRIM( coordinates ), TRIM( temperatures ), &
1405                             TRIM( gradients ), TRIM( slices )
1406       ENDIF
1407    ENDIF
1408
1409!
1410!-- Initial salinity profile
1411!-- Building output strings, starting with surface salinity
1412    IF ( ocean )  THEN
1413       WRITE ( temperatures, '(F6.2)' )  sa_surface
1414       gradients = '------'
1415       slices = '     0'
1416       coordinates = '   0.0'
1417       i = 1
1418       DO  WHILE ( sa_vertical_gradient_level_ind(i) /= -9999 )
1419
1420          WRITE (coor_chr,'(F7.2)')  sa_init(sa_vertical_gradient_level_ind(i))
1421          temperatures = TRIM( temperatures ) // ' ' // TRIM( coor_chr )
1422
1423          WRITE (coor_chr,'(F7.2)')  sa_vertical_gradient(i)
1424          gradients = TRIM( gradients ) // ' ' // TRIM( coor_chr )
1425
1426          WRITE (coor_chr,'(I7)')  sa_vertical_gradient_level_ind(i)
1427          slices = TRIM( slices ) // ' ' // TRIM( coor_chr )
1428
1429          WRITE (coor_chr,'(F7.1)')  sa_vertical_gradient_level(i)
1430          coordinates = TRIM( coordinates ) // ' '  // TRIM( coor_chr )
1431
1432          IF ( i == 10 )  THEN
1433             EXIT
1434          ELSE
1435             i = i + 1
1436          ENDIF
1437
1438       ENDDO
1439
1440       WRITE ( io, 425 )  TRIM( coordinates ), TRIM( temperatures ), &
1441                          TRIM( gradients ), TRIM( slices )
1442    ENDIF
1443
1444!
1445!-- Profile for the large scale vertial velocity
1446!-- Building output strings, starting with surface value
1447    IF ( large_scale_subsidence )  THEN
1448       temperatures = '   0.0'
1449       gradients = '------'
1450       slices = '     0'
1451       coordinates = '   0.0'
1452       i = 1
1453       DO  WHILE ( subs_vertical_gradient_level_i(i) /= -9999 )
1454
1455          WRITE (coor_chr,'(E10.2,7X)')  &
1456                                w_subs(subs_vertical_gradient_level_i(i))
1457          temperatures = TRIM( temperatures ) // ' ' // TRIM( coor_chr )
1458
1459          WRITE (coor_chr,'(E10.2,7X)')  subs_vertical_gradient(i)
1460          gradients = TRIM( gradients ) // ' ' // TRIM( coor_chr )
1461
1462          WRITE (coor_chr,'(I10,7X)')  subs_vertical_gradient_level_i(i)
1463          slices = TRIM( slices ) // ' ' // TRIM( coor_chr )
1464
1465          WRITE (coor_chr,'(F10.2,7X)')  subs_vertical_gradient_level(i)
1466          coordinates = TRIM( coordinates ) // ' '  // TRIM( coor_chr )
1467
1468          IF ( i == 10 )  THEN
1469             EXIT
1470          ELSE
1471             i = i + 1
1472          ENDIF
1473
1474       ENDDO
1475
1476       WRITE ( io, 426 )  TRIM( coordinates ), TRIM( temperatures ), &
1477                          TRIM( gradients ), TRIM( slices )
1478    ENDIF
1479
1480!
1481!-- Cloud physcis parameters / quantities / numerical methods
1482    WRITE ( io, 430 )
1483    IF ( humidity .AND. .NOT. cloud_physics .AND. .NOT. cloud_droplets)  THEN
1484       WRITE ( io, 431 )
1485    ELSEIF ( humidity  .AND.  cloud_physics )  THEN
1486       WRITE ( io, 432 )
1487       IF ( radiation )      WRITE ( io, 132 )
1488       IF ( precipitation )  WRITE ( io, 133 )
1489    ELSEIF ( humidity  .AND.  cloud_droplets )  THEN
1490       WRITE ( io, 433 )
1491       IF ( curvature_solution_effects )  WRITE ( io, 434 )
1492       IF ( collision_kernel /= 'none' )  THEN
1493          WRITE ( io, 435 )  TRIM( collision_kernel )
1494          IF ( collision_kernel(6:9) == 'fast' )  THEN
1495             WRITE ( io, 436 )  radius_classes, dissipation_classes
1496          ENDIF
1497       ELSE
1498          WRITE ( io, 437 )
1499       ENDIF
1500    ENDIF
1501
1502!
1503!-- LES / turbulence parameters
1504    WRITE ( io, 450 )
1505
1506!--
1507! ... LES-constants used must still be added here
1508!--
1509    IF ( constant_diffusion )  THEN
1510       WRITE ( io, 451 )  km_constant, km_constant/prandtl_number, &
1511                          prandtl_number
1512    ENDIF
1513    IF ( .NOT. constant_diffusion)  THEN
1514       IF ( e_init > 0.0 )  WRITE ( io, 455 )  e_init
1515       IF ( e_min > 0.0 )  WRITE ( io, 454 )  e_min
1516       IF ( wall_adjustment )  WRITE ( io, 453 )  wall_adjustment_factor
1517       IF ( adjust_mixing_length  .AND.  prandtl_layer )  WRITE ( io, 452 )
1518    ENDIF
1519
1520!
1521!-- Special actions during the run
1522    WRITE ( io, 470 )
1523    IF ( create_disturbances )  THEN
1524       WRITE ( io, 471 )  dt_disturb, disturbance_amplitude,                   &
1525                          zu(disturbance_level_ind_b), disturbance_level_ind_b,&
1526                          zu(disturbance_level_ind_t), disturbance_level_ind_t
1527       IF ( .NOT. bc_lr_cyc  .OR.  .NOT. bc_ns_cyc )  THEN
1528          WRITE ( io, 472 )  inflow_disturbance_begin, inflow_disturbance_end
1529       ELSE
1530          WRITE ( io, 473 )  disturbance_energy_limit
1531       ENDIF
1532       WRITE ( io, 474 )  TRIM( random_generator )
1533    ENDIF
1534    IF ( pt_surface_initial_change /= 0.0 )  THEN
1535       WRITE ( io, 475 )  pt_surface_initial_change
1536    ENDIF
1537    IF ( humidity  .AND.  q_surface_initial_change /= 0.0 )  THEN
1538       WRITE ( io, 476 )  q_surface_initial_change       
1539    ENDIF
1540    IF ( passive_scalar  .AND.  q_surface_initial_change /= 0.0 )  THEN
1541       WRITE ( io, 477 )  q_surface_initial_change       
1542    ENDIF
1543
1544    IF ( particle_advection )  THEN
1545!
1546!--    Particle attributes
1547       WRITE ( io, 480 )  particle_advection_start, dt_prel, bc_par_lr, &
1548                          bc_par_ns, bc_par_b, bc_par_t, particle_maximum_age, &
1549                          end_time_prel, dt_sort_particles
1550       IF ( use_sgs_for_particles )  WRITE ( io, 488 )  dt_min_part
1551       IF ( random_start_position )  WRITE ( io, 481 )
1552       IF ( particles_per_point > 1 )  WRITE ( io, 489 )  particles_per_point
1553       WRITE ( io, 495 )  total_number_of_particles
1554       IF ( use_particle_tails  .AND.  maximum_number_of_tailpoints /= 0 )  THEN
1555          WRITE ( io, 483 )  maximum_number_of_tailpoints
1556          IF ( minimum_tailpoint_distance /= 0 )  THEN
1557             WRITE ( io, 484 )  total_number_of_tails,      &
1558                                minimum_tailpoint_distance, &
1559                                maximum_tailpoint_age
1560          ENDIF
1561       ENDIF
1562       IF ( dt_write_particle_data /= 9999999.9 )  THEN
1563          WRITE ( io, 485 )  dt_write_particle_data
1564          output_format = ''
1565          IF ( netcdf_output )  THEN
1566             IF ( netcdf_data_format > 1 )  THEN
1567                output_format = 'netcdf (64 bit offset) and binary'
1568             ELSE
1569                output_format = 'netcdf and binary'
1570             ENDIF
1571          ELSE
1572             output_format = 'binary'
1573          ENDIF
1574          WRITE ( io, 344 )  output_format
1575       ENDIF
1576       IF ( dt_dopts /= 9999999.9 )  WRITE ( io, 494 )  dt_dopts
1577       IF ( write_particle_statistics )  WRITE ( io, 486 )
1578
1579       WRITE ( io, 487 )  number_of_particle_groups
1580
1581       DO  i = 1, number_of_particle_groups
1582          IF ( i == 1  .AND.  density_ratio(i) == 9999999.9 )  THEN
1583             WRITE ( io, 490 )  i, 0.0
1584             WRITE ( io, 492 )
1585          ELSE
1586             WRITE ( io, 490 )  i, radius(i)
1587             IF ( density_ratio(i) /= 0.0 )  THEN
1588                WRITE ( io, 491 )  density_ratio(i)
1589             ELSE
1590                WRITE ( io, 492 )
1591             ENDIF
1592          ENDIF
1593          WRITE ( io, 493 )  psl(i), psr(i), pss(i), psn(i), psb(i), pst(i), &
1594                             pdx(i), pdy(i), pdz(i)
1595          IF ( .NOT. vertical_particle_advection(i) )  WRITE ( io, 482 )
1596       ENDDO
1597
1598    ENDIF
1599
1600
1601!
1602!-- Parameters of 1D-model
1603    IF ( INDEX( initializing_actions, 'set_1d-model_profiles' ) /= 0 )  THEN
1604       WRITE ( io, 500 )  end_time_1d, dt_run_control_1d, dt_pr_1d, &
1605                          mixing_length_1d, dissipation_1d
1606       IF ( damp_level_ind_1d /= nzt+1 )  THEN
1607          WRITE ( io, 502 )  zu(damp_level_ind_1d), damp_level_ind_1d
1608       ENDIF
1609    ENDIF
1610
1611!
1612!-- User-defined informations
1613    CALL user_header( io )
1614
1615    WRITE ( io, 99 )
1616
1617!
1618!-- Write buffer contents to disc immediately
1619    CALL local_flush( io )
1620
1621!
1622!-- Here the FORMATs start
1623
1624 99 FORMAT (1X,78('-'))
1625100 FORMAT (/1X,'***************************',9X,42('-')/        &
1626            1X,'* ',A,' *',9X,A/                               &
1627            1X,'***************************',9X,42('-'))
1628101 FORMAT (37X,'coupled run using MPI-',I1,': ',A/ &
1629            37X,42('-'))
1630102 FORMAT (/' Date:              ',A8,9X,'Run:       ',A20/      &
1631            ' Time:              ',A8,9X,'Run-No.:   ',I2.2/     &
1632            ' Run on host:     ',A10)
1633#if defined( __parallel )
1634103 FORMAT (' Number of PEs:',8X,I5,9X,'Processor grid (x,y): (',I3,',',I3, &
1635              ')',1X,A)
1636104 FORMAT (' Number of PEs:',8X,I5,9X,'Tasks:',I4,'   threads per task:',I4/ &
1637              37X,'Processor grid (x,y): (',I3,',',I3,')',1X,A)
1638105 FORMAT (37X,'One additional PE is used to handle'/37X,'the dvrp output!')
1639106 FORMAT (37X,'A 1d-decomposition along x is forced'/ &
1640            37X,'because the job is running on an SMP-cluster')
1641107 FORMAT (37X,'A 1d-decomposition along ',A,' is used')
1642108 FORMAT (37X,'Max. # of parallel I/O streams is ',I5)
1643#endif
1644110 FORMAT (/' Numerical Schemes:'/ &
1645             ' -----------------'/)
1646111 FORMAT (' --> Solve perturbation pressure via FFT using ',A,' routines')
1647112 FORMAT (' --> Solve perturbation pressure via SOR-Red/Black-Schema'/ &
1648            '     Iterations (initial/other): ',I3,'/',I3,'  omega = ',F5.3)
1649113 FORMAT (' --> Momentum advection via Piascek-Williams-Scheme (Form C3)', &
1650                  ' or Upstream')
1651114 FORMAT (' --> Momentum advection via Upstream-Spline-Scheme')
1652115 FORMAT ('     Tendencies are smoothed via Long-Filter with factor ',F5.3) 
1653116 FORMAT (' --> Scalar advection via Piascek-Williams-Scheme (Form C3)', &
1654                  ' or Upstream')
1655117 FORMAT (' --> Scalar advection via Upstream-Spline-Scheme')
1656118 FORMAT (' --> Scalar advection via Bott-Chlond-Scheme')
1657119 FORMAT (' --> Galilei-Transform applied to horizontal advection', &
1658            '     Translation velocity = ',A/ &
1659            '     distance advected ',A,':  ',F8.3,' km(x)  ',F8.3,' km(y)')
1660120 FORMAT (' --> Time differencing scheme: leapfrog only (no euler in case', &
1661                  ' of timestep changes)')
1662121 FORMAT (' --> Time differencing scheme: leapfrog + euler in case of', &
1663                  ' timestep changes')
1664122 FORMAT (' --> Time differencing scheme: ',A)
1665123 FORMAT (' --> Rayleigh-Damping active, starts ',A,' z = ',F8.2,' m'/ &
1666            '     maximum damping coefficient: ',F5.3, ' 1/s')
1667124 FORMAT ('     Spline-overshoots are being suppressed')
1668125 FORMAT ('     Upstream-Scheme is used if Upstream-differences fall short', &
1669                  ' of'/                                                       &
1670            '     delta_u = ',F6.4,4X,'delta_v = ',F6.4,4X,'delta_w = ',F6.4)
1671126 FORMAT ('     Upstream-Scheme is used if Upstream-differences fall short', &
1672                  ' of'/                                                       &
1673            '     delta_e = ',F6.4,4X,'delta_pt = ',F6.4)
1674127 FORMAT ('     The following absolute overshoot differences are tolerated:'/&
1675            '     delta_u = ',F6.4,4X,'delta_v = ',F6.4,4X,'delta_w = ',F6.4)
1676128 FORMAT ('     The following absolute overshoot differences are tolerated:'/&
1677            '     delta_e = ',F6.4,4X,'delta_pt = ',F6.4)
1678129 FORMAT (' --> Additional prognostic equation for the specific humidity')
1679130 FORMAT (' --> Additional prognostic equation for the total water content')
1680132 FORMAT ('     Parameterization of long-wave radiation processes via'/ &
1681            '     effective emissivity scheme')
1682133 FORMAT ('     Precipitation parameterization via Kessler-Scheme')
1683134 FORMAT (' --> Additional prognostic equation for a passive scalar')
1684135 FORMAT (' --> Solve perturbation pressure via multigrid method (', &
1685                  A,'-cycle)'/ &
1686            '     number of grid levels:                   ',I2/ &
1687            '     Gauss-Seidel red/black iterations:       ',I2)
1688136 FORMAT ('     gridpoints of coarsest subdomain (x,y,z): (',I3,',',I3,',', &
1689                  I3,')')
1690137 FORMAT ('     level data gathered on PE0 at level:     ',I2/ &
1691            '     gridpoints of coarsest subdomain (x,y,z): (',I3,',',I3,',', &
1692                  I3,')'/ &
1693            '     gridpoints of coarsest domain (x,y,z):    (',I3,',',I3,',', &
1694                  I3,')')
1695138 FORMAT ('     Using hybrid version for 1d-domain-decomposition')
1696139 FORMAT (' --> Loop optimization method: ',A)
1697140 FORMAT ('     maximum residual allowed:                ',E10.3)
1698141 FORMAT ('     fixed number of multigrid cycles:        ',I4)
1699142 FORMAT ('     perturbation pressure is calculated at every Runge-Kutta ', &
1700                  'step')
1701143 FORMAT ('     Euler/upstream scheme is used for the SGS turbulent ', &
1702                  'kinetic energy')
1703150 FORMAT (' --> Volume flow at the right and north boundary will be ', &
1704                  'conserved'/ &
1705            '     using the ',A,' mode')
1706151 FORMAT ('     with u_bulk = ',F7.3,' m/s and v_bulk = ',F7.3,' m/s')
1707152 FORMAT (' --> External pressure gradient directly prescribed by the user:',&
1708           /'     ',2(1X,E12.5),'Pa/m in x/y direction', &
1709           /'     starting from dp_level_b =', F8.3, 'm', A /)
1710153 FORMAT (' --> Large-scale vertical motion is used in the ', &
1711                  'prognostic equation for')
1712154 FORMAT ('     the potential temperature')
1713200 FORMAT (//' Run time and time step information:'/ &
1714             ' ----------------------------------'/)
1715201 FORMAT ( ' Timestep:          variable     maximum value: ',F6.3,' s', &
1716             '    CFL-factor: ',F4.2)
1717202 FORMAT ( ' Timestep:       dt = ',F6.3,' s'/)
1718203 FORMAT ( ' Start time:       ',F9.3,' s'/ &
1719             ' End time:         ',F9.3,' s')
1720204 FORMAT ( A,F9.3,' s')
1721205 FORMAT ( A,F9.3,' s',5X,'restart every',17X,F9.3,' s')
1722206 FORMAT (/' Time reached:     ',F9.3,' s'/ &
1723             ' CPU-time used:    ',F9.3,' s     per timestep:               ', &
1724               '  ',F9.3,' s'/                                                 &
1725             '                                   per second of simulated tim', &
1726               'e: ',F9.3,' s')
1727207 FORMAT ( A/' Coupling start time:',F9.3,' s')
1728250 FORMAT (//' Computational grid and domain size:'/ &
1729              ' ----------------------------------'// &
1730              ' Grid length:      dx =    ',F7.3,' m    dy =    ',F7.3, &
1731              ' m    dz =    ',F7.3,' m'/ &
1732              ' Domain size:       x = ',F10.3,' m     y = ',F10.3, &
1733              ' m  z(u) = ',F10.3,' m'/)
1734252 FORMAT (' dz constant up to ',F10.3,' m (k=',I4,'), then stretched by', &
1735              ' factor: ',F5.3/ &
1736            ' maximum dz not to be exceeded is dz_max = ',F10.3,' m'/)
1737254 FORMAT (' Number of gridpoints (x,y,z):  (0:',I4,', 0:',I4,', 0:',I4,')'/ &
1738            ' Subdomain size (x,y,z):        (  ',I4,',   ',I4,',   ',I4,')'/)
1739255 FORMAT (' Subdomains have equal size')
1740256 FORMAT (' Subdomains at the upper edges of the virtual processor grid ', &
1741              'have smaller sizes'/                                          &
1742            ' Size of smallest subdomain:    (  ',I4,',   ',I4,',   ',I4,')')
1743260 FORMAT (/' The model has a slope in x-direction. Inclination angle: ',F6.2,&
1744             ' degrees')
1745270 FORMAT (//' Topography informations:'/ &
1746              ' -----------------------'// &
1747              1X,'Topography: ',A)
1748271 FORMAT (  ' Building size (x/y/z) in m: ',F5.1,' / ',F5.1,' / ',F5.1/ &
1749              ' Horizontal index bounds (l/r/s/n): ',I4,' / ',I4,' / ',I4, &
1750                ' / ',I4)
1751272 FORMAT (  ' Single quasi-2D street canyon of infinite length in ',A, &
1752              ' direction' / &
1753              ' Canyon height: ', F6.2, 'm, ch = ', I4, '.'      / &
1754              ' Canyon position (',A,'-walls): cxl = ', I4,', cxr = ', I4, '.')
1755278 FORMAT (' Topography grid definition convention:'/ &
1756            ' cell edge (staggered grid points'/  &
1757            ' (u in x-direction, v in y-direction))' /)
1758279 FORMAT (' Topography grid definition convention:'/ &
1759            ' cell center (scalar grid points)' /)
1760280 FORMAT (//' Vegetation canopy (drag) model:'/ &
1761              ' ------------------------------'// &
1762              ' Canopy mode: ', A / &
1763              ' Canopy top: ',I4 / &
1764              ' Leaf drag coefficient: ',F6.2 /)
1765281 FORMAT (/ ' Scalar_exchange_coefficient: ',F6.2 / &
1766              ' Scalar concentration at leaf surfaces in kg/m**3: ',F6.2 /)
1767282 FORMAT (' Predefined constant heatflux at the top of the vegetation: ',F6.2,' K m/s')
1768283 FORMAT (/ ' Characteristic levels of the leaf area density:'// &
1769              ' Height:              ',A,'  m'/ &
1770              ' Leaf area density:   ',A,'  m**2/m**3'/ &
1771              ' Gradient:            ',A,'  m**2/m**4'/ &
1772              ' Gridpoint:           ',A)
1773               
1774300 FORMAT (//' Boundary conditions:'/ &
1775             ' -------------------'// &
1776             '                     p                    uv             ', &
1777             '                   pt'// &
1778             ' B. bound.: ',A/ &
1779             ' T. bound.: ',A)
1780301 FORMAT (/'                     ',A// &
1781             ' B. bound.: ',A/ &
1782             ' T. bound.: ',A)
1783303 FORMAT (/' Bottom surface fluxes are used in diffusion terms at k=1')
1784304 FORMAT (/' Top surface fluxes are used in diffusion terms at k=nzt')
1785305 FORMAT (//'    Prandtl-Layer between bottom surface and first ', &
1786               'computational u,v-level:'// &
1787             '       zp = ',F6.2,' m   z0 = ',F6.4,' m   kappa = ',F4.2/ &
1788             '       Rif value range:   ',F6.2,' <= rif <=',F6.2)
1789306 FORMAT ('       Predefined constant heatflux:   ',F9.6,' K m/s')
1790307 FORMAT ('       Heatflux has a random normal distribution')
1791308 FORMAT ('       Predefined surface temperature')
1792309 FORMAT ('       Predefined constant salinityflux:   ',F9.6,' psu m/s')
1793310 FORMAT (//'    1D-Model:'// &
1794             '       Rif value range:   ',F6.2,' <= rif <=',F6.2)
1795311 FORMAT ('       Predefined constant humidity flux: ',E10.3,' m/s')
1796312 FORMAT ('       Predefined surface humidity')
1797313 FORMAT ('       Predefined constant scalar flux: ',E10.3,' kg/(m**2 s)')
1798314 FORMAT ('       Predefined scalar value at the surface')
1799315 FORMAT ('       Humidity / scalar flux at top surface is 0.0')
1800316 FORMAT ('       Sensible heatflux and momentum flux from coupled ', &
1801                    'atmosphere model')
1802317 FORMAT (//' Lateral boundaries:'/ &
1803            '       left/right:  ',A/    &
1804            '       north/south: ',A)
1805318 FORMAT (/'       outflow damping layer width: ',I3,' gridpoints with km_', &
1806                    'max =',F5.1,' m**2/s')
1807319 FORMAT ('       turbulence recycling at inflow switched on'/ &
1808            '       width of recycling domain: ',F7.1,' m   grid index: ',I4/ &
1809            '       inflow damping height: ',F6.1,' m   width: ',F6.1,' m')
1810320 FORMAT ('       Predefined constant momentumflux:  u: ',F9.6,' m**2/s**2'/ &
1811            '                                          v: ',F9.6,' m**2/s**2')
1812325 FORMAT (//' List output:'/ &
1813             ' -----------'//  &
1814            '    1D-Profiles:'/    &
1815            '       Output every             ',F8.2,' s')
1816326 FORMAT ('       Time averaged over       ',F8.2,' s'/ &
1817            '       Averaging input every    ',F8.2,' s')
1818330 FORMAT (//' Data output:'/ &
1819             ' -----------'/)
1820331 FORMAT (/'    1D-Profiles:')
1821332 FORMAT (/'       ',A)
1822333 FORMAT ('       Output every             ',F8.2,' s',/ &
1823            '       Time averaged over       ',F8.2,' s'/ &
1824            '       Averaging input every    ',F8.2,' s')
1825334 FORMAT (/'    2D-Arrays',A,':')
1826335 FORMAT (/'       ',A2,'-cross-section  Arrays: ',A/ &
1827            '       Output every             ',F8.2,' s  ',A/ &
1828            '       Cross sections at ',A1,' = ',A/ &
1829            '       scalar-coordinates:   ',A,' m'/)
1830336 FORMAT (/'    3D-Arrays',A,':')
1831337 FORMAT (/'       Arrays: ',A/ &
1832            '       Output every             ',F8.2,' s  ',A/ &
1833            '       Upper output limit at    ',F8.2,' m  (GP ',I4,')'/)
1834338 FORMAT ('       Compressed data output'/ &
1835            '       Decimal precision: ',A/)
1836339 FORMAT ('       No output during initial ',F8.2,' s')
1837340 FORMAT (/'    Time series:')
1838341 FORMAT ('       Output every             ',F8.2,' s'/)
1839342 FORMAT (/'       ',A2,'-cross-section  Arrays: ',A/ &
1840            '       Output every             ',F8.2,' s  ',A/ &
1841            '       Time averaged over       ',F8.2,' s'/ &
1842            '       Averaging input every    ',F8.2,' s'/ &
1843            '       Cross sections at ',A1,' = ',A/ &
1844            '       scalar-coordinates:   ',A,' m'/)
1845343 FORMAT (/'       Arrays: ',A/ &
1846            '       Output every             ',F8.2,' s  ',A/ &
1847            '       Time averaged over       ',F8.2,' s'/ &
1848            '       Averaging input every    ',F8.2,' s'/ &
1849            '       Upper output limit at    ',F8.2,' m  (GP ',I4,')'/)
1850344 FORMAT ('       Output format: ',A/)
1851345 FORMAT (/'    Scaling lengths for output locations of all subsequent mask IDs:',/ &
1852            '       mask_scale_x (in x-direction): ',F9.3, ' m',/ &
1853            '       mask_scale_y (in y-direction): ',F9.3, ' m',/ &
1854            '       mask_scale_z (in z-direction): ',F9.3, ' m' )
1855346 FORMAT (/'    Masked data output',A,' for mask ID ',I2, ':')
1856347 FORMAT ('       Variables: ',A/ &
1857            '       Output every             ',F8.2,' s')
1858348 FORMAT ('       Variables: ',A/ &
1859            '       Output every             ',F8.2,' s'/ &
1860            '       Time averaged over       ',F8.2,' s'/ &
1861            '       Averaging input every    ',F8.2,' s')
1862349 FORMAT (/'       Output locations in ',A,'-direction in multiples of ', &
1863            'mask_scale_',A,' predefined by array mask_',I2.2,'_',A,':'/ &
1864            13('       ',8(F8.2,',')/) )
1865350 FORMAT (/'       Output locations in ',A,'-direction: ', &
1866            'all gridpoints along ',A,'-direction (default).' )
1867351 FORMAT (/'       Output locations in ',A,'-direction in multiples of ', &
1868            'mask_scale_',A,' constructed from array mask_',I2.2,'_',A,'_loop:'/ &
1869            '          loop begin:',F8.2,', end:',F8.2,', stride:',F8.2 )
1870#if defined( __dvrp_graphics )
1871360 FORMAT ('    Plot-Sequence with dvrp-software:'/ &
1872            '       Output every      ',F7.1,' s'/ &
1873            '       Output mode:      ',A/ &
1874            '       Host / User:      ',A,' / ',A/ &
1875            '       Directory:        ',A// &
1876            '       The sequence contains:')
1877361 FORMAT (/'       Isosurface of "',A,'"    Threshold value: ', E12.3/ &
1878            '          Isosurface color: (',F4.2,',',F4.2,',',F4.2,') (R,G,B)')
1879362 FORMAT (/'       Slicer plane ',A/ &
1880            '       Slicer limits: [',F6.2,',',F6.2,']')
1881363 FORMAT (/'       Particles'/ &
1882            '          particle size:  ',F7.2,' m')
1883364 FORMAT ('          particle ',A,' controlled by "',A,'" with interval [', &
1884                       F6.2,',',F6.2,']')
1885365 FORMAT (/'       Groundplate color: (',F4.2,',',F4.2,',',F4.2,') (R,G,B)'/ &
1886            '       Superelevation along (x,y,z): (',F4.1,',',F4.1,',',F4.1, &
1887                     ')'/ &
1888            '       Clipping limits: from x = ',F9.1,' m to x = ',F9.1,' m'/ &
1889            '                        from y = ',F9.1,' m to y = ',F9.1,' m')
1890366 FORMAT (/'       Topography color: (',F4.2,',',F4.2,',',F4.2,') (R,G,B)')
1891367 FORMAT ('       Polygon reduction for topography: cluster_size = ', I1)
1892#endif
1893#if defined( __spectra )
1894370 FORMAT ('    Spectra:')
1895371 FORMAT ('       Output every ',F7.1,' s'/)
1896372 FORMAT ('       Arrays:     ', 10(A5,',')/                         &
1897            '       Directions: ', 10(A5,',')/                         &
1898            '       height levels  k = ', 20(I3,',')/                  &
1899            '                          ', 20(I3,',')/                  &
1900            '                          ', 20(I3,',')/                  &
1901            '                          ', 20(I3,',')/                  &
1902            '                          ', 19(I3,','),I3,'.'/           &
1903            '       height levels selected for standard plot:'/        &
1904            '                      k = ', 20(I3,',')/                  &
1905            '                          ', 20(I3,',')/                  &
1906            '                          ', 20(I3,',')/                  &
1907            '                          ', 20(I3,',')/                  &
1908            '                          ', 19(I3,','),I3,'.'/           &
1909            '       Time averaged over ', F7.1, ' s,' /                &
1910            '       Profiles for the time averaging are taken every ', &
1911                    F6.1,' s')
1912#endif
1913400 FORMAT (//' Physical quantities:'/ &
1914              ' -------------------'/)
1915410 FORMAT ('    Angular velocity    :   omega = ',E9.3,' rad/s'/  &
1916            '    Geograph. latitude  :   phi   = ',F4.1,' degr'/   &
1917            '    Coriolis parameter  :   f     = ',F9.6,' 1/s'/    &
1918            '                            f*    = ',F9.6,' 1/s')
1919411 FORMAT (/'    Gravity             :   g     = ',F4.1,' m/s**2')
1920412 FORMAT (/'    Reference density in buoyancy terms: ',F8.3,' kg/m**3')
1921413 FORMAT (/'    Reference temperature in buoyancy terms: ',F8.4,' K')
1922415 FORMAT (/'    Cloud physics parameters:'/ &
1923             '    ------------------------'/)
1924416 FORMAT ('        Surface pressure   :   p_0   = ',F7.2,' hPa'/      &
1925            '        Gas constant       :   R     = ',F5.1,' J/(kg K)'/ &
1926            '        Density of air     :   rho_0 = ',F5.3,' kg/m**3'/  &
1927            '        Specific heat cap. :   c_p   = ',F6.1,' J/(kg K)'/ &
1928            '        Vapourization heat :   L_v   = ',E8.2,' J/kg')
1929420 FORMAT (/'    Characteristic levels of the initial temperature profile:'// &
1930            '       Height:        ',A,'  m'/ &
1931            '       Temperature:   ',A,'  K'/ &
1932            '       Gradient:      ',A,'  K/100m'/ &
1933            '       Gridpoint:     ',A)
1934421 FORMAT (/'    Characteristic levels of the initial humidity profile:'// &
1935            '       Height:      ',A,'  m'/ &
1936            '       Humidity:    ',A,'  kg/kg'/ &
1937            '       Gradient:    ',A,'  (kg/kg)/100m'/ &
1938            '       Gridpoint:   ',A)
1939422 FORMAT (/'    Characteristic levels of the initial scalar profile:'// &
1940            '       Height:                  ',A,'  m'/ &
1941            '       Scalar concentration:    ',A,'  kg/m**3'/ &
1942            '       Gradient:                ',A,'  (kg/m**3)/100m'/ &
1943            '       Gridpoint:               ',A)
1944423 FORMAT (/'    Characteristic levels of the geo. wind component ug:'// &
1945            '       Height:      ',A,'  m'/ &
1946            '       ug:          ',A,'  m/s'/ &
1947            '       Gradient:    ',A,'  1/100s'/ &
1948            '       Gridpoint:   ',A)
1949424 FORMAT (/'    Characteristic levels of the geo. wind component vg:'// &
1950            '       Height:      ',A,'  m'/ &
1951            '       vg:          ',A,'  m/s'/ &
1952            '       Gradient:    ',A,'  1/100s'/ &
1953            '       Gridpoint:   ',A)
1954425 FORMAT (/'    Characteristic levels of the initial salinity profile:'// &
1955            '       Height:     ',A,'  m'/ &
1956            '       Salinity:   ',A,'  psu'/ &
1957            '       Gradient:   ',A,'  psu/100m'/ &
1958            '       Gridpoint:  ',A)
1959426 FORMAT (/'    Characteristic levels of the subsidence/ascent profile:'// &
1960            '       Height:      ',A,'  m'/ &
1961            '       w_subs:      ',A,'  m/s'/ &
1962            '       Gradient:    ',A,'  (m/s)/100m'/ &
1963            '       Gridpoint:   ',A)
1964427 FORMAT (/'    Initial wind profiles (u,v) are interpolated from given'// &
1965                  ' profiles')
1966430 FORMAT (//' Cloud physics quantities / methods:'/ &
1967              ' ----------------------------------'/)
1968431 FORMAT ('    Humidity is treated as purely passive scalar (no condensati', &
1969                 'on)')
1970432 FORMAT ('    Bulk scheme with liquid water potential temperature and'/ &
1971            '    total water content is used.'/ &
1972            '    Condensation is parameterized via 0% - or 100% scheme.')
1973433 FORMAT ('    Cloud droplets treated explicitly using the Lagrangian part', &
1974                 'icle model')
1975434 FORMAT ('    Curvature and solution effecs are considered for growth of', &
1976                 ' droplets < 1.0E-6 m')
1977435 FORMAT ('    Droplet collision is handled by ',A,'-kernel')
1978436 FORMAT ('       Fast kernel with fixed radius- and dissipation classes ', &
1979                    'are used'/ &
1980            '          number of radius classes:       ',I3,'    interval ', &
1981                       '[1.0E-6,2.0E-4] m'/ &
1982            '          number of dissipation classes:   ',I2,'    interval ', &
1983                       '[0,1000] cm**2/s**3')
1984437 FORMAT ('    Droplet collision is switched off')
1985450 FORMAT (//' LES / Turbulence quantities:'/ &
1986              ' ---------------------------'/)
1987451 FORMAT ('    Diffusion coefficients are constant:'/ &
1988            '    Km = ',F6.2,' m**2/s   Kh = ',F6.2,' m**2/s   Pr = ',F5.2)
1989452 FORMAT ('    Mixing length is limited to the Prandtl mixing lenth.')
1990453 FORMAT ('    Mixing length is limited to ',F4.2,' * z')
1991454 FORMAT ('    TKE is not allowed to fall below ',E9.2,' (m/s)**2')
1992455 FORMAT ('    initial TKE is prescribed as ',E9.2,' (m/s)**2')
1993470 FORMAT (//' Actions during the simulation:'/ &
1994              ' -----------------------------'/)
1995471 FORMAT ('    Disturbance impulse (u,v) every :   ',F6.2,' s'/            &
1996            '    Disturbance amplitude           :     ',F4.2, ' m/s'/       &
1997            '    Lower disturbance level         : ',F8.2,' m (GP ',I4,')'/  &
1998            '    Upper disturbance level         : ',F8.2,' m (GP ',I4,')')
1999472 FORMAT ('    Disturbances continued during the run from i/j =',I4, &
2000                 ' to i/j =',I4)
2001473 FORMAT ('    Disturbances cease as soon as the disturbance energy exceeds',&
2002                 1X,F5.3, ' m**2/s**2')
2003474 FORMAT ('    Random number generator used    : ',A/)
2004475 FORMAT ('    The surface temperature is increased (or decreased, ', &
2005                 'respectively, if'/ &
2006            '    the value is negative) by ',F5.2,' K at the beginning of the',&
2007                 ' 3D-simulation'/)
2008476 FORMAT ('    The surface humidity is increased (or decreased, ',&
2009                 'respectively, if the'/ &
2010            '    value is negative) by ',E8.1,' kg/kg at the beginning of', &
2011                 ' the 3D-simulation'/)
2012477 FORMAT ('    The scalar value is increased at the surface (or decreased, ',&
2013                 'respectively, if the'/ &
2014            '    value is negative) by ',E8.1,' kg/m**3 at the beginning of', &
2015                 ' the 3D-simulation'/)
2016480 FORMAT ('    Particles:'/ &
2017            '    ---------'// &
2018            '       Particle advection is active (switched on at t = ', F7.1, &
2019                    ' s)'/ &
2020            '       Start of new particle generations every  ',F6.1,' s'/ &
2021            '       Boundary conditions: left/right: ', A, ' north/south: ', A/&
2022            '                            bottom:     ', A, ' top:         ', A/&
2023            '       Maximum particle age:                 ',F9.1,' s'/ &
2024            '       Advection stopped at t = ',F9.1,' s'/ &
2025            '       Particles are sorted every ',F9.1,' s'/)
2026481 FORMAT ('       Particles have random start positions'/)
2027482 FORMAT ('          Particles are advected only horizontally'/)
2028483 FORMAT ('       Particles have tails with a maximum of ',I3,' points')
2029484 FORMAT ('            Number of tails of the total domain: ',I10/ &
2030            '            Minimum distance between tailpoints: ',F8.2,' m'/ &
2031            '            Maximum age of the end of the tail:  ',F8.2,' s')
2032485 FORMAT ('       Particle data are written on file every ', F9.1, ' s')
2033486 FORMAT ('       Particle statistics are written on file'/)
2034487 FORMAT ('       Number of particle groups: ',I2/)
2035488 FORMAT ('       SGS velocity components are used for particle advection'/ &
2036            '          minimum timestep for advection: ', F7.5/)
2037489 FORMAT ('       Number of particles simultaneously released at each ', &
2038                    'point: ', I5/)
2039490 FORMAT ('       Particle group ',I2,':'/ &
2040            '          Particle radius: ',E10.3, 'm')
2041491 FORMAT ('          Particle inertia is activated'/ &
2042            '             density_ratio (rho_fluid/rho_particle) = ',F5.3/)
2043492 FORMAT ('          Particles are advected only passively (no inertia)'/)
2044493 FORMAT ('          Boundaries of particle source: x:',F8.1,' - ',F8.1,' m'/&
2045            '                                         y:',F8.1,' - ',F8.1,' m'/&
2046            '                                         z:',F8.1,' - ',F8.1,' m'/&
2047            '          Particle distances:  dx = ',F8.1,' m  dy = ',F8.1, &
2048                       ' m  dz = ',F8.1,' m'/)
2049494 FORMAT ('       Output of particle time series in NetCDF format every ', &
2050                    F8.2,' s'/)
2051495 FORMAT ('       Number of particles in total domain: ',I10/)
2052500 FORMAT (//' 1D-Model parameters:'/                           &
2053              ' -------------------'//                           &
2054            '    Simulation time:                   ',F8.1,' s'/ &
2055            '    Run-controll output every:         ',F8.1,' s'/ &
2056            '    Vertical profile output every:     ',F8.1,' s'/ &
2057            '    Mixing length calculation:         ',A/         &
2058            '    Dissipation calculation:           ',A/)
2059502 FORMAT ('    Damping layer starts from ',F7.1,' m (GP ',I4,')'/)
2060503 FORMAT (' --> Momentum advection via Wicker-Skamarock-Scheme 5th order')
2061504 FORMAT (' --> Scalar advection via Wicker-Skamarock-Scheme 5th order')
2062
2063
2064 END SUBROUTINE header
Note: See TracBrowser for help on using the repository browser.