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

Last change on this file since 3226 was 3225, checked in by kanani, 6 years ago

Correct revision messages of last commit

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