source: palm/tags/release-3.2/SOURCE/header.f90 @ 785

Last change on this file since 785 was 77, checked in by raasch, 17 years ago

New:
---

particle reflection from vertical walls implemented, particle SGS model adjusted to walls

Wall functions for vertical walls now include diabatic conditions. New subroutines wall_fluxes, wall_fluxes_e. New 4D-array rif_wall.

new d3par-parameter netcdf_64bit_3d to switch on 64bit offset only for 3D files

new d3par-parameter dt_max to define the maximum value for the allowed timestep

new inipar-parameter loop_optimization to control the loop optimization method

new inipar-parameter pt_refrence. If given, this value is used as the reference that in buoyancy terms (otherwise, the instantaneous horizontally averaged temperature is used).

new user interface user_advec_particles

new initializing action "by_user" calls user_init_3d_model and allows the initial setting of all 3d arrays

topography height informations are stored on arrays zu_s_inner and zw_w_inner and output to the 2d/3d NetCDF files

samples added to the user interface which show how to add user-define time series quantities.

calculation/output of precipitation amount, precipitation rate and z0 (by setting "pra*", "prr*", "z0*" with data_output). The time interval on which the precipitation amount is defined is set by new d3par-parameter precipitation_amount_interval

unit 9 opened for debug output (file DEBUG_<pe#>)

Makefile, advec_particles, average_3d_data, buoyancy, calc_precipitation, check_open, check_parameters, data_output_2d, diffusion_e, diffusion_u, diffusion_v, diffusion_w, diffusivities, header, impact_of_latent_heat, init_particles, init_3d_model, modules, netcdf, parin, production_e, read_var_list, read_3d_binary, sum_up_3d_data, user_interface, write_var_list, write_3d_binary

New: wall_fluxes

Changed:


General revision of non-cyclic horizontal boundary conditions: radiation boundary conditions are now used instead of Neumann conditions at the outflow (calculation needs velocity values for t-dt, which are stored on new arrays u_m_l, u_m_r, etc.), calculation of mean outflow is not needed any more, volume flow control is added for the outflow boundary (currently only for the north boundary!!), additional gridpoints along x and y (uxrp, vynp) are not needed any more, routine "boundary_conds" now operates on timelevel t+dt and is not split in two parts (main, uvw_outflow) any more, Neumann boundary conditions at inflow/outflow in case of non-cyclic boundary conditions for all 2d-arrays that are handled by exchange_horiz_2d

The FFT-method for solving the Poisson-equation is now working with Neumann boundary conditions both at the bottom and the top. This requires adjustments of the tridiagonal coefficients and subtracting the horizontally averaged mean from the vertical velocity field.

+age_m in particle_type

Particles-package is now part of the default code ("-p particles" is not needed any more).

Move call of user_actions( 'after_integration' ) below increment of times
and counters. user_actions is now called for each statistic region and has as an argument the number of the respective region (sr)

d3par-parameter data_output_ts removed. Timeseries output for "profil" removed. Timeseries are now switched on by dt_dots. Timeseries data is collected in flow_statistics.

Initial velocities at nzb+1 are regarded for volume flow control in case they have been set zero before (to avoid small timesteps); see new internal parameters u/v_nzb_p1_for_vfc.

q is not allowed to become negative (prognostic_equations).

poisfft_init is only called if fft-solver is switched on (init_pegrid).

d3par-parameter moisture renamed to humidity.

Subversion global revision number is read from mrun and added to the run description header and to the run control (_rc) file.

vtk directives removed from main program.

The uitility routine interpret_config reads PALM environment variables from NAMELIST instead using the system call GETENV.

advec_u_pw, advec_u_up, advec_v_pw, advec_v_up, asselin_filter, check_parameters, coriolis, data_output_dvrp, data_output_ptseries, data_output_ts, data_output_2d, data_output_3d, diffusion_u, diffusion_v, exchange_horiz, exchange_horiz_2d, flow_statistics, header, init_grid, init_particles, init_pegrid, init_rankine, init_pt_anomaly, init_1d_model, init_3d_model, modules, palm, package_parin, parin, poisfft, poismg, prandtl_fluxes, pres, production_e, prognostic_equations, read_var_list, read_3d_binary, sor, swap_timelevel, time_integration, write_var_list, write_3d_binary

Errors:


Bugfix: preset of tendencies te_em, te_um, te_vm in init_1d_model

Bugfix in sample for reading user defined data from restart file (user_init)

Bugfix in setting diffusivities for cases with the outflow damping layer extending over more than one subdomain (init_3d_model)

Check for possible negative humidities in the initial humidity profile.

in Makefile, default suffixes removed from the suffix list to avoid calling of m2c in
# case of .mod files

Makefile
check_parameters, init_1d_model, init_3d_model, user_interface

  • Property svn:keywords set to Id
File size: 54.9 KB
Line 
1 SUBROUTINE header
2
3!------------------------------------------------------------------------------!
4! Actual revisions:
5! -----------------
6!
7!
8! Former revisions:
9! -----------------
10! $Id: header.f90 77 2007-03-29 04:26:56Z raasch $
11!
12! 76 2007-03-29 00:58:32Z raasch
13! Output of netcdf_64bit_3d, particles-package is now part of the default code,
14! output of the loop optimization method, moisture renamed humidity,
15! output of subversion revision number
16!
17! 19 2007-02-23 04:53:48Z raasch
18! Output of scalar flux applied at top boundary
19!
20! RCS Log replace by Id keyword, revision history cleaned up
21!
22! Revision 1.63  2006/08/22 13:53:13  raasch
23! Output of dz_max
24!
25! Revision 1.1  1997/08/11 06:17:20  raasch
26! Initial revision
27!
28!
29! Description:
30! ------------
31! Writing a header with all important informations about the actual run.
32! This subroutine is called three times, two times at the beginning
33! (writing information on files RUN_CONTROL and HEADER) and one time at the
34! end of the run, then writing additional information about CPU-usage on file
35! header.
36!------------------------------------------------------------------------------!
37
38    USE arrays_3d
39    USE control_parameters
40    USE cloud_parameters
41    USE cpulog
42    USE dvrp_variables
43    USE grid_variables
44    USE indices
45    USE model_1d
46    USE particle_attributes
47    USE pegrid
48    USE spectrum
49
50    IMPLICIT NONE
51
52    CHARACTER (LEN=1)  ::  prec
53    CHARACTER (LEN=2)  ::  do2d_mode
54    CHARACTER (LEN=5)  ::  section_chr
55    CHARACTER (LEN=9)  ::  time_to_string
56    CHARACTER (LEN=10) ::  coor_chr, host_chr
57    CHARACTER (LEN=16) ::  begin_chr
58    CHARACTER (LEN=21) ::  ver_rev
59    CHARACTER (LEN=40) ::  output_format
60    CHARACTER (LEN=70) ::  char1, char2, coordinates, gradients, dopr_chr, &
61                           do2d_xy, do2d_xz, do2d_yz, do3d_chr, &
62                           run_classification, slices, temperatures, &
63                           ugcomponent, vgcomponent
64    CHARACTER (LEN=85) ::  roben, runten
65
66    INTEGER ::  av, bh, blx, bly, bxl, bxr, byn, bys, i, ihost, io, j, l, ll
67    REAL    ::  cpuseconds_per_simulated_second
68
69!
70!-- Open the output file. At the end of the simulation, output is directed
71!-- to unit 19.
72    IF ( ( runnr == 0 .OR. force_print_header )  .AND. &
73         .NOT. simulated_time_at_begin /= simulated_time )  THEN
74       io = 15   !  header output on file RUN_CONTROL
75    ELSE
76       io = 19   !  header output on file HEADER
77    ENDIF
78    CALL check_open( io )
79
80!
81!-- At the end of the run, output file (HEADER) will be rewritten with
82!-- new informations
83    IF ( io == 19 .AND. simulated_time_at_begin /= simulated_time ) REWIND( 19 )
84
85!
86!-- Determine kind of model run
87    IF ( TRIM( initializing_actions ) == 'read_restart_data' )  THEN
88       run_classification = '3D - restart run'
89    ELSE
90       IF ( INDEX( initializing_actions, 'set_constant_profiles' ) /= 0 )  THEN
91          run_classification = '3D - run without 1D - prerun'
92       ELSEIF ( INDEX(initializing_actions, 'set_1d-model_profiles') /= 0 ) THEN
93          run_classification = '3D - run with 1D - prerun'
94       ELSE
95          PRINT*,'+++ header:  unknown action(s): ',initializing_actions
96       ENDIF
97    ENDIF
98
99!
100!-- Run-identification, date, time, host
101    host_chr = host(1:10)
102    ver_rev = TRIM( version ) // '  ' // TRIM( revision )
103    WRITE ( io, 100 )  ver_rev, TRIM( run_classification ), run_date, &
104                       run_identifier, run_time, runnr, ADJUSTR( host_chr )
105#if defined( __parallel )
106    IF ( npex == -1  .AND.  pdims(2) /= 1 )  THEN
107       char1 = 'calculated'
108    ELSEIF ( ( host(1:3) == 'ibm'  .OR.  host(1:3) == 'nec'  .OR.  &
109               host(1:2) == 'lc' )  .AND.                          &
110             npex == -1  .AND.  pdims(2) == 1 )  THEN
111       char1 = 'forced'
112    ELSE
113       char1 = 'predefined'
114    ENDIF
115    IF ( threads_per_task == 1 )  THEN
116       WRITE ( io, 101 )  numprocs, pdims(1), pdims(2), TRIM( char1 )
117    ELSE
118       WRITE ( io, 102 )  numprocs*threads_per_task, numprocs, &
119                          threads_per_task, pdims(1), pdims(2), TRIM( char1 )
120    ENDIF
121    IF ( ( host(1:3) == 'ibm'  .OR.  host(1:3) == 'nec'  .OR.    &
122           host(1:2) == 'lc'   .OR.  host(1:3) == 'dec' )  .AND. &
123         npex == -1  .AND.  pdims(2) == 1 )                      &
124    THEN
125       WRITE ( io, 104 )
126    ELSEIF ( pdims(2) == 1 )  THEN
127       WRITE ( io, 105 )  'x'
128    ELSEIF ( pdims(1) == 1 )  THEN
129       WRITE ( io, 105 )  'y'
130    ENDIF
131    IF ( use_seperate_pe_for_dvrp_output )  WRITE ( io, 103 )
132#endif
133    WRITE ( io, 99 )
134
135!
136!-- Numerical schemes
137    WRITE ( io, 110 )
138    IF ( psolver(1:7) == 'poisfft' )  THEN
139       WRITE ( io, 111 )  TRIM( fft_method )
140       IF ( psolver == 'poisfft_hybrid' )  WRITE ( io, 138 )
141    ELSEIF ( psolver == 'sor' )  THEN
142       WRITE ( io, 112 )  nsor_ini, nsor, omega_sor
143    ELSEIF ( psolver == 'multigrid' )  THEN
144       WRITE ( io, 135 )  cycle_mg, maximum_grid_level, ngsrb
145       IF ( mg_cycles == -1 )  THEN
146          WRITE ( io, 140 )  residual_limit
147       ELSE
148          WRITE ( io, 141 )  mg_cycles
149       ENDIF
150       IF ( mg_switch_to_pe0_level == 0 )  THEN
151          WRITE ( io, 136 )  nxr_mg(1)-nxl_mg(1)+1, nyn_mg(1)-nys_mg(1)+1, &
152                             nzt_mg(1)
153       ELSE
154          WRITE ( io, 137 )  mg_switch_to_pe0_level,            &
155                             mg_loc_ind(2,0)-mg_loc_ind(1,0)+1, &
156                             mg_loc_ind(4,0)-mg_loc_ind(3,0)+1, &
157                             nzt_mg(mg_switch_to_pe0_level),    &
158                             nxr_mg(1)-nxl_mg(1)+1, nyn_mg(1)-nys_mg(1)+1, &
159                             nzt_mg(1)
160       ENDIF
161    ENDIF
162    IF ( call_psolver_at_all_substeps  .AND. timestep_scheme(1:5) == 'runge' ) &
163    THEN
164       WRITE ( io, 142 )
165    ENDIF
166
167    IF ( momentum_advec == 'pw-scheme' )  THEN
168       WRITE ( io, 113 )
169    ELSE
170       WRITE ( io, 114 )
171       IF ( cut_spline_overshoot )  WRITE ( io, 124 )
172       IF ( overshoot_limit_u /= 0.0  .OR.  overshoot_limit_v /= 0.0  .OR. &
173            overshoot_limit_w /= 0.0 )  THEN
174          WRITE ( io, 127 )  overshoot_limit_u, overshoot_limit_v, &
175                             overshoot_limit_w
176       ENDIF
177       IF ( ups_limit_u /= 0.0  .OR.  ups_limit_v /= 0.0  .OR. &
178            ups_limit_w /= 0.0 )                               &
179       THEN
180          WRITE ( io, 125 )  ups_limit_u, ups_limit_v, ups_limit_w
181       ENDIF
182       IF ( long_filter_factor /= 0.0 )  WRITE ( io, 115 )  long_filter_factor
183    ENDIF
184    IF ( scalar_advec == 'pw-scheme' )  THEN
185       WRITE ( io, 116 )
186    ELSEIF ( scalar_advec == 'ups-scheme' )  THEN
187       WRITE ( io, 117 )
188       IF ( cut_spline_overshoot )  WRITE ( io, 124 )
189       IF ( overshoot_limit_e /= 0.0  .OR.  overshoot_limit_pt /= 0.0 )  THEN
190          WRITE ( io, 128 )  overshoot_limit_e, overshoot_limit_pt
191       ENDIF
192       IF ( ups_limit_e /= 0.0  .OR.  ups_limit_pt /= 0.0 )  THEN
193          WRITE ( io, 126 )  ups_limit_e, ups_limit_pt
194       ENDIF
195    ELSE
196       WRITE ( io, 118 )
197    ENDIF
198
199    WRITE ( io, 139 )  TRIM( loop_optimization )
200
201    IF ( galilei_transformation )  THEN
202       IF ( use_ug_for_galilei_tr )  THEN
203          char1 = 'geostrophic wind'
204       ELSE
205          char1 = 'mean wind in model domain'
206       ENDIF
207       IF ( simulated_time_at_begin == simulated_time )  THEN
208          char2 = 'at the start of the run'
209       ELSE
210          char2 = 'at the end of the run'
211       ENDIF
212       WRITE ( io, 119 )  TRIM( char1 ), TRIM( char2 ), &
213                          advected_distance_x/1000.0, advected_distance_y/1000.0
214    ENDIF
215    IF ( timestep_scheme == 'leapfrog' )  THEN
216       WRITE ( io, 120 )
217    ELSEIF ( timestep_scheme == 'leapfrog+euler' )  THEN
218       WRITE ( io, 121 )
219    ELSE
220       WRITE ( io, 122 )  timestep_scheme
221    ENDIF
222    IF ( rayleigh_damping_factor /= 0.0 )  THEN
223       WRITE ( io, 123 )  rayleigh_damping_height, rayleigh_damping_factor
224    ENDIF
225    IF ( humidity )  THEN
226       IF ( .NOT. cloud_physics )  THEN
227          WRITE ( io, 129 )
228       ELSE
229          WRITE ( io, 130 )
230          WRITE ( io, 131 )
231          IF ( radiation )      WRITE ( io, 132 )
232          IF ( precipitation )  WRITE ( io, 133 )
233       ENDIF
234    ENDIF
235    IF ( passive_scalar )  WRITE ( io, 134 )
236    IF ( conserve_volume_flow )  WRITE ( io, 150 )
237    WRITE ( io, 99 )
238
239!
240!-- Runtime and timestep informations
241    WRITE ( io, 200 )
242    IF ( .NOT. dt_fixed )  THEN
243       WRITE ( io, 201 )  dt_max, cfl_factor
244    ELSE
245       WRITE ( io, 202 )  dt
246    ENDIF
247    WRITE ( io, 203 )  simulated_time_at_begin, end_time
248
249    IF ( time_restart /= 9999999.9  .AND. &
250         simulated_time_at_begin == simulated_time )  THEN
251       IF ( dt_restart == 9999999.9 )  THEN
252          WRITE ( io, 204 )  ' Restart at:       ',time_restart
253       ELSE
254          WRITE ( io, 205 )  ' Restart at:       ',time_restart, dt_restart
255       ENDIF
256    ENDIF
257
258    IF ( simulated_time_at_begin /= simulated_time )  THEN
259       i = MAX ( log_point_s(10)%counts, 1 )
260       IF ( ( simulated_time - simulated_time_at_begin ) == 0.0 )  THEN
261          cpuseconds_per_simulated_second = 0.0
262       ELSE
263          cpuseconds_per_simulated_second = log_point_s(10)%sum / &
264                                            ( simulated_time -    &
265                                              simulated_time_at_begin )
266       ENDIF
267       WRITE ( io, 206 )  simulated_time, log_point_s(10)%sum, &
268                          log_point_s(10)%sum / REAL( i ),     &
269                          cpuseconds_per_simulated_second
270       IF ( time_restart /= 9999999.9  .AND.  time_restart < end_time )  THEN
271          IF ( dt_restart == 9999999.9 )  THEN
272             WRITE ( io, 204 )  ' Next restart at:  ',time_restart
273          ELSE
274             WRITE ( io, 205 )  ' Next restart at:  ',time_restart, dt_restart
275          ENDIF
276       ENDIF
277    ENDIF
278
279!
280!-- Computational grid
281    WRITE ( io, 250 )  dx, dy, dz, (nx+1)*dx, (ny+1)*dy, zu(nzt+1)
282    IF ( dz_stretch_level_index < nzt+1 )  THEN
283       WRITE ( io, 252 )  dz_stretch_level, dz_stretch_level_index, &
284                          dz_stretch_factor, dz_max
285    ENDIF
286    WRITE ( io, 254 )  nx, ny, nzt+1, MIN( nnx, nx+1 ), MIN( nny, ny+1 ), &
287                       MIN( nnz+2, nzt+2 )
288    IF ( numprocs > 1 )  THEN
289       IF ( nxa == nx  .AND.  nya == ny  .AND.  nza == nz )  THEN
290          WRITE ( io, 255 )
291       ELSE
292          WRITE ( io, 256 )  nnx-(nxa-nx), nny-(nya-ny), nzt+2
293       ENDIF
294    ENDIF
295    IF ( sloping_surface )  WRITE ( io, 260 )  alpha_surface
296
297!
298!-- Topography
299    WRITE ( io, 270 )  topography
300    SELECT CASE ( TRIM( topography ) )
301
302       CASE ( 'flat' )
303          ! no actions necessary
304
305       CASE ( 'single_building' )
306          blx = INT( building_length_x / dx )
307          bly = INT( building_length_y / dy )
308          bh  = INT( building_height / dz )
309
310          IF ( building_wall_left == 9999999.9 )  THEN
311             building_wall_left = ( nx + 1 - blx ) / 2 * dx
312          ENDIF
313          bxl = INT ( building_wall_left / dx + 0.5 )
314          bxr = bxl + blx
315
316          IF ( building_wall_south == 9999999.9 )  THEN
317             building_wall_south = ( ny + 1 - bly ) / 2 * dy
318          ENDIF
319          bys = INT ( building_wall_south / dy + 0.5 )
320          byn = bys + bly
321
322          WRITE ( io, 271 )  building_length_x, building_length_y, &
323                             building_height, bxl, bxr, bys, byn
324
325    END SELECT
326
327!
328!-- Boundary conditions
329    IF ( ibc_p_b == 0 )  THEN
330       runten = 'p(0)     = 0      |'
331    ELSEIF ( ibc_p_b == 1 )  THEN
332       runten = 'p(0)     = p(1)   |'
333    ELSE
334       runten = 'p(0)     = p(1) +R|'
335    ENDIF
336    IF ( ibc_p_t == 0 )  THEN
337       roben  = 'p(nzt+1) = 0      |'
338    ELSE
339       roben  = 'p(nzt+1) = p(nzt) |'
340    ENDIF
341
342    IF ( ibc_uv_b == 0 )  THEN
343       runten = TRIM( runten ) // ' uv(0)     = -uv(1)                |'
344    ELSE
345       runten = TRIM( runten ) // ' uv(0)     = uv(1)                 |'
346    ENDIF
347    IF ( ibc_uv_t == 0 )  THEN
348       roben  = TRIM( roben  ) // ' uv(nzt+1) = ug(nzt+1), vg(nzt+1)  |'
349    ELSE
350       roben  = TRIM( roben  ) // ' uv(nzt+1) = uv(nzt)               |'
351    ENDIF
352
353    IF ( ibc_pt_b == 0 )  THEN
354       runten = TRIM( runten ) // ' pt(0)   = pt_surface'
355    ELSE
356       runten = TRIM( runten ) // ' pt(0)   = pt(1)'
357    ENDIF
358    IF ( ibc_pt_t == 0 )  THEN
359       roben  = TRIM( roben  ) // ' pt(nzt+1) = pt_top'
360    ELSEIF( ibc_pt_t == 1 )  THEN
361       roben  = TRIM( roben  ) // ' pt(nzt+1) = pt(nzt)'
362    ELSEIF( ibc_pt_t == 2 )  THEN
363       roben  = TRIM( roben  ) // ' pt(nzt+1) = pt(nzt) + dpt/dz_ini'
364    ENDIF
365
366    WRITE ( io, 300 )  runten, roben
367
368    IF ( .NOT. constant_diffusion )  THEN
369       IF ( ibc_e_b == 1 )  THEN
370          runten = 'e(0)     = e(1)'
371       ELSE
372          runten = 'e(0)     = e(1) = (u*/0.1)**2'
373       ENDIF
374       roben = 'e(nzt+1) = e(nzt) = e(nzt-1)'
375
376       WRITE ( io, 301 )  runten, roben       
377
378    ENDIF
379
380    IF ( humidity  .OR.  passive_scalar )  THEN
381       IF ( humidity )  THEN
382          IF ( ibc_q_b == 0 )  THEN
383             runten = 'q(0)     = q_surface'
384          ELSE
385             runten = 'q(0)     = q(1)'
386          ENDIF
387          IF ( ibc_q_t == 0 )  THEN
388             roben =  'q(nzt)   = q_top'
389          ELSE
390             roben =  'q(nzt)   = q(nzt-1) + dq/dz'
391          ENDIF
392       ELSE
393          IF ( ibc_q_b == 0 )  THEN
394             runten = 's(0)     = s_surface'
395          ELSE
396             runten = 's(0)     = s(1)'
397          ENDIF
398          IF ( ibc_q_t == 0 )  THEN
399             roben =  's(nzt)   = s_top'
400          ELSE
401             roben =  's(nzt)   = s(nzt-1) + ds/dz'
402          ENDIF
403       ENDIF
404
405       WRITE ( io, 302 ) runten, roben
406
407    ENDIF
408
409    IF ( use_surface_fluxes )  THEN
410       WRITE ( io, 303 )
411       IF ( constant_heatflux )  THEN
412          WRITE ( io, 306 )  surface_heatflux
413          IF ( random_heatflux )  WRITE ( io, 307 )
414       ENDIF
415       IF ( humidity  .AND.  constant_waterflux )  THEN
416          WRITE ( io, 311 ) surface_waterflux
417       ENDIF
418       IF ( passive_scalar  .AND.  constant_waterflux )  THEN
419          WRITE ( io, 313 ) surface_waterflux
420       ENDIF
421    ENDIF
422
423    IF ( use_top_fluxes )  THEN
424       WRITE ( io, 304 )
425       IF ( constant_top_heatflux )  THEN
426          WRITE ( io, 306 )  top_heatflux
427       ENDIF
428       IF ( humidity  .OR.  passive_scalar )  THEN
429          WRITE ( io, 315 )
430       ENDIF
431    ENDIF
432
433    IF ( prandtl_layer )  THEN
434       WRITE ( io, 305 )  zu(1), roughness_length, kappa, rif_min, rif_max
435       IF ( .NOT. constant_heatflux )  WRITE ( io, 308 )
436       IF ( humidity  .AND.  .NOT. constant_waterflux )  THEN
437          WRITE ( io, 312 )
438       ENDIF
439       IF ( passive_scalar  .AND.  .NOT. constant_waterflux )  THEN
440          WRITE ( io, 314 )
441       ENDIF
442    ELSE
443       IF ( INDEX(initializing_actions, 'set_1d-model_profiles') /= 0 )  THEN
444          WRITE ( io, 310 )  rif_min, rif_max
445       ENDIF
446    ENDIF
447
448    WRITE ( io, 317 )  bc_lr, bc_ns
449    IF ( bc_lr /= 'cyclic'  .OR.  bc_ns /= 'cyclic' )  THEN
450       WRITE ( io, 318 )  outflow_damping_width, km_damp_max
451    ENDIF
452
453!
454!-- Listing of 1D-profiles
455    WRITE ( io, 320 )  dt_dopr_listing
456    IF ( averaging_interval_pr /= 0.0 )  THEN
457       WRITE ( io, 321 )  averaging_interval_pr, dt_averaging_input_pr
458    ENDIF
459
460!
461!-- DATA output
462    WRITE ( io, 330 )
463    IF ( averaging_interval_pr /= 0.0 )  THEN
464       WRITE ( io, 321 )  averaging_interval_pr, dt_averaging_input_pr
465    ENDIF
466
467!
468!-- 1D-profiles
469    dopr_chr = 'Profile:'
470    IF ( dopr_n /= 0 )  THEN
471       WRITE ( io, 331 )
472
473       output_format = ''
474       IF ( netcdf_output )  THEN
475          IF ( netcdf_64bit )  THEN
476             output_format = 'netcdf (64 bit offset)'
477          ELSE
478             output_format = 'netcdf'
479          ENDIF
480       ENDIF
481       IF ( profil_output )  THEN
482          IF ( netcdf_output )  THEN
483             output_format = TRIM( output_format ) // ' and profil'
484          ELSE
485             output_format = 'profil'
486          ENDIF
487       ENDIF
488       WRITE ( io, 345 )  output_format
489
490       DO  i = 1, dopr_n
491          dopr_chr = TRIM( dopr_chr ) // ' ' // TRIM( data_output_pr(i) ) // ','
492          IF ( LEN_TRIM( dopr_chr ) >= 60 )  THEN
493             WRITE ( io, 332 )  dopr_chr
494             dopr_chr = '       :'
495          ENDIF
496       ENDDO
497
498       IF ( dopr_chr /= '' )  THEN
499          WRITE ( io, 332 )  dopr_chr
500       ENDIF
501       WRITE ( io, 333 )  dt_dopr, averaging_interval_pr, dt_averaging_input_pr
502       IF ( skip_time_dopr /= 0.0 )  WRITE ( io, 339 )  skip_time_dopr
503    ENDIF
504
505!
506!-- 2D-arrays
507    DO  av = 0, 1
508
509       i = 1
510       do2d_xy = ''
511       do2d_xz = ''
512       do2d_yz = ''
513       DO  WHILE ( do2d(av,i) /= ' ' )
514
515          l = MAX( 2, LEN_TRIM( do2d(av,i) ) )
516          do2d_mode = do2d(av,i)(l-1:l)
517
518          SELECT CASE ( do2d_mode )
519             CASE ( 'xy' )
520                ll = LEN_TRIM( do2d_xy )
521                do2d_xy = do2d_xy(1:ll) // ' ' // do2d(av,i)(1:l-3) // ','
522             CASE ( 'xz' )
523                ll = LEN_TRIM( do2d_xz )
524                do2d_xz = do2d_xz(1:ll) // ' ' // do2d(av,i)(1:l-3) // ','
525             CASE ( 'yz' )
526                ll = LEN_TRIM( do2d_yz )
527                do2d_yz = do2d_yz(1:ll) // ' ' // do2d(av,i)(1:l-3) // ','
528          END SELECT
529
530          i = i + 1
531
532       ENDDO
533
534       IF ( ( ( do2d_xy /= ''  .AND.  section(1,1) /= -9999 )  .OR.    &
535              ( do2d_xz /= ''  .AND.  section(1,2) /= -9999 )  .OR.    &
536              ( do2d_yz /= ''  .AND.  section(1,3) /= -9999 ) )  .AND. &
537            ( netcdf_output  .OR.  iso2d_output ) )  THEN
538
539          IF (  av == 0 )  THEN
540             WRITE ( io, 334 )  ''
541          ELSE
542             WRITE ( io, 334 )  '(time-averaged)'
543          ENDIF
544
545          IF ( do2d_at_begin )  THEN
546             begin_chr = 'and at the start'
547          ELSE
548             begin_chr = ''
549          ENDIF
550
551          output_format = ''
552          IF ( netcdf_output )  THEN
553             IF ( netcdf_64bit )  THEN
554                output_format = 'netcdf (64 bit offset)'
555             ELSE
556                output_format = 'netcdf'
557             ENDIF
558          ENDIF
559          IF ( iso2d_output )  THEN
560             IF ( netcdf_output )  THEN
561                output_format = TRIM( output_format ) // ' and iso2d'
562             ELSE
563                output_format = 'iso2d'
564             ENDIF
565          ENDIF
566          WRITE ( io, 345 )  output_format
567
568          IF ( do2d_xy /= ''  .AND.  section(1,1) /= -9999 )  THEN
569             i = 1
570             slices = '/'
571             coordinates = '/'
572!
573!--          Building strings with index and coordinate informations of the
574!--          slices
575             DO  WHILE ( section(i,1) /= -9999 )
576
577                WRITE (section_chr,'(I5)')  section(i,1)
578                section_chr = ADJUSTL( section_chr )
579                slices = TRIM( slices ) // TRIM( section_chr ) // '/'
580
581                WRITE (coor_chr,'(F10.1)')  zu(section(i,1))
582                coor_chr = ADJUSTL( coor_chr )
583                coordinates = TRIM( coordinates ) // TRIM( coor_chr ) // '/'
584
585                i = i + 1
586             ENDDO
587             IF ( av == 0 )  THEN
588                WRITE ( io, 335 )  'XY', do2d_xy, dt_do2d_xy, &
589                                   TRIM( begin_chr ), 'k', TRIM( slices ), &
590                                   TRIM( coordinates )
591                IF ( skip_time_do2d_xy /= 0.0 )  THEN
592                   WRITE ( io, 339 )  skip_time_do2d_xy
593                ENDIF
594             ELSE
595                WRITE ( io, 342 )  'XY', do2d_xy, dt_data_output_av, &
596                                   TRIM( begin_chr ), averaging_interval, &
597                                   dt_averaging_input, 'k', TRIM( slices ), &
598                                   TRIM( coordinates )
599                IF ( skip_time_data_output_av /= 0.0 )  THEN
600                   WRITE ( io, 339 )  skip_time_data_output_av
601                ENDIF
602             ENDIF
603
604          ENDIF
605
606          IF ( do2d_xz /= ''  .AND.  section(1,2) /= -9999 )  THEN
607             i = 1
608             slices = '/'
609             coordinates = '/'
610!
611!--          Building strings with index and coordinate informations of the
612!--          slices
613             DO  WHILE ( section(i,2) /= -9999 )
614
615                WRITE (section_chr,'(I5)')  section(i,2)
616                section_chr = ADJUSTL( section_chr )
617                slices = TRIM( slices ) // TRIM( section_chr ) // '/'
618
619                WRITE (coor_chr,'(F10.1)')  section(i,2) * dy
620                coor_chr = ADJUSTL( coor_chr )
621                coordinates = TRIM( coordinates ) // TRIM( coor_chr ) // '/'
622
623                i = i + 1
624             ENDDO
625             IF ( av == 0 )  THEN
626                WRITE ( io, 335 )  'XZ', do2d_xz, dt_do2d_xz, &
627                                   TRIM( begin_chr ), 'j', TRIM( slices ), &
628                                   TRIM( coordinates )
629                IF ( skip_time_do2d_xz /= 0.0 )  THEN
630                   WRITE ( io, 339 )  skip_time_do2d_xz
631                ENDIF
632             ELSE
633                WRITE ( io, 342 )  'XZ', do2d_xz, dt_data_output_av, &
634                                   TRIM( begin_chr ), averaging_interval, &
635                                   dt_averaging_input, 'j', TRIM( slices ), &
636                                   TRIM( coordinates )
637                IF ( skip_time_data_output_av /= 0.0 )  THEN
638                   WRITE ( io, 339 )  skip_time_data_output_av
639                ENDIF
640             ENDIF
641          ENDIF
642
643          IF ( do2d_yz /= ''  .AND.  section(1,3) /= -9999 )  THEN
644             i = 1
645             slices = '/'
646             coordinates = '/'
647!
648!--          Building strings with index and coordinate informations of the
649!--          slices
650             DO  WHILE ( section(i,3) /= -9999 )
651
652                WRITE (section_chr,'(I5)')  section(i,3)
653                section_chr = ADJUSTL( section_chr )
654                slices = TRIM( slices ) // TRIM( section_chr ) // '/'
655
656                WRITE (coor_chr,'(F10.1)')  section(i,3) * dx
657                coor_chr = ADJUSTL( coor_chr )
658                coordinates = TRIM( coordinates ) // TRIM( coor_chr ) // '/'
659
660                i = i + 1
661             ENDDO
662             IF ( av == 0 )  THEN
663                WRITE ( io, 335 )  'YZ', do2d_yz, dt_do2d_yz, &
664                                   TRIM( begin_chr ), 'i', TRIM( slices ), &
665                                   TRIM( coordinates )
666                IF ( skip_time_do2d_yz /= 0.0 )  THEN
667                   WRITE ( io, 339 )  skip_time_do2d_yz
668                ENDIF
669             ELSE
670                WRITE ( io, 342 )  'YZ', do2d_yz, dt_data_output_av, &
671                                   TRIM( begin_chr ), averaging_interval, &
672                                   dt_averaging_input, 'i', TRIM( slices ), &
673                                   TRIM( coordinates )
674                IF ( skip_time_data_output_av /= 0.0 )  THEN
675                   WRITE ( io, 339 )  skip_time_data_output_av
676                ENDIF
677             ENDIF
678          ENDIF
679
680       ENDIF
681
682    ENDDO
683
684!
685!-- 3d-arrays
686    DO  av = 0, 1
687
688       i = 1
689       do3d_chr = ''
690       DO  WHILE ( do3d(av,i) /= ' ' )
691
692          do3d_chr = TRIM( do3d_chr ) // ' ' // TRIM( do3d(av,i) ) // ','
693          i = i + 1
694
695       ENDDO
696
697       IF ( do3d_chr /= '' )  THEN
698          IF ( av == 0 )  THEN
699             WRITE ( io, 336 )  ''
700          ELSE
701             WRITE ( io, 336 )  '(time-averaged)'
702          ENDIF
703
704          output_format = ''
705          IF ( netcdf_output )  THEN
706             IF ( netcdf_64bit .AND. netcdf_64bit_3d )  THEN
707                output_format = 'netcdf (64 bit offset)'
708             ELSE
709                output_format = 'netcdf'
710             ENDIF
711          ENDIF
712          IF ( avs_output )  THEN
713             IF ( netcdf_output )  THEN
714                output_format = TRIM( output_format ) // ' and avs'
715             ELSE
716                output_format = 'avs'
717             ENDIF
718          ENDIF
719          WRITE ( io, 345 )  output_format
720
721          IF ( do3d_at_begin )  THEN
722             begin_chr = 'and at the start'
723          ELSE
724             begin_chr = ''
725          ENDIF
726          IF ( av == 0 )  THEN
727             WRITE ( io, 337 )  do3d_chr, dt_do3d, TRIM( begin_chr ), &
728                                zu(nz_do3d), nz_do3d
729          ELSE
730             WRITE ( io, 343 )  do3d_chr, dt_data_output_av,           &
731                                TRIM( begin_chr ), averaging_interval, &
732                                dt_averaging_input, zu(nz_do3d), nz_do3d
733          ENDIF
734
735          IF ( do3d_compress )  THEN
736             do3d_chr = ''
737             i = 1
738             DO WHILE ( do3d(av,i) /= ' ' )
739
740                SELECT CASE ( do3d(av,i) )
741                   CASE ( 'u' )
742                      j = 1
743                   CASE ( 'v' )
744                      j = 2
745                   CASE ( 'w' )
746                      j = 3
747                   CASE ( 'p' )
748                      j = 4
749                   CASE ( 'pt' )
750                      j = 5
751                END SELECT
752                WRITE ( prec, '(I1)' )  plot_3d_precision(j)%precision
753                do3d_chr = TRIM( do3d_chr ) // ' ' // TRIM( do3d(av,i) ) // &
754                           ':' // prec // ','
755                i = i + 1
756
757             ENDDO
758             WRITE ( io, 338 )  do3d_chr
759
760          ENDIF
761
762          IF ( av == 0 )  THEN
763             IF ( skip_time_do3d /= 0.0 )  THEN
764                WRITE ( io, 339 )  skip_time_do3d
765             ENDIF
766          ELSE
767             IF ( skip_time_data_output_av /= 0.0 )  THEN
768                WRITE ( io, 339 )  skip_time_data_output_av
769             ENDIF
770          ENDIF
771
772       ENDIF
773
774    ENDDO
775
776!
777!-- Timeseries
778    IF ( dt_dots /= 9999999.9 )  THEN
779       WRITE ( io, 340 )
780
781       output_format = ''
782       IF ( netcdf_output )  THEN
783          IF ( netcdf_64bit )  THEN
784             output_format = 'netcdf (64 bit offset)'
785          ELSE
786             output_format = 'netcdf'
787          ENDIF
788       ENDIF
789       IF ( profil_output )  THEN
790          IF ( netcdf_output )  THEN
791             output_format = TRIM( output_format ) // ' and profil'
792          ELSE
793             output_format = 'profil'
794          ENDIF
795       ENDIF
796       WRITE ( io, 345 )  output_format
797       WRITE ( io, 341 )  dt_dots
798    ENDIF
799
800#if defined( __dvrp_graphics )
801!
802!-- Dvrp-output
803    IF ( dt_dvrp /= 9999999.9 )  THEN
804       WRITE ( io, 360 )  dt_dvrp, TRIM( dvrp_output ), TRIM( dvrp_host ), &
805                          TRIM( dvrp_username ), TRIM( dvrp_directory )
806       i = 1
807       l = 0
808       DO WHILE ( mode_dvrp(i) /= ' ' )
809          IF ( mode_dvrp(i)(1:10) == 'isosurface' )  THEN
810             READ ( mode_dvrp(i), '(10X,I1)' )  j
811             l = l + 1
812             IF ( do3d(0,j) /= ' ' )  THEN
813                WRITE ( io, 361 )  TRIM( do3d(0,j) ), threshold(l)
814             ENDIF
815          ELSEIF ( mode_dvrp(i)(1:6) == 'slicer' )  THEN
816             READ ( mode_dvrp(i), '(6X,I1)' )  j
817             IF ( do2d(0,j) /= ' ' )  WRITE ( io, 362 )  TRIM( do2d(0,j) )
818          ELSEIF ( mode_dvrp(i)(1:9) == 'particles' )  THEN
819             WRITE ( io, 363 )
820          ENDIF
821          i = i + 1
822       ENDDO
823    ENDIF
824#endif
825
826#if defined( __spectra )
827!
828!-- Spectra output
829    IF ( dt_dosp /= 9999999.9 ) THEN
830       WRITE ( io, 370 )
831
832       output_format = ''
833       IF ( netcdf_output )  THEN
834          IF ( netcdf_64bit )  THEN
835             output_format = 'netcdf (64 bit offset)'
836          ELSE
837             output_format = 'netcdf'
838          ENDIF
839       ENDIF
840       IF ( profil_output )  THEN
841          IF ( netcdf_output )  THEN
842             output_format = TRIM( output_format ) // ' and profil'
843          ELSE
844             output_format = 'profil'
845          ENDIF
846       ENDIF
847       WRITE ( io, 345 )  output_format
848       WRITE ( io, 371 )  dt_dosp
849       IF ( skip_time_dosp /= 0.0 )  WRITE ( io, 339 )  skip_time_dosp
850       WRITE ( io, 372 )  ( data_output_sp(i), i = 1,10 ),     &
851                          ( spectra_direction(i), i = 1,10 ),  &
852                          ( comp_spectra_level(i), i = 1,10 ), &
853                          ( plot_spectra_level(i), i = 1,10 ), &
854                          averaging_interval_sp, dt_averaging_input_pr
855    ENDIF
856#endif
857
858    WRITE ( io, 99 )
859
860!
861!-- Physical quantities
862    WRITE ( io, 400 )
863
864!
865!-- Geostrophic parameters
866    WRITE ( io, 410 )  omega, phi, f, fs
867
868!
869!-- Other quantities
870    WRITE ( io, 411 )  g
871    IF ( use_pt_reference )  WRITE ( io, 412 )  pt_reference
872
873!
874!-- Cloud physics parameters
875    IF ( cloud_physics ) THEN
876       WRITE ( io, 415 )
877       WRITE ( io, 416 ) surface_pressure, r_d, rho_surface, cp, l_v
878    ENDIF
879
880!-- Profile of the geostrophic wind (component ug)
881!-- Building output strings
882    WRITE ( ugcomponent, '(F6.2)' )  ug_surface
883    gradients = '------'
884    slices = '     0'
885    coordinates = '   0.0'
886    i = 1
887    DO  WHILE ( ug_vertical_gradient_level_ind(i) /= -9999 )
888     
889       WRITE (coor_chr,'(F6.2,4X)')  ug(ug_vertical_gradient_level_ind(i))
890       ugcomponent = TRIM( ugcomponent ) // '  ' // TRIM( coor_chr )
891
892       WRITE (coor_chr,'(F6.2,4X)')  ug_vertical_gradient(i)
893       gradients = TRIM( gradients ) // '  ' // TRIM( coor_chr )
894
895       WRITE (coor_chr,'(I6,4X)')  ug_vertical_gradient_level_ind(i)
896       slices = TRIM( slices ) // '  ' // TRIM( coor_chr )
897
898       WRITE (coor_chr,'(F6.1,4X)')  ug_vertical_gradient_level(i)
899       coordinates = TRIM( coordinates ) // '  ' // TRIM( coor_chr )
900
901       i = i + 1
902    ENDDO
903
904    WRITE ( io, 423 )  TRIM( coordinates ), TRIM( ugcomponent ), &
905                       TRIM( gradients ), TRIM( slices )
906
907!-- Profile of the geostrophic wind (component vg)
908!-- Building output strings
909    WRITE ( vgcomponent, '(F6.2)' )  vg_surface
910    gradients = '------'
911    slices = '     0'
912    coordinates = '   0.0'
913    i = 1
914    DO  WHILE ( vg_vertical_gradient_level_ind(i) /= -9999 )
915
916       WRITE (coor_chr,'(F6.2,4X)')  vg(vg_vertical_gradient_level_ind(i))
917       vgcomponent = TRIM( vgcomponent ) // '  ' // TRIM( coor_chr )
918
919       WRITE (coor_chr,'(F6.2,4X)')  vg_vertical_gradient(i)
920       gradients = TRIM( gradients ) // '  ' // TRIM( coor_chr )
921
922       WRITE (coor_chr,'(I6,4X)')  vg_vertical_gradient_level_ind(i)
923       slices = TRIM( slices ) // '  ' // TRIM( coor_chr )
924
925       WRITE (coor_chr,'(F6.1,4X)')  vg_vertical_gradient_level(i)
926       coordinates = TRIM( coordinates ) // '  ' // TRIM( coor_chr )
927
928       i = i + 1 
929    ENDDO
930
931    WRITE ( io, 424 )  TRIM( coordinates ), TRIM( vgcomponent ), &
932                       TRIM( gradients ), TRIM( slices )
933
934!
935!-- Initial temperature profile
936!-- Building output strings, starting with surface temperature
937    WRITE ( temperatures, '(F6.2)' )  pt_surface
938    gradients = '------'
939    slices = '     0'
940    coordinates = '   0.0'
941    i = 1
942    DO  WHILE ( pt_vertical_gradient_level_ind(i) /= -9999 )
943
944       WRITE (coor_chr,'(F6.2,4X)')  pt_init(pt_vertical_gradient_level_ind(i))
945       temperatures = TRIM( temperatures ) // '  ' // TRIM( coor_chr )
946
947       WRITE (coor_chr,'(F6.2,4X)')  pt_vertical_gradient(i)
948       gradients = TRIM( gradients ) // '  ' // TRIM( coor_chr )
949
950       WRITE (coor_chr,'(I6,4X)')  pt_vertical_gradient_level_ind(i)
951       slices = TRIM( slices ) // '  ' // TRIM( coor_chr )
952
953       WRITE (coor_chr,'(F6.1,4X)')  pt_vertical_gradient_level(i)
954       coordinates = TRIM( coordinates ) // '  '  // TRIM( coor_chr )
955
956       i = i + 1
957    ENDDO
958
959    WRITE ( io, 420 )  TRIM( coordinates ), TRIM( temperatures ), &
960                       TRIM( gradients ), TRIM( slices )
961
962!
963!-- Initial humidity profile
964!-- Building output strings, starting with surface humidity
965    IF ( humidity  .OR.  passive_scalar )  THEN
966       WRITE ( temperatures, '(E8.1)' )  q_surface
967       gradients = '--------'
968       slices = '       0'
969       coordinates = '     0.0'
970       i = 1
971       DO  WHILE ( q_vertical_gradient_level_ind(i) /= -9999 )
972         
973          WRITE (coor_chr,'(E8.1,4X)')  q_init(q_vertical_gradient_level_ind(i))
974          temperatures = TRIM( temperatures ) // '  ' // TRIM( coor_chr )
975
976          WRITE (coor_chr,'(E8.1,4X)')  q_vertical_gradient(i)
977          gradients = TRIM( gradients ) // '  ' // TRIM( coor_chr )
978         
979          WRITE (coor_chr,'(I8,4X)')  q_vertical_gradient_level_ind(i)
980          slices = TRIM( slices ) // '  ' // TRIM( coor_chr )
981         
982          WRITE (coor_chr,'(F8.1,4X)')  q_vertical_gradient_level(i)
983          coordinates = TRIM( coordinates ) // '  '  // TRIM( coor_chr )
984
985          i = i + 1
986       ENDDO
987
988       IF ( humidity )  THEN
989          WRITE ( io, 421 )  TRIM( coordinates ), TRIM( temperatures ), &
990                             TRIM( gradients ), TRIM( slices )
991       ELSE
992          WRITE ( io, 422 )  TRIM( coordinates ), TRIM( temperatures ), &
993                             TRIM( gradients ), TRIM( slices )
994       ENDIF
995    ENDIF
996
997!
998!-- LES / turbulence parameters
999    WRITE ( io, 450 )
1000
1001!--
1002! ... LES-constants used must still be added here
1003!--
1004    IF ( constant_diffusion )  THEN
1005       WRITE ( io, 451 )  km_constant, km_constant/prandtl_number, &
1006                          prandtl_number
1007    ENDIF
1008    IF ( .NOT. constant_diffusion)  THEN
1009       IF ( e_min > 0.0 )  WRITE ( io, 454 )  e_min
1010       IF ( wall_adjustment )  WRITE ( io, 453 )  wall_adjustment_factor
1011       IF ( adjust_mixing_length  .AND.  prandtl_layer )  WRITE ( io, 452 )
1012    ENDIF
1013
1014!
1015!-- Special actions during the run
1016    WRITE ( io, 470 )
1017    IF ( create_disturbances )  THEN
1018       WRITE ( io, 471 )  dt_disturb, disturbance_amplitude,                   &
1019                          zu(disturbance_level_ind_b), disturbance_level_ind_b,&
1020                          zu(disturbance_level_ind_t), disturbance_level_ind_t
1021       IF ( bc_lr /= 'cyclic'  .OR.  bc_ns /= 'cyclic' )  THEN
1022          WRITE ( io, 472 )  inflow_disturbance_begin, inflow_disturbance_end
1023       ELSE
1024          WRITE ( io, 473 )  disturbance_energy_limit
1025       ENDIF
1026       WRITE ( io, 474 )  TRIM( random_generator )
1027    ENDIF
1028    IF ( pt_surface_initial_change /= 0.0 )  THEN
1029       WRITE ( io, 475 )  pt_surface_initial_change
1030    ENDIF
1031    IF ( humidity  .AND.  q_surface_initial_change /= 0.0 )  THEN
1032       WRITE ( io, 476 )  q_surface_initial_change       
1033    ENDIF
1034    IF ( passive_scalar  .AND.  q_surface_initial_change /= 0.0 )  THEN
1035       WRITE ( io, 477 )  q_surface_initial_change       
1036    ENDIF
1037
1038    IF ( particle_advection )  THEN
1039!
1040!--    Particle attributes
1041       WRITE ( io, 480 )  particle_advection_start, dt_prel, bc_par_lr, &
1042                          bc_par_ns, bc_par_b, bc_par_t, particle_maximum_age, &
1043                          end_time_prel
1044       IF ( use_sgs_for_particles )  WRITE ( io, 488 )  dt_min_part
1045       IF ( random_start_position )  WRITE ( io, 481 )
1046       IF ( particles_per_point > 1 )  WRITE ( io, 489 )  particles_per_point
1047       WRITE ( io, 495 )  total_number_of_particles
1048       IF ( .NOT. vertical_particle_advection )  WRITE ( io, 482 )
1049       IF ( maximum_number_of_tailpoints /= 0 )  THEN
1050          WRITE ( io, 483 )  maximum_number_of_tailpoints
1051          IF ( minimum_tailpoint_distance /= 0 )  THEN
1052             WRITE ( io, 484 )  total_number_of_tails,      &
1053                                minimum_tailpoint_distance, &
1054                                maximum_tailpoint_age
1055          ENDIF
1056       ENDIF
1057       IF ( dt_write_particle_data /= 9999999.9 )  THEN
1058          WRITE ( io, 485 )  dt_write_particle_data
1059          output_format = ''
1060          IF ( netcdf_output )  THEN
1061             IF ( netcdf_64bit )  THEN
1062                output_format = 'netcdf (64 bit offset) and binary'
1063             ELSE
1064                output_format = 'netcdf and binary'
1065             ENDIF
1066          ELSE
1067             output_format = 'binary'
1068          ENDIF
1069          WRITE ( io, 345 )  output_format
1070       ENDIF
1071       IF ( dt_dopts /= 9999999.9 )  WRITE ( io, 494 )  dt_dopts
1072       IF ( write_particle_statistics )  WRITE ( io, 486 )
1073
1074       WRITE ( io, 487 )  number_of_particle_groups
1075
1076       DO  i = 1, number_of_particle_groups
1077          IF ( i == 1  .AND.  density_ratio(i) == 9999999.9 )  THEN
1078             WRITE ( io, 490 )  i, 0.0
1079             WRITE ( io, 492 )
1080          ELSE
1081             WRITE ( io, 490 )  i, radius(i)
1082             IF ( density_ratio(i) /= 0.0 )  THEN
1083                WRITE ( io, 491 )  density_ratio(i)
1084             ELSE
1085                WRITE ( io, 492 )
1086             ENDIF
1087          ENDIF
1088          WRITE ( io, 493 )  psl(i), psr(i), pss(i), psn(i), psb(i), pst(i), &
1089                             pdx(i), pdy(i), pdz(i)
1090       ENDDO
1091
1092    ENDIF
1093
1094
1095!
1096!-- Parameters of 1D-model
1097    IF ( INDEX( initializing_actions, 'set_1d-model_profiles' ) /= 0 )  THEN
1098       WRITE ( io, 500 )  end_time_1d, dt_run_control_1d, dt_pr_1d, &
1099                          mixing_length_1d, dissipation_1d
1100       IF ( damp_level_ind_1d /= nzt+1 )  THEN
1101          WRITE ( io, 502 )  zu(damp_level_ind_1d), damp_level_ind_1d
1102       ENDIF
1103    ENDIF
1104
1105!
1106!-- User-defined informations
1107    CALL user_header( io )
1108
1109    WRITE ( io, 99 )
1110
1111#if defined( __ibm )
1112!
1113!-- Write buffer contents to disc immediately
1114    CALL FLUSH_( io )
1115#elif defined( __lcmuk )  ||  defined( __nec )
1116    CALL FLUSH( io )
1117#endif
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.