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

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

New:
---

Changed:


PALM can be generally installed on any kind of Linux-, IBM-AIX-, or NEC-SX-system by adding appropriate settings to the configuration file.

Scripts are also running under the public domain ksh.

All system relevant compile and link options as well as the host identifier (local_host) are specified in the configuration file.

Filetransfer by ftp removed (options -f removed from mrun and mbuild).

Call of (system-)FLUSH routine moved to new routine local_flush.

return_addres and return_username are read from ENVPAR-NAMELIST-file instead of using local_getenv.

Preprocessor strings for different linux clusters changed to "lc", some preprocessor directives renamed (new: intel_openmp_bug), preprocessor directives for old systems removed

advec_particles, check_open, cpu_log, cpu_statistics, data_output_dvrp, flow_statistics, header, init_dvrp, init_particles, init_1d_model, init_dvrp, init_pegrid, local_getenv, local_system, local_tremain, local_tremain_ini, modules, palm, parin, run_control

new:
local_flush

mbuild, mrun

Errors:


  • Property svn:keywords set to Id
File size: 55.0 KB
Line 
1 SUBROUTINE header
2
3!------------------------------------------------------------------------------!
4! Actual revisions:
5! -----------------
6!
7!
8! Former revisions:
9! -----------------
10! $Id: header.f90 83 2007-04-19 16:27:07Z raasch $
11!
12! 82 2007-04-16 15:40:52Z raasch
13! Preprocessor strings for different linux clusters changed to "lc",
14! routine local_flush is used for buffer flushing
15!
16! 76 2007-03-29 00:58:32Z raasch
17! Output of netcdf_64bit_3d, particles-package is now part of the default code,
18! output of the loop optimization method, moisture renamed humidity,
19! output of subversion revision number
20!
21! 19 2007-02-23 04:53:48Z raasch
22! Output of scalar flux applied at top boundary
23!
24! RCS Log replace by Id keyword, revision history cleaned up
25!
26! Revision 1.63  2006/08/22 13:53:13  raasch
27! Output of dz_max
28!
29! Revision 1.1  1997/08/11 06:17:20  raasch
30! Initial revision
31!
32!
33! Description:
34! ------------
35! Writing a header with all important informations about the actual run.
36! This subroutine is called three times, two times at the beginning
37! (writing information on files RUN_CONTROL and HEADER) and one time at the
38! end of the run, then writing additional information about CPU-usage on file
39! header.
40!------------------------------------------------------------------------------!
41
42    USE arrays_3d
43    USE control_parameters
44    USE cloud_parameters
45    USE cpulog
46    USE dvrp_variables
47    USE grid_variables
48    USE indices
49    USE model_1d
50    USE particle_attributes
51    USE pegrid
52    USE spectrum
53
54    IMPLICIT NONE
55
56    CHARACTER (LEN=1)  ::  prec
57    CHARACTER (LEN=2)  ::  do2d_mode
58    CHARACTER (LEN=5)  ::  section_chr
59    CHARACTER (LEN=9)  ::  time_to_string
60    CHARACTER (LEN=10) ::  coor_chr, host_chr
61    CHARACTER (LEN=16) ::  begin_chr
62    CHARACTER (LEN=21) ::  ver_rev
63    CHARACTER (LEN=40) ::  output_format
64    CHARACTER (LEN=70) ::  char1, char2, coordinates, gradients, dopr_chr, &
65                           do2d_xy, do2d_xz, do2d_yz, do3d_chr, &
66                           run_classification, slices, temperatures, &
67                           ugcomponent, vgcomponent
68    CHARACTER (LEN=85) ::  roben, runten
69
70    INTEGER ::  av, bh, blx, bly, bxl, bxr, byn, bys, i, ihost, io, j, l, ll
71    REAL    ::  cpuseconds_per_simulated_second
72
73!
74!-- Open the output file. At the end of the simulation, output is directed
75!-- to unit 19.
76    IF ( ( runnr == 0 .OR. force_print_header )  .AND. &
77         .NOT. simulated_time_at_begin /= simulated_time )  THEN
78       io = 15   !  header output on file RUN_CONTROL
79    ELSE
80       io = 19   !  header output on file HEADER
81    ENDIF
82    CALL check_open( io )
83
84!
85!-- At the end of the run, output file (HEADER) will be rewritten with
86!-- new informations
87    IF ( io == 19 .AND. simulated_time_at_begin /= simulated_time ) REWIND( 19 )
88
89!
90!-- Determine kind of model run
91    IF ( TRIM( initializing_actions ) == 'read_restart_data' )  THEN
92       run_classification = '3D - restart run'
93    ELSE
94       IF ( INDEX( initializing_actions, 'set_constant_profiles' ) /= 0 )  THEN
95          run_classification = '3D - run without 1D - prerun'
96       ELSEIF ( INDEX(initializing_actions, 'set_1d-model_profiles') /= 0 ) THEN
97          run_classification = '3D - run with 1D - prerun'
98       ELSE
99          PRINT*,'+++ header:  unknown action(s): ',initializing_actions
100       ENDIF
101    ENDIF
102
103!
104!-- Run-identification, date, time, host
105    host_chr = host(1:10)
106    ver_rev = TRIM( version ) // '  ' // TRIM( revision )
107    WRITE ( io, 100 )  ver_rev, TRIM( run_classification ), run_date, &
108                       run_identifier, run_time, runnr, ADJUSTR( host_chr )
109#if defined( __parallel )
110    IF ( npex == -1  .AND.  pdims(2) /= 1 )  THEN
111       char1 = 'calculated'
112    ELSEIF ( ( host(1:3) == 'ibm'  .OR.  host(1:3) == 'nec'  .OR.  &
113               host(1:2) == 'lc' )  .AND.                          &
114             npex == -1  .AND.  pdims(2) == 1 )  THEN
115       char1 = 'forced'
116    ELSE
117       char1 = 'predefined'
118    ENDIF
119    IF ( threads_per_task == 1 )  THEN
120       WRITE ( io, 101 )  numprocs, pdims(1), pdims(2), TRIM( char1 )
121    ELSE
122       WRITE ( io, 102 )  numprocs*threads_per_task, numprocs, &
123                          threads_per_task, pdims(1), pdims(2), TRIM( char1 )
124    ENDIF
125    IF ( ( host(1:3) == 'ibm'  .OR.  host(1:3) == 'nec'  .OR.    &
126           host(1:2) == 'lc'   .OR.  host(1:3) == 'dec' )  .AND. &
127         npex == -1  .AND.  pdims(2) == 1 )                      &
128    THEN
129       WRITE ( io, 104 )
130    ELSEIF ( pdims(2) == 1 )  THEN
131       WRITE ( io, 105 )  'x'
132    ELSEIF ( pdims(1) == 1 )  THEN
133       WRITE ( io, 105 )  'y'
134    ENDIF
135    IF ( use_seperate_pe_for_dvrp_output )  WRITE ( io, 103 )
136#endif
137    WRITE ( io, 99 )
138
139!
140!-- Numerical schemes
141    WRITE ( io, 110 )
142    IF ( psolver(1:7) == 'poisfft' )  THEN
143       WRITE ( io, 111 )  TRIM( fft_method )
144       IF ( psolver == 'poisfft_hybrid' )  WRITE ( io, 138 )
145    ELSEIF ( psolver == 'sor' )  THEN
146       WRITE ( io, 112 )  nsor_ini, nsor, omega_sor
147    ELSEIF ( psolver == 'multigrid' )  THEN
148       WRITE ( io, 135 )  cycle_mg, maximum_grid_level, ngsrb
149       IF ( mg_cycles == -1 )  THEN
150          WRITE ( io, 140 )  residual_limit
151       ELSE
152          WRITE ( io, 141 )  mg_cycles
153       ENDIF
154       IF ( mg_switch_to_pe0_level == 0 )  THEN
155          WRITE ( io, 136 )  nxr_mg(1)-nxl_mg(1)+1, nyn_mg(1)-nys_mg(1)+1, &
156                             nzt_mg(1)
157       ELSE
158          WRITE ( io, 137 )  mg_switch_to_pe0_level,            &
159                             mg_loc_ind(2,0)-mg_loc_ind(1,0)+1, &
160                             mg_loc_ind(4,0)-mg_loc_ind(3,0)+1, &
161                             nzt_mg(mg_switch_to_pe0_level),    &
162                             nxr_mg(1)-nxl_mg(1)+1, nyn_mg(1)-nys_mg(1)+1, &
163                             nzt_mg(1)
164       ENDIF
165    ENDIF
166    IF ( call_psolver_at_all_substeps  .AND. timestep_scheme(1:5) == 'runge' ) &
167    THEN
168       WRITE ( io, 142 )
169    ENDIF
170
171    IF ( momentum_advec == 'pw-scheme' )  THEN
172       WRITE ( io, 113 )
173    ELSE
174       WRITE ( io, 114 )
175       IF ( cut_spline_overshoot )  WRITE ( io, 124 )
176       IF ( overshoot_limit_u /= 0.0  .OR.  overshoot_limit_v /= 0.0  .OR. &
177            overshoot_limit_w /= 0.0 )  THEN
178          WRITE ( io, 127 )  overshoot_limit_u, overshoot_limit_v, &
179                             overshoot_limit_w
180       ENDIF
181       IF ( ups_limit_u /= 0.0  .OR.  ups_limit_v /= 0.0  .OR. &
182            ups_limit_w /= 0.0 )                               &
183       THEN
184          WRITE ( io, 125 )  ups_limit_u, ups_limit_v, ups_limit_w
185       ENDIF
186       IF ( long_filter_factor /= 0.0 )  WRITE ( io, 115 )  long_filter_factor
187    ENDIF
188    IF ( scalar_advec == 'pw-scheme' )  THEN
189       WRITE ( io, 116 )
190    ELSEIF ( scalar_advec == 'ups-scheme' )  THEN
191       WRITE ( io, 117 )
192       IF ( cut_spline_overshoot )  WRITE ( io, 124 )
193       IF ( overshoot_limit_e /= 0.0  .OR.  overshoot_limit_pt /= 0.0 )  THEN
194          WRITE ( io, 128 )  overshoot_limit_e, overshoot_limit_pt
195       ENDIF
196       IF ( ups_limit_e /= 0.0  .OR.  ups_limit_pt /= 0.0 )  THEN
197          WRITE ( io, 126 )  ups_limit_e, ups_limit_pt
198       ENDIF
199    ELSE
200       WRITE ( io, 118 )
201    ENDIF
202
203    WRITE ( io, 139 )  TRIM( loop_optimization )
204
205    IF ( galilei_transformation )  THEN
206       IF ( use_ug_for_galilei_tr )  THEN
207          char1 = 'geostrophic wind'
208       ELSE
209          char1 = 'mean wind in model domain'
210       ENDIF
211       IF ( simulated_time_at_begin == simulated_time )  THEN
212          char2 = 'at the start of the run'
213       ELSE
214          char2 = 'at the end of the run'
215       ENDIF
216       WRITE ( io, 119 )  TRIM( char1 ), TRIM( char2 ), &
217                          advected_distance_x/1000.0, advected_distance_y/1000.0
218    ENDIF
219    IF ( timestep_scheme == 'leapfrog' )  THEN
220       WRITE ( io, 120 )
221    ELSEIF ( timestep_scheme == 'leapfrog+euler' )  THEN
222       WRITE ( io, 121 )
223    ELSE
224       WRITE ( io, 122 )  timestep_scheme
225    ENDIF
226    IF ( rayleigh_damping_factor /= 0.0 )  THEN
227       WRITE ( io, 123 )  rayleigh_damping_height, rayleigh_damping_factor
228    ENDIF
229    IF ( humidity )  THEN
230       IF ( .NOT. cloud_physics )  THEN
231          WRITE ( io, 129 )
232       ELSE
233          WRITE ( io, 130 )
234          WRITE ( io, 131 )
235          IF ( radiation )      WRITE ( io, 132 )
236          IF ( precipitation )  WRITE ( io, 133 )
237       ENDIF
238    ENDIF
239    IF ( passive_scalar )  WRITE ( io, 134 )
240    IF ( conserve_volume_flow )  WRITE ( io, 150 )
241    WRITE ( io, 99 )
242
243!
244!-- Runtime and timestep informations
245    WRITE ( io, 200 )
246    IF ( .NOT. dt_fixed )  THEN
247       WRITE ( io, 201 )  dt_max, cfl_factor
248    ELSE
249       WRITE ( io, 202 )  dt
250    ENDIF
251    WRITE ( io, 203 )  simulated_time_at_begin, end_time
252
253    IF ( time_restart /= 9999999.9  .AND. &
254         simulated_time_at_begin == simulated_time )  THEN
255       IF ( dt_restart == 9999999.9 )  THEN
256          WRITE ( io, 204 )  ' Restart at:       ',time_restart
257       ELSE
258          WRITE ( io, 205 )  ' Restart at:       ',time_restart, dt_restart
259       ENDIF
260    ENDIF
261
262    IF ( simulated_time_at_begin /= simulated_time )  THEN
263       i = MAX ( log_point_s(10)%counts, 1 )
264       IF ( ( simulated_time - simulated_time_at_begin ) == 0.0 )  THEN
265          cpuseconds_per_simulated_second = 0.0
266       ELSE
267          cpuseconds_per_simulated_second = log_point_s(10)%sum / &
268                                            ( simulated_time -    &
269                                              simulated_time_at_begin )
270       ENDIF
271       WRITE ( io, 206 )  simulated_time, log_point_s(10)%sum, &
272                          log_point_s(10)%sum / REAL( i ),     &
273                          cpuseconds_per_simulated_second
274       IF ( time_restart /= 9999999.9  .AND.  time_restart < end_time )  THEN
275          IF ( dt_restart == 9999999.9 )  THEN
276             WRITE ( io, 204 )  ' Next restart at:  ',time_restart
277          ELSE
278             WRITE ( io, 205 )  ' Next restart at:  ',time_restart, dt_restart
279          ENDIF
280       ENDIF
281    ENDIF
282
283!
284!-- Computational grid
285    WRITE ( io, 250 )  dx, dy, dz, (nx+1)*dx, (ny+1)*dy, zu(nzt+1)
286    IF ( dz_stretch_level_index < nzt+1 )  THEN
287       WRITE ( io, 252 )  dz_stretch_level, dz_stretch_level_index, &
288                          dz_stretch_factor, dz_max
289    ENDIF
290    WRITE ( io, 254 )  nx, ny, nzt+1, MIN( nnx, nx+1 ), MIN( nny, ny+1 ), &
291                       MIN( nnz+2, nzt+2 )
292    IF ( numprocs > 1 )  THEN
293       IF ( nxa == nx  .AND.  nya == ny  .AND.  nza == nz )  THEN
294          WRITE ( io, 255 )
295       ELSE
296          WRITE ( io, 256 )  nnx-(nxa-nx), nny-(nya-ny), nzt+2
297       ENDIF
298    ENDIF
299    IF ( sloping_surface )  WRITE ( io, 260 )  alpha_surface
300
301!
302!-- Topography
303    WRITE ( io, 270 )  topography
304    SELECT CASE ( TRIM( topography ) )
305
306       CASE ( 'flat' )
307          ! no actions necessary
308
309       CASE ( 'single_building' )
310          blx = INT( building_length_x / dx )
311          bly = INT( building_length_y / dy )
312          bh  = INT( building_height / dz )
313
314          IF ( building_wall_left == 9999999.9 )  THEN
315             building_wall_left = ( nx + 1 - blx ) / 2 * dx
316          ENDIF
317          bxl = INT ( building_wall_left / dx + 0.5 )
318          bxr = bxl + blx
319
320          IF ( building_wall_south == 9999999.9 )  THEN
321             building_wall_south = ( ny + 1 - bly ) / 2 * dy
322          ENDIF
323          bys = INT ( building_wall_south / dy + 0.5 )
324          byn = bys + bly
325
326          WRITE ( io, 271 )  building_length_x, building_length_y, &
327                             building_height, bxl, bxr, bys, byn
328
329    END SELECT
330
331!
332!-- Boundary conditions
333    IF ( ibc_p_b == 0 )  THEN
334       runten = 'p(0)     = 0      |'
335    ELSEIF ( ibc_p_b == 1 )  THEN
336       runten = 'p(0)     = p(1)   |'
337    ELSE
338       runten = 'p(0)     = p(1) +R|'
339    ENDIF
340    IF ( ibc_p_t == 0 )  THEN
341       roben  = 'p(nzt+1) = 0      |'
342    ELSE
343       roben  = 'p(nzt+1) = p(nzt) |'
344    ENDIF
345
346    IF ( ibc_uv_b == 0 )  THEN
347       runten = TRIM( runten ) // ' uv(0)     = -uv(1)                |'
348    ELSE
349       runten = TRIM( runten ) // ' uv(0)     = uv(1)                 |'
350    ENDIF
351    IF ( ibc_uv_t == 0 )  THEN
352       roben  = TRIM( roben  ) // ' uv(nzt+1) = ug(nzt+1), vg(nzt+1)  |'
353    ELSE
354       roben  = TRIM( roben  ) // ' uv(nzt+1) = uv(nzt)               |'
355    ENDIF
356
357    IF ( ibc_pt_b == 0 )  THEN
358       runten = TRIM( runten ) // ' pt(0)   = pt_surface'
359    ELSE
360       runten = TRIM( runten ) // ' pt(0)   = pt(1)'
361    ENDIF
362    IF ( ibc_pt_t == 0 )  THEN
363       roben  = TRIM( roben  ) // ' pt(nzt+1) = pt_top'
364    ELSEIF( ibc_pt_t == 1 )  THEN
365       roben  = TRIM( roben  ) // ' pt(nzt+1) = pt(nzt)'
366    ELSEIF( ibc_pt_t == 2 )  THEN
367       roben  = TRIM( roben  ) // ' pt(nzt+1) = pt(nzt) + dpt/dz_ini'
368    ENDIF
369
370    WRITE ( io, 300 )  runten, roben
371
372    IF ( .NOT. constant_diffusion )  THEN
373       IF ( ibc_e_b == 1 )  THEN
374          runten = 'e(0)     = e(1)'
375       ELSE
376          runten = 'e(0)     = e(1) = (u*/0.1)**2'
377       ENDIF
378       roben = 'e(nzt+1) = e(nzt) = e(nzt-1)'
379
380       WRITE ( io, 301 )  runten, roben       
381
382    ENDIF
383
384    IF ( humidity  .OR.  passive_scalar )  THEN
385       IF ( humidity )  THEN
386          IF ( ibc_q_b == 0 )  THEN
387             runten = 'q(0)     = q_surface'
388          ELSE
389             runten = 'q(0)     = q(1)'
390          ENDIF
391          IF ( ibc_q_t == 0 )  THEN
392             roben =  'q(nzt)   = q_top'
393          ELSE
394             roben =  'q(nzt)   = q(nzt-1) + dq/dz'
395          ENDIF
396       ELSE
397          IF ( ibc_q_b == 0 )  THEN
398             runten = 's(0)     = s_surface'
399          ELSE
400             runten = 's(0)     = s(1)'
401          ENDIF
402          IF ( ibc_q_t == 0 )  THEN
403             roben =  's(nzt)   = s_top'
404          ELSE
405             roben =  's(nzt)   = s(nzt-1) + ds/dz'
406          ENDIF
407       ENDIF
408
409       WRITE ( io, 302 ) runten, roben
410
411    ENDIF
412
413    IF ( use_surface_fluxes )  THEN
414       WRITE ( io, 303 )
415       IF ( constant_heatflux )  THEN
416          WRITE ( io, 306 )  surface_heatflux
417          IF ( random_heatflux )  WRITE ( io, 307 )
418       ENDIF
419       IF ( humidity  .AND.  constant_waterflux )  THEN
420          WRITE ( io, 311 ) surface_waterflux
421       ENDIF
422       IF ( passive_scalar  .AND.  constant_waterflux )  THEN
423          WRITE ( io, 313 ) surface_waterflux
424       ENDIF
425    ENDIF
426
427    IF ( use_top_fluxes )  THEN
428       WRITE ( io, 304 )
429       IF ( constant_top_heatflux )  THEN
430          WRITE ( io, 306 )  top_heatflux
431       ENDIF
432       IF ( humidity  .OR.  passive_scalar )  THEN
433          WRITE ( io, 315 )
434       ENDIF
435    ENDIF
436
437    IF ( prandtl_layer )  THEN
438       WRITE ( io, 305 )  zu(1), roughness_length, kappa, rif_min, rif_max
439       IF ( .NOT. constant_heatflux )  WRITE ( io, 308 )
440       IF ( humidity  .AND.  .NOT. constant_waterflux )  THEN
441          WRITE ( io, 312 )
442       ENDIF
443       IF ( passive_scalar  .AND.  .NOT. constant_waterflux )  THEN
444          WRITE ( io, 314 )
445       ENDIF
446    ELSE
447       IF ( INDEX(initializing_actions, 'set_1d-model_profiles') /= 0 )  THEN
448          WRITE ( io, 310 )  rif_min, rif_max
449       ENDIF
450    ENDIF
451
452    WRITE ( io, 317 )  bc_lr, bc_ns
453    IF ( bc_lr /= 'cyclic'  .OR.  bc_ns /= 'cyclic' )  THEN
454       WRITE ( io, 318 )  outflow_damping_width, km_damp_max
455    ENDIF
456
457!
458!-- Listing of 1D-profiles
459    WRITE ( io, 320 )  dt_dopr_listing
460    IF ( averaging_interval_pr /= 0.0 )  THEN
461       WRITE ( io, 321 )  averaging_interval_pr, dt_averaging_input_pr
462    ENDIF
463
464!
465!-- DATA output
466    WRITE ( io, 330 )
467    IF ( averaging_interval_pr /= 0.0 )  THEN
468       WRITE ( io, 321 )  averaging_interval_pr, dt_averaging_input_pr
469    ENDIF
470
471!
472!-- 1D-profiles
473    dopr_chr = 'Profile:'
474    IF ( dopr_n /= 0 )  THEN
475       WRITE ( io, 331 )
476
477       output_format = ''
478       IF ( netcdf_output )  THEN
479          IF ( netcdf_64bit )  THEN
480             output_format = 'netcdf (64 bit offset)'
481          ELSE
482             output_format = 'netcdf'
483          ENDIF
484       ENDIF
485       IF ( profil_output )  THEN
486          IF ( netcdf_output )  THEN
487             output_format = TRIM( output_format ) // ' and profil'
488          ELSE
489             output_format = 'profil'
490          ENDIF
491       ENDIF
492       WRITE ( io, 345 )  output_format
493
494       DO  i = 1, dopr_n
495          dopr_chr = TRIM( dopr_chr ) // ' ' // TRIM( data_output_pr(i) ) // ','
496          IF ( LEN_TRIM( dopr_chr ) >= 60 )  THEN
497             WRITE ( io, 332 )  dopr_chr
498             dopr_chr = '       :'
499          ENDIF
500       ENDDO
501
502       IF ( dopr_chr /= '' )  THEN
503          WRITE ( io, 332 )  dopr_chr
504       ENDIF
505       WRITE ( io, 333 )  dt_dopr, averaging_interval_pr, dt_averaging_input_pr
506       IF ( skip_time_dopr /= 0.0 )  WRITE ( io, 339 )  skip_time_dopr
507    ENDIF
508
509!
510!-- 2D-arrays
511    DO  av = 0, 1
512
513       i = 1
514       do2d_xy = ''
515       do2d_xz = ''
516       do2d_yz = ''
517       DO  WHILE ( do2d(av,i) /= ' ' )
518
519          l = MAX( 2, LEN_TRIM( do2d(av,i) ) )
520          do2d_mode = do2d(av,i)(l-1:l)
521
522          SELECT CASE ( do2d_mode )
523             CASE ( 'xy' )
524                ll = LEN_TRIM( do2d_xy )
525                do2d_xy = do2d_xy(1:ll) // ' ' // do2d(av,i)(1:l-3) // ','
526             CASE ( 'xz' )
527                ll = LEN_TRIM( do2d_xz )
528                do2d_xz = do2d_xz(1:ll) // ' ' // do2d(av,i)(1:l-3) // ','
529             CASE ( 'yz' )
530                ll = LEN_TRIM( do2d_yz )
531                do2d_yz = do2d_yz(1:ll) // ' ' // do2d(av,i)(1:l-3) // ','
532          END SELECT
533
534          i = i + 1
535
536       ENDDO
537
538       IF ( ( ( do2d_xy /= ''  .AND.  section(1,1) /= -9999 )  .OR.    &
539              ( do2d_xz /= ''  .AND.  section(1,2) /= -9999 )  .OR.    &
540              ( do2d_yz /= ''  .AND.  section(1,3) /= -9999 ) )  .AND. &
541            ( netcdf_output  .OR.  iso2d_output ) )  THEN
542
543          IF (  av == 0 )  THEN
544             WRITE ( io, 334 )  ''
545          ELSE
546             WRITE ( io, 334 )  '(time-averaged)'
547          ENDIF
548
549          IF ( do2d_at_begin )  THEN
550             begin_chr = 'and at the start'
551          ELSE
552             begin_chr = ''
553          ENDIF
554
555          output_format = ''
556          IF ( netcdf_output )  THEN
557             IF ( netcdf_64bit )  THEN
558                output_format = 'netcdf (64 bit offset)'
559             ELSE
560                output_format = 'netcdf'
561             ENDIF
562          ENDIF
563          IF ( iso2d_output )  THEN
564             IF ( netcdf_output )  THEN
565                output_format = TRIM( output_format ) // ' and iso2d'
566             ELSE
567                output_format = 'iso2d'
568             ENDIF
569          ENDIF
570          WRITE ( io, 345 )  output_format
571
572          IF ( do2d_xy /= ''  .AND.  section(1,1) /= -9999 )  THEN
573             i = 1
574             slices = '/'
575             coordinates = '/'
576!
577!--          Building strings with index and coordinate informations of the
578!--          slices
579             DO  WHILE ( section(i,1) /= -9999 )
580
581                WRITE (section_chr,'(I5)')  section(i,1)
582                section_chr = ADJUSTL( section_chr )
583                slices = TRIM( slices ) // TRIM( section_chr ) // '/'
584
585                WRITE (coor_chr,'(F10.1)')  zu(section(i,1))
586                coor_chr = ADJUSTL( coor_chr )
587                coordinates = TRIM( coordinates ) // TRIM( coor_chr ) // '/'
588
589                i = i + 1
590             ENDDO
591             IF ( av == 0 )  THEN
592                WRITE ( io, 335 )  'XY', do2d_xy, dt_do2d_xy, &
593                                   TRIM( begin_chr ), 'k', TRIM( slices ), &
594                                   TRIM( coordinates )
595                IF ( skip_time_do2d_xy /= 0.0 )  THEN
596                   WRITE ( io, 339 )  skip_time_do2d_xy
597                ENDIF
598             ELSE
599                WRITE ( io, 342 )  'XY', do2d_xy, dt_data_output_av, &
600                                   TRIM( begin_chr ), averaging_interval, &
601                                   dt_averaging_input, 'k', TRIM( slices ), &
602                                   TRIM( coordinates )
603                IF ( skip_time_data_output_av /= 0.0 )  THEN
604                   WRITE ( io, 339 )  skip_time_data_output_av
605                ENDIF
606             ENDIF
607
608          ENDIF
609
610          IF ( do2d_xz /= ''  .AND.  section(1,2) /= -9999 )  THEN
611             i = 1
612             slices = '/'
613             coordinates = '/'
614!
615!--          Building strings with index and coordinate informations of the
616!--          slices
617             DO  WHILE ( section(i,2) /= -9999 )
618
619                WRITE (section_chr,'(I5)')  section(i,2)
620                section_chr = ADJUSTL( section_chr )
621                slices = TRIM( slices ) // TRIM( section_chr ) // '/'
622
623                WRITE (coor_chr,'(F10.1)')  section(i,2) * dy
624                coor_chr = ADJUSTL( coor_chr )
625                coordinates = TRIM( coordinates ) // TRIM( coor_chr ) // '/'
626
627                i = i + 1
628             ENDDO
629             IF ( av == 0 )  THEN
630                WRITE ( io, 335 )  'XZ', do2d_xz, dt_do2d_xz, &
631                                   TRIM( begin_chr ), 'j', TRIM( slices ), &
632                                   TRIM( coordinates )
633                IF ( skip_time_do2d_xz /= 0.0 )  THEN
634                   WRITE ( io, 339 )  skip_time_do2d_xz
635                ENDIF
636             ELSE
637                WRITE ( io, 342 )  'XZ', do2d_xz, dt_data_output_av, &
638                                   TRIM( begin_chr ), averaging_interval, &
639                                   dt_averaging_input, 'j', TRIM( slices ), &
640                                   TRIM( coordinates )
641                IF ( skip_time_data_output_av /= 0.0 )  THEN
642                   WRITE ( io, 339 )  skip_time_data_output_av
643                ENDIF
644             ENDIF
645          ENDIF
646
647          IF ( do2d_yz /= ''  .AND.  section(1,3) /= -9999 )  THEN
648             i = 1
649             slices = '/'
650             coordinates = '/'
651!
652!--          Building strings with index and coordinate informations of the
653!--          slices
654             DO  WHILE ( section(i,3) /= -9999 )
655
656                WRITE (section_chr,'(I5)')  section(i,3)
657                section_chr = ADJUSTL( section_chr )
658                slices = TRIM( slices ) // TRIM( section_chr ) // '/'
659
660                WRITE (coor_chr,'(F10.1)')  section(i,3) * dx
661                coor_chr = ADJUSTL( coor_chr )
662                coordinates = TRIM( coordinates ) // TRIM( coor_chr ) // '/'
663
664                i = i + 1
665             ENDDO
666             IF ( av == 0 )  THEN
667                WRITE ( io, 335 )  'YZ', do2d_yz, dt_do2d_yz, &
668                                   TRIM( begin_chr ), 'i', TRIM( slices ), &
669                                   TRIM( coordinates )
670                IF ( skip_time_do2d_yz /= 0.0 )  THEN
671                   WRITE ( io, 339 )  skip_time_do2d_yz
672                ENDIF
673             ELSE
674                WRITE ( io, 342 )  'YZ', do2d_yz, dt_data_output_av, &
675                                   TRIM( begin_chr ), averaging_interval, &
676                                   dt_averaging_input, 'i', TRIM( slices ), &
677                                   TRIM( coordinates )
678                IF ( skip_time_data_output_av /= 0.0 )  THEN
679                   WRITE ( io, 339 )  skip_time_data_output_av
680                ENDIF
681             ENDIF
682          ENDIF
683
684       ENDIF
685
686    ENDDO
687
688!
689!-- 3d-arrays
690    DO  av = 0, 1
691
692       i = 1
693       do3d_chr = ''
694       DO  WHILE ( do3d(av,i) /= ' ' )
695
696          do3d_chr = TRIM( do3d_chr ) // ' ' // TRIM( do3d(av,i) ) // ','
697          i = i + 1
698
699       ENDDO
700
701       IF ( do3d_chr /= '' )  THEN
702          IF ( av == 0 )  THEN
703             WRITE ( io, 336 )  ''
704          ELSE
705             WRITE ( io, 336 )  '(time-averaged)'
706          ENDIF
707
708          output_format = ''
709          IF ( netcdf_output )  THEN
710             IF ( netcdf_64bit .AND. netcdf_64bit_3d )  THEN
711                output_format = 'netcdf (64 bit offset)'
712             ELSE
713                output_format = 'netcdf'
714             ENDIF
715          ENDIF
716          IF ( avs_output )  THEN
717             IF ( netcdf_output )  THEN
718                output_format = TRIM( output_format ) // ' and avs'
719             ELSE
720                output_format = 'avs'
721             ENDIF
722          ENDIF
723          WRITE ( io, 345 )  output_format
724
725          IF ( do3d_at_begin )  THEN
726             begin_chr = 'and at the start'
727          ELSE
728             begin_chr = ''
729          ENDIF
730          IF ( av == 0 )  THEN
731             WRITE ( io, 337 )  do3d_chr, dt_do3d, TRIM( begin_chr ), &
732                                zu(nz_do3d), nz_do3d
733          ELSE
734             WRITE ( io, 343 )  do3d_chr, dt_data_output_av,           &
735                                TRIM( begin_chr ), averaging_interval, &
736                                dt_averaging_input, zu(nz_do3d), nz_do3d
737          ENDIF
738
739          IF ( do3d_compress )  THEN
740             do3d_chr = ''
741             i = 1
742             DO WHILE ( do3d(av,i) /= ' ' )
743
744                SELECT CASE ( do3d(av,i) )
745                   CASE ( 'u' )
746                      j = 1
747                   CASE ( 'v' )
748                      j = 2
749                   CASE ( 'w' )
750                      j = 3
751                   CASE ( 'p' )
752                      j = 4
753                   CASE ( 'pt' )
754                      j = 5
755                END SELECT
756                WRITE ( prec, '(I1)' )  plot_3d_precision(j)%precision
757                do3d_chr = TRIM( do3d_chr ) // ' ' // TRIM( do3d(av,i) ) // &
758                           ':' // prec // ','
759                i = i + 1
760
761             ENDDO
762             WRITE ( io, 338 )  do3d_chr
763
764          ENDIF
765
766          IF ( av == 0 )  THEN
767             IF ( skip_time_do3d /= 0.0 )  THEN
768                WRITE ( io, 339 )  skip_time_do3d
769             ENDIF
770          ELSE
771             IF ( skip_time_data_output_av /= 0.0 )  THEN
772                WRITE ( io, 339 )  skip_time_data_output_av
773             ENDIF
774          ENDIF
775
776       ENDIF
777
778    ENDDO
779
780!
781!-- Timeseries
782    IF ( dt_dots /= 9999999.9 )  THEN
783       WRITE ( io, 340 )
784
785       output_format = ''
786       IF ( netcdf_output )  THEN
787          IF ( netcdf_64bit )  THEN
788             output_format = 'netcdf (64 bit offset)'
789          ELSE
790             output_format = 'netcdf'
791          ENDIF
792       ENDIF
793       IF ( profil_output )  THEN
794          IF ( netcdf_output )  THEN
795             output_format = TRIM( output_format ) // ' and profil'
796          ELSE
797             output_format = 'profil'
798          ENDIF
799       ENDIF
800       WRITE ( io, 345 )  output_format
801       WRITE ( io, 341 )  dt_dots
802    ENDIF
803
804#if defined( __dvrp_graphics )
805!
806!-- Dvrp-output
807    IF ( dt_dvrp /= 9999999.9 )  THEN
808       WRITE ( io, 360 )  dt_dvrp, TRIM( dvrp_output ), TRIM( dvrp_host ), &
809                          TRIM( dvrp_username ), TRIM( dvrp_directory )
810       i = 1
811       l = 0
812       DO WHILE ( mode_dvrp(i) /= ' ' )
813          IF ( mode_dvrp(i)(1:10) == 'isosurface' )  THEN
814             READ ( mode_dvrp(i), '(10X,I1)' )  j
815             l = l + 1
816             IF ( do3d(0,j) /= ' ' )  THEN
817                WRITE ( io, 361 )  TRIM( do3d(0,j) ), threshold(l)
818             ENDIF
819          ELSEIF ( mode_dvrp(i)(1:6) == 'slicer' )  THEN
820             READ ( mode_dvrp(i), '(6X,I1)' )  j
821             IF ( do2d(0,j) /= ' ' )  WRITE ( io, 362 )  TRIM( do2d(0,j) )
822          ELSEIF ( mode_dvrp(i)(1:9) == 'particles' )  THEN
823             WRITE ( io, 363 )
824          ENDIF
825          i = i + 1
826       ENDDO
827    ENDIF
828#endif
829
830#if defined( __spectra )
831!
832!-- Spectra output
833    IF ( dt_dosp /= 9999999.9 ) THEN
834       WRITE ( io, 370 )
835
836       output_format = ''
837       IF ( netcdf_output )  THEN
838          IF ( netcdf_64bit )  THEN
839             output_format = 'netcdf (64 bit offset)'
840          ELSE
841             output_format = 'netcdf'
842          ENDIF
843       ENDIF
844       IF ( profil_output )  THEN
845          IF ( netcdf_output )  THEN
846             output_format = TRIM( output_format ) // ' and profil'
847          ELSE
848             output_format = 'profil'
849          ENDIF
850       ENDIF
851       WRITE ( io, 345 )  output_format
852       WRITE ( io, 371 )  dt_dosp
853       IF ( skip_time_dosp /= 0.0 )  WRITE ( io, 339 )  skip_time_dosp
854       WRITE ( io, 372 )  ( data_output_sp(i), i = 1,10 ),     &
855                          ( spectra_direction(i), i = 1,10 ),  &
856                          ( comp_spectra_level(i), i = 1,10 ), &
857                          ( plot_spectra_level(i), i = 1,10 ), &
858                          averaging_interval_sp, dt_averaging_input_pr
859    ENDIF
860#endif
861
862    WRITE ( io, 99 )
863
864!
865!-- Physical quantities
866    WRITE ( io, 400 )
867
868!
869!-- Geostrophic parameters
870    WRITE ( io, 410 )  omega, phi, f, fs
871
872!
873!-- Other quantities
874    WRITE ( io, 411 )  g
875    IF ( use_pt_reference )  WRITE ( io, 412 )  pt_reference
876
877!
878!-- Cloud physics parameters
879    IF ( cloud_physics ) THEN
880       WRITE ( io, 415 )
881       WRITE ( io, 416 ) surface_pressure, r_d, rho_surface, cp, l_v
882    ENDIF
883
884!-- Profile of the geostrophic wind (component ug)
885!-- Building output strings
886    WRITE ( ugcomponent, '(F6.2)' )  ug_surface
887    gradients = '------'
888    slices = '     0'
889    coordinates = '   0.0'
890    i = 1
891    DO  WHILE ( ug_vertical_gradient_level_ind(i) /= -9999 )
892     
893       WRITE (coor_chr,'(F6.2,4X)')  ug(ug_vertical_gradient_level_ind(i))
894       ugcomponent = TRIM( ugcomponent ) // '  ' // TRIM( coor_chr )
895
896       WRITE (coor_chr,'(F6.2,4X)')  ug_vertical_gradient(i)
897       gradients = TRIM( gradients ) // '  ' // TRIM( coor_chr )
898
899       WRITE (coor_chr,'(I6,4X)')  ug_vertical_gradient_level_ind(i)
900       slices = TRIM( slices ) // '  ' // TRIM( coor_chr )
901
902       WRITE (coor_chr,'(F6.1,4X)')  ug_vertical_gradient_level(i)
903       coordinates = TRIM( coordinates ) // '  ' // TRIM( coor_chr )
904
905       i = i + 1
906    ENDDO
907
908    WRITE ( io, 423 )  TRIM( coordinates ), TRIM( ugcomponent ), &
909                       TRIM( gradients ), TRIM( slices )
910
911!-- Profile of the geostrophic wind (component vg)
912!-- Building output strings
913    WRITE ( vgcomponent, '(F6.2)' )  vg_surface
914    gradients = '------'
915    slices = '     0'
916    coordinates = '   0.0'
917    i = 1
918    DO  WHILE ( vg_vertical_gradient_level_ind(i) /= -9999 )
919
920       WRITE (coor_chr,'(F6.2,4X)')  vg(vg_vertical_gradient_level_ind(i))
921       vgcomponent = TRIM( vgcomponent ) // '  ' // TRIM( coor_chr )
922
923       WRITE (coor_chr,'(F6.2,4X)')  vg_vertical_gradient(i)
924       gradients = TRIM( gradients ) // '  ' // TRIM( coor_chr )
925
926       WRITE (coor_chr,'(I6,4X)')  vg_vertical_gradient_level_ind(i)
927       slices = TRIM( slices ) // '  ' // TRIM( coor_chr )
928
929       WRITE (coor_chr,'(F6.1,4X)')  vg_vertical_gradient_level(i)
930       coordinates = TRIM( coordinates ) // '  ' // TRIM( coor_chr )
931
932       i = i + 1 
933    ENDDO
934
935    WRITE ( io, 424 )  TRIM( coordinates ), TRIM( vgcomponent ), &
936                       TRIM( gradients ), TRIM( slices )
937
938!
939!-- Initial temperature profile
940!-- Building output strings, starting with surface temperature
941    WRITE ( temperatures, '(F6.2)' )  pt_surface
942    gradients = '------'
943    slices = '     0'
944    coordinates = '   0.0'
945    i = 1
946    DO  WHILE ( pt_vertical_gradient_level_ind(i) /= -9999 )
947
948       WRITE (coor_chr,'(F6.2,4X)')  pt_init(pt_vertical_gradient_level_ind(i))
949       temperatures = TRIM( temperatures ) // '  ' // TRIM( coor_chr )
950
951       WRITE (coor_chr,'(F6.2,4X)')  pt_vertical_gradient(i)
952       gradients = TRIM( gradients ) // '  ' // TRIM( coor_chr )
953
954       WRITE (coor_chr,'(I6,4X)')  pt_vertical_gradient_level_ind(i)
955       slices = TRIM( slices ) // '  ' // TRIM( coor_chr )
956
957       WRITE (coor_chr,'(F6.1,4X)')  pt_vertical_gradient_level(i)
958       coordinates = TRIM( coordinates ) // '  '  // TRIM( coor_chr )
959
960       i = i + 1
961    ENDDO
962
963    WRITE ( io, 420 )  TRIM( coordinates ), TRIM( temperatures ), &
964                       TRIM( gradients ), TRIM( slices )
965
966!
967!-- Initial humidity profile
968!-- Building output strings, starting with surface humidity
969    IF ( humidity  .OR.  passive_scalar )  THEN
970       WRITE ( temperatures, '(E8.1)' )  q_surface
971       gradients = '--------'
972       slices = '       0'
973       coordinates = '     0.0'
974       i = 1
975       DO  WHILE ( q_vertical_gradient_level_ind(i) /= -9999 )
976         
977          WRITE (coor_chr,'(E8.1,4X)')  q_init(q_vertical_gradient_level_ind(i))
978          temperatures = TRIM( temperatures ) // '  ' // TRIM( coor_chr )
979
980          WRITE (coor_chr,'(E8.1,4X)')  q_vertical_gradient(i)
981          gradients = TRIM( gradients ) // '  ' // TRIM( coor_chr )
982         
983          WRITE (coor_chr,'(I8,4X)')  q_vertical_gradient_level_ind(i)
984          slices = TRIM( slices ) // '  ' // TRIM( coor_chr )
985         
986          WRITE (coor_chr,'(F8.1,4X)')  q_vertical_gradient_level(i)
987          coordinates = TRIM( coordinates ) // '  '  // TRIM( coor_chr )
988
989          i = i + 1
990       ENDDO
991
992       IF ( humidity )  THEN
993          WRITE ( io, 421 )  TRIM( coordinates ), TRIM( temperatures ), &
994                             TRIM( gradients ), TRIM( slices )
995       ELSE
996          WRITE ( io, 422 )  TRIM( coordinates ), TRIM( temperatures ), &
997                             TRIM( gradients ), TRIM( slices )
998       ENDIF
999    ENDIF
1000
1001!
1002!-- LES / turbulence parameters
1003    WRITE ( io, 450 )
1004
1005!--
1006! ... LES-constants used must still be added here
1007!--
1008    IF ( constant_diffusion )  THEN
1009       WRITE ( io, 451 )  km_constant, km_constant/prandtl_number, &
1010                          prandtl_number
1011    ENDIF
1012    IF ( .NOT. constant_diffusion)  THEN
1013       IF ( e_min > 0.0 )  WRITE ( io, 454 )  e_min
1014       IF ( wall_adjustment )  WRITE ( io, 453 )  wall_adjustment_factor
1015       IF ( adjust_mixing_length  .AND.  prandtl_layer )  WRITE ( io, 452 )
1016    ENDIF
1017
1018!
1019!-- Special actions during the run
1020    WRITE ( io, 470 )
1021    IF ( create_disturbances )  THEN
1022       WRITE ( io, 471 )  dt_disturb, disturbance_amplitude,                   &
1023                          zu(disturbance_level_ind_b), disturbance_level_ind_b,&
1024                          zu(disturbance_level_ind_t), disturbance_level_ind_t
1025       IF ( bc_lr /= 'cyclic'  .OR.  bc_ns /= 'cyclic' )  THEN
1026          WRITE ( io, 472 )  inflow_disturbance_begin, inflow_disturbance_end
1027       ELSE
1028          WRITE ( io, 473 )  disturbance_energy_limit
1029       ENDIF
1030       WRITE ( io, 474 )  TRIM( random_generator )
1031    ENDIF
1032    IF ( pt_surface_initial_change /= 0.0 )  THEN
1033       WRITE ( io, 475 )  pt_surface_initial_change
1034    ENDIF
1035    IF ( humidity  .AND.  q_surface_initial_change /= 0.0 )  THEN
1036       WRITE ( io, 476 )  q_surface_initial_change       
1037    ENDIF
1038    IF ( passive_scalar  .AND.  q_surface_initial_change /= 0.0 )  THEN
1039       WRITE ( io, 477 )  q_surface_initial_change       
1040    ENDIF
1041
1042    IF ( particle_advection )  THEN
1043!
1044!--    Particle attributes
1045       WRITE ( io, 480 )  particle_advection_start, dt_prel, bc_par_lr, &
1046                          bc_par_ns, bc_par_b, bc_par_t, particle_maximum_age, &
1047                          end_time_prel
1048       IF ( use_sgs_for_particles )  WRITE ( io, 488 )  dt_min_part
1049       IF ( random_start_position )  WRITE ( io, 481 )
1050       IF ( particles_per_point > 1 )  WRITE ( io, 489 )  particles_per_point
1051       WRITE ( io, 495 )  total_number_of_particles
1052       IF ( .NOT. vertical_particle_advection )  WRITE ( io, 482 )
1053       IF ( maximum_number_of_tailpoints /= 0 )  THEN
1054          WRITE ( io, 483 )  maximum_number_of_tailpoints
1055          IF ( minimum_tailpoint_distance /= 0 )  THEN
1056             WRITE ( io, 484 )  total_number_of_tails,      &
1057                                minimum_tailpoint_distance, &
1058                                maximum_tailpoint_age
1059          ENDIF
1060       ENDIF
1061       IF ( dt_write_particle_data /= 9999999.9 )  THEN
1062          WRITE ( io, 485 )  dt_write_particle_data
1063          output_format = ''
1064          IF ( netcdf_output )  THEN
1065             IF ( netcdf_64bit )  THEN
1066                output_format = 'netcdf (64 bit offset) and binary'
1067             ELSE
1068                output_format = 'netcdf and binary'
1069             ENDIF
1070          ELSE
1071             output_format = 'binary'
1072          ENDIF
1073          WRITE ( io, 345 )  output_format
1074       ENDIF
1075       IF ( dt_dopts /= 9999999.9 )  WRITE ( io, 494 )  dt_dopts
1076       IF ( write_particle_statistics )  WRITE ( io, 486 )
1077
1078       WRITE ( io, 487 )  number_of_particle_groups
1079
1080       DO  i = 1, number_of_particle_groups
1081          IF ( i == 1  .AND.  density_ratio(i) == 9999999.9 )  THEN
1082             WRITE ( io, 490 )  i, 0.0
1083             WRITE ( io, 492 )
1084          ELSE
1085             WRITE ( io, 490 )  i, radius(i)
1086             IF ( density_ratio(i) /= 0.0 )  THEN
1087                WRITE ( io, 491 )  density_ratio(i)
1088             ELSE
1089                WRITE ( io, 492 )
1090             ENDIF
1091          ENDIF
1092          WRITE ( io, 493 )  psl(i), psr(i), pss(i), psn(i), psb(i), pst(i), &
1093                             pdx(i), pdy(i), pdz(i)
1094       ENDDO
1095
1096    ENDIF
1097
1098
1099!
1100!-- Parameters of 1D-model
1101    IF ( INDEX( initializing_actions, 'set_1d-model_profiles' ) /= 0 )  THEN
1102       WRITE ( io, 500 )  end_time_1d, dt_run_control_1d, dt_pr_1d, &
1103                          mixing_length_1d, dissipation_1d
1104       IF ( damp_level_ind_1d /= nzt+1 )  THEN
1105          WRITE ( io, 502 )  zu(damp_level_ind_1d), damp_level_ind_1d
1106       ENDIF
1107    ENDIF
1108
1109!
1110!-- User-defined informations
1111    CALL user_header( io )
1112
1113    WRITE ( io, 99 )
1114
1115!
1116!-- Write buffer contents to disc immediately
1117    CALL local_flush( io )
1118
1119!
1120!-- Here the FORMATs start
1121
1122 99 FORMAT (1X,78('-'))
1123100 FORMAT (/1X,'*************************',11X,28('-')/        &
1124            1X,'* ',A,' *',11X,A/                               &
1125            1X,'*************************',11X,28('-')//        &
1126            ' Date:            ',A8,11X,'Run:       ',A20/      &
1127            ' Time:            ',A8,11X,'Run-No.:   ',I2.2/     &
1128            ' Run on host:   ',A10)
1129#if defined( __parallel )
1130101 FORMAT (' Number of PEs:',7X,I4,11X,'Processor grid (x,y): (',I3,',',I3, &
1131              ')',1X,A)
1132102 FORMAT (' Number of PEs:',7X,I4,11X,'Tasks:',I4,'   threads per task:',I4/ &
1133              37X,'Processor grid (x,y): (',I3,',',I3,')',1X,A)
1134103 FORMAT (37X,'One additional PE is used to handle'/37X,'the dvrp output!')
1135104 FORMAT (37X,'A 1d-decomposition along x is forced'/ &
1136            37X,'because the job is running on an SMP-cluster')
1137105 FORMAT (37X,'A 1d-decomposition along ',A,' is used')
1138#endif
1139110 FORMAT (/' Numerical Schemes:'/ &
1140             ' -----------------'/)
1141111 FORMAT (' --> Solve perturbation pressure via FFT using ',A,' routines')
1142112 FORMAT (' --> Solve perturbation pressure via SOR-Red/Black-Schema'/ &
1143            '     Iterations (initial/other): ',I3,'/',I3,'  omega = ',F5.3)
1144113 FORMAT (' --> Momentum advection via Piascek-Williams-Scheme (Form C3)', &
1145                  ' or Upstream')
1146114 FORMAT (' --> Momentum advection via Upstream-Spline-Scheme')
1147115 FORMAT ('     Tendencies are smoothed via Long-Filter with factor ',F5.3) 
1148116 FORMAT (' --> Scalar advection via Piascek-Williams-Scheme (Form C3)', &
1149                  ' or Upstream')
1150117 FORMAT (' --> Scalar advection via Upstream-Spline-Scheme')
1151118 FORMAT (' --> Scalar advection via Bott-Chlond-Scheme')
1152119 FORMAT (' --> Galilei-Transform applied to horizontal advection', &
1153            '     Translation velocity = ',A/ &
1154            '     distance advected ',A,':  ',F8.3,' km(x)  ',F8.3,' km(y)')
1155120 FORMAT (' --> Time differencing scheme: leapfrog only (no euler in case', &
1156                  ' of timestep changes)')
1157121 FORMAT (' --> Time differencing scheme: leapfrog + euler in case of', &
1158                  ' timestep changes')
1159122 FORMAT (' --> Time differencing scheme: ',A)
1160123 FORMAT (' --> Rayleigh-Damping active, starts above z = ',F8.2,' m'/ &
1161            '     maximum damping coefficient: ',F5.3, ' 1/s')
1162124 FORMAT ('     Spline-overshoots are being suppressed')
1163125 FORMAT ('     Upstream-Scheme is used if Upstream-differences fall short', &
1164                  ' of'/                                                       &
1165            '     delta_u = ',F6.4,4X,'delta_v = ',F6.4,4X,'delta_w = ',F6.4)
1166126 FORMAT ('     Upstream-Scheme is used if Upstream-differences fall short', &
1167                  ' of'/                                                       &
1168            '     delta_e = ',F6.4,4X,'delta_pt = ',F6.4)
1169127 FORMAT ('     The following absolute overshoot differences are tolerated:'/&
1170            '     delta_u = ',F6.4,4X,'delta_v = ',F6.4,4X,'delta_w = ',F6.4)
1171128 FORMAT ('     The following absolute overshoot differences are tolerated:'/&
1172            '     delta_e = ',F6.4,4X,'delta_pt = ',F6.4)
1173129 FORMAT (' --> Additional prognostic equation for the specific humidity')
1174130 FORMAT (' --> Additional prognostic equation for the total water content')
1175131 FORMAT (' --> Parameterization of condensation processes via (0%-or100%)')
1176132 FORMAT (' --> Parameterization of long-wave radiation processes via'/ &
1177            '     effective emissivity scheme')
1178133 FORMAT (' --> Precipitation parameterization via Kessler-Scheme')
1179134 FORMAT (' --> Additional prognostic equation for a passive scalar')
1180135 FORMAT (' --> Solve perturbation pressure via multigrid method (', &
1181                  A,'-cycle)'/ &
1182            '     number of grid levels:                   ',I2/ &
1183            '     Gauss-Seidel red/black iterations:       ',I2)
1184136 FORMAT ('     gridpoints of coarsest subdomain (x,y,z): (',I3,',',I3,',', &
1185                  I3,')')
1186137 FORMAT ('     level data gathered on PE0 at level:     ',I2/ &
1187            '     gridpoints of coarsest subdomain (x,y,z): (',I3,',',I3,',', &
1188                  I3,')'/ &
1189            '     gridpoints of coarsest domain (x,y,z):    (',I3,',',I3,',', &
1190                  I3,')')
1191138 FORMAT ('     Using hybrid version for 1d-domain-decomposition')
1192139 FORMAT (' --> Loop optimization method: ',A)
1193140 FORMAT ('     maximum residual allowed:                ',E10.3)
1194141 FORMAT ('     fixed number of multigrid cycles:        ',I4)
1195142 FORMAT ('     perturbation pressure is calculated at every Runge-Kutta ', &
1196                  'step')
1197150 FORMAT (' --> Volume flow at the right and north boundary will be ', &
1198                  'conserved')
1199200 FORMAT (//' Run time and time step information:'/ &
1200             ' ----------------------------------'/)
1201201 FORMAT ( ' Timestep:          variable     maximum value: ',F6.3,' s', &
1202             '    CFL-factor: ',F4.2)
1203202 FORMAT ( ' Timestep:       dt = ',F6.3,' s'/)
1204203 FORMAT ( ' Start time:       ',F9.3,' s'/ &
1205             ' End time:         ',F9.3,' s')
1206204 FORMAT ( A,F9.3,' s')
1207205 FORMAT ( A,F9.3,' s',5X,'restart every',17X,F9.3,' s')
1208206 FORMAT (/' Time reached:     ',F9.3,' s'/ &
1209             ' CPU-time used:    ',F9.3,' s     per timestep:               ', &
1210               '  ',F9.3,' s'/                                                 &
1211             '                                   per second of simulated tim', &
1212               'e: ',F9.3,' s')
1213250 FORMAT (//' Computational grid and domain size:'/ &
1214              ' ----------------------------------'// &
1215              ' Grid length:      dx =    ',F7.3,' m    dy =    ',F7.3, &
1216              ' m    dz =    ',F7.3,' m'/ &
1217              ' Domain size:       x = ',F10.3,' m     y = ',F10.3, &
1218              ' m  z(u) = ',F10.3,' m'/)
1219252 FORMAT (' dz constant up to ',F10.3,' m (k=',I4,'), then stretched by', &
1220              ' factor: ',F5.3/ &
1221            ' maximum dz not to be exceeded is dz_max = ',F10.3,' m'/)
1222254 FORMAT (' Number of gridpoints (x,y,z):  (0:',I4,', 0:',I4,', 0:',I4,')'/ &
1223            ' Subdomain size (x,y,z):        (  ',I4,',   ',I4,',   ',I4,')'/)
1224255 FORMAT (' Subdomains have equal size')
1225256 FORMAT (' Subdomains at the upper edges of the virtual processor grid ', &
1226              'have smaller sizes'/                                          &
1227            ' Size of smallest subdomain:    (  ',I4,',   ',I4,',   ',I4,')')
1228260 FORMAT (/' The model has a slope in x-direction. Inclination angle: ',F6.2,&
1229             ' degrees')
1230270 FORMAT (//' Topography informations:'/ &
1231              ' -----------------------'// &
1232              1X,'Topography: ',A)
1233271 FORMAT (  ' Building size (x/y/z) in m: ',F5.1,' / ',F5.1,' / ',F5.1/ &
1234              ' Horizontal index bounds (l/r/s/n): ',I4,' / ',I4,' / ',I4, &
1235                ' / ',I4)
1236300 FORMAT (//' Boundary conditions:'/ &
1237             ' -------------------'// &
1238             '                     p                    uv             ', &
1239             '                   pt'// &
1240             ' B. bound.: ',A/ &
1241             ' T. bound.: ',A)
1242301 FORMAT (/'                     e'// &
1243             ' B. bound.: ',A/ &
1244             ' T. bound.: ',A)
1245302 FORMAT (/'                     q'// &
1246             ' B. bound.: ',A/ &
1247             ' T. bound.: ',A)
1248303 FORMAT (/' Bottom surface fluxes are used in diffusion terms at k=1')
1249304 FORMAT (/' Top surface fluxes are used in diffusion terms at k=nzt')
1250305 FORMAT (//'    Prandtl-Layer between bottom surface and first ', &
1251               'computational u,v-level:'// &
1252             '       zp = ',F6.2,' m   z0 = ',F6.4,' m   kappa = ',F4.2/ &
1253             '       Rif value range:   ',F6.2,' <= rif <=',F6.2)
1254306 FORMAT ('       Predefined constant heatflux:   ',F6.3,' K m/s')
1255307 FORMAT ('       Heatflux has a random normal distribution')
1256308 FORMAT ('       Predefined surface temperature')
1257310 FORMAT (//'    1D-Model:'// &
1258             '       Rif value range:   ',F6.2,' <= rif <=',F6.2)
1259311 FORMAT ('       Predefined constant humidity flux: ',E10.3,' m/s')
1260312 FORMAT ('       Predefined surface humidity')
1261313 FORMAT ('       Predefined constant scalar flux: ',E10.3,' kg/(m**2 s)')
1262314 FORMAT ('       Predefined scalar value at the surface')
1263315 FORMAT ('       Humidity / scalar flux at top surface is 0.0')
1264317 FORMAT (//' Lateral boundaries:'/ &
1265            '       left/right:  ',A/    &
1266            '       north/south: ',A)
1267318 FORMAT (/'       outflow damping layer width: ',I3,' gridpoints with km_', &
1268                    'max =',F5.1,' m**2/s')
1269320 FORMAT (//' List output:'/ &
1270             ' -----------'//  &
1271            '    1D-Profiles:'/    &
1272            '       Output every             ',F8.2,' s')
1273321 FORMAT ('       Time averaged over       ',F8.2,' s'/ &
1274            '       Averaging input every    ',F8.2,' s')
1275330 FORMAT (//' Data output:'/ &
1276             ' -----------'/)
1277331 FORMAT (/'    1D-Profiles:')
1278332 FORMAT (/'       ',A)
1279333 FORMAT ('       Output every             ',F8.2,' s',/ &
1280            '       Time averaged over       ',F8.2,' s'/ &
1281            '       Averaging input every    ',F8.2,' s')
1282334 FORMAT (/'    2D-Arrays',A,':')
1283335 FORMAT (/'       ',A2,'-cross-section  Arrays: ',A/ &
1284            '       Output every             ',F8.2,' s  ',A/ &
1285            '       Cross sections at ',A1,' = ',A/ &
1286            '       scalar-coordinates:   ',A,' m'/)
1287336 FORMAT (/'    3D-Arrays',A,':')
1288337 FORMAT (/'       Arrays: ',A/ &
1289            '       Output every             ',F8.2,' s  ',A/ &
1290            '       Upper output limit at    ',F8.2,' m  (GP ',I4,')'/)
1291338 FORMAT ('       Compressed data output'/ &
1292            '       Decimal precision: ',A/)
1293339 FORMAT ('       No output during initial ',F8.2,' s')
1294340 FORMAT (/'    Time series:')
1295341 FORMAT ('       Output every             ',F8.2,' s'/)
1296342 FORMAT (/'       ',A2,'-cross-section  Arrays: ',A/ &
1297            '       Output every             ',F8.2,' s  ',A/ &
1298            '       Time averaged over       ',F8.2,' s'/ &
1299            '       Averaging input every    ',F8.2,' s'/ &
1300            '       Cross sections at ',A1,' = ',A/ &
1301            '       scalar-coordinates:   ',A,' m'/)
1302343 FORMAT (/'       Arrays: ',A/ &
1303            '       Output every             ',F8.2,' s  ',A/ &
1304            '       Time averaged over       ',F8.2,' s'/ &
1305            '       Averaging input every    ',F8.2,' s'/ &
1306            '       Upper output limit at    ',F8.2,' m  (GP ',I4,')'/)
1307345 FORMAT ('       Output format: ',A/)
1308#if defined( __dvrp_graphics )
1309360 FORMAT ('    Plot-Sequence with dvrp-software:'/ &
1310            '       Output every      ',F7.1,' s'/ &
1311            '       Output mode:      ',A/ &
1312            '       Host / User:      ',A,' / ',A/ &
1313            '       Directory:        ',A// &
1314            '       The sequence contains:')
1315361 FORMAT ('       Isosurface of ',A,'  Threshold value: ', E12.3)
1316362 FORMAT ('       Sectional plane ',A)
1317363 FORMAT ('       Particles')
1318#endif
1319#if defined( __spectra )
1320370 FORMAT ('    Spectra:')
1321371 FORMAT ('       Output every ',F7.1,' s'/)
1322372 FORMAT ('       Arrays:     ', 10(A5,',')/                         &
1323            '       Directions: ', 10(A5,',')/                         &
1324            '       height levels  k = ', 9(I3,','),I3,'.'/            &
1325            '       height levels selected for standard plot:'/        &
1326            '                      k = ', 9(I3,','),I3,'.'/            &
1327            '       Time averaged over ', F7.1, ' s,' /                &
1328            '       Profiles for the time averaging are taken every ', &
1329                    F6.1,' s')
1330#endif
1331400 FORMAT (//' Physical quantities:'/ &
1332              ' -------------------'/)
1333410 FORMAT ('    Angular velocity    :   omega = ',E9.3,' rad/s'/  &
1334            '    Geograph. latitude  :   phi   = ',F4.1,' degr'/   &
1335            '    Coriolis parameter  :   f     = ',F9.6,' 1/s'/    &
1336            '                            f*    = ',F9.6,' 1/s')
1337411 FORMAT (/'    Gravity             :   g     = ',F4.1,' m/s**2')
1338412 FORMAT (/'    Reference temperature in buoyancy terms: ',F8.4,' K')
1339415 FORMAT (/'    Cloud physics parameters:'/ &
1340             '    ------------------------'/)
1341416 FORMAT ('        Surface pressure   :   p_0   = ',F7.2,' hPa'/      &
1342            '        Gas constant       :   R     = ',F5.1,' J/(kg K)'/ &
1343            '        Density of air     :   rho_0 = ',F5.3,' kg/m**3'/  &
1344            '        Specific heat cap. :   c_p   = ',F6.1,' J/(kg K)'/ &
1345            '        Vapourization heat :   L_v   = ',E8.2,' J/kg')
1346420 FORMAT (/'    Characteristic levels of the initial temperature profile:'// &
1347            '       Height:        ',A,'  m'/ &
1348            '       Temperature:   ',A,'  K'/ &
1349            '       Gradient:      ',A,'  K/100m'/ &
1350            '       Gridpoint:     ',A)
1351421 FORMAT (/'    Characteristic levels of the initial humidity profile:'// &
1352            '       Height:      ',A,'  m'/ &
1353            '       Humidity:    ',A,'  kg/kg'/ &
1354            '       Gradient:    ',A,'  (kg/kg)/100m'/ &
1355            '       Gridpoint:   ',A)
1356422 FORMAT (/'    Characteristic levels of the initial scalar profile:'// &
1357            '       Height:                  ',A,'  m'/ &
1358            '       Scalar concentration:    ',A,'  kg/m**3'/ &
1359            '       Gradient:                ',A,'  (kg/m**3)/100m'/ &
1360            '       Gridpoint:               ',A)
1361423 FORMAT (/'    Characteristic levels of the geo. wind component ug:'// &
1362            '       Height:      ',A,'  m'/ &
1363            '       ug:          ',A,'  m/s'/ &
1364            '       Gradient:    ',A,'  1/100s'/ &
1365            '       Gridpoint:   ',A)
1366424 FORMAT (/'    Characteristic levels of the geo. wind component vg:'// &
1367            '       Height:      ',A,'  m'/ &
1368            '       vg:          ',A,'  m/S'/ &
1369            '       Gradient:    ',A,'  1/100s'/ &
1370            '       Gridpoint:   ',A)
1371450 FORMAT (//' LES / Turbulence quantities:'/ &
1372              ' ---------------------------'/)
1373451 FORMAT ('   Diffusion coefficients are constant:'/ &
1374            '   Km = ',F6.2,' m**2/s   Kh = ',F6.2,' m**2/s   Pr = ',F5.2)
1375452 FORMAT ('   Mixing length is limited to the Prandtl mixing lenth.')
1376453 FORMAT ('   Mixing length is limited to ',F4.2,' * z')
1377454 FORMAT ('   TKE is not allowed to fall below ',E9.2,' (m/s)**2')
1378470 FORMAT (//' Actions during the simulation:'/ &
1379              ' -----------------------------'/)
1380471 FORMAT ('    Disturbance impulse (u,v) every :  ',F6.2,' s'/             &
1381            '    Disturbance amplitude           :    ',F4.2, ' m/s'/        &
1382            '    Lower disturbance level         : ',F7.2,' m (GP ',I4,')'/  &
1383            '    Upper disturbance level         : ',F7.2,' m (GP ',I4,')')
1384472 FORMAT ('    Disturbances continued during the run from i/j =',I4, &
1385                 ' to i/j =',I4)
1386473 FORMAT ('    Disturbances cease as soon as the disturbance energy exceeds',&
1387                 1X,F5.3, ' m**2/s**2')
1388474 FORMAT ('    Random number generator used    : ',A/)
1389475 FORMAT ('    The surface temperature is increased (or decreased, ', &
1390                 'respectively, if'/ &
1391            '    the value is negative) by ',F5.2,' K at the beginning of the',&
1392                 ' 3D-simulation'/)
1393476 FORMAT ('    The surface humidity is increased (or decreased, ',&
1394                 'respectively, if the'/ &
1395            '    value is negative) by ',E8.1,' kg/kg at the beginning of', &
1396                 ' the 3D-simulation'/)
1397477 FORMAT ('    The scalar value is increased at the surface (or decreased, ',&
1398                 'respectively, if the'/ &
1399            '    value is negative) by ',E8.1,' kg/m**3 at the beginning of', &
1400                 ' the 3D-simulation'/)
1401480 FORMAT ('    Particles:'/ &
1402            '    ---------'// &
1403            '       Particle advection is active (switched on at t = ', F7.1, &
1404                    ' s)'/ &
1405            '       Start of new particle generations every  ',F6.1,' s'/ &
1406            '       Boundary conditions: left/right: ', A, ' north/south: ', A/&
1407            '                            bottom:     ', A, ' top:         ', A/&
1408            '       Maximum particle age:                 ',F9.1,' s'/ &
1409            '       Advection stopped at t = ',F9.1,' s'/)
1410481 FORMAT ('       Particles have random start positions'/)
1411482 FORMAT ('       Particles are advected only horizontally'/)
1412483 FORMAT ('       Particles have tails with a maximum of ',I3,' points')
1413484 FORMAT ('            Number of tails of the total domain: ',I10/ &
1414            '            Minimum distance between tailpoints: ',F8.2,' m'/ &
1415            '            Maximum age of the end of the tail:  ',F8.2,' s')
1416485 FORMAT ('       Particle data are written on file every ', F9.1, ' s')
1417486 FORMAT ('       Particle statistics are written on file'/)
1418487 FORMAT ('       Number of particle groups: ',I2/)
1419488 FORMAT ('       SGS velocity components are used for particle advection'/ &
1420            '          minimum timestep for advection: ', F7.5/)
1421489 FORMAT ('       Number of particles simultaneously released at each ', &
1422                    'point: ', I5/)
1423490 FORMAT ('       Particle group ',I2,':'/ &
1424            '          Particle radius: ',E10.3, 'm')
1425491 FORMAT ('          Particle inertia is activated'/ &
1426            '             density_ratio (rho_fluid/rho_particle) = ',F5.3/)
1427492 FORMAT ('          Particles are advected only passively (no inertia)'/)
1428493 FORMAT ('          Boundaries of particle source: x:',F8.1,' - ',F8.1,' m'/&
1429            '                                         y:',F8.1,' - ',F8.1,' m'/&
1430            '                                         z:',F8.1,' - ',F8.1,' m'/&
1431            '          Particle distances:  dx = ',F8.1,' m  dy = ',F8.1, &
1432                       ' m  dz = ',F8.1,' m'/)
1433494 FORMAT ('       Output of particle time series in NetCDF format every ', &
1434                    F8.2,' s'/)
1435495 FORMAT ('       Number of particles in total domain: ',I10/)
1436500 FORMAT (//' 1D-Model parameters:'/                           &
1437              ' -------------------'//                           &
1438            '    Simulation time:                   ',F8.1,' s'/ &
1439            '    Run-controll output every:         ',F8.1,' s'/ &
1440            '    Vertical profile output every:     ',F8.1,' s'/ &
1441            '    Mixing length calculation:         ',A/         &
1442            '    Dissipation calculation:           ',A/)
1443502 FORMAT ('    Damping layer starts from ',F7.1,' m (GP ',I4,')'/)
1444
1445
1446 END SUBROUTINE header
Note: See TracBrowser for help on using the repository browser.