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

Last change on this file since 1831 was 1831, checked in by hoffmann, 8 years ago

cloud physics variables renamed

  • Property svn:keywords set to Id
File size: 87.5 KB
Line 
1!> @file header.f90
2!--------------------------------------------------------------------------------!
3! This file is part of PALM.
4!
5! PALM is free software: you can redistribute it and/or modify it under the terms
6! of the GNU General Public License as published by the Free Software Foundation,
7! either version 3 of the License, or (at your option) any later version.
8!
9! PALM is distributed in the hope that it will be useful, but WITHOUT ANY
10! WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
11! A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
12!
13! You should have received a copy of the GNU General Public License along with
14! PALM. If not, see <http://www.gnu.org/licenses/>.
15!
16! Copyright 1997-2016 Leibniz Universitaet Hannover
17!--------------------------------------------------------------------------------!
18!
19! Current revisions:
20! -----------------
21! turbulence renamed collision_turbulence,
22! drizzle renamed cloud_water_sedimentation
23!
24! Former revisions:
25! -----------------
26! $Id: header.f90 1831 2016-04-07 13:15:51Z hoffmann $
27!
28! 1826 2016-04-07 12:01:39Z maronga
29! Moved radiation model header output to the respective module.
30! Moved canopy model header output to the respective module.
31!
32! 1822 2016-04-07 07:49:42Z hoffmann
33! Tails removed. icloud_scheme replaced by microphysics_*
34!
35! 1817 2016-04-06 15:44:20Z maronga
36! Moved land_surface_model header output to the respective module.
37!
38! 1808 2016-04-05 19:44:00Z raasch
39! routine local_flush replaced by FORTRAN statement
40!
41! 1797 2016-03-21 16:50:28Z raasch
42! output of nesting datatransfer mode
43!
44! 1791 2016-03-11 10:41:25Z raasch
45! output of nesting informations of all domains
46!
47! 1788 2016-03-10 11:01:04Z maronga
48! Parameter dewfall removed
49!
50! 1786 2016-03-08 05:49:27Z raasch
51! cpp-direktives for spectra removed
52!
53! 1783 2016-03-06 18:36:17Z raasch
54! netcdf module and variable names changed, output of netcdf_deflate
55!
56! 1764 2016-02-28 12:45:19Z raasch
57! output of nesting informations
58!
59! 1697 2015-10-28 17:14:10Z raasch
60! small E- and F-FORMAT changes to avoid informative compiler messages about
61! insufficient field width
62!
63! 1691 2015-10-26 16:17:44Z maronga
64! Renamed prandtl_layer to constant_flux_layer, renames rif_min/rif_max to
65! zeta_min/zeta_max.
66!
67! 1682 2015-10-07 23:56:08Z knoop
68! Code annotations made doxygen readable
69!
70! 1675 2015-10-02 08:28:59Z gronemeier
71! Bugfix: Definition of topography grid levels
72!
73! 1660 2015-09-21 08:15:16Z gronemeier
74! Bugfix: Definition of building/street canyon height if vertical grid stretching
75!         starts below the maximum topography height.
76!
77! 1590 2015-05-08 13:56:27Z maronga
78! Bugfix: Added TRIM statements for character strings for LSM and radiation code
79!
80! 1585 2015-04-30 07:05:52Z maronga
81! Further output for radiation model(s).
82!
83! 1575 2015-03-27 09:56:27Z raasch
84! adjustments for psolver-queries, output of seed_follows_topography
85!
86! 1560 2015-03-06 10:48:54Z keck
87! output for recycling y shift
88!
89! 1557 2015-03-05 16:43:04Z suehring
90! output for monotonic limiter
91!
92! 1551 2015-03-03 14:18:16Z maronga
93! Added informal output for land surface model and radiation model. Removed typo.
94!
95! 1496 2014-12-02 17:25:50Z maronga
96! Renamed: "radiation -> "cloud_top_radiation"
97!
98! 1484 2014-10-21 10:53:05Z kanani
99! Changes due to new module structure of the plant canopy model:
100!   module plant_canopy_model_mod and output for new canopy model parameters
101!   (alpha_lad, beta_lad, lai_beta,...) added,
102!   drag_coefficient, leaf_surface_concentration and scalar_exchange_coefficient
103!   renamed to canopy_drag_coeff, leaf_surface_conc and leaf_scalar_exch_coeff,
104!   learde renamed leaf_area_density.
105! Bugfix: DO-WHILE-loop for lad header information additionally restricted
106! by maximum number of gradient levels (currently 10)
107!
108! 1482 2014-10-18 12:34:45Z raasch
109! information about calculated or predefined virtual processor topology adjusted
110!
111! 1468 2014-09-24 14:06:57Z maronga
112! Adapted for use on up to 6-digit processor cores
113!
114! 1429 2014-07-15 12:53:45Z knoop
115! header exended to provide ensemble_member_nr if specified
116!
117! 1376 2014-04-26 11:21:22Z boeske
118! Correction of typos
119!
120! 1365 2014-04-22 15:03:56Z boeske
121! New section 'Large scale forcing and nudging':
122! output of large scale forcing and nudging information,
123! new section for initial profiles created
124!
125! 1359 2014-04-11 17:15:14Z hoffmann
126! dt_sort_particles removed
127!
128! 1353 2014-04-08 15:21:23Z heinze
129! REAL constants provided with KIND-attribute
130!
131! 1327 2014-03-21 11:00:16Z raasch
132! parts concerning iso2d and avs output removed,
133! -netcdf output queries
134!
135! 1324 2014-03-21 09:13:16Z suehring
136! Bugfix: module spectrum added
137!
138! 1322 2014-03-20 16:38:49Z raasch
139! REAL functions provided with KIND-attribute,
140! some REAL constants defined as wp-kind
141!
142! 1320 2014-03-20 08:40:49Z raasch
143! ONLY-attribute added to USE-statements,
144! kind-parameters added to all INTEGER and REAL declaration statements,
145! kinds are defined in new module kinds,
146! revision history before 2012 removed,
147! comment fields (!:) to be used for variable explanations added to
148! all variable declaration statements
149!
150! 1308 2014-03-13 14:58:42Z fricke
151! output of the fixed number of output time levels
152! output_format adjusted for masked data if netcdf_data_format > 5
153!
154! 1299 2014-03-06 13:15:21Z heinze
155! output for using large_scale subsidence in combination
156! with large_scale_forcing
157! reformatting, more detailed explanations
158!
159! 1241 2013-10-30 11:36:58Z heinze
160! output for nudging + large scale forcing from external file
161!
162! 1216 2013-08-26 09:31:42Z raasch
163! output for transpose_compute_overlap
164!
165! 1212 2013-08-15 08:46:27Z raasch
166! output for poisfft_hybrid removed
167!
168! 1179 2013-06-14 05:57:58Z raasch
169! output of reference_state, use_reference renamed use_single_reference_value
170!
171! 1159 2013-05-21 11:58:22Z fricke
172! +use_cmax
173!
174! 1115 2013-03-26 18:16:16Z hoffmann
175! descriptions for Seifert-Beheng-cloud-physics-scheme added
176!
177! 1111 2013-03-08 23:54:10Z raasch
178! output of accelerator board information
179! ibc_p_b = 2 removed
180!
181! 1108 2013-03-05 07:03:32Z raasch
182! bugfix for r1106
183!
184! 1106 2013-03-04 05:31:38Z raasch
185! some format changes for coupled runs
186!
187! 1092 2013-02-02 11:24:22Z raasch
188! unused variables removed
189!
190! 1036 2012-10-22 13:43:42Z raasch
191! code put under GPL (PALM 3.9)
192!
193! 1031 2012-10-19 14:35:30Z raasch
194! output of netCDF data format modified
195!
196! 1015 2012-09-27 09:23:24Z raasch
197! output of Adjustment of mixing length to the Prandtl mixing length at first
198! grid point above ground removed
199!
200! 1003 2012-09-14 14:35:53Z raasch
201! output of information about equal/unequal subdomain size removed
202!
203! 1001 2012-09-13 14:08:46Z raasch
204! all actions concerning leapfrog- and upstream-spline-scheme removed
205!
206! 978 2012-08-09 08:28:32Z fricke
207! -km_damp_max, outflow_damping_width
208! +pt_damping_factor, pt_damping_width
209! +z0h
210!
211! 964 2012-07-26 09:14:24Z raasch
212! output of profil-related quantities removed
213!
214! 940 2012-07-09 14:31:00Z raasch
215! Output in case of simulations for pure neutral stratification (no pt-equation
216! solved)
217!
218! 927 2012-06-06 19:15:04Z raasch
219! output of masking_method for mg-solver
220!
221! 868 2012-03-28 12:21:07Z raasch
222! translation velocity in Galilean transformation changed to 0.6 * ug
223!
224! 833 2012-02-22 08:55:55Z maronga
225! Adjusted format for leaf area density
226!
227! 828 2012-02-21 12:00:36Z raasch
228! output of dissipation_classes + radius_classes
229!
230! 825 2012-02-19 03:03:44Z raasch
231! Output of cloud physics parameters/quantities complemented and restructured
232!
233! Revision 1.1  1997/08/11 06:17:20  raasch
234! Initial revision
235!
236!
237! Description:
238! ------------
239!> Writing a header with all important information about the current run.
240!> This subroutine is called three times, two times at the beginning
241!> (writing information on files RUN_CONTROL and HEADER) and one time at the
242!> end of the run, then writing additional information about CPU-usage on file
243!> header.
244!-----------------------------------------------------------------------------!
245 SUBROUTINE header
246 
247
248    USE arrays_3d,                                                             &
249        ONLY:  pt_init, qsws, q_init, sa_init, shf, ug, vg, w_subs, zu, zw
250       
251    USE control_parameters
252       
253    USE cloud_parameters,                                                      &
254        ONLY:  cloud_water_sedimentation, collision_turbulence, cp,            &
255               c_sedimentation, limiter_sedimentation, l_v, nc_const,          &
256               r_d, ventilation_effect
257       
258    USE cpulog,                                                                &
259        ONLY:  log_point_s
260       
261    USE dvrp_variables,                                                        &
262        ONLY:  use_seperate_pe_for_dvrp_output
263       
264    USE grid_variables,                                                        &
265        ONLY:  dx, dy
266       
267    USE indices,                                                               &
268        ONLY:  mg_loc_ind, nnx, nny, nnz, nx, ny, nxl_mg, nxr_mg, nyn_mg,      &
269               nys_mg, nzt, nzt_mg
270       
271    USE kinds
272 
273    USE land_surface_model_mod,                                                &
274        ONLY: land_surface, lsm_header
275 
276    USE model_1d,                                                              &
277        ONLY:  damp_level_ind_1d, dt_pr_1d, dt_run_control_1d, end_time_1d
278       
279    USE netcdf_interface,                                                      &
280        ONLY:  netcdf_data_format, netcdf_data_format_string, netcdf_deflate
281
282    USE particle_attributes,                                                   &
283        ONLY:  bc_par_b, bc_par_lr, bc_par_ns, bc_par_t, collision_kernel,     &
284               curvature_solution_effects,                                     &
285               density_ratio, dissipation_classes, dt_min_part, dt_prel,       &
286               dt_write_particle_data, end_time_prel,                          &
287               number_of_particle_groups, particle_advection,                  &
288               particle_advection_start,                                       &
289               particles_per_point, pdx, pdy, pdz,  psb, psl, psn, psr, pss,   &
290               pst, radius, radius_classes, random_start_position,             &
291               seed_follows_topography,                                        &
292               total_number_of_particles, use_sgs_for_particles,               &
293               vertical_particle_advection, write_particle_statistics
294       
295    USE pegrid
296
297    USE plant_canopy_model_mod,                                                &
298        ONLY:  pcm_header, plant_canopy
299
300    USE pmc_handle_communicator,                                               &
301        ONLY:  pmc_get_model_info
302
303    USE pmc_interface,                                                         &
304        ONLY:  nested_run, nesting_datatransfer_mode, nesting_mode
305
306    USE radiation_model_mod,                                                   &
307        ONLY:  radiation, radiation_header
308   
309    USE spectrum,                                                              &
310        ONLY:  comp_spectra_level, data_output_sp, plot_spectra_level,         &
311               spectra_direction
312
313    IMPLICIT NONE
314
315    CHARACTER (LEN=1)  ::  prec                !<
316   
317    CHARACTER (LEN=2)  ::  do2d_mode           !<
318   
319    CHARACTER (LEN=5)  ::  section_chr         !<
320   
321    CHARACTER (LEN=10) ::  coor_chr            !<
322    CHARACTER (LEN=10) ::  host_chr            !<
323   
324    CHARACTER (LEN=16) ::  begin_chr           !<
325   
326    CHARACTER (LEN=26) ::  ver_rev             !<
327
328    CHARACTER (LEN=32) ::  cpl_name            !<
329   
330    CHARACTER (LEN=40) ::  output_format       !<
331   
332    CHARACTER (LEN=70) ::  char1               !<
333    CHARACTER (LEN=70) ::  char2               !<
334    CHARACTER (LEN=70) ::  dopr_chr            !<
335    CHARACTER (LEN=70) ::  do2d_xy             !<
336    CHARACTER (LEN=70) ::  do2d_xz             !<
337    CHARACTER (LEN=70) ::  do2d_yz             !<
338    CHARACTER (LEN=70) ::  do3d_chr            !<
339    CHARACTER (LEN=70) ::  domask_chr          !<
340    CHARACTER (LEN=70) ::  run_classification  !<
341   
342    CHARACTER (LEN=85) ::  r_upper             !<
343    CHARACTER (LEN=85) ::  r_lower             !<
344   
345    CHARACTER (LEN=86) ::  coordinates         !<
346    CHARACTER (LEN=86) ::  gradients           !<
347    CHARACTER (LEN=86) ::  slices              !<
348    CHARACTER (LEN=86) ::  temperatures        !<
349    CHARACTER (LEN=86) ::  ugcomponent         !<
350    CHARACTER (LEN=86) ::  vgcomponent         !<
351
352    CHARACTER (LEN=1), DIMENSION(1:3) ::  dir = (/ 'x', 'y', 'z' /)  !<
353
354    INTEGER(iwp) ::  av             !<
355    INTEGER(iwp) ::  bh             !<
356    INTEGER(iwp) ::  blx            !<
357    INTEGER(iwp) ::  bly            !<
358    INTEGER(iwp) ::  bxl            !<
359    INTEGER(iwp) ::  bxr            !<
360    INTEGER(iwp) ::  byn            !<
361    INTEGER(iwp) ::  bys            !<
362    INTEGER(iwp) ::  ch             !<
363    INTEGER(iwp) ::  count          !<
364    INTEGER(iwp) ::  cpl_parent_id  !<
365    INTEGER(iwp) ::  cwx            !<
366    INTEGER(iwp) ::  cwy            !<
367    INTEGER(iwp) ::  cxl            !<
368    INTEGER(iwp) ::  cxr            !<
369    INTEGER(iwp) ::  cyn            !<
370    INTEGER(iwp) ::  cys            !<
371    INTEGER(iwp) ::  dim            !<
372    INTEGER(iwp) ::  i              !<
373    INTEGER(iwp) ::  io             !<
374    INTEGER(iwp) ::  j              !<
375    INTEGER(iwp) ::  k              !<
376    INTEGER(iwp) ::  l              !<
377    INTEGER(iwp) ::  ll             !<
378    INTEGER(iwp) ::  mpi_type       !<
379    INTEGER(iwp) ::  my_cpl_id      !<
380    INTEGER(iwp) ::  n              !<
381    INTEGER(iwp) ::  ncpl           !<
382    INTEGER(iwp) ::  npe_total      !<
383   
384
385    REAL(wp) ::  cpuseconds_per_simulated_second  !<
386    REAL(wp) ::  lower_left_coord_x               !< x-coordinate of nest domain
387    REAL(wp) ::  lower_left_coord_y               !< y-coordinate of nest domain
388
389!
390!-- Open the output file. At the end of the simulation, output is directed
391!-- to unit 19.
392    IF ( ( runnr == 0 .OR. force_print_header )  .AND. &
393         .NOT. simulated_time_at_begin /= simulated_time )  THEN
394       io = 15   !  header output on file RUN_CONTROL
395    ELSE
396       io = 19   !  header output on file HEADER
397    ENDIF
398    CALL check_open( io )
399
400!
401!-- At the end of the run, output file (HEADER) will be rewritten with
402!-- new information
403    IF ( io == 19 .AND. simulated_time_at_begin /= simulated_time ) REWIND( 19 )
404
405!
406!-- Determine kind of model run
407    IF ( TRIM( initializing_actions ) == 'read_restart_data' )  THEN
408       run_classification = 'restart run'
409    ELSEIF ( TRIM( initializing_actions ) == 'cyclic_fill' )  THEN
410       run_classification = 'run with cyclic fill of 3D - prerun data'
411    ELSEIF ( INDEX( initializing_actions, 'set_constant_profiles' ) /= 0 )  THEN
412       run_classification = 'run without 1D - prerun'
413    ELSEIF ( INDEX( initializing_actions, 'set_1d-model_profiles' ) /= 0 )  THEN
414       run_classification = 'run with 1D - prerun'
415    ELSEIF ( INDEX( initializing_actions, 'by_user' ) /=0 )  THEN
416       run_classification = 'run initialized by user'
417    ELSE
418       message_string = ' unknown action(s): ' // TRIM( initializing_actions )
419       CALL message( 'header', 'PA0191', 0, 0, 0, 6, 0 )
420    ENDIF
421    IF ( nested_run )  run_classification = 'nested ' // run_classification
422    IF ( ocean )  THEN
423       run_classification = 'ocean - ' // run_classification
424    ELSE
425       run_classification = 'atmosphere - ' // run_classification
426    ENDIF
427
428!
429!-- Run-identification, date, time, host
430    host_chr = host(1:10)
431    ver_rev = TRIM( version ) // '  ' // TRIM( revision )
432    WRITE ( io, 100 )  ver_rev, TRIM( run_classification )
433    IF ( TRIM( coupling_mode ) /= 'uncoupled' )  THEN
434#if defined( __mpi2 )
435       mpi_type = 2
436#else
437       mpi_type = 1
438#endif
439       WRITE ( io, 101 )  mpi_type, coupling_mode
440    ENDIF
441#if defined( __parallel )
442    IF ( coupling_start_time /= 0.0_wp )  THEN
443       IF ( coupling_start_time > simulated_time_at_begin )  THEN
444          WRITE ( io, 109 )
445       ELSE
446          WRITE ( io, 114 )
447       ENDIF
448    ENDIF
449#endif
450    IF ( ensemble_member_nr /= 0 )  THEN
451       WRITE ( io, 512 )  run_date, run_identifier, run_time, runnr,           &
452                       ADJUSTR( host_chr ), ensemble_member_nr
453    ELSE
454       WRITE ( io, 102 )  run_date, run_identifier, run_time, runnr,           &
455                       ADJUSTR( host_chr )
456    ENDIF
457#if defined( __parallel )
458    IF ( npex == -1  .AND.  npey == -1 )  THEN
459       char1 = 'calculated'
460    ELSE
461       char1 = 'predefined'
462    ENDIF
463    IF ( threads_per_task == 1 )  THEN
464       WRITE ( io, 103 )  numprocs, pdims(1), pdims(2), TRIM( char1 )
465    ELSE
466       WRITE ( io, 104 )  numprocs*threads_per_task, numprocs, &
467                          threads_per_task, pdims(1), pdims(2), TRIM( char1 )
468    ENDIF
469    IF ( num_acc_per_node /= 0 )  WRITE ( io, 117 )  num_acc_per_node   
470    IF ( ( host(1:3) == 'ibm'  .OR.  host(1:3) == 'nec'  .OR.    &
471           host(1:2) == 'lc'   .OR.  host(1:3) == 'dec' )  .AND. &
472         npex == -1  .AND.  pdims(2) == 1 )                      &
473    THEN
474       WRITE ( io, 106 )
475    ELSEIF ( pdims(2) == 1 )  THEN
476       WRITE ( io, 107 )  'x'
477    ELSEIF ( pdims(1) == 1 )  THEN
478       WRITE ( io, 107 )  'y'
479    ENDIF
480    IF ( use_seperate_pe_for_dvrp_output )  WRITE ( io, 105 )
481    IF ( numprocs /= maximum_parallel_io_streams )  THEN
482       WRITE ( io, 108 )  maximum_parallel_io_streams
483    ENDIF
484#else
485    IF ( num_acc_per_node /= 0 )  WRITE ( io, 120 )  num_acc_per_node
486#endif
487
488!
489!-- Nesting informations
490    IF ( nested_run )  THEN
491
492       WRITE ( io, 600 )  TRIM( nesting_mode ),                                &
493                          TRIM( nesting_datatransfer_mode )
494       CALL pmc_get_model_info( ncpl = ncpl, cpl_id = my_cpl_id )
495
496       DO  n = 1, ncpl
497          CALL pmc_get_model_info( request_for_cpl_id = n, cpl_name = cpl_name,&
498                                   cpl_parent_id = cpl_parent_id,              &
499                                   lower_left_x = lower_left_coord_x,          &
500                                   lower_left_y = lower_left_coord_y,          &
501                                   npe_total = npe_total )
502          IF ( n == my_cpl_id )  THEN
503             char1 = '*'
504          ELSE
505             char1 = ' '
506          ENDIF
507          WRITE ( io, 601 )  TRIM( char1 ), n, cpl_parent_id, npe_total,       &
508                             lower_left_coord_x, lower_left_coord_y,           &
509                             TRIM( cpl_name )
510       ENDDO
511    ENDIF
512    WRITE ( io, 99 )
513
514!
515!-- Numerical schemes
516    WRITE ( io, 110 )
517    IF ( psolver(1:7) == 'poisfft' )  THEN
518       WRITE ( io, 111 )  TRIM( fft_method )
519       IF ( transpose_compute_overlap )  WRITE( io, 115 )
520    ELSEIF ( psolver == 'sor' )  THEN
521       WRITE ( io, 112 )  nsor_ini, nsor, omega_sor
522    ELSEIF ( psolver(1:9) == 'multigrid' )  THEN
523       WRITE ( io, 135 )  TRIM(psolver), cycle_mg, maximum_grid_level, ngsrb
524       IF ( mg_cycles == -1 )  THEN
525          WRITE ( io, 140 )  residual_limit
526       ELSE
527          WRITE ( io, 141 )  mg_cycles
528       ENDIF
529       IF ( mg_switch_to_pe0_level == 0 )  THEN
530          WRITE ( io, 136 )  nxr_mg(1)-nxl_mg(1)+1, nyn_mg(1)-nys_mg(1)+1, &
531                             nzt_mg(1)
532       ELSEIF (  mg_switch_to_pe0_level /= -1 )  THEN
533          WRITE ( io, 137 )  mg_switch_to_pe0_level,            &
534                             mg_loc_ind(2,0)-mg_loc_ind(1,0)+1, &
535                             mg_loc_ind(4,0)-mg_loc_ind(3,0)+1, &
536                             nzt_mg(mg_switch_to_pe0_level),    &
537                             nxr_mg(1)-nxl_mg(1)+1, nyn_mg(1)-nys_mg(1)+1, &
538                             nzt_mg(1)
539       ENDIF
540       IF ( masking_method )  WRITE ( io, 144 )
541    ENDIF
542    IF ( call_psolver_at_all_substeps  .AND. timestep_scheme(1:5) == 'runge' ) &
543    THEN
544       WRITE ( io, 142 )
545    ENDIF
546
547    IF ( momentum_advec == 'pw-scheme' )  THEN
548       WRITE ( io, 113 )
549    ELSEIF (momentum_advec == 'ws-scheme' )  THEN
550       WRITE ( io, 503 )
551    ENDIF
552    IF ( scalar_advec == 'pw-scheme' )  THEN
553       WRITE ( io, 116 )
554    ELSEIF ( scalar_advec == 'ws-scheme' )  THEN
555       WRITE ( io, 504 )
556    ELSEIF ( scalar_advec == 'ws-scheme-mono' )  THEN
557       WRITE ( io, 513 )
558    ELSE
559       WRITE ( io, 118 )
560    ENDIF
561
562    WRITE ( io, 139 )  TRIM( loop_optimization )
563
564    IF ( galilei_transformation )  THEN
565       IF ( use_ug_for_galilei_tr )  THEN
566          char1 = '0.6 * geostrophic wind'
567       ELSE
568          char1 = 'mean wind in model domain'
569       ENDIF
570       IF ( simulated_time_at_begin == simulated_time )  THEN
571          char2 = 'at the start of the run'
572       ELSE
573          char2 = 'at the end of the run'
574       ENDIF
575       WRITE ( io, 119 )  TRIM( char1 ), TRIM( char2 ),                        &
576                          advected_distance_x/1000.0_wp,                       &
577                          advected_distance_y/1000.0_wp
578    ENDIF
579    WRITE ( io, 122 )  timestep_scheme
580    IF ( use_upstream_for_tke )  WRITE ( io, 143 )
581    IF ( rayleigh_damping_factor /= 0.0_wp )  THEN
582       IF ( .NOT. ocean )  THEN
583          WRITE ( io, 123 )  'above', rayleigh_damping_height, &
584               rayleigh_damping_factor
585       ELSE
586          WRITE ( io, 123 )  'below', rayleigh_damping_height, &
587               rayleigh_damping_factor
588       ENDIF
589    ENDIF
590    IF ( neutral )  WRITE ( io, 131 )  pt_surface
591    IF ( humidity )  THEN
592       IF ( .NOT. cloud_physics )  THEN
593          WRITE ( io, 129 )
594       ELSE
595          WRITE ( io, 130 )
596       ENDIF
597    ENDIF
598    IF ( passive_scalar )  WRITE ( io, 134 )
599    IF ( conserve_volume_flow )  THEN
600       WRITE ( io, 150 )  conserve_volume_flow_mode
601       IF ( TRIM( conserve_volume_flow_mode ) == 'bulk_velocity' )  THEN
602          WRITE ( io, 151 )  u_bulk, v_bulk
603       ENDIF
604    ELSEIF ( dp_external )  THEN
605       IF ( dp_smooth )  THEN
606          WRITE ( io, 152 )  dpdxy, dp_level_b, ', vertically smoothed.'
607       ELSE
608          WRITE ( io, 152 )  dpdxy, dp_level_b, '.'
609       ENDIF
610    ENDIF
611    WRITE ( io, 99 )
612
613!
614!-- Runtime and timestep information
615    WRITE ( io, 200 )
616    IF ( .NOT. dt_fixed )  THEN
617       WRITE ( io, 201 )  dt_max, cfl_factor
618    ELSE
619       WRITE ( io, 202 )  dt
620    ENDIF
621    WRITE ( io, 203 )  simulated_time_at_begin, end_time
622
623    IF ( time_restart /= 9999999.9_wp  .AND. &
624         simulated_time_at_begin == simulated_time )  THEN
625       IF ( dt_restart == 9999999.9_wp )  THEN
626          WRITE ( io, 204 )  ' Restart at:       ',time_restart
627       ELSE
628          WRITE ( io, 205 )  ' Restart at:       ',time_restart, dt_restart
629       ENDIF
630    ENDIF
631
632    IF ( simulated_time_at_begin /= simulated_time )  THEN
633       i = MAX ( log_point_s(10)%counts, 1 )
634       IF ( ( simulated_time - simulated_time_at_begin ) == 0.0_wp )  THEN
635          cpuseconds_per_simulated_second = 0.0_wp
636       ELSE
637          cpuseconds_per_simulated_second = log_point_s(10)%sum / &
638                                            ( simulated_time -    &
639                                              simulated_time_at_begin )
640       ENDIF
641       WRITE ( io, 206 )  simulated_time, log_point_s(10)%sum,      &
642                          log_point_s(10)%sum / REAL( i, KIND=wp ), &
643                          cpuseconds_per_simulated_second
644       IF ( time_restart /= 9999999.9_wp  .AND.  time_restart < end_time )  THEN
645          IF ( dt_restart == 9999999.9_wp )  THEN
646             WRITE ( io, 204 )  ' Next restart at:     ',time_restart
647          ELSE
648             WRITE ( io, 205 )  ' Next restart at:     ',time_restart, dt_restart
649          ENDIF
650       ENDIF
651    ENDIF
652
653
654!
655!-- Start time for coupled runs, if independent precursor runs for atmosphere
656!-- and ocean are used or have been used. In this case, coupling_start_time
657!-- defines the time when the coupling is switched on.
658    IF ( coupling_start_time /= 0.0_wp )  THEN
659       WRITE ( io, 207 )  coupling_start_time
660    ENDIF
661
662!
663!-- Computational grid
664    IF ( .NOT. ocean )  THEN
665       WRITE ( io, 250 )  dx, dy, dz, (nx+1)*dx, (ny+1)*dy, zu(nzt+1)
666       IF ( dz_stretch_level_index < nzt+1 )  THEN
667          WRITE ( io, 252 )  dz_stretch_level, dz_stretch_level_index, &
668                             dz_stretch_factor, dz_max
669       ENDIF
670    ELSE
671       WRITE ( io, 250 )  dx, dy, dz, (nx+1)*dx, (ny+1)*dy, zu(0)
672       IF ( dz_stretch_level_index > 0 )  THEN
673          WRITE ( io, 252 )  dz_stretch_level, dz_stretch_level_index, &
674                             dz_stretch_factor, dz_max
675       ENDIF
676    ENDIF
677    WRITE ( io, 254 )  nx, ny, nzt+1, MIN( nnx, nx+1 ), MIN( nny, ny+1 ), &
678                       MIN( nnz+2, nzt+2 )
679    IF ( sloping_surface )  WRITE ( io, 260 )  alpha_surface
680
681!
682!-- Large scale forcing and nudging
683    WRITE ( io, 160 )
684    IF ( large_scale_forcing )  THEN
685       WRITE ( io, 162 )
686       WRITE ( io, 163 )
687
688       IF ( large_scale_subsidence )  THEN
689          IF ( .NOT. use_subsidence_tendencies )  THEN
690             WRITE ( io, 164 )
691          ELSE
692             WRITE ( io, 165 )
693          ENDIF
694       ENDIF
695
696       IF ( bc_pt_b == 'dirichlet' )  THEN
697          WRITE ( io, 180 )
698       ELSEIF ( bc_pt_b == 'neumann' )  THEN
699          WRITE ( io, 181 )
700       ENDIF
701
702       IF ( bc_q_b == 'dirichlet' )  THEN
703          WRITE ( io, 182 )
704       ELSEIF ( bc_q_b == 'neumann' )  THEN
705          WRITE ( io, 183 )
706       ENDIF
707
708       WRITE ( io, 167 )
709       IF ( nudging )  THEN
710          WRITE ( io, 170 )
711       ENDIF
712    ELSE
713       WRITE ( io, 161 )
714       WRITE ( io, 171 )
715    ENDIF
716    IF ( large_scale_subsidence )  THEN
717       WRITE ( io, 168 )
718       WRITE ( io, 169 )
719    ENDIF
720
721!
722!-- Profile for the large scale vertial velocity
723!-- Building output strings, starting with surface value
724    IF ( large_scale_subsidence )  THEN
725       temperatures = '   0.0'
726       gradients = '------'
727       slices = '     0'
728       coordinates = '   0.0'
729       i = 1
730       DO  WHILE ( subs_vertical_gradient_level_i(i) /= -9999 )
731
732          WRITE (coor_chr,'(E10.2,7X)')  &
733                                w_subs(subs_vertical_gradient_level_i(i))
734          temperatures = TRIM( temperatures ) // ' ' // TRIM( coor_chr )
735
736          WRITE (coor_chr,'(E10.2,7X)')  subs_vertical_gradient(i)
737          gradients = TRIM( gradients ) // ' ' // TRIM( coor_chr )
738
739          WRITE (coor_chr,'(I10,7X)')  subs_vertical_gradient_level_i(i)
740          slices = TRIM( slices ) // ' ' // TRIM( coor_chr )
741
742          WRITE (coor_chr,'(F10.2,7X)')  subs_vertical_gradient_level(i)
743          coordinates = TRIM( coordinates ) // ' '  // TRIM( coor_chr )
744
745          IF ( i == 10 )  THEN
746             EXIT
747          ELSE
748             i = i + 1
749          ENDIF
750
751       ENDDO
752
753 
754       IF ( .NOT. large_scale_forcing )  THEN
755          WRITE ( io, 426 )  TRIM( coordinates ), TRIM( temperatures ), &
756                             TRIM( gradients ), TRIM( slices )
757       ENDIF
758
759
760    ENDIF
761
762!-- Profile of the geostrophic wind (component ug)
763!-- Building output strings
764    WRITE ( ugcomponent, '(F6.2)' )  ug_surface
765    gradients = '------'
766    slices = '     0'
767    coordinates = '   0.0'
768    i = 1
769    DO  WHILE ( ug_vertical_gradient_level_ind(i) /= -9999 )
770     
771       WRITE (coor_chr,'(F6.2,1X)')  ug(ug_vertical_gradient_level_ind(i))
772       ugcomponent = TRIM( ugcomponent ) // '  ' // TRIM( coor_chr )
773
774       WRITE (coor_chr,'(F6.2,1X)')  ug_vertical_gradient(i)
775       gradients = TRIM( gradients ) // '  ' // TRIM( coor_chr )
776
777       WRITE (coor_chr,'(I6,1X)')  ug_vertical_gradient_level_ind(i)
778       slices = TRIM( slices ) // '  ' // TRIM( coor_chr )
779
780       WRITE (coor_chr,'(F6.1,1X)')  ug_vertical_gradient_level(i)
781       coordinates = TRIM( coordinates ) // '  ' // TRIM( coor_chr )
782
783       IF ( i == 10 )  THEN
784          EXIT
785       ELSE
786          i = i + 1
787       ENDIF
788
789    ENDDO
790
791    IF ( .NOT. large_scale_forcing )  THEN
792       WRITE ( io, 423 )  TRIM( coordinates ), TRIM( ugcomponent ), &
793                          TRIM( gradients ), TRIM( slices )
794    ENDIF
795
796!-- Profile of the geostrophic wind (component vg)
797!-- Building output strings
798    WRITE ( vgcomponent, '(F6.2)' )  vg_surface
799    gradients = '------'
800    slices = '     0'
801    coordinates = '   0.0'
802    i = 1
803    DO  WHILE ( vg_vertical_gradient_level_ind(i) /= -9999 )
804
805       WRITE (coor_chr,'(F6.2,1X)')  vg(vg_vertical_gradient_level_ind(i))
806       vgcomponent = TRIM( vgcomponent ) // '  ' // TRIM( coor_chr )
807
808       WRITE (coor_chr,'(F6.2,1X)')  vg_vertical_gradient(i)
809       gradients = TRIM( gradients ) // '  ' // TRIM( coor_chr )
810
811       WRITE (coor_chr,'(I6,1X)')  vg_vertical_gradient_level_ind(i)
812       slices = TRIM( slices ) // '  ' // TRIM( coor_chr )
813
814       WRITE (coor_chr,'(F6.1,1X)')  vg_vertical_gradient_level(i)
815       coordinates = TRIM( coordinates ) // '  ' // TRIM( coor_chr )
816
817       IF ( i == 10 )  THEN
818          EXIT
819       ELSE
820          i = i + 1
821       ENDIF
822 
823    ENDDO
824
825    IF ( .NOT. large_scale_forcing )  THEN
826       WRITE ( io, 424 )  TRIM( coordinates ), TRIM( vgcomponent ), &
827                          TRIM( gradients ), TRIM( slices )
828    ENDIF
829
830!
831!-- Topography
832    WRITE ( io, 270 )  topography
833    SELECT CASE ( TRIM( topography ) )
834
835       CASE ( 'flat' )
836          ! no actions necessary
837
838       CASE ( 'single_building' )
839          blx = INT( building_length_x / dx )
840          bly = INT( building_length_y / dy )
841          bh  = MINLOC( ABS( zw - building_height ), 1 ) - 1
842          IF ( ABS( zw(bh  ) - building_height ) == &
843               ABS( zw(bh+1) - building_height )    )  bh = bh + 1
844
845          IF ( building_wall_left == 9999999.9_wp )  THEN
846             building_wall_left = ( nx + 1 - blx ) / 2 * dx
847          ENDIF
848          bxl = INT ( building_wall_left / dx + 0.5_wp )
849          bxr = bxl + blx
850
851          IF ( building_wall_south == 9999999.9_wp )  THEN
852             building_wall_south = ( ny + 1 - bly ) / 2 * dy
853          ENDIF
854          bys = INT ( building_wall_south / dy + 0.5_wp )
855          byn = bys + bly
856
857          WRITE ( io, 271 )  building_length_x, building_length_y, &
858                             building_height, bxl, bxr, bys, byn
859
860       CASE ( 'single_street_canyon' )
861          ch  = MINLOC( ABS( zw - canyon_height ), 1 ) - 1
862          IF ( ABS( zw(ch  ) - canyon_height ) == &
863               ABS( zw(ch+1) - canyon_height )    )  ch = ch + 1
864          IF ( canyon_width_x /= 9999999.9_wp )  THEN
865!
866!--          Street canyon in y direction
867             cwx = NINT( canyon_width_x / dx )
868             IF ( canyon_wall_left == 9999999.9_wp )  THEN
869                canyon_wall_left = ( nx + 1 - cwx ) / 2 * dx
870             ENDIF
871             cxl = NINT( canyon_wall_left / dx )
872             cxr = cxl + cwx
873             WRITE ( io, 272 )  'y', canyon_height, ch, 'u', cxl, cxr
874
875          ELSEIF ( canyon_width_y /= 9999999.9_wp )  THEN
876!
877!--          Street canyon in x direction
878             cwy = NINT( canyon_width_y / dy )
879             IF ( canyon_wall_south == 9999999.9_wp )  THEN
880                canyon_wall_south = ( ny + 1 - cwy ) / 2 * dy
881             ENDIF
882             cys = NINT( canyon_wall_south / dy )
883             cyn = cys + cwy
884             WRITE ( io, 272 )  'x', canyon_height, ch, 'v', cys, cyn
885          ENDIF
886
887    END SELECT
888
889    IF ( TRIM( topography ) /= 'flat' )  THEN
890       IF ( TRIM( topography_grid_convention ) == ' ' )  THEN
891          IF ( TRIM( topography ) == 'single_building' .OR.  &
892               TRIM( topography ) == 'single_street_canyon' )  THEN
893             WRITE ( io, 278 )
894          ELSEIF ( TRIM( topography ) == 'read_from_file' )  THEN
895             WRITE ( io, 279 )
896          ENDIF
897       ELSEIF ( TRIM( topography_grid_convention ) == 'cell_edge' )  THEN
898          WRITE ( io, 278 )
899       ELSEIF ( TRIM( topography_grid_convention ) == 'cell_center' )  THEN
900          WRITE ( io, 279 )
901       ENDIF
902    ENDIF
903
904    IF ( plant_canopy )  CALL pcm_header ( io )
905
906    IF ( land_surface )  CALL lsm_header ( io )
907
908    IF ( radiation )  CALL radiation_header ( io )
909
910!
911!-- Boundary conditions
912    IF ( ibc_p_b == 0 )  THEN
913       r_lower = 'p(0)     = 0      |'
914    ELSEIF ( ibc_p_b == 1 )  THEN
915       r_lower = 'p(0)     = p(1)   |'
916    ENDIF
917    IF ( ibc_p_t == 0 )  THEN
918       r_upper  = 'p(nzt+1) = 0      |'
919    ELSE
920       r_upper  = 'p(nzt+1) = p(nzt) |'
921    ENDIF
922
923    IF ( ibc_uv_b == 0 )  THEN
924       r_lower = TRIM( r_lower ) // ' uv(0)     = -uv(1)                |'
925    ELSE
926       r_lower = TRIM( r_lower ) // ' uv(0)     = uv(1)                 |'
927    ENDIF
928    IF ( TRIM( bc_uv_t ) == 'dirichlet_0' )  THEN
929       r_upper  = TRIM( r_upper  ) // ' uv(nzt+1) = 0                     |'
930    ELSEIF ( ibc_uv_t == 0 )  THEN
931       r_upper  = TRIM( r_upper  ) // ' uv(nzt+1) = ug(nzt+1), vg(nzt+1)  |'
932    ELSE
933       r_upper  = TRIM( r_upper  ) // ' uv(nzt+1) = uv(nzt)               |'
934    ENDIF
935
936    IF ( ibc_pt_b == 0 )  THEN
937       IF ( land_surface )  THEN
938          r_lower = TRIM( r_lower ) // ' pt(0)     = from soil model'
939       ELSE
940          r_lower = TRIM( r_lower ) // ' pt(0)     = pt_surface'
941       ENDIF
942    ELSEIF ( ibc_pt_b == 1 )  THEN
943       r_lower = TRIM( r_lower ) // ' pt(0)     = pt(1)'
944    ELSEIF ( ibc_pt_b == 2 )  THEN
945       r_lower = TRIM( r_lower ) // ' pt(0)     = from coupled model'
946    ENDIF
947    IF ( ibc_pt_t == 0 )  THEN
948       r_upper  = TRIM( r_upper  ) // ' pt(nzt+1) = pt_top'
949    ELSEIF( ibc_pt_t == 1 )  THEN
950       r_upper  = TRIM( r_upper  ) // ' pt(nzt+1) = pt(nzt)'
951    ELSEIF( ibc_pt_t == 2 )  THEN
952       r_upper  = TRIM( r_upper  ) // ' pt(nzt+1) = pt(nzt) + dpt/dz_ini'
953
954    ENDIF
955
956    WRITE ( io, 300 )  r_lower, r_upper
957
958    IF ( .NOT. constant_diffusion )  THEN
959       IF ( ibc_e_b == 1 )  THEN
960          r_lower = 'e(0)     = e(1)'
961       ELSE
962          r_lower = 'e(0)     = e(1) = (u*/0.1)**2'
963       ENDIF
964       r_upper = 'e(nzt+1) = e(nzt) = e(nzt-1)'
965
966       WRITE ( io, 301 )  'e', r_lower, r_upper       
967
968    ENDIF
969
970    IF ( ocean )  THEN
971       r_lower = 'sa(0)    = sa(1)'
972       IF ( ibc_sa_t == 0 )  THEN
973          r_upper =  'sa(nzt+1) = sa_surface'
974       ELSE
975          r_upper =  'sa(nzt+1) = sa(nzt)'
976       ENDIF
977       WRITE ( io, 301 ) 'sa', r_lower, r_upper
978    ENDIF
979
980    IF ( humidity )  THEN
981       IF ( ibc_q_b == 0 )  THEN
982          IF ( land_surface )  THEN
983             r_lower = 'q(0)     = from soil model'
984          ELSE
985             r_lower = 'q(0)     = q_surface'
986          ENDIF
987
988       ELSE
989          r_lower = 'q(0)     = q(1)'
990       ENDIF
991       IF ( ibc_q_t == 0 )  THEN
992          r_upper =  'q(nzt)   = q_top'
993       ELSE
994          r_upper =  'q(nzt)   = q(nzt-1) + dq/dz'
995       ENDIF
996       WRITE ( io, 301 ) 'q', r_lower, r_upper
997    ENDIF
998
999    IF ( passive_scalar )  THEN
1000       IF ( ibc_q_b == 0 )  THEN
1001          r_lower = 's(0)     = s_surface'
1002       ELSE
1003          r_lower = 's(0)     = s(1)'
1004       ENDIF
1005       IF ( ibc_q_t == 0 )  THEN
1006          r_upper =  's(nzt)   = s_top'
1007       ELSE
1008          r_upper =  's(nzt)   = s(nzt-1) + ds/dz'
1009       ENDIF
1010       WRITE ( io, 301 ) 's', r_lower, r_upper
1011    ENDIF
1012
1013    IF ( use_surface_fluxes )  THEN
1014       WRITE ( io, 303 )
1015       IF ( constant_heatflux )  THEN
1016          IF ( large_scale_forcing .AND. lsf_surf )  THEN
1017             WRITE ( io, 306 )  shf(0,0)
1018          ELSE
1019             WRITE ( io, 306 )  surface_heatflux
1020          ENDIF
1021          IF ( random_heatflux )  WRITE ( io, 307 )
1022       ENDIF
1023       IF ( humidity  .AND.  constant_waterflux )  THEN
1024          IF ( large_scale_forcing .AND. lsf_surf )  THEN
1025             WRITE ( io, 311 ) qsws(0,0)
1026          ELSE
1027             WRITE ( io, 311 ) surface_waterflux
1028          ENDIF
1029       ENDIF
1030       IF ( passive_scalar  .AND.  constant_waterflux )  THEN
1031          WRITE ( io, 313 ) surface_waterflux
1032       ENDIF
1033    ENDIF
1034
1035    IF ( use_top_fluxes )  THEN
1036       WRITE ( io, 304 )
1037       IF ( coupling_mode == 'uncoupled' )  THEN
1038          WRITE ( io, 320 )  top_momentumflux_u, top_momentumflux_v
1039          IF ( constant_top_heatflux )  THEN
1040             WRITE ( io, 306 )  top_heatflux
1041          ENDIF
1042       ELSEIF ( coupling_mode == 'ocean_to_atmosphere' )  THEN
1043          WRITE ( io, 316 )
1044       ENDIF
1045       IF ( ocean  .AND.  constant_top_salinityflux )  THEN
1046          WRITE ( io, 309 )  top_salinityflux
1047       ENDIF
1048       IF ( humidity  .OR.  passive_scalar )  THEN
1049          WRITE ( io, 315 )
1050       ENDIF
1051    ENDIF
1052
1053    IF ( constant_flux_layer )  THEN
1054       WRITE ( io, 305 )  (zu(1)-zu(0)), roughness_length,                     &
1055                          z0h_factor*roughness_length, kappa,                  &
1056                          zeta_min, zeta_max
1057       IF ( .NOT. constant_heatflux )  WRITE ( io, 308 )
1058       IF ( humidity  .AND.  .NOT. constant_waterflux )  THEN
1059          WRITE ( io, 312 )
1060       ENDIF
1061       IF ( passive_scalar  .AND.  .NOT. constant_waterflux )  THEN
1062          WRITE ( io, 314 )
1063       ENDIF
1064    ELSE
1065       IF ( INDEX(initializing_actions, 'set_1d-model_profiles') /= 0 )  THEN
1066          WRITE ( io, 310 )  zeta_min, zeta_max
1067       ENDIF
1068    ENDIF
1069
1070    WRITE ( io, 317 )  bc_lr, bc_ns
1071    IF ( .NOT. bc_lr_cyc  .OR.  .NOT. bc_ns_cyc )  THEN
1072       WRITE ( io, 318 )  use_cmax, pt_damping_width, pt_damping_factor       
1073       IF ( turbulent_inflow )  THEN
1074          IF ( .NOT. recycling_yshift ) THEN
1075             WRITE ( io, 319 )  recycling_width, recycling_plane, &
1076                                inflow_damping_height, inflow_damping_width
1077          ELSE
1078             WRITE ( io, 322 )  recycling_width, recycling_plane, &
1079                                inflow_damping_height, inflow_damping_width
1080          END IF
1081       ENDIF
1082    ENDIF
1083
1084!
1085!-- Initial Profiles
1086    WRITE ( io, 321 )
1087!
1088!-- Initial wind profiles
1089    IF ( u_profile(1) /= 9999999.9_wp )  WRITE ( io, 427 )
1090
1091!
1092!-- Initial temperature profile
1093!-- Building output strings, starting with surface temperature
1094    WRITE ( temperatures, '(F6.2)' )  pt_surface
1095    gradients = '------'
1096    slices = '     0'
1097    coordinates = '   0.0'
1098    i = 1
1099    DO  WHILE ( pt_vertical_gradient_level_ind(i) /= -9999 )
1100
1101       WRITE (coor_chr,'(F7.2)')  pt_init(pt_vertical_gradient_level_ind(i))
1102       temperatures = TRIM( temperatures ) // ' ' // TRIM( coor_chr )
1103
1104       WRITE (coor_chr,'(F7.2)')  pt_vertical_gradient(i)
1105       gradients = TRIM( gradients ) // ' ' // TRIM( coor_chr )
1106
1107       WRITE (coor_chr,'(I7)')  pt_vertical_gradient_level_ind(i)
1108       slices = TRIM( slices ) // ' ' // TRIM( coor_chr )
1109
1110       WRITE (coor_chr,'(F7.1)')  pt_vertical_gradient_level(i)
1111       coordinates = TRIM( coordinates ) // ' '  // TRIM( coor_chr )
1112
1113       IF ( i == 10 )  THEN
1114          EXIT
1115       ELSE
1116          i = i + 1
1117       ENDIF
1118
1119    ENDDO
1120
1121    IF ( .NOT. nudging )  THEN
1122       WRITE ( io, 420 )  TRIM( coordinates ), TRIM( temperatures ), &
1123                          TRIM( gradients ), TRIM( slices )
1124    ELSE
1125       WRITE ( io, 428 ) 
1126    ENDIF
1127
1128!
1129!-- Initial humidity profile
1130!-- Building output strings, starting with surface humidity
1131    IF ( humidity  .OR.  passive_scalar )  THEN
1132       WRITE ( temperatures, '(E8.1)' )  q_surface
1133       gradients = '--------'
1134       slices = '       0'
1135       coordinates = '     0.0'
1136       i = 1
1137       DO  WHILE ( q_vertical_gradient_level_ind(i) /= -9999 )
1138         
1139          WRITE (coor_chr,'(E8.1,4X)')  q_init(q_vertical_gradient_level_ind(i))
1140          temperatures = TRIM( temperatures ) // '  ' // TRIM( coor_chr )
1141
1142          WRITE (coor_chr,'(E8.1,4X)')  q_vertical_gradient(i)
1143          gradients = TRIM( gradients ) // '  ' // TRIM( coor_chr )
1144         
1145          WRITE (coor_chr,'(I8,4X)')  q_vertical_gradient_level_ind(i)
1146          slices = TRIM( slices ) // '  ' // TRIM( coor_chr )
1147         
1148          WRITE (coor_chr,'(F8.1,4X)')  q_vertical_gradient_level(i)
1149          coordinates = TRIM( coordinates ) // '  '  // TRIM( coor_chr )
1150
1151          IF ( i == 10 )  THEN
1152             EXIT
1153          ELSE
1154             i = i + 1
1155          ENDIF
1156
1157       ENDDO
1158
1159       IF ( humidity )  THEN
1160          IF ( .NOT. nudging )  THEN
1161             WRITE ( io, 421 )  TRIM( coordinates ), TRIM( temperatures ), &
1162                                TRIM( gradients ), TRIM( slices )
1163          ENDIF
1164       ELSE
1165          WRITE ( io, 422 )  TRIM( coordinates ), TRIM( temperatures ), &
1166                             TRIM( gradients ), TRIM( slices )
1167       ENDIF
1168    ENDIF
1169
1170!
1171!-- Initial salinity profile
1172!-- Building output strings, starting with surface salinity
1173    IF ( ocean )  THEN
1174       WRITE ( temperatures, '(F6.2)' )  sa_surface
1175       gradients = '------'
1176       slices = '     0'
1177       coordinates = '   0.0'
1178       i = 1
1179       DO  WHILE ( sa_vertical_gradient_level_ind(i) /= -9999 )
1180
1181          WRITE (coor_chr,'(F7.2)')  sa_init(sa_vertical_gradient_level_ind(i))
1182          temperatures = TRIM( temperatures ) // ' ' // TRIM( coor_chr )
1183
1184          WRITE (coor_chr,'(F7.2)')  sa_vertical_gradient(i)
1185          gradients = TRIM( gradients ) // ' ' // TRIM( coor_chr )
1186
1187          WRITE (coor_chr,'(I7)')  sa_vertical_gradient_level_ind(i)
1188          slices = TRIM( slices ) // ' ' // TRIM( coor_chr )
1189
1190          WRITE (coor_chr,'(F7.1)')  sa_vertical_gradient_level(i)
1191          coordinates = TRIM( coordinates ) // ' '  // TRIM( coor_chr )
1192
1193          IF ( i == 10 )  THEN
1194             EXIT
1195          ELSE
1196             i = i + 1
1197          ENDIF
1198
1199       ENDDO
1200
1201       WRITE ( io, 425 )  TRIM( coordinates ), TRIM( temperatures ), &
1202                          TRIM( gradients ), TRIM( slices )
1203    ENDIF
1204
1205
1206!
1207!-- Listing of 1D-profiles
1208    WRITE ( io, 325 )  dt_dopr_listing
1209    IF ( averaging_interval_pr /= 0.0_wp )  THEN
1210       WRITE ( io, 326 )  averaging_interval_pr, dt_averaging_input_pr
1211    ENDIF
1212
1213!
1214!-- DATA output
1215    WRITE ( io, 330 )
1216    IF ( averaging_interval_pr /= 0.0_wp )  THEN
1217       WRITE ( io, 326 )  averaging_interval_pr, dt_averaging_input_pr
1218    ENDIF
1219
1220!
1221!-- 1D-profiles
1222    dopr_chr = 'Profile:'
1223    IF ( dopr_n /= 0 )  THEN
1224       WRITE ( io, 331 )
1225
1226       output_format = ''
1227       output_format = netcdf_data_format_string
1228       IF ( netcdf_deflate == 0 )  THEN
1229          WRITE ( io, 344 )  output_format
1230       ELSE
1231          WRITE ( io, 354 )  TRIM( output_format ), netcdf_deflate
1232       ENDIF
1233
1234       DO  i = 1, dopr_n
1235          dopr_chr = TRIM( dopr_chr ) // ' ' // TRIM( data_output_pr(i) ) // ','
1236          IF ( LEN_TRIM( dopr_chr ) >= 60 )  THEN
1237             WRITE ( io, 332 )  dopr_chr
1238             dopr_chr = '       :'
1239          ENDIF
1240       ENDDO
1241
1242       IF ( dopr_chr /= '' )  THEN
1243          WRITE ( io, 332 )  dopr_chr
1244       ENDIF
1245       WRITE ( io, 333 )  dt_dopr, averaging_interval_pr, dt_averaging_input_pr
1246       IF ( skip_time_dopr /= 0.0_wp )  WRITE ( io, 339 )  skip_time_dopr
1247    ENDIF
1248
1249!
1250!-- 2D-arrays
1251    DO  av = 0, 1
1252
1253       i = 1
1254       do2d_xy = ''
1255       do2d_xz = ''
1256       do2d_yz = ''
1257       DO  WHILE ( do2d(av,i) /= ' ' )
1258
1259          l = MAX( 2, LEN_TRIM( do2d(av,i) ) )
1260          do2d_mode = do2d(av,i)(l-1:l)
1261
1262          SELECT CASE ( do2d_mode )
1263             CASE ( 'xy' )
1264                ll = LEN_TRIM( do2d_xy )
1265                do2d_xy = do2d_xy(1:ll) // ' ' // do2d(av,i)(1:l-3) // ','
1266             CASE ( 'xz' )
1267                ll = LEN_TRIM( do2d_xz )
1268                do2d_xz = do2d_xz(1:ll) // ' ' // do2d(av,i)(1:l-3) // ','
1269             CASE ( 'yz' )
1270                ll = LEN_TRIM( do2d_yz )
1271                do2d_yz = do2d_yz(1:ll) // ' ' // do2d(av,i)(1:l-3) // ','
1272          END SELECT
1273
1274          i = i + 1
1275
1276       ENDDO
1277
1278       IF ( ( ( do2d_xy /= ''  .AND.  section(1,1) /= -9999 )  .OR.    &
1279              ( do2d_xz /= ''  .AND.  section(1,2) /= -9999 )  .OR.    &
1280              ( do2d_yz /= ''  .AND.  section(1,3) /= -9999 ) ) )  THEN
1281
1282          IF (  av == 0 )  THEN
1283             WRITE ( io, 334 )  ''
1284          ELSE
1285             WRITE ( io, 334 )  '(time-averaged)'
1286          ENDIF
1287
1288          IF ( do2d_at_begin )  THEN
1289             begin_chr = 'and at the start'
1290          ELSE
1291             begin_chr = ''
1292          ENDIF
1293
1294          output_format = ''
1295          output_format = netcdf_data_format_string
1296          IF ( netcdf_deflate == 0 )  THEN
1297             WRITE ( io, 344 )  output_format
1298          ELSE
1299             WRITE ( io, 354 )  TRIM( output_format ), netcdf_deflate
1300          ENDIF
1301
1302          IF ( do2d_xy /= ''  .AND.  section(1,1) /= -9999 )  THEN
1303             i = 1
1304             slices = '/'
1305             coordinates = '/'
1306!
1307!--          Building strings with index and coordinate information of the
1308!--          slices
1309             DO  WHILE ( section(i,1) /= -9999 )
1310
1311                WRITE (section_chr,'(I5)')  section(i,1)
1312                section_chr = ADJUSTL( section_chr )
1313                slices = TRIM( slices ) // TRIM( section_chr ) // '/'
1314
1315                IF ( section(i,1) == -1 )  THEN
1316                   WRITE (coor_chr,'(F10.1)')  -1.0_wp
1317                ELSE
1318                   WRITE (coor_chr,'(F10.1)')  zu(section(i,1))
1319                ENDIF
1320                coor_chr = ADJUSTL( coor_chr )
1321                coordinates = TRIM( coordinates ) // TRIM( coor_chr ) // '/'
1322
1323                i = i + 1
1324             ENDDO
1325             IF ( av == 0 )  THEN
1326                WRITE ( io, 335 )  'XY', do2d_xy, dt_do2d_xy, &
1327                                   TRIM( begin_chr ), 'k', TRIM( slices ), &
1328                                   TRIM( coordinates )
1329                IF ( skip_time_do2d_xy /= 0.0_wp )  THEN
1330                   WRITE ( io, 339 )  skip_time_do2d_xy
1331                ENDIF
1332             ELSE
1333                WRITE ( io, 342 )  'XY', do2d_xy, dt_data_output_av, &
1334                                   TRIM( begin_chr ), averaging_interval, &
1335                                   dt_averaging_input, 'k', TRIM( slices ), &
1336                                   TRIM( coordinates )
1337                IF ( skip_time_data_output_av /= 0.0_wp )  THEN
1338                   WRITE ( io, 339 )  skip_time_data_output_av
1339                ENDIF
1340             ENDIF
1341             IF ( netcdf_data_format > 4 )  THEN
1342                WRITE ( io, 352 )  ntdim_2d_xy(av)
1343             ELSE
1344                WRITE ( io, 353 )
1345             ENDIF
1346          ENDIF
1347
1348          IF ( do2d_xz /= ''  .AND.  section(1,2) /= -9999 )  THEN
1349             i = 1
1350             slices = '/'
1351             coordinates = '/'
1352!
1353!--          Building strings with index and coordinate information of the
1354!--          slices
1355             DO  WHILE ( section(i,2) /= -9999 )
1356
1357                WRITE (section_chr,'(I5)')  section(i,2)
1358                section_chr = ADJUSTL( section_chr )
1359                slices = TRIM( slices ) // TRIM( section_chr ) // '/'
1360
1361                WRITE (coor_chr,'(F10.1)')  section(i,2) * dy
1362                coor_chr = ADJUSTL( coor_chr )
1363                coordinates = TRIM( coordinates ) // TRIM( coor_chr ) // '/'
1364
1365                i = i + 1
1366             ENDDO
1367             IF ( av == 0 )  THEN
1368                WRITE ( io, 335 )  'XZ', do2d_xz, dt_do2d_xz, &
1369                                   TRIM( begin_chr ), 'j', TRIM( slices ), &
1370                                   TRIM( coordinates )
1371                IF ( skip_time_do2d_xz /= 0.0_wp )  THEN
1372                   WRITE ( io, 339 )  skip_time_do2d_xz
1373                ENDIF
1374             ELSE
1375                WRITE ( io, 342 )  'XZ', do2d_xz, dt_data_output_av, &
1376                                   TRIM( begin_chr ), averaging_interval, &
1377                                   dt_averaging_input, 'j', TRIM( slices ), &
1378                                   TRIM( coordinates )
1379                IF ( skip_time_data_output_av /= 0.0_wp )  THEN
1380                   WRITE ( io, 339 )  skip_time_data_output_av
1381                ENDIF
1382             ENDIF
1383             IF ( netcdf_data_format > 4 )  THEN
1384                WRITE ( io, 352 )  ntdim_2d_xz(av)
1385             ELSE
1386                WRITE ( io, 353 )
1387             ENDIF
1388          ENDIF
1389
1390          IF ( do2d_yz /= ''  .AND.  section(1,3) /= -9999 )  THEN
1391             i = 1
1392             slices = '/'
1393             coordinates = '/'
1394!
1395!--          Building strings with index and coordinate information of the
1396!--          slices
1397             DO  WHILE ( section(i,3) /= -9999 )
1398
1399                WRITE (section_chr,'(I5)')  section(i,3)
1400                section_chr = ADJUSTL( section_chr )
1401                slices = TRIM( slices ) // TRIM( section_chr ) // '/'
1402
1403                WRITE (coor_chr,'(F10.1)')  section(i,3) * dx
1404                coor_chr = ADJUSTL( coor_chr )
1405                coordinates = TRIM( coordinates ) // TRIM( coor_chr ) // '/'
1406
1407                i = i + 1
1408             ENDDO
1409             IF ( av == 0 )  THEN
1410                WRITE ( io, 335 )  'YZ', do2d_yz, dt_do2d_yz, &
1411                                   TRIM( begin_chr ), 'i', TRIM( slices ), &
1412                                   TRIM( coordinates )
1413                IF ( skip_time_do2d_yz /= 0.0_wp )  THEN
1414                   WRITE ( io, 339 )  skip_time_do2d_yz
1415                ENDIF
1416             ELSE
1417                WRITE ( io, 342 )  'YZ', do2d_yz, dt_data_output_av, &
1418                                   TRIM( begin_chr ), averaging_interval, &
1419                                   dt_averaging_input, 'i', TRIM( slices ), &
1420                                   TRIM( coordinates )
1421                IF ( skip_time_data_output_av /= 0.0_wp )  THEN
1422                   WRITE ( io, 339 )  skip_time_data_output_av
1423                ENDIF
1424             ENDIF
1425             IF ( netcdf_data_format > 4 )  THEN
1426                WRITE ( io, 352 )  ntdim_2d_yz(av)
1427             ELSE
1428                WRITE ( io, 353 )
1429             ENDIF
1430          ENDIF
1431
1432       ENDIF
1433
1434    ENDDO
1435
1436!
1437!-- 3d-arrays
1438    DO  av = 0, 1
1439
1440       i = 1
1441       do3d_chr = ''
1442       DO  WHILE ( do3d(av,i) /= ' ' )
1443
1444          do3d_chr = TRIM( do3d_chr ) // ' ' // TRIM( do3d(av,i) ) // ','
1445          i = i + 1
1446
1447       ENDDO
1448
1449       IF ( do3d_chr /= '' )  THEN
1450          IF ( av == 0 )  THEN
1451             WRITE ( io, 336 )  ''
1452          ELSE
1453             WRITE ( io, 336 )  '(time-averaged)'
1454          ENDIF
1455
1456          output_format = netcdf_data_format_string
1457          IF ( netcdf_deflate == 0 )  THEN
1458             WRITE ( io, 344 )  output_format
1459          ELSE
1460             WRITE ( io, 354 )  TRIM( output_format ), netcdf_deflate
1461          ENDIF
1462
1463          IF ( do3d_at_begin )  THEN
1464             begin_chr = 'and at the start'
1465          ELSE
1466             begin_chr = ''
1467          ENDIF
1468          IF ( av == 0 )  THEN
1469             WRITE ( io, 337 )  do3d_chr, dt_do3d, TRIM( begin_chr ), &
1470                                zu(nz_do3d), nz_do3d
1471          ELSE
1472             WRITE ( io, 343 )  do3d_chr, dt_data_output_av,           &
1473                                TRIM( begin_chr ), averaging_interval, &
1474                                dt_averaging_input, zu(nz_do3d), nz_do3d
1475          ENDIF
1476
1477          IF ( netcdf_data_format > 4 )  THEN
1478             WRITE ( io, 352 )  ntdim_3d(av)
1479          ELSE
1480             WRITE ( io, 353 )
1481          ENDIF
1482
1483          IF ( av == 0 )  THEN
1484             IF ( skip_time_do3d /= 0.0_wp )  THEN
1485                WRITE ( io, 339 )  skip_time_do3d
1486             ENDIF
1487          ELSE
1488             IF ( skip_time_data_output_av /= 0.0_wp )  THEN
1489                WRITE ( io, 339 )  skip_time_data_output_av
1490             ENDIF
1491          ENDIF
1492
1493       ENDIF
1494
1495    ENDDO
1496
1497!
1498!-- masked arrays
1499    IF ( masks > 0 )  WRITE ( io, 345 )  &
1500         mask_scale_x, mask_scale_y, mask_scale_z
1501    DO  mid = 1, masks
1502       DO  av = 0, 1
1503
1504          i = 1
1505          domask_chr = ''
1506          DO  WHILE ( domask(mid,av,i) /= ' ' )
1507             domask_chr = TRIM( domask_chr ) // ' ' //  &
1508                          TRIM( domask(mid,av,i) ) // ','
1509             i = i + 1
1510          ENDDO
1511
1512          IF ( domask_chr /= '' )  THEN
1513             IF ( av == 0 )  THEN
1514                WRITE ( io, 346 )  '', mid
1515             ELSE
1516                WRITE ( io, 346 )  ' (time-averaged)', mid
1517             ENDIF
1518
1519             output_format = netcdf_data_format_string
1520!--          Parallel output not implemented for mask data, hence
1521!--          output_format must be adjusted.
1522             IF ( netcdf_data_format == 5 ) output_format = 'netCDF4/HDF5'
1523             IF ( netcdf_data_format == 6 ) output_format = 'netCDF4/HDF5 classic'
1524             IF ( netcdf_deflate == 0 )  THEN
1525                WRITE ( io, 344 )  output_format
1526             ELSE
1527                WRITE ( io, 354 )  TRIM( output_format ), netcdf_deflate
1528             ENDIF
1529
1530             IF ( av == 0 )  THEN
1531                WRITE ( io, 347 )  domask_chr, dt_domask(mid)
1532             ELSE
1533                WRITE ( io, 348 )  domask_chr, dt_data_output_av, &
1534                                   averaging_interval, dt_averaging_input
1535             ENDIF
1536
1537             IF ( av == 0 )  THEN
1538                IF ( skip_time_domask(mid) /= 0.0_wp )  THEN
1539                   WRITE ( io, 339 )  skip_time_domask(mid)
1540                ENDIF
1541             ELSE
1542                IF ( skip_time_data_output_av /= 0.0_wp )  THEN
1543                   WRITE ( io, 339 )  skip_time_data_output_av
1544                ENDIF
1545             ENDIF
1546!
1547!--          output locations
1548             DO  dim = 1, 3
1549                IF ( mask(mid,dim,1) >= 0.0_wp )  THEN
1550                   count = 0
1551                   DO  WHILE ( mask(mid,dim,count+1) >= 0.0_wp )
1552                      count = count + 1
1553                   ENDDO
1554                   WRITE ( io, 349 )  dir(dim), dir(dim), mid, dir(dim), &
1555                                      mask(mid,dim,:count)
1556                ELSEIF ( mask_loop(mid,dim,1) < 0.0_wp .AND.  &
1557                         mask_loop(mid,dim,2) < 0.0_wp .AND.  &
1558                         mask_loop(mid,dim,3) == 0.0_wp )  THEN
1559                   WRITE ( io, 350 )  dir(dim), dir(dim)
1560                ELSEIF ( mask_loop(mid,dim,3) == 0.0_wp )  THEN
1561                   WRITE ( io, 351 )  dir(dim), dir(dim), mid, dir(dim), &
1562                                      mask_loop(mid,dim,1:2)
1563                ELSE
1564                   WRITE ( io, 351 )  dir(dim), dir(dim), mid, dir(dim), &
1565                                      mask_loop(mid,dim,1:3)
1566                ENDIF
1567             ENDDO
1568          ENDIF
1569
1570       ENDDO
1571    ENDDO
1572
1573!
1574!-- Timeseries
1575    IF ( dt_dots /= 9999999.9_wp )  THEN
1576       WRITE ( io, 340 )
1577
1578       output_format = netcdf_data_format_string
1579       IF ( netcdf_deflate == 0 )  THEN
1580          WRITE ( io, 344 )  output_format
1581       ELSE
1582          WRITE ( io, 354 )  TRIM( output_format ), netcdf_deflate
1583       ENDIF
1584       WRITE ( io, 341 )  dt_dots
1585    ENDIF
1586
1587#if defined( __dvrp_graphics )
1588!
1589!-- Dvrp-output
1590    IF ( dt_dvrp /= 9999999.9_wp )  THEN
1591       WRITE ( io, 360 )  dt_dvrp, TRIM( dvrp_output ), TRIM( dvrp_host ), &
1592                          TRIM( dvrp_username ), TRIM( dvrp_directory )
1593       i = 1
1594       l = 0
1595       m = 0
1596       DO WHILE ( mode_dvrp(i) /= ' ' )
1597          IF ( mode_dvrp(i)(1:10) == 'isosurface' )  THEN
1598             READ ( mode_dvrp(i), '(10X,I2)' )  j
1599             l = l + 1
1600             IF ( do3d(0,j) /= ' ' )  THEN
1601                WRITE ( io, 361 )  TRIM( do3d(0,j) ), threshold(l), &
1602                                   isosurface_color(:,l)
1603             ENDIF
1604          ELSEIF ( mode_dvrp(i)(1:6) == 'slicer' )  THEN
1605             READ ( mode_dvrp(i), '(6X,I2)' )  j
1606             m = m + 1
1607             IF ( do2d(0,j) /= ' ' )  THEN
1608                WRITE ( io, 362 )  TRIM( do2d(0,j) ), &
1609                                   slicer_range_limits_dvrp(:,m)
1610             ENDIF
1611          ENDIF
1612          i = i + 1
1613       ENDDO
1614
1615       WRITE ( io, 365 )  groundplate_color, superelevation_x, &
1616                          superelevation_y, superelevation, clip_dvrp_l, &
1617                          clip_dvrp_r, clip_dvrp_s, clip_dvrp_n
1618
1619       IF ( TRIM( topography ) /= 'flat' )  THEN
1620          WRITE ( io, 366 )  topography_color
1621          IF ( cluster_size > 1 )  THEN
1622             WRITE ( io, 367 )  cluster_size
1623          ENDIF
1624       ENDIF
1625
1626    ENDIF
1627#endif
1628
1629!
1630!-- Spectra output
1631    IF ( dt_dosp /= 9999999.9_wp )  THEN
1632       WRITE ( io, 370 )
1633
1634       output_format = netcdf_data_format_string
1635       IF ( netcdf_deflate == 0 )  THEN
1636          WRITE ( io, 344 )  output_format
1637       ELSE
1638          WRITE ( io, 354 )  TRIM( output_format ), netcdf_deflate
1639       ENDIF
1640       WRITE ( io, 371 )  dt_dosp
1641       IF ( skip_time_dosp /= 0.0_wp )  WRITE ( io, 339 )  skip_time_dosp
1642       WRITE ( io, 372 )  ( data_output_sp(i), i = 1,10 ),     &
1643                          ( spectra_direction(i), i = 1,10 ),  &
1644                          ( comp_spectra_level(i), i = 1,100 ), &
1645                          ( plot_spectra_level(i), i = 1,100 ), &
1646                          averaging_interval_sp, dt_averaging_input_pr
1647    ENDIF
1648
1649    WRITE ( io, 99 )
1650
1651!
1652!-- Physical quantities
1653    WRITE ( io, 400 )
1654
1655!
1656!-- Geostrophic parameters
1657    WRITE ( io, 410 )  phi, omega, f, fs
1658
1659!
1660!-- Other quantities
1661    WRITE ( io, 411 )  g
1662
1663    WRITE ( io, 412 )  TRIM( reference_state )
1664    IF ( use_single_reference_value )  THEN
1665       IF ( ocean )  THEN
1666          WRITE ( io, 413 )  prho_reference
1667       ELSE
1668          WRITE ( io, 414 )  pt_reference
1669       ENDIF
1670    ENDIF
1671
1672!
1673!-- Cloud physics parameters
1674    IF ( cloud_physics )  THEN
1675       WRITE ( io, 415 )
1676       WRITE ( io, 416 ) surface_pressure, r_d, rho_surface, cp, l_v
1677       IF ( microphysics_seifert )  THEN
1678          WRITE ( io, 510 ) 1.0E-6_wp * nc_const
1679          WRITE ( io, 511 ) c_sedimentation
1680       ENDIF
1681    ENDIF
1682
1683!
1684!-- Cloud physcis parameters / quantities / numerical methods
1685    WRITE ( io, 430 )
1686    IF ( humidity .AND. .NOT. cloud_physics .AND. .NOT. cloud_droplets)  THEN
1687       WRITE ( io, 431 )
1688    ELSEIF ( humidity  .AND.  cloud_physics )  THEN
1689       WRITE ( io, 432 )
1690       IF ( cloud_top_radiation )  WRITE ( io, 132 )
1691       IF ( microphysics_kessler )  THEN
1692          WRITE ( io, 133 )
1693       ELSEIF ( microphysics_seifert )  THEN
1694          IF ( cloud_water_sedimentation )  WRITE ( io, 506 )
1695          WRITE ( io, 505 )
1696          IF ( collision_turbulence )  WRITE ( io, 507 )
1697          IF ( ventilation_effect )  WRITE ( io, 508 )
1698          IF ( limiter_sedimentation )  WRITE ( io, 509 )
1699       ENDIF
1700    ELSEIF ( humidity  .AND.  cloud_droplets )  THEN
1701       WRITE ( io, 433 )
1702       IF ( curvature_solution_effects )  WRITE ( io, 434 )
1703       IF ( collision_kernel /= 'none' )  THEN
1704          WRITE ( io, 435 )  TRIM( collision_kernel )
1705          IF ( collision_kernel(6:9) == 'fast' )  THEN
1706             WRITE ( io, 436 )  radius_classes, dissipation_classes
1707          ENDIF
1708       ELSE
1709          WRITE ( io, 437 )
1710       ENDIF
1711    ENDIF
1712
1713!
1714!-- LES / turbulence parameters
1715    WRITE ( io, 450 )
1716
1717!--
1718! ... LES-constants used must still be added here
1719!--
1720    IF ( constant_diffusion )  THEN
1721       WRITE ( io, 451 )  km_constant, km_constant/prandtl_number, &
1722                          prandtl_number
1723    ENDIF
1724    IF ( .NOT. constant_diffusion)  THEN
1725       IF ( e_init > 0.0_wp )  WRITE ( io, 455 )  e_init
1726       IF ( e_min > 0.0_wp )  WRITE ( io, 454 )  e_min
1727       IF ( wall_adjustment )  WRITE ( io, 453 )  wall_adjustment_factor
1728    ENDIF
1729
1730!
1731!-- Special actions during the run
1732    WRITE ( io, 470 )
1733    IF ( create_disturbances )  THEN
1734       WRITE ( io, 471 )  dt_disturb, disturbance_amplitude,                   &
1735                          zu(disturbance_level_ind_b), disturbance_level_ind_b,&
1736                          zu(disturbance_level_ind_t), disturbance_level_ind_t
1737       IF ( .NOT. bc_lr_cyc  .OR.  .NOT. bc_ns_cyc )  THEN
1738          WRITE ( io, 472 )  inflow_disturbance_begin, inflow_disturbance_end
1739       ELSE
1740          WRITE ( io, 473 )  disturbance_energy_limit
1741       ENDIF
1742       WRITE ( io, 474 )  TRIM( random_generator )
1743    ENDIF
1744    IF ( pt_surface_initial_change /= 0.0_wp )  THEN
1745       WRITE ( io, 475 )  pt_surface_initial_change
1746    ENDIF
1747    IF ( humidity  .AND.  q_surface_initial_change /= 0.0_wp )  THEN
1748       WRITE ( io, 476 )  q_surface_initial_change       
1749    ENDIF
1750    IF ( passive_scalar  .AND.  q_surface_initial_change /= 0.0_wp )  THEN
1751       WRITE ( io, 477 )  q_surface_initial_change       
1752    ENDIF
1753
1754    IF ( particle_advection )  THEN
1755!
1756!--    Particle attributes
1757       WRITE ( io, 480 )  particle_advection_start, dt_prel, bc_par_lr, &
1758                          bc_par_ns, bc_par_b, bc_par_t, particle_maximum_age, &
1759                          end_time_prel
1760       IF ( use_sgs_for_particles )  WRITE ( io, 488 )  dt_min_part
1761       IF ( random_start_position )  WRITE ( io, 481 )
1762       IF ( seed_follows_topography )  WRITE ( io, 496 )
1763       IF ( particles_per_point > 1 )  WRITE ( io, 489 )  particles_per_point
1764       WRITE ( io, 495 )  total_number_of_particles
1765       IF ( dt_write_particle_data /= 9999999.9_wp )  THEN
1766          WRITE ( io, 485 )  dt_write_particle_data
1767          IF ( netcdf_data_format > 1 )  THEN
1768             output_format = 'netcdf (64 bit offset) and binary'
1769          ELSE
1770             output_format = 'netcdf and binary'
1771          ENDIF
1772          IF ( netcdf_deflate == 0 )  THEN
1773             WRITE ( io, 344 )  output_format
1774          ELSE
1775             WRITE ( io, 354 )  TRIM( output_format ), netcdf_deflate
1776          ENDIF
1777       ENDIF
1778       IF ( dt_dopts /= 9999999.9_wp )  WRITE ( io, 494 )  dt_dopts
1779       IF ( write_particle_statistics )  WRITE ( io, 486 )
1780
1781       WRITE ( io, 487 )  number_of_particle_groups
1782
1783       DO  i = 1, number_of_particle_groups
1784          IF ( i == 1  .AND.  density_ratio(i) == 9999999.9_wp )  THEN
1785             WRITE ( io, 490 )  i, 0.0_wp
1786             WRITE ( io, 492 )
1787          ELSE
1788             WRITE ( io, 490 )  i, radius(i)
1789             IF ( density_ratio(i) /= 0.0_wp )  THEN
1790                WRITE ( io, 491 )  density_ratio(i)
1791             ELSE
1792                WRITE ( io, 492 )
1793             ENDIF
1794          ENDIF
1795          WRITE ( io, 493 )  psl(i), psr(i), pss(i), psn(i), psb(i), pst(i), &
1796                             pdx(i), pdy(i), pdz(i)
1797          IF ( .NOT. vertical_particle_advection(i) )  WRITE ( io, 482 )
1798       ENDDO
1799
1800    ENDIF
1801
1802
1803!
1804!-- Parameters of 1D-model
1805    IF ( INDEX( initializing_actions, 'set_1d-model_profiles' ) /= 0 )  THEN
1806       WRITE ( io, 500 )  end_time_1d, dt_run_control_1d, dt_pr_1d, &
1807                          mixing_length_1d, dissipation_1d
1808       IF ( damp_level_ind_1d /= nzt+1 )  THEN
1809          WRITE ( io, 502 )  zu(damp_level_ind_1d), damp_level_ind_1d
1810       ENDIF
1811    ENDIF
1812
1813!
1814!-- User-defined information
1815    CALL user_header( io )
1816
1817    WRITE ( io, 99 )
1818
1819!
1820!-- Write buffer contents to disc immediately
1821    FLUSH( io )
1822
1823!
1824!-- Here the FORMATs start
1825
1826 99 FORMAT (1X,78('-'))
1827100 FORMAT (/1X,'******************************',4X,44('-')/        &
1828            1X,'* ',A,' *',4X,A/                               &
1829            1X,'******************************',4X,44('-'))
1830101 FORMAT (35X,'coupled run using MPI-',I1,': ',A/ &
1831            35X,42('-'))
1832102 FORMAT (/' Date:                 ',A8,4X,'Run:       ',A20/      &
1833            ' Time:                 ',A8,4X,'Run-No.:   ',I2.2/     &
1834            ' Run on host:        ',A10)
1835#if defined( __parallel )
1836103 FORMAT (' Number of PEs:',10X,I6,4X,'Processor grid (x,y): (',I4,',',I4, &
1837              ')',1X,A)
1838104 FORMAT (' Number of PEs:',10X,I6,4X,'Tasks:',I4,'   threads per task:',I4/ &
1839              35X,'Processor grid (x,y): (',I4,',',I4,')',1X,A)
1840105 FORMAT (35X,'One additional PE is used to handle'/37X,'the dvrp output!')
1841106 FORMAT (35X,'A 1d-decomposition along x is forced'/ &
1842            35X,'because the job is running on an SMP-cluster')
1843107 FORMAT (35X,'A 1d-decomposition along ',A,' is used')
1844108 FORMAT (35X,'Max. # of parallel I/O streams is ',I5)
1845109 FORMAT (35X,'Precursor run for coupled atmos-ocean run'/ &
1846            35X,42('-'))
1847114 FORMAT (35X,'Coupled atmosphere-ocean run following'/ &
1848            35X,'independent precursor runs'/             &
1849            35X,42('-'))
1850117 FORMAT (' Accelerator boards / node:  ',I2)
1851#endif
1852110 FORMAT (/' Numerical Schemes:'/ &
1853             ' -----------------'/)
1854111 FORMAT (' --> Solve perturbation pressure via FFT using ',A,' routines')
1855112 FORMAT (' --> Solve perturbation pressure via SOR-Red/Black-Schema'/ &
1856            '     Iterations (initial/other): ',I3,'/',I3,'  omega =',F6.3)
1857113 FORMAT (' --> Momentum advection via Piascek-Williams-Scheme (Form C3)', &
1858                  ' or Upstream')
1859115 FORMAT ('     FFT and transpositions are overlapping')
1860116 FORMAT (' --> Scalar advection via Piascek-Williams-Scheme (Form C3)', &
1861                  ' or Upstream')
1862118 FORMAT (' --> Scalar advection via Bott-Chlond-Scheme')
1863119 FORMAT (' --> Galilei-Transform applied to horizontal advection:'/ &
1864            '     translation velocity = ',A/ &
1865            '     distance advected ',A,':  ',F8.3,' km(x)  ',F8.3,' km(y)')
1866120 FORMAT (' Accelerator boards: ',8X,I2)
1867122 FORMAT (' --> Time differencing scheme: ',A)
1868123 FORMAT (' --> Rayleigh-Damping active, starts ',A,' z = ',F8.2,' m'/ &
1869            '     maximum damping coefficient:',F6.3, ' 1/s')
1870129 FORMAT (' --> Additional prognostic equation for the specific humidity')
1871130 FORMAT (' --> Additional prognostic equation for the total water content')
1872131 FORMAT (' --> No pt-equation solved. Neutral stratification with pt = ', &
1873                  F6.2, ' K assumed')
1874132 FORMAT ('     Parameterization of long-wave radiation processes via'/ &
1875            '     effective emissivity scheme')
1876133 FORMAT ('     Precipitation parameterization via Kessler-Scheme')
1877134 FORMAT (' --> Additional prognostic equation for a passive scalar')
1878135 FORMAT (' --> Solve perturbation pressure via ',A,' method (', &
1879                  A,'-cycle)'/ &
1880            '     number of grid levels:                   ',I2/ &
1881            '     Gauss-Seidel red/black iterations:       ',I2)
1882136 FORMAT ('     gridpoints of coarsest subdomain (x,y,z): (',I3,',',I3,',', &
1883                  I3,')')
1884137 FORMAT ('     level data gathered on PE0 at level:     ',I2/ &
1885            '     gridpoints of coarsest subdomain (x,y,z): (',I3,',',I3,',', &
1886                  I3,')'/ &
1887            '     gridpoints of coarsest domain (x,y,z):    (',I3,',',I3,',', &
1888                  I3,')')
1889139 FORMAT (' --> Loop optimization method: ',A)
1890140 FORMAT ('     maximum residual allowed:                ',E10.3)
1891141 FORMAT ('     fixed number of multigrid cycles:        ',I4)
1892142 FORMAT ('     perturbation pressure is calculated at every Runge-Kutta ', &
1893                  'step')
1894143 FORMAT ('     Euler/upstream scheme is used for the SGS turbulent ', &
1895                  'kinetic energy')
1896144 FORMAT ('     masking method is used')
1897150 FORMAT (' --> Volume flow at the right and north boundary will be ', &
1898                  'conserved'/ &
1899            '     using the ',A,' mode')
1900151 FORMAT ('     with u_bulk = ',F7.3,' m/s and v_bulk = ',F7.3,' m/s')
1901152 FORMAT (' --> External pressure gradient directly prescribed by the user:',&
1902           /'     ',2(1X,E12.5),'Pa/m in x/y direction', &
1903           /'     starting from dp_level_b =', F8.3, 'm', A /)
1904160 FORMAT (//' Large scale forcing and nudging:'/ &
1905              ' -------------------------------'/)
1906161 FORMAT (' --> No large scale forcing from external is used (default) ')
1907162 FORMAT (' --> Large scale forcing from external file LSF_DATA is used: ')
1908163 FORMAT ('     - large scale advection tendencies ')
1909164 FORMAT ('     - large scale subsidence velocity w_subs ')
1910165 FORMAT ('     - large scale subsidence tendencies ')
1911167 FORMAT ('     - and geostrophic wind components ug and vg')
1912168 FORMAT (' --> Large-scale vertical motion is used in the ', &
1913                  'prognostic equation(s) for')
1914169 FORMAT ('     the scalar(s) only')
1915170 FORMAT (' --> Nudging is used')
1916171 FORMAT (' --> No nudging is used (default) ')
1917180 FORMAT ('     - prescribed surface values for temperature')
1918181 FORMAT ('     - prescribed surface fluxes for temperature')
1919182 FORMAT ('     - prescribed surface values for humidity')
1920183 FORMAT ('     - prescribed surface fluxes for humidity')
1921200 FORMAT (//' Run time and time step information:'/ &
1922             ' ----------------------------------'/)
1923201 FORMAT ( ' Timestep:             variable     maximum value: ',F6.3,' s', &
1924             '    CFL-factor:',F5.2)
1925202 FORMAT ( ' Timestep:          dt = ',F6.3,' s'/)
1926203 FORMAT ( ' Start time:          ',F9.3,' s'/ &
1927             ' End time:            ',F9.3,' s')
1928204 FORMAT ( A,F9.3,' s')
1929205 FORMAT ( A,F9.3,' s',5X,'restart every',17X,F9.3,' s')
1930206 FORMAT (/' Time reached:        ',F9.3,' s'/ &
1931             ' CPU-time used:       ',F9.3,' s     per timestep:               ', &
1932               '  ',F9.3,' s'/                                                    &
1933             '                                      per second of simulated tim', &
1934               'e: ',F9.3,' s')
1935207 FORMAT ( ' Coupling start time: ',F9.3,' s')
1936250 FORMAT (//' Computational grid and domain size:'/ &
1937              ' ----------------------------------'// &
1938              ' Grid length:      dx =    ',F7.3,' m    dy =    ',F7.3, &
1939              ' m    dz =    ',F7.3,' m'/ &
1940              ' Domain size:       x = ',F10.3,' m     y = ',F10.3, &
1941              ' m  z(u) = ',F10.3,' m'/)
1942252 FORMAT (' dz constant up to ',F10.3,' m (k=',I4,'), then stretched by', &
1943              ' factor:',F6.3/ &
1944            ' maximum dz not to be exceeded is dz_max = ',F10.3,' m'/)
1945254 FORMAT (' Number of gridpoints (x,y,z):  (0:',I4,', 0:',I4,', 0:',I4,')'/ &
1946            ' Subdomain size (x,y,z):        (  ',I4,',   ',I4,',   ',I4,')'/)
1947260 FORMAT (/' The model has a slope in x-direction. Inclination angle: ',F6.2,&
1948             ' degrees')
1949270 FORMAT (//' Topography information:'/ &
1950              ' ----------------------'// &
1951              1X,'Topography: ',A)
1952271 FORMAT (  ' Building size (x/y/z) in m: ',F5.1,' / ',F5.1,' / ',F5.1/ &
1953              ' Horizontal index bounds (l/r/s/n): ',I4,' / ',I4,' / ',I4, &
1954                ' / ',I4)
1955272 FORMAT (  ' Single quasi-2D street canyon of infinite length in ',A, &
1956              ' direction' / &
1957              ' Canyon height: ', F6.2, 'm, ch = ', I4, '.'      / &
1958              ' Canyon position (',A,'-walls): cxl = ', I4,', cxr = ', I4, '.')
1959278 FORMAT (' Topography grid definition convention:'/ &
1960            ' cell edge (staggered grid points'/  &
1961            ' (u in x-direction, v in y-direction))' /)
1962279 FORMAT (' Topography grid definition convention:'/ &
1963            ' cell center (scalar grid points)' /)
1964300 FORMAT (//' Boundary conditions:'/ &
1965             ' -------------------'// &
1966             '                     p                    uv             ', &
1967             '                     pt'// &
1968             ' B. bound.: ',A/ &
1969             ' T. bound.: ',A)
1970301 FORMAT (/'                     ',A// &
1971             ' B. bound.: ',A/ &
1972             ' T. bound.: ',A)
1973303 FORMAT (/' Bottom surface fluxes are used in diffusion terms at k=1')
1974304 FORMAT (/' Top surface fluxes are used in diffusion terms at k=nzt')
1975305 FORMAT (//'    Prandtl-Layer between bottom surface and first ', &
1976               'computational u,v-level:'// &
1977             '       zp = ',F6.2,' m   z0 =',F7.4,' m   z0h =',F8.5,&
1978             ' m   kappa =',F5.2/ &
1979             '       Rif value range:   ',F8.2,' <= rif <=',F6.2)
1980306 FORMAT ('       Predefined constant heatflux:   ',F9.6,' K m/s')
1981307 FORMAT ('       Heatflux has a random normal distribution')
1982308 FORMAT ('       Predefined surface temperature')
1983309 FORMAT ('       Predefined constant salinityflux:   ',F9.6,' psu m/s')
1984310 FORMAT (//'    1D-Model:'// &
1985             '       Rif value range:   ',F6.2,' <= rif <=',F6.2)
1986311 FORMAT ('       Predefined constant humidity flux: ',E10.3,' m/s')
1987312 FORMAT ('       Predefined surface humidity')
1988313 FORMAT ('       Predefined constant scalar flux: ',E10.3,' kg/(m**2 s)')
1989314 FORMAT ('       Predefined scalar value at the surface')
1990315 FORMAT ('       Humidity / scalar flux at top surface is 0.0')
1991316 FORMAT ('       Sensible heatflux and momentum flux from coupled ', &
1992                    'atmosphere model')
1993317 FORMAT (//' Lateral boundaries:'/ &
1994            '       left/right:  ',A/    &
1995            '       north/south: ',A)
1996318 FORMAT (/'       use_cmax: ',L1 / &
1997            '       pt damping layer width = ',F8.2,' m, pt ', &
1998                    'damping factor =',F7.4)
1999319 FORMAT ('       turbulence recycling at inflow switched on'/ &
2000            '       width of recycling domain: ',F7.1,' m   grid index: ',I4/ &
2001            '       inflow damping height: ',F6.1,' m   width: ',F6.1,' m')
2002320 FORMAT ('       Predefined constant momentumflux:  u: ',F9.6,' m**2/s**2'/ &
2003            '                                          v: ',F9.6,' m**2/s**2')
2004321 FORMAT (//' Initial profiles:'/ &
2005              ' ----------------')
2006322 FORMAT ('       turbulence recycling at inflow switched on'/ &
2007            '       y shift of the recycled inflow turbulence switched on'/ &
2008            '       width of recycling domain: ',F7.1,' m   grid index: ',I4/ &
2009            '       inflow damping height: ',F6.1,' m   width: ',F6.1,' m'/)
2010325 FORMAT (//' List output:'/ &
2011             ' -----------'//  &
2012            '    1D-Profiles:'/    &
2013            '       Output every             ',F8.2,' s')
2014326 FORMAT ('       Time averaged over       ',F8.2,' s'/ &
2015            '       Averaging input every    ',F8.2,' s')
2016330 FORMAT (//' Data output:'/ &
2017             ' -----------'/)
2018331 FORMAT (/'    1D-Profiles:')
2019332 FORMAT (/'       ',A)
2020333 FORMAT ('       Output every             ',F8.2,' s',/ &
2021            '       Time averaged over       ',F8.2,' s'/ &
2022            '       Averaging input every    ',F8.2,' s')
2023334 FORMAT (/'    2D-Arrays',A,':')
2024335 FORMAT (/'       ',A2,'-cross-section  Arrays: ',A/ &
2025            '       Output every             ',F8.2,' s  ',A/ &
2026            '       Cross sections at ',A1,' = ',A/ &
2027            '       scalar-coordinates:   ',A,' m'/)
2028336 FORMAT (/'    3D-Arrays',A,':')
2029337 FORMAT (/'       Arrays: ',A/ &
2030            '       Output every             ',F8.2,' s  ',A/ &
2031            '       Upper output limit at    ',F8.2,' m  (GP ',I4,')'/)
2032339 FORMAT ('       No output during initial ',F8.2,' s')
2033340 FORMAT (/'    Time series:')
2034341 FORMAT ('       Output every             ',F8.2,' s'/)
2035342 FORMAT (/'       ',A2,'-cross-section  Arrays: ',A/ &
2036            '       Output every             ',F8.2,' s  ',A/ &
2037            '       Time averaged over       ',F8.2,' s'/ &
2038            '       Averaging input every    ',F8.2,' s'/ &
2039            '       Cross sections at ',A1,' = ',A/ &
2040            '       scalar-coordinates:   ',A,' m'/)
2041343 FORMAT (/'       Arrays: ',A/ &
2042            '       Output every             ',F8.2,' s  ',A/ &
2043            '       Time averaged over       ',F8.2,' s'/ &
2044            '       Averaging input every    ',F8.2,' s'/ &
2045            '       Upper output limit at    ',F8.2,' m  (GP ',I4,')'/)
2046344 FORMAT ('       Output format: ',A/)
2047345 FORMAT (/'    Scaling lengths for output locations of all subsequent mask IDs:',/ &
2048            '       mask_scale_x (in x-direction): ',F9.3, ' m',/ &
2049            '       mask_scale_y (in y-direction): ',F9.3, ' m',/ &
2050            '       mask_scale_z (in z-direction): ',F9.3, ' m' )
2051346 FORMAT (/'    Masked data output',A,' for mask ID ',I2, ':')
2052347 FORMAT ('       Variables: ',A/ &
2053            '       Output every             ',F8.2,' s')
2054348 FORMAT ('       Variables: ',A/ &
2055            '       Output every             ',F8.2,' s'/ &
2056            '       Time averaged over       ',F8.2,' s'/ &
2057            '       Averaging input every    ',F8.2,' s')
2058349 FORMAT (/'       Output locations in ',A,'-direction in multiples of ', &
2059            'mask_scale_',A,' predefined by array mask_',I2.2,'_',A,':'/ &
2060            13('       ',8(F8.2,',')/) )
2061350 FORMAT (/'       Output locations in ',A,'-direction: ', &
2062            'all gridpoints along ',A,'-direction (default).' )
2063351 FORMAT (/'       Output locations in ',A,'-direction in multiples of ', &
2064            'mask_scale_',A,' constructed from array mask_',I2.2,'_',A,'_loop:'/ &
2065            '          loop begin:',F8.2,', end:',F8.2,', stride:',F8.2 )
2066352 FORMAT  (/'       Number of output time levels allowed: ',I3 /)
2067353 FORMAT  (/'       Number of output time levels allowed: unlimited' /)
2068354 FORMAT ('       Output format: ',A, '   compressed with level: ',I1/)
2069#if defined( __dvrp_graphics )
2070360 FORMAT ('    Plot-Sequence with dvrp-software:'/ &
2071            '       Output every      ',F7.1,' s'/ &
2072            '       Output mode:      ',A/ &
2073            '       Host / User:      ',A,' / ',A/ &
2074            '       Directory:        ',A// &
2075            '       The sequence contains:')
2076361 FORMAT (/'       Isosurface of "',A,'"    Threshold value: ', E12.3/ &
2077            '          Isosurface color: (',F4.2,',',F4.2,',',F4.2,') (R,G,B)')
2078362 FORMAT (/'       Slicer plane ',A/ &
2079            '       Slicer limits: [',F6.2,',',F6.2,']')
2080365 FORMAT (/'       Groundplate color: (',F4.2,',',F4.2,',',F4.2,') (R,G,B)'/ &
2081            '       Superelevation along (x,y,z): (',F4.1,',',F4.1,',',F4.1, &
2082                     ')'/ &
2083            '       Clipping limits: from x = ',F9.1,' m to x = ',F9.1,' m'/ &
2084            '                        from y = ',F9.1,' m to y = ',F9.1,' m')
2085366 FORMAT (/'       Topography color: (',F4.2,',',F4.2,',',F4.2,') (R,G,B)')
2086367 FORMAT ('       Polygon reduction for topography: cluster_size = ', I1)
2087#endif
2088370 FORMAT ('    Spectra:')
2089371 FORMAT ('       Output every ',F7.1,' s'/)
2090372 FORMAT ('       Arrays:     ', 10(A5,',')/                         &
2091            '       Directions: ', 10(A5,',')/                         &
2092            '       height levels  k = ', 20(I3,',')/                  &
2093            '                          ', 20(I3,',')/                  &
2094            '                          ', 20(I3,',')/                  &
2095            '                          ', 20(I3,',')/                  &
2096            '                          ', 19(I3,','),I3,'.'/           &
2097            '       height levels selected for standard plot:'/        &
2098            '                      k = ', 20(I3,',')/                  &
2099            '                          ', 20(I3,',')/                  &
2100            '                          ', 20(I3,',')/                  &
2101            '                          ', 20(I3,',')/                  &
2102            '                          ', 19(I3,','),I3,'.'/           &
2103            '       Time averaged over ', F7.1, ' s,' /                &
2104            '       Profiles for the time averaging are taken every ', &
2105                    F6.1,' s')
2106400 FORMAT (//' Physical quantities:'/ &
2107              ' -------------------'/)
2108410 FORMAT ('    Geograph. latitude  :   phi    = ',F4.1,' degr'/   &
2109            '    Angular velocity    :   omega  =',E10.3,' rad/s'/  &
2110            '    Coriolis parameter  :   f      = ',F9.6,' 1/s'/    &
2111            '                            f*     = ',F9.6,' 1/s')
2112411 FORMAT (/'    Gravity             :   g      = ',F4.1,' m/s**2')
2113412 FORMAT (/'    Reference state used in buoyancy terms: ',A)
2114413 FORMAT ('       Reference density in buoyancy terms: ',F8.3,' kg/m**3')
2115414 FORMAT ('       Reference temperature in buoyancy terms: ',F8.4,' K')
2116415 FORMAT (/' Cloud physics parameters:'/ &
2117             ' ------------------------'/)
2118416 FORMAT ('    Surface pressure   :   p_0   = ',F7.2,' hPa'/      &
2119            '    Gas constant       :   R     = ',F5.1,' J/(kg K)'/ &
2120            '    Density of air     :   rho_0 =',F6.3,' kg/m**3'/  &
2121            '    Specific heat cap. :   c_p   = ',F6.1,' J/(kg K)'/ &
2122            '    Vapourization heat :   L_v   =',E9.2,' J/kg')
2123417 FORMAT ('    Geograph. longitude :   lambda = ',F4.1,' degr')
2124418 FORMAT (/'    Day of the year at model start :   day_init      =     ',I3 &
2125            /'    UTC time at model start        :   time_utc_init = ',F7.1' s')
2126420 FORMAT (/'    Characteristic levels of the initial temperature profile:'// &
2127            '       Height:        ',A,'  m'/ &
2128            '       Temperature:   ',A,'  K'/ &
2129            '       Gradient:      ',A,'  K/100m'/ &
2130            '       Gridpoint:     ',A)
2131421 FORMAT (/'    Characteristic levels of the initial humidity profile:'// &
2132            '       Height:      ',A,'  m'/ &
2133            '       Humidity:    ',A,'  kg/kg'/ &
2134            '       Gradient:    ',A,'  (kg/kg)/100m'/ &
2135            '       Gridpoint:   ',A)
2136422 FORMAT (/'    Characteristic levels of the initial scalar profile:'// &
2137            '       Height:                  ',A,'  m'/ &
2138            '       Scalar concentration:    ',A,'  kg/m**3'/ &
2139            '       Gradient:                ',A,'  (kg/m**3)/100m'/ &
2140            '       Gridpoint:               ',A)
2141423 FORMAT (/'    Characteristic levels of the geo. wind component ug:'// &
2142            '       Height:      ',A,'  m'/ &
2143            '       ug:          ',A,'  m/s'/ &
2144            '       Gradient:    ',A,'  1/100s'/ &
2145            '       Gridpoint:   ',A)
2146424 FORMAT (/'    Characteristic levels of the geo. wind component vg:'// &
2147            '       Height:      ',A,'  m'/ &
2148            '       vg:          ',A,'  m/s'/ &
2149            '       Gradient:    ',A,'  1/100s'/ &
2150            '       Gridpoint:   ',A)
2151425 FORMAT (/'    Characteristic levels of the initial salinity profile:'// &
2152            '       Height:     ',A,'  m'/ &
2153            '       Salinity:   ',A,'  psu'/ &
2154            '       Gradient:   ',A,'  psu/100m'/ &
2155            '       Gridpoint:  ',A)
2156426 FORMAT (/'    Characteristic levels of the subsidence/ascent profile:'// &
2157            '       Height:      ',A,'  m'/ &
2158            '       w_subs:      ',A,'  m/s'/ &
2159            '       Gradient:    ',A,'  (m/s)/100m'/ &
2160            '       Gridpoint:   ',A)
2161427 FORMAT (/'    Initial wind profiles (u,v) are interpolated from given'// &
2162                  ' profiles')
2163428 FORMAT (/'    Initial profiles (u, v, pt, q) are taken from file '/ &
2164             '    NUDGING_DATA')
2165430 FORMAT (//' Cloud physics quantities / methods:'/ &
2166              ' ----------------------------------'/)
2167431 FORMAT ('    Humidity is treated as purely passive scalar (no condensati', &
2168                 'on)')
2169432 FORMAT ('    Bulk scheme with liquid water potential temperature and'/ &
2170            '    total water content is used.'/ &
2171            '    Condensation is parameterized via 0% - or 100% scheme.')
2172433 FORMAT ('    Cloud droplets treated explicitly using the Lagrangian part', &
2173                 'icle model')
2174434 FORMAT ('    Curvature and solution effecs are considered for growth of', &
2175                 ' droplets < 1.0E-6 m')
2176435 FORMAT ('    Droplet collision is handled by ',A,'-kernel')
2177436 FORMAT ('       Fast kernel with fixed radius- and dissipation classes ', &
2178                    'are used'/ &
2179            '          number of radius classes:       ',I3,'    interval ', &
2180                       '[1.0E-6,2.0E-4] m'/ &
2181            '          number of dissipation classes:   ',I2,'    interval ', &
2182                       '[0,1000] cm**2/s**3')
2183437 FORMAT ('    Droplet collision is switched off')
2184450 FORMAT (//' LES / Turbulence quantities:'/ &
2185              ' ---------------------------'/)
2186451 FORMAT ('    Diffusion coefficients are constant:'/ &
2187            '    Km = ',F6.2,' m**2/s   Kh = ',F6.2,' m**2/s   Pr = ',F5.2)
2188453 FORMAT ('    Mixing length is limited to',F5.2,' * z')
2189454 FORMAT ('    TKE is not allowed to fall below ',E9.2,' (m/s)**2')
2190455 FORMAT ('    initial TKE is prescribed as ',E9.2,' (m/s)**2')
2191470 FORMAT (//' Actions during the simulation:'/ &
2192              ' -----------------------------'/)
2193471 FORMAT ('    Disturbance impulse (u,v) every :   ',F6.2,' s'/            &
2194            '    Disturbance amplitude           :    ',F5.2, ' m/s'/       &
2195            '    Lower disturbance level         : ',F8.2,' m (GP ',I4,')'/  &
2196            '    Upper disturbance level         : ',F8.2,' m (GP ',I4,')')
2197472 FORMAT ('    Disturbances continued during the run from i/j =',I4, &
2198                 ' to i/j =',I4)
2199473 FORMAT ('    Disturbances cease as soon as the disturbance energy exceeds',&
2200                 F6.3, ' m**2/s**2')
2201474 FORMAT ('    Random number generator used    : ',A/)
2202475 FORMAT ('    The surface temperature is increased (or decreased, ', &
2203                 'respectively, if'/ &
2204            '    the value is negative) by ',F5.2,' K at the beginning of the',&
2205                 ' 3D-simulation'/)
2206476 FORMAT ('    The surface humidity is increased (or decreased, ',&
2207                 'respectively, if the'/ &
2208            '    value is negative) by ',E8.1,' kg/kg at the beginning of', &
2209                 ' the 3D-simulation'/)
2210477 FORMAT ('    The scalar value is increased at the surface (or decreased, ',&
2211                 'respectively, if the'/ &
2212            '    value is negative) by ',E8.1,' kg/m**3 at the beginning of', &
2213                 ' the 3D-simulation'/)
2214480 FORMAT ('    Particles:'/ &
2215            '    ---------'// &
2216            '       Particle advection is active (switched on at t = ', F7.1, &
2217                    ' s)'/ &
2218            '       Start of new particle generations every  ',F6.1,' s'/ &
2219            '       Boundary conditions: left/right: ', A, ' north/south: ', A/&
2220            '                            bottom:     ', A, ' top:         ', A/&
2221            '       Maximum particle age:                 ',F9.1,' s'/ &
2222            '       Advection stopped at t = ',F9.1,' s'/)
2223481 FORMAT ('       Particles have random start positions'/)
2224482 FORMAT ('          Particles are advected only horizontally'/)
2225485 FORMAT ('       Particle data are written on file every ', F9.1, ' s')
2226486 FORMAT ('       Particle statistics are written on file'/)
2227487 FORMAT ('       Number of particle groups: ',I2/)
2228488 FORMAT ('       SGS velocity components are used for particle advection'/ &
2229            '          minimum timestep for advection:', F8.5/)
2230489 FORMAT ('       Number of particles simultaneously released at each ', &
2231                    'point: ', I5/)
2232490 FORMAT ('       Particle group ',I2,':'/ &
2233            '          Particle radius: ',E10.3, 'm')
2234491 FORMAT ('          Particle inertia is activated'/ &
2235            '             density_ratio (rho_fluid/rho_particle) =',F6.3/)
2236492 FORMAT ('          Particles are advected only passively (no inertia)'/)
2237493 FORMAT ('          Boundaries of particle source: x:',F8.1,' - ',F8.1,' m'/&
2238            '                                         y:',F8.1,' - ',F8.1,' m'/&
2239            '                                         z:',F8.1,' - ',F8.1,' m'/&
2240            '          Particle distances:  dx = ',F8.1,' m  dy = ',F8.1, &
2241                       ' m  dz = ',F8.1,' m'/)
2242494 FORMAT ('       Output of particle time series in NetCDF format every ', &
2243                    F8.2,' s'/)
2244495 FORMAT ('       Number of particles in total domain: ',I10/)
2245496 FORMAT ('       Initial vertical particle positions are interpreted ', &
2246                    'as relative to the given topography')
2247500 FORMAT (//' 1D-Model parameters:'/                           &
2248              ' -------------------'//                           &
2249            '    Simulation time:                   ',F8.1,' s'/ &
2250            '    Run-controll output every:         ',F8.1,' s'/ &
2251            '    Vertical profile output every:     ',F8.1,' s'/ &
2252            '    Mixing length calculation:         ',A/         &
2253            '    Dissipation calculation:           ',A/)
2254502 FORMAT ('    Damping layer starts from ',F7.1,' m (GP ',I4,')'/)
2255503 FORMAT (' --> Momentum advection via Wicker-Skamarock-Scheme 5th order')
2256504 FORMAT (' --> Scalar advection via Wicker-Skamarock-Scheme 5th order')
2257505 FORMAT ('    Precipitation parameterization via Seifert-Beheng-Scheme')
2258506 FORMAT ('    Cloud water sedimentation parameterization via Stokes law')
2259507 FORMAT ('    Turbulence effects on precipitation process')
2260508 FORMAT ('    Ventilation effects on evaporation of rain drops')
2261509 FORMAT ('    Slope limiter used for sedimentation process')
2262510 FORMAT ('    Droplet density    :   N_c   = ',F6.1,' 1/cm**3')
2263511 FORMAT ('    Sedimentation Courant number:                  '/&
2264            '                               C_s   =',F4.1,'        ')
2265512 FORMAT (/' Date:                 ',A8,6X,'Run:       ',A20/      &
2266            ' Time:                 ',A8,6X,'Run-No.:   ',I2.2/     &
2267            ' Run on host:        ',A10,6X,'En-No.:    ',I2.2)
2268513 FORMAT (' --> Scalar advection via Wicker-Skamarock-Scheme 5th order ' // & 
2269            '+ monotonic adjustment')
2270600 FORMAT (/' Nesting informations:'/ &
2271            ' --------------------'/ &
2272            ' Nesting mode:                     ',A/ &
2273            ' Nesting-datatransfer mode:        ',A// &
2274            ' Nest id  parent  number   lower left coordinates   name'/ &
2275            ' (*=me)     id    of PEs      x (m)     y (m)' )
2276601 FORMAT (2X,A1,1X,I2.2,6X,I2.2,5X,I5,5X,F8.2,2X,F8.2,5X,A)
2277
2278 END SUBROUTINE header
Note: See TracBrowser for help on using the repository browser.