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

Last change on this file since 1805 was 1798, checked in by raasch, 8 years ago

last commit documented

  • Property svn:keywords set to Id
File size: 96.2 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-2015 Leibniz Universitaet Hannover
17!--------------------------------------------------------------------------------!
18!
19! Current revisions:
20! -----------------
21!
22!
23! Former revisions:
24! -----------------
25! $Id: header.f90 1798 2016-03-21 16:59:17Z maronga $
26!
27! 1797 2016-03-21 16:50:28Z raasch
28! output of nesting datatransfer mode
29!
30! 1791 2016-03-11 10:41:25Z raasch
31! output of nesting informations of all domains
32!
33! 1788 2016-03-10 11:01:04Z maronga
34! Parameter dewfall removed
35!
36! 1786 2016-03-08 05:49:27Z raasch
37! cpp-direktives for spectra removed
38!
39! 1783 2016-03-06 18:36:17Z raasch
40! netcdf module and variable names changed, output of netcdf_deflate
41!
42! 1764 2016-02-28 12:45:19Z raasch
43! output of nesting informations
44!
45! 1697 2015-10-28 17:14:10Z raasch
46! small E- and F-FORMAT changes to avoid informative compiler messages about
47! insufficient field width
48!
49! 1691 2015-10-26 16:17:44Z maronga
50! Renamed prandtl_layer to constant_flux_layer, renames rif_min/rif_max to
51! zeta_min/zeta_max.
52!
53! 1682 2015-10-07 23:56:08Z knoop
54! Code annotations made doxygen readable
55!
56! 1675 2015-10-02 08:28:59Z gronemeier
57! Bugfix: Definition of topography grid levels
58!
59! 1660 2015-09-21 08:15:16Z gronemeier
60! Bugfix: Definition of building/street canyon height if vertical grid stretching
61!         starts below the maximum topography height.
62!
63! 1590 2015-05-08 13:56:27Z maronga
64! Bugfix: Added TRIM statements for character strings for LSM and radiation code
65!
66! 1585 2015-04-30 07:05:52Z maronga
67! Further output for radiation model(s).
68!
69! 1575 2015-03-27 09:56:27Z raasch
70! adjustments for psolver-queries, output of seed_follows_topography
71!
72! 1560 2015-03-06 10:48:54Z keck
73! output for recycling y shift
74!
75! 1557 2015-03-05 16:43:04Z suehring
76! output for monotonic limiter
77!
78! 1551 2015-03-03 14:18:16Z maronga
79! Added informal output for land surface model and radiation model. Removed typo.
80!
81! 1496 2014-12-02 17:25:50Z maronga
82! Renamed: "radiation -> "cloud_top_radiation"
83!
84! 1484 2014-10-21 10:53:05Z kanani
85! Changes due to new module structure of the plant canopy model:
86!   module plant_canopy_model_mod and output for new canopy model parameters
87!   (alpha_lad, beta_lad, lai_beta,...) added,
88!   drag_coefficient, leaf_surface_concentration and scalar_exchange_coefficient
89!   renamed to canopy_drag_coeff, leaf_surface_conc and leaf_scalar_exch_coeff,
90!   learde renamed leaf_area_density.
91! Bugfix: DO-WHILE-loop for lad header information additionally restricted
92! by maximum number of gradient levels (currently 10)
93!
94! 1482 2014-10-18 12:34:45Z raasch
95! information about calculated or predefined virtual processor topology adjusted
96!
97! 1468 2014-09-24 14:06:57Z maronga
98! Adapted for use on up to 6-digit processor cores
99!
100! 1429 2014-07-15 12:53:45Z knoop
101! header exended to provide ensemble_member_nr if specified
102!
103! 1376 2014-04-26 11:21:22Z boeske
104! Correction of typos
105!
106! 1365 2014-04-22 15:03:56Z boeske
107! New section 'Large scale forcing and nudging':
108! output of large scale forcing and nudging information,
109! new section for initial profiles created
110!
111! 1359 2014-04-11 17:15:14Z hoffmann
112! dt_sort_particles removed
113!
114! 1353 2014-04-08 15:21:23Z heinze
115! REAL constants provided with KIND-attribute
116!
117! 1327 2014-03-21 11:00:16Z raasch
118! parts concerning iso2d and avs output removed,
119! -netcdf output queries
120!
121! 1324 2014-03-21 09:13:16Z suehring
122! Bugfix: module spectrum added
123!
124! 1322 2014-03-20 16:38:49Z raasch
125! REAL functions provided with KIND-attribute,
126! some REAL constants defined as wp-kind
127!
128! 1320 2014-03-20 08:40:49Z raasch
129! ONLY-attribute added to USE-statements,
130! kind-parameters added to all INTEGER and REAL declaration statements,
131! kinds are defined in new module kinds,
132! revision history before 2012 removed,
133! comment fields (!:) to be used for variable explanations added to
134! all variable declaration statements
135!
136! 1308 2014-03-13 14:58:42Z fricke
137! output of the fixed number of output time levels
138! output_format adjusted for masked data if netcdf_data_format > 5
139!
140! 1299 2014-03-06 13:15:21Z heinze
141! output for using large_scale subsidence in combination
142! with large_scale_forcing
143! reformatting, more detailed explanations
144!
145! 1241 2013-10-30 11:36:58Z heinze
146! output for nudging + large scale forcing from external file
147!
148! 1216 2013-08-26 09:31:42Z raasch
149! output for transpose_compute_overlap
150!
151! 1212 2013-08-15 08:46:27Z raasch
152! output for poisfft_hybrid removed
153!
154! 1179 2013-06-14 05:57:58Z raasch
155! output of reference_state, use_reference renamed use_single_reference_value
156!
157! 1159 2013-05-21 11:58:22Z fricke
158! +use_cmax
159!
160! 1115 2013-03-26 18:16:16Z hoffmann
161! descriptions for Seifert-Beheng-cloud-physics-scheme added
162!
163! 1111 2013-03-08 23:54:10Z raasch
164! output of accelerator board information
165! ibc_p_b = 2 removed
166!
167! 1108 2013-03-05 07:03:32Z raasch
168! bugfix for r1106
169!
170! 1106 2013-03-04 05:31:38Z raasch
171! some format changes for coupled runs
172!
173! 1092 2013-02-02 11:24:22Z raasch
174! unused variables removed
175!
176! 1036 2012-10-22 13:43:42Z raasch
177! code put under GPL (PALM 3.9)
178!
179! 1031 2012-10-19 14:35:30Z raasch
180! output of netCDF data format modified
181!
182! 1015 2012-09-27 09:23:24Z raasch
183! output of Adjustment of mixing length to the Prandtl mixing length at first
184! grid point above ground removed
185!
186! 1003 2012-09-14 14:35:53Z raasch
187! output of information about equal/unequal subdomain size removed
188!
189! 1001 2012-09-13 14:08:46Z raasch
190! all actions concerning leapfrog- and upstream-spline-scheme removed
191!
192! 978 2012-08-09 08:28:32Z fricke
193! -km_damp_max, outflow_damping_width
194! +pt_damping_factor, pt_damping_width
195! +z0h
196!
197! 964 2012-07-26 09:14:24Z raasch
198! output of profil-related quantities removed
199!
200! 940 2012-07-09 14:31:00Z raasch
201! Output in case of simulations for pure neutral stratification (no pt-equation
202! solved)
203!
204! 927 2012-06-06 19:15:04Z raasch
205! output of masking_method for mg-solver
206!
207! 868 2012-03-28 12:21:07Z raasch
208! translation velocity in Galilean transformation changed to 0.6 * ug
209!
210! 833 2012-02-22 08:55:55Z maronga
211! Adjusted format for leaf area density
212!
213! 828 2012-02-21 12:00:36Z raasch
214! output of dissipation_classes + radius_classes
215!
216! 825 2012-02-19 03:03:44Z raasch
217! Output of cloud physics parameters/quantities complemented and restructured
218!
219! Revision 1.1  1997/08/11 06:17:20  raasch
220! Initial revision
221!
222!
223! Description:
224! ------------
225!> Writing a header with all important information about the current run.
226!> This subroutine is called three times, two times at the beginning
227!> (writing information on files RUN_CONTROL and HEADER) and one time at the
228!> end of the run, then writing additional information about CPU-usage on file
229!> header.
230!-----------------------------------------------------------------------------!
231 SUBROUTINE header
232 
233
234    USE arrays_3d,                                                             &
235        ONLY:  pt_init, qsws, q_init, sa_init, shf, ug, vg, w_subs, zu, zw
236       
237    USE control_parameters
238       
239    USE cloud_parameters,                                                      &
240        ONLY:  cp, curvature_solution_effects, c_sedimentation,                &
241               limiter_sedimentation, l_v, nc_const, r_d, ventilation_effect
242       
243    USE cpulog,                                                                &
244        ONLY:  log_point_s
245       
246    USE dvrp_variables,                                                        &
247        ONLY:  use_seperate_pe_for_dvrp_output
248       
249    USE grid_variables,                                                        &
250        ONLY:  dx, dy
251       
252    USE indices,                                                               &
253        ONLY:  mg_loc_ind, nnx, nny, nnz, nx, ny, nxl_mg, nxr_mg, nyn_mg,      &
254               nys_mg, nzt, nzt_mg
255       
256    USE kinds
257   
258    USE land_surface_model_mod,                                                &
259        ONLY:  conserve_water_content, land_surface, nzb_soil,                 &
260               nzt_soil, root_fraction, soil_moisture, soil_temperature,       &
261               soil_type, soil_type_name, veg_type, veg_type_name, zs
262 
263    USE model_1d,                                                              &
264        ONLY:  damp_level_ind_1d, dt_pr_1d, dt_run_control_1d, end_time_1d
265       
266    USE netcdf_interface,                                                      &
267        ONLY:  netcdf_data_format, netcdf_data_format_string, netcdf_deflate
268
269    USE particle_attributes,                                                   &
270        ONLY:  bc_par_b, bc_par_lr, bc_par_ns, bc_par_t, collision_kernel,     &
271               density_ratio, dissipation_classes, dt_min_part, dt_prel,       &
272               dt_write_particle_data, end_time_prel,                          &
273               maximum_number_of_tailpoints, maximum_tailpoint_age,            &
274               minimum_tailpoint_distance, number_of_particle_groups,          &
275               particle_advection, particle_advection_start,                   &
276               particles_per_point, pdx, pdy, pdz,  psb, psl, psn, psr, pss,   &
277               pst, radius, radius_classes, random_start_position,             &
278               seed_follows_topography,                                        &
279               total_number_of_particles, use_particle_tails,                  &
280               use_sgs_for_particles, total_number_of_tails,                   &
281               vertical_particle_advection, write_particle_statistics
282       
283    USE pegrid
284
285    USE plant_canopy_model_mod,                                                &
286        ONLY:  alpha_lad, beta_lad, calc_beta_lad_profile, canopy_drag_coeff,  &
287               canopy_mode, cthf, lad, lad_surface, lad_vertical_gradient,     &
288               lad_vertical_gradient_level, lad_vertical_gradient_level_ind,   &
289               lai_beta, leaf_scalar_exch_coeff, leaf_surface_conc, pch_index, &
290               plant_canopy
291
292    USE pmc_handle_communicator,                                               &
293        ONLY:  pmc_get_model_info
294
295    USE pmc_interface,                                                         &
296        ONLY:  nested_run, nesting_datatransfer_mode, nesting_mode
297
298    USE radiation_model_mod,                                                   &
299        ONLY:  albedo, albedo_type, albedo_type_name, constant_albedo,         &
300               day_init, dt_radiation, lambda, lw_radiation, net_radiation,    &
301               radiation, radiation_scheme, sw_radiation, time_utc_init
302   
303    USE spectrum,                                                              &
304        ONLY:  comp_spectra_level, data_output_sp, plot_spectra_level,         &
305               spectra_direction
306
307    IMPLICIT NONE
308
309    CHARACTER (LEN=1)  ::  prec                !<
310   
311    CHARACTER (LEN=2)  ::  do2d_mode           !<
312   
313    CHARACTER (LEN=5)  ::  section_chr         !<
314   
315    CHARACTER (LEN=10) ::  coor_chr            !<
316    CHARACTER (LEN=10) ::  host_chr            !<
317   
318    CHARACTER (LEN=16) ::  begin_chr           !<
319   
320    CHARACTER (LEN=26) ::  ver_rev             !<
321
322    CHARACTER (LEN=32) ::  cpl_name            !<
323   
324    CHARACTER (LEN=40) ::  output_format       !<
325   
326    CHARACTER (LEN=70) ::  char1               !<
327    CHARACTER (LEN=70) ::  char2               !<
328    CHARACTER (LEN=70) ::  dopr_chr            !<
329    CHARACTER (LEN=70) ::  do2d_xy             !<
330    CHARACTER (LEN=70) ::  do2d_xz             !<
331    CHARACTER (LEN=70) ::  do2d_yz             !<
332    CHARACTER (LEN=70) ::  do3d_chr            !<
333    CHARACTER (LEN=70) ::  domask_chr          !<
334    CHARACTER (LEN=70) ::  run_classification  !<
335   
336    CHARACTER (LEN=85) ::  roben               !<
337    CHARACTER (LEN=85) ::  runten              !<
338   
339    CHARACTER (LEN=86) ::  coordinates         !<
340    CHARACTER (LEN=86) ::  gradients           !<
341    CHARACTER (LEN=86) ::  leaf_area_density   !<
342    CHARACTER (LEN=86) ::  roots               !<
343    CHARACTER (LEN=86) ::  slices              !<
344    CHARACTER (LEN=86) ::  temperatures        !<
345    CHARACTER (LEN=86) ::  ugcomponent         !<
346    CHARACTER (LEN=86) ::  vgcomponent         !<
347
348    CHARACTER (LEN=1), DIMENSION(1:3) ::  dir = (/ 'x', 'y', 'z' /)  !<
349
350    INTEGER(iwp) ::  av             !<
351    INTEGER(iwp) ::  bh             !<
352    INTEGER(iwp) ::  blx            !<
353    INTEGER(iwp) ::  bly            !<
354    INTEGER(iwp) ::  bxl            !<
355    INTEGER(iwp) ::  bxr            !<
356    INTEGER(iwp) ::  byn            !<
357    INTEGER(iwp) ::  bys            !<
358    INTEGER(iwp) ::  ch             !<
359    INTEGER(iwp) ::  count          !<
360    INTEGER(iwp) ::  cpl_parent_id  !<
361    INTEGER(iwp) ::  cwx            !<
362    INTEGER(iwp) ::  cwy            !<
363    INTEGER(iwp) ::  cxl            !<
364    INTEGER(iwp) ::  cxr            !<
365    INTEGER(iwp) ::  cyn            !<
366    INTEGER(iwp) ::  cys            !<
367    INTEGER(iwp) ::  dim            !<
368    INTEGER(iwp) ::  i              !<
369    INTEGER(iwp) ::  io             !<
370    INTEGER(iwp) ::  j              !<
371    INTEGER(iwp) ::  k              !<
372    INTEGER(iwp) ::  l              !<
373    INTEGER(iwp) ::  ll             !<
374    INTEGER(iwp) ::  mpi_type       !<
375    INTEGER(iwp) ::  my_cpl_id      !<
376    INTEGER(iwp) ::  n              !<
377    INTEGER(iwp) ::  ncpl           !<
378    INTEGER(iwp) ::  npe_total      !<
379   
380    REAL(wp) ::  canopy_height                    !< canopy height (in m)
381    REAL(wp) ::  cpuseconds_per_simulated_second  !<
382    REAL(wp) ::  lower_left_coord_x               !< x-coordinate of nest domain
383    REAL(wp) ::  lower_left_coord_y               !< y-coordinate of nest domain
384
385!
386!-- Open the output file. At the end of the simulation, output is directed
387!-- to unit 19.
388    IF ( ( runnr == 0 .OR. force_print_header )  .AND. &
389         .NOT. simulated_time_at_begin /= simulated_time )  THEN
390       io = 15   !  header output on file RUN_CONTROL
391    ELSE
392       io = 19   !  header output on file HEADER
393    ENDIF
394    CALL check_open( io )
395
396!
397!-- At the end of the run, output file (HEADER) will be rewritten with
398!-- new information
399    IF ( io == 19 .AND. simulated_time_at_begin /= simulated_time ) REWIND( 19 )
400
401!
402!-- Determine kind of model run
403    IF ( TRIM( initializing_actions ) == 'read_restart_data' )  THEN
404       run_classification = 'restart run'
405    ELSEIF ( TRIM( initializing_actions ) == 'cyclic_fill' )  THEN
406       run_classification = 'run with cyclic fill of 3D - prerun data'
407    ELSEIF ( INDEX( initializing_actions, 'set_constant_profiles' ) /= 0 )  THEN
408       run_classification = 'run without 1D - prerun'
409    ELSEIF ( INDEX( initializing_actions, 'set_1d-model_profiles' ) /= 0 )  THEN
410       run_classification = 'run with 1D - prerun'
411    ELSEIF ( INDEX( initializing_actions, 'by_user' ) /=0 )  THEN
412       run_classification = 'run initialized by user'
413    ELSE
414       message_string = ' unknown action(s): ' // TRIM( initializing_actions )
415       CALL message( 'header', 'PA0191', 0, 0, 0, 6, 0 )
416    ENDIF
417    IF ( nested_run )  run_classification = 'nested ' // run_classification
418    IF ( ocean )  THEN
419       run_classification = 'ocean - ' // run_classification
420    ELSE
421       run_classification = 'atmosphere - ' // run_classification
422    ENDIF
423
424!
425!-- Run-identification, date, time, host
426    host_chr = host(1:10)
427    ver_rev = TRIM( version ) // '  ' // TRIM( revision )
428    WRITE ( io, 100 )  ver_rev, TRIM( run_classification )
429    IF ( TRIM( coupling_mode ) /= 'uncoupled' )  THEN
430#if defined( __mpi2 )
431       mpi_type = 2
432#else
433       mpi_type = 1
434#endif
435       WRITE ( io, 101 )  mpi_type, coupling_mode
436    ENDIF
437#if defined( __parallel )
438    IF ( coupling_start_time /= 0.0_wp )  THEN
439       IF ( coupling_start_time > simulated_time_at_begin )  THEN
440          WRITE ( io, 109 )
441       ELSE
442          WRITE ( io, 114 )
443       ENDIF
444    ENDIF
445#endif
446    IF ( ensemble_member_nr /= 0 )  THEN
447       WRITE ( io, 512 )  run_date, run_identifier, run_time, runnr,           &
448                       ADJUSTR( host_chr ), ensemble_member_nr
449    ELSE
450       WRITE ( io, 102 )  run_date, run_identifier, run_time, runnr,           &
451                       ADJUSTR( host_chr )
452    ENDIF
453#if defined( __parallel )
454    IF ( npex == -1  .AND.  npey == -1 )  THEN
455       char1 = 'calculated'
456    ELSE
457       char1 = 'predefined'
458    ENDIF
459    IF ( threads_per_task == 1 )  THEN
460       WRITE ( io, 103 )  numprocs, pdims(1), pdims(2), TRIM( char1 )
461    ELSE
462       WRITE ( io, 104 )  numprocs*threads_per_task, numprocs, &
463                          threads_per_task, pdims(1), pdims(2), TRIM( char1 )
464    ENDIF
465    IF ( num_acc_per_node /= 0 )  WRITE ( io, 117 )  num_acc_per_node   
466    IF ( ( host(1:3) == 'ibm'  .OR.  host(1:3) == 'nec'  .OR.    &
467           host(1:2) == 'lc'   .OR.  host(1:3) == 'dec' )  .AND. &
468         npex == -1  .AND.  pdims(2) == 1 )                      &
469    THEN
470       WRITE ( io, 106 )
471    ELSEIF ( pdims(2) == 1 )  THEN
472       WRITE ( io, 107 )  'x'
473    ELSEIF ( pdims(1) == 1 )  THEN
474       WRITE ( io, 107 )  'y'
475    ENDIF
476    IF ( use_seperate_pe_for_dvrp_output )  WRITE ( io, 105 )
477    IF ( numprocs /= maximum_parallel_io_streams )  THEN
478       WRITE ( io, 108 )  maximum_parallel_io_streams
479    ENDIF
480#else
481    IF ( num_acc_per_node /= 0 )  WRITE ( io, 120 )  num_acc_per_node
482#endif
483
484!
485!-- Nesting informations
486    IF ( nested_run )  THEN
487
488       WRITE ( io, 600 )  TRIM( nesting_mode ),                                &
489                          TRIM( nesting_datatransfer_mode )
490       CALL pmc_get_model_info( ncpl = ncpl, cpl_id = my_cpl_id )
491
492       DO  n = 1, ncpl
493          CALL pmc_get_model_info( request_for_cpl_id = n, cpl_name = cpl_name,&
494                                   cpl_parent_id = cpl_parent_id,              &
495                                   lower_left_x = lower_left_coord_x,          &
496                                   lower_left_y = lower_left_coord_y,          &
497                                   npe_total = npe_total )
498          IF ( n == my_cpl_id )  THEN
499             char1 = '*'
500          ELSE
501             char1 = ' '
502          ENDIF
503          WRITE ( io, 601 )  TRIM( char1 ), n, cpl_parent_id, npe_total,       &
504                             lower_left_coord_x, lower_left_coord_y,           &
505                             TRIM( cpl_name )
506       ENDDO
507    ENDIF
508    WRITE ( io, 99 )
509
510!
511!-- Numerical schemes
512    WRITE ( io, 110 )
513    IF ( psolver(1:7) == 'poisfft' )  THEN
514       WRITE ( io, 111 )  TRIM( fft_method )
515       IF ( transpose_compute_overlap )  WRITE( io, 115 )
516    ELSEIF ( psolver == 'sor' )  THEN
517       WRITE ( io, 112 )  nsor_ini, nsor, omega_sor
518    ELSEIF ( psolver(1:9) == 'multigrid' )  THEN
519       WRITE ( io, 135 )  TRIM(psolver), cycle_mg, maximum_grid_level, ngsrb
520       IF ( mg_cycles == -1 )  THEN
521          WRITE ( io, 140 )  residual_limit
522       ELSE
523          WRITE ( io, 141 )  mg_cycles
524       ENDIF
525       IF ( mg_switch_to_pe0_level == 0 )  THEN
526          WRITE ( io, 136 )  nxr_mg(1)-nxl_mg(1)+1, nyn_mg(1)-nys_mg(1)+1, &
527                             nzt_mg(1)
528       ELSEIF (  mg_switch_to_pe0_level /= -1 )  THEN
529          WRITE ( io, 137 )  mg_switch_to_pe0_level,            &
530                             mg_loc_ind(2,0)-mg_loc_ind(1,0)+1, &
531                             mg_loc_ind(4,0)-mg_loc_ind(3,0)+1, &
532                             nzt_mg(mg_switch_to_pe0_level),    &
533                             nxr_mg(1)-nxl_mg(1)+1, nyn_mg(1)-nys_mg(1)+1, &
534                             nzt_mg(1)
535       ENDIF
536       IF ( masking_method )  WRITE ( io, 144 )
537    ENDIF
538    IF ( call_psolver_at_all_substeps  .AND. timestep_scheme(1:5) == 'runge' ) &
539    THEN
540       WRITE ( io, 142 )
541    ENDIF
542
543    IF ( momentum_advec == 'pw-scheme' )  THEN
544       WRITE ( io, 113 )
545    ELSEIF (momentum_advec == 'ws-scheme' )  THEN
546       WRITE ( io, 503 )
547    ENDIF
548    IF ( scalar_advec == 'pw-scheme' )  THEN
549       WRITE ( io, 116 )
550    ELSEIF ( scalar_advec == 'ws-scheme' )  THEN
551       WRITE ( io, 504 )
552    ELSEIF ( scalar_advec == 'ws-scheme-mono' )  THEN
553       WRITE ( io, 513 )
554    ELSE
555       WRITE ( io, 118 )
556    ENDIF
557
558    WRITE ( io, 139 )  TRIM( loop_optimization )
559
560    IF ( galilei_transformation )  THEN
561       IF ( use_ug_for_galilei_tr )  THEN
562          char1 = '0.6 * geostrophic wind'
563       ELSE
564          char1 = 'mean wind in model domain'
565       ENDIF
566       IF ( simulated_time_at_begin == simulated_time )  THEN
567          char2 = 'at the start of the run'
568       ELSE
569          char2 = 'at the end of the run'
570       ENDIF
571       WRITE ( io, 119 )  TRIM( char1 ), TRIM( char2 ),                        &
572                          advected_distance_x/1000.0_wp,                       &
573                          advected_distance_y/1000.0_wp
574    ENDIF
575    WRITE ( io, 122 )  timestep_scheme
576    IF ( use_upstream_for_tke )  WRITE ( io, 143 )
577    IF ( rayleigh_damping_factor /= 0.0_wp )  THEN
578       IF ( .NOT. ocean )  THEN
579          WRITE ( io, 123 )  'above', rayleigh_damping_height, &
580               rayleigh_damping_factor
581       ELSE
582          WRITE ( io, 123 )  'below', rayleigh_damping_height, &
583               rayleigh_damping_factor
584       ENDIF
585    ENDIF
586    IF ( neutral )  WRITE ( io, 131 )  pt_surface
587    IF ( humidity )  THEN
588       IF ( .NOT. cloud_physics )  THEN
589          WRITE ( io, 129 )
590       ELSE
591          WRITE ( io, 130 )
592       ENDIF
593    ENDIF
594    IF ( passive_scalar )  WRITE ( io, 134 )
595    IF ( conserve_volume_flow )  THEN
596       WRITE ( io, 150 )  conserve_volume_flow_mode
597       IF ( TRIM( conserve_volume_flow_mode ) == 'bulk_velocity' )  THEN
598          WRITE ( io, 151 )  u_bulk, v_bulk
599       ENDIF
600    ELSEIF ( dp_external )  THEN
601       IF ( dp_smooth )  THEN
602          WRITE ( io, 152 )  dpdxy, dp_level_b, ', vertically smoothed.'
603       ELSE
604          WRITE ( io, 152 )  dpdxy, dp_level_b, '.'
605       ENDIF
606    ENDIF
607    WRITE ( io, 99 )
608
609!
610!-- Runtime and timestep information
611    WRITE ( io, 200 )
612    IF ( .NOT. dt_fixed )  THEN
613       WRITE ( io, 201 )  dt_max, cfl_factor
614    ELSE
615       WRITE ( io, 202 )  dt
616    ENDIF
617    WRITE ( io, 203 )  simulated_time_at_begin, end_time
618
619    IF ( time_restart /= 9999999.9_wp  .AND. &
620         simulated_time_at_begin == simulated_time )  THEN
621       IF ( dt_restart == 9999999.9_wp )  THEN
622          WRITE ( io, 204 )  ' Restart at:       ',time_restart
623       ELSE
624          WRITE ( io, 205 )  ' Restart at:       ',time_restart, dt_restart
625       ENDIF
626    ENDIF
627
628    IF ( simulated_time_at_begin /= simulated_time )  THEN
629       i = MAX ( log_point_s(10)%counts, 1 )
630       IF ( ( simulated_time - simulated_time_at_begin ) == 0.0_wp )  THEN
631          cpuseconds_per_simulated_second = 0.0_wp
632       ELSE
633          cpuseconds_per_simulated_second = log_point_s(10)%sum / &
634                                            ( simulated_time -    &
635                                              simulated_time_at_begin )
636       ENDIF
637       WRITE ( io, 206 )  simulated_time, log_point_s(10)%sum,      &
638                          log_point_s(10)%sum / REAL( i, KIND=wp ), &
639                          cpuseconds_per_simulated_second
640       IF ( time_restart /= 9999999.9_wp  .AND.  time_restart < end_time )  THEN
641          IF ( dt_restart == 9999999.9_wp )  THEN
642             WRITE ( io, 204 )  ' Next restart at:     ',time_restart
643          ELSE
644             WRITE ( io, 205 )  ' Next restart at:     ',time_restart, dt_restart
645          ENDIF
646       ENDIF
647    ENDIF
648
649
650!
651!-- Start time for coupled runs, if independent precursor runs for atmosphere
652!-- and ocean are used or have been used. In this case, coupling_start_time
653!-- defines the time when the coupling is switched on.
654    IF ( coupling_start_time /= 0.0_wp )  THEN
655       WRITE ( io, 207 )  coupling_start_time
656    ENDIF
657
658!
659!-- Computational grid
660    IF ( .NOT. ocean )  THEN
661       WRITE ( io, 250 )  dx, dy, dz, (nx+1)*dx, (ny+1)*dy, zu(nzt+1)
662       IF ( dz_stretch_level_index < nzt+1 )  THEN
663          WRITE ( io, 252 )  dz_stretch_level, dz_stretch_level_index, &
664                             dz_stretch_factor, dz_max
665       ENDIF
666    ELSE
667       WRITE ( io, 250 )  dx, dy, dz, (nx+1)*dx, (ny+1)*dy, zu(0)
668       IF ( dz_stretch_level_index > 0 )  THEN
669          WRITE ( io, 252 )  dz_stretch_level, dz_stretch_level_index, &
670                             dz_stretch_factor, dz_max
671       ENDIF
672    ENDIF
673    WRITE ( io, 254 )  nx, ny, nzt+1, MIN( nnx, nx+1 ), MIN( nny, ny+1 ), &
674                       MIN( nnz+2, nzt+2 )
675    IF ( sloping_surface )  WRITE ( io, 260 )  alpha_surface
676
677!
678!-- Large scale forcing and nudging
679    WRITE ( io, 160 )
680    IF ( large_scale_forcing )  THEN
681       WRITE ( io, 162 )
682       WRITE ( io, 163 )
683
684       IF ( large_scale_subsidence )  THEN
685          IF ( .NOT. use_subsidence_tendencies )  THEN
686             WRITE ( io, 164 )
687          ELSE
688             WRITE ( io, 165 )
689          ENDIF
690       ENDIF
691
692       IF ( bc_pt_b == 'dirichlet' )  THEN
693          WRITE ( io, 180 )
694       ELSEIF ( bc_pt_b == 'neumann' )  THEN
695          WRITE ( io, 181 )
696       ENDIF
697
698       IF ( bc_q_b == 'dirichlet' )  THEN
699          WRITE ( io, 182 )
700       ELSEIF ( bc_q_b == 'neumann' )  THEN
701          WRITE ( io, 183 )
702       ENDIF
703
704       WRITE ( io, 167 )
705       IF ( nudging )  THEN
706          WRITE ( io, 170 )
707       ENDIF
708    ELSE
709       WRITE ( io, 161 )
710       WRITE ( io, 171 )
711    ENDIF
712    IF ( large_scale_subsidence )  THEN
713       WRITE ( io, 168 )
714       WRITE ( io, 169 )
715    ENDIF
716
717!
718!-- Profile for the large scale vertial velocity
719!-- Building output strings, starting with surface value
720    IF ( large_scale_subsidence )  THEN
721       temperatures = '   0.0'
722       gradients = '------'
723       slices = '     0'
724       coordinates = '   0.0'
725       i = 1
726       DO  WHILE ( subs_vertical_gradient_level_i(i) /= -9999 )
727
728          WRITE (coor_chr,'(E10.2,7X)')  &
729                                w_subs(subs_vertical_gradient_level_i(i))
730          temperatures = TRIM( temperatures ) // ' ' // TRIM( coor_chr )
731
732          WRITE (coor_chr,'(E10.2,7X)')  subs_vertical_gradient(i)
733          gradients = TRIM( gradients ) // ' ' // TRIM( coor_chr )
734
735          WRITE (coor_chr,'(I10,7X)')  subs_vertical_gradient_level_i(i)
736          slices = TRIM( slices ) // ' ' // TRIM( coor_chr )
737
738          WRITE (coor_chr,'(F10.2,7X)')  subs_vertical_gradient_level(i)
739          coordinates = TRIM( coordinates ) // ' '  // TRIM( coor_chr )
740
741          IF ( i == 10 )  THEN
742             EXIT
743          ELSE
744             i = i + 1
745          ENDIF
746
747       ENDDO
748
749 
750       IF ( .NOT. large_scale_forcing )  THEN
751          WRITE ( io, 426 )  TRIM( coordinates ), TRIM( temperatures ), &
752                             TRIM( gradients ), TRIM( slices )
753       ENDIF
754
755
756    ENDIF
757
758!-- Profile of the geostrophic wind (component ug)
759!-- Building output strings
760    WRITE ( ugcomponent, '(F6.2)' )  ug_surface
761    gradients = '------'
762    slices = '     0'
763    coordinates = '   0.0'
764    i = 1
765    DO  WHILE ( ug_vertical_gradient_level_ind(i) /= -9999 )
766     
767       WRITE (coor_chr,'(F6.2,1X)')  ug(ug_vertical_gradient_level_ind(i))
768       ugcomponent = TRIM( ugcomponent ) // '  ' // TRIM( coor_chr )
769
770       WRITE (coor_chr,'(F6.2,1X)')  ug_vertical_gradient(i)
771       gradients = TRIM( gradients ) // '  ' // TRIM( coor_chr )
772
773       WRITE (coor_chr,'(I6,1X)')  ug_vertical_gradient_level_ind(i)
774       slices = TRIM( slices ) // '  ' // TRIM( coor_chr )
775
776       WRITE (coor_chr,'(F6.1,1X)')  ug_vertical_gradient_level(i)
777       coordinates = TRIM( coordinates ) // '  ' // TRIM( coor_chr )
778
779       IF ( i == 10 )  THEN
780          EXIT
781       ELSE
782          i = i + 1
783       ENDIF
784
785    ENDDO
786
787    IF ( .NOT. large_scale_forcing )  THEN
788       WRITE ( io, 423 )  TRIM( coordinates ), TRIM( ugcomponent ), &
789                          TRIM( gradients ), TRIM( slices )
790    ENDIF
791
792!-- Profile of the geostrophic wind (component vg)
793!-- Building output strings
794    WRITE ( vgcomponent, '(F6.2)' )  vg_surface
795    gradients = '------'
796    slices = '     0'
797    coordinates = '   0.0'
798    i = 1
799    DO  WHILE ( vg_vertical_gradient_level_ind(i) /= -9999 )
800
801       WRITE (coor_chr,'(F6.2,1X)')  vg(vg_vertical_gradient_level_ind(i))
802       vgcomponent = TRIM( vgcomponent ) // '  ' // TRIM( coor_chr )
803
804       WRITE (coor_chr,'(F6.2,1X)')  vg_vertical_gradient(i)
805       gradients = TRIM( gradients ) // '  ' // TRIM( coor_chr )
806
807       WRITE (coor_chr,'(I6,1X)')  vg_vertical_gradient_level_ind(i)
808       slices = TRIM( slices ) // '  ' // TRIM( coor_chr )
809
810       WRITE (coor_chr,'(F6.1,1X)')  vg_vertical_gradient_level(i)
811       coordinates = TRIM( coordinates ) // '  ' // TRIM( coor_chr )
812
813       IF ( i == 10 )  THEN
814          EXIT
815       ELSE
816          i = i + 1
817       ENDIF
818 
819    ENDDO
820
821    IF ( .NOT. large_scale_forcing )  THEN
822       WRITE ( io, 424 )  TRIM( coordinates ), TRIM( vgcomponent ), &
823                          TRIM( gradients ), TRIM( slices )
824    ENDIF
825
826!
827!-- Topography
828    WRITE ( io, 270 )  topography
829    SELECT CASE ( TRIM( topography ) )
830
831       CASE ( 'flat' )
832          ! no actions necessary
833
834       CASE ( 'single_building' )
835          blx = INT( building_length_x / dx )
836          bly = INT( building_length_y / dy )
837          bh  = MINLOC( ABS( zw - building_height ), 1 ) - 1
838          IF ( ABS( zw(bh  ) - building_height ) == &
839               ABS( zw(bh+1) - building_height )    )  bh = bh + 1
840
841          IF ( building_wall_left == 9999999.9_wp )  THEN
842             building_wall_left = ( nx + 1 - blx ) / 2 * dx
843          ENDIF
844          bxl = INT ( building_wall_left / dx + 0.5_wp )
845          bxr = bxl + blx
846
847          IF ( building_wall_south == 9999999.9_wp )  THEN
848             building_wall_south = ( ny + 1 - bly ) / 2 * dy
849          ENDIF
850          bys = INT ( building_wall_south / dy + 0.5_wp )
851          byn = bys + bly
852
853          WRITE ( io, 271 )  building_length_x, building_length_y, &
854                             building_height, bxl, bxr, bys, byn
855
856       CASE ( 'single_street_canyon' )
857          ch  = MINLOC( ABS( zw - canyon_height ), 1 ) - 1
858          IF ( ABS( zw(ch  ) - canyon_height ) == &
859               ABS( zw(ch+1) - canyon_height )    )  ch = ch + 1
860          IF ( canyon_width_x /= 9999999.9_wp )  THEN
861!
862!--          Street canyon in y direction
863             cwx = NINT( canyon_width_x / dx )
864             IF ( canyon_wall_left == 9999999.9_wp )  THEN
865                canyon_wall_left = ( nx + 1 - cwx ) / 2 * dx
866             ENDIF
867             cxl = NINT( canyon_wall_left / dx )
868             cxr = cxl + cwx
869             WRITE ( io, 272 )  'y', canyon_height, ch, 'u', cxl, cxr
870
871          ELSEIF ( canyon_width_y /= 9999999.9_wp )  THEN
872!
873!--          Street canyon in x direction
874             cwy = NINT( canyon_width_y / dy )
875             IF ( canyon_wall_south == 9999999.9_wp )  THEN
876                canyon_wall_south = ( ny + 1 - cwy ) / 2 * dy
877             ENDIF
878             cys = NINT( canyon_wall_south / dy )
879             cyn = cys + cwy
880             WRITE ( io, 272 )  'x', canyon_height, ch, 'v', cys, cyn
881          ENDIF
882
883    END SELECT
884
885    IF ( TRIM( topography ) /= 'flat' )  THEN
886       IF ( TRIM( topography_grid_convention ) == ' ' )  THEN
887          IF ( TRIM( topography ) == 'single_building' .OR.  &
888               TRIM( topography ) == 'single_street_canyon' )  THEN
889             WRITE ( io, 278 )
890          ELSEIF ( TRIM( topography ) == 'read_from_file' )  THEN
891             WRITE ( io, 279 )
892          ENDIF
893       ELSEIF ( TRIM( topography_grid_convention ) == 'cell_edge' )  THEN
894          WRITE ( io, 278 )
895       ELSEIF ( TRIM( topography_grid_convention ) == 'cell_center' )  THEN
896          WRITE ( io, 279 )
897       ENDIF
898    ENDIF
899
900    IF ( plant_canopy )  THEN
901   
902       canopy_height = pch_index * dz
903
904       WRITE ( io, 280 )  canopy_mode, canopy_height, pch_index,               &
905                          canopy_drag_coeff
906       IF ( passive_scalar )  THEN
907          WRITE ( io, 281 )  leaf_scalar_exch_coeff,                           &
908                             leaf_surface_conc
909       ENDIF
910
911!
912!--    Heat flux at the top of vegetation
913       WRITE ( io, 282 )  cthf
914
915!
916!--    Leaf area density profile, calculated either from given vertical
917!--    gradients or from beta probability density function.
918       IF (  .NOT.  calc_beta_lad_profile )  THEN
919
920!--       Building output strings, starting with surface value
921          WRITE ( leaf_area_density, '(F7.4)' )  lad_surface
922          gradients = '------'
923          slices = '     0'
924          coordinates = '   0.0'
925          i = 1
926          DO  WHILE ( i < 11  .AND.  lad_vertical_gradient_level_ind(i) /= -9999 )
927
928             WRITE (coor_chr,'(F7.2)')  lad(lad_vertical_gradient_level_ind(i))
929             leaf_area_density = TRIM( leaf_area_density ) // ' ' // TRIM( coor_chr )
930 
931             WRITE (coor_chr,'(F7.2)')  lad_vertical_gradient(i)
932             gradients = TRIM( gradients ) // ' ' // TRIM( coor_chr )
933
934             WRITE (coor_chr,'(I7)')  lad_vertical_gradient_level_ind(i)
935             slices = TRIM( slices ) // ' ' // TRIM( coor_chr )
936
937             WRITE (coor_chr,'(F7.1)')  lad_vertical_gradient_level(i)
938             coordinates = TRIM( coordinates ) // ' '  // TRIM( coor_chr )
939
940             i = i + 1
941          ENDDO
942
943          WRITE ( io, 283 )  TRIM( coordinates ), TRIM( leaf_area_density ),              &
944                             TRIM( gradients ), TRIM( slices )
945
946       ELSE
947       
948          WRITE ( leaf_area_density, '(F7.4)' )  lad_surface
949          coordinates = '   0.0'
950         
951          DO  k = 1, pch_index
952
953             WRITE (coor_chr,'(F7.2)')  lad(k)
954             leaf_area_density = TRIM( leaf_area_density ) // ' ' // TRIM( coor_chr )
955 
956             WRITE (coor_chr,'(F7.1)')  zu(k)
957             coordinates = TRIM( coordinates ) // ' '  // TRIM( coor_chr )
958
959          ENDDO       
960
961          WRITE ( io, 284 ) TRIM( coordinates ), TRIM( leaf_area_density ), alpha_lad,    &
962                            beta_lad, lai_beta
963
964       ENDIF 
965
966    ENDIF
967
968
969    IF ( land_surface )  THEN
970
971       temperatures = ''
972       gradients    = '' ! use for humidity here
973       coordinates  = '' ! use for height
974       roots        = '' ! use for root fraction
975       slices       = '' ! use for index
976
977       i = 1
978       DO i = nzb_soil, nzt_soil
979          WRITE (coor_chr,'(F10.2,7X)') soil_temperature(i)
980          temperatures = TRIM( temperatures ) // ' ' // TRIM( coor_chr )
981
982          WRITE (coor_chr,'(F10.2,7X)') soil_moisture(i)
983          gradients = TRIM( gradients ) // ' ' // TRIM( coor_chr )
984
985          WRITE (coor_chr,'(F10.2,7X)')  - zs(i)
986          coordinates = TRIM( coordinates ) // ' '  // TRIM( coor_chr )
987
988          WRITE (coor_chr,'(F10.2,7X)')  root_fraction(i)
989          roots = TRIM( roots ) // ' '  // TRIM( coor_chr )
990
991          WRITE (coor_chr,'(I10,7X)')  i
992          slices = TRIM( slices ) // ' '  // TRIM( coor_chr )
993
994
995       ENDDO
996
997!
998!--    Write land surface model header
999       WRITE( io, 419 )
1000       IF ( conserve_water_content )  THEN
1001          WRITE( io, 440 )
1002       ELSE
1003          WRITE( io, 441 )
1004       ENDIF
1005
1006       WRITE( io, 438 ) TRIM( veg_type_name(veg_type) ),                       &
1007                        TRIM (soil_type_name(soil_type) )
1008       WRITE( io, 439 ) TRIM( coordinates ), TRIM( temperatures ),             &
1009                        TRIM( gradients ), TRIM( roots ), TRIM( slices )
1010
1011
1012    ENDIF
1013
1014    IF ( radiation )  THEN
1015!
1016!--    Write radiation model header
1017       WRITE( io, 444 )
1018
1019       IF ( radiation_scheme == "constant" )  THEN
1020          WRITE( io, 445 ) net_radiation
1021       ELSEIF ( radiation_scheme == "clear-sky" )  THEN
1022          WRITE( io, 446 )
1023       ELSEIF ( radiation_scheme == "rrtmg" )  THEN
1024          WRITE( io, 447 )
1025          IF ( .NOT. lw_radiation )  WRITE( io, 458 )
1026          IF ( .NOT. sw_radiation )  WRITE( io, 459 )
1027       ENDIF
1028
1029       IF ( albedo_type == 0 )  THEN
1030          WRITE( io, 448 ) albedo
1031       ELSE
1032          WRITE( io, 456 ) TRIM( albedo_type_name(albedo_type) )
1033       ENDIF
1034       IF ( constant_albedo )  THEN
1035          WRITE( io, 457 )
1036       ENDIF
1037       WRITE( io, 449 ) dt_radiation
1038    ENDIF
1039
1040
1041!
1042!-- Boundary conditions
1043    IF ( ibc_p_b == 0 )  THEN
1044       runten = 'p(0)     = 0      |'
1045    ELSEIF ( ibc_p_b == 1 )  THEN
1046       runten = 'p(0)     = p(1)   |'
1047    ENDIF
1048    IF ( ibc_p_t == 0 )  THEN
1049       roben  = 'p(nzt+1) = 0      |'
1050    ELSE
1051       roben  = 'p(nzt+1) = p(nzt) |'
1052    ENDIF
1053
1054    IF ( ibc_uv_b == 0 )  THEN
1055       runten = TRIM( runten ) // ' uv(0)     = -uv(1)                |'
1056    ELSE
1057       runten = TRIM( runten ) // ' uv(0)     = uv(1)                 |'
1058    ENDIF
1059    IF ( TRIM( bc_uv_t ) == 'dirichlet_0' )  THEN
1060       roben  = TRIM( roben  ) // ' uv(nzt+1) = 0                     |'
1061    ELSEIF ( ibc_uv_t == 0 )  THEN
1062       roben  = TRIM( roben  ) // ' uv(nzt+1) = ug(nzt+1), vg(nzt+1)  |'
1063    ELSE
1064       roben  = TRIM( roben  ) // ' uv(nzt+1) = uv(nzt)               |'
1065    ENDIF
1066
1067    IF ( ibc_pt_b == 0 )  THEN
1068       IF ( land_surface )  THEN
1069          runten = TRIM( runten ) // ' pt(0)     = from soil model'
1070       ELSE
1071          runten = TRIM( runten ) // ' pt(0)     = pt_surface'
1072       ENDIF
1073    ELSEIF ( ibc_pt_b == 1 )  THEN
1074       runten = TRIM( runten ) // ' pt(0)     = pt(1)'
1075    ELSEIF ( ibc_pt_b == 2 )  THEN
1076       runten = TRIM( runten ) // ' pt(0)     = from coupled model'
1077    ENDIF
1078    IF ( ibc_pt_t == 0 )  THEN
1079       roben  = TRIM( roben  ) // ' pt(nzt+1) = pt_top'
1080    ELSEIF( ibc_pt_t == 1 )  THEN
1081       roben  = TRIM( roben  ) // ' pt(nzt+1) = pt(nzt)'
1082    ELSEIF( ibc_pt_t == 2 )  THEN
1083       roben  = TRIM( roben  ) // ' pt(nzt+1) = pt(nzt) + dpt/dz_ini'
1084
1085    ENDIF
1086
1087    WRITE ( io, 300 )  runten, roben
1088
1089    IF ( .NOT. constant_diffusion )  THEN
1090       IF ( ibc_e_b == 1 )  THEN
1091          runten = 'e(0)     = e(1)'
1092       ELSE
1093          runten = 'e(0)     = e(1) = (u*/0.1)**2'
1094       ENDIF
1095       roben = 'e(nzt+1) = e(nzt) = e(nzt-1)'
1096
1097       WRITE ( io, 301 )  'e', runten, roben       
1098
1099    ENDIF
1100
1101    IF ( ocean )  THEN
1102       runten = 'sa(0)    = sa(1)'
1103       IF ( ibc_sa_t == 0 )  THEN
1104          roben =  'sa(nzt+1) = sa_surface'
1105       ELSE
1106          roben =  'sa(nzt+1) = sa(nzt)'
1107       ENDIF
1108       WRITE ( io, 301 ) 'sa', runten, roben
1109    ENDIF
1110
1111    IF ( humidity )  THEN
1112       IF ( ibc_q_b == 0 )  THEN
1113          IF ( land_surface )  THEN
1114             runten = 'q(0)     = from soil model'
1115          ELSE
1116             runten = 'q(0)     = q_surface'
1117          ENDIF
1118
1119       ELSE
1120          runten = 'q(0)     = q(1)'
1121       ENDIF
1122       IF ( ibc_q_t == 0 )  THEN
1123          roben =  'q(nzt)   = q_top'
1124       ELSE
1125          roben =  'q(nzt)   = q(nzt-1) + dq/dz'
1126       ENDIF
1127       WRITE ( io, 301 ) 'q', runten, roben
1128    ENDIF
1129
1130    IF ( passive_scalar )  THEN
1131       IF ( ibc_q_b == 0 )  THEN
1132          runten = 's(0)     = s_surface'
1133       ELSE
1134          runten = 's(0)     = s(1)'
1135       ENDIF
1136       IF ( ibc_q_t == 0 )  THEN
1137          roben =  's(nzt)   = s_top'
1138       ELSE
1139          roben =  's(nzt)   = s(nzt-1) + ds/dz'
1140       ENDIF
1141       WRITE ( io, 301 ) 's', runten, roben
1142    ENDIF
1143
1144    IF ( use_surface_fluxes )  THEN
1145       WRITE ( io, 303 )
1146       IF ( constant_heatflux )  THEN
1147          IF ( large_scale_forcing .AND. lsf_surf )  THEN
1148             WRITE ( io, 306 )  shf(0,0)
1149          ELSE
1150             WRITE ( io, 306 )  surface_heatflux
1151          ENDIF
1152          IF ( random_heatflux )  WRITE ( io, 307 )
1153       ENDIF
1154       IF ( humidity  .AND.  constant_waterflux )  THEN
1155          IF ( large_scale_forcing .AND. lsf_surf )  THEN
1156             WRITE ( io, 311 ) qsws(0,0)
1157          ELSE
1158             WRITE ( io, 311 ) surface_waterflux
1159          ENDIF
1160       ENDIF
1161       IF ( passive_scalar  .AND.  constant_waterflux )  THEN
1162          WRITE ( io, 313 ) surface_waterflux
1163       ENDIF
1164    ENDIF
1165
1166    IF ( use_top_fluxes )  THEN
1167       WRITE ( io, 304 )
1168       IF ( coupling_mode == 'uncoupled' )  THEN
1169          WRITE ( io, 320 )  top_momentumflux_u, top_momentumflux_v
1170          IF ( constant_top_heatflux )  THEN
1171             WRITE ( io, 306 )  top_heatflux
1172          ENDIF
1173       ELSEIF ( coupling_mode == 'ocean_to_atmosphere' )  THEN
1174          WRITE ( io, 316 )
1175       ENDIF
1176       IF ( ocean  .AND.  constant_top_salinityflux )  THEN
1177          WRITE ( io, 309 )  top_salinityflux
1178       ENDIF
1179       IF ( humidity  .OR.  passive_scalar )  THEN
1180          WRITE ( io, 315 )
1181       ENDIF
1182    ENDIF
1183
1184    IF ( constant_flux_layer )  THEN
1185       WRITE ( io, 305 )  (zu(1)-zu(0)), roughness_length,                     &
1186                          z0h_factor*roughness_length, kappa,                  &
1187                          zeta_min, zeta_max
1188       IF ( .NOT. constant_heatflux )  WRITE ( io, 308 )
1189       IF ( humidity  .AND.  .NOT. constant_waterflux )  THEN
1190          WRITE ( io, 312 )
1191       ENDIF
1192       IF ( passive_scalar  .AND.  .NOT. constant_waterflux )  THEN
1193          WRITE ( io, 314 )
1194       ENDIF
1195    ELSE
1196       IF ( INDEX(initializing_actions, 'set_1d-model_profiles') /= 0 )  THEN
1197          WRITE ( io, 310 )  zeta_min, zeta_max
1198       ENDIF
1199    ENDIF
1200
1201    WRITE ( io, 317 )  bc_lr, bc_ns
1202    IF ( .NOT. bc_lr_cyc  .OR.  .NOT. bc_ns_cyc )  THEN
1203       WRITE ( io, 318 )  use_cmax, pt_damping_width, pt_damping_factor       
1204       IF ( turbulent_inflow )  THEN
1205          IF ( .NOT. recycling_yshift ) THEN
1206             WRITE ( io, 319 )  recycling_width, recycling_plane, &
1207                                inflow_damping_height, inflow_damping_width
1208          ELSE
1209             WRITE ( io, 322 )  recycling_width, recycling_plane, &
1210                                inflow_damping_height, inflow_damping_width
1211          END IF
1212       ENDIF
1213    ENDIF
1214
1215!
1216!-- Initial Profiles
1217    WRITE ( io, 321 )
1218!
1219!-- Initial wind profiles
1220    IF ( u_profile(1) /= 9999999.9_wp )  WRITE ( io, 427 )
1221
1222!
1223!-- Initial temperature profile
1224!-- Building output strings, starting with surface temperature
1225    WRITE ( temperatures, '(F6.2)' )  pt_surface
1226    gradients = '------'
1227    slices = '     0'
1228    coordinates = '   0.0'
1229    i = 1
1230    DO  WHILE ( pt_vertical_gradient_level_ind(i) /= -9999 )
1231
1232       WRITE (coor_chr,'(F7.2)')  pt_init(pt_vertical_gradient_level_ind(i))
1233       temperatures = TRIM( temperatures ) // ' ' // TRIM( coor_chr )
1234
1235       WRITE (coor_chr,'(F7.2)')  pt_vertical_gradient(i)
1236       gradients = TRIM( gradients ) // ' ' // TRIM( coor_chr )
1237
1238       WRITE (coor_chr,'(I7)')  pt_vertical_gradient_level_ind(i)
1239       slices = TRIM( slices ) // ' ' // TRIM( coor_chr )
1240
1241       WRITE (coor_chr,'(F7.1)')  pt_vertical_gradient_level(i)
1242       coordinates = TRIM( coordinates ) // ' '  // TRIM( coor_chr )
1243
1244       IF ( i == 10 )  THEN
1245          EXIT
1246       ELSE
1247          i = i + 1
1248       ENDIF
1249
1250    ENDDO
1251
1252    IF ( .NOT. nudging )  THEN
1253       WRITE ( io, 420 )  TRIM( coordinates ), TRIM( temperatures ), &
1254                          TRIM( gradients ), TRIM( slices )
1255    ELSE
1256       WRITE ( io, 428 ) 
1257    ENDIF
1258
1259!
1260!-- Initial humidity profile
1261!-- Building output strings, starting with surface humidity
1262    IF ( humidity  .OR.  passive_scalar )  THEN
1263       WRITE ( temperatures, '(E8.1)' )  q_surface
1264       gradients = '--------'
1265       slices = '       0'
1266       coordinates = '     0.0'
1267       i = 1
1268       DO  WHILE ( q_vertical_gradient_level_ind(i) /= -9999 )
1269         
1270          WRITE (coor_chr,'(E8.1,4X)')  q_init(q_vertical_gradient_level_ind(i))
1271          temperatures = TRIM( temperatures ) // '  ' // TRIM( coor_chr )
1272
1273          WRITE (coor_chr,'(E8.1,4X)')  q_vertical_gradient(i)
1274          gradients = TRIM( gradients ) // '  ' // TRIM( coor_chr )
1275         
1276          WRITE (coor_chr,'(I8,4X)')  q_vertical_gradient_level_ind(i)
1277          slices = TRIM( slices ) // '  ' // TRIM( coor_chr )
1278         
1279          WRITE (coor_chr,'(F8.1,4X)')  q_vertical_gradient_level(i)
1280          coordinates = TRIM( coordinates ) // '  '  // TRIM( coor_chr )
1281
1282          IF ( i == 10 )  THEN
1283             EXIT
1284          ELSE
1285             i = i + 1
1286          ENDIF
1287
1288       ENDDO
1289
1290       IF ( humidity )  THEN
1291          IF ( .NOT. nudging )  THEN
1292             WRITE ( io, 421 )  TRIM( coordinates ), TRIM( temperatures ), &
1293                                TRIM( gradients ), TRIM( slices )
1294          ENDIF
1295       ELSE
1296          WRITE ( io, 422 )  TRIM( coordinates ), TRIM( temperatures ), &
1297                             TRIM( gradients ), TRIM( slices )
1298       ENDIF
1299    ENDIF
1300
1301!
1302!-- Initial salinity profile
1303!-- Building output strings, starting with surface salinity
1304    IF ( ocean )  THEN
1305       WRITE ( temperatures, '(F6.2)' )  sa_surface
1306       gradients = '------'
1307       slices = '     0'
1308       coordinates = '   0.0'
1309       i = 1
1310       DO  WHILE ( sa_vertical_gradient_level_ind(i) /= -9999 )
1311
1312          WRITE (coor_chr,'(F7.2)')  sa_init(sa_vertical_gradient_level_ind(i))
1313          temperatures = TRIM( temperatures ) // ' ' // TRIM( coor_chr )
1314
1315          WRITE (coor_chr,'(F7.2)')  sa_vertical_gradient(i)
1316          gradients = TRIM( gradients ) // ' ' // TRIM( coor_chr )
1317
1318          WRITE (coor_chr,'(I7)')  sa_vertical_gradient_level_ind(i)
1319          slices = TRIM( slices ) // ' ' // TRIM( coor_chr )
1320
1321          WRITE (coor_chr,'(F7.1)')  sa_vertical_gradient_level(i)
1322          coordinates = TRIM( coordinates ) // ' '  // TRIM( coor_chr )
1323
1324          IF ( i == 10 )  THEN
1325             EXIT
1326          ELSE
1327             i = i + 1
1328          ENDIF
1329
1330       ENDDO
1331
1332       WRITE ( io, 425 )  TRIM( coordinates ), TRIM( temperatures ), &
1333                          TRIM( gradients ), TRIM( slices )
1334    ENDIF
1335
1336
1337!
1338!-- Listing of 1D-profiles
1339    WRITE ( io, 325 )  dt_dopr_listing
1340    IF ( averaging_interval_pr /= 0.0_wp )  THEN
1341       WRITE ( io, 326 )  averaging_interval_pr, dt_averaging_input_pr
1342    ENDIF
1343
1344!
1345!-- DATA output
1346    WRITE ( io, 330 )
1347    IF ( averaging_interval_pr /= 0.0_wp )  THEN
1348       WRITE ( io, 326 )  averaging_interval_pr, dt_averaging_input_pr
1349    ENDIF
1350
1351!
1352!-- 1D-profiles
1353    dopr_chr = 'Profile:'
1354    IF ( dopr_n /= 0 )  THEN
1355       WRITE ( io, 331 )
1356
1357       output_format = ''
1358       output_format = netcdf_data_format_string
1359       IF ( netcdf_deflate == 0 )  THEN
1360          WRITE ( io, 344 )  output_format
1361       ELSE
1362          WRITE ( io, 354 )  TRIM( output_format ), netcdf_deflate
1363       ENDIF
1364
1365       DO  i = 1, dopr_n
1366          dopr_chr = TRIM( dopr_chr ) // ' ' // TRIM( data_output_pr(i) ) // ','
1367          IF ( LEN_TRIM( dopr_chr ) >= 60 )  THEN
1368             WRITE ( io, 332 )  dopr_chr
1369             dopr_chr = '       :'
1370          ENDIF
1371       ENDDO
1372
1373       IF ( dopr_chr /= '' )  THEN
1374          WRITE ( io, 332 )  dopr_chr
1375       ENDIF
1376       WRITE ( io, 333 )  dt_dopr, averaging_interval_pr, dt_averaging_input_pr
1377       IF ( skip_time_dopr /= 0.0_wp )  WRITE ( io, 339 )  skip_time_dopr
1378    ENDIF
1379
1380!
1381!-- 2D-arrays
1382    DO  av = 0, 1
1383
1384       i = 1
1385       do2d_xy = ''
1386       do2d_xz = ''
1387       do2d_yz = ''
1388       DO  WHILE ( do2d(av,i) /= ' ' )
1389
1390          l = MAX( 2, LEN_TRIM( do2d(av,i) ) )
1391          do2d_mode = do2d(av,i)(l-1:l)
1392
1393          SELECT CASE ( do2d_mode )
1394             CASE ( 'xy' )
1395                ll = LEN_TRIM( do2d_xy )
1396                do2d_xy = do2d_xy(1:ll) // ' ' // do2d(av,i)(1:l-3) // ','
1397             CASE ( 'xz' )
1398                ll = LEN_TRIM( do2d_xz )
1399                do2d_xz = do2d_xz(1:ll) // ' ' // do2d(av,i)(1:l-3) // ','
1400             CASE ( 'yz' )
1401                ll = LEN_TRIM( do2d_yz )
1402                do2d_yz = do2d_yz(1:ll) // ' ' // do2d(av,i)(1:l-3) // ','
1403          END SELECT
1404
1405          i = i + 1
1406
1407       ENDDO
1408
1409       IF ( ( ( do2d_xy /= ''  .AND.  section(1,1) /= -9999 )  .OR.    &
1410              ( do2d_xz /= ''  .AND.  section(1,2) /= -9999 )  .OR.    &
1411              ( do2d_yz /= ''  .AND.  section(1,3) /= -9999 ) ) )  THEN
1412
1413          IF (  av == 0 )  THEN
1414             WRITE ( io, 334 )  ''
1415          ELSE
1416             WRITE ( io, 334 )  '(time-averaged)'
1417          ENDIF
1418
1419          IF ( do2d_at_begin )  THEN
1420             begin_chr = 'and at the start'
1421          ELSE
1422             begin_chr = ''
1423          ENDIF
1424
1425          output_format = ''
1426          output_format = netcdf_data_format_string
1427          IF ( netcdf_deflate == 0 )  THEN
1428             WRITE ( io, 344 )  output_format
1429          ELSE
1430             WRITE ( io, 354 )  TRIM( output_format ), netcdf_deflate
1431          ENDIF
1432
1433          IF ( do2d_xy /= ''  .AND.  section(1,1) /= -9999 )  THEN
1434             i = 1
1435             slices = '/'
1436             coordinates = '/'
1437!
1438!--          Building strings with index and coordinate information of the
1439!--          slices
1440             DO  WHILE ( section(i,1) /= -9999 )
1441
1442                WRITE (section_chr,'(I5)')  section(i,1)
1443                section_chr = ADJUSTL( section_chr )
1444                slices = TRIM( slices ) // TRIM( section_chr ) // '/'
1445
1446                IF ( section(i,1) == -1 )  THEN
1447                   WRITE (coor_chr,'(F10.1)')  -1.0_wp
1448                ELSE
1449                   WRITE (coor_chr,'(F10.1)')  zu(section(i,1))
1450                ENDIF
1451                coor_chr = ADJUSTL( coor_chr )
1452                coordinates = TRIM( coordinates ) // TRIM( coor_chr ) // '/'
1453
1454                i = i + 1
1455             ENDDO
1456             IF ( av == 0 )  THEN
1457                WRITE ( io, 335 )  'XY', do2d_xy, dt_do2d_xy, &
1458                                   TRIM( begin_chr ), 'k', TRIM( slices ), &
1459                                   TRIM( coordinates )
1460                IF ( skip_time_do2d_xy /= 0.0_wp )  THEN
1461                   WRITE ( io, 339 )  skip_time_do2d_xy
1462                ENDIF
1463             ELSE
1464                WRITE ( io, 342 )  'XY', do2d_xy, dt_data_output_av, &
1465                                   TRIM( begin_chr ), averaging_interval, &
1466                                   dt_averaging_input, 'k', TRIM( slices ), &
1467                                   TRIM( coordinates )
1468                IF ( skip_time_data_output_av /= 0.0_wp )  THEN
1469                   WRITE ( io, 339 )  skip_time_data_output_av
1470                ENDIF
1471             ENDIF
1472             IF ( netcdf_data_format > 4 )  THEN
1473                WRITE ( io, 352 )  ntdim_2d_xy(av)
1474             ELSE
1475                WRITE ( io, 353 )
1476             ENDIF
1477          ENDIF
1478
1479          IF ( do2d_xz /= ''  .AND.  section(1,2) /= -9999 )  THEN
1480             i = 1
1481             slices = '/'
1482             coordinates = '/'
1483!
1484!--          Building strings with index and coordinate information of the
1485!--          slices
1486             DO  WHILE ( section(i,2) /= -9999 )
1487
1488                WRITE (section_chr,'(I5)')  section(i,2)
1489                section_chr = ADJUSTL( section_chr )
1490                slices = TRIM( slices ) // TRIM( section_chr ) // '/'
1491
1492                WRITE (coor_chr,'(F10.1)')  section(i,2) * dy
1493                coor_chr = ADJUSTL( coor_chr )
1494                coordinates = TRIM( coordinates ) // TRIM( coor_chr ) // '/'
1495
1496                i = i + 1
1497             ENDDO
1498             IF ( av == 0 )  THEN
1499                WRITE ( io, 335 )  'XZ', do2d_xz, dt_do2d_xz, &
1500                                   TRIM( begin_chr ), 'j', TRIM( slices ), &
1501                                   TRIM( coordinates )
1502                IF ( skip_time_do2d_xz /= 0.0_wp )  THEN
1503                   WRITE ( io, 339 )  skip_time_do2d_xz
1504                ENDIF
1505             ELSE
1506                WRITE ( io, 342 )  'XZ', do2d_xz, dt_data_output_av, &
1507                                   TRIM( begin_chr ), averaging_interval, &
1508                                   dt_averaging_input, 'j', TRIM( slices ), &
1509                                   TRIM( coordinates )
1510                IF ( skip_time_data_output_av /= 0.0_wp )  THEN
1511                   WRITE ( io, 339 )  skip_time_data_output_av
1512                ENDIF
1513             ENDIF
1514             IF ( netcdf_data_format > 4 )  THEN
1515                WRITE ( io, 352 )  ntdim_2d_xz(av)
1516             ELSE
1517                WRITE ( io, 353 )
1518             ENDIF
1519          ENDIF
1520
1521          IF ( do2d_yz /= ''  .AND.  section(1,3) /= -9999 )  THEN
1522             i = 1
1523             slices = '/'
1524             coordinates = '/'
1525!
1526!--          Building strings with index and coordinate information of the
1527!--          slices
1528             DO  WHILE ( section(i,3) /= -9999 )
1529
1530                WRITE (section_chr,'(I5)')  section(i,3)
1531                section_chr = ADJUSTL( section_chr )
1532                slices = TRIM( slices ) // TRIM( section_chr ) // '/'
1533
1534                WRITE (coor_chr,'(F10.1)')  section(i,3) * dx
1535                coor_chr = ADJUSTL( coor_chr )
1536                coordinates = TRIM( coordinates ) // TRIM( coor_chr ) // '/'
1537
1538                i = i + 1
1539             ENDDO
1540             IF ( av == 0 )  THEN
1541                WRITE ( io, 335 )  'YZ', do2d_yz, dt_do2d_yz, &
1542                                   TRIM( begin_chr ), 'i', TRIM( slices ), &
1543                                   TRIM( coordinates )
1544                IF ( skip_time_do2d_yz /= 0.0_wp )  THEN
1545                   WRITE ( io, 339 )  skip_time_do2d_yz
1546                ENDIF
1547             ELSE
1548                WRITE ( io, 342 )  'YZ', do2d_yz, dt_data_output_av, &
1549                                   TRIM( begin_chr ), averaging_interval, &
1550                                   dt_averaging_input, 'i', TRIM( slices ), &
1551                                   TRIM( coordinates )
1552                IF ( skip_time_data_output_av /= 0.0_wp )  THEN
1553                   WRITE ( io, 339 )  skip_time_data_output_av
1554                ENDIF
1555             ENDIF
1556             IF ( netcdf_data_format > 4 )  THEN
1557                WRITE ( io, 352 )  ntdim_2d_yz(av)
1558             ELSE
1559                WRITE ( io, 353 )
1560             ENDIF
1561          ENDIF
1562
1563       ENDIF
1564
1565    ENDDO
1566
1567!
1568!-- 3d-arrays
1569    DO  av = 0, 1
1570
1571       i = 1
1572       do3d_chr = ''
1573       DO  WHILE ( do3d(av,i) /= ' ' )
1574
1575          do3d_chr = TRIM( do3d_chr ) // ' ' // TRIM( do3d(av,i) ) // ','
1576          i = i + 1
1577
1578       ENDDO
1579
1580       IF ( do3d_chr /= '' )  THEN
1581          IF ( av == 0 )  THEN
1582             WRITE ( io, 336 )  ''
1583          ELSE
1584             WRITE ( io, 336 )  '(time-averaged)'
1585          ENDIF
1586
1587          output_format = netcdf_data_format_string
1588          IF ( netcdf_deflate == 0 )  THEN
1589             WRITE ( io, 344 )  output_format
1590          ELSE
1591             WRITE ( io, 354 )  TRIM( output_format ), netcdf_deflate
1592          ENDIF
1593
1594          IF ( do3d_at_begin )  THEN
1595             begin_chr = 'and at the start'
1596          ELSE
1597             begin_chr = ''
1598          ENDIF
1599          IF ( av == 0 )  THEN
1600             WRITE ( io, 337 )  do3d_chr, dt_do3d, TRIM( begin_chr ), &
1601                                zu(nz_do3d), nz_do3d
1602          ELSE
1603             WRITE ( io, 343 )  do3d_chr, dt_data_output_av,           &
1604                                TRIM( begin_chr ), averaging_interval, &
1605                                dt_averaging_input, zu(nz_do3d), nz_do3d
1606          ENDIF
1607
1608          IF ( netcdf_data_format > 4 )  THEN
1609             WRITE ( io, 352 )  ntdim_3d(av)
1610          ELSE
1611             WRITE ( io, 353 )
1612          ENDIF
1613
1614          IF ( av == 0 )  THEN
1615             IF ( skip_time_do3d /= 0.0_wp )  THEN
1616                WRITE ( io, 339 )  skip_time_do3d
1617             ENDIF
1618          ELSE
1619             IF ( skip_time_data_output_av /= 0.0_wp )  THEN
1620                WRITE ( io, 339 )  skip_time_data_output_av
1621             ENDIF
1622          ENDIF
1623
1624       ENDIF
1625
1626    ENDDO
1627
1628!
1629!-- masked arrays
1630    IF ( masks > 0 )  WRITE ( io, 345 )  &
1631         mask_scale_x, mask_scale_y, mask_scale_z
1632    DO  mid = 1, masks
1633       DO  av = 0, 1
1634
1635          i = 1
1636          domask_chr = ''
1637          DO  WHILE ( domask(mid,av,i) /= ' ' )
1638             domask_chr = TRIM( domask_chr ) // ' ' //  &
1639                          TRIM( domask(mid,av,i) ) // ','
1640             i = i + 1
1641          ENDDO
1642
1643          IF ( domask_chr /= '' )  THEN
1644             IF ( av == 0 )  THEN
1645                WRITE ( io, 346 )  '', mid
1646             ELSE
1647                WRITE ( io, 346 )  ' (time-averaged)', mid
1648             ENDIF
1649
1650             output_format = netcdf_data_format_string
1651!--          Parallel output not implemented for mask data, hence
1652!--          output_format must be adjusted.
1653             IF ( netcdf_data_format == 5 ) output_format = 'netCDF4/HDF5'
1654             IF ( netcdf_data_format == 6 ) output_format = 'netCDF4/HDF5 classic'
1655             IF ( netcdf_deflate == 0 )  THEN
1656                WRITE ( io, 344 )  output_format
1657             ELSE
1658                WRITE ( io, 354 )  TRIM( output_format ), netcdf_deflate
1659             ENDIF
1660
1661             IF ( av == 0 )  THEN
1662                WRITE ( io, 347 )  domask_chr, dt_domask(mid)
1663             ELSE
1664                WRITE ( io, 348 )  domask_chr, dt_data_output_av, &
1665                                   averaging_interval, dt_averaging_input
1666             ENDIF
1667
1668             IF ( av == 0 )  THEN
1669                IF ( skip_time_domask(mid) /= 0.0_wp )  THEN
1670                   WRITE ( io, 339 )  skip_time_domask(mid)
1671                ENDIF
1672             ELSE
1673                IF ( skip_time_data_output_av /= 0.0_wp )  THEN
1674                   WRITE ( io, 339 )  skip_time_data_output_av
1675                ENDIF
1676             ENDIF
1677!
1678!--          output locations
1679             DO  dim = 1, 3
1680                IF ( mask(mid,dim,1) >= 0.0_wp )  THEN
1681                   count = 0
1682                   DO  WHILE ( mask(mid,dim,count+1) >= 0.0_wp )
1683                      count = count + 1
1684                   ENDDO
1685                   WRITE ( io, 349 )  dir(dim), dir(dim), mid, dir(dim), &
1686                                      mask(mid,dim,:count)
1687                ELSEIF ( mask_loop(mid,dim,1) < 0.0_wp .AND.  &
1688                         mask_loop(mid,dim,2) < 0.0_wp .AND.  &
1689                         mask_loop(mid,dim,3) == 0.0_wp )  THEN
1690                   WRITE ( io, 350 )  dir(dim), dir(dim)
1691                ELSEIF ( mask_loop(mid,dim,3) == 0.0_wp )  THEN
1692                   WRITE ( io, 351 )  dir(dim), dir(dim), mid, dir(dim), &
1693                                      mask_loop(mid,dim,1:2)
1694                ELSE
1695                   WRITE ( io, 351 )  dir(dim), dir(dim), mid, dir(dim), &
1696                                      mask_loop(mid,dim,1:3)
1697                ENDIF
1698             ENDDO
1699          ENDIF
1700
1701       ENDDO
1702    ENDDO
1703
1704!
1705!-- Timeseries
1706    IF ( dt_dots /= 9999999.9_wp )  THEN
1707       WRITE ( io, 340 )
1708
1709       output_format = netcdf_data_format_string
1710       IF ( netcdf_deflate == 0 )  THEN
1711          WRITE ( io, 344 )  output_format
1712       ELSE
1713          WRITE ( io, 354 )  TRIM( output_format ), netcdf_deflate
1714       ENDIF
1715       WRITE ( io, 341 )  dt_dots
1716    ENDIF
1717
1718#if defined( __dvrp_graphics )
1719!
1720!-- Dvrp-output
1721    IF ( dt_dvrp /= 9999999.9_wp )  THEN
1722       WRITE ( io, 360 )  dt_dvrp, TRIM( dvrp_output ), TRIM( dvrp_host ), &
1723                          TRIM( dvrp_username ), TRIM( dvrp_directory )
1724       i = 1
1725       l = 0
1726       m = 0
1727       DO WHILE ( mode_dvrp(i) /= ' ' )
1728          IF ( mode_dvrp(i)(1:10) == 'isosurface' )  THEN
1729             READ ( mode_dvrp(i), '(10X,I2)' )  j
1730             l = l + 1
1731             IF ( do3d(0,j) /= ' ' )  THEN
1732                WRITE ( io, 361 )  TRIM( do3d(0,j) ), threshold(l), &
1733                                   isosurface_color(:,l)
1734             ENDIF
1735          ELSEIF ( mode_dvrp(i)(1:6) == 'slicer' )  THEN
1736             READ ( mode_dvrp(i), '(6X,I2)' )  j
1737             m = m + 1
1738             IF ( do2d(0,j) /= ' ' )  THEN
1739                WRITE ( io, 362 )  TRIM( do2d(0,j) ), &
1740                                   slicer_range_limits_dvrp(:,m)
1741             ENDIF
1742          ELSEIF ( mode_dvrp(i)(1:9) == 'particles' )  THEN
1743             WRITE ( io, 363 )  dvrp_psize
1744             IF ( particle_dvrpsize /= 'none' )  THEN
1745                WRITE ( io, 364 )  'size', TRIM( particle_dvrpsize ), &
1746                                   dvrpsize_interval
1747             ENDIF
1748             IF ( particle_color /= 'none' )  THEN
1749                WRITE ( io, 364 )  'color', TRIM( particle_color ), &
1750                                   color_interval
1751             ENDIF
1752          ENDIF
1753          i = i + 1
1754       ENDDO
1755
1756       WRITE ( io, 365 )  groundplate_color, superelevation_x, &
1757                          superelevation_y, superelevation, clip_dvrp_l, &
1758                          clip_dvrp_r, clip_dvrp_s, clip_dvrp_n
1759
1760       IF ( TRIM( topography ) /= 'flat' )  THEN
1761          WRITE ( io, 366 )  topography_color
1762          IF ( cluster_size > 1 )  THEN
1763             WRITE ( io, 367 )  cluster_size
1764          ENDIF
1765       ENDIF
1766
1767    ENDIF
1768#endif
1769
1770!
1771!-- Spectra output
1772    IF ( dt_dosp /= 9999999.9_wp )  THEN
1773       WRITE ( io, 370 )
1774
1775       output_format = netcdf_data_format_string
1776       IF ( netcdf_deflate == 0 )  THEN
1777          WRITE ( io, 344 )  output_format
1778       ELSE
1779          WRITE ( io, 354 )  TRIM( output_format ), netcdf_deflate
1780       ENDIF
1781       WRITE ( io, 371 )  dt_dosp
1782       IF ( skip_time_dosp /= 0.0_wp )  WRITE ( io, 339 )  skip_time_dosp
1783       WRITE ( io, 372 )  ( data_output_sp(i), i = 1,10 ),     &
1784                          ( spectra_direction(i), i = 1,10 ),  &
1785                          ( comp_spectra_level(i), i = 1,100 ), &
1786                          ( plot_spectra_level(i), i = 1,100 ), &
1787                          averaging_interval_sp, dt_averaging_input_pr
1788    ENDIF
1789
1790    WRITE ( io, 99 )
1791
1792!
1793!-- Physical quantities
1794    WRITE ( io, 400 )
1795
1796!
1797!-- Geostrophic parameters
1798    IF ( radiation .AND. radiation_scheme /= 'constant' )  THEN
1799       WRITE ( io, 417 )  lambda
1800    ENDIF
1801    WRITE ( io, 410 )  phi, omega, f, fs
1802
1803!
1804!-- Other quantities
1805    WRITE ( io, 411 )  g
1806    IF ( radiation .AND. radiation_scheme /= 'constant' )  THEN
1807       WRITE ( io, 418 )  day_init, time_utc_init
1808    ENDIF
1809
1810    WRITE ( io, 412 )  TRIM( reference_state )
1811    IF ( use_single_reference_value )  THEN
1812       IF ( ocean )  THEN
1813          WRITE ( io, 413 )  prho_reference
1814       ELSE
1815          WRITE ( io, 414 )  pt_reference
1816       ENDIF
1817    ENDIF
1818
1819!
1820!-- Cloud physics parameters
1821    IF ( cloud_physics )  THEN
1822       WRITE ( io, 415 )
1823       WRITE ( io, 416 ) surface_pressure, r_d, rho_surface, cp, l_v
1824       IF ( icloud_scheme == 0 )  THEN
1825          WRITE ( io, 510 ) 1.0E-6_wp * nc_const
1826          IF ( precipitation )  WRITE ( io, 511 ) c_sedimentation
1827       ENDIF
1828    ENDIF
1829
1830!
1831!-- Cloud physcis parameters / quantities / numerical methods
1832    WRITE ( io, 430 )
1833    IF ( humidity .AND. .NOT. cloud_physics .AND. .NOT. cloud_droplets)  THEN
1834       WRITE ( io, 431 )
1835    ELSEIF ( humidity  .AND.  cloud_physics )  THEN
1836       WRITE ( io, 432 )
1837       IF ( cloud_top_radiation )  WRITE ( io, 132 )
1838       IF ( icloud_scheme == 1 )  THEN
1839          IF ( precipitation )  WRITE ( io, 133 )
1840       ELSEIF ( icloud_scheme == 0 )  THEN
1841          IF ( drizzle )  WRITE ( io, 506 )
1842          IF ( precipitation )  THEN
1843             WRITE ( io, 505 )
1844             IF ( turbulence )  WRITE ( io, 507 )
1845             IF ( ventilation_effect )  WRITE ( io, 508 )
1846             IF ( limiter_sedimentation )  WRITE ( io, 509 )
1847          ENDIF
1848       ENDIF
1849    ELSEIF ( humidity  .AND.  cloud_droplets )  THEN
1850       WRITE ( io, 433 )
1851       IF ( curvature_solution_effects )  WRITE ( io, 434 )
1852       IF ( collision_kernel /= 'none' )  THEN
1853          WRITE ( io, 435 )  TRIM( collision_kernel )
1854          IF ( collision_kernel(6:9) == 'fast' )  THEN
1855             WRITE ( io, 436 )  radius_classes, dissipation_classes
1856          ENDIF
1857       ELSE
1858          WRITE ( io, 437 )
1859       ENDIF
1860    ENDIF
1861
1862!
1863!-- LES / turbulence parameters
1864    WRITE ( io, 450 )
1865
1866!--
1867! ... LES-constants used must still be added here
1868!--
1869    IF ( constant_diffusion )  THEN
1870       WRITE ( io, 451 )  km_constant, km_constant/prandtl_number, &
1871                          prandtl_number
1872    ENDIF
1873    IF ( .NOT. constant_diffusion)  THEN
1874       IF ( e_init > 0.0_wp )  WRITE ( io, 455 )  e_init
1875       IF ( e_min > 0.0_wp )  WRITE ( io, 454 )  e_min
1876       IF ( wall_adjustment )  WRITE ( io, 453 )  wall_adjustment_factor
1877    ENDIF
1878
1879!
1880!-- Special actions during the run
1881    WRITE ( io, 470 )
1882    IF ( create_disturbances )  THEN
1883       WRITE ( io, 471 )  dt_disturb, disturbance_amplitude,                   &
1884                          zu(disturbance_level_ind_b), disturbance_level_ind_b,&
1885                          zu(disturbance_level_ind_t), disturbance_level_ind_t
1886       IF ( .NOT. bc_lr_cyc  .OR.  .NOT. bc_ns_cyc )  THEN
1887          WRITE ( io, 472 )  inflow_disturbance_begin, inflow_disturbance_end
1888       ELSE
1889          WRITE ( io, 473 )  disturbance_energy_limit
1890       ENDIF
1891       WRITE ( io, 474 )  TRIM( random_generator )
1892    ENDIF
1893    IF ( pt_surface_initial_change /= 0.0_wp )  THEN
1894       WRITE ( io, 475 )  pt_surface_initial_change
1895    ENDIF
1896    IF ( humidity  .AND.  q_surface_initial_change /= 0.0_wp )  THEN
1897       WRITE ( io, 476 )  q_surface_initial_change       
1898    ENDIF
1899    IF ( passive_scalar  .AND.  q_surface_initial_change /= 0.0_wp )  THEN
1900       WRITE ( io, 477 )  q_surface_initial_change       
1901    ENDIF
1902
1903    IF ( particle_advection )  THEN
1904!
1905!--    Particle attributes
1906       WRITE ( io, 480 )  particle_advection_start, dt_prel, bc_par_lr, &
1907                          bc_par_ns, bc_par_b, bc_par_t, particle_maximum_age, &
1908                          end_time_prel
1909       IF ( use_sgs_for_particles )  WRITE ( io, 488 )  dt_min_part
1910       IF ( random_start_position )  WRITE ( io, 481 )
1911       IF ( seed_follows_topography )  WRITE ( io, 496 )
1912       IF ( particles_per_point > 1 )  WRITE ( io, 489 )  particles_per_point
1913       WRITE ( io, 495 )  total_number_of_particles
1914       IF ( use_particle_tails  .AND.  maximum_number_of_tailpoints /= 0 )  THEN
1915          WRITE ( io, 483 )  maximum_number_of_tailpoints
1916          IF ( minimum_tailpoint_distance /= 0 )  THEN
1917             WRITE ( io, 484 )  total_number_of_tails,      &
1918                                minimum_tailpoint_distance, &
1919                                maximum_tailpoint_age
1920          ENDIF
1921       ENDIF
1922       IF ( dt_write_particle_data /= 9999999.9_wp )  THEN
1923          WRITE ( io, 485 )  dt_write_particle_data
1924          IF ( netcdf_data_format > 1 )  THEN
1925             output_format = 'netcdf (64 bit offset) and binary'
1926          ELSE
1927             output_format = 'netcdf and binary'
1928          ENDIF
1929          IF ( netcdf_deflate == 0 )  THEN
1930             WRITE ( io, 344 )  output_format
1931          ELSE
1932             WRITE ( io, 354 )  TRIM( output_format ), netcdf_deflate
1933          ENDIF
1934       ENDIF
1935       IF ( dt_dopts /= 9999999.9_wp )  WRITE ( io, 494 )  dt_dopts
1936       IF ( write_particle_statistics )  WRITE ( io, 486 )
1937
1938       WRITE ( io, 487 )  number_of_particle_groups
1939
1940       DO  i = 1, number_of_particle_groups
1941          IF ( i == 1  .AND.  density_ratio(i) == 9999999.9_wp )  THEN
1942             WRITE ( io, 490 )  i, 0.0_wp
1943             WRITE ( io, 492 )
1944          ELSE
1945             WRITE ( io, 490 )  i, radius(i)
1946             IF ( density_ratio(i) /= 0.0_wp )  THEN
1947                WRITE ( io, 491 )  density_ratio(i)
1948             ELSE
1949                WRITE ( io, 492 )
1950             ENDIF
1951          ENDIF
1952          WRITE ( io, 493 )  psl(i), psr(i), pss(i), psn(i), psb(i), pst(i), &
1953                             pdx(i), pdy(i), pdz(i)
1954          IF ( .NOT. vertical_particle_advection(i) )  WRITE ( io, 482 )
1955       ENDDO
1956
1957    ENDIF
1958
1959
1960!
1961!-- Parameters of 1D-model
1962    IF ( INDEX( initializing_actions, 'set_1d-model_profiles' ) /= 0 )  THEN
1963       WRITE ( io, 500 )  end_time_1d, dt_run_control_1d, dt_pr_1d, &
1964                          mixing_length_1d, dissipation_1d
1965       IF ( damp_level_ind_1d /= nzt+1 )  THEN
1966          WRITE ( io, 502 )  zu(damp_level_ind_1d), damp_level_ind_1d
1967       ENDIF
1968    ENDIF
1969
1970!
1971!-- User-defined information
1972    CALL user_header( io )
1973
1974    WRITE ( io, 99 )
1975
1976!
1977!-- Write buffer contents to disc immediately
1978    CALL local_flush( io )
1979
1980!
1981!-- Here the FORMATs start
1982
1983 99 FORMAT (1X,78('-'))
1984100 FORMAT (/1X,'******************************',4X,44('-')/        &
1985            1X,'* ',A,' *',4X,A/                               &
1986            1X,'******************************',4X,44('-'))
1987101 FORMAT (35X,'coupled run using MPI-',I1,': ',A/ &
1988            35X,42('-'))
1989102 FORMAT (/' Date:                 ',A8,4X,'Run:       ',A20/      &
1990            ' Time:                 ',A8,4X,'Run-No.:   ',I2.2/     &
1991            ' Run on host:        ',A10)
1992#if defined( __parallel )
1993103 FORMAT (' Number of PEs:',10X,I6,4X,'Processor grid (x,y): (',I4,',',I4, &
1994              ')',1X,A)
1995104 FORMAT (' Number of PEs:',10X,I6,4X,'Tasks:',I4,'   threads per task:',I4/ &
1996              35X,'Processor grid (x,y): (',I4,',',I4,')',1X,A)
1997105 FORMAT (35X,'One additional PE is used to handle'/37X,'the dvrp output!')
1998106 FORMAT (35X,'A 1d-decomposition along x is forced'/ &
1999            35X,'because the job is running on an SMP-cluster')
2000107 FORMAT (35X,'A 1d-decomposition along ',A,' is used')
2001108 FORMAT (35X,'Max. # of parallel I/O streams is ',I5)
2002109 FORMAT (35X,'Precursor run for coupled atmos-ocean run'/ &
2003            35X,42('-'))
2004114 FORMAT (35X,'Coupled atmosphere-ocean run following'/ &
2005            35X,'independent precursor runs'/             &
2006            35X,42('-'))
2007117 FORMAT (' Accelerator boards / node:  ',I2)
2008#endif
2009110 FORMAT (/' Numerical Schemes:'/ &
2010             ' -----------------'/)
2011111 FORMAT (' --> Solve perturbation pressure via FFT using ',A,' routines')
2012112 FORMAT (' --> Solve perturbation pressure via SOR-Red/Black-Schema'/ &
2013            '     Iterations (initial/other): ',I3,'/',I3,'  omega =',F6.3)
2014113 FORMAT (' --> Momentum advection via Piascek-Williams-Scheme (Form C3)', &
2015                  ' or Upstream')
2016115 FORMAT ('     FFT and transpositions are overlapping')
2017116 FORMAT (' --> Scalar advection via Piascek-Williams-Scheme (Form C3)', &
2018                  ' or Upstream')
2019118 FORMAT (' --> Scalar advection via Bott-Chlond-Scheme')
2020119 FORMAT (' --> Galilei-Transform applied to horizontal advection:'/ &
2021            '     translation velocity = ',A/ &
2022            '     distance advected ',A,':  ',F8.3,' km(x)  ',F8.3,' km(y)')
2023120 FORMAT (' Accelerator boards: ',8X,I2)
2024122 FORMAT (' --> Time differencing scheme: ',A)
2025123 FORMAT (' --> Rayleigh-Damping active, starts ',A,' z = ',F8.2,' m'/ &
2026            '     maximum damping coefficient:',F6.3, ' 1/s')
2027129 FORMAT (' --> Additional prognostic equation for the specific humidity')
2028130 FORMAT (' --> Additional prognostic equation for the total water content')
2029131 FORMAT (' --> No pt-equation solved. Neutral stratification with pt = ', &
2030                  F6.2, ' K assumed')
2031132 FORMAT ('     Parameterization of long-wave radiation processes via'/ &
2032            '     effective emissivity scheme')
2033133 FORMAT ('     Precipitation parameterization via Kessler-Scheme')
2034134 FORMAT (' --> Additional prognostic equation for a passive scalar')
2035135 FORMAT (' --> Solve perturbation pressure via ',A,' method (', &
2036                  A,'-cycle)'/ &
2037            '     number of grid levels:                   ',I2/ &
2038            '     Gauss-Seidel red/black iterations:       ',I2)
2039136 FORMAT ('     gridpoints of coarsest subdomain (x,y,z): (',I3,',',I3,',', &
2040                  I3,')')
2041137 FORMAT ('     level data gathered on PE0 at level:     ',I2/ &
2042            '     gridpoints of coarsest subdomain (x,y,z): (',I3,',',I3,',', &
2043                  I3,')'/ &
2044            '     gridpoints of coarsest domain (x,y,z):    (',I3,',',I3,',', &
2045                  I3,')')
2046139 FORMAT (' --> Loop optimization method: ',A)
2047140 FORMAT ('     maximum residual allowed:                ',E10.3)
2048141 FORMAT ('     fixed number of multigrid cycles:        ',I4)
2049142 FORMAT ('     perturbation pressure is calculated at every Runge-Kutta ', &
2050                  'step')
2051143 FORMAT ('     Euler/upstream scheme is used for the SGS turbulent ', &
2052                  'kinetic energy')
2053144 FORMAT ('     masking method is used')
2054150 FORMAT (' --> Volume flow at the right and north boundary will be ', &
2055                  'conserved'/ &
2056            '     using the ',A,' mode')
2057151 FORMAT ('     with u_bulk = ',F7.3,' m/s and v_bulk = ',F7.3,' m/s')
2058152 FORMAT (' --> External pressure gradient directly prescribed by the user:',&
2059           /'     ',2(1X,E12.5),'Pa/m in x/y direction', &
2060           /'     starting from dp_level_b =', F8.3, 'm', A /)
2061160 FORMAT (//' Large scale forcing and nudging:'/ &
2062              ' -------------------------------'/)
2063161 FORMAT (' --> No large scale forcing from external is used (default) ')
2064162 FORMAT (' --> Large scale forcing from external file LSF_DATA is used: ')
2065163 FORMAT ('     - large scale advection tendencies ')
2066164 FORMAT ('     - large scale subsidence velocity w_subs ')
2067165 FORMAT ('     - large scale subsidence tendencies ')
2068167 FORMAT ('     - and geostrophic wind components ug and vg')
2069168 FORMAT (' --> Large-scale vertical motion is used in the ', &
2070                  'prognostic equation(s) for')
2071169 FORMAT ('     the scalar(s) only')
2072170 FORMAT (' --> Nudging is used')
2073171 FORMAT (' --> No nudging is used (default) ')
2074180 FORMAT ('     - prescribed surface values for temperature')
2075181 FORMAT ('     - prescribed surface fluxes for temperature')
2076182 FORMAT ('     - prescribed surface values for humidity')
2077183 FORMAT ('     - prescribed surface fluxes for humidity')
2078200 FORMAT (//' Run time and time step information:'/ &
2079             ' ----------------------------------'/)
2080201 FORMAT ( ' Timestep:             variable     maximum value: ',F6.3,' s', &
2081             '    CFL-factor:',F5.2)
2082202 FORMAT ( ' Timestep:          dt = ',F6.3,' s'/)
2083203 FORMAT ( ' Start time:          ',F9.3,' s'/ &
2084             ' End time:            ',F9.3,' s')
2085204 FORMAT ( A,F9.3,' s')
2086205 FORMAT ( A,F9.3,' s',5X,'restart every',17X,F9.3,' s')
2087206 FORMAT (/' Time reached:        ',F9.3,' s'/ &
2088             ' CPU-time used:       ',F9.3,' s     per timestep:               ', &
2089               '  ',F9.3,' s'/                                                    &
2090             '                                      per second of simulated tim', &
2091               'e: ',F9.3,' s')
2092207 FORMAT ( ' Coupling start time: ',F9.3,' s')
2093250 FORMAT (//' Computational grid and domain size:'/ &
2094              ' ----------------------------------'// &
2095              ' Grid length:      dx =    ',F7.3,' m    dy =    ',F7.3, &
2096              ' m    dz =    ',F7.3,' m'/ &
2097              ' Domain size:       x = ',F10.3,' m     y = ',F10.3, &
2098              ' m  z(u) = ',F10.3,' m'/)
2099252 FORMAT (' dz constant up to ',F10.3,' m (k=',I4,'), then stretched by', &
2100              ' factor:',F6.3/ &
2101            ' maximum dz not to be exceeded is dz_max = ',F10.3,' m'/)
2102254 FORMAT (' Number of gridpoints (x,y,z):  (0:',I4,', 0:',I4,', 0:',I4,')'/ &
2103            ' Subdomain size (x,y,z):        (  ',I4,',   ',I4,',   ',I4,')'/)
2104260 FORMAT (/' The model has a slope in x-direction. Inclination angle: ',F6.2,&
2105             ' degrees')
2106270 FORMAT (//' Topography information:'/ &
2107              ' ----------------------'// &
2108              1X,'Topography: ',A)
2109271 FORMAT (  ' Building size (x/y/z) in m: ',F5.1,' / ',F5.1,' / ',F5.1/ &
2110              ' Horizontal index bounds (l/r/s/n): ',I4,' / ',I4,' / ',I4, &
2111                ' / ',I4)
2112272 FORMAT (  ' Single quasi-2D street canyon of infinite length in ',A, &
2113              ' direction' / &
2114              ' Canyon height: ', F6.2, 'm, ch = ', I4, '.'      / &
2115              ' Canyon position (',A,'-walls): cxl = ', I4,', cxr = ', I4, '.')
2116278 FORMAT (' Topography grid definition convention:'/ &
2117            ' cell edge (staggered grid points'/  &
2118            ' (u in x-direction, v in y-direction))' /)
2119279 FORMAT (' Topography grid definition convention:'/ &
2120            ' cell center (scalar grid points)' /)
2121280 FORMAT (//' Vegetation canopy (drag) model:'/ &
2122              ' ------------------------------'// &
2123              ' Canopy mode: ', A / &
2124              ' Canopy height: ',F6.2,'m (',I4,' grid points)' / &
2125              ' Leaf drag coefficient: ',F6.2 /)
2126281 FORMAT (/ ' Scalar exchange coefficient: ',F6.2 / &
2127              ' Scalar concentration at leaf surfaces in kg/m**3: ',F6.2 /)
2128282 FORMAT (' Predefined constant heatflux at the top of the vegetation: ',F6.2,' K m/s')
2129283 FORMAT (/ ' Characteristic levels of the leaf area density:'// &
2130              ' Height:              ',A,'  m'/ &
2131              ' Leaf area density:   ',A,'  m**2/m**3'/ &
2132              ' Gradient:            ',A,'  m**2/m**4'/ &
2133              ' Gridpoint:           ',A)
2134284 FORMAT (//' Characteristic levels of the leaf area density and coefficients:'// &
2135              ' Height:              ',A,'  m'/ &
2136              ' Leaf area density:   ',A,'  m**2/m**3'/ &
2137              ' Coefficient alpha: ',F6.2 / &
2138              ' Coefficient beta: ',F6.2 / &
2139              ' Leaf area index: ',F6.2,'  m**2/m**2' /)
2140               
2141300 FORMAT (//' Boundary conditions:'/ &
2142             ' -------------------'// &
2143             '                     p                    uv             ', &
2144             '                     pt'// &
2145             ' B. bound.: ',A/ &
2146             ' T. bound.: ',A)
2147301 FORMAT (/'                     ',A// &
2148             ' B. bound.: ',A/ &
2149             ' T. bound.: ',A)
2150303 FORMAT (/' Bottom surface fluxes are used in diffusion terms at k=1')
2151304 FORMAT (/' Top surface fluxes are used in diffusion terms at k=nzt')
2152305 FORMAT (//'    Prandtl-Layer between bottom surface and first ', &
2153               'computational u,v-level:'// &
2154             '       zp = ',F6.2,' m   z0 =',F7.4,' m   z0h =',F8.5,&
2155             ' m   kappa =',F5.2/ &
2156             '       Rif value range:   ',F8.2,' <= rif <=',F6.2)
2157306 FORMAT ('       Predefined constant heatflux:   ',F9.6,' K m/s')
2158307 FORMAT ('       Heatflux has a random normal distribution')
2159308 FORMAT ('       Predefined surface temperature')
2160309 FORMAT ('       Predefined constant salinityflux:   ',F9.6,' psu m/s')
2161310 FORMAT (//'    1D-Model:'// &
2162             '       Rif value range:   ',F6.2,' <= rif <=',F6.2)
2163311 FORMAT ('       Predefined constant humidity flux: ',E10.3,' m/s')
2164312 FORMAT ('       Predefined surface humidity')
2165313 FORMAT ('       Predefined constant scalar flux: ',E10.3,' kg/(m**2 s)')
2166314 FORMAT ('       Predefined scalar value at the surface')
2167315 FORMAT ('       Humidity / scalar flux at top surface is 0.0')
2168316 FORMAT ('       Sensible heatflux and momentum flux from coupled ', &
2169                    'atmosphere model')
2170317 FORMAT (//' Lateral boundaries:'/ &
2171            '       left/right:  ',A/    &
2172            '       north/south: ',A)
2173318 FORMAT (/'       use_cmax: ',L1 / &
2174            '       pt damping layer width = ',F8.2,' m, pt ', &
2175                    'damping factor =',F7.4)
2176319 FORMAT ('       turbulence recycling at inflow switched on'/ &
2177            '       width of recycling domain: ',F7.1,' m   grid index: ',I4/ &
2178            '       inflow damping height: ',F6.1,' m   width: ',F6.1,' m')
2179320 FORMAT ('       Predefined constant momentumflux:  u: ',F9.6,' m**2/s**2'/ &
2180            '                                          v: ',F9.6,' m**2/s**2')
2181321 FORMAT (//' Initial profiles:'/ &
2182              ' ----------------')
2183322 FORMAT ('       turbulence recycling at inflow switched on'/ &
2184            '       y shift of the recycled inflow turbulence switched on'/ &
2185            '       width of recycling domain: ',F7.1,' m   grid index: ',I4/ &
2186            '       inflow damping height: ',F6.1,' m   width: ',F6.1,' m'/)
2187325 FORMAT (//' List output:'/ &
2188             ' -----------'//  &
2189            '    1D-Profiles:'/    &
2190            '       Output every             ',F8.2,' s')
2191326 FORMAT ('       Time averaged over       ',F8.2,' s'/ &
2192            '       Averaging input every    ',F8.2,' s')
2193330 FORMAT (//' Data output:'/ &
2194             ' -----------'/)
2195331 FORMAT (/'    1D-Profiles:')
2196332 FORMAT (/'       ',A)
2197333 FORMAT ('       Output every             ',F8.2,' s',/ &
2198            '       Time averaged over       ',F8.2,' s'/ &
2199            '       Averaging input every    ',F8.2,' s')
2200334 FORMAT (/'    2D-Arrays',A,':')
2201335 FORMAT (/'       ',A2,'-cross-section  Arrays: ',A/ &
2202            '       Output every             ',F8.2,' s  ',A/ &
2203            '       Cross sections at ',A1,' = ',A/ &
2204            '       scalar-coordinates:   ',A,' m'/)
2205336 FORMAT (/'    3D-Arrays',A,':')
2206337 FORMAT (/'       Arrays: ',A/ &
2207            '       Output every             ',F8.2,' s  ',A/ &
2208            '       Upper output limit at    ',F8.2,' m  (GP ',I4,')'/)
2209339 FORMAT ('       No output during initial ',F8.2,' s')
2210340 FORMAT (/'    Time series:')
2211341 FORMAT ('       Output every             ',F8.2,' s'/)
2212342 FORMAT (/'       ',A2,'-cross-section  Arrays: ',A/ &
2213            '       Output every             ',F8.2,' s  ',A/ &
2214            '       Time averaged over       ',F8.2,' s'/ &
2215            '       Averaging input every    ',F8.2,' s'/ &
2216            '       Cross sections at ',A1,' = ',A/ &
2217            '       scalar-coordinates:   ',A,' m'/)
2218343 FORMAT (/'       Arrays: ',A/ &
2219            '       Output every             ',F8.2,' s  ',A/ &
2220            '       Time averaged over       ',F8.2,' s'/ &
2221            '       Averaging input every    ',F8.2,' s'/ &
2222            '       Upper output limit at    ',F8.2,' m  (GP ',I4,')'/)
2223344 FORMAT ('       Output format: ',A/)
2224345 FORMAT (/'    Scaling lengths for output locations of all subsequent mask IDs:',/ &
2225            '       mask_scale_x (in x-direction): ',F9.3, ' m',/ &
2226            '       mask_scale_y (in y-direction): ',F9.3, ' m',/ &
2227            '       mask_scale_z (in z-direction): ',F9.3, ' m' )
2228346 FORMAT (/'    Masked data output',A,' for mask ID ',I2, ':')
2229347 FORMAT ('       Variables: ',A/ &
2230            '       Output every             ',F8.2,' s')
2231348 FORMAT ('       Variables: ',A/ &
2232            '       Output every             ',F8.2,' s'/ &
2233            '       Time averaged over       ',F8.2,' s'/ &
2234            '       Averaging input every    ',F8.2,' s')
2235349 FORMAT (/'       Output locations in ',A,'-direction in multiples of ', &
2236            'mask_scale_',A,' predefined by array mask_',I2.2,'_',A,':'/ &
2237            13('       ',8(F8.2,',')/) )
2238350 FORMAT (/'       Output locations in ',A,'-direction: ', &
2239            'all gridpoints along ',A,'-direction (default).' )
2240351 FORMAT (/'       Output locations in ',A,'-direction in multiples of ', &
2241            'mask_scale_',A,' constructed from array mask_',I2.2,'_',A,'_loop:'/ &
2242            '          loop begin:',F8.2,', end:',F8.2,', stride:',F8.2 )
2243352 FORMAT  (/'       Number of output time levels allowed: ',I3 /)
2244353 FORMAT  (/'       Number of output time levels allowed: unlimited' /)
2245354 FORMAT ('       Output format: ',A, '   compressed with level: ',I1/)
2246#if defined( __dvrp_graphics )
2247360 FORMAT ('    Plot-Sequence with dvrp-software:'/ &
2248            '       Output every      ',F7.1,' s'/ &
2249            '       Output mode:      ',A/ &
2250            '       Host / User:      ',A,' / ',A/ &
2251            '       Directory:        ',A// &
2252            '       The sequence contains:')
2253361 FORMAT (/'       Isosurface of "',A,'"    Threshold value: ', E12.3/ &
2254            '          Isosurface color: (',F4.2,',',F4.2,',',F4.2,') (R,G,B)')
2255362 FORMAT (/'       Slicer plane ',A/ &
2256            '       Slicer limits: [',F6.2,',',F6.2,']')
2257363 FORMAT (/'       Particles'/ &
2258            '          particle size:  ',F7.2,' m')
2259364 FORMAT ('          particle ',A,' controlled by "',A,'" with interval [', &
2260                       F6.2,',',F6.2,']')
2261365 FORMAT (/'       Groundplate color: (',F4.2,',',F4.2,',',F4.2,') (R,G,B)'/ &
2262            '       Superelevation along (x,y,z): (',F4.1,',',F4.1,',',F4.1, &
2263                     ')'/ &
2264            '       Clipping limits: from x = ',F9.1,' m to x = ',F9.1,' m'/ &
2265            '                        from y = ',F9.1,' m to y = ',F9.1,' m')
2266366 FORMAT (/'       Topography color: (',F4.2,',',F4.2,',',F4.2,') (R,G,B)')
2267367 FORMAT ('       Polygon reduction for topography: cluster_size = ', I1)
2268#endif
2269370 FORMAT ('    Spectra:')
2270371 FORMAT ('       Output every ',F7.1,' s'/)
2271372 FORMAT ('       Arrays:     ', 10(A5,',')/                         &
2272            '       Directions: ', 10(A5,',')/                         &
2273            '       height levels  k = ', 20(I3,',')/                  &
2274            '                          ', 20(I3,',')/                  &
2275            '                          ', 20(I3,',')/                  &
2276            '                          ', 20(I3,',')/                  &
2277            '                          ', 19(I3,','),I3,'.'/           &
2278            '       height levels selected for standard plot:'/        &
2279            '                      k = ', 20(I3,',')/                  &
2280            '                          ', 20(I3,',')/                  &
2281            '                          ', 20(I3,',')/                  &
2282            '                          ', 20(I3,',')/                  &
2283            '                          ', 19(I3,','),I3,'.'/           &
2284            '       Time averaged over ', F7.1, ' s,' /                &
2285            '       Profiles for the time averaging are taken every ', &
2286                    F6.1,' s')
2287400 FORMAT (//' Physical quantities:'/ &
2288              ' -------------------'/)
2289410 FORMAT ('    Geograph. latitude  :   phi    = ',F4.1,' degr'/   &
2290            '    Angular velocity    :   omega  =',E10.3,' rad/s'/  &
2291            '    Coriolis parameter  :   f      = ',F9.6,' 1/s'/    &
2292            '                            f*     = ',F9.6,' 1/s')
2293411 FORMAT (/'    Gravity             :   g      = ',F4.1,' m/s**2')
2294412 FORMAT (/'    Reference state used in buoyancy terms: ',A)
2295413 FORMAT ('       Reference density in buoyancy terms: ',F8.3,' kg/m**3')
2296414 FORMAT ('       Reference temperature in buoyancy terms: ',F8.4,' K')
2297415 FORMAT (/' Cloud physics parameters:'/ &
2298             ' ------------------------'/)
2299416 FORMAT ('    Surface pressure   :   p_0   = ',F7.2,' hPa'/      &
2300            '    Gas constant       :   R     = ',F5.1,' J/(kg K)'/ &
2301            '    Density of air     :   rho_0 =',F6.3,' kg/m**3'/  &
2302            '    Specific heat cap. :   c_p   = ',F6.1,' J/(kg K)'/ &
2303            '    Vapourization heat :   L_v   =',E9.2,' J/kg')
2304417 FORMAT ('    Geograph. longitude :   lambda = ',F4.1,' degr')
2305418 FORMAT (/'    Day of the year at model start :   day_init      =     ',I3 &
2306            /'    UTC time at model start        :   time_utc_init = ',F7.1' s')
2307419 FORMAT (//' Land surface model information:'/ &
2308              ' ------------------------------'/)
2309420 FORMAT (/'    Characteristic levels of the initial temperature profile:'// &
2310            '       Height:        ',A,'  m'/ &
2311            '       Temperature:   ',A,'  K'/ &
2312            '       Gradient:      ',A,'  K/100m'/ &
2313            '       Gridpoint:     ',A)
2314421 FORMAT (/'    Characteristic levels of the initial humidity profile:'// &
2315            '       Height:      ',A,'  m'/ &
2316            '       Humidity:    ',A,'  kg/kg'/ &
2317            '       Gradient:    ',A,'  (kg/kg)/100m'/ &
2318            '       Gridpoint:   ',A)
2319422 FORMAT (/'    Characteristic levels of the initial scalar profile:'// &
2320            '       Height:                  ',A,'  m'/ &
2321            '       Scalar concentration:    ',A,'  kg/m**3'/ &
2322            '       Gradient:                ',A,'  (kg/m**3)/100m'/ &
2323            '       Gridpoint:               ',A)
2324423 FORMAT (/'    Characteristic levels of the geo. wind component ug:'// &
2325            '       Height:      ',A,'  m'/ &
2326            '       ug:          ',A,'  m/s'/ &
2327            '       Gradient:    ',A,'  1/100s'/ &
2328            '       Gridpoint:   ',A)
2329424 FORMAT (/'    Characteristic levels of the geo. wind component vg:'// &
2330            '       Height:      ',A,'  m'/ &
2331            '       vg:          ',A,'  m/s'/ &
2332            '       Gradient:    ',A,'  1/100s'/ &
2333            '       Gridpoint:   ',A)
2334425 FORMAT (/'    Characteristic levels of the initial salinity profile:'// &
2335            '       Height:     ',A,'  m'/ &
2336            '       Salinity:   ',A,'  psu'/ &
2337            '       Gradient:   ',A,'  psu/100m'/ &
2338            '       Gridpoint:  ',A)
2339426 FORMAT (/'    Characteristic levels of the subsidence/ascent profile:'// &
2340            '       Height:      ',A,'  m'/ &
2341            '       w_subs:      ',A,'  m/s'/ &
2342            '       Gradient:    ',A,'  (m/s)/100m'/ &
2343            '       Gridpoint:   ',A)
2344427 FORMAT (/'    Initial wind profiles (u,v) are interpolated from given'// &
2345                  ' profiles')
2346428 FORMAT (/'    Initial profiles (u, v, pt, q) are taken from file '/ &
2347             '    NUDGING_DATA')
2348430 FORMAT (//' Cloud physics quantities / methods:'/ &
2349              ' ----------------------------------'/)
2350431 FORMAT ('    Humidity is treated as purely passive scalar (no condensati', &
2351                 'on)')
2352432 FORMAT ('    Bulk scheme with liquid water potential temperature and'/ &
2353            '    total water content is used.'/ &
2354            '    Condensation is parameterized via 0% - or 100% scheme.')
2355433 FORMAT ('    Cloud droplets treated explicitly using the Lagrangian part', &
2356                 'icle model')
2357434 FORMAT ('    Curvature and solution effecs are considered for growth of', &
2358                 ' droplets < 1.0E-6 m')
2359435 FORMAT ('    Droplet collision is handled by ',A,'-kernel')
2360436 FORMAT ('       Fast kernel with fixed radius- and dissipation classes ', &
2361                    'are used'/ &
2362            '          number of radius classes:       ',I3,'    interval ', &
2363                       '[1.0E-6,2.0E-4] m'/ &
2364            '          number of dissipation classes:   ',I2,'    interval ', &
2365                       '[0,1000] cm**2/s**3')
2366437 FORMAT ('    Droplet collision is switched off')
2367438 FORMAT (' --> Land surface type  : ',A,/ &
2368            ' --> Soil porosity type : ',A)
2369439 FORMAT (/'    Initial soil temperature and moisture profile:'// &
2370            '       Height:        ',A,'  m'/ &
2371            '       Temperature:   ',A,'  K'/ &
2372            '       Moisture:      ',A,'  m**3/m**3'/ &
2373            '       Root fraction: ',A,'  '/ &
2374            '       Gridpoint:     ',A)
2375440 FORMAT (' --> Soil bottom is closed (water content is conserved, default)')
2376441 FORMAT (' --> Soil bottom is open (water content is not conserved)')
2377444 FORMAT (//' Radiation model information:'/                                 &
2378              ' ----------------------------'/)
2379445 FORMAT (' --> Using constant net radiation: net_radiation = ', F6.2, '  W/m**2')
2380446 FORMAT (' --> Simple radiation scheme for clear sky is used (no clouds,',  &
2381                   ' default)')
2382447 FORMAT (' --> RRTMG scheme is used')
2383448 FORMAT (/'     User-specific surface albedo: albedo =', F6.3)
2384449 FORMAT  ('     Timestep: dt_radiation = ', F5.2, '  s')
2385
2386450 FORMAT (//' LES / Turbulence quantities:'/ &
2387              ' ---------------------------'/)
2388451 FORMAT ('    Diffusion coefficients are constant:'/ &
2389            '    Km = ',F6.2,' m**2/s   Kh = ',F6.2,' m**2/s   Pr = ',F5.2)
2390453 FORMAT ('    Mixing length is limited to',F5.2,' * z')
2391454 FORMAT ('    TKE is not allowed to fall below ',E9.2,' (m/s)**2')
2392455 FORMAT ('    initial TKE is prescribed as ',E9.2,' (m/s)**2')
2393456 FORMAT (/'    Albedo is set for land surface type: ', A)
2394457 FORMAT (/'    --> Albedo is fixed during the run')
2395458 FORMAT (/'    --> Longwave radiation is disabled')
2396459 FORMAT (/'    --> Shortwave radiation is disabled.')
2397470 FORMAT (//' Actions during the simulation:'/ &
2398              ' -----------------------------'/)
2399471 FORMAT ('    Disturbance impulse (u,v) every :   ',F6.2,' s'/            &
2400            '    Disturbance amplitude           :    ',F5.2, ' m/s'/       &
2401            '    Lower disturbance level         : ',F8.2,' m (GP ',I4,')'/  &
2402            '    Upper disturbance level         : ',F8.2,' m (GP ',I4,')')
2403472 FORMAT ('    Disturbances continued during the run from i/j =',I4, &
2404                 ' to i/j =',I4)
2405473 FORMAT ('    Disturbances cease as soon as the disturbance energy exceeds',&
2406                 F6.3, ' m**2/s**2')
2407474 FORMAT ('    Random number generator used    : ',A/)
2408475 FORMAT ('    The surface temperature is increased (or decreased, ', &
2409                 'respectively, if'/ &
2410            '    the value is negative) by ',F5.2,' K at the beginning of the',&
2411                 ' 3D-simulation'/)
2412476 FORMAT ('    The surface humidity is increased (or decreased, ',&
2413                 'respectively, if the'/ &
2414            '    value is negative) by ',E8.1,' kg/kg at the beginning of', &
2415                 ' the 3D-simulation'/)
2416477 FORMAT ('    The scalar value is increased at the surface (or decreased, ',&
2417                 'respectively, if the'/ &
2418            '    value is negative) by ',E8.1,' kg/m**3 at the beginning of', &
2419                 ' the 3D-simulation'/)
2420480 FORMAT ('    Particles:'/ &
2421            '    ---------'// &
2422            '       Particle advection is active (switched on at t = ', F7.1, &
2423                    ' s)'/ &
2424            '       Start of new particle generations every  ',F6.1,' s'/ &
2425            '       Boundary conditions: left/right: ', A, ' north/south: ', A/&
2426            '                            bottom:     ', A, ' top:         ', A/&
2427            '       Maximum particle age:                 ',F9.1,' s'/ &
2428            '       Advection stopped at t = ',F9.1,' s'/)
2429481 FORMAT ('       Particles have random start positions'/)
2430482 FORMAT ('          Particles are advected only horizontally'/)
2431483 FORMAT ('       Particles have tails with a maximum of ',I3,' points')
2432484 FORMAT ('            Number of tails of the total domain: ',I10/ &
2433            '            Minimum distance between tailpoints: ',F8.2,' m'/ &
2434            '            Maximum age of the end of the tail:  ',F8.2,' s')
2435485 FORMAT ('       Particle data are written on file every ', F9.1, ' s')
2436486 FORMAT ('       Particle statistics are written on file'/)
2437487 FORMAT ('       Number of particle groups: ',I2/)
2438488 FORMAT ('       SGS velocity components are used for particle advection'/ &
2439            '          minimum timestep for advection:', F8.5/)
2440489 FORMAT ('       Number of particles simultaneously released at each ', &
2441                    'point: ', I5/)
2442490 FORMAT ('       Particle group ',I2,':'/ &
2443            '          Particle radius: ',E10.3, 'm')
2444491 FORMAT ('          Particle inertia is activated'/ &
2445            '             density_ratio (rho_fluid/rho_particle) =',F6.3/)
2446492 FORMAT ('          Particles are advected only passively (no inertia)'/)
2447493 FORMAT ('          Boundaries of particle source: x:',F8.1,' - ',F8.1,' m'/&
2448            '                                         y:',F8.1,' - ',F8.1,' m'/&
2449            '                                         z:',F8.1,' - ',F8.1,' m'/&
2450            '          Particle distances:  dx = ',F8.1,' m  dy = ',F8.1, &
2451                       ' m  dz = ',F8.1,' m'/)
2452494 FORMAT ('       Output of particle time series in NetCDF format every ', &
2453                    F8.2,' s'/)
2454495 FORMAT ('       Number of particles in total domain: ',I10/)
2455496 FORMAT ('       Initial vertical particle positions are interpreted ', &
2456                    'as relative to the given topography')
2457500 FORMAT (//' 1D-Model parameters:'/                           &
2458              ' -------------------'//                           &
2459            '    Simulation time:                   ',F8.1,' s'/ &
2460            '    Run-controll output every:         ',F8.1,' s'/ &
2461            '    Vertical profile output every:     ',F8.1,' s'/ &
2462            '    Mixing length calculation:         ',A/         &
2463            '    Dissipation calculation:           ',A/)
2464502 FORMAT ('    Damping layer starts from ',F7.1,' m (GP ',I4,')'/)
2465503 FORMAT (' --> Momentum advection via Wicker-Skamarock-Scheme 5th order')
2466504 FORMAT (' --> Scalar advection via Wicker-Skamarock-Scheme 5th order')
2467505 FORMAT ('    Precipitation parameterization via Seifert-Beheng-Scheme')
2468506 FORMAT ('    Drizzle parameterization via Stokes law')
2469507 FORMAT ('    Turbulence effects on precipitation process')
2470508 FORMAT ('    Ventilation effects on evaporation of rain drops')
2471509 FORMAT ('    Slope limiter used for sedimentation process')
2472510 FORMAT ('    Droplet density    :   N_c   = ',F6.1,' 1/cm**3')
2473511 FORMAT ('    Sedimentation Courant number:                  '/&
2474            '                               C_s   =',F4.1,'        ')
2475512 FORMAT (/' Date:                 ',A8,6X,'Run:       ',A20/      &
2476            ' Time:                 ',A8,6X,'Run-No.:   ',I2.2/     &
2477            ' Run on host:        ',A10,6X,'En-No.:    ',I2.2)
2478513 FORMAT (' --> Scalar advection via Wicker-Skamarock-Scheme 5th order ' // & 
2479            '+ monotonic adjustment')
2480600 FORMAT (/' Nesting informations:'/ &
2481            ' --------------------'/ &
2482            ' Nesting mode:                     ',A/ &
2483            ' Nesting-datatransfer mode:        ',A// &
2484            ' Nest id  parent  number   lower left coordinates   name'/ &
2485            ' (*=me)     id    of PEs      x (m)     y (m)' )
2486601 FORMAT (2X,A1,1X,I2.2,6X,I2.2,5X,I5,5X,F8.2,2X,F8.2,5X,A)
2487
2488 END SUBROUTINE header
Note: See TracBrowser for help on using the repository browser.