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

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