source: palm/tags/release-5.0/SOURCE/header.f90 @ 4383

Last change on this file since 4383 was 2701, checked in by suehring, 6 years ago

changes from last commit documented

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