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

Last change on this file since 184 was 167, checked in by steinfeld, 16 years ago

Bugfix in header.f90

  • Property svn:keywords set to Id
File size: 62.0 KB
Line 
1 SUBROUTINE header
2
3!------------------------------------------------------------------------------!
4! Actual revisions:
5! -----------------
6! Bugfix in the output of the characteristic levels of potential temperature,
7! geostrophic wind, scalar concentration, humidity and leaf area density
8! Output of turbulence recycling informations
9!
10! Former revisions:
11! -----------------
12! $Id: header.f90 167 2008-05-15 13:19:25Z letzel $
13!
14! 138 2007-11-28 10:03:58Z letzel
15! Allow new case bc_uv_t = 'dirichlet_0' for channel flow.
16! Allow two instead of one digit to specify isosurface and slicer variables.
17! Output of sorting frequency of particles
18!
19! 108 2007-08-24 15:10:38Z letzel
20! Output of informations for coupled model runs (boundary conditions etc.)
21! + output of momentumfluxes at the top boundary
22! Rayleigh damping for ocean, e_init
23!
24! 97 2007-06-21 08:23:15Z raasch
25! Adjustments for the ocean version.
26! use_pt_reference renamed use_reference
27!
28! 87 2007-05-22 15:46:47Z raasch
29! Bugfix: output of use_upstream_for_tke
30!
31! 82 2007-04-16 15:40:52Z raasch
32! Preprocessor strings for different linux clusters changed to "lc",
33! routine local_flush is used for buffer flushing
34!
35! 76 2007-03-29 00:58:32Z raasch
36! Output of netcdf_64bit_3d, particles-package is now part of the default code,
37! output of the loop optimization method, moisture renamed humidity,
38! output of subversion revision number
39!
40! 19 2007-02-23 04:53:48Z raasch
41! Output of scalar flux applied at top boundary
42!
43! RCS Log replace by Id keyword, revision history cleaned up
44!
45! Revision 1.63  2006/08/22 13:53:13  raasch
46! Output of dz_max
47!
48! Revision 1.1  1997/08/11 06:17:20  raasch
49! Initial revision
50!
51!
52! Description:
53! ------------
54! Writing a header with all important informations about the actual run.
55! This subroutine is called three times, two times at the beginning
56! (writing information on files RUN_CONTROL and HEADER) and one time at the
57! end of the run, then writing additional information about CPU-usage on file
58! header.
59!------------------------------------------------------------------------------!
60
61    USE arrays_3d
62    USE control_parameters
63    USE cloud_parameters
64    USE cpulog
65    USE dvrp_variables
66    USE grid_variables
67    USE indices
68    USE model_1d
69    USE particle_attributes
70    USE pegrid
71    USE spectrum
72
73    IMPLICIT NONE
74
75    CHARACTER (LEN=1)  ::  prec
76    CHARACTER (LEN=2)  ::  do2d_mode
77    CHARACTER (LEN=5)  ::  section_chr
78    CHARACTER (LEN=9)  ::  time_to_string
79    CHARACTER (LEN=10) ::  coor_chr, host_chr
80    CHARACTER (LEN=16) ::  begin_chr
81    CHARACTER (LEN=21) ::  ver_rev
82    CHARACTER (LEN=40) ::  output_format
83    CHARACTER (LEN=70) ::  char1, char2, dopr_chr, &
84                           do2d_xy, do2d_xz, do2d_yz, do3d_chr, &
85                           run_classification
86    CHARACTER (LEN=86) ::  coordinates, gradients, learde, slices,  &
87                           temperatures, ugcomponent, vgcomponent
88    CHARACTER (LEN=85) ::  roben, runten
89
90    INTEGER ::  av, bh, blx, bly, bxl, bxr, byn, bys, i, ihost, io, j, l, ll
91    REAL    ::  cpuseconds_per_simulated_second
92
93!
94!-- Open the output file. At the end of the simulation, output is directed
95!-- to unit 19.
96    IF ( ( runnr == 0 .OR. force_print_header )  .AND. &
97         .NOT. simulated_time_at_begin /= simulated_time )  THEN
98       io = 15   !  header output on file RUN_CONTROL
99    ELSE
100       io = 19   !  header output on file HEADER
101    ENDIF
102    CALL check_open( io )
103
104!
105!-- At the end of the run, output file (HEADER) will be rewritten with
106!-- new informations
107    IF ( io == 19 .AND. simulated_time_at_begin /= simulated_time ) REWIND( 19 )
108
109!
110!-- Determine kind of model run
111    IF ( TRIM( initializing_actions ) == 'read_restart_data' )  THEN
112       run_classification = '3D - restart run'
113    ELSEIF ( TRIM( initializing_actions ) == 'read_data_for_recycling' )  THEN
114       run_classification = '3D - run using 3D - prerun data'
115    ELSEIF ( INDEX( initializing_actions, 'set_constant_profiles' ) /= 0 )  THEN
116       run_classification = '3D - run without 1D - prerun'
117    ELSEIF ( INDEX(initializing_actions, 'set_1d-model_profiles') /= 0 ) THEN
118       run_classification = '3D - run with 1D - prerun'
119    ELSE
120       PRINT*,'+++ header:  unknown action(s): ',initializing_actions
121    ENDIF
122    IF ( ocean )  THEN
123       run_classification = 'ocean - ' // run_classification
124    ELSE
125       run_classification = 'atmosphere - ' // run_classification
126    ENDIF
127
128!
129!-- Run-identification, date, time, host
130    host_chr = host(1:10)
131    ver_rev = TRIM( version ) // '  ' // TRIM( revision )
132    WRITE ( io, 100 )  ver_rev, TRIM( run_classification )
133    IF ( coupling_mode /= 'uncoupled' )  WRITE ( io, 101 )  coupling_mode
134    WRITE ( io, 102 )  run_date, run_identifier, run_time, runnr, &
135                       ADJUSTR( host_chr )
136#if defined( __parallel )
137    IF ( npex == -1  .AND.  pdims(2) /= 1 )  THEN
138       char1 = 'calculated'
139    ELSEIF ( ( host(1:3) == 'ibm'  .OR.  host(1:3) == 'nec'  .OR.  &
140               host(1:2) == 'lc' )  .AND.                          &
141             npex == -1  .AND.  pdims(2) == 1 )  THEN
142       char1 = 'forced'
143    ELSE
144       char1 = 'predefined'
145    ENDIF
146    IF ( threads_per_task == 1 )  THEN
147       WRITE ( io, 103 )  numprocs, pdims(1), pdims(2), TRIM( char1 )
148    ELSE
149       WRITE ( io, 104 )  numprocs*threads_per_task, numprocs, &
150                          threads_per_task, pdims(1), pdims(2), TRIM( char1 )
151    ENDIF
152    IF ( ( host(1:3) == 'ibm'  .OR.  host(1:3) == 'nec'  .OR.    &
153           host(1:2) == 'lc'   .OR.  host(1:3) == 'dec' )  .AND. &
154         npex == -1  .AND.  pdims(2) == 1 )                      &
155    THEN
156       WRITE ( io, 106 )
157    ELSEIF ( pdims(2) == 1 )  THEN
158       WRITE ( io, 107 )  'x'
159    ELSEIF ( pdims(1) == 1 )  THEN
160       WRITE ( io, 107 )  'y'
161    ENDIF
162    IF ( use_seperate_pe_for_dvrp_output )  WRITE ( io, 105 )
163#endif
164    WRITE ( io, 99 )
165
166!
167!-- Numerical schemes
168    WRITE ( io, 110 )
169    IF ( psolver(1:7) == 'poisfft' )  THEN
170       WRITE ( io, 111 )  TRIM( fft_method )
171       IF ( psolver == 'poisfft_hybrid' )  WRITE ( io, 138 )
172    ELSEIF ( psolver == 'sor' )  THEN
173       WRITE ( io, 112 )  nsor_ini, nsor, omega_sor
174    ELSEIF ( psolver == 'multigrid' )  THEN
175       WRITE ( io, 135 )  cycle_mg, maximum_grid_level, ngsrb
176       IF ( mg_cycles == -1 )  THEN
177          WRITE ( io, 140 )  residual_limit
178       ELSE
179          WRITE ( io, 141 )  mg_cycles
180       ENDIF
181       IF ( mg_switch_to_pe0_level == 0 )  THEN
182          WRITE ( io, 136 )  nxr_mg(1)-nxl_mg(1)+1, nyn_mg(1)-nys_mg(1)+1, &
183                             nzt_mg(1)
184       ELSE
185          WRITE ( io, 137 )  mg_switch_to_pe0_level,            &
186                             mg_loc_ind(2,0)-mg_loc_ind(1,0)+1, &
187                             mg_loc_ind(4,0)-mg_loc_ind(3,0)+1, &
188                             nzt_mg(mg_switch_to_pe0_level),    &
189                             nxr_mg(1)-nxl_mg(1)+1, nyn_mg(1)-nys_mg(1)+1, &
190                             nzt_mg(1)
191       ENDIF
192    ENDIF
193    IF ( call_psolver_at_all_substeps  .AND. timestep_scheme(1:5) == 'runge' ) &
194    THEN
195       WRITE ( io, 142 )
196    ENDIF
197
198    IF ( momentum_advec == 'pw-scheme' )  THEN
199       WRITE ( io, 113 )
200    ELSE
201       WRITE ( io, 114 )
202       IF ( cut_spline_overshoot )  WRITE ( io, 124 )
203       IF ( overshoot_limit_u /= 0.0  .OR.  overshoot_limit_v /= 0.0  .OR. &
204            overshoot_limit_w /= 0.0 )  THEN
205          WRITE ( io, 127 )  overshoot_limit_u, overshoot_limit_v, &
206                             overshoot_limit_w
207       ENDIF
208       IF ( ups_limit_u /= 0.0  .OR.  ups_limit_v /= 0.0  .OR. &
209            ups_limit_w /= 0.0 )                               &
210       THEN
211          WRITE ( io, 125 )  ups_limit_u, ups_limit_v, ups_limit_w
212       ENDIF
213       IF ( long_filter_factor /= 0.0 )  WRITE ( io, 115 )  long_filter_factor
214    ENDIF
215    IF ( scalar_advec == 'pw-scheme' )  THEN
216       WRITE ( io, 116 )
217    ELSEIF ( scalar_advec == 'ups-scheme' )  THEN
218       WRITE ( io, 117 )
219       IF ( cut_spline_overshoot )  WRITE ( io, 124 )
220       IF ( overshoot_limit_e /= 0.0  .OR.  overshoot_limit_pt /= 0.0 )  THEN
221          WRITE ( io, 128 )  overshoot_limit_e, overshoot_limit_pt
222       ENDIF
223       IF ( ups_limit_e /= 0.0  .OR.  ups_limit_pt /= 0.0 )  THEN
224          WRITE ( io, 126 )  ups_limit_e, ups_limit_pt
225       ENDIF
226    ELSE
227       WRITE ( io, 118 )
228    ENDIF
229
230    WRITE ( io, 139 )  TRIM( loop_optimization )
231
232    IF ( galilei_transformation )  THEN
233       IF ( use_ug_for_galilei_tr )  THEN
234          char1 = 'geostrophic wind'
235       ELSE
236          char1 = 'mean wind in model domain'
237       ENDIF
238       IF ( simulated_time_at_begin == simulated_time )  THEN
239          char2 = 'at the start of the run'
240       ELSE
241          char2 = 'at the end of the run'
242       ENDIF
243       WRITE ( io, 119 )  TRIM( char1 ), TRIM( char2 ), &
244                          advected_distance_x/1000.0, advected_distance_y/1000.0
245    ENDIF
246    IF ( timestep_scheme == 'leapfrog' )  THEN
247       WRITE ( io, 120 )
248    ELSEIF ( timestep_scheme == 'leapfrog+euler' )  THEN
249       WRITE ( io, 121 )
250    ELSE
251       WRITE ( io, 122 )  timestep_scheme
252    ENDIF
253    IF ( use_upstream_for_tke )  WRITE ( io, 143 )
254    IF ( rayleigh_damping_factor /= 0.0 )  THEN
255       IF ( .NOT. ocean )  THEN
256          WRITE ( io, 123 )  'above', rayleigh_damping_height, &
257               rayleigh_damping_factor
258       ELSE
259          WRITE ( io, 123 )  'below', rayleigh_damping_height, &
260               rayleigh_damping_factor
261       ENDIF
262    ENDIF
263    IF ( humidity )  THEN
264       IF ( .NOT. cloud_physics )  THEN
265          WRITE ( io, 129 )
266       ELSE
267          WRITE ( io, 130 )
268          WRITE ( io, 131 )
269          IF ( radiation )      WRITE ( io, 132 )
270          IF ( precipitation )  WRITE ( io, 133 )
271       ENDIF
272    ENDIF
273    IF ( passive_scalar )  WRITE ( io, 134 )
274    IF ( conserve_volume_flow )  WRITE ( io, 150 )
275    WRITE ( io, 99 )
276
277!
278!-- Runtime and timestep informations
279    WRITE ( io, 200 )
280    IF ( .NOT. dt_fixed )  THEN
281       WRITE ( io, 201 )  dt_max, cfl_factor
282    ELSE
283       WRITE ( io, 202 )  dt
284    ENDIF
285    WRITE ( io, 203 )  simulated_time_at_begin, end_time
286
287    IF ( time_restart /= 9999999.9  .AND. &
288         simulated_time_at_begin == simulated_time )  THEN
289       IF ( dt_restart == 9999999.9 )  THEN
290          WRITE ( io, 204 )  ' Restart at:       ',time_restart
291       ELSE
292          WRITE ( io, 205 )  ' Restart at:       ',time_restart, dt_restart
293       ENDIF
294    ENDIF
295
296    IF ( simulated_time_at_begin /= simulated_time )  THEN
297       i = MAX ( log_point_s(10)%counts, 1 )
298       IF ( ( simulated_time - simulated_time_at_begin ) == 0.0 )  THEN
299          cpuseconds_per_simulated_second = 0.0
300       ELSE
301          cpuseconds_per_simulated_second = log_point_s(10)%sum / &
302                                            ( simulated_time -    &
303                                              simulated_time_at_begin )
304       ENDIF
305       WRITE ( io, 206 )  simulated_time, log_point_s(10)%sum, &
306                          log_point_s(10)%sum / REAL( i ),     &
307                          cpuseconds_per_simulated_second
308       IF ( time_restart /= 9999999.9  .AND.  time_restart < end_time )  THEN
309          IF ( dt_restart == 9999999.9 )  THEN
310             WRITE ( io, 204 )  ' Next restart at:  ',time_restart
311          ELSE
312             WRITE ( io, 205 )  ' Next restart at:  ',time_restart, dt_restart
313          ENDIF
314       ENDIF
315    ENDIF
316
317!
318!-- Computational grid
319    IF ( .NOT. ocean )  THEN
320       WRITE ( io, 250 )  dx, dy, dz, (nx+1)*dx, (ny+1)*dy, zu(nzt+1)
321       IF ( dz_stretch_level_index < nzt+1 )  THEN
322          WRITE ( io, 252 )  dz_stretch_level, dz_stretch_level_index, &
323                             dz_stretch_factor, dz_max
324       ENDIF
325    ELSE
326       WRITE ( io, 250 )  dx, dy, dz, (nx+1)*dx, (ny+1)*dy, zu(0)
327       IF ( dz_stretch_level_index > 0 )  THEN
328          WRITE ( io, 252 )  dz_stretch_level, dz_stretch_level_index, &
329                             dz_stretch_factor, dz_max
330       ENDIF
331    ENDIF
332    WRITE ( io, 254 )  nx, ny, nzt+1, MIN( nnx, nx+1 ), MIN( nny, ny+1 ), &
333                       MIN( nnz+2, nzt+2 )
334    IF ( numprocs > 1 )  THEN
335       IF ( nxa == nx  .AND.  nya == ny  .AND.  nza == nz )  THEN
336          WRITE ( io, 255 )
337       ELSE
338          WRITE ( io, 256 )  nnx-(nxa-nx), nny-(nya-ny), nzt+2
339       ENDIF
340    ENDIF
341    IF ( sloping_surface )  WRITE ( io, 260 )  alpha_surface
342
343!
344!-- Topography
345    WRITE ( io, 270 )  topography
346    SELECT CASE ( TRIM( topography ) )
347
348       CASE ( 'flat' )
349          ! no actions necessary
350
351       CASE ( 'single_building' )
352          blx = INT( building_length_x / dx )
353          bly = INT( building_length_y / dy )
354          bh  = INT( building_height / dz )
355
356          IF ( building_wall_left == 9999999.9 )  THEN
357             building_wall_left = ( nx + 1 - blx ) / 2 * dx
358          ENDIF
359          bxl = INT ( building_wall_left / dx + 0.5 )
360          bxr = bxl + blx
361
362          IF ( building_wall_south == 9999999.9 )  THEN
363             building_wall_south = ( ny + 1 - bly ) / 2 * dy
364          ENDIF
365          bys = INT ( building_wall_south / dy + 0.5 )
366          byn = bys + bly
367
368          WRITE ( io, 271 )  building_length_x, building_length_y, &
369                             building_height, bxl, bxr, bys, byn
370
371    END SELECT
372
373    IF ( plant_canopy ) THEN
374
375       WRITE ( io, 280 ) canopy_mode, pch_index, drag_coefficient
376       IF ( passive_scalar ) THEN
377          WRITE ( io, 281 ) scalar_exchange_coefficient,   &
378                            leaf_surface_concentration
379       ENDIF
380
381!
382!--    Heat flux at the top of vegetation
383       WRITE ( io, 282 ) cthf
384
385!
386!--    Leaf area density profile
387!--    Building output strings, starting with surface value
388       WRITE ( learde, '(F6.2)' )  lad_surface
389       gradients = '------'
390       slices = '     0'
391       coordinates = '   0.0'
392       i = 1
393       DO  WHILE ( lad_vertical_gradient_level_ind(i) /= -9999 )
394
395          WRITE (coor_chr,'(F7.2)')  lad(lad_vertical_gradient_level_ind(i))
396          learde = TRIM( learde ) // ' ' // TRIM( coor_chr )
397
398          WRITE (coor_chr,'(F7.2)')  lad_vertical_gradient(i)
399          gradients = TRIM( gradients ) // ' ' // TRIM( coor_chr )
400
401          WRITE (coor_chr,'(I7)')  lad_vertical_gradient_level_ind(i)
402          slices = TRIM( slices ) // ' ' // TRIM( coor_chr )
403
404          WRITE (coor_chr,'(F7.1)')  lad_vertical_gradient_level(i)
405          coordinates = TRIM( coordinates ) // ' '  // TRIM( coor_chr )
406
407          i = i + 1
408       ENDDO
409
410       WRITE ( io, 283 )  TRIM( coordinates ), TRIM( learde ), &
411                          TRIM( gradients ), TRIM( slices )
412
413    ENDIF
414
415!
416!-- Boundary conditions
417    IF ( ibc_p_b == 0 )  THEN
418       runten = 'p(0)     = 0      |'
419    ELSEIF ( ibc_p_b == 1 )  THEN
420       runten = 'p(0)     = p(1)   |'
421    ELSE
422       runten = 'p(0)     = p(1) +R|'
423    ENDIF
424    IF ( ibc_p_t == 0 )  THEN
425       roben  = 'p(nzt+1) = 0      |'
426    ELSE
427       roben  = 'p(nzt+1) = p(nzt) |'
428    ENDIF
429
430    IF ( ibc_uv_b == 0 )  THEN
431       runten = TRIM( runten ) // ' uv(0)     = -uv(1)                |'
432    ELSE
433       runten = TRIM( runten ) // ' uv(0)     = uv(1)                 |'
434    ENDIF
435    IF ( TRIM( bc_uv_t ) == 'dirichlet_0' )  THEN
436       roben  = TRIM( roben  ) // ' uv(nzt+1) = 0                     |'
437    ELSEIF ( ibc_uv_t == 0 )  THEN
438       roben  = TRIM( roben  ) // ' uv(nzt+1) = ug(nzt+1), vg(nzt+1)  |'
439    ELSE
440       roben  = TRIM( roben  ) // ' uv(nzt+1) = uv(nzt)               |'
441    ENDIF
442
443    IF ( ibc_pt_b == 0 )  THEN
444       runten = TRIM( runten ) // ' pt(0)   = pt_surface'
445    ELSEIF ( ibc_pt_b == 1 )  THEN
446       runten = TRIM( runten ) // ' pt(0)   = pt(1)'
447    ELSEIF ( ibc_pt_b == 2 )  THEN
448       runten = TRIM( runten ) // ' pt(0) = from coupled model'
449    ENDIF
450    IF ( ibc_pt_t == 0 )  THEN
451       roben  = TRIM( roben  ) // ' pt(nzt+1) = pt_top'
452    ELSEIF( ibc_pt_t == 1 )  THEN
453       roben  = TRIM( roben  ) // ' pt(nzt+1) = pt(nzt)'
454    ELSEIF( ibc_pt_t == 2 )  THEN
455       roben  = TRIM( roben  ) // ' pt(nzt+1) = pt(nzt) + dpt/dz_ini'
456    ENDIF
457
458    WRITE ( io, 300 )  runten, roben
459
460    IF ( .NOT. constant_diffusion )  THEN
461       IF ( ibc_e_b == 1 )  THEN
462          runten = 'e(0)     = e(1)'
463       ELSE
464          runten = 'e(0)     = e(1) = (u*/0.1)**2'
465       ENDIF
466       roben = 'e(nzt+1) = e(nzt) = e(nzt-1)'
467
468       WRITE ( io, 301 )  'e', runten, roben       
469
470    ENDIF
471
472    IF ( ocean )  THEN
473       runten = 'sa(0)    = sa(1)'
474       IF ( ibc_sa_t == 0 )  THEN
475          roben =  'sa(nzt+1) = sa_surface'
476       ELSE
477          roben =  'sa(nzt+1) = sa(nzt)'
478       ENDIF
479       WRITE ( io, 301 ) 'sa', runten, roben
480    ENDIF
481
482    IF ( humidity )  THEN
483       IF ( ibc_q_b == 0 )  THEN
484          runten = 'q(0)     = q_surface'
485       ELSE
486          runten = 'q(0)     = q(1)'
487       ENDIF
488       IF ( ibc_q_t == 0 )  THEN
489          roben =  'q(nzt)   = q_top'
490       ELSE
491          roben =  'q(nzt)   = q(nzt-1) + dq/dz'
492       ENDIF
493       WRITE ( io, 301 ) 'q', runten, roben
494    ENDIF
495
496    IF ( passive_scalar )  THEN
497       IF ( ibc_q_b == 0 )  THEN
498          runten = 's(0)     = s_surface'
499       ELSE
500          runten = 's(0)     = s(1)'
501       ENDIF
502       IF ( ibc_q_t == 0 )  THEN
503          roben =  's(nzt)   = s_top'
504       ELSE
505          roben =  's(nzt)   = s(nzt-1) + ds/dz'
506       ENDIF
507       WRITE ( io, 301 ) 's', runten, roben
508    ENDIF
509
510    IF ( use_surface_fluxes )  THEN
511       WRITE ( io, 303 )
512       IF ( constant_heatflux )  THEN
513          WRITE ( io, 306 )  surface_heatflux
514          IF ( random_heatflux )  WRITE ( io, 307 )
515       ENDIF
516       IF ( humidity  .AND.  constant_waterflux )  THEN
517          WRITE ( io, 311 ) surface_waterflux
518       ENDIF
519       IF ( passive_scalar  .AND.  constant_waterflux )  THEN
520          WRITE ( io, 313 ) surface_waterflux
521       ENDIF
522    ENDIF
523
524    IF ( use_top_fluxes )  THEN
525       WRITE ( io, 304 )
526       IF ( coupling_mode == 'uncoupled' )  THEN
527          WRITE ( io, 320 )  top_momentumflux_u, top_momentumflux_v
528          IF ( constant_top_heatflux )  THEN
529             WRITE ( io, 306 )  top_heatflux
530          ENDIF
531       ELSEIF ( coupling_mode == 'ocean_to_atmosphere' )  THEN
532          WRITE ( io, 316 )
533       ENDIF
534       IF ( ocean  .AND.  constant_top_salinityflux )  THEN
535          WRITE ( io, 309 )  top_salinityflux
536       ENDIF
537       IF ( humidity  .OR.  passive_scalar )  THEN
538          WRITE ( io, 315 )
539       ENDIF
540    ENDIF
541
542    IF ( prandtl_layer )  THEN
543       WRITE ( io, 305 )  0.5 * (zu(1)-zu(0)), roughness_length, kappa, &
544                          rif_min, rif_max
545       IF ( .NOT. constant_heatflux )  WRITE ( io, 308 )
546       IF ( humidity  .AND.  .NOT. constant_waterflux )  THEN
547          WRITE ( io, 312 )
548       ENDIF
549       IF ( passive_scalar  .AND.  .NOT. constant_waterflux )  THEN
550          WRITE ( io, 314 )
551       ENDIF
552    ELSE
553       IF ( INDEX(initializing_actions, 'set_1d-model_profiles') /= 0 )  THEN
554          WRITE ( io, 310 )  rif_min, rif_max
555       ENDIF
556    ENDIF
557
558    WRITE ( io, 317 )  bc_lr, bc_ns
559    IF ( bc_lr /= 'cyclic'  .OR.  bc_ns /= 'cyclic' )  THEN
560       WRITE ( io, 318 )  outflow_damping_width, km_damp_max
561       IF ( turbulent_inflow )  THEN
562          WRITE ( io, 319 )  recycling_width, recycling_plane, &
563                             inflow_damping_height, inflow_damping_width
564       ENDIF
565    ENDIF
566
567!
568!-- Listing of 1D-profiles
569    WRITE ( io, 325 )  dt_dopr_listing
570    IF ( averaging_interval_pr /= 0.0 )  THEN
571       WRITE ( io, 326 )  averaging_interval_pr, dt_averaging_input_pr
572    ENDIF
573
574!
575!-- DATA output
576    WRITE ( io, 330 )
577    IF ( averaging_interval_pr /= 0.0 )  THEN
578       WRITE ( io, 326 )  averaging_interval_pr, dt_averaging_input_pr
579    ENDIF
580
581!
582!-- 1D-profiles
583    dopr_chr = 'Profile:'
584    IF ( dopr_n /= 0 )  THEN
585       WRITE ( io, 331 )
586
587       output_format = ''
588       IF ( netcdf_output )  THEN
589          IF ( netcdf_64bit )  THEN
590             output_format = 'netcdf (64 bit offset)'
591          ELSE
592             output_format = 'netcdf'
593          ENDIF
594       ENDIF
595       IF ( profil_output )  THEN
596          IF ( netcdf_output )  THEN
597             output_format = TRIM( output_format ) // ' and profil'
598          ELSE
599             output_format = 'profil'
600          ENDIF
601       ENDIF
602       WRITE ( io, 345 )  output_format
603
604       DO  i = 1, dopr_n
605          dopr_chr = TRIM( dopr_chr ) // ' ' // TRIM( data_output_pr(i) ) // ','
606          IF ( LEN_TRIM( dopr_chr ) >= 60 )  THEN
607             WRITE ( io, 332 )  dopr_chr
608             dopr_chr = '       :'
609          ENDIF
610       ENDDO
611
612       IF ( dopr_chr /= '' )  THEN
613          WRITE ( io, 332 )  dopr_chr
614       ENDIF
615       WRITE ( io, 333 )  dt_dopr, averaging_interval_pr, dt_averaging_input_pr
616       IF ( skip_time_dopr /= 0.0 )  WRITE ( io, 339 )  skip_time_dopr
617    ENDIF
618
619!
620!-- 2D-arrays
621    DO  av = 0, 1
622
623       i = 1
624       do2d_xy = ''
625       do2d_xz = ''
626       do2d_yz = ''
627       DO  WHILE ( do2d(av,i) /= ' ' )
628
629          l = MAX( 2, LEN_TRIM( do2d(av,i) ) )
630          do2d_mode = do2d(av,i)(l-1:l)
631
632          SELECT CASE ( do2d_mode )
633             CASE ( 'xy' )
634                ll = LEN_TRIM( do2d_xy )
635                do2d_xy = do2d_xy(1:ll) // ' ' // do2d(av,i)(1:l-3) // ','
636             CASE ( 'xz' )
637                ll = LEN_TRIM( do2d_xz )
638                do2d_xz = do2d_xz(1:ll) // ' ' // do2d(av,i)(1:l-3) // ','
639             CASE ( 'yz' )
640                ll = LEN_TRIM( do2d_yz )
641                do2d_yz = do2d_yz(1:ll) // ' ' // do2d(av,i)(1:l-3) // ','
642          END SELECT
643
644          i = i + 1
645
646       ENDDO
647
648       IF ( ( ( do2d_xy /= ''  .AND.  section(1,1) /= -9999 )  .OR.    &
649              ( do2d_xz /= ''  .AND.  section(1,2) /= -9999 )  .OR.    &
650              ( do2d_yz /= ''  .AND.  section(1,3) /= -9999 ) )  .AND. &
651            ( netcdf_output  .OR.  iso2d_output ) )  THEN
652
653          IF (  av == 0 )  THEN
654             WRITE ( io, 334 )  ''
655          ELSE
656             WRITE ( io, 334 )  '(time-averaged)'
657          ENDIF
658
659          IF ( do2d_at_begin )  THEN
660             begin_chr = 'and at the start'
661          ELSE
662             begin_chr = ''
663          ENDIF
664
665          output_format = ''
666          IF ( netcdf_output )  THEN
667             IF ( netcdf_64bit )  THEN
668                output_format = 'netcdf (64 bit offset)'
669             ELSE
670                output_format = 'netcdf'
671             ENDIF
672          ENDIF
673          IF ( iso2d_output )  THEN
674             IF ( netcdf_output )  THEN
675                output_format = TRIM( output_format ) // ' and iso2d'
676             ELSE
677                output_format = 'iso2d'
678             ENDIF
679          ENDIF
680          WRITE ( io, 345 )  output_format
681
682          IF ( do2d_xy /= ''  .AND.  section(1,1) /= -9999 )  THEN
683             i = 1
684             slices = '/'
685             coordinates = '/'
686!
687!--          Building strings with index and coordinate informations of the
688!--          slices
689             DO  WHILE ( section(i,1) /= -9999 )
690
691                WRITE (section_chr,'(I5)')  section(i,1)
692                section_chr = ADJUSTL( section_chr )
693                slices = TRIM( slices ) // TRIM( section_chr ) // '/'
694
695                WRITE (coor_chr,'(F10.1)')  zu(section(i,1))
696                coor_chr = ADJUSTL( coor_chr )
697                coordinates = TRIM( coordinates ) // TRIM( coor_chr ) // '/'
698
699                i = i + 1
700             ENDDO
701             IF ( av == 0 )  THEN
702                WRITE ( io, 335 )  'XY', do2d_xy, dt_do2d_xy, &
703                                   TRIM( begin_chr ), 'k', TRIM( slices ), &
704                                   TRIM( coordinates )
705                IF ( skip_time_do2d_xy /= 0.0 )  THEN
706                   WRITE ( io, 339 )  skip_time_do2d_xy
707                ENDIF
708             ELSE
709                WRITE ( io, 342 )  'XY', do2d_xy, dt_data_output_av, &
710                                   TRIM( begin_chr ), averaging_interval, &
711                                   dt_averaging_input, 'k', TRIM( slices ), &
712                                   TRIM( coordinates )
713                IF ( skip_time_data_output_av /= 0.0 )  THEN
714                   WRITE ( io, 339 )  skip_time_data_output_av
715                ENDIF
716             ENDIF
717
718          ENDIF
719
720          IF ( do2d_xz /= ''  .AND.  section(1,2) /= -9999 )  THEN
721             i = 1
722             slices = '/'
723             coordinates = '/'
724!
725!--          Building strings with index and coordinate informations of the
726!--          slices
727             DO  WHILE ( section(i,2) /= -9999 )
728
729                WRITE (section_chr,'(I5)')  section(i,2)
730                section_chr = ADJUSTL( section_chr )
731                slices = TRIM( slices ) // TRIM( section_chr ) // '/'
732
733                WRITE (coor_chr,'(F10.1)')  section(i,2) * dy
734                coor_chr = ADJUSTL( coor_chr )
735                coordinates = TRIM( coordinates ) // TRIM( coor_chr ) // '/'
736
737                i = i + 1
738             ENDDO
739             IF ( av == 0 )  THEN
740                WRITE ( io, 335 )  'XZ', do2d_xz, dt_do2d_xz, &
741                                   TRIM( begin_chr ), 'j', TRIM( slices ), &
742                                   TRIM( coordinates )
743                IF ( skip_time_do2d_xz /= 0.0 )  THEN
744                   WRITE ( io, 339 )  skip_time_do2d_xz
745                ENDIF
746             ELSE
747                WRITE ( io, 342 )  'XZ', do2d_xz, dt_data_output_av, &
748                                   TRIM( begin_chr ), averaging_interval, &
749                                   dt_averaging_input, 'j', TRIM( slices ), &
750                                   TRIM( coordinates )
751                IF ( skip_time_data_output_av /= 0.0 )  THEN
752                   WRITE ( io, 339 )  skip_time_data_output_av
753                ENDIF
754             ENDIF
755          ENDIF
756
757          IF ( do2d_yz /= ''  .AND.  section(1,3) /= -9999 )  THEN
758             i = 1
759             slices = '/'
760             coordinates = '/'
761!
762!--          Building strings with index and coordinate informations of the
763!--          slices
764             DO  WHILE ( section(i,3) /= -9999 )
765
766                WRITE (section_chr,'(I5)')  section(i,3)
767                section_chr = ADJUSTL( section_chr )
768                slices = TRIM( slices ) // TRIM( section_chr ) // '/'
769
770                WRITE (coor_chr,'(F10.1)')  section(i,3) * dx
771                coor_chr = ADJUSTL( coor_chr )
772                coordinates = TRIM( coordinates ) // TRIM( coor_chr ) // '/'
773
774                i = i + 1
775             ENDDO
776             IF ( av == 0 )  THEN
777                WRITE ( io, 335 )  'YZ', do2d_yz, dt_do2d_yz, &
778                                   TRIM( begin_chr ), 'i', TRIM( slices ), &
779                                   TRIM( coordinates )
780                IF ( skip_time_do2d_yz /= 0.0 )  THEN
781                   WRITE ( io, 339 )  skip_time_do2d_yz
782                ENDIF
783             ELSE
784                WRITE ( io, 342 )  'YZ', do2d_yz, dt_data_output_av, &
785                                   TRIM( begin_chr ), averaging_interval, &
786                                   dt_averaging_input, 'i', TRIM( slices ), &
787                                   TRIM( coordinates )
788                IF ( skip_time_data_output_av /= 0.0 )  THEN
789                   WRITE ( io, 339 )  skip_time_data_output_av
790                ENDIF
791             ENDIF
792          ENDIF
793
794       ENDIF
795
796    ENDDO
797
798!
799!-- 3d-arrays
800    DO  av = 0, 1
801
802       i = 1
803       do3d_chr = ''
804       DO  WHILE ( do3d(av,i) /= ' ' )
805
806          do3d_chr = TRIM( do3d_chr ) // ' ' // TRIM( do3d(av,i) ) // ','
807          i = i + 1
808
809       ENDDO
810
811       IF ( do3d_chr /= '' )  THEN
812          IF ( av == 0 )  THEN
813             WRITE ( io, 336 )  ''
814          ELSE
815             WRITE ( io, 336 )  '(time-averaged)'
816          ENDIF
817
818          output_format = ''
819          IF ( netcdf_output )  THEN
820             IF ( netcdf_64bit .AND. netcdf_64bit_3d )  THEN
821                output_format = 'netcdf (64 bit offset)'
822             ELSE
823                output_format = 'netcdf'
824             ENDIF
825          ENDIF
826          IF ( avs_output )  THEN
827             IF ( netcdf_output )  THEN
828                output_format = TRIM( output_format ) // ' and avs'
829             ELSE
830                output_format = 'avs'
831             ENDIF
832          ENDIF
833          WRITE ( io, 345 )  output_format
834
835          IF ( do3d_at_begin )  THEN
836             begin_chr = 'and at the start'
837          ELSE
838             begin_chr = ''
839          ENDIF
840          IF ( av == 0 )  THEN
841             WRITE ( io, 337 )  do3d_chr, dt_do3d, TRIM( begin_chr ), &
842                                zu(nz_do3d), nz_do3d
843          ELSE
844             WRITE ( io, 343 )  do3d_chr, dt_data_output_av,           &
845                                TRIM( begin_chr ), averaging_interval, &
846                                dt_averaging_input, zu(nz_do3d), nz_do3d
847          ENDIF
848
849          IF ( do3d_compress )  THEN
850             do3d_chr = ''
851             i = 1
852             DO WHILE ( do3d(av,i) /= ' ' )
853
854                SELECT CASE ( do3d(av,i) )
855                   CASE ( 'u' )
856                      j = 1
857                   CASE ( 'v' )
858                      j = 2
859                   CASE ( 'w' )
860                      j = 3
861                   CASE ( 'p' )
862                      j = 4
863                   CASE ( 'pt' )
864                      j = 5
865                END SELECT
866                WRITE ( prec, '(I1)' )  plot_3d_precision(j)%precision
867                do3d_chr = TRIM( do3d_chr ) // ' ' // TRIM( do3d(av,i) ) // &
868                           ':' // prec // ','
869                i = i + 1
870
871             ENDDO
872             WRITE ( io, 338 )  do3d_chr
873
874          ENDIF
875
876          IF ( av == 0 )  THEN
877             IF ( skip_time_do3d /= 0.0 )  THEN
878                WRITE ( io, 339 )  skip_time_do3d
879             ENDIF
880          ELSE
881             IF ( skip_time_data_output_av /= 0.0 )  THEN
882                WRITE ( io, 339 )  skip_time_data_output_av
883             ENDIF
884          ENDIF
885
886       ENDIF
887
888    ENDDO
889
890!
891!-- Timeseries
892    IF ( dt_dots /= 9999999.9 )  THEN
893       WRITE ( io, 340 )
894
895       output_format = ''
896       IF ( netcdf_output )  THEN
897          IF ( netcdf_64bit )  THEN
898             output_format = 'netcdf (64 bit offset)'
899          ELSE
900             output_format = 'netcdf'
901          ENDIF
902       ENDIF
903       IF ( profil_output )  THEN
904          IF ( netcdf_output )  THEN
905             output_format = TRIM( output_format ) // ' and profil'
906          ELSE
907             output_format = 'profil'
908          ENDIF
909       ENDIF
910       WRITE ( io, 345 )  output_format
911       WRITE ( io, 341 )  dt_dots
912    ENDIF
913
914#if defined( __dvrp_graphics )
915!
916!-- Dvrp-output
917    IF ( dt_dvrp /= 9999999.9 )  THEN
918       WRITE ( io, 360 )  dt_dvrp, TRIM( dvrp_output ), TRIM( dvrp_host ), &
919                          TRIM( dvrp_username ), TRIM( dvrp_directory )
920       i = 1
921       l = 0
922       DO WHILE ( mode_dvrp(i) /= ' ' )
923          IF ( mode_dvrp(i)(1:10) == 'isosurface' )  THEN
924             READ ( mode_dvrp(i), '(10X,I2)' )  j
925             l = l + 1
926             IF ( do3d(0,j) /= ' ' )  THEN
927                WRITE ( io, 361 )  TRIM( do3d(0,j) ), threshold(l)
928             ENDIF
929          ELSEIF ( mode_dvrp(i)(1:6) == 'slicer' )  THEN
930             READ ( mode_dvrp(i), '(6X,I2)' )  j
931             IF ( do2d(0,j) /= ' ' )  WRITE ( io, 362 )  TRIM( do2d(0,j) )
932          ELSEIF ( mode_dvrp(i)(1:9) == 'particles' )  THEN
933             WRITE ( io, 363 )
934          ENDIF
935          i = i + 1
936       ENDDO
937    ENDIF
938#endif
939
940#if defined( __spectra )
941!
942!-- Spectra output
943    IF ( dt_dosp /= 9999999.9 ) THEN
944       WRITE ( io, 370 )
945
946       output_format = ''
947       IF ( netcdf_output )  THEN
948          IF ( netcdf_64bit )  THEN
949             output_format = 'netcdf (64 bit offset)'
950          ELSE
951             output_format = 'netcdf'
952          ENDIF
953       ENDIF
954       IF ( profil_output )  THEN
955          IF ( netcdf_output )  THEN
956             output_format = TRIM( output_format ) // ' and profil'
957          ELSE
958             output_format = 'profil'
959          ENDIF
960       ENDIF
961       WRITE ( io, 345 )  output_format
962       WRITE ( io, 371 )  dt_dosp
963       IF ( skip_time_dosp /= 0.0 )  WRITE ( io, 339 )  skip_time_dosp
964       WRITE ( io, 372 )  ( data_output_sp(i), i = 1,10 ),     &
965                          ( spectra_direction(i), i = 1,10 ),  &
966                          ( comp_spectra_level(i), i = 1,10 ), &
967                          ( plot_spectra_level(i), i = 1,10 ), &
968                          averaging_interval_sp, dt_averaging_input_pr
969    ENDIF
970#endif
971
972    WRITE ( io, 99 )
973
974!
975!-- Physical quantities
976    WRITE ( io, 400 )
977
978!
979!-- Geostrophic parameters
980    WRITE ( io, 410 )  omega, phi, f, fs
981
982!
983!-- Other quantities
984    WRITE ( io, 411 )  g
985    IF ( use_reference )  THEN
986       IF ( ocean )  THEN
987          WRITE ( io, 412 )  prho_reference
988       ELSE
989          WRITE ( io, 413 )  pt_reference
990       ENDIF
991    ENDIF
992
993!
994!-- Cloud physics parameters
995    IF ( cloud_physics ) THEN
996       WRITE ( io, 415 )
997       WRITE ( io, 416 ) surface_pressure, r_d, rho_surface, cp, l_v
998    ENDIF
999
1000!-- Profile of the geostrophic wind (component ug)
1001!-- Building output strings
1002    WRITE ( ugcomponent, '(F6.2)' )  ug_surface
1003    gradients = '------'
1004    slices = '     0'
1005    coordinates = '   0.0'
1006    i = 1
1007    DO  WHILE ( ug_vertical_gradient_level_ind(i) /= -9999 )
1008     
1009       WRITE (coor_chr,'(F6.2,1X)')  ug(ug_vertical_gradient_level_ind(i))
1010       ugcomponent = TRIM( ugcomponent ) // '  ' // TRIM( coor_chr )
1011
1012       WRITE (coor_chr,'(F6.2,1X)')  ug_vertical_gradient(i)
1013       gradients = TRIM( gradients ) // '  ' // TRIM( coor_chr )
1014
1015       WRITE (coor_chr,'(I6,1X)')  ug_vertical_gradient_level_ind(i)
1016       slices = TRIM( slices ) // '  ' // TRIM( coor_chr )
1017
1018       WRITE (coor_chr,'(F6.1,1X)')  ug_vertical_gradient_level(i)
1019       coordinates = TRIM( coordinates ) // '  ' // TRIM( coor_chr )
1020
1021       i = i + 1
1022    ENDDO
1023
1024    WRITE ( io, 423 )  TRIM( coordinates ), TRIM( ugcomponent ), &
1025                       TRIM( gradients ), TRIM( slices )
1026
1027!-- Profile of the geostrophic wind (component vg)
1028!-- Building output strings
1029    WRITE ( vgcomponent, '(F6.2)' )  vg_surface
1030    gradients = '------'
1031    slices = '     0'
1032    coordinates = '   0.0'
1033    i = 1
1034    DO  WHILE ( vg_vertical_gradient_level_ind(i) /= -9999 )
1035
1036       WRITE (coor_chr,'(F6.2,1X)')  vg(vg_vertical_gradient_level_ind(i))
1037       vgcomponent = TRIM( vgcomponent ) // '  ' // TRIM( coor_chr )
1038
1039       WRITE (coor_chr,'(F6.2,1X)')  vg_vertical_gradient(i)
1040       gradients = TRIM( gradients ) // '  ' // TRIM( coor_chr )
1041
1042       WRITE (coor_chr,'(I6,1X)')  vg_vertical_gradient_level_ind(i)
1043       slices = TRIM( slices ) // '  ' // TRIM( coor_chr )
1044
1045       WRITE (coor_chr,'(F6.1,1X)')  vg_vertical_gradient_level(i)
1046       coordinates = TRIM( coordinates ) // '  ' // TRIM( coor_chr )
1047
1048       i = i + 1 
1049    ENDDO
1050
1051    WRITE ( io, 424 )  TRIM( coordinates ), TRIM( vgcomponent ), &
1052                       TRIM( gradients ), TRIM( slices )
1053
1054!
1055!-- Initial temperature profile
1056!-- Building output strings, starting with surface temperature
1057    WRITE ( temperatures, '(F6.2)' )  pt_surface
1058    gradients = '------'
1059    slices = '     0'
1060    coordinates = '   0.0'
1061    i = 1
1062    DO  WHILE ( pt_vertical_gradient_level_ind(i) /= -9999 )
1063
1064       WRITE (coor_chr,'(F7.2)')  pt_init(pt_vertical_gradient_level_ind(i))
1065       temperatures = TRIM( temperatures ) // ' ' // TRIM( coor_chr )
1066
1067       WRITE (coor_chr,'(F7.2)')  pt_vertical_gradient(i)
1068       gradients = TRIM( gradients ) // ' ' // TRIM( coor_chr )
1069
1070       WRITE (coor_chr,'(I7)')  pt_vertical_gradient_level_ind(i)
1071       slices = TRIM( slices ) // ' ' // TRIM( coor_chr )
1072
1073       WRITE (coor_chr,'(F7.1)')  pt_vertical_gradient_level(i)
1074       coordinates = TRIM( coordinates ) // ' '  // TRIM( coor_chr )
1075
1076       i = i + 1
1077    ENDDO
1078
1079    WRITE ( io, 420 )  TRIM( coordinates ), TRIM( temperatures ), &
1080                       TRIM( gradients ), TRIM( slices )
1081
1082!
1083!-- Initial humidity profile
1084!-- Building output strings, starting with surface humidity
1085    IF ( humidity  .OR.  passive_scalar )  THEN
1086       WRITE ( temperatures, '(E8.1)' )  q_surface
1087       gradients = '--------'
1088       slices = '       0'
1089       coordinates = '     0.0'
1090       i = 1
1091       DO  WHILE ( q_vertical_gradient_level_ind(i) /= -9999 )
1092         
1093          WRITE (coor_chr,'(E8.1,4X)')  q_init(q_vertical_gradient_level_ind(i))
1094          temperatures = TRIM( temperatures ) // '  ' // TRIM( coor_chr )
1095
1096          WRITE (coor_chr,'(E8.1,4X)')  q_vertical_gradient(i)
1097          gradients = TRIM( gradients ) // '  ' // TRIM( coor_chr )
1098         
1099          WRITE (coor_chr,'(I8,4X)')  q_vertical_gradient_level_ind(i)
1100          slices = TRIM( slices ) // '  ' // TRIM( coor_chr )
1101         
1102          WRITE (coor_chr,'(F8.1,4X)')  q_vertical_gradient_level(i)
1103          coordinates = TRIM( coordinates ) // '  '  // TRIM( coor_chr )
1104
1105          i = i + 1
1106       ENDDO
1107
1108       IF ( humidity )  THEN
1109          WRITE ( io, 421 )  TRIM( coordinates ), TRIM( temperatures ), &
1110                             TRIM( gradients ), TRIM( slices )
1111       ELSE
1112          WRITE ( io, 422 )  TRIM( coordinates ), TRIM( temperatures ), &
1113                             TRIM( gradients ), TRIM( slices )
1114       ENDIF
1115    ENDIF
1116
1117!
1118!-- Initial salinity profile
1119!-- Building output strings, starting with surface salinity
1120    IF ( ocean )  THEN
1121       WRITE ( temperatures, '(F6.2)' )  sa_surface
1122       gradients = '------'
1123       slices = '     0'
1124       coordinates = '   0.0'
1125       i = 1
1126       DO  WHILE ( sa_vertical_gradient_level_ind(i) /= -9999 )
1127
1128          WRITE (coor_chr,'(F7.2)')  sa_init(sa_vertical_gradient_level_ind(i))
1129          temperatures = TRIM( temperatures ) // ' ' // TRIM( coor_chr )
1130
1131          WRITE (coor_chr,'(F7.2)')  sa_vertical_gradient(i)
1132          gradients = TRIM( gradients ) // ' ' // TRIM( coor_chr )
1133
1134          WRITE (coor_chr,'(I7)')  sa_vertical_gradient_level_ind(i)
1135          slices = TRIM( slices ) // ' ' // TRIM( coor_chr )
1136
1137          WRITE (coor_chr,'(F7.1)')  sa_vertical_gradient_level(i)
1138          coordinates = TRIM( coordinates ) // ' '  // TRIM( coor_chr )
1139
1140          i = i + 1
1141       ENDDO
1142
1143       WRITE ( io, 425 )  TRIM( coordinates ), TRIM( temperatures ), &
1144                          TRIM( gradients ), TRIM( slices )
1145    ENDIF
1146
1147!
1148!-- LES / turbulence parameters
1149    WRITE ( io, 450 )
1150
1151!--
1152! ... LES-constants used must still be added here
1153!--
1154    IF ( constant_diffusion )  THEN
1155       WRITE ( io, 451 )  km_constant, km_constant/prandtl_number, &
1156                          prandtl_number
1157    ENDIF
1158    IF ( .NOT. constant_diffusion)  THEN
1159       IF ( e_init > 0.0 )  WRITE ( io, 455 )  e_init
1160       IF ( e_min > 0.0 )  WRITE ( io, 454 )  e_min
1161       IF ( wall_adjustment )  WRITE ( io, 453 )  wall_adjustment_factor
1162       IF ( adjust_mixing_length  .AND.  prandtl_layer )  WRITE ( io, 452 )
1163    ENDIF
1164
1165!
1166!-- Special actions during the run
1167    WRITE ( io, 470 )
1168    IF ( create_disturbances )  THEN
1169       WRITE ( io, 471 )  dt_disturb, disturbance_amplitude,                   &
1170                          zu(disturbance_level_ind_b), disturbance_level_ind_b,&
1171                          zu(disturbance_level_ind_t), disturbance_level_ind_t
1172       IF ( bc_lr /= 'cyclic'  .OR.  bc_ns /= 'cyclic' )  THEN
1173          WRITE ( io, 472 )  inflow_disturbance_begin, inflow_disturbance_end
1174       ELSE
1175          WRITE ( io, 473 )  disturbance_energy_limit
1176       ENDIF
1177       WRITE ( io, 474 )  TRIM( random_generator )
1178    ENDIF
1179    IF ( pt_surface_initial_change /= 0.0 )  THEN
1180       WRITE ( io, 475 )  pt_surface_initial_change
1181    ENDIF
1182    IF ( humidity  .AND.  q_surface_initial_change /= 0.0 )  THEN
1183       WRITE ( io, 476 )  q_surface_initial_change       
1184    ENDIF
1185    IF ( passive_scalar  .AND.  q_surface_initial_change /= 0.0 )  THEN
1186       WRITE ( io, 477 )  q_surface_initial_change       
1187    ENDIF
1188
1189    IF ( particle_advection )  THEN
1190!
1191!--    Particle attributes
1192       WRITE ( io, 480 )  particle_advection_start, dt_prel, bc_par_lr, &
1193                          bc_par_ns, bc_par_b, bc_par_t, particle_maximum_age, &
1194                          end_time_prel, dt_sort_particles
1195       IF ( use_sgs_for_particles )  WRITE ( io, 488 )  dt_min_part
1196       IF ( random_start_position )  WRITE ( io, 481 )
1197       IF ( particles_per_point > 1 )  WRITE ( io, 489 )  particles_per_point
1198       WRITE ( io, 495 )  total_number_of_particles
1199       IF ( .NOT. vertical_particle_advection )  WRITE ( io, 482 )
1200       IF ( maximum_number_of_tailpoints /= 0 )  THEN
1201          WRITE ( io, 483 )  maximum_number_of_tailpoints
1202          IF ( minimum_tailpoint_distance /= 0 )  THEN
1203             WRITE ( io, 484 )  total_number_of_tails,      &
1204                                minimum_tailpoint_distance, &
1205                                maximum_tailpoint_age
1206          ENDIF
1207       ENDIF
1208       IF ( dt_write_particle_data /= 9999999.9 )  THEN
1209          WRITE ( io, 485 )  dt_write_particle_data
1210          output_format = ''
1211          IF ( netcdf_output )  THEN
1212             IF ( netcdf_64bit )  THEN
1213                output_format = 'netcdf (64 bit offset) and binary'
1214             ELSE
1215                output_format = 'netcdf and binary'
1216             ENDIF
1217          ELSE
1218             output_format = 'binary'
1219          ENDIF
1220          WRITE ( io, 345 )  output_format
1221       ENDIF
1222       IF ( dt_dopts /= 9999999.9 )  WRITE ( io, 494 )  dt_dopts
1223       IF ( write_particle_statistics )  WRITE ( io, 486 )
1224
1225       WRITE ( io, 487 )  number_of_particle_groups
1226
1227       DO  i = 1, number_of_particle_groups
1228          IF ( i == 1  .AND.  density_ratio(i) == 9999999.9 )  THEN
1229             WRITE ( io, 490 )  i, 0.0
1230             WRITE ( io, 492 )
1231          ELSE
1232             WRITE ( io, 490 )  i, radius(i)
1233             IF ( density_ratio(i) /= 0.0 )  THEN
1234                WRITE ( io, 491 )  density_ratio(i)
1235             ELSE
1236                WRITE ( io, 492 )
1237             ENDIF
1238          ENDIF
1239          WRITE ( io, 493 )  psl(i), psr(i), pss(i), psn(i), psb(i), pst(i), &
1240                             pdx(i), pdy(i), pdz(i)
1241       ENDDO
1242
1243    ENDIF
1244
1245
1246!
1247!-- Parameters of 1D-model
1248    IF ( INDEX( initializing_actions, 'set_1d-model_profiles' ) /= 0 )  THEN
1249       WRITE ( io, 500 )  end_time_1d, dt_run_control_1d, dt_pr_1d, &
1250                          mixing_length_1d, dissipation_1d
1251       IF ( damp_level_ind_1d /= nzt+1 )  THEN
1252          WRITE ( io, 502 )  zu(damp_level_ind_1d), damp_level_ind_1d
1253       ENDIF
1254    ENDIF
1255
1256!
1257!-- User-defined informations
1258    CALL user_header( io )
1259
1260    WRITE ( io, 99 )
1261
1262!
1263!-- Write buffer contents to disc immediately
1264    CALL local_flush( io )
1265
1266!
1267!-- Here the FORMATs start
1268
1269 99 FORMAT (1X,78('-'))
1270100 FORMAT (/1X,'*************************',11X,42('-')/        &
1271            1X,'* ',A,' *',11X,A/                               &
1272            1X,'*************************',11X,42('-'))
1273101 FORMAT (37X,'coupled run: ',A/ &
1274            37X,42('-'))
1275102 FORMAT (/' Date:            ',A8,11X,'Run:       ',A20/      &
1276            ' Time:            ',A8,11X,'Run-No.:   ',I2.2/     &
1277            ' Run on host:   ',A10)
1278#if defined( __parallel )
1279103 FORMAT (' Number of PEs:',7X,I4,11X,'Processor grid (x,y): (',I3,',',I3, &
1280              ')',1X,A)
1281104 FORMAT (' Number of PEs:',7X,I4,11X,'Tasks:',I4,'   threads per task:',I4/ &
1282              37X,'Processor grid (x,y): (',I3,',',I3,')',1X,A)
1283105 FORMAT (37X,'One additional PE is used to handle'/37X,'the dvrp output!')
1284106 FORMAT (37X,'A 1d-decomposition along x is forced'/ &
1285            37X,'because the job is running on an SMP-cluster')
1286107 FORMAT (37X,'A 1d-decomposition along ',A,' is used')
1287#endif
1288110 FORMAT (/' Numerical Schemes:'/ &
1289             ' -----------------'/)
1290111 FORMAT (' --> Solve perturbation pressure via FFT using ',A,' routines')
1291112 FORMAT (' --> Solve perturbation pressure via SOR-Red/Black-Schema'/ &
1292            '     Iterations (initial/other): ',I3,'/',I3,'  omega = ',F5.3)
1293113 FORMAT (' --> Momentum advection via Piascek-Williams-Scheme (Form C3)', &
1294                  ' or Upstream')
1295114 FORMAT (' --> Momentum advection via Upstream-Spline-Scheme')
1296115 FORMAT ('     Tendencies are smoothed via Long-Filter with factor ',F5.3) 
1297116 FORMAT (' --> Scalar advection via Piascek-Williams-Scheme (Form C3)', &
1298                  ' or Upstream')
1299117 FORMAT (' --> Scalar advection via Upstream-Spline-Scheme')
1300118 FORMAT (' --> Scalar advection via Bott-Chlond-Scheme')
1301119 FORMAT (' --> Galilei-Transform applied to horizontal advection', &
1302            '     Translation velocity = ',A/ &
1303            '     distance advected ',A,':  ',F8.3,' km(x)  ',F8.3,' km(y)')
1304120 FORMAT (' --> Time differencing scheme: leapfrog only (no euler in case', &
1305                  ' of timestep changes)')
1306121 FORMAT (' --> Time differencing scheme: leapfrog + euler in case of', &
1307                  ' timestep changes')
1308122 FORMAT (' --> Time differencing scheme: ',A)
1309123 FORMAT (' --> Rayleigh-Damping active, starts ',A,' z = ',F8.2,' m'/ &
1310            '     maximum damping coefficient: ',F5.3, ' 1/s')
1311124 FORMAT ('     Spline-overshoots are being suppressed')
1312125 FORMAT ('     Upstream-Scheme is used if Upstream-differences fall short', &
1313                  ' of'/                                                       &
1314            '     delta_u = ',F6.4,4X,'delta_v = ',F6.4,4X,'delta_w = ',F6.4)
1315126 FORMAT ('     Upstream-Scheme is used if Upstream-differences fall short', &
1316                  ' of'/                                                       &
1317            '     delta_e = ',F6.4,4X,'delta_pt = ',F6.4)
1318127 FORMAT ('     The following absolute overshoot differences are tolerated:'/&
1319            '     delta_u = ',F6.4,4X,'delta_v = ',F6.4,4X,'delta_w = ',F6.4)
1320128 FORMAT ('     The following absolute overshoot differences are tolerated:'/&
1321            '     delta_e = ',F6.4,4X,'delta_pt = ',F6.4)
1322129 FORMAT (' --> Additional prognostic equation for the specific humidity')
1323130 FORMAT (' --> Additional prognostic equation for the total water content')
1324131 FORMAT (' --> Parameterization of condensation processes via (0%-or100%)')
1325132 FORMAT (' --> Parameterization of long-wave radiation processes via'/ &
1326            '     effective emissivity scheme')
1327133 FORMAT (' --> Precipitation parameterization via Kessler-Scheme')
1328134 FORMAT (' --> Additional prognostic equation for a passive scalar')
1329135 FORMAT (' --> Solve perturbation pressure via multigrid method (', &
1330                  A,'-cycle)'/ &
1331            '     number of grid levels:                   ',I2/ &
1332            '     Gauss-Seidel red/black iterations:       ',I2)
1333136 FORMAT ('     gridpoints of coarsest subdomain (x,y,z): (',I3,',',I3,',', &
1334                  I3,')')
1335137 FORMAT ('     level data gathered on PE0 at level:     ',I2/ &
1336            '     gridpoints of coarsest subdomain (x,y,z): (',I3,',',I3,',', &
1337                  I3,')'/ &
1338            '     gridpoints of coarsest domain (x,y,z):    (',I3,',',I3,',', &
1339                  I3,')')
1340138 FORMAT ('     Using hybrid version for 1d-domain-decomposition')
1341139 FORMAT (' --> Loop optimization method: ',A)
1342140 FORMAT ('     maximum residual allowed:                ',E10.3)
1343141 FORMAT ('     fixed number of multigrid cycles:        ',I4)
1344142 FORMAT ('     perturbation pressure is calculated at every Runge-Kutta ', &
1345                  'step')
1346143 FORMAT ('     Euler/upstream scheme is used for the SGS turbulent ', &
1347                  'kinetic energy')
1348150 FORMAT (' --> Volume flow at the right and north boundary will be ', &
1349                  'conserved')
1350200 FORMAT (//' Run time and time step information:'/ &
1351             ' ----------------------------------'/)
1352201 FORMAT ( ' Timestep:          variable     maximum value: ',F6.3,' s', &
1353             '    CFL-factor: ',F4.2)
1354202 FORMAT ( ' Timestep:       dt = ',F6.3,' s'/)
1355203 FORMAT ( ' Start time:       ',F9.3,' s'/ &
1356             ' End time:         ',F9.3,' s')
1357204 FORMAT ( A,F9.3,' s')
1358205 FORMAT ( A,F9.3,' s',5X,'restart every',17X,F9.3,' s')
1359206 FORMAT (/' Time reached:     ',F9.3,' s'/ &
1360             ' CPU-time used:    ',F9.3,' s     per timestep:               ', &
1361               '  ',F9.3,' s'/                                                 &
1362             '                                   per second of simulated tim', &
1363               'e: ',F9.3,' s')
1364250 FORMAT (//' Computational grid and domain size:'/ &
1365              ' ----------------------------------'// &
1366              ' Grid length:      dx =    ',F7.3,' m    dy =    ',F7.3, &
1367              ' m    dz =    ',F7.3,' m'/ &
1368              ' Domain size:       x = ',F10.3,' m     y = ',F10.3, &
1369              ' m  z(u) = ',F10.3,' m'/)
1370252 FORMAT (' dz constant up to ',F10.3,' m (k=',I4,'), then stretched by', &
1371              ' factor: ',F5.3/ &
1372            ' maximum dz not to be exceeded is dz_max = ',F10.3,' m'/)
1373254 FORMAT (' Number of gridpoints (x,y,z):  (0:',I4,', 0:',I4,', 0:',I4,')'/ &
1374            ' Subdomain size (x,y,z):        (  ',I4,',   ',I4,',   ',I4,')'/)
1375255 FORMAT (' Subdomains have equal size')
1376256 FORMAT (' Subdomains at the upper edges of the virtual processor grid ', &
1377              'have smaller sizes'/                                          &
1378            ' Size of smallest subdomain:    (  ',I4,',   ',I4,',   ',I4,')')
1379260 FORMAT (/' The model has a slope in x-direction. Inclination angle: ',F6.2,&
1380             ' degrees')
1381270 FORMAT (//' Topography informations:'/ &
1382              ' -----------------------'// &
1383              1X,'Topography: ',A)
1384271 FORMAT (  ' Building size (x/y/z) in m: ',F5.1,' / ',F5.1,' / ',F5.1/ &
1385              ' Horizontal index bounds (l/r/s/n): ',I4,' / ',I4,' / ',I4, &
1386                ' / ',I4)
1387280 FORMAT (//' Vegetation canopy (drag) model:'/ &
1388              ' ------------------------------'// &
1389              ' Canopy mode: ', A / &
1390              ' Canopy top: ',I4 / &
1391              ' Leaf drag coefficient: ',F6.2 /)
1392281 FORMAT (/ ' Scalar_exchange_coefficient: ',F6.2 / &
1393              ' Scalar concentration at leaf surfaces in kg/m**3: ',F6.2 /)
1394282 FORMAT (' Predefined constant heatflux at the top of the vegetation: ',F6.2,' K m/s')
1395283 FORMAT (/ ' Characteristic levels of the leaf area density:'// &
1396              ' Height:              ',A,'  m'/ &
1397              ' Leaf area density:   ',A,'  m**2/m**3'/ &
1398              ' Gradient:            ',A,'  m**2/m**4'/ &
1399              ' Gridpoint:           ',A)
1400               
1401300 FORMAT (//' Boundary conditions:'/ &
1402             ' -------------------'// &
1403             '                     p                    uv             ', &
1404             '                   pt'// &
1405             ' B. bound.: ',A/ &
1406             ' T. bound.: ',A)
1407301 FORMAT (/'                     ',A// &
1408             ' B. bound.: ',A/ &
1409             ' T. bound.: ',A)
1410303 FORMAT (/' Bottom surface fluxes are used in diffusion terms at k=1')
1411304 FORMAT (/' Top surface fluxes are used in diffusion terms at k=nzt')
1412305 FORMAT (//'    Prandtl-Layer between bottom surface and first ', &
1413               'computational u,v-level:'// &
1414             '       zp = ',F6.2,' m   z0 = ',F6.4,' m   kappa = ',F4.2/ &
1415             '       Rif value range:   ',F6.2,' <= rif <=',F6.2)
1416306 FORMAT ('       Predefined constant heatflux:   ',F9.6,' K m/s')
1417307 FORMAT ('       Heatflux has a random normal distribution')
1418308 FORMAT ('       Predefined surface temperature')
1419309 FORMAT ('       Predefined constant salinityflux:   ',F9.6,' psu m/s')
1420310 FORMAT (//'    1D-Model:'// &
1421             '       Rif value range:   ',F6.2,' <= rif <=',F6.2)
1422311 FORMAT ('       Predefined constant humidity flux: ',E10.3,' m/s')
1423312 FORMAT ('       Predefined surface humidity')
1424313 FORMAT ('       Predefined constant scalar flux: ',E10.3,' kg/(m**2 s)')
1425314 FORMAT ('       Predefined scalar value at the surface')
1426315 FORMAT ('       Humidity / scalar flux at top surface is 0.0')
1427316 FORMAT ('       Sensible heatflux and momentum flux from coupled ', &
1428                    'atmosphere model')
1429317 FORMAT (//' Lateral boundaries:'/ &
1430            '       left/right:  ',A/    &
1431            '       north/south: ',A)
1432318 FORMAT (/'       outflow damping layer width: ',I3,' gridpoints with km_', &
1433                    'max =',F5.1,' m**2/s')
1434319 FORMAT ('       turbulence recycling at inflow switched on'/ &
1435            '       width of recycling domain: ',F7.1,' m   grid index: ',I4/ &
1436            '       inflow damping height: ',F6.1,' m   width: ',F6.1,' m')
1437320 FORMAT ('       Predefined constant momentumflux:  u: ',F9.6,' m**2/s**2'/ &
1438            '                                          v: ',F9.6,' m**2/s**2')
1439325 FORMAT (//' List output:'/ &
1440             ' -----------'//  &
1441            '    1D-Profiles:'/    &
1442            '       Output every             ',F8.2,' s')
1443326 FORMAT ('       Time averaged over       ',F8.2,' s'/ &
1444            '       Averaging input every    ',F8.2,' s')
1445330 FORMAT (//' Data output:'/ &
1446             ' -----------'/)
1447331 FORMAT (/'    1D-Profiles:')
1448332 FORMAT (/'       ',A)
1449333 FORMAT ('       Output every             ',F8.2,' s',/ &
1450            '       Time averaged over       ',F8.2,' s'/ &
1451            '       Averaging input every    ',F8.2,' s')
1452334 FORMAT (/'    2D-Arrays',A,':')
1453335 FORMAT (/'       ',A2,'-cross-section  Arrays: ',A/ &
1454            '       Output every             ',F8.2,' s  ',A/ &
1455            '       Cross sections at ',A1,' = ',A/ &
1456            '       scalar-coordinates:   ',A,' m'/)
1457336 FORMAT (/'    3D-Arrays',A,':')
1458337 FORMAT (/'       Arrays: ',A/ &
1459            '       Output every             ',F8.2,' s  ',A/ &
1460            '       Upper output limit at    ',F8.2,' m  (GP ',I4,')'/)
1461338 FORMAT ('       Compressed data output'/ &
1462            '       Decimal precision: ',A/)
1463339 FORMAT ('       No output during initial ',F8.2,' s')
1464340 FORMAT (/'    Time series:')
1465341 FORMAT ('       Output every             ',F8.2,' s'/)
1466342 FORMAT (/'       ',A2,'-cross-section  Arrays: ',A/ &
1467            '       Output every             ',F8.2,' s  ',A/ &
1468            '       Time averaged over       ',F8.2,' s'/ &
1469            '       Averaging input every    ',F8.2,' s'/ &
1470            '       Cross sections at ',A1,' = ',A/ &
1471            '       scalar-coordinates:   ',A,' m'/)
1472343 FORMAT (/'       Arrays: ',A/ &
1473            '       Output every             ',F8.2,' s  ',A/ &
1474            '       Time averaged over       ',F8.2,' s'/ &
1475            '       Averaging input every    ',F8.2,' s'/ &
1476            '       Upper output limit at    ',F8.2,' m  (GP ',I4,')'/)
1477345 FORMAT ('       Output format: ',A/)
1478#if defined( __dvrp_graphics )
1479360 FORMAT ('    Plot-Sequence with dvrp-software:'/ &
1480            '       Output every      ',F7.1,' s'/ &
1481            '       Output mode:      ',A/ &
1482            '       Host / User:      ',A,' / ',A/ &
1483            '       Directory:        ',A// &
1484            '       The sequence contains:')
1485361 FORMAT ('       Isosurface of ',A,'  Threshold value: ', E12.3)
1486362 FORMAT ('       Sectional plane ',A)
1487363 FORMAT ('       Particles')
1488#endif
1489#if defined( __spectra )
1490370 FORMAT ('    Spectra:')
1491371 FORMAT ('       Output every ',F7.1,' s'/)
1492372 FORMAT ('       Arrays:     ', 10(A5,',')/                         &
1493            '       Directions: ', 10(A5,',')/                         &
1494            '       height levels  k = ', 9(I3,','),I3,'.'/            &
1495            '       height levels selected for standard plot:'/        &
1496            '                      k = ', 9(I3,','),I3,'.'/            &
1497            '       Time averaged over ', F7.1, ' s,' /                &
1498            '       Profiles for the time averaging are taken every ', &
1499                    F6.1,' s')
1500#endif
1501400 FORMAT (//' Physical quantities:'/ &
1502              ' -------------------'/)
1503410 FORMAT ('    Angular velocity    :   omega = ',E9.3,' rad/s'/  &
1504            '    Geograph. latitude  :   phi   = ',F4.1,' degr'/   &
1505            '    Coriolis parameter  :   f     = ',F9.6,' 1/s'/    &
1506            '                            f*    = ',F9.6,' 1/s')
1507411 FORMAT (/'    Gravity             :   g     = ',F4.1,' m/s**2')
1508412 FORMAT (/'    Reference density in buoyancy terms: ',F8.3,' kg/m**3')
1509413 FORMAT (/'    Reference temperature in buoyancy terms: ',F8.4,' K')
1510415 FORMAT (/'    Cloud physics parameters:'/ &
1511             '    ------------------------'/)
1512416 FORMAT ('        Surface pressure   :   p_0   = ',F7.2,' hPa'/      &
1513            '        Gas constant       :   R     = ',F5.1,' J/(kg K)'/ &
1514            '        Density of air     :   rho_0 = ',F5.3,' kg/m**3'/  &
1515            '        Specific heat cap. :   c_p   = ',F6.1,' J/(kg K)'/ &
1516            '        Vapourization heat :   L_v   = ',E8.2,' J/kg')
1517420 FORMAT (/'    Characteristic levels of the initial temperature profile:'// &
1518            '       Height:        ',A,'  m'/ &
1519            '       Temperature:   ',A,'  K'/ &
1520            '       Gradient:      ',A,'  K/100m'/ &
1521            '       Gridpoint:     ',A)
1522421 FORMAT (/'    Characteristic levels of the initial humidity profile:'// &
1523            '       Height:      ',A,'  m'/ &
1524            '       Humidity:    ',A,'  kg/kg'/ &
1525            '       Gradient:    ',A,'  (kg/kg)/100m'/ &
1526            '       Gridpoint:   ',A)
1527422 FORMAT (/'    Characteristic levels of the initial scalar profile:'// &
1528            '       Height:                  ',A,'  m'/ &
1529            '       Scalar concentration:    ',A,'  kg/m**3'/ &
1530            '       Gradient:                ',A,'  (kg/m**3)/100m'/ &
1531            '       Gridpoint:               ',A)
1532423 FORMAT (/'    Characteristic levels of the geo. wind component ug:'// &
1533            '       Height:      ',A,'  m'/ &
1534            '       ug:          ',A,'  m/s'/ &
1535            '       Gradient:    ',A,'  1/100s'/ &
1536            '       Gridpoint:   ',A)
1537424 FORMAT (/'    Characteristic levels of the geo. wind component vg:'// &
1538            '       Height:      ',A,'  m'/ &
1539            '       vg:          ',A,'  m/s'/ &
1540            '       Gradient:    ',A,'  1/100s'/ &
1541            '       Gridpoint:   ',A)
1542425 FORMAT (/'    Characteristic levels of the initial salinity profile:'// &
1543            '       Height:     ',A,'  m'/ &
1544            '       Salinity:   ',A,'  psu'/ &
1545            '       Gradient:   ',A,'  psu/100m'/ &
1546            '       Gridpoint:  ',A)
1547450 FORMAT (//' LES / Turbulence quantities:'/ &
1548              ' ---------------------------'/)
1549451 FORMAT ('   Diffusion coefficients are constant:'/ &
1550            '   Km = ',F6.2,' m**2/s   Kh = ',F6.2,' m**2/s   Pr = ',F5.2)
1551452 FORMAT ('   Mixing length is limited to the Prandtl mixing lenth.')
1552453 FORMAT ('   Mixing length is limited to ',F4.2,' * z')
1553454 FORMAT ('   TKE is not allowed to fall below ',E9.2,' (m/s)**2')
1554455 FORMAT ('   initial TKE is prescribed as ',E9.2,' (m/s)**2')
1555470 FORMAT (//' Actions during the simulation:'/ &
1556              ' -----------------------------'/)
1557471 FORMAT ('    Disturbance impulse (u,v) every :   ',F6.2,' s'/            &
1558            '    Disturbance amplitude           :     ',F4.2, ' m/s'/       &
1559            '    Lower disturbance level         : ',F8.2,' m (GP ',I4,')'/  &
1560            '    Upper disturbance level         : ',F8.2,' m (GP ',I4,')')
1561472 FORMAT ('    Disturbances continued during the run from i/j =',I4, &
1562                 ' to i/j =',I4)
1563473 FORMAT ('    Disturbances cease as soon as the disturbance energy exceeds',&
1564                 1X,F5.3, ' m**2/s**2')
1565474 FORMAT ('    Random number generator used    : ',A/)
1566475 FORMAT ('    The surface temperature is increased (or decreased, ', &
1567                 'respectively, if'/ &
1568            '    the value is negative) by ',F5.2,' K at the beginning of the',&
1569                 ' 3D-simulation'/)
1570476 FORMAT ('    The surface humidity is increased (or decreased, ',&
1571                 'respectively, if the'/ &
1572            '    value is negative) by ',E8.1,' kg/kg at the beginning of', &
1573                 ' the 3D-simulation'/)
1574477 FORMAT ('    The scalar value is increased at the surface (or decreased, ',&
1575                 'respectively, if the'/ &
1576            '    value is negative) by ',E8.1,' kg/m**3 at the beginning of', &
1577                 ' the 3D-simulation'/)
1578480 FORMAT ('    Particles:'/ &
1579            '    ---------'// &
1580            '       Particle advection is active (switched on at t = ', F7.1, &
1581                    ' s)'/ &
1582            '       Start of new particle generations every  ',F6.1,' s'/ &
1583            '       Boundary conditions: left/right: ', A, ' north/south: ', A/&
1584            '                            bottom:     ', A, ' top:         ', A/&
1585            '       Maximum particle age:                 ',F9.1,' s'/ &
1586            '       Advection stopped at t = ',F9.1,' s'/ &
1587            '       Particles are sorted every ',F9.1,' s'/)
1588481 FORMAT ('       Particles have random start positions'/)
1589482 FORMAT ('       Particles are advected only horizontally'/)
1590483 FORMAT ('       Particles have tails with a maximum of ',I3,' points')
1591484 FORMAT ('            Number of tails of the total domain: ',I10/ &
1592            '            Minimum distance between tailpoints: ',F8.2,' m'/ &
1593            '            Maximum age of the end of the tail:  ',F8.2,' s')
1594485 FORMAT ('       Particle data are written on file every ', F9.1, ' s')
1595486 FORMAT ('       Particle statistics are written on file'/)
1596487 FORMAT ('       Number of particle groups: ',I2/)
1597488 FORMAT ('       SGS velocity components are used for particle advection'/ &
1598            '          minimum timestep for advection: ', F7.5/)
1599489 FORMAT ('       Number of particles simultaneously released at each ', &
1600                    'point: ', I5/)
1601490 FORMAT ('       Particle group ',I2,':'/ &
1602            '          Particle radius: ',E10.3, 'm')
1603491 FORMAT ('          Particle inertia is activated'/ &
1604            '             density_ratio (rho_fluid/rho_particle) = ',F5.3/)
1605492 FORMAT ('          Particles are advected only passively (no inertia)'/)
1606493 FORMAT ('          Boundaries of particle source: x:',F8.1,' - ',F8.1,' m'/&
1607            '                                         y:',F8.1,' - ',F8.1,' m'/&
1608            '                                         z:',F8.1,' - ',F8.1,' m'/&
1609            '          Particle distances:  dx = ',F8.1,' m  dy = ',F8.1, &
1610                       ' m  dz = ',F8.1,' m'/)
1611494 FORMAT ('       Output of particle time series in NetCDF format every ', &
1612                    F8.2,' s'/)
1613495 FORMAT ('       Number of particles in total domain: ',I10/)
1614500 FORMAT (//' 1D-Model parameters:'/                           &
1615              ' -------------------'//                           &
1616            '    Simulation time:                   ',F8.1,' s'/ &
1617            '    Run-controll output every:         ',F8.1,' s'/ &
1618            '    Vertical profile output every:     ',F8.1,' s'/ &
1619            '    Mixing length calculation:         ',A/         &
1620            '    Dissipation calculation:           ',A/)
1621502 FORMAT ('    Damping layer starts from ',F7.1,' m (GP ',I4,')'/)
1622
1623
1624 END SUBROUTINE header
Note: See TracBrowser for help on using the repository browser.