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

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

Particle reflections at downward-facing walls; revision of particle speed interpolations at walls; bugfixes in get_topography_index and in date constants

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