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

Last change on this file since 358 was 346, checked in by raasch, 15 years ago

small updates

  • Property svn:keywords set to Id
File size: 69.1 KB
Line 
1 SUBROUTINE header
2
3!------------------------------------------------------------------------------!
4! Current revisions:
5! -----------------
6! initializing_actions='read_data_for_recycling' renamed to 'cyclic_fill'
7! Coupling with independent precursor runs.
8! Output of messages replaced by message handling routine.
9! Output of several additional dvr parameters
10! +canyon_height, canyon_width_x, canyon_width_y, canyon_wall_left,
11! canyon_wall_south, conserve_volume_flow_mode, dp_external, dp_level_b,
12! dp_smooth, dpdxy, u_bulk, v_bulk
13! topography_grid_convention moved from user_header
14! small bugfix concerning 3d 64bit netcdf output format
15!
16! Former revisions:
17! -----------------
18! $Id: header.f90 346 2009-07-06 10:13:41Z heinze $
19!
20! 206 2008-10-13 14:59:11Z raasch
21! Bugfix: error in zu index in case of section_xy = -1
22!
23! 198 2008-09-17 08:55:28Z raasch
24! Format adjustments allowing output of larger revision numbers
25!
26! 197 2008-09-16 15:29:03Z raasch
27! allow 100 spectra levels instead of 10 for consistency with
28! define_netcdf_header,
29! bugfix in the output of the characteristic levels of potential temperature,
30! geostrophic wind, scalar concentration, humidity and leaf area density,
31! output of turbulence recycling informations
32!
33! 138 2007-11-28 10:03:58Z letzel
34! Allow new case bc_uv_t = 'dirichlet_0' for channel flow.
35! Allow two instead of one digit to specify isosurface and slicer variables.
36! Output of sorting frequency of particles
37!
38! 108 2007-08-24 15:10:38Z letzel
39! Output of informations for coupled model runs (boundary conditions etc.)
40! + output of momentumfluxes at the top boundary
41! Rayleigh damping for ocean, e_init
42!
43! 97 2007-06-21 08:23:15Z raasch
44! Adjustments for the ocean version.
45! use_pt_reference renamed use_reference
46!
47! 87 2007-05-22 15:46:47Z raasch
48! Bugfix: output of use_upstream_for_tke
49!
50! 82 2007-04-16 15:40:52Z raasch
51! Preprocessor strings for different linux clusters changed to "lc",
52! routine local_flush is used for buffer flushing
53!
54! 76 2007-03-29 00:58:32Z raasch
55! Output of netcdf_64bit_3d, particles-package is now part of the default code,
56! output of the loop optimization method, moisture renamed humidity,
57! output of subversion revision number
58!
59! 19 2007-02-23 04:53:48Z raasch
60! Output of scalar flux applied at top boundary
61!
62! RCS Log replace by Id keyword, revision history cleaned up
63!
64! Revision 1.63  2006/08/22 13:53:13  raasch
65! Output of dz_max
66!
67! Revision 1.1  1997/08/11 06:17:20  raasch
68! Initial revision
69!
70!
71! Description:
72! ------------
73! Writing a header with all important informations about the actual run.
74! This subroutine is called three times, two times at the beginning
75! (writing information on files RUN_CONTROL and HEADER) and one time at the
76! end of the run, then writing additional information about CPU-usage on file
77! header.
78!------------------------------------------------------------------------------!
79
80    USE arrays_3d
81    USE control_parameters
82    USE cloud_parameters
83    USE cpulog
84    USE dvrp_variables
85    USE grid_variables
86    USE indices
87    USE model_1d
88    USE particle_attributes
89    USE pegrid
90    USE spectrum
91
92    IMPLICIT NONE
93
94    CHARACTER (LEN=1)  ::  prec
95    CHARACTER (LEN=2)  ::  do2d_mode
96    CHARACTER (LEN=5)  ::  section_chr
97    CHARACTER (LEN=9)  ::  time_to_string
98    CHARACTER (LEN=10) ::  coor_chr, host_chr
99    CHARACTER (LEN=16) ::  begin_chr
100    CHARACTER (LEN=23) ::  ver_rev
101    CHARACTER (LEN=40) ::  output_format
102    CHARACTER (LEN=70) ::  char1, char2, dopr_chr, &
103                           do2d_xy, do2d_xz, do2d_yz, do3d_chr, &
104                           run_classification
105    CHARACTER (LEN=86) ::  coordinates, gradients, learde, slices,  &
106                           temperatures, ugcomponent, vgcomponent
107    CHARACTER (LEN=85) ::  roben, runten
108
109    INTEGER ::  av, bh, blx, bly, bxl, bxr, byn, bys, ch, cwx, cwy, cxl, cxr, &
110                cyn, cys, i, ihost, io, j, l, ll, m, mpi_type
111    REAL    ::  cpuseconds_per_simulated_second
112
113!
114!-- Open the output file. At the end of the simulation, output is directed
115!-- to unit 19.
116    IF ( ( runnr == 0 .OR. force_print_header )  .AND. &
117         .NOT. simulated_time_at_begin /= simulated_time )  THEN
118       io = 15   !  header output on file RUN_CONTROL
119    ELSE
120       io = 19   !  header output on file HEADER
121    ENDIF
122    CALL check_open( io )
123
124!
125!-- At the end of the run, output file (HEADER) will be rewritten with
126!-- new informations
127    IF ( io == 19 .AND. simulated_time_at_begin /= simulated_time ) REWIND( 19 )
128
129!
130!-- Determine kind of model run
131    IF ( TRIM( initializing_actions ) == 'read_restart_data' )  THEN
132       run_classification = '3D - restart run'
133    ELSEIF ( TRIM( initializing_actions ) == 'cyclic_fill' )  THEN
134       run_classification = '3D - run with cyclic fill of 3D - prerun data'
135    ELSEIF ( INDEX( initializing_actions, 'set_constant_profiles' ) /= 0 )  THEN
136       run_classification = '3D - run without 1D - prerun'
137    ELSEIF ( INDEX( initializing_actions, 'set_1d-model_profiles' ) /= 0 )  THEN
138       run_classification = '3D - run with 1D - prerun'
139    ELSEIF ( INDEX( initializing_actions, 'by_user' ) /=0 )  THEN
140       run_classification = '3D - run initialized by user'
141    ELSE
142       message_string = ' unknown action(s): ' // TRIM( initializing_actions )
143       CALL message( 'header', 'PA0191', 0, 0, 0, 6, 0 )
144    ENDIF
145    IF ( ocean )  THEN
146       run_classification = 'ocean - ' // run_classification
147    ELSE
148       run_classification = 'atmosphere - ' // run_classification
149    ENDIF
150
151!
152!-- Run-identification, date, time, host
153    host_chr = host(1:10)
154    ver_rev = TRIM( version ) // '  ' // TRIM( revision )
155    WRITE ( io, 100 )  ver_rev, TRIM( run_classification )
156    IF ( TRIM( coupling_mode ) /= 'uncoupled' )  THEN
157#if defined( __mpi2 )
158       mpi_type = 2
159#else
160       mpi_type = 1
161#endif
162       WRITE ( io, 101 )  mpi_type, coupling_mode
163    ENDIF
164    WRITE ( io, 102 )  run_date, run_identifier, run_time, runnr, &
165                       ADJUSTR( host_chr )
166#if defined( __parallel )
167    IF ( npex == -1  .AND.  pdims(2) /= 1 )  THEN
168       char1 = 'calculated'
169    ELSEIF ( ( host(1:3) == 'ibm'  .OR.  host(1:3) == 'nec'  .OR.  &
170               host(1:2) == 'lc' )  .AND.                          &
171             npex == -1  .AND.  pdims(2) == 1 )  THEN
172       char1 = 'forced'
173    ELSE
174       char1 = 'predefined'
175    ENDIF
176    IF ( threads_per_task == 1 )  THEN
177       WRITE ( io, 103 )  numprocs, pdims(1), pdims(2), TRIM( char1 )
178    ELSE
179       WRITE ( io, 104 )  numprocs*threads_per_task, numprocs, &
180                          threads_per_task, pdims(1), pdims(2), TRIM( char1 )
181    ENDIF
182    IF ( ( host(1:3) == 'ibm'  .OR.  host(1:3) == 'nec'  .OR.    &
183           host(1:2) == 'lc'   .OR.  host(1:3) == 'dec' )  .AND. &
184         npex == -1  .AND.  pdims(2) == 1 )                      &
185    THEN
186       WRITE ( io, 106 )
187    ELSEIF ( pdims(2) == 1 )  THEN
188       WRITE ( io, 107 )  'x'
189    ELSEIF ( pdims(1) == 1 )  THEN
190       WRITE ( io, 107 )  'y'
191    ENDIF
192    IF ( use_seperate_pe_for_dvrp_output )  WRITE ( io, 105 )
193#endif
194    WRITE ( io, 99 )
195
196!
197!-- Numerical schemes
198    WRITE ( io, 110 )
199    IF ( psolver(1:7) == 'poisfft' )  THEN
200       WRITE ( io, 111 )  TRIM( fft_method )
201       IF ( psolver == 'poisfft_hybrid' )  WRITE ( io, 138 )
202    ELSEIF ( psolver == 'sor' )  THEN
203       WRITE ( io, 112 )  nsor_ini, nsor, omega_sor
204    ELSEIF ( psolver == 'multigrid' )  THEN
205       WRITE ( io, 135 )  cycle_mg, maximum_grid_level, ngsrb
206       IF ( mg_cycles == -1 )  THEN
207          WRITE ( io, 140 )  residual_limit
208       ELSE
209          WRITE ( io, 141 )  mg_cycles
210       ENDIF
211       IF ( mg_switch_to_pe0_level == 0 )  THEN
212          WRITE ( io, 136 )  nxr_mg(1)-nxl_mg(1)+1, nyn_mg(1)-nys_mg(1)+1, &
213                             nzt_mg(1)
214       ELSEIF (  mg_switch_to_pe0_level /= -1 )  THEN
215          WRITE ( io, 137 )  mg_switch_to_pe0_level,            &
216                             mg_loc_ind(2,0)-mg_loc_ind(1,0)+1, &
217                             mg_loc_ind(4,0)-mg_loc_ind(3,0)+1, &
218                             nzt_mg(mg_switch_to_pe0_level),    &
219                             nxr_mg(1)-nxl_mg(1)+1, nyn_mg(1)-nys_mg(1)+1, &
220                             nzt_mg(1)
221       ENDIF
222    ENDIF
223    IF ( call_psolver_at_all_substeps  .AND. timestep_scheme(1:5) == 'runge' ) &
224    THEN
225       WRITE ( io, 142 )
226    ENDIF
227
228    IF ( momentum_advec == 'pw-scheme' )  THEN
229       WRITE ( io, 113 )
230    ELSE
231       WRITE ( io, 114 )
232       IF ( cut_spline_overshoot )  WRITE ( io, 124 )
233       IF ( overshoot_limit_u /= 0.0  .OR.  overshoot_limit_v /= 0.0  .OR. &
234            overshoot_limit_w /= 0.0 )  THEN
235          WRITE ( io, 127 )  overshoot_limit_u, overshoot_limit_v, &
236                             overshoot_limit_w
237       ENDIF
238       IF ( ups_limit_u /= 0.0  .OR.  ups_limit_v /= 0.0  .OR. &
239            ups_limit_w /= 0.0 )                               &
240       THEN
241          WRITE ( io, 125 )  ups_limit_u, ups_limit_v, ups_limit_w
242       ENDIF
243       IF ( long_filter_factor /= 0.0 )  WRITE ( io, 115 )  long_filter_factor
244    ENDIF
245    IF ( scalar_advec == 'pw-scheme' )  THEN
246       WRITE ( io, 116 )
247    ELSEIF ( scalar_advec == 'ups-scheme' )  THEN
248       WRITE ( io, 117 )
249       IF ( cut_spline_overshoot )  WRITE ( io, 124 )
250       IF ( overshoot_limit_e /= 0.0  .OR.  overshoot_limit_pt /= 0.0 )  THEN
251          WRITE ( io, 128 )  overshoot_limit_e, overshoot_limit_pt
252       ENDIF
253       IF ( ups_limit_e /= 0.0  .OR.  ups_limit_pt /= 0.0 )  THEN
254          WRITE ( io, 126 )  ups_limit_e, ups_limit_pt
255       ENDIF
256    ELSE
257       WRITE ( io, 118 )
258    ENDIF
259
260    WRITE ( io, 139 )  TRIM( loop_optimization )
261
262    IF ( galilei_transformation )  THEN
263       IF ( use_ug_for_galilei_tr )  THEN
264          char1 = 'geostrophic wind'
265       ELSE
266          char1 = 'mean wind in model domain'
267       ENDIF
268       IF ( simulated_time_at_begin == simulated_time )  THEN
269          char2 = 'at the start of the run'
270       ELSE
271          char2 = 'at the end of the run'
272       ENDIF
273       WRITE ( io, 119 )  TRIM( char1 ), TRIM( char2 ), &
274                          advected_distance_x/1000.0, advected_distance_y/1000.0
275    ENDIF
276    IF ( timestep_scheme == 'leapfrog' )  THEN
277       WRITE ( io, 120 )
278    ELSEIF ( timestep_scheme == 'leapfrog+euler' )  THEN
279       WRITE ( io, 121 )
280    ELSE
281       WRITE ( io, 122 )  timestep_scheme
282    ENDIF
283    IF ( use_upstream_for_tke )  WRITE ( io, 143 )
284    IF ( rayleigh_damping_factor /= 0.0 )  THEN
285       IF ( .NOT. ocean )  THEN
286          WRITE ( io, 123 )  'above', rayleigh_damping_height, &
287               rayleigh_damping_factor
288       ELSE
289          WRITE ( io, 123 )  'below', rayleigh_damping_height, &
290               rayleigh_damping_factor
291       ENDIF
292    ENDIF
293    IF ( humidity )  THEN
294       IF ( .NOT. cloud_physics )  THEN
295          WRITE ( io, 129 )
296       ELSE
297          WRITE ( io, 130 )
298          WRITE ( io, 131 )
299          IF ( radiation )      WRITE ( io, 132 )
300          IF ( precipitation )  WRITE ( io, 133 )
301       ENDIF
302    ENDIF
303    IF ( passive_scalar )  WRITE ( io, 134 )
304    IF ( conserve_volume_flow )  THEN
305       WRITE ( io, 150 )  conserve_volume_flow_mode
306       IF ( TRIM( conserve_volume_flow_mode ) == 'bulk_velocity' )  THEN
307          WRITE ( io, 151 )  u_bulk, v_bulk
308       ENDIF
309    ELSEIF ( dp_external )  THEN
310       IF ( dp_smooth )  THEN
311          WRITE ( io, 152 )  dpdxy, dp_level_b, ', vertically smoothed.'
312       ELSE
313          WRITE ( io, 152 )  dpdxy, dp_level_b, '.'
314       ENDIF
315    ENDIF
316    WRITE ( io, 99 )
317
318!
319!-- Runtime and timestep informations
320    WRITE ( io, 200 )
321    IF ( .NOT. dt_fixed )  THEN
322       WRITE ( io, 201 )  dt_max, cfl_factor
323    ELSE
324       WRITE ( io, 202 )  dt
325    ENDIF
326    WRITE ( io, 203 )  simulated_time_at_begin, end_time
327
328    IF ( time_restart /= 9999999.9  .AND. &
329         simulated_time_at_begin == simulated_time )  THEN
330       IF ( dt_restart == 9999999.9 )  THEN
331          WRITE ( io, 204 )  ' Restart at:       ',time_restart
332       ELSE
333          WRITE ( io, 205 )  ' Restart at:       ',time_restart, dt_restart
334       ENDIF
335    ENDIF
336
337    IF ( simulated_time_at_begin /= simulated_time )  THEN
338       i = MAX ( log_point_s(10)%counts, 1 )
339       IF ( ( simulated_time - simulated_time_at_begin ) == 0.0 )  THEN
340          cpuseconds_per_simulated_second = 0.0
341       ELSE
342          cpuseconds_per_simulated_second = log_point_s(10)%sum / &
343                                            ( simulated_time -    &
344                                              simulated_time_at_begin )
345       ENDIF
346       WRITE ( io, 206 )  simulated_time, log_point_s(10)%sum, &
347                          log_point_s(10)%sum / REAL( i ),     &
348                          cpuseconds_per_simulated_second
349       IF ( time_restart /= 9999999.9  .AND.  time_restart < end_time )  THEN
350          IF ( dt_restart == 9999999.9 )  THEN
351             WRITE ( io, 204 )  ' Next restart at:  ',time_restart
352          ELSE
353             WRITE ( io, 205 )  ' Next restart at:  ',time_restart, dt_restart
354          ENDIF
355       ENDIF
356    ENDIF
357
358!
359!-- Start time for coupled runs, if independent precursor runs for atmosphere
360!-- and ocean are used. In this case, coupling_start_time defines the time
361!-- when the coupling is switched on.
362    IF ( coupling_start_time /= 0.0 )  THEN
363       IF ( coupling_start_time >= simulated_time_at_begin )  THEN
364          char1 = 'Precursor run for a coupled atmosphere-ocean run'
365       ELSE
366          char1 = 'Coupled atmosphere-ocean run following independent ' // &
367                  'precursor runs'
368       ENDIF
369       WRITE ( io, 207 )  char1, coupling_start_time
370    ENDIF
371
372!
373!-- Computational grid
374    IF ( .NOT. ocean )  THEN
375       WRITE ( io, 250 )  dx, dy, dz, (nx+1)*dx, (ny+1)*dy, zu(nzt+1)
376       IF ( dz_stretch_level_index < nzt+1 )  THEN
377          WRITE ( io, 252 )  dz_stretch_level, dz_stretch_level_index, &
378                             dz_stretch_factor, dz_max
379       ENDIF
380    ELSE
381       WRITE ( io, 250 )  dx, dy, dz, (nx+1)*dx, (ny+1)*dy, zu(0)
382       IF ( dz_stretch_level_index > 0 )  THEN
383          WRITE ( io, 252 )  dz_stretch_level, dz_stretch_level_index, &
384                             dz_stretch_factor, dz_max
385       ENDIF
386    ENDIF
387    WRITE ( io, 254 )  nx, ny, nzt+1, MIN( nnx, nx+1 ), MIN( nny, ny+1 ), &
388                       MIN( nnz+2, nzt+2 )
389    IF ( numprocs > 1 )  THEN
390       IF ( nxa == nx  .AND.  nya == ny  .AND.  nza == nz )  THEN
391          WRITE ( io, 255 )
392       ELSE
393          WRITE ( io, 256 )  nnx-(nxa-nx), nny-(nya-ny), nzt+2
394       ENDIF
395    ENDIF
396    IF ( sloping_surface )  WRITE ( io, 260 )  alpha_surface
397
398!
399!-- Topography
400    WRITE ( io, 270 )  topography
401    SELECT CASE ( TRIM( topography ) )
402
403       CASE ( 'flat' )
404          ! no actions necessary
405
406       CASE ( 'single_building' )
407          blx = INT( building_length_x / dx )
408          bly = INT( building_length_y / dy )
409          bh  = INT( building_height / dz )
410
411          IF ( building_wall_left == 9999999.9 )  THEN
412             building_wall_left = ( nx + 1 - blx ) / 2 * dx
413          ENDIF
414          bxl = INT ( building_wall_left / dx + 0.5 )
415          bxr = bxl + blx
416
417          IF ( building_wall_south == 9999999.9 )  THEN
418             building_wall_south = ( ny + 1 - bly ) / 2 * dy
419          ENDIF
420          bys = INT ( building_wall_south / dy + 0.5 )
421          byn = bys + bly
422
423          WRITE ( io, 271 )  building_length_x, building_length_y, &
424                             building_height, bxl, bxr, bys, byn
425
426       CASE ( 'single_street_canyon' )
427          ch  = NINT( canyon_height / dz )
428          IF ( canyon_width_x /= 9999999.9 )  THEN
429!
430!--          Street canyon in y direction
431             cwx = NINT( canyon_width_x / dx )
432             IF ( canyon_wall_left == 9999999.9 )  THEN
433                canyon_wall_left = ( nx + 1 - cwx ) / 2 * dx
434             ENDIF
435             cxl = NINT( canyon_wall_left / dx )
436             cxr = cxl + cwx
437             WRITE ( io, 272 )  'y', canyon_height, ch, 'u', cxl, cxr
438
439          ELSEIF ( canyon_width_y /= 9999999.9 )  THEN
440!
441!--          Street canyon in x direction
442             cwy = NINT( canyon_width_y / dy )
443             IF ( canyon_wall_south == 9999999.9 )  THEN
444                canyon_wall_south = ( ny + 1 - cwy ) / 2 * dy
445             ENDIF
446             cys = NINT( canyon_wall_south / dy )
447             cyn = cys + cwy
448             WRITE ( io, 272 )  'x', canyon_height, ch, 'v', cys, cyn
449          ENDIF
450
451    END SELECT
452
453    IF ( TRIM( topography ) /= 'flat' )  THEN
454       IF ( TRIM( topography_grid_convention ) == ' ' )  THEN
455          IF ( TRIM( topography ) == 'single_building' .OR.  &
456               TRIM( topography ) == 'single_street_canyon' )  THEN
457             WRITE ( io, 278 )
458          ELSEIF ( TRIM( topography ) == 'read_from_file' )  THEN
459             WRITE ( io, 279 )
460          ENDIF
461       ELSEIF ( TRIM( topography_grid_convention ) == 'cell_edge' )  THEN
462          WRITE ( io, 278 )
463       ELSEIF ( TRIM( topography_grid_convention ) == 'cell_center' )  THEN
464          WRITE ( io, 279 )
465       ENDIF
466    ENDIF
467
468    IF ( plant_canopy ) THEN
469
470       WRITE ( io, 280 ) canopy_mode, pch_index, drag_coefficient
471       IF ( passive_scalar ) THEN
472          WRITE ( io, 281 ) scalar_exchange_coefficient,   &
473                            leaf_surface_concentration
474       ENDIF
475
476!
477!--    Heat flux at the top of vegetation
478       WRITE ( io, 282 ) cthf
479
480!
481!--    Leaf area density profile
482!--    Building output strings, starting with surface value
483       WRITE ( learde, '(F6.2)' )  lad_surface
484       gradients = '------'
485       slices = '     0'
486       coordinates = '   0.0'
487       i = 1
488       DO  WHILE ( lad_vertical_gradient_level_ind(i) /= -9999 )
489
490          WRITE (coor_chr,'(F7.2)')  lad(lad_vertical_gradient_level_ind(i))
491          learde = TRIM( learde ) // ' ' // TRIM( coor_chr )
492
493          WRITE (coor_chr,'(F7.2)')  lad_vertical_gradient(i)
494          gradients = TRIM( gradients ) // ' ' // TRIM( coor_chr )
495
496          WRITE (coor_chr,'(I7)')  lad_vertical_gradient_level_ind(i)
497          slices = TRIM( slices ) // ' ' // TRIM( coor_chr )
498
499          WRITE (coor_chr,'(F7.1)')  lad_vertical_gradient_level(i)
500          coordinates = TRIM( coordinates ) // ' '  // TRIM( coor_chr )
501
502          i = i + 1
503       ENDDO
504
505       WRITE ( io, 283 )  TRIM( coordinates ), TRIM( learde ), &
506                          TRIM( gradients ), TRIM( slices )
507
508    ENDIF
509
510!
511!-- Boundary conditions
512    IF ( ibc_p_b == 0 )  THEN
513       runten = 'p(0)     = 0      |'
514    ELSEIF ( ibc_p_b == 1 )  THEN
515       runten = 'p(0)     = p(1)   |'
516    ELSE
517       runten = 'p(0)     = p(1) +R|'
518    ENDIF
519    IF ( ibc_p_t == 0 )  THEN
520       roben  = 'p(nzt+1) = 0      |'
521    ELSE
522       roben  = 'p(nzt+1) = p(nzt) |'
523    ENDIF
524
525    IF ( ibc_uv_b == 0 )  THEN
526       runten = TRIM( runten ) // ' uv(0)     = -uv(1)                |'
527    ELSE
528       runten = TRIM( runten ) // ' uv(0)     = uv(1)                 |'
529    ENDIF
530    IF ( TRIM( bc_uv_t ) == 'dirichlet_0' )  THEN
531       roben  = TRIM( roben  ) // ' uv(nzt+1) = 0                     |'
532    ELSEIF ( ibc_uv_t == 0 )  THEN
533       roben  = TRIM( roben  ) // ' uv(nzt+1) = ug(nzt+1), vg(nzt+1)  |'
534    ELSE
535       roben  = TRIM( roben  ) // ' uv(nzt+1) = uv(nzt)               |'
536    ENDIF
537
538    IF ( ibc_pt_b == 0 )  THEN
539       runten = TRIM( runten ) // ' pt(0)   = pt_surface'
540    ELSEIF ( ibc_pt_b == 1 )  THEN
541       runten = TRIM( runten ) // ' pt(0)   = pt(1)'
542    ELSEIF ( ibc_pt_b == 2 )  THEN
543       runten = TRIM( runten ) // ' pt(0) = from coupled model'
544    ENDIF
545    IF ( ibc_pt_t == 0 )  THEN
546       roben  = TRIM( roben  ) // ' pt(nzt+1) = pt_top'
547    ELSEIF( ibc_pt_t == 1 )  THEN
548       roben  = TRIM( roben  ) // ' pt(nzt+1) = pt(nzt)'
549    ELSEIF( ibc_pt_t == 2 )  THEN
550       roben  = TRIM( roben  ) // ' pt(nzt+1) = pt(nzt) + dpt/dz_ini'
551    ENDIF
552
553    WRITE ( io, 300 )  runten, roben
554
555    IF ( .NOT. constant_diffusion )  THEN
556       IF ( ibc_e_b == 1 )  THEN
557          runten = 'e(0)     = e(1)'
558       ELSE
559          runten = 'e(0)     = e(1) = (u*/0.1)**2'
560       ENDIF
561       roben = 'e(nzt+1) = e(nzt) = e(nzt-1)'
562
563       WRITE ( io, 301 )  'e', runten, roben       
564
565    ENDIF
566
567    IF ( ocean )  THEN
568       runten = 'sa(0)    = sa(1)'
569       IF ( ibc_sa_t == 0 )  THEN
570          roben =  'sa(nzt+1) = sa_surface'
571       ELSE
572          roben =  'sa(nzt+1) = sa(nzt)'
573       ENDIF
574       WRITE ( io, 301 ) 'sa', runten, roben
575    ENDIF
576
577    IF ( humidity )  THEN
578       IF ( ibc_q_b == 0 )  THEN
579          runten = 'q(0)     = q_surface'
580       ELSE
581          runten = 'q(0)     = q(1)'
582       ENDIF
583       IF ( ibc_q_t == 0 )  THEN
584          roben =  'q(nzt)   = q_top'
585       ELSE
586          roben =  'q(nzt)   = q(nzt-1) + dq/dz'
587       ENDIF
588       WRITE ( io, 301 ) 'q', runten, roben
589    ENDIF
590
591    IF ( passive_scalar )  THEN
592       IF ( ibc_q_b == 0 )  THEN
593          runten = 's(0)     = s_surface'
594       ELSE
595          runten = 's(0)     = s(1)'
596       ENDIF
597       IF ( ibc_q_t == 0 )  THEN
598          roben =  's(nzt)   = s_top'
599       ELSE
600          roben =  's(nzt)   = s(nzt-1) + ds/dz'
601       ENDIF
602       WRITE ( io, 301 ) 's', runten, roben
603    ENDIF
604
605    IF ( use_surface_fluxes )  THEN
606       WRITE ( io, 303 )
607       IF ( constant_heatflux )  THEN
608          WRITE ( io, 306 )  surface_heatflux
609          IF ( random_heatflux )  WRITE ( io, 307 )
610       ENDIF
611       IF ( humidity  .AND.  constant_waterflux )  THEN
612          WRITE ( io, 311 ) surface_waterflux
613       ENDIF
614       IF ( passive_scalar  .AND.  constant_waterflux )  THEN
615          WRITE ( io, 313 ) surface_waterflux
616       ENDIF
617    ENDIF
618
619    IF ( use_top_fluxes )  THEN
620       WRITE ( io, 304 )
621       IF ( coupling_mode == 'uncoupled' )  THEN
622          WRITE ( io, 320 )  top_momentumflux_u, top_momentumflux_v
623          IF ( constant_top_heatflux )  THEN
624             WRITE ( io, 306 )  top_heatflux
625          ENDIF
626       ELSEIF ( coupling_mode == 'ocean_to_atmosphere' )  THEN
627          WRITE ( io, 316 )
628       ENDIF
629       IF ( ocean  .AND.  constant_top_salinityflux )  THEN
630          WRITE ( io, 309 )  top_salinityflux
631       ENDIF
632       IF ( humidity  .OR.  passive_scalar )  THEN
633          WRITE ( io, 315 )
634       ENDIF
635    ENDIF
636
637    IF ( prandtl_layer )  THEN
638       WRITE ( io, 305 )  0.5 * (zu(1)-zu(0)), roughness_length, kappa, &
639                          rif_min, rif_max
640       IF ( .NOT. constant_heatflux )  WRITE ( io, 308 )
641       IF ( humidity  .AND.  .NOT. constant_waterflux )  THEN
642          WRITE ( io, 312 )
643       ENDIF
644       IF ( passive_scalar  .AND.  .NOT. constant_waterflux )  THEN
645          WRITE ( io, 314 )
646       ENDIF
647    ELSE
648       IF ( INDEX(initializing_actions, 'set_1d-model_profiles') /= 0 )  THEN
649          WRITE ( io, 310 )  rif_min, rif_max
650       ENDIF
651    ENDIF
652
653    WRITE ( io, 317 )  bc_lr, bc_ns
654    IF ( bc_lr /= 'cyclic'  .OR.  bc_ns /= 'cyclic' )  THEN
655       WRITE ( io, 318 )  outflow_damping_width, km_damp_max
656       IF ( turbulent_inflow )  THEN
657          WRITE ( io, 319 )  recycling_width, recycling_plane, &
658                             inflow_damping_height, inflow_damping_width
659       ENDIF
660    ENDIF
661
662!
663!-- Listing of 1D-profiles
664    WRITE ( io, 325 )  dt_dopr_listing
665    IF ( averaging_interval_pr /= 0.0 )  THEN
666       WRITE ( io, 326 )  averaging_interval_pr, dt_averaging_input_pr
667    ENDIF
668
669!
670!-- DATA output
671    WRITE ( io, 330 )
672    IF ( averaging_interval_pr /= 0.0 )  THEN
673       WRITE ( io, 326 )  averaging_interval_pr, dt_averaging_input_pr
674    ENDIF
675
676!
677!-- 1D-profiles
678    dopr_chr = 'Profile:'
679    IF ( dopr_n /= 0 )  THEN
680       WRITE ( io, 331 )
681
682       output_format = ''
683       IF ( netcdf_output )  THEN
684          IF ( netcdf_64bit )  THEN
685             output_format = 'netcdf (64 bit offset)'
686          ELSE
687             output_format = 'netcdf'
688          ENDIF
689       ENDIF
690       IF ( profil_output )  THEN
691          IF ( netcdf_output )  THEN
692             output_format = TRIM( output_format ) // ' and profil'
693          ELSE
694             output_format = 'profil'
695          ENDIF
696       ENDIF
697       WRITE ( io, 344 )  output_format
698
699       DO  i = 1, dopr_n
700          dopr_chr = TRIM( dopr_chr ) // ' ' // TRIM( data_output_pr(i) ) // ','
701          IF ( LEN_TRIM( dopr_chr ) >= 60 )  THEN
702             WRITE ( io, 332 )  dopr_chr
703             dopr_chr = '       :'
704          ENDIF
705       ENDDO
706
707       IF ( dopr_chr /= '' )  THEN
708          WRITE ( io, 332 )  dopr_chr
709       ENDIF
710       WRITE ( io, 333 )  dt_dopr, averaging_interval_pr, dt_averaging_input_pr
711       IF ( skip_time_dopr /= 0.0 )  WRITE ( io, 339 )  skip_time_dopr
712    ENDIF
713
714!
715!-- 2D-arrays
716    DO  av = 0, 1
717
718       i = 1
719       do2d_xy = ''
720       do2d_xz = ''
721       do2d_yz = ''
722       DO  WHILE ( do2d(av,i) /= ' ' )
723
724          l = MAX( 2, LEN_TRIM( do2d(av,i) ) )
725          do2d_mode = do2d(av,i)(l-1:l)
726
727          SELECT CASE ( do2d_mode )
728             CASE ( 'xy' )
729                ll = LEN_TRIM( do2d_xy )
730                do2d_xy = do2d_xy(1:ll) // ' ' // do2d(av,i)(1:l-3) // ','
731             CASE ( 'xz' )
732                ll = LEN_TRIM( do2d_xz )
733                do2d_xz = do2d_xz(1:ll) // ' ' // do2d(av,i)(1:l-3) // ','
734             CASE ( 'yz' )
735                ll = LEN_TRIM( do2d_yz )
736                do2d_yz = do2d_yz(1:ll) // ' ' // do2d(av,i)(1:l-3) // ','
737          END SELECT
738
739          i = i + 1
740
741       ENDDO
742
743       IF ( ( ( do2d_xy /= ''  .AND.  section(1,1) /= -9999 )  .OR.    &
744              ( do2d_xz /= ''  .AND.  section(1,2) /= -9999 )  .OR.    &
745              ( do2d_yz /= ''  .AND.  section(1,3) /= -9999 ) )  .AND. &
746            ( netcdf_output  .OR.  iso2d_output ) )  THEN
747
748          IF (  av == 0 )  THEN
749             WRITE ( io, 334 )  ''
750          ELSE
751             WRITE ( io, 334 )  '(time-averaged)'
752          ENDIF
753
754          IF ( do2d_at_begin )  THEN
755             begin_chr = 'and at the start'
756          ELSE
757             begin_chr = ''
758          ENDIF
759
760          output_format = ''
761          IF ( netcdf_output )  THEN
762             IF ( netcdf_64bit )  THEN
763                output_format = 'netcdf (64 bit offset)'
764             ELSE
765                output_format = 'netcdf'
766             ENDIF
767          ENDIF
768          IF ( iso2d_output )  THEN
769             IF ( netcdf_output )  THEN
770                output_format = TRIM( output_format ) // ' and iso2d'
771             ELSE
772                output_format = 'iso2d'
773             ENDIF
774          ENDIF
775          WRITE ( io, 344 )  output_format
776
777          IF ( do2d_xy /= ''  .AND.  section(1,1) /= -9999 )  THEN
778             i = 1
779             slices = '/'
780             coordinates = '/'
781!
782!--          Building strings with index and coordinate informations of the
783!--          slices
784             DO  WHILE ( section(i,1) /= -9999 )
785
786                WRITE (section_chr,'(I5)')  section(i,1)
787                section_chr = ADJUSTL( section_chr )
788                slices = TRIM( slices ) // TRIM( section_chr ) // '/'
789
790                IF ( section(i,1) == -1 )  THEN
791                   WRITE (coor_chr,'(F10.1)')  -1.0
792                ELSE
793                   WRITE (coor_chr,'(F10.1)')  zu(section(i,1))
794                ENDIF
795                coor_chr = ADJUSTL( coor_chr )
796                coordinates = TRIM( coordinates ) // TRIM( coor_chr ) // '/'
797
798                i = i + 1
799             ENDDO
800             IF ( av == 0 )  THEN
801                WRITE ( io, 335 )  'XY', do2d_xy, dt_do2d_xy, &
802                                   TRIM( begin_chr ), 'k', TRIM( slices ), &
803                                   TRIM( coordinates )
804                IF ( skip_time_do2d_xy /= 0.0 )  THEN
805                   WRITE ( io, 339 )  skip_time_do2d_xy
806                ENDIF
807             ELSE
808                WRITE ( io, 342 )  'XY', do2d_xy, dt_data_output_av, &
809                                   TRIM( begin_chr ), averaging_interval, &
810                                   dt_averaging_input, 'k', TRIM( slices ), &
811                                   TRIM( coordinates )
812                IF ( skip_time_data_output_av /= 0.0 )  THEN
813                   WRITE ( io, 339 )  skip_time_data_output_av
814                ENDIF
815             ENDIF
816
817          ENDIF
818
819          IF ( do2d_xz /= ''  .AND.  section(1,2) /= -9999 )  THEN
820             i = 1
821             slices = '/'
822             coordinates = '/'
823!
824!--          Building strings with index and coordinate informations of the
825!--          slices
826             DO  WHILE ( section(i,2) /= -9999 )
827
828                WRITE (section_chr,'(I5)')  section(i,2)
829                section_chr = ADJUSTL( section_chr )
830                slices = TRIM( slices ) // TRIM( section_chr ) // '/'
831
832                WRITE (coor_chr,'(F10.1)')  section(i,2) * dy
833                coor_chr = ADJUSTL( coor_chr )
834                coordinates = TRIM( coordinates ) // TRIM( coor_chr ) // '/'
835
836                i = i + 1
837             ENDDO
838             IF ( av == 0 )  THEN
839                WRITE ( io, 335 )  'XZ', do2d_xz, dt_do2d_xz, &
840                                   TRIM( begin_chr ), 'j', TRIM( slices ), &
841                                   TRIM( coordinates )
842                IF ( skip_time_do2d_xz /= 0.0 )  THEN
843                   WRITE ( io, 339 )  skip_time_do2d_xz
844                ENDIF
845             ELSE
846                WRITE ( io, 342 )  'XZ', do2d_xz, dt_data_output_av, &
847                                   TRIM( begin_chr ), averaging_interval, &
848                                   dt_averaging_input, 'j', TRIM( slices ), &
849                                   TRIM( coordinates )
850                IF ( skip_time_data_output_av /= 0.0 )  THEN
851                   WRITE ( io, 339 )  skip_time_data_output_av
852                ENDIF
853             ENDIF
854          ENDIF
855
856          IF ( do2d_yz /= ''  .AND.  section(1,3) /= -9999 )  THEN
857             i = 1
858             slices = '/'
859             coordinates = '/'
860!
861!--          Building strings with index and coordinate informations of the
862!--          slices
863             DO  WHILE ( section(i,3) /= -9999 )
864
865                WRITE (section_chr,'(I5)')  section(i,3)
866                section_chr = ADJUSTL( section_chr )
867                slices = TRIM( slices ) // TRIM( section_chr ) // '/'
868
869                WRITE (coor_chr,'(F10.1)')  section(i,3) * dx
870                coor_chr = ADJUSTL( coor_chr )
871                coordinates = TRIM( coordinates ) // TRIM( coor_chr ) // '/'
872
873                i = i + 1
874             ENDDO
875             IF ( av == 0 )  THEN
876                WRITE ( io, 335 )  'YZ', do2d_yz, dt_do2d_yz, &
877                                   TRIM( begin_chr ), 'i', TRIM( slices ), &
878                                   TRIM( coordinates )
879                IF ( skip_time_do2d_yz /= 0.0 )  THEN
880                   WRITE ( io, 339 )  skip_time_do2d_yz
881                ENDIF
882             ELSE
883                WRITE ( io, 342 )  'YZ', do2d_yz, dt_data_output_av, &
884                                   TRIM( begin_chr ), averaging_interval, &
885                                   dt_averaging_input, 'i', TRIM( slices ), &
886                                   TRIM( coordinates )
887                IF ( skip_time_data_output_av /= 0.0 )  THEN
888                   WRITE ( io, 339 )  skip_time_data_output_av
889                ENDIF
890             ENDIF
891          ENDIF
892
893       ENDIF
894
895    ENDDO
896
897!
898!-- 3d-arrays
899    DO  av = 0, 1
900
901       i = 1
902       do3d_chr = ''
903       DO  WHILE ( do3d(av,i) /= ' ' )
904
905          do3d_chr = TRIM( do3d_chr ) // ' ' // TRIM( do3d(av,i) ) // ','
906          i = i + 1
907
908       ENDDO
909
910       IF ( do3d_chr /= '' )  THEN
911          IF ( av == 0 )  THEN
912             WRITE ( io, 336 )  ''
913          ELSE
914             WRITE ( io, 336 )  '(time-averaged)'
915          ENDIF
916
917          output_format = ''
918          IF ( netcdf_output )  THEN
919             IF ( netcdf_64bit_3d )  THEN
920                output_format = 'netcdf (64 bit offset)'
921             ELSE
922                output_format = 'netcdf'
923             ENDIF
924          ENDIF
925          IF ( avs_output )  THEN
926             IF ( netcdf_output )  THEN
927                output_format = TRIM( output_format ) // ' and avs'
928             ELSE
929                output_format = 'avs'
930             ENDIF
931          ENDIF
932          WRITE ( io, 344 )  output_format
933
934          IF ( do3d_at_begin )  THEN
935             begin_chr = 'and at the start'
936          ELSE
937             begin_chr = ''
938          ENDIF
939          IF ( av == 0 )  THEN
940             WRITE ( io, 337 )  do3d_chr, dt_do3d, TRIM( begin_chr ), &
941                                zu(nz_do3d), nz_do3d
942          ELSE
943             WRITE ( io, 343 )  do3d_chr, dt_data_output_av,           &
944                                TRIM( begin_chr ), averaging_interval, &
945                                dt_averaging_input, zu(nz_do3d), nz_do3d
946          ENDIF
947
948          IF ( do3d_compress )  THEN
949             do3d_chr = ''
950             i = 1
951             DO WHILE ( do3d(av,i) /= ' ' )
952
953                SELECT CASE ( do3d(av,i) )
954                   CASE ( 'u' )
955                      j = 1
956                   CASE ( 'v' )
957                      j = 2
958                   CASE ( 'w' )
959                      j = 3
960                   CASE ( 'p' )
961                      j = 4
962                   CASE ( 'pt' )
963                      j = 5
964                END SELECT
965                WRITE ( prec, '(I1)' )  plot_3d_precision(j)%precision
966                do3d_chr = TRIM( do3d_chr ) // ' ' // TRIM( do3d(av,i) ) // &
967                           ':' // prec // ','
968                i = i + 1
969
970             ENDDO
971             WRITE ( io, 338 )  do3d_chr
972
973          ENDIF
974
975          IF ( av == 0 )  THEN
976             IF ( skip_time_do3d /= 0.0 )  THEN
977                WRITE ( io, 339 )  skip_time_do3d
978             ENDIF
979          ELSE
980             IF ( skip_time_data_output_av /= 0.0 )  THEN
981                WRITE ( io, 339 )  skip_time_data_output_av
982             ENDIF
983          ENDIF
984
985       ENDIF
986
987    ENDDO
988
989!
990!-- Timeseries
991    IF ( dt_dots /= 9999999.9 )  THEN
992       WRITE ( io, 340 )
993
994       output_format = ''
995       IF ( netcdf_output )  THEN
996          IF ( netcdf_64bit )  THEN
997             output_format = 'netcdf (64 bit offset)'
998          ELSE
999             output_format = 'netcdf'
1000          ENDIF
1001       ENDIF
1002       IF ( profil_output )  THEN
1003          IF ( netcdf_output )  THEN
1004             output_format = TRIM( output_format ) // ' and profil'
1005          ELSE
1006             output_format = 'profil'
1007          ENDIF
1008       ENDIF
1009       WRITE ( io, 344 )  output_format
1010       WRITE ( io, 341 )  dt_dots
1011    ENDIF
1012
1013#if defined( __dvrp_graphics )
1014!
1015!-- Dvrp-output
1016    IF ( dt_dvrp /= 9999999.9 )  THEN
1017       WRITE ( io, 360 )  dt_dvrp, TRIM( dvrp_output ), TRIM( dvrp_host ), &
1018                          TRIM( dvrp_username ), TRIM( dvrp_directory )
1019       i = 1
1020       l = 0
1021       m = 0
1022       DO WHILE ( mode_dvrp(i) /= ' ' )
1023          IF ( mode_dvrp(i)(1:10) == 'isosurface' )  THEN
1024             READ ( mode_dvrp(i), '(10X,I2)' )  j
1025             l = l + 1
1026             IF ( do3d(0,j) /= ' ' )  THEN
1027                WRITE ( io, 361 )  TRIM( do3d(0,j) ), threshold(l), &
1028                                   isosurface_color(:,l)
1029             ENDIF
1030          ELSEIF ( mode_dvrp(i)(1:6) == 'slicer' )  THEN
1031             READ ( mode_dvrp(i), '(6X,I2)' )  j
1032             m = m + 1
1033             IF ( do2d(0,j) /= ' ' )  THEN
1034                WRITE ( io, 362 )  TRIM( do2d(0,j) ), &
1035                                   slicer_range_limits_dvrp(:,m)
1036             ENDIF
1037          ELSEIF ( mode_dvrp(i)(1:9) == 'particles' )  THEN
1038             WRITE ( io, 363 )  dvrp_psize
1039             IF ( particle_dvrpsize /= 'none' )  THEN
1040                WRITE ( io, 364 )  'size', TRIM( particle_dvrpsize ), &
1041                                   dvrpsize_interval
1042             ENDIF
1043             IF ( particle_color /= 'none' )  THEN
1044                WRITE ( io, 364 )  'color', TRIM( particle_color ), &
1045                                   color_interval
1046             ENDIF
1047          ENDIF
1048          i = i + 1
1049       ENDDO
1050
1051       WRITE ( io, 365 )  groundplate_color, superelevation_x, &
1052                          superelevation_y, superelevation, clip_dvrp_l, &
1053                          clip_dvrp_r, clip_dvrp_s, clip_dvrp_n
1054
1055       IF ( TRIM( topography ) /= 'flat' )  THEN
1056          WRITE ( io, 366 )  topography_color
1057          IF ( cluster_size > 1 )  THEN
1058             WRITE ( io, 367 )  cluster_size
1059          ENDIF
1060       ENDIF
1061
1062    ENDIF
1063#endif
1064
1065#if defined( __spectra )
1066!
1067!-- Spectra output
1068    IF ( dt_dosp /= 9999999.9 ) THEN
1069       WRITE ( io, 370 )
1070
1071       output_format = ''
1072       IF ( netcdf_output )  THEN
1073          IF ( netcdf_64bit )  THEN
1074             output_format = 'netcdf (64 bit offset)'
1075          ELSE
1076             output_format = 'netcdf'
1077          ENDIF
1078       ENDIF
1079       IF ( profil_output )  THEN
1080          IF ( netcdf_output )  THEN
1081             output_format = TRIM( output_format ) // ' and profil'
1082          ELSE
1083             output_format = 'profil'
1084          ENDIF
1085       ENDIF
1086       WRITE ( io, 344 )  output_format
1087       WRITE ( io, 371 )  dt_dosp
1088       IF ( skip_time_dosp /= 0.0 )  WRITE ( io, 339 )  skip_time_dosp
1089       WRITE ( io, 372 )  ( data_output_sp(i), i = 1,10 ),     &
1090                          ( spectra_direction(i), i = 1,10 ),  &
1091                          ( comp_spectra_level(i), i = 1,100 ), &
1092                          ( plot_spectra_level(i), i = 1,100 ), &
1093                          averaging_interval_sp, dt_averaging_input_pr
1094    ENDIF
1095#endif
1096
1097    WRITE ( io, 99 )
1098
1099!
1100!-- Physical quantities
1101    WRITE ( io, 400 )
1102
1103!
1104!-- Geostrophic parameters
1105    WRITE ( io, 410 )  omega, phi, f, fs
1106
1107!
1108!-- Other quantities
1109    WRITE ( io, 411 )  g
1110    IF ( use_reference )  THEN
1111       IF ( ocean )  THEN
1112          WRITE ( io, 412 )  prho_reference
1113       ELSE
1114          WRITE ( io, 413 )  pt_reference
1115       ENDIF
1116    ENDIF
1117
1118!
1119!-- Cloud physics parameters
1120    IF ( cloud_physics ) THEN
1121       WRITE ( io, 415 )
1122       WRITE ( io, 416 ) surface_pressure, r_d, rho_surface, cp, l_v
1123    ENDIF
1124
1125!-- Profile of the geostrophic wind (component ug)
1126!-- Building output strings
1127    WRITE ( ugcomponent, '(F6.2)' )  ug_surface
1128    gradients = '------'
1129    slices = '     0'
1130    coordinates = '   0.0'
1131    i = 1
1132    DO  WHILE ( ug_vertical_gradient_level_ind(i) /= -9999 )
1133     
1134       WRITE (coor_chr,'(F6.2,1X)')  ug(ug_vertical_gradient_level_ind(i))
1135       ugcomponent = TRIM( ugcomponent ) // '  ' // TRIM( coor_chr )
1136
1137       WRITE (coor_chr,'(F6.2,1X)')  ug_vertical_gradient(i)
1138       gradients = TRIM( gradients ) // '  ' // TRIM( coor_chr )
1139
1140       WRITE (coor_chr,'(I6,1X)')  ug_vertical_gradient_level_ind(i)
1141       slices = TRIM( slices ) // '  ' // TRIM( coor_chr )
1142
1143       WRITE (coor_chr,'(F6.1,1X)')  ug_vertical_gradient_level(i)
1144       coordinates = TRIM( coordinates ) // '  ' // TRIM( coor_chr )
1145
1146       i = i + 1
1147    ENDDO
1148
1149    WRITE ( io, 423 )  TRIM( coordinates ), TRIM( ugcomponent ), &
1150                       TRIM( gradients ), TRIM( slices )
1151
1152!-- Profile of the geostrophic wind (component vg)
1153!-- Building output strings
1154    WRITE ( vgcomponent, '(F6.2)' )  vg_surface
1155    gradients = '------'
1156    slices = '     0'
1157    coordinates = '   0.0'
1158    i = 1
1159    DO  WHILE ( vg_vertical_gradient_level_ind(i) /= -9999 )
1160
1161       WRITE (coor_chr,'(F6.2,1X)')  vg(vg_vertical_gradient_level_ind(i))
1162       vgcomponent = TRIM( vgcomponent ) // '  ' // TRIM( coor_chr )
1163
1164       WRITE (coor_chr,'(F6.2,1X)')  vg_vertical_gradient(i)
1165       gradients = TRIM( gradients ) // '  ' // TRIM( coor_chr )
1166
1167       WRITE (coor_chr,'(I6,1X)')  vg_vertical_gradient_level_ind(i)
1168       slices = TRIM( slices ) // '  ' // TRIM( coor_chr )
1169
1170       WRITE (coor_chr,'(F6.1,1X)')  vg_vertical_gradient_level(i)
1171       coordinates = TRIM( coordinates ) // '  ' // TRIM( coor_chr )
1172
1173       i = i + 1 
1174    ENDDO
1175
1176    WRITE ( io, 424 )  TRIM( coordinates ), TRIM( vgcomponent ), &
1177                       TRIM( gradients ), TRIM( slices )
1178
1179!
1180!-- Initial temperature profile
1181!-- Building output strings, starting with surface temperature
1182    WRITE ( temperatures, '(F6.2)' )  pt_surface
1183    gradients = '------'
1184    slices = '     0'
1185    coordinates = '   0.0'
1186    i = 1
1187    DO  WHILE ( pt_vertical_gradient_level_ind(i) /= -9999 )
1188
1189       WRITE (coor_chr,'(F7.2)')  pt_init(pt_vertical_gradient_level_ind(i))
1190       temperatures = TRIM( temperatures ) // ' ' // TRIM( coor_chr )
1191
1192       WRITE (coor_chr,'(F7.2)')  pt_vertical_gradient(i)
1193       gradients = TRIM( gradients ) // ' ' // TRIM( coor_chr )
1194
1195       WRITE (coor_chr,'(I7)')  pt_vertical_gradient_level_ind(i)
1196       slices = TRIM( slices ) // ' ' // TRIM( coor_chr )
1197
1198       WRITE (coor_chr,'(F7.1)')  pt_vertical_gradient_level(i)
1199       coordinates = TRIM( coordinates ) // ' '  // TRIM( coor_chr )
1200
1201       i = i + 1
1202    ENDDO
1203
1204    WRITE ( io, 420 )  TRIM( coordinates ), TRIM( temperatures ), &
1205                       TRIM( gradients ), TRIM( slices )
1206
1207!
1208!-- Initial humidity profile
1209!-- Building output strings, starting with surface humidity
1210    IF ( humidity  .OR.  passive_scalar )  THEN
1211       WRITE ( temperatures, '(E8.1)' )  q_surface
1212       gradients = '--------'
1213       slices = '       0'
1214       coordinates = '     0.0'
1215       i = 1
1216       DO  WHILE ( q_vertical_gradient_level_ind(i) /= -9999 )
1217         
1218          WRITE (coor_chr,'(E8.1,4X)')  q_init(q_vertical_gradient_level_ind(i))
1219          temperatures = TRIM( temperatures ) // '  ' // TRIM( coor_chr )
1220
1221          WRITE (coor_chr,'(E8.1,4X)')  q_vertical_gradient(i)
1222          gradients = TRIM( gradients ) // '  ' // TRIM( coor_chr )
1223         
1224          WRITE (coor_chr,'(I8,4X)')  q_vertical_gradient_level_ind(i)
1225          slices = TRIM( slices ) // '  ' // TRIM( coor_chr )
1226         
1227          WRITE (coor_chr,'(F8.1,4X)')  q_vertical_gradient_level(i)
1228          coordinates = TRIM( coordinates ) // '  '  // TRIM( coor_chr )
1229
1230          i = i + 1
1231       ENDDO
1232
1233       IF ( humidity )  THEN
1234          WRITE ( io, 421 )  TRIM( coordinates ), TRIM( temperatures ), &
1235                             TRIM( gradients ), TRIM( slices )
1236       ELSE
1237          WRITE ( io, 422 )  TRIM( coordinates ), TRIM( temperatures ), &
1238                             TRIM( gradients ), TRIM( slices )
1239       ENDIF
1240    ENDIF
1241
1242!
1243!-- Initial salinity profile
1244!-- Building output strings, starting with surface salinity
1245    IF ( ocean )  THEN
1246       WRITE ( temperatures, '(F6.2)' )  sa_surface
1247       gradients = '------'
1248       slices = '     0'
1249       coordinates = '   0.0'
1250       i = 1
1251       DO  WHILE ( sa_vertical_gradient_level_ind(i) /= -9999 )
1252
1253          WRITE (coor_chr,'(F7.2)')  sa_init(sa_vertical_gradient_level_ind(i))
1254          temperatures = TRIM( temperatures ) // ' ' // TRIM( coor_chr )
1255
1256          WRITE (coor_chr,'(F7.2)')  sa_vertical_gradient(i)
1257          gradients = TRIM( gradients ) // ' ' // TRIM( coor_chr )
1258
1259          WRITE (coor_chr,'(I7)')  sa_vertical_gradient_level_ind(i)
1260          slices = TRIM( slices ) // ' ' // TRIM( coor_chr )
1261
1262          WRITE (coor_chr,'(F7.1)')  sa_vertical_gradient_level(i)
1263          coordinates = TRIM( coordinates ) // ' '  // TRIM( coor_chr )
1264
1265          i = i + 1
1266       ENDDO
1267
1268       WRITE ( io, 425 )  TRIM( coordinates ), TRIM( temperatures ), &
1269                          TRIM( gradients ), TRIM( slices )
1270    ENDIF
1271
1272!
1273!-- LES / turbulence parameters
1274    WRITE ( io, 450 )
1275
1276!--
1277! ... LES-constants used must still be added here
1278!--
1279    IF ( constant_diffusion )  THEN
1280       WRITE ( io, 451 )  km_constant, km_constant/prandtl_number, &
1281                          prandtl_number
1282    ENDIF
1283    IF ( .NOT. constant_diffusion)  THEN
1284       IF ( e_init > 0.0 )  WRITE ( io, 455 )  e_init
1285       IF ( e_min > 0.0 )  WRITE ( io, 454 )  e_min
1286       IF ( wall_adjustment )  WRITE ( io, 453 )  wall_adjustment_factor
1287       IF ( adjust_mixing_length  .AND.  prandtl_layer )  WRITE ( io, 452 )
1288    ENDIF
1289
1290!
1291!-- Special actions during the run
1292    WRITE ( io, 470 )
1293    IF ( create_disturbances )  THEN
1294       WRITE ( io, 471 )  dt_disturb, disturbance_amplitude,                   &
1295                          zu(disturbance_level_ind_b), disturbance_level_ind_b,&
1296                          zu(disturbance_level_ind_t), disturbance_level_ind_t
1297       IF ( bc_lr /= 'cyclic'  .OR.  bc_ns /= 'cyclic' )  THEN
1298          WRITE ( io, 472 )  inflow_disturbance_begin, inflow_disturbance_end
1299       ELSE
1300          WRITE ( io, 473 )  disturbance_energy_limit
1301       ENDIF
1302       WRITE ( io, 474 )  TRIM( random_generator )
1303    ENDIF
1304    IF ( pt_surface_initial_change /= 0.0 )  THEN
1305       WRITE ( io, 475 )  pt_surface_initial_change
1306    ENDIF
1307    IF ( humidity  .AND.  q_surface_initial_change /= 0.0 )  THEN
1308       WRITE ( io, 476 )  q_surface_initial_change       
1309    ENDIF
1310    IF ( passive_scalar  .AND.  q_surface_initial_change /= 0.0 )  THEN
1311       WRITE ( io, 477 )  q_surface_initial_change       
1312    ENDIF
1313
1314    IF ( particle_advection )  THEN
1315!
1316!--    Particle attributes
1317       WRITE ( io, 480 )  particle_advection_start, dt_prel, bc_par_lr, &
1318                          bc_par_ns, bc_par_b, bc_par_t, particle_maximum_age, &
1319                          end_time_prel, dt_sort_particles
1320       IF ( use_sgs_for_particles )  WRITE ( io, 488 )  dt_min_part
1321       IF ( random_start_position )  WRITE ( io, 481 )
1322       IF ( particles_per_point > 1 )  WRITE ( io, 489 )  particles_per_point
1323       WRITE ( io, 495 )  total_number_of_particles
1324       IF ( maximum_number_of_tailpoints /= 0 )  THEN
1325          WRITE ( io, 483 )  maximum_number_of_tailpoints
1326          IF ( minimum_tailpoint_distance /= 0 )  THEN
1327             WRITE ( io, 484 )  total_number_of_tails,      &
1328                                minimum_tailpoint_distance, &
1329                                maximum_tailpoint_age
1330          ENDIF
1331       ENDIF
1332       IF ( dt_write_particle_data /= 9999999.9 )  THEN
1333          WRITE ( io, 485 )  dt_write_particle_data
1334          output_format = ''
1335          IF ( netcdf_output )  THEN
1336             IF ( netcdf_64bit )  THEN
1337                output_format = 'netcdf (64 bit offset) and binary'
1338             ELSE
1339                output_format = 'netcdf and binary'
1340             ENDIF
1341          ELSE
1342             output_format = 'binary'
1343          ENDIF
1344          WRITE ( io, 344 )  output_format
1345       ENDIF
1346       IF ( dt_dopts /= 9999999.9 )  WRITE ( io, 494 )  dt_dopts
1347       IF ( write_particle_statistics )  WRITE ( io, 486 )
1348
1349       WRITE ( io, 487 )  number_of_particle_groups
1350
1351       DO  i = 1, number_of_particle_groups
1352          IF ( i == 1  .AND.  density_ratio(i) == 9999999.9 )  THEN
1353             WRITE ( io, 490 )  i, 0.0
1354             WRITE ( io, 492 )
1355          ELSE
1356             WRITE ( io, 490 )  i, radius(i)
1357             IF ( density_ratio(i) /= 0.0 )  THEN
1358                WRITE ( io, 491 )  density_ratio(i)
1359             ELSE
1360                WRITE ( io, 492 )
1361             ENDIF
1362          ENDIF
1363          WRITE ( io, 493 )  psl(i), psr(i), pss(i), psn(i), psb(i), pst(i), &
1364                             pdx(i), pdy(i), pdz(i)
1365          IF ( .NOT. vertical_particle_advection(i) )  WRITE ( io, 482 )
1366       ENDDO
1367
1368    ENDIF
1369
1370
1371!
1372!-- Parameters of 1D-model
1373    IF ( INDEX( initializing_actions, 'set_1d-model_profiles' ) /= 0 )  THEN
1374       WRITE ( io, 500 )  end_time_1d, dt_run_control_1d, dt_pr_1d, &
1375                          mixing_length_1d, dissipation_1d
1376       IF ( damp_level_ind_1d /= nzt+1 )  THEN
1377          WRITE ( io, 502 )  zu(damp_level_ind_1d), damp_level_ind_1d
1378       ENDIF
1379    ENDIF
1380
1381!
1382!-- User-defined informations
1383    CALL user_header( io )
1384
1385    WRITE ( io, 99 )
1386
1387!
1388!-- Write buffer contents to disc immediately
1389    CALL local_flush( io )
1390
1391!
1392!-- Here the FORMATs start
1393
1394 99 FORMAT (1X,78('-'))
1395100 FORMAT (/1X,'***************************',9X,42('-')/        &
1396            1X,'* ',A,' *',9X,A/                               &
1397            1X,'***************************',9X,42('-'))
1398101 FORMAT (37X,'coupled run using MPI-',I1,': ',A/ &
1399            37X,42('-'))
1400102 FORMAT (/' Date:              ',A8,9X,'Run:       ',A20/      &
1401            ' Time:              ',A8,9X,'Run-No.:   ',I2.2/     &
1402            ' Run on host:     ',A10)
1403#if defined( __parallel )
1404103 FORMAT (' Number of PEs:',8X,I5,9X,'Processor grid (x,y): (',I3,',',I3, &
1405              ')',1X,A)
1406104 FORMAT (' Number of PEs:',8X,I5,9X,'Tasks:',I4,'   threads per task:',I4/ &
1407              37X,'Processor grid (x,y): (',I3,',',I3,')',1X,A)
1408105 FORMAT (37X,'One additional PE is used to handle'/37X,'the dvrp output!')
1409106 FORMAT (37X,'A 1d-decomposition along x is forced'/ &
1410            37X,'because the job is running on an SMP-cluster')
1411107 FORMAT (37X,'A 1d-decomposition along ',A,' is used')
1412#endif
1413110 FORMAT (/' Numerical Schemes:'/ &
1414             ' -----------------'/)
1415111 FORMAT (' --> Solve perturbation pressure via FFT using ',A,' routines')
1416112 FORMAT (' --> Solve perturbation pressure via SOR-Red/Black-Schema'/ &
1417            '     Iterations (initial/other): ',I3,'/',I3,'  omega = ',F5.3)
1418113 FORMAT (' --> Momentum advection via Piascek-Williams-Scheme (Form C3)', &
1419                  ' or Upstream')
1420114 FORMAT (' --> Momentum advection via Upstream-Spline-Scheme')
1421115 FORMAT ('     Tendencies are smoothed via Long-Filter with factor ',F5.3) 
1422116 FORMAT (' --> Scalar advection via Piascek-Williams-Scheme (Form C3)', &
1423                  ' or Upstream')
1424117 FORMAT (' --> Scalar advection via Upstream-Spline-Scheme')
1425118 FORMAT (' --> Scalar advection via Bott-Chlond-Scheme')
1426119 FORMAT (' --> Galilei-Transform applied to horizontal advection', &
1427            '     Translation velocity = ',A/ &
1428            '     distance advected ',A,':  ',F8.3,' km(x)  ',F8.3,' km(y)')
1429120 FORMAT (' --> Time differencing scheme: leapfrog only (no euler in case', &
1430                  ' of timestep changes)')
1431121 FORMAT (' --> Time differencing scheme: leapfrog + euler in case of', &
1432                  ' timestep changes')
1433122 FORMAT (' --> Time differencing scheme: ',A)
1434123 FORMAT (' --> Rayleigh-Damping active, starts ',A,' z = ',F8.2,' m'/ &
1435            '     maximum damping coefficient: ',F5.3, ' 1/s')
1436124 FORMAT ('     Spline-overshoots are being suppressed')
1437125 FORMAT ('     Upstream-Scheme is used if Upstream-differences fall short', &
1438                  ' of'/                                                       &
1439            '     delta_u = ',F6.4,4X,'delta_v = ',F6.4,4X,'delta_w = ',F6.4)
1440126 FORMAT ('     Upstream-Scheme is used if Upstream-differences fall short', &
1441                  ' of'/                                                       &
1442            '     delta_e = ',F6.4,4X,'delta_pt = ',F6.4)
1443127 FORMAT ('     The following absolute overshoot differences are tolerated:'/&
1444            '     delta_u = ',F6.4,4X,'delta_v = ',F6.4,4X,'delta_w = ',F6.4)
1445128 FORMAT ('     The following absolute overshoot differences are tolerated:'/&
1446            '     delta_e = ',F6.4,4X,'delta_pt = ',F6.4)
1447129 FORMAT (' --> Additional prognostic equation for the specific humidity')
1448130 FORMAT (' --> Additional prognostic equation for the total water content')
1449131 FORMAT (' --> Parameterization of condensation processes via (0%-or100%)')
1450132 FORMAT (' --> Parameterization of long-wave radiation processes via'/ &
1451            '     effective emissivity scheme')
1452133 FORMAT (' --> Precipitation parameterization via Kessler-Scheme')
1453134 FORMAT (' --> Additional prognostic equation for a passive scalar')
1454135 FORMAT (' --> Solve perturbation pressure via multigrid method (', &
1455                  A,'-cycle)'/ &
1456            '     number of grid levels:                   ',I2/ &
1457            '     Gauss-Seidel red/black iterations:       ',I2)
1458136 FORMAT ('     gridpoints of coarsest subdomain (x,y,z): (',I3,',',I3,',', &
1459                  I3,')')
1460137 FORMAT ('     level data gathered on PE0 at level:     ',I2/ &
1461            '     gridpoints of coarsest subdomain (x,y,z): (',I3,',',I3,',', &
1462                  I3,')'/ &
1463            '     gridpoints of coarsest domain (x,y,z):    (',I3,',',I3,',', &
1464                  I3,')')
1465138 FORMAT ('     Using hybrid version for 1d-domain-decomposition')
1466139 FORMAT (' --> Loop optimization method: ',A)
1467140 FORMAT ('     maximum residual allowed:                ',E10.3)
1468141 FORMAT ('     fixed number of multigrid cycles:        ',I4)
1469142 FORMAT ('     perturbation pressure is calculated at every Runge-Kutta ', &
1470                  'step')
1471143 FORMAT ('     Euler/upstream scheme is used for the SGS turbulent ', &
1472                  'kinetic energy')
1473150 FORMAT (' --> Volume flow at the right and north boundary will be ', &
1474                  'conserved'/ &
1475            '     using the ',A,' mode')
1476151 FORMAT ('     with u_bulk = ',F7.3,' m/s and v_bulk = ',F7.3,' m/s')
1477152 FORMAT (' --> External pressure gradient directly prescribed by the user:',&
1478           /'     ',2(1X,E12.5),'Pa/m in x/y direction', &
1479           /'     starting from dp_level_b =', F8.3, 'm', A /)
1480200 FORMAT (//' Run time and time step information:'/ &
1481             ' ----------------------------------'/)
1482201 FORMAT ( ' Timestep:          variable     maximum value: ',F6.3,' s', &
1483             '    CFL-factor: ',F4.2)
1484202 FORMAT ( ' Timestep:       dt = ',F6.3,' s'/)
1485203 FORMAT ( ' Start time:       ',F9.3,' s'/ &
1486             ' End time:         ',F9.3,' s')
1487204 FORMAT ( A,F9.3,' s')
1488205 FORMAT ( A,F9.3,' s',5X,'restart every',17X,F9.3,' s')
1489206 FORMAT (/' Time reached:     ',F9.3,' s'/ &
1490             ' CPU-time used:    ',F9.3,' s     per timestep:               ', &
1491               '  ',F9.3,' s'/                                                 &
1492             '                                   per second of simulated tim', &
1493               'e: ',F9.3,' s')
1494207 FORMAT ( A/' Coupling start time:',F9.3,' s')
1495250 FORMAT (//' Computational grid and domain size:'/ &
1496              ' ----------------------------------'// &
1497              ' Grid length:      dx =    ',F7.3,' m    dy =    ',F7.3, &
1498              ' m    dz =    ',F7.3,' m'/ &
1499              ' Domain size:       x = ',F10.3,' m     y = ',F10.3, &
1500              ' m  z(u) = ',F10.3,' m'/)
1501252 FORMAT (' dz constant up to ',F10.3,' m (k=',I4,'), then stretched by', &
1502              ' factor: ',F5.3/ &
1503            ' maximum dz not to be exceeded is dz_max = ',F10.3,' m'/)
1504254 FORMAT (' Number of gridpoints (x,y,z):  (0:',I4,', 0:',I4,', 0:',I4,')'/ &
1505            ' Subdomain size (x,y,z):        (  ',I4,',   ',I4,',   ',I4,')'/)
1506255 FORMAT (' Subdomains have equal size')
1507256 FORMAT (' Subdomains at the upper edges of the virtual processor grid ', &
1508              'have smaller sizes'/                                          &
1509            ' Size of smallest subdomain:    (  ',I4,',   ',I4,',   ',I4,')')
1510260 FORMAT (/' The model has a slope in x-direction. Inclination angle: ',F6.2,&
1511             ' degrees')
1512270 FORMAT (//' Topography informations:'/ &
1513              ' -----------------------'// &
1514              1X,'Topography: ',A)
1515271 FORMAT (  ' Building size (x/y/z) in m: ',F5.1,' / ',F5.1,' / ',F5.1/ &
1516              ' Horizontal index bounds (l/r/s/n): ',I4,' / ',I4,' / ',I4, &
1517                ' / ',I4)
1518272 FORMAT (  ' Single quasi-2D street canyon of infinite length in ',A, &
1519              ' direction' / &
1520              ' Canyon height: ', F6.2, 'm, ch = ', I4, '.'      / &
1521              ' Canyon position (',A,'-walls): cxl = ', I4,', cxr = ', I4, '.')
1522278 FORMAT (' Topography grid definition convention:'/ &
1523            ' cell edge (staggered grid points'/  &
1524            ' (u in x-direction, v in y-direction))' /)
1525279 FORMAT (' Topography grid definition convention:'/ &
1526            ' cell center (scalar grid points)' /)
1527280 FORMAT (//' Vegetation canopy (drag) model:'/ &
1528              ' ------------------------------'// &
1529              ' Canopy mode: ', A / &
1530              ' Canopy top: ',I4 / &
1531              ' Leaf drag coefficient: ',F6.2 /)
1532281 FORMAT (/ ' Scalar_exchange_coefficient: ',F6.2 / &
1533              ' Scalar concentration at leaf surfaces in kg/m**3: ',F6.2 /)
1534282 FORMAT (' Predefined constant heatflux at the top of the vegetation: ',F6.2,' K m/s')
1535283 FORMAT (/ ' Characteristic levels of the leaf area density:'// &
1536              ' Height:              ',A,'  m'/ &
1537              ' Leaf area density:   ',A,'  m**2/m**3'/ &
1538              ' Gradient:            ',A,'  m**2/m**4'/ &
1539              ' Gridpoint:           ',A)
1540               
1541300 FORMAT (//' Boundary conditions:'/ &
1542             ' -------------------'// &
1543             '                     p                    uv             ', &
1544             '                   pt'// &
1545             ' B. bound.: ',A/ &
1546             ' T. bound.: ',A)
1547301 FORMAT (/'                     ',A// &
1548             ' B. bound.: ',A/ &
1549             ' T. bound.: ',A)
1550303 FORMAT (/' Bottom surface fluxes are used in diffusion terms at k=1')
1551304 FORMAT (/' Top surface fluxes are used in diffusion terms at k=nzt')
1552305 FORMAT (//'    Prandtl-Layer between bottom surface and first ', &
1553               'computational u,v-level:'// &
1554             '       zp = ',F6.2,' m   z0 = ',F6.4,' m   kappa = ',F4.2/ &
1555             '       Rif value range:   ',F6.2,' <= rif <=',F6.2)
1556306 FORMAT ('       Predefined constant heatflux:   ',F9.6,' K m/s')
1557307 FORMAT ('       Heatflux has a random normal distribution')
1558308 FORMAT ('       Predefined surface temperature')
1559309 FORMAT ('       Predefined constant salinityflux:   ',F9.6,' psu m/s')
1560310 FORMAT (//'    1D-Model:'// &
1561             '       Rif value range:   ',F6.2,' <= rif <=',F6.2)
1562311 FORMAT ('       Predefined constant humidity flux: ',E10.3,' m/s')
1563312 FORMAT ('       Predefined surface humidity')
1564313 FORMAT ('       Predefined constant scalar flux: ',E10.3,' kg/(m**2 s)')
1565314 FORMAT ('       Predefined scalar value at the surface')
1566315 FORMAT ('       Humidity / scalar flux at top surface is 0.0')
1567316 FORMAT ('       Sensible heatflux and momentum flux from coupled ', &
1568                    'atmosphere model')
1569317 FORMAT (//' Lateral boundaries:'/ &
1570            '       left/right:  ',A/    &
1571            '       north/south: ',A)
1572318 FORMAT (/'       outflow damping layer width: ',I3,' gridpoints with km_', &
1573                    'max =',F5.1,' m**2/s')
1574319 FORMAT ('       turbulence recycling at inflow switched on'/ &
1575            '       width of recycling domain: ',F7.1,' m   grid index: ',I4/ &
1576            '       inflow damping height: ',F6.1,' m   width: ',F6.1,' m')
1577320 FORMAT ('       Predefined constant momentumflux:  u: ',F9.6,' m**2/s**2'/ &
1578            '                                          v: ',F9.6,' m**2/s**2')
1579325 FORMAT (//' List output:'/ &
1580             ' -----------'//  &
1581            '    1D-Profiles:'/    &
1582            '       Output every             ',F8.2,' s')
1583326 FORMAT ('       Time averaged over       ',F8.2,' s'/ &
1584            '       Averaging input every    ',F8.2,' s')
1585330 FORMAT (//' Data output:'/ &
1586             ' -----------'/)
1587331 FORMAT (/'    1D-Profiles:')
1588332 FORMAT (/'       ',A)
1589333 FORMAT ('       Output every             ',F8.2,' s',/ &
1590            '       Time averaged over       ',F8.2,' s'/ &
1591            '       Averaging input every    ',F8.2,' s')
1592334 FORMAT (/'    2D-Arrays',A,':')
1593335 FORMAT (/'       ',A2,'-cross-section  Arrays: ',A/ &
1594            '       Output every             ',F8.2,' s  ',A/ &
1595            '       Cross sections at ',A1,' = ',A/ &
1596            '       scalar-coordinates:   ',A,' m'/)
1597336 FORMAT (/'    3D-Arrays',A,':')
1598337 FORMAT (/'       Arrays: ',A/ &
1599            '       Output every             ',F8.2,' s  ',A/ &
1600            '       Upper output limit at    ',F8.2,' m  (GP ',I4,')'/)
1601338 FORMAT ('       Compressed data output'/ &
1602            '       Decimal precision: ',A/)
1603339 FORMAT ('       No output during initial ',F8.2,' s')
1604340 FORMAT (/'    Time series:')
1605341 FORMAT ('       Output every             ',F8.2,' s'/)
1606342 FORMAT (/'       ',A2,'-cross-section  Arrays: ',A/ &
1607            '       Output every             ',F8.2,' s  ',A/ &
1608            '       Time averaged over       ',F8.2,' s'/ &
1609            '       Averaging input every    ',F8.2,' s'/ &
1610            '       Cross sections at ',A1,' = ',A/ &
1611            '       scalar-coordinates:   ',A,' m'/)
1612343 FORMAT (/'       Arrays: ',A/ &
1613            '       Output every             ',F8.2,' s  ',A/ &
1614            '       Time averaged over       ',F8.2,' s'/ &
1615            '       Averaging input every    ',F8.2,' s'/ &
1616            '       Upper output limit at    ',F8.2,' m  (GP ',I4,')'/)
1617344 FORMAT ('       Output format: ',A/)
1618#if defined( __dvrp_graphics )
1619360 FORMAT ('    Plot-Sequence with dvrp-software:'/ &
1620            '       Output every      ',F7.1,' s'/ &
1621            '       Output mode:      ',A/ &
1622            '       Host / User:      ',A,' / ',A/ &
1623            '       Directory:        ',A// &
1624            '       The sequence contains:')
1625361 FORMAT (/'       Isosurface of "',A,'"    Threshold value: ', E12.3/ &
1626            '          Isosurface color: (',F4.2,',',F4.2,',',F4.2,') (R,G,B)')
1627362 FORMAT (/'       Slicer plane ',A/ &
1628            '       Slicer limits: [',F6.2,',',F6.2,']')
1629363 FORMAT (/'       Particles'/ &
1630            '          particle size:  ',F7.2,' m')
1631364 FORMAT ('          particle ',A,' controlled by "',A,'" with interval [', &
1632                       F6.2,',',F6.2,']')
1633365 FORMAT (/'       Groundplate color: (',F4.2,',',F4.2,',',F4.2,') (R,G,B)'/ &
1634            '       Superelevation along (x,y,z): (',F4.1,',',F4.1,',',F4.1, &
1635                     ')'/ &
1636            '       Clipping limits: from x = ',F9.1,' m to x = ',F9.1,' m'/ &
1637            '                        from y = ',F9.1,' m to y = ',F9.1,' m')
1638366 FORMAT (/'       Topography color: (',F4.2,',',F4.2,',',F4.2,') (R,G,B)')
1639367 FORMAT ('       Polygon reduction for topography: cluster_size = ', I1)
1640#endif
1641#if defined( __spectra )
1642370 FORMAT ('    Spectra:')
1643371 FORMAT ('       Output every ',F7.1,' s'/)
1644372 FORMAT ('       Arrays:     ', 10(A5,',')/                         &
1645            '       Directions: ', 10(A5,',')/                         &
1646            '       height levels  k = ', 20(I3,',')/                  &
1647            '                          ', 20(I3,',')/                  &
1648            '                          ', 20(I3,',')/                  &
1649            '                          ', 20(I3,',')/                  &
1650            '                          ', 19(I3,','),I3,'.'/           &
1651            '       height levels selected for standard plot:'/        &
1652            '                      k = ', 20(I3,',')/                  &
1653            '                          ', 20(I3,',')/                  &
1654            '                          ', 20(I3,',')/                  &
1655            '                          ', 20(I3,',')/                  &
1656            '                          ', 19(I3,','),I3,'.'/           &
1657            '       Time averaged over ', F7.1, ' s,' /                &
1658            '       Profiles for the time averaging are taken every ', &
1659                    F6.1,' s')
1660#endif
1661400 FORMAT (//' Physical quantities:'/ &
1662              ' -------------------'/)
1663410 FORMAT ('    Angular velocity    :   omega = ',E9.3,' rad/s'/  &
1664            '    Geograph. latitude  :   phi   = ',F4.1,' degr'/   &
1665            '    Coriolis parameter  :   f     = ',F9.6,' 1/s'/    &
1666            '                            f*    = ',F9.6,' 1/s')
1667411 FORMAT (/'    Gravity             :   g     = ',F4.1,' m/s**2')
1668412 FORMAT (/'    Reference density in buoyancy terms: ',F8.3,' kg/m**3')
1669413 FORMAT (/'    Reference temperature in buoyancy terms: ',F8.4,' K')
1670415 FORMAT (/'    Cloud physics parameters:'/ &
1671             '    ------------------------'/)
1672416 FORMAT ('        Surface pressure   :   p_0   = ',F7.2,' hPa'/      &
1673            '        Gas constant       :   R     = ',F5.1,' J/(kg K)'/ &
1674            '        Density of air     :   rho_0 = ',F5.3,' kg/m**3'/  &
1675            '        Specific heat cap. :   c_p   = ',F6.1,' J/(kg K)'/ &
1676            '        Vapourization heat :   L_v   = ',E8.2,' J/kg')
1677420 FORMAT (/'    Characteristic levels of the initial temperature profile:'// &
1678            '       Height:        ',A,'  m'/ &
1679            '       Temperature:   ',A,'  K'/ &
1680            '       Gradient:      ',A,'  K/100m'/ &
1681            '       Gridpoint:     ',A)
1682421 FORMAT (/'    Characteristic levels of the initial humidity profile:'// &
1683            '       Height:      ',A,'  m'/ &
1684            '       Humidity:    ',A,'  kg/kg'/ &
1685            '       Gradient:    ',A,'  (kg/kg)/100m'/ &
1686            '       Gridpoint:   ',A)
1687422 FORMAT (/'    Characteristic levels of the initial scalar profile:'// &
1688            '       Height:                  ',A,'  m'/ &
1689            '       Scalar concentration:    ',A,'  kg/m**3'/ &
1690            '       Gradient:                ',A,'  (kg/m**3)/100m'/ &
1691            '       Gridpoint:               ',A)
1692423 FORMAT (/'    Characteristic levels of the geo. wind component ug:'// &
1693            '       Height:      ',A,'  m'/ &
1694            '       ug:          ',A,'  m/s'/ &
1695            '       Gradient:    ',A,'  1/100s'/ &
1696            '       Gridpoint:   ',A)
1697424 FORMAT (/'    Characteristic levels of the geo. wind component vg:'// &
1698            '       Height:      ',A,'  m'/ &
1699            '       vg:          ',A,'  m/s'/ &
1700            '       Gradient:    ',A,'  1/100s'/ &
1701            '       Gridpoint:   ',A)
1702425 FORMAT (/'    Characteristic levels of the initial salinity profile:'// &
1703            '       Height:     ',A,'  m'/ &
1704            '       Salinity:   ',A,'  psu'/ &
1705            '       Gradient:   ',A,'  psu/100m'/ &
1706            '       Gridpoint:  ',A)
1707450 FORMAT (//' LES / Turbulence quantities:'/ &
1708              ' ---------------------------'/)
1709451 FORMAT ('   Diffusion coefficients are constant:'/ &
1710            '   Km = ',F6.2,' m**2/s   Kh = ',F6.2,' m**2/s   Pr = ',F5.2)
1711452 FORMAT ('   Mixing length is limited to the Prandtl mixing lenth.')
1712453 FORMAT ('   Mixing length is limited to ',F4.2,' * z')
1713454 FORMAT ('   TKE is not allowed to fall below ',E9.2,' (m/s)**2')
1714455 FORMAT ('   initial TKE is prescribed as ',E9.2,' (m/s)**2')
1715470 FORMAT (//' Actions during the simulation:'/ &
1716              ' -----------------------------'/)
1717471 FORMAT ('    Disturbance impulse (u,v) every :   ',F6.2,' s'/            &
1718            '    Disturbance amplitude           :     ',F4.2, ' m/s'/       &
1719            '    Lower disturbance level         : ',F8.2,' m (GP ',I4,')'/  &
1720            '    Upper disturbance level         : ',F8.2,' m (GP ',I4,')')
1721472 FORMAT ('    Disturbances continued during the run from i/j =',I4, &
1722                 ' to i/j =',I4)
1723473 FORMAT ('    Disturbances cease as soon as the disturbance energy exceeds',&
1724                 1X,F5.3, ' m**2/s**2')
1725474 FORMAT ('    Random number generator used    : ',A/)
1726475 FORMAT ('    The surface temperature is increased (or decreased, ', &
1727                 'respectively, if'/ &
1728            '    the value is negative) by ',F5.2,' K at the beginning of the',&
1729                 ' 3D-simulation'/)
1730476 FORMAT ('    The surface humidity is increased (or decreased, ',&
1731                 'respectively, if the'/ &
1732            '    value is negative) by ',E8.1,' kg/kg at the beginning of', &
1733                 ' the 3D-simulation'/)
1734477 FORMAT ('    The scalar value is increased at the surface (or decreased, ',&
1735                 'respectively, if the'/ &
1736            '    value is negative) by ',E8.1,' kg/m**3 at the beginning of', &
1737                 ' the 3D-simulation'/)
1738480 FORMAT ('    Particles:'/ &
1739            '    ---------'// &
1740            '       Particle advection is active (switched on at t = ', F7.1, &
1741                    ' s)'/ &
1742            '       Start of new particle generations every  ',F6.1,' s'/ &
1743            '       Boundary conditions: left/right: ', A, ' north/south: ', A/&
1744            '                            bottom:     ', A, ' top:         ', A/&
1745            '       Maximum particle age:                 ',F9.1,' s'/ &
1746            '       Advection stopped at t = ',F9.1,' s'/ &
1747            '       Particles are sorted every ',F9.1,' s'/)
1748481 FORMAT ('       Particles have random start positions'/)
1749482 FORMAT ('          Particles are advected only horizontally'/)
1750483 FORMAT ('       Particles have tails with a maximum of ',I3,' points')
1751484 FORMAT ('            Number of tails of the total domain: ',I10/ &
1752            '            Minimum distance between tailpoints: ',F8.2,' m'/ &
1753            '            Maximum age of the end of the tail:  ',F8.2,' s')
1754485 FORMAT ('       Particle data are written on file every ', F9.1, ' s')
1755486 FORMAT ('       Particle statistics are written on file'/)
1756487 FORMAT ('       Number of particle groups: ',I2/)
1757488 FORMAT ('       SGS velocity components are used for particle advection'/ &
1758            '          minimum timestep for advection: ', F7.5/)
1759489 FORMAT ('       Number of particles simultaneously released at each ', &
1760                    'point: ', I5/)
1761490 FORMAT ('       Particle group ',I2,':'/ &
1762            '          Particle radius: ',E10.3, 'm')
1763491 FORMAT ('          Particle inertia is activated'/ &
1764            '             density_ratio (rho_fluid/rho_particle) = ',F5.3/)
1765492 FORMAT ('          Particles are advected only passively (no inertia)'/)
1766493 FORMAT ('          Boundaries of particle source: x:',F8.1,' - ',F8.1,' m'/&
1767            '                                         y:',F8.1,' - ',F8.1,' m'/&
1768            '                                         z:',F8.1,' - ',F8.1,' m'/&
1769            '          Particle distances:  dx = ',F8.1,' m  dy = ',F8.1, &
1770                       ' m  dz = ',F8.1,' m'/)
1771494 FORMAT ('       Output of particle time series in NetCDF format every ', &
1772                    F8.2,' s'/)
1773495 FORMAT ('       Number of particles in total domain: ',I10/)
1774500 FORMAT (//' 1D-Model parameters:'/                           &
1775              ' -------------------'//                           &
1776            '    Simulation time:                   ',F8.1,' s'/ &
1777            '    Run-controll output every:         ',F8.1,' s'/ &
1778            '    Vertical profile output every:     ',F8.1,' s'/ &
1779            '    Mixing length calculation:         ',A/         &
1780            '    Dissipation calculation:           ',A/)
1781502 FORMAT ('    Damping layer starts from ',F7.1,' m (GP ',I4,')'/)
1782
1783
1784 END SUBROUTINE header
Note: See TracBrowser for help on using the repository browser.