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

Last change on this file since 2977 was 2967, checked in by raasch, 6 years ago

bugfix: missing parallel cpp-directives added

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