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

Last change on this file since 239 was 237, checked in by raasch, 15 years ago

polygon reduction for topography and ground plate isosurface (dvr)

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