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

Last change on this file since 1483 was 1483, checked in by raasch, 9 years ago

last commit documented

  • Property svn:keywords set to Id
File size: 82.6 KB
RevLine 
[1]1 SUBROUTINE header
2
[1036]3!--------------------------------------------------------------------------------!
4! This file is part of PALM.
5!
6! PALM is free software: you can redistribute it and/or modify it under the terms
7! of the GNU General Public License as published by the Free Software Foundation,
8! either version 3 of the License, or (at your option) any later 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!
[1310]17! Copyright 1997-2014 Leibniz Universitaet Hannover
[1036]18!--------------------------------------------------------------------------------!
19!
[254]20! Current revisions:
[1]21! -----------------
[1329]22!
[1483]23!
[1321]24! Former revisions:
25! -----------------
26! $Id: header.f90 1483 2014-10-18 12:51:13Z raasch $
27!
[1483]28! 1482 2014-10-18 12:34:45Z raasch
29! information about calculated or predefined virtual processor topology adjusted
30!
[1469]31! 1468 2014-09-24 14:06:57Z maronga
32! Adapted for use on up to 6-digit processor cores
33!
[1430]34! 1429 2014-07-15 12:53:45Z knoop
35! header exended to provide ensemble_member_nr if specified
36!
[1377]37! 1376 2014-04-26 11:21:22Z boeske
38! Correction of typos
39!
[1366]40! 1365 2014-04-22 15:03:56Z boeske
41! New section 'Large scale forcing and nudging':
42! output of large scale forcing and nudging information,
43! new section for initial profiles created
44!
[1360]45! 1359 2014-04-11 17:15:14Z hoffmann
46! dt_sort_particles removed
47!
[1354]48! 1353 2014-04-08 15:21:23Z heinze
49! REAL constants provided with KIND-attribute
50!
[1329]51! 1327 2014-03-21 11:00:16Z raasch
52! parts concerning iso2d and avs output removed,
53! -netcdf output queries
54!
[1325]55! 1324 2014-03-21 09:13:16Z suehring
56! Bugfix: module spectrum added
57!
[1323]58! 1322 2014-03-20 16:38:49Z raasch
59! REAL functions provided with KIND-attribute,
60! some REAL constants defined as wp-kind
61!
[1321]62! 1320 2014-03-20 08:40:49Z raasch
[1320]63! ONLY-attribute added to USE-statements,
64! kind-parameters added to all INTEGER and REAL declaration statements,
65! kinds are defined in new module kinds,
66! revision history before 2012 removed,
67! comment fields (!:) to be used for variable explanations added to
68! all variable declaration statements
[1321]69!
[1309]70! 1308 2014-03-13 14:58:42Z fricke
71! output of the fixed number of output time levels
72! output_format adjusted for masked data if netcdf_data_format > 5
73!
[1300]74! 1299 2014-03-06 13:15:21Z heinze
75! output for using large_scale subsidence in combination
76! with large_scale_forcing
77! reformatting, more detailed explanations
78!
[1242]79! 1241 2013-10-30 11:36:58Z heinze
80! output for nudging + large scale forcing from external file
81!
[1217]82! 1216 2013-08-26 09:31:42Z raasch
83! output for transpose_compute_overlap
84!
[1213]85! 1212 2013-08-15 08:46:27Z raasch
86! output for poisfft_hybrid removed
87!
[1182]88! 1179 2013-06-14 05:57:58Z raasch
89! output of reference_state, use_reference renamed use_single_reference_value
90!
[1160]91! 1159 2013-05-21 11:58:22Z fricke
92! +use_cmax
93!
[1116]94! 1115 2013-03-26 18:16:16Z hoffmann
95! descriptions for Seifert-Beheng-cloud-physics-scheme added
96!
[1112]97! 1111 2013-03-08 23:54:10Z raasch
98! output of accelerator board information
99! ibc_p_b = 2 removed
100!
[1109]101! 1108 2013-03-05 07:03:32Z raasch
102! bugfix for r1106
103!
[1107]104! 1106 2013-03-04 05:31:38Z raasch
105! some format changes for coupled runs
106!
[1093]107! 1092 2013-02-02 11:24:22Z raasch
108! unused variables removed
109!
[1037]110! 1036 2012-10-22 13:43:42Z raasch
111! code put under GPL (PALM 3.9)
112!
[1035]113! 1031 2012-10-19 14:35:30Z raasch
114! output of netCDF data format modified
115!
[1017]116! 1015 2012-09-27 09:23:24Z raasch
[1365]117! output of Adjustment of mixing length to the Prandtl mixing length at first
[1017]118! grid point above ground removed
119!
[1004]120! 1003 2012-09-14 14:35:53Z raasch
121! output of information about equal/unequal subdomain size removed
122!
[1002]123! 1001 2012-09-13 14:08:46Z raasch
124! all actions concerning leapfrog- and upstream-spline-scheme removed
125!
[979]126! 978 2012-08-09 08:28:32Z fricke
127! -km_damp_max, outflow_damping_width
128! +pt_damping_factor, pt_damping_width
129! +z0h
130!
[965]131! 964 2012-07-26 09:14:24Z raasch
132! output of profil-related quantities removed
133!
[941]134! 940 2012-07-09 14:31:00Z raasch
135! Output in case of simulations for pure neutral stratification (no pt-equation
136! solved)
137!
[928]138! 927 2012-06-06 19:15:04Z raasch
139! output of masking_method for mg-solver
140!
[869]141! 868 2012-03-28 12:21:07Z raasch
142! translation velocity in Galilean transformation changed to 0.6 * ug
143!
[834]144! 833 2012-02-22 08:55:55Z maronga
145! Adjusted format for leaf area density
146!
[829]147! 828 2012-02-21 12:00:36Z raasch
148! output of dissipation_classes + radius_classes
149!
[826]150! 825 2012-02-19 03:03:44Z raasch
151! Output of cloud physics parameters/quantities complemented and restructured
152!
[1]153! Revision 1.1  1997/08/11 06:17:20  raasch
154! Initial revision
155!
156!
157! Description:
158! ------------
159! Writing a header with all important informations about the actual run.
160! This subroutine is called three times, two times at the beginning
161! (writing information on files RUN_CONTROL and HEADER) and one time at the
162! end of the run, then writing additional information about CPU-usage on file
163! header.
[411]164!-----------------------------------------------------------------------------!
[1]165
[1320]166    USE arrays_3d,                                                             &
167        ONLY:  lad, pt_init, qsws, q_init, sa_init, shf, ug, vg, w_subs, zu
168       
[1]169    USE control_parameters
[1320]170       
171    USE cloud_parameters,                                                      &
172        ONLY:  cp, curvature_solution_effects, c_sedimentation,                &
173               limiter_sedimentation, l_v, nc_const, r_d, ventilation_effect
174       
175    USE cpulog,                                                                &
176        ONLY:  log_point_s
177       
178    USE dvrp_variables,                                                        &
179        ONLY:  use_seperate_pe_for_dvrp_output
180       
181    USE grid_variables,                                                        &
182        ONLY:  dx, dy
183       
184    USE indices,                                                               &
185        ONLY:  mg_loc_ind, nnx, nny, nnz, nx, ny, nxl_mg, nxr_mg, nyn_mg,      &
186               nys_mg, nzt, nzt_mg
187       
188    USE kinds
189   
190    USE model_1d,                                                              &
191        ONLY:  damp_level_ind_1d, dt_pr_1d, dt_run_control_1d, end_time_1d
192       
193    USE particle_attributes,                                                   &
194        ONLY:  bc_par_b, bc_par_lr, bc_par_ns, bc_par_t, collision_kernel,     &
195               density_ratio, dissipation_classes, dt_min_part, dt_prel,       &
[1359]196               dt_write_particle_data, end_time_prel,                          &
[1320]197               maximum_number_of_tailpoints, maximum_tailpoint_age,            &
198               minimum_tailpoint_distance, number_of_particle_groups,          &
199               particle_advection, particle_advection_start,                   &
200               particles_per_point, pdx, pdy, pdz,  psb, psl, psn, psr, pss,   &
201               pst, radius, radius_classes, random_start_position,             &
202               total_number_of_particles, use_particle_tails,                  &
203               use_sgs_for_particles, total_number_of_tails,                   &
204               vertical_particle_advection, write_particle_statistics
205       
[1]206    USE pegrid
[1324]207   
208    USE spectrum,                                                              &
209        ONLY:  comp_spectra_level, data_output_sp, plot_spectra_level,         &
210               spectra_direction
[1]211
212    IMPLICIT NONE
213
[1320]214    CHARACTER (LEN=1)  ::  prec                !:
215   
216    CHARACTER (LEN=2)  ::  do2d_mode           !:
217   
218    CHARACTER (LEN=5)  ::  section_chr         !:
219   
220    CHARACTER (LEN=10) ::  coor_chr            !:
221    CHARACTER (LEN=10) ::  host_chr            !:
222   
223    CHARACTER (LEN=16) ::  begin_chr           !:
224   
225    CHARACTER (LEN=26) ::  ver_rev             !:
226   
227    CHARACTER (LEN=40) ::  output_format       !:
228   
229    CHARACTER (LEN=70) ::  char1               !:
230    CHARACTER (LEN=70) ::  char2               !:
231    CHARACTER (LEN=70) ::  dopr_chr            !:
232    CHARACTER (LEN=70) ::  do2d_xy             !:
233    CHARACTER (LEN=70) ::  do2d_xz             !:
234    CHARACTER (LEN=70) ::  do2d_yz             !:
235    CHARACTER (LEN=70) ::  do3d_chr            !:
236    CHARACTER (LEN=70) ::  domask_chr          !:
237    CHARACTER (LEN=70) ::  run_classification  !:
238   
239    CHARACTER (LEN=85) ::  roben               !:
240    CHARACTER (LEN=85) ::  runten              !:
241   
242    CHARACTER (LEN=86) ::  coordinates         !:
243    CHARACTER (LEN=86) ::  gradients           !:
244    CHARACTER (LEN=86) ::  learde              !:
245    CHARACTER (LEN=86) ::  slices              !:
246    CHARACTER (LEN=86) ::  temperatures        !:
247    CHARACTER (LEN=86) ::  ugcomponent         !:
248    CHARACTER (LEN=86) ::  vgcomponent         !:
[1]249
[1320]250    CHARACTER (LEN=1), DIMENSION(1:3) ::  dir = (/ 'x', 'y', 'z' /)  !:
[410]251
[1320]252    INTEGER(iwp) ::  av        !:
253    INTEGER(iwp) ::  bh        !:
254    INTEGER(iwp) ::  blx       !:
255    INTEGER(iwp) ::  bly       !:
256    INTEGER(iwp) ::  bxl       !:
257    INTEGER(iwp) ::  bxr       !:
258    INTEGER(iwp) ::  byn       !:
259    INTEGER(iwp) ::  bys       !:
260    INTEGER(iwp) ::  ch        !:
261    INTEGER(iwp) ::  count     !:
262    INTEGER(iwp) ::  cwx       !:
263    INTEGER(iwp) ::  cwy       !:
264    INTEGER(iwp) ::  cxl       !:
265    INTEGER(iwp) ::  cxr       !:
266    INTEGER(iwp) ::  cyn       !:
267    INTEGER(iwp) ::  cys       !:
268    INTEGER(iwp) ::  dim       !:
269    INTEGER(iwp) ::  i         !:
270    INTEGER(iwp) ::  io        !:
271    INTEGER(iwp) ::  j         !:
272    INTEGER(iwp) ::  l         !:
273    INTEGER(iwp) ::  ll        !:
274    INTEGER(iwp) ::  mpi_type  !:
275   
276    REAL(wp) ::  cpuseconds_per_simulated_second  !:
[1]277
278!
279!-- Open the output file. At the end of the simulation, output is directed
280!-- to unit 19.
281    IF ( ( runnr == 0 .OR. force_print_header )  .AND. &
282         .NOT. simulated_time_at_begin /= simulated_time )  THEN
283       io = 15   !  header output on file RUN_CONTROL
284    ELSE
285       io = 19   !  header output on file HEADER
286    ENDIF
287    CALL check_open( io )
288
289!
290!-- At the end of the run, output file (HEADER) will be rewritten with
291!-- new informations
292    IF ( io == 19 .AND. simulated_time_at_begin /= simulated_time ) REWIND( 19 )
293
294!
295!-- Determine kind of model run
296    IF ( TRIM( initializing_actions ) == 'read_restart_data' )  THEN
297       run_classification = '3D - restart run'
[328]298    ELSEIF ( TRIM( initializing_actions ) == 'cyclic_fill' )  THEN
299       run_classification = '3D - run with cyclic fill of 3D - prerun data'
[147]300    ELSEIF ( INDEX( initializing_actions, 'set_constant_profiles' ) /= 0 )  THEN
301       run_classification = '3D - run without 1D - prerun'
[197]302    ELSEIF ( INDEX( initializing_actions, 'set_1d-model_profiles' ) /= 0 )  THEN
[147]303       run_classification = '3D - run with 1D - prerun'
[197]304    ELSEIF ( INDEX( initializing_actions, 'by_user' ) /=0 )  THEN
305       run_classification = '3D - run initialized by user'
[1]306    ELSE
[254]307       message_string = ' unknown action(s): ' // TRIM( initializing_actions )
308       CALL message( 'header', 'PA0191', 0, 0, 0, 6, 0 )
[1]309    ENDIF
[97]310    IF ( ocean )  THEN
311       run_classification = 'ocean - ' // run_classification
312    ELSE
313       run_classification = 'atmosphere - ' // run_classification
314    ENDIF
[1]315
316!
317!-- Run-identification, date, time, host
318    host_chr = host(1:10)
[75]319    ver_rev = TRIM( version ) // '  ' // TRIM( revision )
[102]320    WRITE ( io, 100 )  ver_rev, TRIM( run_classification )
[291]321    IF ( TRIM( coupling_mode ) /= 'uncoupled' )  THEN
322#if defined( __mpi2 )
323       mpi_type = 2
324#else
325       mpi_type = 1
326#endif
327       WRITE ( io, 101 )  mpi_type, coupling_mode
328    ENDIF
[1108]329#if defined( __parallel )
[1353]330    IF ( coupling_start_time /= 0.0_wp )  THEN
[1106]331       IF ( coupling_start_time > simulated_time_at_begin )  THEN
332          WRITE ( io, 109 )
333       ELSE
334          WRITE ( io, 114 )
335       ENDIF
336    ENDIF
[1108]337#endif
[1429]338    IF ( ensemble_member_nr /= 0 )  THEN
339       WRITE ( io, 512 )  run_date, run_identifier, run_time, runnr,           &
340                       ADJUSTR( host_chr ), ensemble_member_nr
341    ELSE
342       WRITE ( io, 102 )  run_date, run_identifier, run_time, runnr,           &
[102]343                       ADJUSTR( host_chr )
[1429]344    ENDIF
[1]345#if defined( __parallel )
[1482]346    IF ( npex == -1  .AND.  npey == -1 )  THEN
[1]347       char1 = 'calculated'
348    ELSE
349       char1 = 'predefined'
350    ENDIF
351    IF ( threads_per_task == 1 )  THEN
[102]352       WRITE ( io, 103 )  numprocs, pdims(1), pdims(2), TRIM( char1 )
[1]353    ELSE
[102]354       WRITE ( io, 104 )  numprocs*threads_per_task, numprocs, &
[1]355                          threads_per_task, pdims(1), pdims(2), TRIM( char1 )
356    ENDIF
[1111]357    IF ( num_acc_per_node /= 0 )  WRITE ( io, 117 )  num_acc_per_node   
[1]358    IF ( ( host(1:3) == 'ibm'  .OR.  host(1:3) == 'nec'  .OR.    &
359           host(1:2) == 'lc'   .OR.  host(1:3) == 'dec' )  .AND. &
360         npex == -1  .AND.  pdims(2) == 1 )                      &
361    THEN
[102]362       WRITE ( io, 106 )
[1]363    ELSEIF ( pdims(2) == 1 )  THEN
[102]364       WRITE ( io, 107 )  'x'
[1]365    ELSEIF ( pdims(1) == 1 )  THEN
[102]366       WRITE ( io, 107 )  'y'
[1]367    ENDIF
[102]368    IF ( use_seperate_pe_for_dvrp_output )  WRITE ( io, 105 )
[759]369    IF ( numprocs /= maximum_parallel_io_streams )  THEN
370       WRITE ( io, 108 )  maximum_parallel_io_streams
371    ENDIF
[1111]372#else
373    IF ( num_acc_per_node /= 0 )  WRITE ( io, 120 )  num_acc_per_node
[1]374#endif
375    WRITE ( io, 99 )
376
377!
378!-- Numerical schemes
379    WRITE ( io, 110 )
380    IF ( psolver(1:7) == 'poisfft' )  THEN
381       WRITE ( io, 111 )  TRIM( fft_method )
[1216]382       IF ( transpose_compute_overlap )  WRITE( io, 115 )
[1]383    ELSEIF ( psolver == 'sor' )  THEN
384       WRITE ( io, 112 )  nsor_ini, nsor, omega_sor
385    ELSEIF ( psolver == 'multigrid' )  THEN
386       WRITE ( io, 135 )  cycle_mg, maximum_grid_level, ngsrb
387       IF ( mg_cycles == -1 )  THEN
388          WRITE ( io, 140 )  residual_limit
389       ELSE
390          WRITE ( io, 141 )  mg_cycles
391       ENDIF
392       IF ( mg_switch_to_pe0_level == 0 )  THEN
393          WRITE ( io, 136 )  nxr_mg(1)-nxl_mg(1)+1, nyn_mg(1)-nys_mg(1)+1, &
394                             nzt_mg(1)
[197]395       ELSEIF (  mg_switch_to_pe0_level /= -1 )  THEN
[1]396          WRITE ( io, 137 )  mg_switch_to_pe0_level,            &
397                             mg_loc_ind(2,0)-mg_loc_ind(1,0)+1, &
398                             mg_loc_ind(4,0)-mg_loc_ind(3,0)+1, &
399                             nzt_mg(mg_switch_to_pe0_level),    &
400                             nxr_mg(1)-nxl_mg(1)+1, nyn_mg(1)-nys_mg(1)+1, &
401                             nzt_mg(1)
402       ENDIF
[927]403       IF ( masking_method )  WRITE ( io, 144 )
[1]404    ENDIF
405    IF ( call_psolver_at_all_substeps  .AND. timestep_scheme(1:5) == 'runge' ) &
406    THEN
407       WRITE ( io, 142 )
408    ENDIF
409
410    IF ( momentum_advec == 'pw-scheme' )  THEN
411       WRITE ( io, 113 )
[1299]412    ELSEIF (momentum_advec == 'ws-scheme' )  THEN
[667]413       WRITE ( io, 503 )
[1]414    ENDIF
415    IF ( scalar_advec == 'pw-scheme' )  THEN
416       WRITE ( io, 116 )
[667]417    ELSEIF ( scalar_advec == 'ws-scheme' )  THEN
418       WRITE ( io, 504 )
[1]419    ELSE
420       WRITE ( io, 118 )
421    ENDIF
[63]422
423    WRITE ( io, 139 )  TRIM( loop_optimization )
424
[1]425    IF ( galilei_transformation )  THEN
426       IF ( use_ug_for_galilei_tr )  THEN
[868]427          char1 = '0.6 * geostrophic wind'
[1]428       ELSE
429          char1 = 'mean wind in model domain'
430       ENDIF
431       IF ( simulated_time_at_begin == simulated_time )  THEN
432          char2 = 'at the start of the run'
433       ELSE
434          char2 = 'at the end of the run'
435       ENDIF
[1353]436       WRITE ( io, 119 )  TRIM( char1 ), TRIM( char2 ),                        &
437                          advected_distance_x/1000.0_wp,                       &
438                          advected_distance_y/1000.0_wp
[1]439    ENDIF
[1001]440    WRITE ( io, 122 )  timestep_scheme
[87]441    IF ( use_upstream_for_tke )  WRITE ( io, 143 )
[1353]442    IF ( rayleigh_damping_factor /= 0.0_wp )  THEN
[108]443       IF ( .NOT. ocean )  THEN
444          WRITE ( io, 123 )  'above', rayleigh_damping_height, &
445               rayleigh_damping_factor
446       ELSE
447          WRITE ( io, 123 )  'below', rayleigh_damping_height, &
448               rayleigh_damping_factor
449       ENDIF
[1]450    ENDIF
[940]451    IF ( neutral )  WRITE ( io, 131 )  pt_surface
[75]452    IF ( humidity )  THEN
[1]453       IF ( .NOT. cloud_physics )  THEN
454          WRITE ( io, 129 )
455       ELSE
456          WRITE ( io, 130 )
457       ENDIF
458    ENDIF
459    IF ( passive_scalar )  WRITE ( io, 134 )
[240]460    IF ( conserve_volume_flow )  THEN
[241]461       WRITE ( io, 150 )  conserve_volume_flow_mode
462       IF ( TRIM( conserve_volume_flow_mode ) == 'bulk_velocity' )  THEN
463          WRITE ( io, 151 )  u_bulk, v_bulk
464       ENDIF
[240]465    ELSEIF ( dp_external )  THEN
466       IF ( dp_smooth )  THEN
[241]467          WRITE ( io, 152 )  dpdxy, dp_level_b, ', vertically smoothed.'
[240]468       ELSE
[241]469          WRITE ( io, 152 )  dpdxy, dp_level_b, '.'
[240]470       ENDIF
471    ENDIF
[1]472    WRITE ( io, 99 )
473
474!
475!-- Runtime and timestep informations
476    WRITE ( io, 200 )
477    IF ( .NOT. dt_fixed )  THEN
478       WRITE ( io, 201 )  dt_max, cfl_factor
479    ELSE
480       WRITE ( io, 202 )  dt
481    ENDIF
482    WRITE ( io, 203 )  simulated_time_at_begin, end_time
483
[1322]484    IF ( time_restart /= 9999999.9_wp  .AND. &
[1]485         simulated_time_at_begin == simulated_time )  THEN
[1322]486       IF ( dt_restart == 9999999.9_wp )  THEN
[1]487          WRITE ( io, 204 )  ' Restart at:       ',time_restart
488       ELSE
489          WRITE ( io, 205 )  ' Restart at:       ',time_restart, dt_restart
490       ENDIF
491    ENDIF
492
493    IF ( simulated_time_at_begin /= simulated_time )  THEN
494       i = MAX ( log_point_s(10)%counts, 1 )
[1353]495       IF ( ( simulated_time - simulated_time_at_begin ) == 0.0_wp )  THEN
496          cpuseconds_per_simulated_second = 0.0_wp
[1]497       ELSE
498          cpuseconds_per_simulated_second = log_point_s(10)%sum / &
499                                            ( simulated_time -    &
500                                              simulated_time_at_begin )
501       ENDIF
[1322]502       WRITE ( io, 206 )  simulated_time, log_point_s(10)%sum,      &
503                          log_point_s(10)%sum / REAL( i, KIND=wp ), &
[1]504                          cpuseconds_per_simulated_second
[1322]505       IF ( time_restart /= 9999999.9_wp  .AND.  time_restart < end_time )  THEN
506          IF ( dt_restart == 9999999.9_wp )  THEN
[1106]507             WRITE ( io, 204 )  ' Next restart at:     ',time_restart
[1]508          ELSE
[1106]509             WRITE ( io, 205 )  ' Next restart at:     ',time_restart, dt_restart
[1]510          ENDIF
511       ENDIF
512    ENDIF
513
[1324]514
[1]515!
[291]516!-- Start time for coupled runs, if independent precursor runs for atmosphere
[1106]517!-- and ocean are used or have been used. In this case, coupling_start_time
518!-- defines the time when the coupling is switched on.
[1353]519    IF ( coupling_start_time /= 0.0_wp )  THEN
[1106]520       WRITE ( io, 207 )  coupling_start_time
[291]521    ENDIF
522
523!
[1]524!-- Computational grid
[94]525    IF ( .NOT. ocean )  THEN
526       WRITE ( io, 250 )  dx, dy, dz, (nx+1)*dx, (ny+1)*dy, zu(nzt+1)
527       IF ( dz_stretch_level_index < nzt+1 )  THEN
528          WRITE ( io, 252 )  dz_stretch_level, dz_stretch_level_index, &
529                             dz_stretch_factor, dz_max
530       ENDIF
531    ELSE
532       WRITE ( io, 250 )  dx, dy, dz, (nx+1)*dx, (ny+1)*dy, zu(0)
533       IF ( dz_stretch_level_index > 0 )  THEN
534          WRITE ( io, 252 )  dz_stretch_level, dz_stretch_level_index, &
535                             dz_stretch_factor, dz_max
536       ENDIF
[1]537    ENDIF
538    WRITE ( io, 254 )  nx, ny, nzt+1, MIN( nnx, nx+1 ), MIN( nny, ny+1 ), &
539                       MIN( nnz+2, nzt+2 )
540    IF ( sloping_surface )  WRITE ( io, 260 )  alpha_surface
541
542!
[1365]543!-- Large scale forcing and nudging
544    WRITE ( io, 160 )
545    IF ( large_scale_forcing )  THEN
546       WRITE ( io, 162 )
547       WRITE ( io, 163 )
548
549       IF ( large_scale_subsidence )  THEN
550          IF ( .NOT. use_subsidence_tendencies )  THEN
551             WRITE ( io, 164 )
552          ELSE
553             WRITE ( io, 165 )
554          ENDIF
555       ENDIF
556
557       IF ( bc_pt_b == 'dirichlet' )  THEN
558          WRITE ( io, 180 )
559       ELSEIF ( bc_pt_b == 'neumann' )  THEN
560          WRITE ( io, 181 )
561       ENDIF
562
563       IF ( bc_q_b == 'dirichlet' )  THEN
564          WRITE ( io, 182 )
565       ELSEIF ( bc_q_b == 'neumann' )  THEN
566          WRITE ( io, 183 )
567       ENDIF
568
569       WRITE ( io, 167 )
570       IF ( nudging )  THEN
571          WRITE ( io, 170 )
572       ENDIF
573    ELSE
574       WRITE ( io, 161 )
575       WRITE ( io, 171 )
576    ENDIF
577    IF ( large_scale_subsidence )  THEN
578       WRITE ( io, 168 )
579       WRITE ( io, 169 )
580    ENDIF
581
582!
583!-- Profile for the large scale vertial velocity
584!-- Building output strings, starting with surface value
585    IF ( large_scale_subsidence )  THEN
586       temperatures = '   0.0'
587       gradients = '------'
588       slices = '     0'
589       coordinates = '   0.0'
590       i = 1
591       DO  WHILE ( subs_vertical_gradient_level_i(i) /= -9999 )
592
593          WRITE (coor_chr,'(E10.2,7X)')  &
594                                w_subs(subs_vertical_gradient_level_i(i))
595          temperatures = TRIM( temperatures ) // ' ' // TRIM( coor_chr )
596
597          WRITE (coor_chr,'(E10.2,7X)')  subs_vertical_gradient(i)
598          gradients = TRIM( gradients ) // ' ' // TRIM( coor_chr )
599
600          WRITE (coor_chr,'(I10,7X)')  subs_vertical_gradient_level_i(i)
601          slices = TRIM( slices ) // ' ' // TRIM( coor_chr )
602
603          WRITE (coor_chr,'(F10.2,7X)')  subs_vertical_gradient_level(i)
604          coordinates = TRIM( coordinates ) // ' '  // TRIM( coor_chr )
605
606          IF ( i == 10 )  THEN
607             EXIT
608          ELSE
609             i = i + 1
610          ENDIF
611
612       ENDDO
613
614 
615       IF ( .NOT. large_scale_forcing )  THEN
616          WRITE ( io, 426 )  TRIM( coordinates ), TRIM( temperatures ), &
617                             TRIM( gradients ), TRIM( slices )
618       ENDIF
619
620
621    ENDIF
622
623!-- Profile of the geostrophic wind (component ug)
624!-- Building output strings
625    WRITE ( ugcomponent, '(F6.2)' )  ug_surface
626    gradients = '------'
627    slices = '     0'
628    coordinates = '   0.0'
629    i = 1
630    DO  WHILE ( ug_vertical_gradient_level_ind(i) /= -9999 )
631     
632       WRITE (coor_chr,'(F6.2,1X)')  ug(ug_vertical_gradient_level_ind(i))
633       ugcomponent = TRIM( ugcomponent ) // '  ' // TRIM( coor_chr )
634
635       WRITE (coor_chr,'(F6.2,1X)')  ug_vertical_gradient(i)
636       gradients = TRIM( gradients ) // '  ' // TRIM( coor_chr )
637
638       WRITE (coor_chr,'(I6,1X)')  ug_vertical_gradient_level_ind(i)
639       slices = TRIM( slices ) // '  ' // TRIM( coor_chr )
640
641       WRITE (coor_chr,'(F6.1,1X)')  ug_vertical_gradient_level(i)
642       coordinates = TRIM( coordinates ) // '  ' // TRIM( coor_chr )
643
644       IF ( i == 10 )  THEN
645          EXIT
646       ELSE
647          i = i + 1
648       ENDIF
649
650    ENDDO
651
652    IF ( .NOT. large_scale_forcing )  THEN
653       WRITE ( io, 423 )  TRIM( coordinates ), TRIM( ugcomponent ), &
654                          TRIM( gradients ), TRIM( slices )
655    ENDIF
656
657!-- Profile of the geostrophic wind (component vg)
658!-- Building output strings
659    WRITE ( vgcomponent, '(F6.2)' )  vg_surface
660    gradients = '------'
661    slices = '     0'
662    coordinates = '   0.0'
663    i = 1
664    DO  WHILE ( vg_vertical_gradient_level_ind(i) /= -9999 )
665
666       WRITE (coor_chr,'(F6.2,1X)')  vg(vg_vertical_gradient_level_ind(i))
667       vgcomponent = TRIM( vgcomponent ) // '  ' // TRIM( coor_chr )
668
669       WRITE (coor_chr,'(F6.2,1X)')  vg_vertical_gradient(i)
670       gradients = TRIM( gradients ) // '  ' // TRIM( coor_chr )
671
672       WRITE (coor_chr,'(I6,1X)')  vg_vertical_gradient_level_ind(i)
673       slices = TRIM( slices ) // '  ' // TRIM( coor_chr )
674
675       WRITE (coor_chr,'(F6.1,1X)')  vg_vertical_gradient_level(i)
676       coordinates = TRIM( coordinates ) // '  ' // TRIM( coor_chr )
677
678       IF ( i == 10 )  THEN
679          EXIT
680       ELSE
681          i = i + 1
682       ENDIF
683 
684    ENDDO
685
686    IF ( .NOT. large_scale_forcing )  THEN
687       WRITE ( io, 424 )  TRIM( coordinates ), TRIM( vgcomponent ), &
688                          TRIM( gradients ), TRIM( slices )
689    ENDIF
690
691!
[1]692!-- Topography
693    WRITE ( io, 270 )  topography
694    SELECT CASE ( TRIM( topography ) )
695
696       CASE ( 'flat' )
697          ! no actions necessary
698
699       CASE ( 'single_building' )
700          blx = INT( building_length_x / dx )
701          bly = INT( building_length_y / dy )
702          bh  = INT( building_height / dz )
703
[1322]704          IF ( building_wall_left == 9999999.9_wp )  THEN
[1]705             building_wall_left = ( nx + 1 - blx ) / 2 * dx
706          ENDIF
[1353]707          bxl = INT ( building_wall_left / dx + 0.5_wp )
[1]708          bxr = bxl + blx
709
[1322]710          IF ( building_wall_south == 9999999.9_wp )  THEN
[1]711             building_wall_south = ( ny + 1 - bly ) / 2 * dy
712          ENDIF
[1353]713          bys = INT ( building_wall_south / dy + 0.5_wp )
[1]714          byn = bys + bly
715
716          WRITE ( io, 271 )  building_length_x, building_length_y, &
717                             building_height, bxl, bxr, bys, byn
718
[240]719       CASE ( 'single_street_canyon' )
720          ch  = NINT( canyon_height / dz )
[1322]721          IF ( canyon_width_x /= 9999999.9_wp )  THEN
[240]722!
723!--          Street canyon in y direction
724             cwx = NINT( canyon_width_x / dx )
[1322]725             IF ( canyon_wall_left == 9999999.9_wp )  THEN
[240]726                canyon_wall_left = ( nx + 1 - cwx ) / 2 * dx
727             ENDIF
728             cxl = NINT( canyon_wall_left / dx )
729             cxr = cxl + cwx
730             WRITE ( io, 272 )  'y', canyon_height, ch, 'u', cxl, cxr
731
[1322]732          ELSEIF ( canyon_width_y /= 9999999.9_wp )  THEN
[240]733!
734!--          Street canyon in x direction
735             cwy = NINT( canyon_width_y / dy )
[1322]736             IF ( canyon_wall_south == 9999999.9_wp )  THEN
[240]737                canyon_wall_south = ( ny + 1 - cwy ) / 2 * dy
738             ENDIF
739             cys = NINT( canyon_wall_south / dy )
740             cyn = cys + cwy
741             WRITE ( io, 272 )  'x', canyon_height, ch, 'v', cys, cyn
742          ENDIF
743
[1]744    END SELECT
745
[256]746    IF ( TRIM( topography ) /= 'flat' )  THEN
747       IF ( TRIM( topography_grid_convention ) == ' ' )  THEN
748          IF ( TRIM( topography ) == 'single_building' .OR.  &
749               TRIM( topography ) == 'single_street_canyon' )  THEN
750             WRITE ( io, 278 )
751          ELSEIF ( TRIM( topography ) == 'read_from_file' )  THEN
752             WRITE ( io, 279 )
753          ENDIF
754       ELSEIF ( TRIM( topography_grid_convention ) == 'cell_edge' )  THEN
755          WRITE ( io, 278 )
756       ELSEIF ( TRIM( topography_grid_convention ) == 'cell_center' )  THEN
757          WRITE ( io, 279 )
758       ENDIF
759    ENDIF
760
[1299]761    IF ( plant_canopy )  THEN
[138]762
763       WRITE ( io, 280 ) canopy_mode, pch_index, drag_coefficient
[1299]764       IF ( passive_scalar )  THEN
[153]765          WRITE ( io, 281 ) scalar_exchange_coefficient,   &
766                            leaf_surface_concentration
767       ENDIF
[138]768
[1]769!
[153]770!--    Heat flux at the top of vegetation
771       WRITE ( io, 282 ) cthf
772
773!
[138]774!--    Leaf area density profile
775!--    Building output strings, starting with surface value
[833]776       WRITE ( learde, '(F6.4)' )  lad_surface
[138]777       gradients = '------'
778       slices = '     0'
779       coordinates = '   0.0'
780       i = 1
781       DO  WHILE ( lad_vertical_gradient_level_ind(i) /= -9999 )
782
783          WRITE (coor_chr,'(F7.2)')  lad(lad_vertical_gradient_level_ind(i))
784          learde = TRIM( learde ) // ' ' // TRIM( coor_chr )
785
786          WRITE (coor_chr,'(F7.2)')  lad_vertical_gradient(i)
787          gradients = TRIM( gradients ) // ' ' // TRIM( coor_chr )
788
789          WRITE (coor_chr,'(I7)')  lad_vertical_gradient_level_ind(i)
790          slices = TRIM( slices ) // ' ' // TRIM( coor_chr )
791
792          WRITE (coor_chr,'(F7.1)')  lad_vertical_gradient_level(i)
793          coordinates = TRIM( coordinates ) // ' '  // TRIM( coor_chr )
794
795          i = i + 1
796       ENDDO
797
[153]798       WRITE ( io, 283 )  TRIM( coordinates ), TRIM( learde ), &
[138]799                          TRIM( gradients ), TRIM( slices )
800
801    ENDIF
802
803!
[1]804!-- Boundary conditions
805    IF ( ibc_p_b == 0 )  THEN
806       runten = 'p(0)     = 0      |'
807    ELSEIF ( ibc_p_b == 1 )  THEN
808       runten = 'p(0)     = p(1)   |'
809    ENDIF
810    IF ( ibc_p_t == 0 )  THEN
811       roben  = 'p(nzt+1) = 0      |'
812    ELSE
813       roben  = 'p(nzt+1) = p(nzt) |'
814    ENDIF
815
816    IF ( ibc_uv_b == 0 )  THEN
817       runten = TRIM( runten ) // ' uv(0)     = -uv(1)                |'
818    ELSE
819       runten = TRIM( runten ) // ' uv(0)     = uv(1)                 |'
820    ENDIF
[132]821    IF ( TRIM( bc_uv_t ) == 'dirichlet_0' )  THEN
822       roben  = TRIM( roben  ) // ' uv(nzt+1) = 0                     |'
823    ELSEIF ( ibc_uv_t == 0 )  THEN
[1]824       roben  = TRIM( roben  ) // ' uv(nzt+1) = ug(nzt+1), vg(nzt+1)  |'
825    ELSE
826       roben  = TRIM( roben  ) // ' uv(nzt+1) = uv(nzt)               |'
827    ENDIF
828
829    IF ( ibc_pt_b == 0 )  THEN
830       runten = TRIM( runten ) // ' pt(0)   = pt_surface'
[102]831    ELSEIF ( ibc_pt_b == 1 )  THEN
[1]832       runten = TRIM( runten ) // ' pt(0)   = pt(1)'
[102]833    ELSEIF ( ibc_pt_b == 2 )  THEN
834       runten = TRIM( runten ) // ' pt(0) = from coupled model'
[1]835    ENDIF
836    IF ( ibc_pt_t == 0 )  THEN
[19]837       roben  = TRIM( roben  ) // ' pt(nzt+1) = pt_top'
838    ELSEIF( ibc_pt_t == 1 )  THEN
839       roben  = TRIM( roben  ) // ' pt(nzt+1) = pt(nzt)'
840    ELSEIF( ibc_pt_t == 2 )  THEN
841       roben  = TRIM( roben  ) // ' pt(nzt+1) = pt(nzt) + dpt/dz_ini'
[667]842
[1]843    ENDIF
844
845    WRITE ( io, 300 )  runten, roben
846
847    IF ( .NOT. constant_diffusion )  THEN
848       IF ( ibc_e_b == 1 )  THEN
849          runten = 'e(0)     = e(1)'
850       ELSE
851          runten = 'e(0)     = e(1) = (u*/0.1)**2'
852       ENDIF
853       roben = 'e(nzt+1) = e(nzt) = e(nzt-1)'
854
[97]855       WRITE ( io, 301 )  'e', runten, roben       
[1]856
857    ENDIF
858
[97]859    IF ( ocean )  THEN
860       runten = 'sa(0)    = sa(1)'
861       IF ( ibc_sa_t == 0 )  THEN
862          roben =  'sa(nzt+1) = sa_surface'
[1]863       ELSE
[97]864          roben =  'sa(nzt+1) = sa(nzt)'
[1]865       ENDIF
[97]866       WRITE ( io, 301 ) 'sa', runten, roben
867    ENDIF
[1]868
[97]869    IF ( humidity )  THEN
870       IF ( ibc_q_b == 0 )  THEN
871          runten = 'q(0)     = q_surface'
872       ELSE
873          runten = 'q(0)     = q(1)'
874       ENDIF
875       IF ( ibc_q_t == 0 )  THEN
876          roben =  'q(nzt)   = q_top'
877       ELSE
878          roben =  'q(nzt)   = q(nzt-1) + dq/dz'
879       ENDIF
880       WRITE ( io, 301 ) 'q', runten, roben
881    ENDIF
[1]882
[97]883    IF ( passive_scalar )  THEN
884       IF ( ibc_q_b == 0 )  THEN
885          runten = 's(0)     = s_surface'
886       ELSE
887          runten = 's(0)     = s(1)'
888       ENDIF
889       IF ( ibc_q_t == 0 )  THEN
890          roben =  's(nzt)   = s_top'
891       ELSE
892          roben =  's(nzt)   = s(nzt-1) + ds/dz'
893       ENDIF
894       WRITE ( io, 301 ) 's', runten, roben
[1]895    ENDIF
896
897    IF ( use_surface_fluxes )  THEN
898       WRITE ( io, 303 )
899       IF ( constant_heatflux )  THEN
[1299]900          IF ( large_scale_forcing .AND. lsf_surf )  THEN
[1241]901             WRITE ( io, 306 )  shf(0,0)
902          ELSE
903             WRITE ( io, 306 )  surface_heatflux
904          ENDIF
[1]905          IF ( random_heatflux )  WRITE ( io, 307 )
906       ENDIF
[75]907       IF ( humidity  .AND.  constant_waterflux )  THEN
[1299]908          IF ( large_scale_forcing .AND. lsf_surf )  THEN
[1241]909             WRITE ( io, 311 ) qsws(0,0)
910          ELSE
911             WRITE ( io, 311 ) surface_waterflux
912          ENDIF
[1]913       ENDIF
914       IF ( passive_scalar  .AND.  constant_waterflux )  THEN
915          WRITE ( io, 313 ) surface_waterflux
916       ENDIF
917    ENDIF
918
[19]919    IF ( use_top_fluxes )  THEN
920       WRITE ( io, 304 )
[102]921       IF ( coupling_mode == 'uncoupled' )  THEN
[151]922          WRITE ( io, 320 )  top_momentumflux_u, top_momentumflux_v
[102]923          IF ( constant_top_heatflux )  THEN
924             WRITE ( io, 306 )  top_heatflux
925          ENDIF
926       ELSEIF ( coupling_mode == 'ocean_to_atmosphere' )  THEN
927          WRITE ( io, 316 )
[19]928       ENDIF
[97]929       IF ( ocean  .AND.  constant_top_salinityflux )  THEN
930          WRITE ( io, 309 )  top_salinityflux
931       ENDIF
[75]932       IF ( humidity  .OR.  passive_scalar )  THEN
[19]933          WRITE ( io, 315 )
934       ENDIF
935    ENDIF
936
[1]937    IF ( prandtl_layer )  THEN
[978]938       WRITE ( io, 305 )  (zu(1)-zu(0)), roughness_length, &
939                          z0h_factor*roughness_length, kappa, &
[94]940                          rif_min, rif_max
[1]941       IF ( .NOT. constant_heatflux )  WRITE ( io, 308 )
[75]942       IF ( humidity  .AND.  .NOT. constant_waterflux )  THEN
[1]943          WRITE ( io, 312 )
944       ENDIF
945       IF ( passive_scalar  .AND.  .NOT. constant_waterflux )  THEN
946          WRITE ( io, 314 )
947       ENDIF
948    ELSE
949       IF ( INDEX(initializing_actions, 'set_1d-model_profiles') /= 0 )  THEN
950          WRITE ( io, 310 )  rif_min, rif_max
951       ENDIF
952    ENDIF
953
954    WRITE ( io, 317 )  bc_lr, bc_ns
[707]955    IF ( .NOT. bc_lr_cyc  .OR.  .NOT. bc_ns_cyc )  THEN
[1159]956       WRITE ( io, 318 )  use_cmax, pt_damping_width, pt_damping_factor       
[151]957       IF ( turbulent_inflow )  THEN
958          WRITE ( io, 319 )  recycling_width, recycling_plane, &
959                             inflow_damping_height, inflow_damping_width
960       ENDIF
[1]961    ENDIF
962
963!
[1365]964!-- Initial Profiles
965    WRITE ( io, 321 )
966!
967!-- Initial wind profiles
968    IF ( u_profile(1) /= 9999999.9_wp )  WRITE ( io, 427 )
969
970!
971!-- Initial temperature profile
972!-- Building output strings, starting with surface temperature
973    WRITE ( temperatures, '(F6.2)' )  pt_surface
974    gradients = '------'
975    slices = '     0'
976    coordinates = '   0.0'
977    i = 1
978    DO  WHILE ( pt_vertical_gradient_level_ind(i) /= -9999 )
979
980       WRITE (coor_chr,'(F7.2)')  pt_init(pt_vertical_gradient_level_ind(i))
981       temperatures = TRIM( temperatures ) // ' ' // TRIM( coor_chr )
982
983       WRITE (coor_chr,'(F7.2)')  pt_vertical_gradient(i)
984       gradients = TRIM( gradients ) // ' ' // TRIM( coor_chr )
985
986       WRITE (coor_chr,'(I7)')  pt_vertical_gradient_level_ind(i)
987       slices = TRIM( slices ) // ' ' // TRIM( coor_chr )
988
989       WRITE (coor_chr,'(F7.1)')  pt_vertical_gradient_level(i)
990       coordinates = TRIM( coordinates ) // ' '  // TRIM( coor_chr )
991
992       IF ( i == 10 )  THEN
993          EXIT
994       ELSE
995          i = i + 1
996       ENDIF
997
998    ENDDO
999
1000    IF ( .NOT. nudging )  THEN
1001       WRITE ( io, 420 )  TRIM( coordinates ), TRIM( temperatures ), &
1002                          TRIM( gradients ), TRIM( slices )
1003    ELSE
1004       WRITE ( io, 428 ) 
1005    ENDIF
1006
1007!
1008!-- Initial humidity profile
1009!-- Building output strings, starting with surface humidity
1010    IF ( humidity  .OR.  passive_scalar )  THEN
1011       WRITE ( temperatures, '(E8.1)' )  q_surface
1012       gradients = '--------'
1013       slices = '       0'
1014       coordinates = '     0.0'
1015       i = 1
1016       DO  WHILE ( q_vertical_gradient_level_ind(i) /= -9999 )
1017         
1018          WRITE (coor_chr,'(E8.1,4X)')  q_init(q_vertical_gradient_level_ind(i))
1019          temperatures = TRIM( temperatures ) // '  ' // TRIM( coor_chr )
1020
1021          WRITE (coor_chr,'(E8.1,4X)')  q_vertical_gradient(i)
1022          gradients = TRIM( gradients ) // '  ' // TRIM( coor_chr )
1023         
1024          WRITE (coor_chr,'(I8,4X)')  q_vertical_gradient_level_ind(i)
1025          slices = TRIM( slices ) // '  ' // TRIM( coor_chr )
1026         
1027          WRITE (coor_chr,'(F8.1,4X)')  q_vertical_gradient_level(i)
1028          coordinates = TRIM( coordinates ) // '  '  // TRIM( coor_chr )
1029
1030          IF ( i == 10 )  THEN
1031             EXIT
1032          ELSE
1033             i = i + 1
1034          ENDIF
1035
1036       ENDDO
1037
1038       IF ( humidity )  THEN
1039          IF ( .NOT. nudging )  THEN
1040             WRITE ( io, 421 )  TRIM( coordinates ), TRIM( temperatures ), &
1041                                TRIM( gradients ), TRIM( slices )
1042          ENDIF
1043       ELSE
1044          WRITE ( io, 422 )  TRIM( coordinates ), TRIM( temperatures ), &
1045                             TRIM( gradients ), TRIM( slices )
1046       ENDIF
1047    ENDIF
1048
1049!
1050!-- Initial salinity profile
1051!-- Building output strings, starting with surface salinity
1052    IF ( ocean )  THEN
1053       WRITE ( temperatures, '(F6.2)' )  sa_surface
1054       gradients = '------'
1055       slices = '     0'
1056       coordinates = '   0.0'
1057       i = 1
1058       DO  WHILE ( sa_vertical_gradient_level_ind(i) /= -9999 )
1059
1060          WRITE (coor_chr,'(F7.2)')  sa_init(sa_vertical_gradient_level_ind(i))
1061          temperatures = TRIM( temperatures ) // ' ' // TRIM( coor_chr )
1062
1063          WRITE (coor_chr,'(F7.2)')  sa_vertical_gradient(i)
1064          gradients = TRIM( gradients ) // ' ' // TRIM( coor_chr )
1065
1066          WRITE (coor_chr,'(I7)')  sa_vertical_gradient_level_ind(i)
1067          slices = TRIM( slices ) // ' ' // TRIM( coor_chr )
1068
1069          WRITE (coor_chr,'(F7.1)')  sa_vertical_gradient_level(i)
1070          coordinates = TRIM( coordinates ) // ' '  // TRIM( coor_chr )
1071
1072          IF ( i == 10 )  THEN
1073             EXIT
1074          ELSE
1075             i = i + 1
1076          ENDIF
1077
1078       ENDDO
1079
1080       WRITE ( io, 425 )  TRIM( coordinates ), TRIM( temperatures ), &
1081                          TRIM( gradients ), TRIM( slices )
1082    ENDIF
1083
1084
1085!
[1]1086!-- Listing of 1D-profiles
[151]1087    WRITE ( io, 325 )  dt_dopr_listing
[1353]1088    IF ( averaging_interval_pr /= 0.0_wp )  THEN
[151]1089       WRITE ( io, 326 )  averaging_interval_pr, dt_averaging_input_pr
[1]1090    ENDIF
1091
1092!
1093!-- DATA output
1094    WRITE ( io, 330 )
[1353]1095    IF ( averaging_interval_pr /= 0.0_wp )  THEN
[151]1096       WRITE ( io, 326 )  averaging_interval_pr, dt_averaging_input_pr
[1]1097    ENDIF
1098
1099!
1100!-- 1D-profiles
[346]1101    dopr_chr = 'Profile:'
[1]1102    IF ( dopr_n /= 0 )  THEN
1103       WRITE ( io, 331 )
1104
1105       output_format = ''
[1327]1106       output_format = output_format_netcdf
[292]1107       WRITE ( io, 344 )  output_format
[1]1108
1109       DO  i = 1, dopr_n
1110          dopr_chr = TRIM( dopr_chr ) // ' ' // TRIM( data_output_pr(i) ) // ','
1111          IF ( LEN_TRIM( dopr_chr ) >= 60 )  THEN
1112             WRITE ( io, 332 )  dopr_chr
1113             dopr_chr = '       :'
1114          ENDIF
1115       ENDDO
1116
1117       IF ( dopr_chr /= '' )  THEN
1118          WRITE ( io, 332 )  dopr_chr
1119       ENDIF
1120       WRITE ( io, 333 )  dt_dopr, averaging_interval_pr, dt_averaging_input_pr
[1353]1121       IF ( skip_time_dopr /= 0.0_wp )  WRITE ( io, 339 )  skip_time_dopr
[1]1122    ENDIF
1123
1124!
1125!-- 2D-arrays
1126    DO  av = 0, 1
1127
1128       i = 1
1129       do2d_xy = ''
1130       do2d_xz = ''
1131       do2d_yz = ''
1132       DO  WHILE ( do2d(av,i) /= ' ' )
1133
1134          l = MAX( 2, LEN_TRIM( do2d(av,i) ) )
1135          do2d_mode = do2d(av,i)(l-1:l)
1136
1137          SELECT CASE ( do2d_mode )
1138             CASE ( 'xy' )
1139                ll = LEN_TRIM( do2d_xy )
1140                do2d_xy = do2d_xy(1:ll) // ' ' // do2d(av,i)(1:l-3) // ','
1141             CASE ( 'xz' )
1142                ll = LEN_TRIM( do2d_xz )
1143                do2d_xz = do2d_xz(1:ll) // ' ' // do2d(av,i)(1:l-3) // ','
1144             CASE ( 'yz' )
1145                ll = LEN_TRIM( do2d_yz )
1146                do2d_yz = do2d_yz(1:ll) // ' ' // do2d(av,i)(1:l-3) // ','
1147          END SELECT
1148
1149          i = i + 1
1150
1151       ENDDO
1152
1153       IF ( ( ( do2d_xy /= ''  .AND.  section(1,1) /= -9999 )  .OR.    &
1154              ( do2d_xz /= ''  .AND.  section(1,2) /= -9999 )  .OR.    &
[1327]1155              ( do2d_yz /= ''  .AND.  section(1,3) /= -9999 ) ) )  THEN
[1]1156
1157          IF (  av == 0 )  THEN
1158             WRITE ( io, 334 )  ''
1159          ELSE
1160             WRITE ( io, 334 )  '(time-averaged)'
1161          ENDIF
1162
1163          IF ( do2d_at_begin )  THEN
1164             begin_chr = 'and at the start'
1165          ELSE
1166             begin_chr = ''
1167          ENDIF
1168
1169          output_format = ''
[1327]1170          output_format = output_format_netcdf
[292]1171          WRITE ( io, 344 )  output_format
[1]1172
1173          IF ( do2d_xy /= ''  .AND.  section(1,1) /= -9999 )  THEN
1174             i = 1
1175             slices = '/'
1176             coordinates = '/'
1177!
1178!--          Building strings with index and coordinate informations of the
1179!--          slices
1180             DO  WHILE ( section(i,1) /= -9999 )
1181
1182                WRITE (section_chr,'(I5)')  section(i,1)
1183                section_chr = ADJUSTL( section_chr )
1184                slices = TRIM( slices ) // TRIM( section_chr ) // '/'
1185
[206]1186                IF ( section(i,1) == -1 )  THEN
[1353]1187                   WRITE (coor_chr,'(F10.1)')  -1.0_wp
[206]1188                ELSE
1189                   WRITE (coor_chr,'(F10.1)')  zu(section(i,1))
1190                ENDIF
[1]1191                coor_chr = ADJUSTL( coor_chr )
1192                coordinates = TRIM( coordinates ) // TRIM( coor_chr ) // '/'
1193
1194                i = i + 1
1195             ENDDO
1196             IF ( av == 0 )  THEN
1197                WRITE ( io, 335 )  'XY', do2d_xy, dt_do2d_xy, &
1198                                   TRIM( begin_chr ), 'k', TRIM( slices ), &
1199                                   TRIM( coordinates )
[1353]1200                IF ( skip_time_do2d_xy /= 0.0_wp )  THEN
[1]1201                   WRITE ( io, 339 )  skip_time_do2d_xy
1202                ENDIF
1203             ELSE
1204                WRITE ( io, 342 )  'XY', do2d_xy, dt_data_output_av, &
1205                                   TRIM( begin_chr ), averaging_interval, &
1206                                   dt_averaging_input, 'k', TRIM( slices ), &
1207                                   TRIM( coordinates )
[1353]1208                IF ( skip_time_data_output_av /= 0.0_wp )  THEN
[1]1209                   WRITE ( io, 339 )  skip_time_data_output_av
1210                ENDIF
1211             ENDIF
[1308]1212             IF ( netcdf_data_format > 4 )  THEN
1213                WRITE ( io, 352 )  ntdim_2d_xy(av)
1214             ELSE
1215                WRITE ( io, 353 )
1216             ENDIF
[1]1217          ENDIF
1218
1219          IF ( do2d_xz /= ''  .AND.  section(1,2) /= -9999 )  THEN
1220             i = 1
1221             slices = '/'
1222             coordinates = '/'
1223!
1224!--          Building strings with index and coordinate informations of the
1225!--          slices
1226             DO  WHILE ( section(i,2) /= -9999 )
1227
1228                WRITE (section_chr,'(I5)')  section(i,2)
1229                section_chr = ADJUSTL( section_chr )
1230                slices = TRIM( slices ) // TRIM( section_chr ) // '/'
1231
1232                WRITE (coor_chr,'(F10.1)')  section(i,2) * dy
1233                coor_chr = ADJUSTL( coor_chr )
1234                coordinates = TRIM( coordinates ) // TRIM( coor_chr ) // '/'
1235
1236                i = i + 1
1237             ENDDO
1238             IF ( av == 0 )  THEN
1239                WRITE ( io, 335 )  'XZ', do2d_xz, dt_do2d_xz, &
1240                                   TRIM( begin_chr ), 'j', TRIM( slices ), &
1241                                   TRIM( coordinates )
[1353]1242                IF ( skip_time_do2d_xz /= 0.0_wp )  THEN
[1]1243                   WRITE ( io, 339 )  skip_time_do2d_xz
1244                ENDIF
1245             ELSE
1246                WRITE ( io, 342 )  'XZ', do2d_xz, dt_data_output_av, &
1247                                   TRIM( begin_chr ), averaging_interval, &
1248                                   dt_averaging_input, 'j', TRIM( slices ), &
1249                                   TRIM( coordinates )
[1353]1250                IF ( skip_time_data_output_av /= 0.0_wp )  THEN
[1]1251                   WRITE ( io, 339 )  skip_time_data_output_av
1252                ENDIF
1253             ENDIF
[1308]1254             IF ( netcdf_data_format > 4 )  THEN
1255                WRITE ( io, 352 )  ntdim_2d_xz(av)
1256             ELSE
1257                WRITE ( io, 353 )
1258             ENDIF
[1]1259          ENDIF
1260
1261          IF ( do2d_yz /= ''  .AND.  section(1,3) /= -9999 )  THEN
1262             i = 1
1263             slices = '/'
1264             coordinates = '/'
1265!
1266!--          Building strings with index and coordinate informations of the
1267!--          slices
1268             DO  WHILE ( section(i,3) /= -9999 )
1269
1270                WRITE (section_chr,'(I5)')  section(i,3)
1271                section_chr = ADJUSTL( section_chr )
1272                slices = TRIM( slices ) // TRIM( section_chr ) // '/'
1273
1274                WRITE (coor_chr,'(F10.1)')  section(i,3) * dx
1275                coor_chr = ADJUSTL( coor_chr )
1276                coordinates = TRIM( coordinates ) // TRIM( coor_chr ) // '/'
1277
1278                i = i + 1
1279             ENDDO
1280             IF ( av == 0 )  THEN
1281                WRITE ( io, 335 )  'YZ', do2d_yz, dt_do2d_yz, &
1282                                   TRIM( begin_chr ), 'i', TRIM( slices ), &
1283                                   TRIM( coordinates )
[1353]1284                IF ( skip_time_do2d_yz /= 0.0_wp )  THEN
[1]1285                   WRITE ( io, 339 )  skip_time_do2d_yz
1286                ENDIF
1287             ELSE
1288                WRITE ( io, 342 )  'YZ', do2d_yz, dt_data_output_av, &
1289                                   TRIM( begin_chr ), averaging_interval, &
1290                                   dt_averaging_input, 'i', TRIM( slices ), &
1291                                   TRIM( coordinates )
[1353]1292                IF ( skip_time_data_output_av /= 0.0_wp )  THEN
[1]1293                   WRITE ( io, 339 )  skip_time_data_output_av
1294                ENDIF
1295             ENDIF
[1308]1296             IF ( netcdf_data_format > 4 )  THEN
1297                WRITE ( io, 352 )  ntdim_2d_yz(av)
1298             ELSE
1299                WRITE ( io, 353 )
1300             ENDIF
[1]1301          ENDIF
1302
1303       ENDIF
1304
1305    ENDDO
1306
1307!
1308!-- 3d-arrays
1309    DO  av = 0, 1
1310
1311       i = 1
1312       do3d_chr = ''
1313       DO  WHILE ( do3d(av,i) /= ' ' )
1314
1315          do3d_chr = TRIM( do3d_chr ) // ' ' // TRIM( do3d(av,i) ) // ','
1316          i = i + 1
1317
1318       ENDDO
1319
1320       IF ( do3d_chr /= '' )  THEN
1321          IF ( av == 0 )  THEN
1322             WRITE ( io, 336 )  ''
1323          ELSE
1324             WRITE ( io, 336 )  '(time-averaged)'
1325          ENDIF
1326
[1327]1327          output_format = output_format_netcdf
[292]1328          WRITE ( io, 344 )  output_format
[1]1329
1330          IF ( do3d_at_begin )  THEN
1331             begin_chr = 'and at the start'
1332          ELSE
1333             begin_chr = ''
1334          ENDIF
1335          IF ( av == 0 )  THEN
1336             WRITE ( io, 337 )  do3d_chr, dt_do3d, TRIM( begin_chr ), &
1337                                zu(nz_do3d), nz_do3d
1338          ELSE
1339             WRITE ( io, 343 )  do3d_chr, dt_data_output_av,           &
1340                                TRIM( begin_chr ), averaging_interval, &
1341                                dt_averaging_input, zu(nz_do3d), nz_do3d
1342          ENDIF
1343
[1308]1344          IF ( netcdf_data_format > 4 )  THEN
1345             WRITE ( io, 352 )  ntdim_3d(av)
1346          ELSE
1347             WRITE ( io, 353 )
1348          ENDIF
1349
[1]1350          IF ( av == 0 )  THEN
[1353]1351             IF ( skip_time_do3d /= 0.0_wp )  THEN
[1]1352                WRITE ( io, 339 )  skip_time_do3d
1353             ENDIF
1354          ELSE
[1353]1355             IF ( skip_time_data_output_av /= 0.0_wp )  THEN
[1]1356                WRITE ( io, 339 )  skip_time_data_output_av
1357             ENDIF
1358          ENDIF
1359
1360       ENDIF
1361
1362    ENDDO
1363
1364!
[410]1365!-- masked arrays
1366    IF ( masks > 0 )  WRITE ( io, 345 )  &
1367         mask_scale_x, mask_scale_y, mask_scale_z
1368    DO  mid = 1, masks
1369       DO  av = 0, 1
1370
1371          i = 1
1372          domask_chr = ''
1373          DO  WHILE ( domask(mid,av,i) /= ' ' )
1374             domask_chr = TRIM( domask_chr ) // ' ' //  &
1375                          TRIM( domask(mid,av,i) ) // ','
1376             i = i + 1
1377          ENDDO
1378
1379          IF ( domask_chr /= '' )  THEN
1380             IF ( av == 0 )  THEN
1381                WRITE ( io, 346 )  '', mid
1382             ELSE
1383                WRITE ( io, 346 )  ' (time-averaged)', mid
1384             ENDIF
1385
[1327]1386             output_format = output_format_netcdf
[1308]1387!--          Parallel output not implemented for mask data, hence
1388!--          output_format must be adjusted.
1389             IF ( netcdf_data_format == 5 ) output_format = 'netCDF4/HDF5'
1390             IF ( netcdf_data_format == 6 ) output_format = 'netCDF4/HDF5 classic'
[410]1391             WRITE ( io, 344 )  output_format
1392
1393             IF ( av == 0 )  THEN
1394                WRITE ( io, 347 )  domask_chr, dt_domask(mid)
1395             ELSE
1396                WRITE ( io, 348 )  domask_chr, dt_data_output_av, &
1397                                   averaging_interval, dt_averaging_input
1398             ENDIF
1399
1400             IF ( av == 0 )  THEN
[1353]1401                IF ( skip_time_domask(mid) /= 0.0_wp )  THEN
[410]1402                   WRITE ( io, 339 )  skip_time_domask(mid)
1403                ENDIF
1404             ELSE
[1353]1405                IF ( skip_time_data_output_av /= 0.0_wp )  THEN
[410]1406                   WRITE ( io, 339 )  skip_time_data_output_av
1407                ENDIF
1408             ENDIF
1409!
1410!--          output locations
1411             DO  dim = 1, 3
[1353]1412                IF ( mask(mid,dim,1) >= 0.0_wp )  THEN
[410]1413                   count = 0
[1353]1414                   DO  WHILE ( mask(mid,dim,count+1) >= 0.0_wp )
[410]1415                      count = count + 1
1416                   ENDDO
1417                   WRITE ( io, 349 )  dir(dim), dir(dim), mid, dir(dim), &
1418                                      mask(mid,dim,:count)
[1353]1419                ELSEIF ( mask_loop(mid,dim,1) < 0.0_wp .AND.  &
1420                         mask_loop(mid,dim,2) < 0.0_wp .AND.  &
1421                         mask_loop(mid,dim,3) == 0.0_wp )  THEN
[410]1422                   WRITE ( io, 350 )  dir(dim), dir(dim)
[1353]1423                ELSEIF ( mask_loop(mid,dim,3) == 0.0_wp )  THEN
[410]1424                   WRITE ( io, 351 )  dir(dim), dir(dim), mid, dir(dim), &
1425                                      mask_loop(mid,dim,1:2)
1426                ELSE
1427                   WRITE ( io, 351 )  dir(dim), dir(dim), mid, dir(dim), &
1428                                      mask_loop(mid,dim,1:3)
1429                ENDIF
1430             ENDDO
1431          ENDIF
1432
1433       ENDDO
1434    ENDDO
1435
1436!
[1]1437!-- Timeseries
[1322]1438    IF ( dt_dots /= 9999999.9_wp )  THEN
[1]1439       WRITE ( io, 340 )
1440
[1327]1441       output_format = output_format_netcdf
[292]1442       WRITE ( io, 344 )  output_format
[1]1443       WRITE ( io, 341 )  dt_dots
1444    ENDIF
1445
1446#if defined( __dvrp_graphics )
1447!
1448!-- Dvrp-output
[1322]1449    IF ( dt_dvrp /= 9999999.9_wp )  THEN
[1]1450       WRITE ( io, 360 )  dt_dvrp, TRIM( dvrp_output ), TRIM( dvrp_host ), &
1451                          TRIM( dvrp_username ), TRIM( dvrp_directory )
1452       i = 1
1453       l = 0
[336]1454       m = 0
[1]1455       DO WHILE ( mode_dvrp(i) /= ' ' )
1456          IF ( mode_dvrp(i)(1:10) == 'isosurface' )  THEN
[130]1457             READ ( mode_dvrp(i), '(10X,I2)' )  j
[1]1458             l = l + 1
1459             IF ( do3d(0,j) /= ' ' )  THEN
[336]1460                WRITE ( io, 361 )  TRIM( do3d(0,j) ), threshold(l), &
1461                                   isosurface_color(:,l)
[1]1462             ENDIF
1463          ELSEIF ( mode_dvrp(i)(1:6) == 'slicer' )  THEN
[130]1464             READ ( mode_dvrp(i), '(6X,I2)' )  j
[336]1465             m = m + 1
1466             IF ( do2d(0,j) /= ' ' )  THEN
1467                WRITE ( io, 362 )  TRIM( do2d(0,j) ), &
1468                                   slicer_range_limits_dvrp(:,m)
1469             ENDIF
[1]1470          ELSEIF ( mode_dvrp(i)(1:9) == 'particles' )  THEN
[336]1471             WRITE ( io, 363 )  dvrp_psize
1472             IF ( particle_dvrpsize /= 'none' )  THEN
1473                WRITE ( io, 364 )  'size', TRIM( particle_dvrpsize ), &
1474                                   dvrpsize_interval
1475             ENDIF
1476             IF ( particle_color /= 'none' )  THEN
1477                WRITE ( io, 364 )  'color', TRIM( particle_color ), &
1478                                   color_interval
1479             ENDIF
[1]1480          ENDIF
1481          i = i + 1
1482       ENDDO
[237]1483
[336]1484       WRITE ( io, 365 )  groundplate_color, superelevation_x, &
1485                          superelevation_y, superelevation, clip_dvrp_l, &
1486                          clip_dvrp_r, clip_dvrp_s, clip_dvrp_n
1487
1488       IF ( TRIM( topography ) /= 'flat' )  THEN
1489          WRITE ( io, 366 )  topography_color
1490          IF ( cluster_size > 1 )  THEN
1491             WRITE ( io, 367 )  cluster_size
1492          ENDIF
[237]1493       ENDIF
1494
[1]1495    ENDIF
1496#endif
1497
1498#if defined( __spectra )
1499!
1500!-- Spectra output
[1322]1501    IF ( dt_dosp /= 9999999.9_wp )  THEN
[1]1502       WRITE ( io, 370 )
1503
[1327]1504       output_format = output_format_netcdf
[292]1505       WRITE ( io, 344 )  output_format
[1]1506       WRITE ( io, 371 )  dt_dosp
[1353]1507       IF ( skip_time_dosp /= 0.0_wp )  WRITE ( io, 339 )  skip_time_dosp
[1]1508       WRITE ( io, 372 )  ( data_output_sp(i), i = 1,10 ),     &
1509                          ( spectra_direction(i), i = 1,10 ),  &
[189]1510                          ( comp_spectra_level(i), i = 1,100 ), &
1511                          ( plot_spectra_level(i), i = 1,100 ), &
[1]1512                          averaging_interval_sp, dt_averaging_input_pr
1513    ENDIF
1514#endif
1515
1516    WRITE ( io, 99 )
1517
1518!
1519!-- Physical quantities
1520    WRITE ( io, 400 )
1521
1522!
1523!-- Geostrophic parameters
1524    WRITE ( io, 410 )  omega, phi, f, fs
1525
1526!
1527!-- Other quantities
1528    WRITE ( io, 411 )  g
[1179]1529    WRITE ( io, 412 )  TRIM( reference_state )
1530    IF ( use_single_reference_value )  THEN
[97]1531       IF ( ocean )  THEN
[1179]1532          WRITE ( io, 413 )  prho_reference
[97]1533       ELSE
[1179]1534          WRITE ( io, 414 )  pt_reference
[97]1535       ENDIF
1536    ENDIF
[1]1537
1538!
1539!-- Cloud physics parameters
[1299]1540    IF ( cloud_physics )  THEN
[57]1541       WRITE ( io, 415 )
1542       WRITE ( io, 416 ) surface_pressure, r_d, rho_surface, cp, l_v
[1115]1543       IF ( icloud_scheme == 0 )  THEN
[1353]1544          WRITE ( io, 510 ) 1.0E-6_wp * nc_const
[1115]1545          IF ( precipitation )  WRITE ( io, 511 ) c_sedimentation
1546       ENDIF
[1]1547    ENDIF
1548
1549!
[824]1550!-- Cloud physcis parameters / quantities / numerical methods
1551    WRITE ( io, 430 )
1552    IF ( humidity .AND. .NOT. cloud_physics .AND. .NOT. cloud_droplets)  THEN
1553       WRITE ( io, 431 )
1554    ELSEIF ( humidity  .AND.  cloud_physics )  THEN
1555       WRITE ( io, 432 )
[1115]1556       IF ( radiation )  WRITE ( io, 132 )
1557       IF ( icloud_scheme == 1 )  THEN
1558          IF ( precipitation )  WRITE ( io, 133 )
1559       ELSEIF ( icloud_scheme == 0 )  THEN
1560          IF ( drizzle )  WRITE ( io, 506 )
1561          IF ( precipitation )  THEN
1562             WRITE ( io, 505 )
1563             IF ( turbulence )  WRITE ( io, 507 )
1564             IF ( ventilation_effect )  WRITE ( io, 508 )
1565             IF ( limiter_sedimentation )  WRITE ( io, 509 )
1566          ENDIF
1567       ENDIF
[824]1568    ELSEIF ( humidity  .AND.  cloud_droplets )  THEN
1569       WRITE ( io, 433 )
1570       IF ( curvature_solution_effects )  WRITE ( io, 434 )
[825]1571       IF ( collision_kernel /= 'none' )  THEN
1572          WRITE ( io, 435 )  TRIM( collision_kernel )
[828]1573          IF ( collision_kernel(6:9) == 'fast' )  THEN
1574             WRITE ( io, 436 )  radius_classes, dissipation_classes
1575          ENDIF
[825]1576       ELSE
[828]1577          WRITE ( io, 437 )
[825]1578       ENDIF
[824]1579    ENDIF
1580
1581!
[1]1582!-- LES / turbulence parameters
1583    WRITE ( io, 450 )
1584
1585!--
1586! ... LES-constants used must still be added here
1587!--
1588    IF ( constant_diffusion )  THEN
1589       WRITE ( io, 451 )  km_constant, km_constant/prandtl_number, &
1590                          prandtl_number
1591    ENDIF
1592    IF ( .NOT. constant_diffusion)  THEN
[1353]1593       IF ( e_init > 0.0_wp )  WRITE ( io, 455 )  e_init
1594       IF ( e_min > 0.0_wp )  WRITE ( io, 454 )  e_min
[1]1595       IF ( wall_adjustment )  WRITE ( io, 453 )  wall_adjustment_factor
1596    ENDIF
1597
1598!
1599!-- Special actions during the run
1600    WRITE ( io, 470 )
1601    IF ( create_disturbances )  THEN
1602       WRITE ( io, 471 )  dt_disturb, disturbance_amplitude,                   &
1603                          zu(disturbance_level_ind_b), disturbance_level_ind_b,&
1604                          zu(disturbance_level_ind_t), disturbance_level_ind_t
[707]1605       IF ( .NOT. bc_lr_cyc  .OR.  .NOT. bc_ns_cyc )  THEN
[1]1606          WRITE ( io, 472 )  inflow_disturbance_begin, inflow_disturbance_end
1607       ELSE
1608          WRITE ( io, 473 )  disturbance_energy_limit
1609       ENDIF
1610       WRITE ( io, 474 )  TRIM( random_generator )
1611    ENDIF
[1353]1612    IF ( pt_surface_initial_change /= 0.0_wp )  THEN
[1]1613       WRITE ( io, 475 )  pt_surface_initial_change
1614    ENDIF
[1353]1615    IF ( humidity  .AND.  q_surface_initial_change /= 0.0_wp )  THEN
[1]1616       WRITE ( io, 476 )  q_surface_initial_change       
1617    ENDIF
[1353]1618    IF ( passive_scalar  .AND.  q_surface_initial_change /= 0.0_wp )  THEN
[1]1619       WRITE ( io, 477 )  q_surface_initial_change       
1620    ENDIF
1621
[60]1622    IF ( particle_advection )  THEN
[1]1623!
[60]1624!--    Particle attributes
1625       WRITE ( io, 480 )  particle_advection_start, dt_prel, bc_par_lr, &
1626                          bc_par_ns, bc_par_b, bc_par_t, particle_maximum_age, &
[1359]1627                          end_time_prel
[60]1628       IF ( use_sgs_for_particles )  WRITE ( io, 488 )  dt_min_part
1629       IF ( random_start_position )  WRITE ( io, 481 )
1630       IF ( particles_per_point > 1 )  WRITE ( io, 489 )  particles_per_point
1631       WRITE ( io, 495 )  total_number_of_particles
[824]1632       IF ( use_particle_tails  .AND.  maximum_number_of_tailpoints /= 0 )  THEN
[60]1633          WRITE ( io, 483 )  maximum_number_of_tailpoints
1634          IF ( minimum_tailpoint_distance /= 0 )  THEN
1635             WRITE ( io, 484 )  total_number_of_tails,      &
1636                                minimum_tailpoint_distance, &
1637                                maximum_tailpoint_age
1638          ENDIF
[1]1639       ENDIF
[1322]1640       IF ( dt_write_particle_data /= 9999999.9_wp )  THEN
[60]1641          WRITE ( io, 485 )  dt_write_particle_data
[1327]1642          IF ( netcdf_data_format > 1 )  THEN
1643             output_format = 'netcdf (64 bit offset) and binary'
[1]1644          ELSE
[1327]1645             output_format = 'netcdf and binary'
[1]1646          ENDIF
[292]1647          WRITE ( io, 344 )  output_format
[1]1648       ENDIF
[1322]1649       IF ( dt_dopts /= 9999999.9_wp )  WRITE ( io, 494 )  dt_dopts
[60]1650       IF ( write_particle_statistics )  WRITE ( io, 486 )
[1]1651
[60]1652       WRITE ( io, 487 )  number_of_particle_groups
[1]1653
[60]1654       DO  i = 1, number_of_particle_groups
[1322]1655          IF ( i == 1  .AND.  density_ratio(i) == 9999999.9_wp )  THEN
[1353]1656             WRITE ( io, 490 )  i, 0.0_wp
[60]1657             WRITE ( io, 492 )
[1]1658          ELSE
[60]1659             WRITE ( io, 490 )  i, radius(i)
[1353]1660             IF ( density_ratio(i) /= 0.0_wp )  THEN
[60]1661                WRITE ( io, 491 )  density_ratio(i)
1662             ELSE
1663                WRITE ( io, 492 )
1664             ENDIF
[1]1665          ENDIF
[60]1666          WRITE ( io, 493 )  psl(i), psr(i), pss(i), psn(i), psb(i), pst(i), &
1667                             pdx(i), pdy(i), pdz(i)
[336]1668          IF ( .NOT. vertical_particle_advection(i) )  WRITE ( io, 482 )
[60]1669       ENDDO
[1]1670
[60]1671    ENDIF
[1]1672
[60]1673
[1]1674!
1675!-- Parameters of 1D-model
1676    IF ( INDEX( initializing_actions, 'set_1d-model_profiles' ) /= 0 )  THEN
1677       WRITE ( io, 500 )  end_time_1d, dt_run_control_1d, dt_pr_1d, &
1678                          mixing_length_1d, dissipation_1d
1679       IF ( damp_level_ind_1d /= nzt+1 )  THEN
1680          WRITE ( io, 502 )  zu(damp_level_ind_1d), damp_level_ind_1d
1681       ENDIF
1682    ENDIF
1683
1684!
1685!-- User-defined informations
1686    CALL user_header( io )
1687
1688    WRITE ( io, 99 )
1689
1690!
1691!-- Write buffer contents to disc immediately
[82]1692    CALL local_flush( io )
[1]1693
1694!
1695!-- Here the FORMATs start
1696
1697 99 FORMAT (1X,78('-'))
[1468]1698100 FORMAT (/1X,'******************************',4X,44('-')/        &
1699            1X,'* ',A,' *',4X,A/                               &
1700            1X,'******************************',4X,44('-'))
1701101 FORMAT (35X,'coupled run using MPI-',I1,': ',A/ &
1702            35X,42('-'))
1703102 FORMAT (/' Date:                 ',A8,4X,'Run:       ',A20/      &
1704            ' Time:                 ',A8,4X,'Run-No.:   ',I2.2/     &
[1106]1705            ' Run on host:        ',A10)
[1]1706#if defined( __parallel )
[1468]1707103 FORMAT (' Number of PEs:',10X,I6,4X,'Processor grid (x,y): (',I4,',',I4, &
[1]1708              ')',1X,A)
[1468]1709104 FORMAT (' Number of PEs:',10X,I6,4X,'Tasks:',I4,'   threads per task:',I4/ &
1710              35X,'Processor grid (x,y): (',I4,',',I4,')',1X,A)
1711105 FORMAT (35X,'One additional PE is used to handle'/37X,'the dvrp output!')
1712106 FORMAT (35X,'A 1d-decomposition along x is forced'/ &
1713            35X,'because the job is running on an SMP-cluster')
1714107 FORMAT (35X,'A 1d-decomposition along ',A,' is used')
1715108 FORMAT (35X,'Max. # of parallel I/O streams is ',I5)
1716109 FORMAT (35X,'Precursor run for coupled atmos-ocean run'/ &
1717            35X,42('-'))
1718114 FORMAT (35X,'Coupled atmosphere-ocean run following'/ &
1719            35X,'independent precursor runs'/             &
1720            35X,42('-'))
[1111]1721117 FORMAT (' Accelerator boards / node:  ',I2)
[1]1722#endif
1723110 FORMAT (/' Numerical Schemes:'/ &
1724             ' -----------------'/)
1725111 FORMAT (' --> Solve perturbation pressure via FFT using ',A,' routines')
1726112 FORMAT (' --> Solve perturbation pressure via SOR-Red/Black-Schema'/ &
1727            '     Iterations (initial/other): ',I3,'/',I3,'  omega = ',F5.3)
1728113 FORMAT (' --> Momentum advection via Piascek-Williams-Scheme (Form C3)', &
1729                  ' or Upstream')
[1216]1730115 FORMAT ('     FFT and transpositions are overlapping')
[1]1731116 FORMAT (' --> Scalar advection via Piascek-Williams-Scheme (Form C3)', &
1732                  ' or Upstream')
1733118 FORMAT (' --> Scalar advection via Bott-Chlond-Scheme')
[1106]1734119 FORMAT (' --> Galilei-Transform applied to horizontal advection:'/ &
1735            '     translation velocity = ',A/ &
[1]1736            '     distance advected ',A,':  ',F8.3,' km(x)  ',F8.3,' km(y)')
[1111]1737120 FORMAT (' Accelerator boards: ',8X,I2)
[1]1738122 FORMAT (' --> Time differencing scheme: ',A)
[108]1739123 FORMAT (' --> Rayleigh-Damping active, starts ',A,' z = ',F8.2,' m'/ &
[1]1740            '     maximum damping coefficient: ',F5.3, ' 1/s')
1741129 FORMAT (' --> Additional prognostic equation for the specific humidity')
1742130 FORMAT (' --> Additional prognostic equation for the total water content')
[940]1743131 FORMAT (' --> No pt-equation solved. Neutral stratification with pt = ', &
1744                  F6.2, ' K assumed')
[824]1745132 FORMAT ('     Parameterization of long-wave radiation processes via'/ &
[1]1746            '     effective emissivity scheme')
[824]1747133 FORMAT ('     Precipitation parameterization via Kessler-Scheme')
[1]1748134 FORMAT (' --> Additional prognostic equation for a passive scalar')
1749135 FORMAT (' --> Solve perturbation pressure via multigrid method (', &
1750                  A,'-cycle)'/ &
1751            '     number of grid levels:                   ',I2/ &
1752            '     Gauss-Seidel red/black iterations:       ',I2)
1753136 FORMAT ('     gridpoints of coarsest subdomain (x,y,z): (',I3,',',I3,',', &
1754                  I3,')')
1755137 FORMAT ('     level data gathered on PE0 at level:     ',I2/ &
1756            '     gridpoints of coarsest subdomain (x,y,z): (',I3,',',I3,',', &
1757                  I3,')'/ &
1758            '     gridpoints of coarsest domain (x,y,z):    (',I3,',',I3,',', &
1759                  I3,')')
[63]1760139 FORMAT (' --> Loop optimization method: ',A)
[1]1761140 FORMAT ('     maximum residual allowed:                ',E10.3)
1762141 FORMAT ('     fixed number of multigrid cycles:        ',I4)
1763142 FORMAT ('     perturbation pressure is calculated at every Runge-Kutta ', &
1764                  'step')
[87]1765143 FORMAT ('     Euler/upstream scheme is used for the SGS turbulent ', &
1766                  'kinetic energy')
[927]1767144 FORMAT ('     masking method is used')
[1]1768150 FORMAT (' --> Volume flow at the right and north boundary will be ', &
[241]1769                  'conserved'/ &
1770            '     using the ',A,' mode')
1771151 FORMAT ('     with u_bulk = ',F7.3,' m/s and v_bulk = ',F7.3,' m/s')
[306]1772152 FORMAT (' --> External pressure gradient directly prescribed by the user:',&
1773           /'     ',2(1X,E12.5),'Pa/m in x/y direction', &
1774           /'     starting from dp_level_b =', F8.3, 'm', A /)
[1365]1775160 FORMAT (//' Large scale forcing and nudging:'/ &
1776              ' -------------------------------'/)
1777161 FORMAT (' --> No large scale forcing from external is used (default) ')
1778162 FORMAT (' --> Large scale forcing from external file LSF_DATA is used: ')
1779163 FORMAT ('     - large scale advection tendencies ')
1780164 FORMAT ('     - large scale subsidence velocity w_subs ')
1781165 FORMAT ('     - large scale subsidence tendencies ')
1782167 FORMAT ('     - and geostrophic wind components ug and vg')
1783168 FORMAT (' --> Large-scale vertical motion is used in the ', &
[1299]1784                  'prognostic equation(s) for')
[1365]1785169 FORMAT ('     the scalar(s) only')
1786170 FORMAT (' --> Nudging is used')
1787171 FORMAT (' --> No nudging is used (default) ')
1788180 FORMAT ('     - prescribed surface values for temperature')
[1376]1789181 FORMAT ('     - prescribed surface fluxes for temperature')
1790182 FORMAT ('     - prescribed surface values for humidity')
[1365]1791183 FORMAT ('     - prescribed surface fluxes for humidity')
[1]1792200 FORMAT (//' Run time and time step information:'/ &
1793             ' ----------------------------------'/)
[1106]1794201 FORMAT ( ' Timestep:             variable     maximum value: ',F6.3,' s', &
[1]1795             '    CFL-factor: ',F4.2)
[1106]1796202 FORMAT ( ' Timestep:          dt = ',F6.3,' s'/)
1797203 FORMAT ( ' Start time:          ',F9.3,' s'/ &
1798             ' End time:            ',F9.3,' s')
[1]1799204 FORMAT ( A,F9.3,' s')
1800205 FORMAT ( A,F9.3,' s',5X,'restart every',17X,F9.3,' s')
[1106]1801206 FORMAT (/' Time reached:        ',F9.3,' s'/ &
1802             ' CPU-time used:       ',F9.3,' s     per timestep:               ', &
1803               '  ',F9.3,' s'/                                                    &
[1111]1804             '                                      per second of simulated tim', &
[1]1805               'e: ',F9.3,' s')
[1106]1806207 FORMAT ( ' Coupling start time: ',F9.3,' s')
[1]1807250 FORMAT (//' Computational grid and domain size:'/ &
1808              ' ----------------------------------'// &
1809              ' Grid length:      dx =    ',F7.3,' m    dy =    ',F7.3, &
1810              ' m    dz =    ',F7.3,' m'/ &
1811              ' Domain size:       x = ',F10.3,' m     y = ',F10.3, &
1812              ' m  z(u) = ',F10.3,' m'/)
1813252 FORMAT (' dz constant up to ',F10.3,' m (k=',I4,'), then stretched by', &
1814              ' factor: ',F5.3/ &
1815            ' maximum dz not to be exceeded is dz_max = ',F10.3,' m'/)
1816254 FORMAT (' Number of gridpoints (x,y,z):  (0:',I4,', 0:',I4,', 0:',I4,')'/ &
1817            ' Subdomain size (x,y,z):        (  ',I4,',   ',I4,',   ',I4,')'/)
1818260 FORMAT (/' The model has a slope in x-direction. Inclination angle: ',F6.2,&
1819             ' degrees')
1820270 FORMAT (//' Topography informations:'/ &
1821              ' -----------------------'// &
1822              1X,'Topography: ',A)
1823271 FORMAT (  ' Building size (x/y/z) in m: ',F5.1,' / ',F5.1,' / ',F5.1/ &
1824              ' Horizontal index bounds (l/r/s/n): ',I4,' / ',I4,' / ',I4, &
1825                ' / ',I4)
[240]1826272 FORMAT (  ' Single quasi-2D street canyon of infinite length in ',A, &
1827              ' direction' / &
1828              ' Canyon height: ', F6.2, 'm, ch = ', I4, '.'      / &
1829              ' Canyon position (',A,'-walls): cxl = ', I4,', cxr = ', I4, '.')
[256]1830278 FORMAT (' Topography grid definition convention:'/ &
1831            ' cell edge (staggered grid points'/  &
1832            ' (u in x-direction, v in y-direction))' /)
1833279 FORMAT (' Topography grid definition convention:'/ &
1834            ' cell center (scalar grid points)' /)
[138]1835280 FORMAT (//' Vegetation canopy (drag) model:'/ &
1836              ' ------------------------------'// &
1837              ' Canopy mode: ', A / &
1838              ' Canopy top: ',I4 / &
1839              ' Leaf drag coefficient: ',F6.2 /)
[153]1840281 FORMAT (/ ' Scalar_exchange_coefficient: ',F6.2 / &
1841              ' Scalar concentration at leaf surfaces in kg/m**3: ',F6.2 /)
1842282 FORMAT (' Predefined constant heatflux at the top of the vegetation: ',F6.2,' K m/s')
1843283 FORMAT (/ ' Characteristic levels of the leaf area density:'// &
[138]1844              ' Height:              ',A,'  m'/ &
1845              ' Leaf area density:   ',A,'  m**2/m**3'/ &
1846              ' Gradient:            ',A,'  m**2/m**4'/ &
1847              ' Gridpoint:           ',A)
1848               
[1]1849300 FORMAT (//' Boundary conditions:'/ &
1850             ' -------------------'// &
1851             '                     p                    uv             ', &
1852             '                   pt'// &
1853             ' B. bound.: ',A/ &
1854             ' T. bound.: ',A)
[97]1855301 FORMAT (/'                     ',A// &
[1]1856             ' B. bound.: ',A/ &
1857             ' T. bound.: ',A)
[19]1858303 FORMAT (/' Bottom surface fluxes are used in diffusion terms at k=1')
1859304 FORMAT (/' Top surface fluxes are used in diffusion terms at k=nzt')
1860305 FORMAT (//'    Prandtl-Layer between bottom surface and first ', &
1861               'computational u,v-level:'// &
[978]1862             '       zp = ',F6.2,' m   z0 = ',F6.4,' m   z0h = ',F7.5,&
1863             ' m   kappa = ',F4.2/ &
[1]1864             '       Rif value range:   ',F6.2,' <= rif <=',F6.2)
[97]1865306 FORMAT ('       Predefined constant heatflux:   ',F9.6,' K m/s')
[1]1866307 FORMAT ('       Heatflux has a random normal distribution')
1867308 FORMAT ('       Predefined surface temperature')
[97]1868309 FORMAT ('       Predefined constant salinityflux:   ',F9.6,' psu m/s')
[1]1869310 FORMAT (//'    1D-Model:'// &
1870             '       Rif value range:   ',F6.2,' <= rif <=',F6.2)
1871311 FORMAT ('       Predefined constant humidity flux: ',E10.3,' m/s')
1872312 FORMAT ('       Predefined surface humidity')
1873313 FORMAT ('       Predefined constant scalar flux: ',E10.3,' kg/(m**2 s)')
1874314 FORMAT ('       Predefined scalar value at the surface')
[19]1875315 FORMAT ('       Humidity / scalar flux at top surface is 0.0')
[102]1876316 FORMAT ('       Sensible heatflux and momentum flux from coupled ', &
1877                    'atmosphere model')
[1]1878317 FORMAT (//' Lateral boundaries:'/ &
1879            '       left/right:  ',A/    &
1880            '       north/south: ',A)
[1159]1881318 FORMAT (/'       use_cmax: ',L1 / &
1882            '       pt damping layer width = ',F8.2,' m, pt ', &
[978]1883                    'damping factor = ',F6.4)
[151]1884319 FORMAT ('       turbulence recycling at inflow switched on'/ &
1885            '       width of recycling domain: ',F7.1,' m   grid index: ',I4/ &
1886            '       inflow damping height: ',F6.1,' m   width: ',F6.1,' m')
1887320 FORMAT ('       Predefined constant momentumflux:  u: ',F9.6,' m**2/s**2'/ &
[103]1888            '                                          v: ',F9.6,' m**2/s**2')
[1365]1889321 FORMAT (//' Initial profiles:'/ &
1890              ' ----------------')
[151]1891325 FORMAT (//' List output:'/ &
[1]1892             ' -----------'//  &
1893            '    1D-Profiles:'/    &
1894            '       Output every             ',F8.2,' s')
[151]1895326 FORMAT ('       Time averaged over       ',F8.2,' s'/ &
[1]1896            '       Averaging input every    ',F8.2,' s')
1897330 FORMAT (//' Data output:'/ &
1898             ' -----------'/)
1899331 FORMAT (/'    1D-Profiles:')
1900332 FORMAT (/'       ',A)
1901333 FORMAT ('       Output every             ',F8.2,' s',/ &
1902            '       Time averaged over       ',F8.2,' s'/ &
1903            '       Averaging input every    ',F8.2,' s')
1904334 FORMAT (/'    2D-Arrays',A,':')
1905335 FORMAT (/'       ',A2,'-cross-section  Arrays: ',A/ &
1906            '       Output every             ',F8.2,' s  ',A/ &
1907            '       Cross sections at ',A1,' = ',A/ &
1908            '       scalar-coordinates:   ',A,' m'/)
1909336 FORMAT (/'    3D-Arrays',A,':')
1910337 FORMAT (/'       Arrays: ',A/ &
1911            '       Output every             ',F8.2,' s  ',A/ &
1912            '       Upper output limit at    ',F8.2,' m  (GP ',I4,')'/)
1913339 FORMAT ('       No output during initial ',F8.2,' s')
1914340 FORMAT (/'    Time series:')
1915341 FORMAT ('       Output every             ',F8.2,' s'/)
1916342 FORMAT (/'       ',A2,'-cross-section  Arrays: ',A/ &
1917            '       Output every             ',F8.2,' s  ',A/ &
1918            '       Time averaged over       ',F8.2,' s'/ &
1919            '       Averaging input every    ',F8.2,' s'/ &
1920            '       Cross sections at ',A1,' = ',A/ &
1921            '       scalar-coordinates:   ',A,' m'/)
1922343 FORMAT (/'       Arrays: ',A/ &
1923            '       Output every             ',F8.2,' s  ',A/ &
1924            '       Time averaged over       ',F8.2,' s'/ &
1925            '       Averaging input every    ',F8.2,' s'/ &
1926            '       Upper output limit at    ',F8.2,' m  (GP ',I4,')'/)
[292]1927344 FORMAT ('       Output format: ',A/)
[410]1928345 FORMAT (/'    Scaling lengths for output locations of all subsequent mask IDs:',/ &
1929            '       mask_scale_x (in x-direction): ',F9.3, ' m',/ &
1930            '       mask_scale_y (in y-direction): ',F9.3, ' m',/ &
1931            '       mask_scale_z (in z-direction): ',F9.3, ' m' )
1932346 FORMAT (/'    Masked data output',A,' for mask ID ',I2, ':')
1933347 FORMAT ('       Variables: ',A/ &
1934            '       Output every             ',F8.2,' s')
1935348 FORMAT ('       Variables: ',A/ &
1936            '       Output every             ',F8.2,' s'/ &
1937            '       Time averaged over       ',F8.2,' s'/ &
1938            '       Averaging input every    ',F8.2,' s')
1939349 FORMAT (/'       Output locations in ',A,'-direction in multiples of ', &
1940            'mask_scale_',A,' predefined by array mask_',I2.2,'_',A,':'/ &
1941            13('       ',8(F8.2,',')/) )
1942350 FORMAT (/'       Output locations in ',A,'-direction: ', &
1943            'all gridpoints along ',A,'-direction (default).' )
1944351 FORMAT (/'       Output locations in ',A,'-direction in multiples of ', &
1945            'mask_scale_',A,' constructed from array mask_',I2.2,'_',A,'_loop:'/ &
1946            '          loop begin:',F8.2,', end:',F8.2,', stride:',F8.2 )
[1313]1947352 FORMAT  (/'       Number of output time levels allowed: ',I3 /)
1948353 FORMAT  (/'       Number of output time levels allowed: unlimited' /)
[1]1949#if defined( __dvrp_graphics )
1950360 FORMAT ('    Plot-Sequence with dvrp-software:'/ &
1951            '       Output every      ',F7.1,' s'/ &
1952            '       Output mode:      ',A/ &
1953            '       Host / User:      ',A,' / ',A/ &
1954            '       Directory:        ',A// &
1955            '       The sequence contains:')
[337]1956361 FORMAT (/'       Isosurface of "',A,'"    Threshold value: ', E12.3/ &
1957            '          Isosurface color: (',F4.2,',',F4.2,',',F4.2,') (R,G,B)')
1958362 FORMAT (/'       Slicer plane ',A/ &
[336]1959            '       Slicer limits: [',F6.2,',',F6.2,']')
[337]1960363 FORMAT (/'       Particles'/ &
[336]1961            '          particle size:  ',F7.2,' m')
1962364 FORMAT ('          particle ',A,' controlled by "',A,'" with interval [', &
1963                       F6.2,',',F6.2,']')
[337]1964365 FORMAT (/'       Groundplate color: (',F4.2,',',F4.2,',',F4.2,') (R,G,B)'/ &
[336]1965            '       Superelevation along (x,y,z): (',F4.1,',',F4.1,',',F4.1, &
1966                     ')'/ &
1967            '       Clipping limits: from x = ',F9.1,' m to x = ',F9.1,' m'/ &
1968            '                        from y = ',F9.1,' m to y = ',F9.1,' m')
[337]1969366 FORMAT (/'       Topography color: (',F4.2,',',F4.2,',',F4.2,') (R,G,B)')
[336]1970367 FORMAT ('       Polygon reduction for topography: cluster_size = ', I1)
[1]1971#endif
1972#if defined( __spectra )
1973370 FORMAT ('    Spectra:')
1974371 FORMAT ('       Output every ',F7.1,' s'/)
1975372 FORMAT ('       Arrays:     ', 10(A5,',')/                         &
1976            '       Directions: ', 10(A5,',')/                         &
[189]1977            '       height levels  k = ', 20(I3,',')/                  &
1978            '                          ', 20(I3,',')/                  &
1979            '                          ', 20(I3,',')/                  &
1980            '                          ', 20(I3,',')/                  &
1981            '                          ', 19(I3,','),I3,'.'/           &
[1]1982            '       height levels selected for standard plot:'/        &
[189]1983            '                      k = ', 20(I3,',')/                  &
1984            '                          ', 20(I3,',')/                  &
1985            '                          ', 20(I3,',')/                  &
1986            '                          ', 20(I3,',')/                  &
1987            '                          ', 19(I3,','),I3,'.'/           &
[1]1988            '       Time averaged over ', F7.1, ' s,' /                &
1989            '       Profiles for the time averaging are taken every ', &
1990                    F6.1,' s')
1991#endif
1992400 FORMAT (//' Physical quantities:'/ &
1993              ' -------------------'/)
1994410 FORMAT ('    Angular velocity    :   omega = ',E9.3,' rad/s'/  &
1995            '    Geograph. latitude  :   phi   = ',F4.1,' degr'/   &
1996            '    Coriolis parameter  :   f     = ',F9.6,' 1/s'/    &
1997            '                            f*    = ',F9.6,' 1/s')
1998411 FORMAT (/'    Gravity             :   g     = ',F4.1,' m/s**2')
[1179]1999412 FORMAT (/'    Reference state used in buoyancy terms: ',A)
2000413 FORMAT ('       Reference density in buoyancy terms: ',F8.3,' kg/m**3')
2001414 FORMAT ('       Reference temperature in buoyancy terms: ',F8.4,' K')
[57]2002415 FORMAT (/'    Cloud physics parameters:'/ &
[1]2003             '    ------------------------'/)
[57]2004416 FORMAT ('        Surface pressure   :   p_0   = ',F7.2,' hPa'/      &
[1]2005            '        Gas constant       :   R     = ',F5.1,' J/(kg K)'/ &
2006            '        Density of air     :   rho_0 = ',F5.3,' kg/m**3'/  &
2007            '        Specific heat cap. :   c_p   = ',F6.1,' J/(kg K)'/ &
2008            '        Vapourization heat :   L_v   = ',E8.2,' J/kg')
2009420 FORMAT (/'    Characteristic levels of the initial temperature profile:'// &
2010            '       Height:        ',A,'  m'/ &
2011            '       Temperature:   ',A,'  K'/ &
2012            '       Gradient:      ',A,'  K/100m'/ &
2013            '       Gridpoint:     ',A)
2014421 FORMAT (/'    Characteristic levels of the initial humidity profile:'// &
2015            '       Height:      ',A,'  m'/ &
2016            '       Humidity:    ',A,'  kg/kg'/ &
2017            '       Gradient:    ',A,'  (kg/kg)/100m'/ &
2018            '       Gridpoint:   ',A)
2019422 FORMAT (/'    Characteristic levels of the initial scalar profile:'// &
2020            '       Height:                  ',A,'  m'/ &
2021            '       Scalar concentration:    ',A,'  kg/m**3'/ &
2022            '       Gradient:                ',A,'  (kg/m**3)/100m'/ &
2023            '       Gridpoint:               ',A)
2024423 FORMAT (/'    Characteristic levels of the geo. wind component ug:'// &
2025            '       Height:      ',A,'  m'/ &
2026            '       ug:          ',A,'  m/s'/ &
2027            '       Gradient:    ',A,'  1/100s'/ &
2028            '       Gridpoint:   ',A)
2029424 FORMAT (/'    Characteristic levels of the geo. wind component vg:'// &
2030            '       Height:      ',A,'  m'/ &
[97]2031            '       vg:          ',A,'  m/s'/ &
[1]2032            '       Gradient:    ',A,'  1/100s'/ &
2033            '       Gridpoint:   ',A)
[97]2034425 FORMAT (/'    Characteristic levels of the initial salinity profile:'// &
2035            '       Height:     ',A,'  m'/ &
2036            '       Salinity:   ',A,'  psu'/ &
2037            '       Gradient:   ',A,'  psu/100m'/ &
2038            '       Gridpoint:  ',A)
[411]2039426 FORMAT (/'    Characteristic levels of the subsidence/ascent profile:'// &
2040            '       Height:      ',A,'  m'/ &
2041            '       w_subs:      ',A,'  m/s'/ &
2042            '       Gradient:    ',A,'  (m/s)/100m'/ &
2043            '       Gridpoint:   ',A)
[767]2044427 FORMAT (/'    Initial wind profiles (u,v) are interpolated from given'// &
2045                  ' profiles')
[1241]2046428 FORMAT (/'    Initial profiles (u, v, pt, q) are taken from file '/ &
2047             '    NUDGING_DATA')
[824]2048430 FORMAT (//' Cloud physics quantities / methods:'/ &
2049              ' ----------------------------------'/)
2050431 FORMAT ('    Humidity is treated as purely passive scalar (no condensati', &
2051                 'on)')
2052432 FORMAT ('    Bulk scheme with liquid water potential temperature and'/ &
2053            '    total water content is used.'/ &
2054            '    Condensation is parameterized via 0% - or 100% scheme.')
2055433 FORMAT ('    Cloud droplets treated explicitly using the Lagrangian part', &
2056                 'icle model')
2057434 FORMAT ('    Curvature and solution effecs are considered for growth of', &
2058                 ' droplets < 1.0E-6 m')
[825]2059435 FORMAT ('    Droplet collision is handled by ',A,'-kernel')
[828]2060436 FORMAT ('       Fast kernel with fixed radius- and dissipation classes ', &
2061                    'are used'/ &
2062            '          number of radius classes:       ',I3,'    interval ', &
2063                       '[1.0E-6,2.0E-4] m'/ &
2064            '          number of dissipation classes:   ',I2,'    interval ', &
2065                       '[0,1000] cm**2/s**3')
2066437 FORMAT ('    Droplet collision is switched off')
[1]2067450 FORMAT (//' LES / Turbulence quantities:'/ &
2068              ' ---------------------------'/)
[824]2069451 FORMAT ('    Diffusion coefficients are constant:'/ &
2070            '    Km = ',F6.2,' m**2/s   Kh = ',F6.2,' m**2/s   Pr = ',F5.2)
2071453 FORMAT ('    Mixing length is limited to ',F4.2,' * z')
2072454 FORMAT ('    TKE is not allowed to fall below ',E9.2,' (m/s)**2')
2073455 FORMAT ('    initial TKE is prescribed as ',E9.2,' (m/s)**2')
[1]2074470 FORMAT (//' Actions during the simulation:'/ &
2075              ' -----------------------------'/)
[94]2076471 FORMAT ('    Disturbance impulse (u,v) every :   ',F6.2,' s'/            &
2077            '    Disturbance amplitude           :     ',F4.2, ' m/s'/       &
2078            '    Lower disturbance level         : ',F8.2,' m (GP ',I4,')'/  &
2079            '    Upper disturbance level         : ',F8.2,' m (GP ',I4,')')
[1]2080472 FORMAT ('    Disturbances continued during the run from i/j =',I4, &
2081                 ' to i/j =',I4)
2082473 FORMAT ('    Disturbances cease as soon as the disturbance energy exceeds',&
2083                 1X,F5.3, ' m**2/s**2')
2084474 FORMAT ('    Random number generator used    : ',A/)
2085475 FORMAT ('    The surface temperature is increased (or decreased, ', &
2086                 'respectively, if'/ &
2087            '    the value is negative) by ',F5.2,' K at the beginning of the',&
2088                 ' 3D-simulation'/)
2089476 FORMAT ('    The surface humidity is increased (or decreased, ',&
2090                 'respectively, if the'/ &
2091            '    value is negative) by ',E8.1,' kg/kg at the beginning of', &
2092                 ' the 3D-simulation'/)
2093477 FORMAT ('    The scalar value is increased at the surface (or decreased, ',&
2094                 'respectively, if the'/ &
2095            '    value is negative) by ',E8.1,' kg/m**3 at the beginning of', &
2096                 ' the 3D-simulation'/)
2097480 FORMAT ('    Particles:'/ &
2098            '    ---------'// &
2099            '       Particle advection is active (switched on at t = ', F7.1, &
2100                    ' s)'/ &
2101            '       Start of new particle generations every  ',F6.1,' s'/ &
2102            '       Boundary conditions: left/right: ', A, ' north/south: ', A/&
2103            '                            bottom:     ', A, ' top:         ', A/&
2104            '       Maximum particle age:                 ',F9.1,' s'/ &
[1359]2105            '       Advection stopped at t = ',F9.1,' s'/)
[1]2106481 FORMAT ('       Particles have random start positions'/)
[336]2107482 FORMAT ('          Particles are advected only horizontally'/)
[1]2108483 FORMAT ('       Particles have tails with a maximum of ',I3,' points')
2109484 FORMAT ('            Number of tails of the total domain: ',I10/ &
2110            '            Minimum distance between tailpoints: ',F8.2,' m'/ &
2111            '            Maximum age of the end of the tail:  ',F8.2,' s')
2112485 FORMAT ('       Particle data are written on file every ', F9.1, ' s')
2113486 FORMAT ('       Particle statistics are written on file'/)
2114487 FORMAT ('       Number of particle groups: ',I2/)
2115488 FORMAT ('       SGS velocity components are used for particle advection'/ &
2116            '          minimum timestep for advection: ', F7.5/)
2117489 FORMAT ('       Number of particles simultaneously released at each ', &
2118                    'point: ', I5/)
2119490 FORMAT ('       Particle group ',I2,':'/ &
2120            '          Particle radius: ',E10.3, 'm')
2121491 FORMAT ('          Particle inertia is activated'/ &
2122            '             density_ratio (rho_fluid/rho_particle) = ',F5.3/)
2123492 FORMAT ('          Particles are advected only passively (no inertia)'/)
2124493 FORMAT ('          Boundaries of particle source: x:',F8.1,' - ',F8.1,' m'/&
2125            '                                         y:',F8.1,' - ',F8.1,' m'/&
2126            '                                         z:',F8.1,' - ',F8.1,' m'/&
2127            '          Particle distances:  dx = ',F8.1,' m  dy = ',F8.1, &
2128                       ' m  dz = ',F8.1,' m'/)
2129494 FORMAT ('       Output of particle time series in NetCDF format every ', &
2130                    F8.2,' s'/)
2131495 FORMAT ('       Number of particles in total domain: ',I10/)
2132500 FORMAT (//' 1D-Model parameters:'/                           &
2133              ' -------------------'//                           &
2134            '    Simulation time:                   ',F8.1,' s'/ &
2135            '    Run-controll output every:         ',F8.1,' s'/ &
2136            '    Vertical profile output every:     ',F8.1,' s'/ &
2137            '    Mixing length calculation:         ',A/         &
2138            '    Dissipation calculation:           ',A/)
2139502 FORMAT ('    Damping layer starts from ',F7.1,' m (GP ',I4,')'/)
[667]2140503 FORMAT (' --> Momentum advection via Wicker-Skamarock-Scheme 5th order')
2141504 FORMAT (' --> Scalar advection via Wicker-Skamarock-Scheme 5th order')
[1115]2142505 FORMAT ('    Precipitation parameterization via Seifert-Beheng-Scheme')
2143506 FORMAT ('    Drizzle parameterization via Stokes law')
2144507 FORMAT ('    Turbulence effects on precipitation process')
2145508 FORMAT ('    Ventilation effects on evaporation of rain drops')
2146509 FORMAT ('    Slope limiter used for sedimentation process')
2147510 FORMAT ('        Droplet density    :   N_c   = ',F6.1,' 1/cm**3')
2148511 FORMAT ('        Sedimentation Courant number:                  '/&
2149            '                               C_s   = ',F3.1,'        ')
[1429]2150512 FORMAT (/' Date:                 ',A8,6X,'Run:       ',A20/      &
2151            ' Time:                 ',A8,6X,'Run-No.:   ',I2.2/     &
2152            ' Run on host:        ',A10,6X,'En-No.:    ',I2.2)
[1]2153
2154 END SUBROUTINE header
Note: See TracBrowser for help on using the repository browser.