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

Last change on this file since 2898 was 2883, checked in by Giersch, 6 years ago

Format 325 of header output has been changed, dt_dopr_listing is not set to the default value zero anymore

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