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

Last change on this file since 1765 was 1765, checked in by raasch, 8 years ago

last commit documented

  • Property svn:keywords set to Id
File size: 93.4 KB
RevLine 
[1682]1!> @file header.f90
[1036]2!--------------------------------------------------------------------------------!
3! This file is part of PALM.
4!
5! PALM is free software: you can redistribute it and/or modify it under the terms
6! of the GNU General Public License as published by the Free Software Foundation,
7! either version 3 of the License, or (at your option) any later version.
8!
9! PALM is distributed in the hope that it will be useful, but WITHOUT ANY
10! WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
11! A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
12!
13! You should have received a copy of the GNU General Public License along with
14! PALM. If not, see <http://www.gnu.org/licenses/>.
15!
[1691]16! Copyright 1997-2015 Leibniz Universitaet Hannover
[1036]17!--------------------------------------------------------------------------------!
18!
[254]19! Current revisions:
[1]20! -----------------
[1698]21!
[1765]22!
[1485]23! Former revisions:
24! -----------------
25! $Id: header.f90 1765 2016-02-28 13:30:40Z raasch $
26!
[1765]27! 1764 2016-02-28 12:45:19Z raasch
28! output of nesting informations
29!
[1698]30! 1697 2015-10-28 17:14:10Z raasch
31! small E- and F-FORMAT changes to avoid informative compiler messages about
32! insufficient field width
33!
[1692]34! 1691 2015-10-26 16:17:44Z maronga
35! Renamed prandtl_layer to constant_flux_layer, renames rif_min/rif_max to
36! zeta_min/zeta_max.
37!
[1683]38! 1682 2015-10-07 23:56:08Z knoop
39! Code annotations made doxygen readable
40!
[1676]41! 1675 2015-10-02 08:28:59Z gronemeier
42! Bugfix: Definition of topography grid levels
43!
[1662]44! 1660 2015-09-21 08:15:16Z gronemeier
45! Bugfix: Definition of building/street canyon height if vertical grid stretching
46!         starts below the maximum topography height.
47!
[1591]48! 1590 2015-05-08 13:56:27Z maronga
49! Bugfix: Added TRIM statements for character strings for LSM and radiation code
50!
[1586]51! 1585 2015-04-30 07:05:52Z maronga
52! Further output for radiation model(s).
53!
[1576]54! 1575 2015-03-27 09:56:27Z raasch
55! adjustments for psolver-queries, output of seed_follows_topography
56!
[1561]57! 1560 2015-03-06 10:48:54Z keck
58! output for recycling y shift
59!
[1558]60! 1557 2015-03-05 16:43:04Z suehring
61! output for monotonic limiter
62!
[1552]63! 1551 2015-03-03 14:18:16Z maronga
64! Added informal output for land surface model and radiation model. Removed typo.
65!
[1497]66! 1496 2014-12-02 17:25:50Z maronga
67! Renamed: "radiation -> "cloud_top_radiation"
68!
[1485]69! 1484 2014-10-21 10:53:05Z kanani
[1484]70! Changes due to new module structure of the plant canopy model:
71!   module plant_canopy_model_mod and output for new canopy model parameters
72!   (alpha_lad, beta_lad, lai_beta,...) added,
73!   drag_coefficient, leaf_surface_concentration and scalar_exchange_coefficient
74!   renamed to canopy_drag_coeff, leaf_surface_conc and leaf_scalar_exch_coeff,
75!   learde renamed leaf_area_density.
76! Bugfix: DO-WHILE-loop for lad header information additionally restricted
77! by maximum number of gradient levels (currently 10)
[1483]78!
79! 1482 2014-10-18 12:34:45Z raasch
80! information about calculated or predefined virtual processor topology adjusted
81!
[1469]82! 1468 2014-09-24 14:06:57Z maronga
83! Adapted for use on up to 6-digit processor cores
84!
[1430]85! 1429 2014-07-15 12:53:45Z knoop
86! header exended to provide ensemble_member_nr if specified
87!
[1377]88! 1376 2014-04-26 11:21:22Z boeske
89! Correction of typos
90!
[1366]91! 1365 2014-04-22 15:03:56Z boeske
92! New section 'Large scale forcing and nudging':
93! output of large scale forcing and nudging information,
94! new section for initial profiles created
95!
[1360]96! 1359 2014-04-11 17:15:14Z hoffmann
97! dt_sort_particles removed
98!
[1354]99! 1353 2014-04-08 15:21:23Z heinze
100! REAL constants provided with KIND-attribute
101!
[1329]102! 1327 2014-03-21 11:00:16Z raasch
103! parts concerning iso2d and avs output removed,
104! -netcdf output queries
105!
[1325]106! 1324 2014-03-21 09:13:16Z suehring
107! Bugfix: module spectrum added
108!
[1323]109! 1322 2014-03-20 16:38:49Z raasch
110! REAL functions provided with KIND-attribute,
111! some REAL constants defined as wp-kind
112!
[1321]113! 1320 2014-03-20 08:40:49Z raasch
[1320]114! ONLY-attribute added to USE-statements,
115! kind-parameters added to all INTEGER and REAL declaration statements,
116! kinds are defined in new module kinds,
117! revision history before 2012 removed,
118! comment fields (!:) to be used for variable explanations added to
119! all variable declaration statements
[1321]120!
[1309]121! 1308 2014-03-13 14:58:42Z fricke
122! output of the fixed number of output time levels
123! output_format adjusted for masked data if netcdf_data_format > 5
124!
[1300]125! 1299 2014-03-06 13:15:21Z heinze
126! output for using large_scale subsidence in combination
127! with large_scale_forcing
128! reformatting, more detailed explanations
129!
[1242]130! 1241 2013-10-30 11:36:58Z heinze
131! output for nudging + large scale forcing from external file
132!
[1217]133! 1216 2013-08-26 09:31:42Z raasch
134! output for transpose_compute_overlap
135!
[1213]136! 1212 2013-08-15 08:46:27Z raasch
137! output for poisfft_hybrid removed
138!
[1182]139! 1179 2013-06-14 05:57:58Z raasch
140! output of reference_state, use_reference renamed use_single_reference_value
141!
[1160]142! 1159 2013-05-21 11:58:22Z fricke
143! +use_cmax
144!
[1116]145! 1115 2013-03-26 18:16:16Z hoffmann
146! descriptions for Seifert-Beheng-cloud-physics-scheme added
147!
[1112]148! 1111 2013-03-08 23:54:10Z raasch
149! output of accelerator board information
150! ibc_p_b = 2 removed
151!
[1109]152! 1108 2013-03-05 07:03:32Z raasch
153! bugfix for r1106
154!
[1107]155! 1106 2013-03-04 05:31:38Z raasch
156! some format changes for coupled runs
157!
[1093]158! 1092 2013-02-02 11:24:22Z raasch
159! unused variables removed
160!
[1037]161! 1036 2012-10-22 13:43:42Z raasch
162! code put under GPL (PALM 3.9)
163!
[1035]164! 1031 2012-10-19 14:35:30Z raasch
165! output of netCDF data format modified
166!
[1017]167! 1015 2012-09-27 09:23:24Z raasch
[1365]168! output of Adjustment of mixing length to the Prandtl mixing length at first
[1017]169! grid point above ground removed
170!
[1004]171! 1003 2012-09-14 14:35:53Z raasch
172! output of information about equal/unequal subdomain size removed
173!
[1002]174! 1001 2012-09-13 14:08:46Z raasch
175! all actions concerning leapfrog- and upstream-spline-scheme removed
176!
[979]177! 978 2012-08-09 08:28:32Z fricke
178! -km_damp_max, outflow_damping_width
179! +pt_damping_factor, pt_damping_width
180! +z0h
181!
[965]182! 964 2012-07-26 09:14:24Z raasch
183! output of profil-related quantities removed
184!
[941]185! 940 2012-07-09 14:31:00Z raasch
186! Output in case of simulations for pure neutral stratification (no pt-equation
187! solved)
188!
[928]189! 927 2012-06-06 19:15:04Z raasch
190! output of masking_method for mg-solver
191!
[869]192! 868 2012-03-28 12:21:07Z raasch
193! translation velocity in Galilean transformation changed to 0.6 * ug
194!
[834]195! 833 2012-02-22 08:55:55Z maronga
196! Adjusted format for leaf area density
197!
[829]198! 828 2012-02-21 12:00:36Z raasch
199! output of dissipation_classes + radius_classes
200!
[826]201! 825 2012-02-19 03:03:44Z raasch
202! Output of cloud physics parameters/quantities complemented and restructured
203!
[1]204! Revision 1.1  1997/08/11 06:17:20  raasch
205! Initial revision
206!
207!
208! Description:
209! ------------
[1764]210!> Writing a header with all important information about the current run.
[1682]211!> This subroutine is called three times, two times at the beginning
212!> (writing information on files RUN_CONTROL and HEADER) and one time at the
213!> end of the run, then writing additional information about CPU-usage on file
214!> header.
[411]215!-----------------------------------------------------------------------------!
[1682]216 SUBROUTINE header
217 
[1]218
[1320]219    USE arrays_3d,                                                             &
[1660]220        ONLY:  pt_init, qsws, q_init, sa_init, shf, ug, vg, w_subs, zu, zw
[1320]221       
[1]222    USE control_parameters
[1320]223       
224    USE cloud_parameters,                                                      &
225        ONLY:  cp, curvature_solution_effects, c_sedimentation,                &
226               limiter_sedimentation, l_v, nc_const, r_d, ventilation_effect
227       
228    USE cpulog,                                                                &
229        ONLY:  log_point_s
230       
231    USE dvrp_variables,                                                        &
232        ONLY:  use_seperate_pe_for_dvrp_output
233       
234    USE grid_variables,                                                        &
235        ONLY:  dx, dy
236       
237    USE indices,                                                               &
238        ONLY:  mg_loc_ind, nnx, nny, nnz, nx, ny, nxl_mg, nxr_mg, nyn_mg,      &
239               nys_mg, nzt, nzt_mg
240       
241    USE kinds
[1551]242   
243    USE land_surface_model_mod,                                                &
244        ONLY:  conserve_water_content, dewfall, land_surface, nzb_soil,        &
245               nzt_soil, root_fraction, soil_moisture, soil_temperature,       &
246               soil_type, soil_type_name, veg_type, veg_type_name, zs
247 
[1320]248    USE model_1d,                                                              &
249        ONLY:  damp_level_ind_1d, dt_pr_1d, dt_run_control_1d, end_time_1d
250       
251    USE particle_attributes,                                                   &
252        ONLY:  bc_par_b, bc_par_lr, bc_par_ns, bc_par_t, collision_kernel,     &
253               density_ratio, dissipation_classes, dt_min_part, dt_prel,       &
[1359]254               dt_write_particle_data, end_time_prel,                          &
[1320]255               maximum_number_of_tailpoints, maximum_tailpoint_age,            &
256               minimum_tailpoint_distance, number_of_particle_groups,          &
257               particle_advection, particle_advection_start,                   &
258               particles_per_point, pdx, pdy, pdz,  psb, psl, psn, psr, pss,   &
259               pst, radius, radius_classes, random_start_position,             &
[1575]260               seed_follows_topography,                                        &
[1320]261               total_number_of_particles, use_particle_tails,                  &
262               use_sgs_for_particles, total_number_of_tails,                   &
263               vertical_particle_advection, write_particle_statistics
264       
[1]265    USE pegrid
[1484]266
267    USE plant_canopy_model_mod,                                                &
268        ONLY:  alpha_lad, beta_lad, calc_beta_lad_profile, canopy_drag_coeff,  &
269               canopy_mode, cthf, lad, lad_surface, lad_vertical_gradient,     &
270               lad_vertical_gradient_level, lad_vertical_gradient_level_ind,   &
271               lai_beta, leaf_scalar_exch_coeff, leaf_surface_conc, pch_index, &
272               plant_canopy
[1551]273
[1764]274    USE pmc_interface,                                                         &
275        ONLY:  cpl_id, cpl_parent_id, cpl_name, lower_left_coord_x,            &
276               lower_left_coord_y, nested_run, nesting_mode
277
[1551]278    USE radiation_model_mod,                                                   &
[1585]279        ONLY:  albedo, albedo_type, albedo_type_name, constant_albedo,         &
280               day_init, dt_radiation, lambda, lw_radiation, net_radiation,    &
281               radiation, radiation_scheme, sw_radiation, time_utc_init
[1324]282   
283    USE spectrum,                                                              &
284        ONLY:  comp_spectra_level, data_output_sp, plot_spectra_level,         &
285               spectra_direction
[1]286
287    IMPLICIT NONE
288
[1682]289    CHARACTER (LEN=1)  ::  prec                !<
[1320]290   
[1682]291    CHARACTER (LEN=2)  ::  do2d_mode           !<
[1320]292   
[1682]293    CHARACTER (LEN=5)  ::  section_chr         !<
[1320]294   
[1682]295    CHARACTER (LEN=10) ::  coor_chr            !<
296    CHARACTER (LEN=10) ::  host_chr            !<
[1320]297   
[1682]298    CHARACTER (LEN=16) ::  begin_chr           !<
[1320]299   
[1682]300    CHARACTER (LEN=26) ::  ver_rev             !<
[1320]301   
[1682]302    CHARACTER (LEN=40) ::  output_format       !<
[1320]303   
[1682]304    CHARACTER (LEN=70) ::  char1               !<
305    CHARACTER (LEN=70) ::  char2               !<
306    CHARACTER (LEN=70) ::  dopr_chr            !<
307    CHARACTER (LEN=70) ::  do2d_xy             !<
308    CHARACTER (LEN=70) ::  do2d_xz             !<
309    CHARACTER (LEN=70) ::  do2d_yz             !<
310    CHARACTER (LEN=70) ::  do3d_chr            !<
311    CHARACTER (LEN=70) ::  domask_chr          !<
312    CHARACTER (LEN=70) ::  run_classification  !<
[1320]313   
[1682]314    CHARACTER (LEN=85) ::  roben               !<
315    CHARACTER (LEN=85) ::  runten              !<
[1320]316   
[1682]317    CHARACTER (LEN=86) ::  coordinates         !<
318    CHARACTER (LEN=86) ::  gradients           !<
319    CHARACTER (LEN=86) ::  leaf_area_density   !<
320    CHARACTER (LEN=86) ::  roots               !<
321    CHARACTER (LEN=86) ::  slices              !<
322    CHARACTER (LEN=86) ::  temperatures        !<
323    CHARACTER (LEN=86) ::  ugcomponent         !<
324    CHARACTER (LEN=86) ::  vgcomponent         !<
[1]325
[1682]326    CHARACTER (LEN=1), DIMENSION(1:3) ::  dir = (/ 'x', 'y', 'z' /)  !<
[410]327
[1682]328    INTEGER(iwp) ::  av        !<
329    INTEGER(iwp) ::  bh        !<
330    INTEGER(iwp) ::  blx       !<
331    INTEGER(iwp) ::  bly       !<
332    INTEGER(iwp) ::  bxl       !<
333    INTEGER(iwp) ::  bxr       !<
334    INTEGER(iwp) ::  byn       !<
335    INTEGER(iwp) ::  bys       !<
336    INTEGER(iwp) ::  ch        !<
337    INTEGER(iwp) ::  count     !<
338    INTEGER(iwp) ::  cwx       !<
339    INTEGER(iwp) ::  cwy       !<
340    INTEGER(iwp) ::  cxl       !<
341    INTEGER(iwp) ::  cxr       !<
342    INTEGER(iwp) ::  cyn       !<
343    INTEGER(iwp) ::  cys       !<
344    INTEGER(iwp) ::  dim       !<
345    INTEGER(iwp) ::  i         !<
346    INTEGER(iwp) ::  io        !<
347    INTEGER(iwp) ::  j         !<
348    INTEGER(iwp) ::  k         !<
349    INTEGER(iwp) ::  l         !<
350    INTEGER(iwp) ::  ll        !<
351    INTEGER(iwp) ::  mpi_type  !<
[1320]352   
[1682]353    REAL(wp) ::  canopy_height                    !< canopy height (in m)
354    REAL(wp) ::  cpuseconds_per_simulated_second  !<
[1]355
356!
357!-- Open the output file. At the end of the simulation, output is directed
358!-- to unit 19.
359    IF ( ( runnr == 0 .OR. force_print_header )  .AND. &
360         .NOT. simulated_time_at_begin /= simulated_time )  THEN
361       io = 15   !  header output on file RUN_CONTROL
362    ELSE
363       io = 19   !  header output on file HEADER
364    ENDIF
365    CALL check_open( io )
366
367!
368!-- At the end of the run, output file (HEADER) will be rewritten with
[1551]369!-- new information
[1]370    IF ( io == 19 .AND. simulated_time_at_begin /= simulated_time ) REWIND( 19 )
371
372!
373!-- Determine kind of model run
374    IF ( TRIM( initializing_actions ) == 'read_restart_data' )  THEN
[1764]375       run_classification = 'restart run'
[328]376    ELSEIF ( TRIM( initializing_actions ) == 'cyclic_fill' )  THEN
[1764]377       run_classification = 'run with cyclic fill of 3D - prerun data'
[147]378    ELSEIF ( INDEX( initializing_actions, 'set_constant_profiles' ) /= 0 )  THEN
[1764]379       run_classification = 'run without 1D - prerun'
[197]380    ELSEIF ( INDEX( initializing_actions, 'set_1d-model_profiles' ) /= 0 )  THEN
[1764]381       run_classification = 'run with 1D - prerun'
[197]382    ELSEIF ( INDEX( initializing_actions, 'by_user' ) /=0 )  THEN
[1764]383       run_classification = 'run initialized by user'
[1]384    ELSE
[254]385       message_string = ' unknown action(s): ' // TRIM( initializing_actions )
386       CALL message( 'header', 'PA0191', 0, 0, 0, 6, 0 )
[1]387    ENDIF
[1764]388    IF ( nested_run )  run_classification = 'nested ' // run_classification
[97]389    IF ( ocean )  THEN
390       run_classification = 'ocean - ' // run_classification
391    ELSE
392       run_classification = 'atmosphere - ' // run_classification
393    ENDIF
[1]394
395!
396!-- Run-identification, date, time, host
397    host_chr = host(1:10)
[75]398    ver_rev = TRIM( version ) // '  ' // TRIM( revision )
[102]399    WRITE ( io, 100 )  ver_rev, TRIM( run_classification )
[291]400    IF ( TRIM( coupling_mode ) /= 'uncoupled' )  THEN
401#if defined( __mpi2 )
402       mpi_type = 2
403#else
404       mpi_type = 1
405#endif
406       WRITE ( io, 101 )  mpi_type, coupling_mode
407    ENDIF
[1108]408#if defined( __parallel )
[1353]409    IF ( coupling_start_time /= 0.0_wp )  THEN
[1106]410       IF ( coupling_start_time > simulated_time_at_begin )  THEN
411          WRITE ( io, 109 )
412       ELSE
413          WRITE ( io, 114 )
414       ENDIF
415    ENDIF
[1108]416#endif
[1429]417    IF ( ensemble_member_nr /= 0 )  THEN
418       WRITE ( io, 512 )  run_date, run_identifier, run_time, runnr,           &
419                       ADJUSTR( host_chr ), ensemble_member_nr
420    ELSE
421       WRITE ( io, 102 )  run_date, run_identifier, run_time, runnr,           &
[102]422                       ADJUSTR( host_chr )
[1429]423    ENDIF
[1]424#if defined( __parallel )
[1482]425    IF ( npex == -1  .AND.  npey == -1 )  THEN
[1]426       char1 = 'calculated'
427    ELSE
428       char1 = 'predefined'
429    ENDIF
430    IF ( threads_per_task == 1 )  THEN
[102]431       WRITE ( io, 103 )  numprocs, pdims(1), pdims(2), TRIM( char1 )
[1]432    ELSE
[102]433       WRITE ( io, 104 )  numprocs*threads_per_task, numprocs, &
[1]434                          threads_per_task, pdims(1), pdims(2), TRIM( char1 )
435    ENDIF
[1111]436    IF ( num_acc_per_node /= 0 )  WRITE ( io, 117 )  num_acc_per_node   
[1]437    IF ( ( host(1:3) == 'ibm'  .OR.  host(1:3) == 'nec'  .OR.    &
438           host(1:2) == 'lc'   .OR.  host(1:3) == 'dec' )  .AND. &
439         npex == -1  .AND.  pdims(2) == 1 )                      &
440    THEN
[102]441       WRITE ( io, 106 )
[1]442    ELSEIF ( pdims(2) == 1 )  THEN
[102]443       WRITE ( io, 107 )  'x'
[1]444    ELSEIF ( pdims(1) == 1 )  THEN
[102]445       WRITE ( io, 107 )  'y'
[1]446    ENDIF
[102]447    IF ( use_seperate_pe_for_dvrp_output )  WRITE ( io, 105 )
[759]448    IF ( numprocs /= maximum_parallel_io_streams )  THEN
449       WRITE ( io, 108 )  maximum_parallel_io_streams
450    ENDIF
[1111]451#else
452    IF ( num_acc_per_node /= 0 )  WRITE ( io, 120 )  num_acc_per_node
[1]453#endif
[1764]454
455!
456!-- Nesting informations
457    IF ( nested_run )  THEN
458       WRITE ( io, 600 )  cpl_id, TRIM( cpl_name ), cpl_parent_id,             &
459                          nesting_mode, lower_left_coord_x, lower_left_coord_y
460    ENDIF
[1]461    WRITE ( io, 99 )
462
463!
464!-- Numerical schemes
465    WRITE ( io, 110 )
466    IF ( psolver(1:7) == 'poisfft' )  THEN
467       WRITE ( io, 111 )  TRIM( fft_method )
[1216]468       IF ( transpose_compute_overlap )  WRITE( io, 115 )
[1]469    ELSEIF ( psolver == 'sor' )  THEN
470       WRITE ( io, 112 )  nsor_ini, nsor, omega_sor
[1575]471    ELSEIF ( psolver(1:9) == 'multigrid' )  THEN
472       WRITE ( io, 135 )  TRIM(psolver), cycle_mg, maximum_grid_level, ngsrb
[1]473       IF ( mg_cycles == -1 )  THEN
474          WRITE ( io, 140 )  residual_limit
475       ELSE
476          WRITE ( io, 141 )  mg_cycles
477       ENDIF
478       IF ( mg_switch_to_pe0_level == 0 )  THEN
479          WRITE ( io, 136 )  nxr_mg(1)-nxl_mg(1)+1, nyn_mg(1)-nys_mg(1)+1, &
480                             nzt_mg(1)
[197]481       ELSEIF (  mg_switch_to_pe0_level /= -1 )  THEN
[1]482          WRITE ( io, 137 )  mg_switch_to_pe0_level,            &
483                             mg_loc_ind(2,0)-mg_loc_ind(1,0)+1, &
484                             mg_loc_ind(4,0)-mg_loc_ind(3,0)+1, &
485                             nzt_mg(mg_switch_to_pe0_level),    &
486                             nxr_mg(1)-nxl_mg(1)+1, nyn_mg(1)-nys_mg(1)+1, &
487                             nzt_mg(1)
488       ENDIF
[927]489       IF ( masking_method )  WRITE ( io, 144 )
[1]490    ENDIF
491    IF ( call_psolver_at_all_substeps  .AND. timestep_scheme(1:5) == 'runge' ) &
492    THEN
493       WRITE ( io, 142 )
494    ENDIF
495
496    IF ( momentum_advec == 'pw-scheme' )  THEN
497       WRITE ( io, 113 )
[1299]498    ELSEIF (momentum_advec == 'ws-scheme' )  THEN
[667]499       WRITE ( io, 503 )
[1]500    ENDIF
501    IF ( scalar_advec == 'pw-scheme' )  THEN
502       WRITE ( io, 116 )
[667]503    ELSEIF ( scalar_advec == 'ws-scheme' )  THEN
504       WRITE ( io, 504 )
[1557]505    ELSEIF ( scalar_advec == 'ws-scheme-mono' )  THEN
506       WRITE ( io, 513 )
[1]507    ELSE
508       WRITE ( io, 118 )
509    ENDIF
[63]510
511    WRITE ( io, 139 )  TRIM( loop_optimization )
512
[1]513    IF ( galilei_transformation )  THEN
514       IF ( use_ug_for_galilei_tr )  THEN
[868]515          char1 = '0.6 * geostrophic wind'
[1]516       ELSE
517          char1 = 'mean wind in model domain'
518       ENDIF
519       IF ( simulated_time_at_begin == simulated_time )  THEN
520          char2 = 'at the start of the run'
521       ELSE
522          char2 = 'at the end of the run'
523       ENDIF
[1353]524       WRITE ( io, 119 )  TRIM( char1 ), TRIM( char2 ),                        &
525                          advected_distance_x/1000.0_wp,                       &
526                          advected_distance_y/1000.0_wp
[1]527    ENDIF
[1001]528    WRITE ( io, 122 )  timestep_scheme
[87]529    IF ( use_upstream_for_tke )  WRITE ( io, 143 )
[1353]530    IF ( rayleigh_damping_factor /= 0.0_wp )  THEN
[108]531       IF ( .NOT. ocean )  THEN
532          WRITE ( io, 123 )  'above', rayleigh_damping_height, &
533               rayleigh_damping_factor
534       ELSE
535          WRITE ( io, 123 )  'below', rayleigh_damping_height, &
536               rayleigh_damping_factor
537       ENDIF
[1]538    ENDIF
[940]539    IF ( neutral )  WRITE ( io, 131 )  pt_surface
[75]540    IF ( humidity )  THEN
[1]541       IF ( .NOT. cloud_physics )  THEN
542          WRITE ( io, 129 )
543       ELSE
544          WRITE ( io, 130 )
545       ENDIF
546    ENDIF
547    IF ( passive_scalar )  WRITE ( io, 134 )
[240]548    IF ( conserve_volume_flow )  THEN
[241]549       WRITE ( io, 150 )  conserve_volume_flow_mode
550       IF ( TRIM( conserve_volume_flow_mode ) == 'bulk_velocity' )  THEN
551          WRITE ( io, 151 )  u_bulk, v_bulk
552       ENDIF
[240]553    ELSEIF ( dp_external )  THEN
554       IF ( dp_smooth )  THEN
[241]555          WRITE ( io, 152 )  dpdxy, dp_level_b, ', vertically smoothed.'
[240]556       ELSE
[241]557          WRITE ( io, 152 )  dpdxy, dp_level_b, '.'
[240]558       ENDIF
559    ENDIF
[1]560    WRITE ( io, 99 )
561
562!
[1551]563!-- Runtime and timestep information
[1]564    WRITE ( io, 200 )
565    IF ( .NOT. dt_fixed )  THEN
566       WRITE ( io, 201 )  dt_max, cfl_factor
567    ELSE
568       WRITE ( io, 202 )  dt
569    ENDIF
570    WRITE ( io, 203 )  simulated_time_at_begin, end_time
571
[1322]572    IF ( time_restart /= 9999999.9_wp  .AND. &
[1]573         simulated_time_at_begin == simulated_time )  THEN
[1322]574       IF ( dt_restart == 9999999.9_wp )  THEN
[1]575          WRITE ( io, 204 )  ' Restart at:       ',time_restart
576       ELSE
577          WRITE ( io, 205 )  ' Restart at:       ',time_restart, dt_restart
578       ENDIF
579    ENDIF
580
581    IF ( simulated_time_at_begin /= simulated_time )  THEN
582       i = MAX ( log_point_s(10)%counts, 1 )
[1353]583       IF ( ( simulated_time - simulated_time_at_begin ) == 0.0_wp )  THEN
584          cpuseconds_per_simulated_second = 0.0_wp
[1]585       ELSE
586          cpuseconds_per_simulated_second = log_point_s(10)%sum / &
587                                            ( simulated_time -    &
588                                              simulated_time_at_begin )
589       ENDIF
[1322]590       WRITE ( io, 206 )  simulated_time, log_point_s(10)%sum,      &
591                          log_point_s(10)%sum / REAL( i, KIND=wp ), &
[1]592                          cpuseconds_per_simulated_second
[1322]593       IF ( time_restart /= 9999999.9_wp  .AND.  time_restart < end_time )  THEN
594          IF ( dt_restart == 9999999.9_wp )  THEN
[1106]595             WRITE ( io, 204 )  ' Next restart at:     ',time_restart
[1]596          ELSE
[1106]597             WRITE ( io, 205 )  ' Next restart at:     ',time_restart, dt_restart
[1]598          ENDIF
599       ENDIF
600    ENDIF
601
[1324]602
[1]603!
[291]604!-- Start time for coupled runs, if independent precursor runs for atmosphere
[1106]605!-- and ocean are used or have been used. In this case, coupling_start_time
606!-- defines the time when the coupling is switched on.
[1353]607    IF ( coupling_start_time /= 0.0_wp )  THEN
[1106]608       WRITE ( io, 207 )  coupling_start_time
[291]609    ENDIF
610
611!
[1]612!-- Computational grid
[94]613    IF ( .NOT. ocean )  THEN
614       WRITE ( io, 250 )  dx, dy, dz, (nx+1)*dx, (ny+1)*dy, zu(nzt+1)
615       IF ( dz_stretch_level_index < nzt+1 )  THEN
616          WRITE ( io, 252 )  dz_stretch_level, dz_stretch_level_index, &
617                             dz_stretch_factor, dz_max
618       ENDIF
619    ELSE
620       WRITE ( io, 250 )  dx, dy, dz, (nx+1)*dx, (ny+1)*dy, zu(0)
621       IF ( dz_stretch_level_index > 0 )  THEN
622          WRITE ( io, 252 )  dz_stretch_level, dz_stretch_level_index, &
623                             dz_stretch_factor, dz_max
624       ENDIF
[1]625    ENDIF
626    WRITE ( io, 254 )  nx, ny, nzt+1, MIN( nnx, nx+1 ), MIN( nny, ny+1 ), &
627                       MIN( nnz+2, nzt+2 )
628    IF ( sloping_surface )  WRITE ( io, 260 )  alpha_surface
629
630!
[1365]631!-- Large scale forcing and nudging
632    WRITE ( io, 160 )
633    IF ( large_scale_forcing )  THEN
634       WRITE ( io, 162 )
635       WRITE ( io, 163 )
636
637       IF ( large_scale_subsidence )  THEN
638          IF ( .NOT. use_subsidence_tendencies )  THEN
639             WRITE ( io, 164 )
640          ELSE
641             WRITE ( io, 165 )
642          ENDIF
643       ENDIF
644
645       IF ( bc_pt_b == 'dirichlet' )  THEN
646          WRITE ( io, 180 )
647       ELSEIF ( bc_pt_b == 'neumann' )  THEN
648          WRITE ( io, 181 )
649       ENDIF
650
651       IF ( bc_q_b == 'dirichlet' )  THEN
652          WRITE ( io, 182 )
653       ELSEIF ( bc_q_b == 'neumann' )  THEN
654          WRITE ( io, 183 )
655       ENDIF
656
657       WRITE ( io, 167 )
658       IF ( nudging )  THEN
659          WRITE ( io, 170 )
660       ENDIF
661    ELSE
662       WRITE ( io, 161 )
663       WRITE ( io, 171 )
664    ENDIF
665    IF ( large_scale_subsidence )  THEN
666       WRITE ( io, 168 )
667       WRITE ( io, 169 )
668    ENDIF
669
670!
671!-- Profile for the large scale vertial velocity
672!-- Building output strings, starting with surface value
673    IF ( large_scale_subsidence )  THEN
674       temperatures = '   0.0'
675       gradients = '------'
676       slices = '     0'
677       coordinates = '   0.0'
678       i = 1
679       DO  WHILE ( subs_vertical_gradient_level_i(i) /= -9999 )
680
681          WRITE (coor_chr,'(E10.2,7X)')  &
682                                w_subs(subs_vertical_gradient_level_i(i))
683          temperatures = TRIM( temperatures ) // ' ' // TRIM( coor_chr )
684
685          WRITE (coor_chr,'(E10.2,7X)')  subs_vertical_gradient(i)
686          gradients = TRIM( gradients ) // ' ' // TRIM( coor_chr )
687
688          WRITE (coor_chr,'(I10,7X)')  subs_vertical_gradient_level_i(i)
689          slices = TRIM( slices ) // ' ' // TRIM( coor_chr )
690
691          WRITE (coor_chr,'(F10.2,7X)')  subs_vertical_gradient_level(i)
692          coordinates = TRIM( coordinates ) // ' '  // TRIM( coor_chr )
693
694          IF ( i == 10 )  THEN
695             EXIT
696          ELSE
697             i = i + 1
698          ENDIF
699
700       ENDDO
701
702 
703       IF ( .NOT. large_scale_forcing )  THEN
704          WRITE ( io, 426 )  TRIM( coordinates ), TRIM( temperatures ), &
705                             TRIM( gradients ), TRIM( slices )
706       ENDIF
707
708
709    ENDIF
710
711!-- Profile of the geostrophic wind (component ug)
712!-- Building output strings
713    WRITE ( ugcomponent, '(F6.2)' )  ug_surface
714    gradients = '------'
715    slices = '     0'
716    coordinates = '   0.0'
717    i = 1
718    DO  WHILE ( ug_vertical_gradient_level_ind(i) /= -9999 )
719     
720       WRITE (coor_chr,'(F6.2,1X)')  ug(ug_vertical_gradient_level_ind(i))
721       ugcomponent = TRIM( ugcomponent ) // '  ' // TRIM( coor_chr )
722
723       WRITE (coor_chr,'(F6.2,1X)')  ug_vertical_gradient(i)
724       gradients = TRIM( gradients ) // '  ' // TRIM( coor_chr )
725
726       WRITE (coor_chr,'(I6,1X)')  ug_vertical_gradient_level_ind(i)
727       slices = TRIM( slices ) // '  ' // TRIM( coor_chr )
728
729       WRITE (coor_chr,'(F6.1,1X)')  ug_vertical_gradient_level(i)
730       coordinates = TRIM( coordinates ) // '  ' // TRIM( coor_chr )
731
732       IF ( i == 10 )  THEN
733          EXIT
734       ELSE
735          i = i + 1
736       ENDIF
737
738    ENDDO
739
740    IF ( .NOT. large_scale_forcing )  THEN
741       WRITE ( io, 423 )  TRIM( coordinates ), TRIM( ugcomponent ), &
742                          TRIM( gradients ), TRIM( slices )
743    ENDIF
744
745!-- Profile of the geostrophic wind (component vg)
746!-- Building output strings
747    WRITE ( vgcomponent, '(F6.2)' )  vg_surface
748    gradients = '------'
749    slices = '     0'
750    coordinates = '   0.0'
751    i = 1
752    DO  WHILE ( vg_vertical_gradient_level_ind(i) /= -9999 )
753
754       WRITE (coor_chr,'(F6.2,1X)')  vg(vg_vertical_gradient_level_ind(i))
755       vgcomponent = TRIM( vgcomponent ) // '  ' // TRIM( coor_chr )
756
757       WRITE (coor_chr,'(F6.2,1X)')  vg_vertical_gradient(i)
758       gradients = TRIM( gradients ) // '  ' // TRIM( coor_chr )
759
760       WRITE (coor_chr,'(I6,1X)')  vg_vertical_gradient_level_ind(i)
761       slices = TRIM( slices ) // '  ' // TRIM( coor_chr )
762
763       WRITE (coor_chr,'(F6.1,1X)')  vg_vertical_gradient_level(i)
764       coordinates = TRIM( coordinates ) // '  ' // TRIM( coor_chr )
765
766       IF ( i == 10 )  THEN
767          EXIT
768       ELSE
769          i = i + 1
770       ENDIF
771 
772    ENDDO
773
774    IF ( .NOT. large_scale_forcing )  THEN
775       WRITE ( io, 424 )  TRIM( coordinates ), TRIM( vgcomponent ), &
776                          TRIM( gradients ), TRIM( slices )
777    ENDIF
778
779!
[1]780!-- Topography
781    WRITE ( io, 270 )  topography
782    SELECT CASE ( TRIM( topography ) )
783
784       CASE ( 'flat' )
785          ! no actions necessary
786
787       CASE ( 'single_building' )
788          blx = INT( building_length_x / dx )
789          bly = INT( building_length_y / dy )
[1675]790          bh  = MINLOC( ABS( zw - building_height ), 1 ) - 1
791          IF ( ABS( zw(bh  ) - building_height ) == &
792               ABS( zw(bh+1) - building_height )    )  bh = bh + 1
[1]793
[1322]794          IF ( building_wall_left == 9999999.9_wp )  THEN
[1]795             building_wall_left = ( nx + 1 - blx ) / 2 * dx
796          ENDIF
[1353]797          bxl = INT ( building_wall_left / dx + 0.5_wp )
[1]798          bxr = bxl + blx
799
[1322]800          IF ( building_wall_south == 9999999.9_wp )  THEN
[1]801             building_wall_south = ( ny + 1 - bly ) / 2 * dy
802          ENDIF
[1353]803          bys = INT ( building_wall_south / dy + 0.5_wp )
[1]804          byn = bys + bly
805
806          WRITE ( io, 271 )  building_length_x, building_length_y, &
807                             building_height, bxl, bxr, bys, byn
808
[240]809       CASE ( 'single_street_canyon' )
[1675]810          ch  = MINLOC( ABS( zw - canyon_height ), 1 ) - 1
811          IF ( ABS( zw(ch  ) - canyon_height ) == &
812               ABS( zw(ch+1) - canyon_height )    )  ch = ch + 1
[1322]813          IF ( canyon_width_x /= 9999999.9_wp )  THEN
[240]814!
815!--          Street canyon in y direction
816             cwx = NINT( canyon_width_x / dx )
[1322]817             IF ( canyon_wall_left == 9999999.9_wp )  THEN
[240]818                canyon_wall_left = ( nx + 1 - cwx ) / 2 * dx
819             ENDIF
820             cxl = NINT( canyon_wall_left / dx )
821             cxr = cxl + cwx
822             WRITE ( io, 272 )  'y', canyon_height, ch, 'u', cxl, cxr
823
[1322]824          ELSEIF ( canyon_width_y /= 9999999.9_wp )  THEN
[240]825!
826!--          Street canyon in x direction
827             cwy = NINT( canyon_width_y / dy )
[1322]828             IF ( canyon_wall_south == 9999999.9_wp )  THEN
[240]829                canyon_wall_south = ( ny + 1 - cwy ) / 2 * dy
830             ENDIF
831             cys = NINT( canyon_wall_south / dy )
832             cyn = cys + cwy
833             WRITE ( io, 272 )  'x', canyon_height, ch, 'v', cys, cyn
834          ENDIF
835
[1]836    END SELECT
837
[256]838    IF ( TRIM( topography ) /= 'flat' )  THEN
839       IF ( TRIM( topography_grid_convention ) == ' ' )  THEN
840          IF ( TRIM( topography ) == 'single_building' .OR.  &
841               TRIM( topography ) == 'single_street_canyon' )  THEN
842             WRITE ( io, 278 )
843          ELSEIF ( TRIM( topography ) == 'read_from_file' )  THEN
844             WRITE ( io, 279 )
845          ENDIF
846       ELSEIF ( TRIM( topography_grid_convention ) == 'cell_edge' )  THEN
847          WRITE ( io, 278 )
848       ELSEIF ( TRIM( topography_grid_convention ) == 'cell_center' )  THEN
849          WRITE ( io, 279 )
850       ENDIF
851    ENDIF
852
[1299]853    IF ( plant_canopy )  THEN
[1484]854   
855       canopy_height = pch_index * dz
[138]856
[1484]857       WRITE ( io, 280 )  canopy_mode, canopy_height, pch_index,               &
858                          canopy_drag_coeff
[1299]859       IF ( passive_scalar )  THEN
[1484]860          WRITE ( io, 281 )  leaf_scalar_exch_coeff,                           &
861                             leaf_surface_conc
[153]862       ENDIF
[138]863
[1]864!
[153]865!--    Heat flux at the top of vegetation
[1484]866       WRITE ( io, 282 )  cthf
[153]867
868!
[1484]869!--    Leaf area density profile, calculated either from given vertical
870!--    gradients or from beta probability density function.
871       IF (  .NOT.  calc_beta_lad_profile )  THEN
[138]872
[1484]873!--       Building output strings, starting with surface value
[1697]874          WRITE ( leaf_area_density, '(F7.4)' )  lad_surface
[1484]875          gradients = '------'
876          slices = '     0'
877          coordinates = '   0.0'
878          i = 1
879          DO  WHILE ( i < 11  .AND.  lad_vertical_gradient_level_ind(i) /= -9999 )
[138]880
[1484]881             WRITE (coor_chr,'(F7.2)')  lad(lad_vertical_gradient_level_ind(i))
882             leaf_area_density = TRIM( leaf_area_density ) // ' ' // TRIM( coor_chr )
883 
884             WRITE (coor_chr,'(F7.2)')  lad_vertical_gradient(i)
885             gradients = TRIM( gradients ) // ' ' // TRIM( coor_chr )
[138]886
[1484]887             WRITE (coor_chr,'(I7)')  lad_vertical_gradient_level_ind(i)
888             slices = TRIM( slices ) // ' ' // TRIM( coor_chr )
[138]889
[1484]890             WRITE (coor_chr,'(F7.1)')  lad_vertical_gradient_level(i)
891             coordinates = TRIM( coordinates ) // ' '  // TRIM( coor_chr )
[138]892
[1484]893             i = i + 1
894          ENDDO
[138]895
[1484]896          WRITE ( io, 283 )  TRIM( coordinates ), TRIM( leaf_area_density ),              &
897                             TRIM( gradients ), TRIM( slices )
[138]898
[1484]899       ELSE
900       
[1697]901          WRITE ( leaf_area_density, '(F7.4)' )  lad_surface
[1484]902          coordinates = '   0.0'
903         
904          DO  k = 1, pch_index
905
906             WRITE (coor_chr,'(F7.2)')  lad(k)
907             leaf_area_density = TRIM( leaf_area_density ) // ' ' // TRIM( coor_chr )
908 
909             WRITE (coor_chr,'(F7.1)')  zu(k)
910             coordinates = TRIM( coordinates ) // ' '  // TRIM( coor_chr )
911
912          ENDDO       
913
914          WRITE ( io, 284 ) TRIM( coordinates ), TRIM( leaf_area_density ), alpha_lad,    &
915                            beta_lad, lai_beta
916
917       ENDIF 
918
[138]919    ENDIF
920
[1484]921
[1551]922    IF ( land_surface )  THEN
923
924       temperatures = ''
925       gradients    = '' ! use for humidity here
926       coordinates  = '' ! use for height
927       roots        = '' ! use for root fraction
928       slices       = '' ! use for index
929
930       i = 1
931       DO i = nzb_soil, nzt_soil
932          WRITE (coor_chr,'(F10.2,7X)') soil_temperature(i)
933          temperatures = TRIM( temperatures ) // ' ' // TRIM( coor_chr )
934
935          WRITE (coor_chr,'(F10.2,7X)') soil_moisture(i)
936          gradients = TRIM( gradients ) // ' ' // TRIM( coor_chr )
937
938          WRITE (coor_chr,'(F10.2,7X)')  - zs(i)
939          coordinates = TRIM( coordinates ) // ' '  // TRIM( coor_chr )
940
941          WRITE (coor_chr,'(F10.2,7X)')  root_fraction(i)
942          roots = TRIM( roots ) // ' '  // TRIM( coor_chr )
943
944          WRITE (coor_chr,'(I10,7X)')  i
945          slices = TRIM( slices ) // ' '  // TRIM( coor_chr )
946
947
948       ENDDO
949
[138]950!
[1551]951!--    Write land surface model header
952       WRITE( io, 419 )
953       IF ( conserve_water_content )  THEN
954          WRITE( io, 440 )
955       ELSE
956          WRITE( io, 441 )
957       ENDIF
958
959       IF ( dewfall )  THEN
960          WRITE( io, 442 )
961       ELSE
962          WRITE( io, 443 )
963       ENDIF
964
[1590]965       WRITE( io, 438 ) TRIM( veg_type_name(veg_type) ),                       &
966                        TRIM (soil_type_name(soil_type) )
[1551]967       WRITE( io, 439 ) TRIM( coordinates ), TRIM( temperatures ),             &
968                        TRIM( gradients ), TRIM( roots ), TRIM( slices )
969
970
971    ENDIF
972
973    IF ( radiation )  THEN
974!
[1585]975!--    Write radiation model header
[1551]976       WRITE( io, 444 )
977
978       IF ( radiation_scheme == "constant" )  THEN
979          WRITE( io, 445 ) net_radiation
980       ELSEIF ( radiation_scheme == "clear-sky" )  THEN
981          WRITE( io, 446 )
[1585]982       ELSEIF ( radiation_scheme == "rrtmg" )  THEN
983          WRITE( io, 447 )
984          IF ( .NOT. lw_radiation )  WRITE( io, 458 )
985          IF ( .NOT. sw_radiation )  WRITE( io, 459 )
986       ENDIF
987
988       IF ( albedo_type == 0 )  THEN
989          WRITE( io, 448 ) albedo
[1551]990       ELSE
[1590]991          WRITE( io, 456 ) TRIM( albedo_type_name(albedo_type) )
[1551]992       ENDIF
[1585]993       IF ( constant_albedo )  THEN
994          WRITE( io, 457 )
995       ENDIF
[1551]996       WRITE( io, 449 ) dt_radiation
997    ENDIF
998
999
1000!
[1]1001!-- Boundary conditions
1002    IF ( ibc_p_b == 0 )  THEN
1003       runten = 'p(0)     = 0      |'
1004    ELSEIF ( ibc_p_b == 1 )  THEN
1005       runten = 'p(0)     = p(1)   |'
1006    ENDIF
1007    IF ( ibc_p_t == 0 )  THEN
1008       roben  = 'p(nzt+1) = 0      |'
1009    ELSE
1010       roben  = 'p(nzt+1) = p(nzt) |'
1011    ENDIF
1012
1013    IF ( ibc_uv_b == 0 )  THEN
1014       runten = TRIM( runten ) // ' uv(0)     = -uv(1)                |'
1015    ELSE
1016       runten = TRIM( runten ) // ' uv(0)     = uv(1)                 |'
1017    ENDIF
[132]1018    IF ( TRIM( bc_uv_t ) == 'dirichlet_0' )  THEN
1019       roben  = TRIM( roben  ) // ' uv(nzt+1) = 0                     |'
1020    ELSEIF ( ibc_uv_t == 0 )  THEN
[1]1021       roben  = TRIM( roben  ) // ' uv(nzt+1) = ug(nzt+1), vg(nzt+1)  |'
1022    ELSE
1023       roben  = TRIM( roben  ) // ' uv(nzt+1) = uv(nzt)               |'
1024    ENDIF
1025
1026    IF ( ibc_pt_b == 0 )  THEN
[1551]1027       IF ( land_surface )  THEN
1028          runten = TRIM( runten ) // ' pt(0)     = from soil model'
1029       ELSE
1030          runten = TRIM( runten ) // ' pt(0)     = pt_surface'
1031       ENDIF
[102]1032    ELSEIF ( ibc_pt_b == 1 )  THEN
[1551]1033       runten = TRIM( runten ) // ' pt(0)     = pt(1)'
[102]1034    ELSEIF ( ibc_pt_b == 2 )  THEN
[1551]1035       runten = TRIM( runten ) // ' pt(0)     = from coupled model'
[1]1036    ENDIF
1037    IF ( ibc_pt_t == 0 )  THEN
[19]1038       roben  = TRIM( roben  ) // ' pt(nzt+1) = pt_top'
1039    ELSEIF( ibc_pt_t == 1 )  THEN
1040       roben  = TRIM( roben  ) // ' pt(nzt+1) = pt(nzt)'
1041    ELSEIF( ibc_pt_t == 2 )  THEN
1042       roben  = TRIM( roben  ) // ' pt(nzt+1) = pt(nzt) + dpt/dz_ini'
[667]1043
[1]1044    ENDIF
1045
1046    WRITE ( io, 300 )  runten, roben
1047
1048    IF ( .NOT. constant_diffusion )  THEN
1049       IF ( ibc_e_b == 1 )  THEN
1050          runten = 'e(0)     = e(1)'
1051       ELSE
1052          runten = 'e(0)     = e(1) = (u*/0.1)**2'
1053       ENDIF
1054       roben = 'e(nzt+1) = e(nzt) = e(nzt-1)'
1055
[97]1056       WRITE ( io, 301 )  'e', runten, roben       
[1]1057
1058    ENDIF
1059
[97]1060    IF ( ocean )  THEN
1061       runten = 'sa(0)    = sa(1)'
1062       IF ( ibc_sa_t == 0 )  THEN
1063          roben =  'sa(nzt+1) = sa_surface'
[1]1064       ELSE
[97]1065          roben =  'sa(nzt+1) = sa(nzt)'
[1]1066       ENDIF
[97]1067       WRITE ( io, 301 ) 'sa', runten, roben
1068    ENDIF
[1]1069
[97]1070    IF ( humidity )  THEN
1071       IF ( ibc_q_b == 0 )  THEN
[1551]1072          IF ( land_surface )  THEN
1073             runten = 'q(0)     = from soil model'
1074          ELSE
1075             runten = 'q(0)     = q_surface'
1076          ENDIF
1077
[97]1078       ELSE
1079          runten = 'q(0)     = q(1)'
1080       ENDIF
1081       IF ( ibc_q_t == 0 )  THEN
1082          roben =  'q(nzt)   = q_top'
1083       ELSE
1084          roben =  'q(nzt)   = q(nzt-1) + dq/dz'
1085       ENDIF
1086       WRITE ( io, 301 ) 'q', runten, roben
1087    ENDIF
[1]1088
[97]1089    IF ( passive_scalar )  THEN
1090       IF ( ibc_q_b == 0 )  THEN
1091          runten = 's(0)     = s_surface'
1092       ELSE
1093          runten = 's(0)     = s(1)'
1094       ENDIF
1095       IF ( ibc_q_t == 0 )  THEN
1096          roben =  's(nzt)   = s_top'
1097       ELSE
1098          roben =  's(nzt)   = s(nzt-1) + ds/dz'
1099       ENDIF
1100       WRITE ( io, 301 ) 's', runten, roben
[1]1101    ENDIF
1102
1103    IF ( use_surface_fluxes )  THEN
1104       WRITE ( io, 303 )
1105       IF ( constant_heatflux )  THEN
[1299]1106          IF ( large_scale_forcing .AND. lsf_surf )  THEN
[1241]1107             WRITE ( io, 306 )  shf(0,0)
1108          ELSE
1109             WRITE ( io, 306 )  surface_heatflux
1110          ENDIF
[1]1111          IF ( random_heatflux )  WRITE ( io, 307 )
1112       ENDIF
[75]1113       IF ( humidity  .AND.  constant_waterflux )  THEN
[1299]1114          IF ( large_scale_forcing .AND. lsf_surf )  THEN
[1241]1115             WRITE ( io, 311 ) qsws(0,0)
1116          ELSE
1117             WRITE ( io, 311 ) surface_waterflux
1118          ENDIF
[1]1119       ENDIF
1120       IF ( passive_scalar  .AND.  constant_waterflux )  THEN
1121          WRITE ( io, 313 ) surface_waterflux
1122       ENDIF
1123    ENDIF
1124
[19]1125    IF ( use_top_fluxes )  THEN
1126       WRITE ( io, 304 )
[102]1127       IF ( coupling_mode == 'uncoupled' )  THEN
[151]1128          WRITE ( io, 320 )  top_momentumflux_u, top_momentumflux_v
[102]1129          IF ( constant_top_heatflux )  THEN
1130             WRITE ( io, 306 )  top_heatflux
1131          ENDIF
1132       ELSEIF ( coupling_mode == 'ocean_to_atmosphere' )  THEN
1133          WRITE ( io, 316 )
[19]1134       ENDIF
[97]1135       IF ( ocean  .AND.  constant_top_salinityflux )  THEN
1136          WRITE ( io, 309 )  top_salinityflux
1137       ENDIF
[75]1138       IF ( humidity  .OR.  passive_scalar )  THEN
[19]1139          WRITE ( io, 315 )
1140       ENDIF
1141    ENDIF
1142
[1691]1143    IF ( constant_flux_layer )  THEN
1144       WRITE ( io, 305 )  (zu(1)-zu(0)), roughness_length,                     &
1145                          z0h_factor*roughness_length, kappa,                  &
1146                          zeta_min, zeta_max
[1]1147       IF ( .NOT. constant_heatflux )  WRITE ( io, 308 )
[75]1148       IF ( humidity  .AND.  .NOT. constant_waterflux )  THEN
[1]1149          WRITE ( io, 312 )
1150       ENDIF
1151       IF ( passive_scalar  .AND.  .NOT. constant_waterflux )  THEN
1152          WRITE ( io, 314 )
1153       ENDIF
1154    ELSE
1155       IF ( INDEX(initializing_actions, 'set_1d-model_profiles') /= 0 )  THEN
[1691]1156          WRITE ( io, 310 )  zeta_min, zeta_max
[1]1157       ENDIF
1158    ENDIF
1159
1160    WRITE ( io, 317 )  bc_lr, bc_ns
[707]1161    IF ( .NOT. bc_lr_cyc  .OR.  .NOT. bc_ns_cyc )  THEN
[1159]1162       WRITE ( io, 318 )  use_cmax, pt_damping_width, pt_damping_factor       
[151]1163       IF ( turbulent_inflow )  THEN
[1560]1164          IF ( .NOT. recycling_yshift ) THEN
1165             WRITE ( io, 319 )  recycling_width, recycling_plane, &
1166                                inflow_damping_height, inflow_damping_width
1167          ELSE
1168             WRITE ( io, 322 )  recycling_width, recycling_plane, &
1169                                inflow_damping_height, inflow_damping_width
1170          END IF
[151]1171       ENDIF
[1]1172    ENDIF
1173
1174!
[1365]1175!-- Initial Profiles
1176    WRITE ( io, 321 )
1177!
1178!-- Initial wind profiles
1179    IF ( u_profile(1) /= 9999999.9_wp )  WRITE ( io, 427 )
1180
1181!
1182!-- Initial temperature profile
1183!-- Building output strings, starting with surface temperature
1184    WRITE ( temperatures, '(F6.2)' )  pt_surface
1185    gradients = '------'
1186    slices = '     0'
1187    coordinates = '   0.0'
1188    i = 1
1189    DO  WHILE ( pt_vertical_gradient_level_ind(i) /= -9999 )
1190
1191       WRITE (coor_chr,'(F7.2)')  pt_init(pt_vertical_gradient_level_ind(i))
1192       temperatures = TRIM( temperatures ) // ' ' // TRIM( coor_chr )
1193
1194       WRITE (coor_chr,'(F7.2)')  pt_vertical_gradient(i)
1195       gradients = TRIM( gradients ) // ' ' // TRIM( coor_chr )
1196
1197       WRITE (coor_chr,'(I7)')  pt_vertical_gradient_level_ind(i)
1198       slices = TRIM( slices ) // ' ' // TRIM( coor_chr )
1199
1200       WRITE (coor_chr,'(F7.1)')  pt_vertical_gradient_level(i)
1201       coordinates = TRIM( coordinates ) // ' '  // TRIM( coor_chr )
1202
1203       IF ( i == 10 )  THEN
1204          EXIT
1205       ELSE
1206          i = i + 1
1207       ENDIF
1208
1209    ENDDO
1210
1211    IF ( .NOT. nudging )  THEN
1212       WRITE ( io, 420 )  TRIM( coordinates ), TRIM( temperatures ), &
1213                          TRIM( gradients ), TRIM( slices )
1214    ELSE
1215       WRITE ( io, 428 ) 
1216    ENDIF
1217
1218!
1219!-- Initial humidity profile
1220!-- Building output strings, starting with surface humidity
1221    IF ( humidity  .OR.  passive_scalar )  THEN
1222       WRITE ( temperatures, '(E8.1)' )  q_surface
1223       gradients = '--------'
1224       slices = '       0'
1225       coordinates = '     0.0'
1226       i = 1
1227       DO  WHILE ( q_vertical_gradient_level_ind(i) /= -9999 )
1228         
1229          WRITE (coor_chr,'(E8.1,4X)')  q_init(q_vertical_gradient_level_ind(i))
1230          temperatures = TRIM( temperatures ) // '  ' // TRIM( coor_chr )
1231
1232          WRITE (coor_chr,'(E8.1,4X)')  q_vertical_gradient(i)
1233          gradients = TRIM( gradients ) // '  ' // TRIM( coor_chr )
1234         
1235          WRITE (coor_chr,'(I8,4X)')  q_vertical_gradient_level_ind(i)
1236          slices = TRIM( slices ) // '  ' // TRIM( coor_chr )
1237         
1238          WRITE (coor_chr,'(F8.1,4X)')  q_vertical_gradient_level(i)
1239          coordinates = TRIM( coordinates ) // '  '  // TRIM( coor_chr )
1240
1241          IF ( i == 10 )  THEN
1242             EXIT
1243          ELSE
1244             i = i + 1
1245          ENDIF
1246
1247       ENDDO
1248
1249       IF ( humidity )  THEN
1250          IF ( .NOT. nudging )  THEN
1251             WRITE ( io, 421 )  TRIM( coordinates ), TRIM( temperatures ), &
1252                                TRIM( gradients ), TRIM( slices )
1253          ENDIF
1254       ELSE
1255          WRITE ( io, 422 )  TRIM( coordinates ), TRIM( temperatures ), &
1256                             TRIM( gradients ), TRIM( slices )
1257       ENDIF
1258    ENDIF
1259
1260!
1261!-- Initial salinity profile
1262!-- Building output strings, starting with surface salinity
1263    IF ( ocean )  THEN
1264       WRITE ( temperatures, '(F6.2)' )  sa_surface
1265       gradients = '------'
1266       slices = '     0'
1267       coordinates = '   0.0'
1268       i = 1
1269       DO  WHILE ( sa_vertical_gradient_level_ind(i) /= -9999 )
1270
1271          WRITE (coor_chr,'(F7.2)')  sa_init(sa_vertical_gradient_level_ind(i))
1272          temperatures = TRIM( temperatures ) // ' ' // TRIM( coor_chr )
1273
1274          WRITE (coor_chr,'(F7.2)')  sa_vertical_gradient(i)
1275          gradients = TRIM( gradients ) // ' ' // TRIM( coor_chr )
1276
1277          WRITE (coor_chr,'(I7)')  sa_vertical_gradient_level_ind(i)
1278          slices = TRIM( slices ) // ' ' // TRIM( coor_chr )
1279
1280          WRITE (coor_chr,'(F7.1)')  sa_vertical_gradient_level(i)
1281          coordinates = TRIM( coordinates ) // ' '  // TRIM( coor_chr )
1282
1283          IF ( i == 10 )  THEN
1284             EXIT
1285          ELSE
1286             i = i + 1
1287          ENDIF
1288
1289       ENDDO
1290
1291       WRITE ( io, 425 )  TRIM( coordinates ), TRIM( temperatures ), &
1292                          TRIM( gradients ), TRIM( slices )
1293    ENDIF
1294
1295
1296!
[1]1297!-- Listing of 1D-profiles
[151]1298    WRITE ( io, 325 )  dt_dopr_listing
[1353]1299    IF ( averaging_interval_pr /= 0.0_wp )  THEN
[151]1300       WRITE ( io, 326 )  averaging_interval_pr, dt_averaging_input_pr
[1]1301    ENDIF
1302
1303!
1304!-- DATA output
1305    WRITE ( io, 330 )
[1353]1306    IF ( averaging_interval_pr /= 0.0_wp )  THEN
[151]1307       WRITE ( io, 326 )  averaging_interval_pr, dt_averaging_input_pr
[1]1308    ENDIF
1309
1310!
1311!-- 1D-profiles
[346]1312    dopr_chr = 'Profile:'
[1]1313    IF ( dopr_n /= 0 )  THEN
1314       WRITE ( io, 331 )
1315
1316       output_format = ''
[1327]1317       output_format = output_format_netcdf
[292]1318       WRITE ( io, 344 )  output_format
[1]1319
1320       DO  i = 1, dopr_n
1321          dopr_chr = TRIM( dopr_chr ) // ' ' // TRIM( data_output_pr(i) ) // ','
1322          IF ( LEN_TRIM( dopr_chr ) >= 60 )  THEN
1323             WRITE ( io, 332 )  dopr_chr
1324             dopr_chr = '       :'
1325          ENDIF
1326       ENDDO
1327
1328       IF ( dopr_chr /= '' )  THEN
1329          WRITE ( io, 332 )  dopr_chr
1330       ENDIF
1331       WRITE ( io, 333 )  dt_dopr, averaging_interval_pr, dt_averaging_input_pr
[1353]1332       IF ( skip_time_dopr /= 0.0_wp )  WRITE ( io, 339 )  skip_time_dopr
[1]1333    ENDIF
1334
1335!
1336!-- 2D-arrays
1337    DO  av = 0, 1
1338
1339       i = 1
1340       do2d_xy = ''
1341       do2d_xz = ''
1342       do2d_yz = ''
1343       DO  WHILE ( do2d(av,i) /= ' ' )
1344
1345          l = MAX( 2, LEN_TRIM( do2d(av,i) ) )
1346          do2d_mode = do2d(av,i)(l-1:l)
1347
1348          SELECT CASE ( do2d_mode )
1349             CASE ( 'xy' )
1350                ll = LEN_TRIM( do2d_xy )
1351                do2d_xy = do2d_xy(1:ll) // ' ' // do2d(av,i)(1:l-3) // ','
1352             CASE ( 'xz' )
1353                ll = LEN_TRIM( do2d_xz )
1354                do2d_xz = do2d_xz(1:ll) // ' ' // do2d(av,i)(1:l-3) // ','
1355             CASE ( 'yz' )
1356                ll = LEN_TRIM( do2d_yz )
1357                do2d_yz = do2d_yz(1:ll) // ' ' // do2d(av,i)(1:l-3) // ','
1358          END SELECT
1359
1360          i = i + 1
1361
1362       ENDDO
1363
1364       IF ( ( ( do2d_xy /= ''  .AND.  section(1,1) /= -9999 )  .OR.    &
1365              ( do2d_xz /= ''  .AND.  section(1,2) /= -9999 )  .OR.    &
[1327]1366              ( do2d_yz /= ''  .AND.  section(1,3) /= -9999 ) ) )  THEN
[1]1367
1368          IF (  av == 0 )  THEN
1369             WRITE ( io, 334 )  ''
1370          ELSE
1371             WRITE ( io, 334 )  '(time-averaged)'
1372          ENDIF
1373
1374          IF ( do2d_at_begin )  THEN
1375             begin_chr = 'and at the start'
1376          ELSE
1377             begin_chr = ''
1378          ENDIF
1379
1380          output_format = ''
[1327]1381          output_format = output_format_netcdf
[292]1382          WRITE ( io, 344 )  output_format
[1]1383
1384          IF ( do2d_xy /= ''  .AND.  section(1,1) /= -9999 )  THEN
1385             i = 1
1386             slices = '/'
1387             coordinates = '/'
1388!
[1551]1389!--          Building strings with index and coordinate information of the
[1]1390!--          slices
1391             DO  WHILE ( section(i,1) /= -9999 )
1392
1393                WRITE (section_chr,'(I5)')  section(i,1)
1394                section_chr = ADJUSTL( section_chr )
1395                slices = TRIM( slices ) // TRIM( section_chr ) // '/'
1396
[206]1397                IF ( section(i,1) == -1 )  THEN
[1353]1398                   WRITE (coor_chr,'(F10.1)')  -1.0_wp
[206]1399                ELSE
1400                   WRITE (coor_chr,'(F10.1)')  zu(section(i,1))
1401                ENDIF
[1]1402                coor_chr = ADJUSTL( coor_chr )
1403                coordinates = TRIM( coordinates ) // TRIM( coor_chr ) // '/'
1404
1405                i = i + 1
1406             ENDDO
1407             IF ( av == 0 )  THEN
1408                WRITE ( io, 335 )  'XY', do2d_xy, dt_do2d_xy, &
1409                                   TRIM( begin_chr ), 'k', TRIM( slices ), &
1410                                   TRIM( coordinates )
[1353]1411                IF ( skip_time_do2d_xy /= 0.0_wp )  THEN
[1]1412                   WRITE ( io, 339 )  skip_time_do2d_xy
1413                ENDIF
1414             ELSE
1415                WRITE ( io, 342 )  'XY', do2d_xy, dt_data_output_av, &
1416                                   TRIM( begin_chr ), averaging_interval, &
1417                                   dt_averaging_input, 'k', TRIM( slices ), &
1418                                   TRIM( coordinates )
[1353]1419                IF ( skip_time_data_output_av /= 0.0_wp )  THEN
[1]1420                   WRITE ( io, 339 )  skip_time_data_output_av
1421                ENDIF
1422             ENDIF
[1308]1423             IF ( netcdf_data_format > 4 )  THEN
1424                WRITE ( io, 352 )  ntdim_2d_xy(av)
1425             ELSE
1426                WRITE ( io, 353 )
1427             ENDIF
[1]1428          ENDIF
1429
1430          IF ( do2d_xz /= ''  .AND.  section(1,2) /= -9999 )  THEN
1431             i = 1
1432             slices = '/'
1433             coordinates = '/'
1434!
[1551]1435!--          Building strings with index and coordinate information of the
[1]1436!--          slices
1437             DO  WHILE ( section(i,2) /= -9999 )
1438
1439                WRITE (section_chr,'(I5)')  section(i,2)
1440                section_chr = ADJUSTL( section_chr )
1441                slices = TRIM( slices ) // TRIM( section_chr ) // '/'
1442
1443                WRITE (coor_chr,'(F10.1)')  section(i,2) * dy
1444                coor_chr = ADJUSTL( coor_chr )
1445                coordinates = TRIM( coordinates ) // TRIM( coor_chr ) // '/'
1446
1447                i = i + 1
1448             ENDDO
1449             IF ( av == 0 )  THEN
1450                WRITE ( io, 335 )  'XZ', do2d_xz, dt_do2d_xz, &
1451                                   TRIM( begin_chr ), 'j', TRIM( slices ), &
1452                                   TRIM( coordinates )
[1353]1453                IF ( skip_time_do2d_xz /= 0.0_wp )  THEN
[1]1454                   WRITE ( io, 339 )  skip_time_do2d_xz
1455                ENDIF
1456             ELSE
1457                WRITE ( io, 342 )  'XZ', do2d_xz, dt_data_output_av, &
1458                                   TRIM( begin_chr ), averaging_interval, &
1459                                   dt_averaging_input, 'j', TRIM( slices ), &
1460                                   TRIM( coordinates )
[1353]1461                IF ( skip_time_data_output_av /= 0.0_wp )  THEN
[1]1462                   WRITE ( io, 339 )  skip_time_data_output_av
1463                ENDIF
1464             ENDIF
[1308]1465             IF ( netcdf_data_format > 4 )  THEN
1466                WRITE ( io, 352 )  ntdim_2d_xz(av)
1467             ELSE
1468                WRITE ( io, 353 )
1469             ENDIF
[1]1470          ENDIF
1471
1472          IF ( do2d_yz /= ''  .AND.  section(1,3) /= -9999 )  THEN
1473             i = 1
1474             slices = '/'
1475             coordinates = '/'
1476!
[1551]1477!--          Building strings with index and coordinate information of the
[1]1478!--          slices
1479             DO  WHILE ( section(i,3) /= -9999 )
1480
1481                WRITE (section_chr,'(I5)')  section(i,3)
1482                section_chr = ADJUSTL( section_chr )
1483                slices = TRIM( slices ) // TRIM( section_chr ) // '/'
1484
1485                WRITE (coor_chr,'(F10.1)')  section(i,3) * dx
1486                coor_chr = ADJUSTL( coor_chr )
1487                coordinates = TRIM( coordinates ) // TRIM( coor_chr ) // '/'
1488
1489                i = i + 1
1490             ENDDO
1491             IF ( av == 0 )  THEN
1492                WRITE ( io, 335 )  'YZ', do2d_yz, dt_do2d_yz, &
1493                                   TRIM( begin_chr ), 'i', TRIM( slices ), &
1494                                   TRIM( coordinates )
[1353]1495                IF ( skip_time_do2d_yz /= 0.0_wp )  THEN
[1]1496                   WRITE ( io, 339 )  skip_time_do2d_yz
1497                ENDIF
1498             ELSE
1499                WRITE ( io, 342 )  'YZ', do2d_yz, dt_data_output_av, &
1500                                   TRIM( begin_chr ), averaging_interval, &
1501                                   dt_averaging_input, 'i', TRIM( slices ), &
1502                                   TRIM( coordinates )
[1353]1503                IF ( skip_time_data_output_av /= 0.0_wp )  THEN
[1]1504                   WRITE ( io, 339 )  skip_time_data_output_av
1505                ENDIF
1506             ENDIF
[1308]1507             IF ( netcdf_data_format > 4 )  THEN
1508                WRITE ( io, 352 )  ntdim_2d_yz(av)
1509             ELSE
1510                WRITE ( io, 353 )
1511             ENDIF
[1]1512          ENDIF
1513
1514       ENDIF
1515
1516    ENDDO
1517
1518!
1519!-- 3d-arrays
1520    DO  av = 0, 1
1521
1522       i = 1
1523       do3d_chr = ''
1524       DO  WHILE ( do3d(av,i) /= ' ' )
1525
1526          do3d_chr = TRIM( do3d_chr ) // ' ' // TRIM( do3d(av,i) ) // ','
1527          i = i + 1
1528
1529       ENDDO
1530
1531       IF ( do3d_chr /= '' )  THEN
1532          IF ( av == 0 )  THEN
1533             WRITE ( io, 336 )  ''
1534          ELSE
1535             WRITE ( io, 336 )  '(time-averaged)'
1536          ENDIF
1537
[1327]1538          output_format = output_format_netcdf
[292]1539          WRITE ( io, 344 )  output_format
[1]1540
1541          IF ( do3d_at_begin )  THEN
1542             begin_chr = 'and at the start'
1543          ELSE
1544             begin_chr = ''
1545          ENDIF
1546          IF ( av == 0 )  THEN
1547             WRITE ( io, 337 )  do3d_chr, dt_do3d, TRIM( begin_chr ), &
1548                                zu(nz_do3d), nz_do3d
1549          ELSE
1550             WRITE ( io, 343 )  do3d_chr, dt_data_output_av,           &
1551                                TRIM( begin_chr ), averaging_interval, &
1552                                dt_averaging_input, zu(nz_do3d), nz_do3d
1553          ENDIF
1554
[1308]1555          IF ( netcdf_data_format > 4 )  THEN
1556             WRITE ( io, 352 )  ntdim_3d(av)
1557          ELSE
1558             WRITE ( io, 353 )
1559          ENDIF
1560
[1]1561          IF ( av == 0 )  THEN
[1353]1562             IF ( skip_time_do3d /= 0.0_wp )  THEN
[1]1563                WRITE ( io, 339 )  skip_time_do3d
1564             ENDIF
1565          ELSE
[1353]1566             IF ( skip_time_data_output_av /= 0.0_wp )  THEN
[1]1567                WRITE ( io, 339 )  skip_time_data_output_av
1568             ENDIF
1569          ENDIF
1570
1571       ENDIF
1572
1573    ENDDO
1574
1575!
[410]1576!-- masked arrays
1577    IF ( masks > 0 )  WRITE ( io, 345 )  &
1578         mask_scale_x, mask_scale_y, mask_scale_z
1579    DO  mid = 1, masks
1580       DO  av = 0, 1
1581
1582          i = 1
1583          domask_chr = ''
1584          DO  WHILE ( domask(mid,av,i) /= ' ' )
1585             domask_chr = TRIM( domask_chr ) // ' ' //  &
1586                          TRIM( domask(mid,av,i) ) // ','
1587             i = i + 1
1588          ENDDO
1589
1590          IF ( domask_chr /= '' )  THEN
1591             IF ( av == 0 )  THEN
1592                WRITE ( io, 346 )  '', mid
1593             ELSE
1594                WRITE ( io, 346 )  ' (time-averaged)', mid
1595             ENDIF
1596
[1327]1597             output_format = output_format_netcdf
[1308]1598!--          Parallel output not implemented for mask data, hence
1599!--          output_format must be adjusted.
1600             IF ( netcdf_data_format == 5 ) output_format = 'netCDF4/HDF5'
1601             IF ( netcdf_data_format == 6 ) output_format = 'netCDF4/HDF5 classic'
[410]1602             WRITE ( io, 344 )  output_format
1603
1604             IF ( av == 0 )  THEN
1605                WRITE ( io, 347 )  domask_chr, dt_domask(mid)
1606             ELSE
1607                WRITE ( io, 348 )  domask_chr, dt_data_output_av, &
1608                                   averaging_interval, dt_averaging_input
1609             ENDIF
1610
1611             IF ( av == 0 )  THEN
[1353]1612                IF ( skip_time_domask(mid) /= 0.0_wp )  THEN
[410]1613                   WRITE ( io, 339 )  skip_time_domask(mid)
1614                ENDIF
1615             ELSE
[1353]1616                IF ( skip_time_data_output_av /= 0.0_wp )  THEN
[410]1617                   WRITE ( io, 339 )  skip_time_data_output_av
1618                ENDIF
1619             ENDIF
1620!
1621!--          output locations
1622             DO  dim = 1, 3
[1353]1623                IF ( mask(mid,dim,1) >= 0.0_wp )  THEN
[410]1624                   count = 0
[1353]1625                   DO  WHILE ( mask(mid,dim,count+1) >= 0.0_wp )
[410]1626                      count = count + 1
1627                   ENDDO
1628                   WRITE ( io, 349 )  dir(dim), dir(dim), mid, dir(dim), &
1629                                      mask(mid,dim,:count)
[1353]1630                ELSEIF ( mask_loop(mid,dim,1) < 0.0_wp .AND.  &
1631                         mask_loop(mid,dim,2) < 0.0_wp .AND.  &
1632                         mask_loop(mid,dim,3) == 0.0_wp )  THEN
[410]1633                   WRITE ( io, 350 )  dir(dim), dir(dim)
[1353]1634                ELSEIF ( mask_loop(mid,dim,3) == 0.0_wp )  THEN
[410]1635                   WRITE ( io, 351 )  dir(dim), dir(dim), mid, dir(dim), &
1636                                      mask_loop(mid,dim,1:2)
1637                ELSE
1638                   WRITE ( io, 351 )  dir(dim), dir(dim), mid, dir(dim), &
1639                                      mask_loop(mid,dim,1:3)
1640                ENDIF
1641             ENDDO
1642          ENDIF
1643
1644       ENDDO
1645    ENDDO
1646
1647!
[1]1648!-- Timeseries
[1322]1649    IF ( dt_dots /= 9999999.9_wp )  THEN
[1]1650       WRITE ( io, 340 )
1651
[1327]1652       output_format = output_format_netcdf
[292]1653       WRITE ( io, 344 )  output_format
[1]1654       WRITE ( io, 341 )  dt_dots
1655    ENDIF
1656
1657#if defined( __dvrp_graphics )
1658!
1659!-- Dvrp-output
[1322]1660    IF ( dt_dvrp /= 9999999.9_wp )  THEN
[1]1661       WRITE ( io, 360 )  dt_dvrp, TRIM( dvrp_output ), TRIM( dvrp_host ), &
1662                          TRIM( dvrp_username ), TRIM( dvrp_directory )
1663       i = 1
1664       l = 0
[336]1665       m = 0
[1]1666       DO WHILE ( mode_dvrp(i) /= ' ' )
1667          IF ( mode_dvrp(i)(1:10) == 'isosurface' )  THEN
[130]1668             READ ( mode_dvrp(i), '(10X,I2)' )  j
[1]1669             l = l + 1
1670             IF ( do3d(0,j) /= ' ' )  THEN
[336]1671                WRITE ( io, 361 )  TRIM( do3d(0,j) ), threshold(l), &
1672                                   isosurface_color(:,l)
[1]1673             ENDIF
1674          ELSEIF ( mode_dvrp(i)(1:6) == 'slicer' )  THEN
[130]1675             READ ( mode_dvrp(i), '(6X,I2)' )  j
[336]1676             m = m + 1
1677             IF ( do2d(0,j) /= ' ' )  THEN
1678                WRITE ( io, 362 )  TRIM( do2d(0,j) ), &
1679                                   slicer_range_limits_dvrp(:,m)
1680             ENDIF
[1]1681          ELSEIF ( mode_dvrp(i)(1:9) == 'particles' )  THEN
[336]1682             WRITE ( io, 363 )  dvrp_psize
1683             IF ( particle_dvrpsize /= 'none' )  THEN
1684                WRITE ( io, 364 )  'size', TRIM( particle_dvrpsize ), &
1685                                   dvrpsize_interval
1686             ENDIF
1687             IF ( particle_color /= 'none' )  THEN
1688                WRITE ( io, 364 )  'color', TRIM( particle_color ), &
1689                                   color_interval
1690             ENDIF
[1]1691          ENDIF
1692          i = i + 1
1693       ENDDO
[237]1694
[336]1695       WRITE ( io, 365 )  groundplate_color, superelevation_x, &
1696                          superelevation_y, superelevation, clip_dvrp_l, &
1697                          clip_dvrp_r, clip_dvrp_s, clip_dvrp_n
1698
1699       IF ( TRIM( topography ) /= 'flat' )  THEN
1700          WRITE ( io, 366 )  topography_color
1701          IF ( cluster_size > 1 )  THEN
1702             WRITE ( io, 367 )  cluster_size
1703          ENDIF
[237]1704       ENDIF
1705
[1]1706    ENDIF
1707#endif
1708
1709#if defined( __spectra )
1710!
1711!-- Spectra output
[1322]1712    IF ( dt_dosp /= 9999999.9_wp )  THEN
[1]1713       WRITE ( io, 370 )
1714
[1327]1715       output_format = output_format_netcdf
[292]1716       WRITE ( io, 344 )  output_format
[1]1717       WRITE ( io, 371 )  dt_dosp
[1353]1718       IF ( skip_time_dosp /= 0.0_wp )  WRITE ( io, 339 )  skip_time_dosp
[1]1719       WRITE ( io, 372 )  ( data_output_sp(i), i = 1,10 ),     &
1720                          ( spectra_direction(i), i = 1,10 ),  &
[189]1721                          ( comp_spectra_level(i), i = 1,100 ), &
1722                          ( plot_spectra_level(i), i = 1,100 ), &
[1]1723                          averaging_interval_sp, dt_averaging_input_pr
1724    ENDIF
1725#endif
1726
1727    WRITE ( io, 99 )
1728
1729!
1730!-- Physical quantities
1731    WRITE ( io, 400 )
1732
1733!
1734!-- Geostrophic parameters
[1551]1735    IF ( radiation .AND. radiation_scheme /= 'constant' )  THEN
1736       WRITE ( io, 417 )  lambda
1737    ENDIF
1738    WRITE ( io, 410 )  phi, omega, f, fs
[1]1739
1740!
1741!-- Other quantities
1742    WRITE ( io, 411 )  g
[1551]1743    IF ( radiation .AND. radiation_scheme /= 'constant' )  THEN
1744       WRITE ( io, 418 )  day_init, time_utc_init
1745    ENDIF
1746
[1179]1747    WRITE ( io, 412 )  TRIM( reference_state )
1748    IF ( use_single_reference_value )  THEN
[97]1749       IF ( ocean )  THEN
[1179]1750          WRITE ( io, 413 )  prho_reference
[97]1751       ELSE
[1179]1752          WRITE ( io, 414 )  pt_reference
[97]1753       ENDIF
1754    ENDIF
[1]1755
1756!
1757!-- Cloud physics parameters
[1299]1758    IF ( cloud_physics )  THEN
[57]1759       WRITE ( io, 415 )
1760       WRITE ( io, 416 ) surface_pressure, r_d, rho_surface, cp, l_v
[1115]1761       IF ( icloud_scheme == 0 )  THEN
[1353]1762          WRITE ( io, 510 ) 1.0E-6_wp * nc_const
[1115]1763          IF ( precipitation )  WRITE ( io, 511 ) c_sedimentation
1764       ENDIF
[1]1765    ENDIF
1766
1767!
[824]1768!-- Cloud physcis parameters / quantities / numerical methods
1769    WRITE ( io, 430 )
1770    IF ( humidity .AND. .NOT. cloud_physics .AND. .NOT. cloud_droplets)  THEN
1771       WRITE ( io, 431 )
1772    ELSEIF ( humidity  .AND.  cloud_physics )  THEN
1773       WRITE ( io, 432 )
[1496]1774       IF ( cloud_top_radiation )  WRITE ( io, 132 )
[1115]1775       IF ( icloud_scheme == 1 )  THEN
1776          IF ( precipitation )  WRITE ( io, 133 )
1777       ELSEIF ( icloud_scheme == 0 )  THEN
1778          IF ( drizzle )  WRITE ( io, 506 )
1779          IF ( precipitation )  THEN
1780             WRITE ( io, 505 )
1781             IF ( turbulence )  WRITE ( io, 507 )
1782             IF ( ventilation_effect )  WRITE ( io, 508 )
1783             IF ( limiter_sedimentation )  WRITE ( io, 509 )
1784          ENDIF
1785       ENDIF
[824]1786    ELSEIF ( humidity  .AND.  cloud_droplets )  THEN
1787       WRITE ( io, 433 )
1788       IF ( curvature_solution_effects )  WRITE ( io, 434 )
[825]1789       IF ( collision_kernel /= 'none' )  THEN
1790          WRITE ( io, 435 )  TRIM( collision_kernel )
[828]1791          IF ( collision_kernel(6:9) == 'fast' )  THEN
1792             WRITE ( io, 436 )  radius_classes, dissipation_classes
1793          ENDIF
[825]1794       ELSE
[828]1795          WRITE ( io, 437 )
[825]1796       ENDIF
[824]1797    ENDIF
1798
1799!
[1]1800!-- LES / turbulence parameters
1801    WRITE ( io, 450 )
1802
1803!--
1804! ... LES-constants used must still be added here
1805!--
1806    IF ( constant_diffusion )  THEN
1807       WRITE ( io, 451 )  km_constant, km_constant/prandtl_number, &
1808                          prandtl_number
1809    ENDIF
1810    IF ( .NOT. constant_diffusion)  THEN
[1353]1811       IF ( e_init > 0.0_wp )  WRITE ( io, 455 )  e_init
1812       IF ( e_min > 0.0_wp )  WRITE ( io, 454 )  e_min
[1]1813       IF ( wall_adjustment )  WRITE ( io, 453 )  wall_adjustment_factor
1814    ENDIF
1815
1816!
1817!-- Special actions during the run
1818    WRITE ( io, 470 )
1819    IF ( create_disturbances )  THEN
1820       WRITE ( io, 471 )  dt_disturb, disturbance_amplitude,                   &
1821                          zu(disturbance_level_ind_b), disturbance_level_ind_b,&
1822                          zu(disturbance_level_ind_t), disturbance_level_ind_t
[707]1823       IF ( .NOT. bc_lr_cyc  .OR.  .NOT. bc_ns_cyc )  THEN
[1]1824          WRITE ( io, 472 )  inflow_disturbance_begin, inflow_disturbance_end
1825       ELSE
1826          WRITE ( io, 473 )  disturbance_energy_limit
1827       ENDIF
1828       WRITE ( io, 474 )  TRIM( random_generator )
1829    ENDIF
[1353]1830    IF ( pt_surface_initial_change /= 0.0_wp )  THEN
[1]1831       WRITE ( io, 475 )  pt_surface_initial_change
1832    ENDIF
[1353]1833    IF ( humidity  .AND.  q_surface_initial_change /= 0.0_wp )  THEN
[1]1834       WRITE ( io, 476 )  q_surface_initial_change       
1835    ENDIF
[1353]1836    IF ( passive_scalar  .AND.  q_surface_initial_change /= 0.0_wp )  THEN
[1]1837       WRITE ( io, 477 )  q_surface_initial_change       
1838    ENDIF
1839
[60]1840    IF ( particle_advection )  THEN
[1]1841!
[60]1842!--    Particle attributes
1843       WRITE ( io, 480 )  particle_advection_start, dt_prel, bc_par_lr, &
1844                          bc_par_ns, bc_par_b, bc_par_t, particle_maximum_age, &
[1359]1845                          end_time_prel
[60]1846       IF ( use_sgs_for_particles )  WRITE ( io, 488 )  dt_min_part
1847       IF ( random_start_position )  WRITE ( io, 481 )
[1575]1848       IF ( seed_follows_topography )  WRITE ( io, 496 )
[60]1849       IF ( particles_per_point > 1 )  WRITE ( io, 489 )  particles_per_point
1850       WRITE ( io, 495 )  total_number_of_particles
[824]1851       IF ( use_particle_tails  .AND.  maximum_number_of_tailpoints /= 0 )  THEN
[60]1852          WRITE ( io, 483 )  maximum_number_of_tailpoints
1853          IF ( minimum_tailpoint_distance /= 0 )  THEN
1854             WRITE ( io, 484 )  total_number_of_tails,      &
1855                                minimum_tailpoint_distance, &
1856                                maximum_tailpoint_age
1857          ENDIF
[1]1858       ENDIF
[1322]1859       IF ( dt_write_particle_data /= 9999999.9_wp )  THEN
[60]1860          WRITE ( io, 485 )  dt_write_particle_data
[1327]1861          IF ( netcdf_data_format > 1 )  THEN
1862             output_format = 'netcdf (64 bit offset) and binary'
[1]1863          ELSE
[1327]1864             output_format = 'netcdf and binary'
[1]1865          ENDIF
[292]1866          WRITE ( io, 344 )  output_format
[1]1867       ENDIF
[1322]1868       IF ( dt_dopts /= 9999999.9_wp )  WRITE ( io, 494 )  dt_dopts
[60]1869       IF ( write_particle_statistics )  WRITE ( io, 486 )
[1]1870
[60]1871       WRITE ( io, 487 )  number_of_particle_groups
[1]1872
[60]1873       DO  i = 1, number_of_particle_groups
[1322]1874          IF ( i == 1  .AND.  density_ratio(i) == 9999999.9_wp )  THEN
[1353]1875             WRITE ( io, 490 )  i, 0.0_wp
[60]1876             WRITE ( io, 492 )
[1]1877          ELSE
[60]1878             WRITE ( io, 490 )  i, radius(i)
[1353]1879             IF ( density_ratio(i) /= 0.0_wp )  THEN
[60]1880                WRITE ( io, 491 )  density_ratio(i)
1881             ELSE
1882                WRITE ( io, 492 )
1883             ENDIF
[1]1884          ENDIF
[60]1885          WRITE ( io, 493 )  psl(i), psr(i), pss(i), psn(i), psb(i), pst(i), &
1886                             pdx(i), pdy(i), pdz(i)
[336]1887          IF ( .NOT. vertical_particle_advection(i) )  WRITE ( io, 482 )
[60]1888       ENDDO
[1]1889
[60]1890    ENDIF
[1]1891
[60]1892
[1]1893!
1894!-- Parameters of 1D-model
1895    IF ( INDEX( initializing_actions, 'set_1d-model_profiles' ) /= 0 )  THEN
1896       WRITE ( io, 500 )  end_time_1d, dt_run_control_1d, dt_pr_1d, &
1897                          mixing_length_1d, dissipation_1d
1898       IF ( damp_level_ind_1d /= nzt+1 )  THEN
1899          WRITE ( io, 502 )  zu(damp_level_ind_1d), damp_level_ind_1d
1900       ENDIF
1901    ENDIF
1902
1903!
[1551]1904!-- User-defined information
[1]1905    CALL user_header( io )
1906
1907    WRITE ( io, 99 )
1908
1909!
1910!-- Write buffer contents to disc immediately
[82]1911    CALL local_flush( io )
[1]1912
1913!
1914!-- Here the FORMATs start
1915
1916 99 FORMAT (1X,78('-'))
[1468]1917100 FORMAT (/1X,'******************************',4X,44('-')/        &
1918            1X,'* ',A,' *',4X,A/                               &
1919            1X,'******************************',4X,44('-'))
1920101 FORMAT (35X,'coupled run using MPI-',I1,': ',A/ &
1921            35X,42('-'))
1922102 FORMAT (/' Date:                 ',A8,4X,'Run:       ',A20/      &
1923            ' Time:                 ',A8,4X,'Run-No.:   ',I2.2/     &
[1106]1924            ' Run on host:        ',A10)
[1]1925#if defined( __parallel )
[1468]1926103 FORMAT (' Number of PEs:',10X,I6,4X,'Processor grid (x,y): (',I4,',',I4, &
[1]1927              ')',1X,A)
[1468]1928104 FORMAT (' Number of PEs:',10X,I6,4X,'Tasks:',I4,'   threads per task:',I4/ &
1929              35X,'Processor grid (x,y): (',I4,',',I4,')',1X,A)
1930105 FORMAT (35X,'One additional PE is used to handle'/37X,'the dvrp output!')
1931106 FORMAT (35X,'A 1d-decomposition along x is forced'/ &
1932            35X,'because the job is running on an SMP-cluster')
1933107 FORMAT (35X,'A 1d-decomposition along ',A,' is used')
1934108 FORMAT (35X,'Max. # of parallel I/O streams is ',I5)
1935109 FORMAT (35X,'Precursor run for coupled atmos-ocean run'/ &
1936            35X,42('-'))
1937114 FORMAT (35X,'Coupled atmosphere-ocean run following'/ &
1938            35X,'independent precursor runs'/             &
1939            35X,42('-'))
[1111]1940117 FORMAT (' Accelerator boards / node:  ',I2)
[1]1941#endif
1942110 FORMAT (/' Numerical Schemes:'/ &
1943             ' -----------------'/)
1944111 FORMAT (' --> Solve perturbation pressure via FFT using ',A,' routines')
1945112 FORMAT (' --> Solve perturbation pressure via SOR-Red/Black-Schema'/ &
[1697]1946            '     Iterations (initial/other): ',I3,'/',I3,'  omega =',F6.3)
[1]1947113 FORMAT (' --> Momentum advection via Piascek-Williams-Scheme (Form C3)', &
1948                  ' or Upstream')
[1216]1949115 FORMAT ('     FFT and transpositions are overlapping')
[1]1950116 FORMAT (' --> Scalar advection via Piascek-Williams-Scheme (Form C3)', &
1951                  ' or Upstream')
1952118 FORMAT (' --> Scalar advection via Bott-Chlond-Scheme')
[1106]1953119 FORMAT (' --> Galilei-Transform applied to horizontal advection:'/ &
1954            '     translation velocity = ',A/ &
[1]1955            '     distance advected ',A,':  ',F8.3,' km(x)  ',F8.3,' km(y)')
[1111]1956120 FORMAT (' Accelerator boards: ',8X,I2)
[1]1957122 FORMAT (' --> Time differencing scheme: ',A)
[108]1958123 FORMAT (' --> Rayleigh-Damping active, starts ',A,' z = ',F8.2,' m'/ &
[1697]1959            '     maximum damping coefficient:',F6.3, ' 1/s')
[1]1960129 FORMAT (' --> Additional prognostic equation for the specific humidity')
1961130 FORMAT (' --> Additional prognostic equation for the total water content')
[940]1962131 FORMAT (' --> No pt-equation solved. Neutral stratification with pt = ', &
1963                  F6.2, ' K assumed')
[824]1964132 FORMAT ('     Parameterization of long-wave radiation processes via'/ &
[1]1965            '     effective emissivity scheme')
[824]1966133 FORMAT ('     Precipitation parameterization via Kessler-Scheme')
[1]1967134 FORMAT (' --> Additional prognostic equation for a passive scalar')
[1575]1968135 FORMAT (' --> Solve perturbation pressure via ',A,' method (', &
[1]1969                  A,'-cycle)'/ &
1970            '     number of grid levels:                   ',I2/ &
1971            '     Gauss-Seidel red/black iterations:       ',I2)
1972136 FORMAT ('     gridpoints of coarsest subdomain (x,y,z): (',I3,',',I3,',', &
1973                  I3,')')
1974137 FORMAT ('     level data gathered on PE0 at level:     ',I2/ &
1975            '     gridpoints of coarsest subdomain (x,y,z): (',I3,',',I3,',', &
1976                  I3,')'/ &
1977            '     gridpoints of coarsest domain (x,y,z):    (',I3,',',I3,',', &
1978                  I3,')')
[63]1979139 FORMAT (' --> Loop optimization method: ',A)
[1]1980140 FORMAT ('     maximum residual allowed:                ',E10.3)
1981141 FORMAT ('     fixed number of multigrid cycles:        ',I4)
1982142 FORMAT ('     perturbation pressure is calculated at every Runge-Kutta ', &
1983                  'step')
[87]1984143 FORMAT ('     Euler/upstream scheme is used for the SGS turbulent ', &
1985                  'kinetic energy')
[927]1986144 FORMAT ('     masking method is used')
[1]1987150 FORMAT (' --> Volume flow at the right and north boundary will be ', &
[241]1988                  'conserved'/ &
1989            '     using the ',A,' mode')
1990151 FORMAT ('     with u_bulk = ',F7.3,' m/s and v_bulk = ',F7.3,' m/s')
[306]1991152 FORMAT (' --> External pressure gradient directly prescribed by the user:',&
1992           /'     ',2(1X,E12.5),'Pa/m in x/y direction', &
1993           /'     starting from dp_level_b =', F8.3, 'm', A /)
[1365]1994160 FORMAT (//' Large scale forcing and nudging:'/ &
1995              ' -------------------------------'/)
1996161 FORMAT (' --> No large scale forcing from external is used (default) ')
1997162 FORMAT (' --> Large scale forcing from external file LSF_DATA is used: ')
1998163 FORMAT ('     - large scale advection tendencies ')
1999164 FORMAT ('     - large scale subsidence velocity w_subs ')
2000165 FORMAT ('     - large scale subsidence tendencies ')
2001167 FORMAT ('     - and geostrophic wind components ug and vg')
2002168 FORMAT (' --> Large-scale vertical motion is used in the ', &
[1299]2003                  'prognostic equation(s) for')
[1365]2004169 FORMAT ('     the scalar(s) only')
2005170 FORMAT (' --> Nudging is used')
2006171 FORMAT (' --> No nudging is used (default) ')
2007180 FORMAT ('     - prescribed surface values for temperature')
[1376]2008181 FORMAT ('     - prescribed surface fluxes for temperature')
2009182 FORMAT ('     - prescribed surface values for humidity')
[1365]2010183 FORMAT ('     - prescribed surface fluxes for humidity')
[1]2011200 FORMAT (//' Run time and time step information:'/ &
2012             ' ----------------------------------'/)
[1106]2013201 FORMAT ( ' Timestep:             variable     maximum value: ',F6.3,' s', &
[1697]2014             '    CFL-factor:',F5.2)
[1106]2015202 FORMAT ( ' Timestep:          dt = ',F6.3,' s'/)
2016203 FORMAT ( ' Start time:          ',F9.3,' s'/ &
2017             ' End time:            ',F9.3,' s')
[1]2018204 FORMAT ( A,F9.3,' s')
2019205 FORMAT ( A,F9.3,' s',5X,'restart every',17X,F9.3,' s')
[1106]2020206 FORMAT (/' Time reached:        ',F9.3,' s'/ &
2021             ' CPU-time used:       ',F9.3,' s     per timestep:               ', &
2022               '  ',F9.3,' s'/                                                    &
[1111]2023             '                                      per second of simulated tim', &
[1]2024               'e: ',F9.3,' s')
[1106]2025207 FORMAT ( ' Coupling start time: ',F9.3,' s')
[1]2026250 FORMAT (//' Computational grid and domain size:'/ &
2027              ' ----------------------------------'// &
2028              ' Grid length:      dx =    ',F7.3,' m    dy =    ',F7.3, &
2029              ' m    dz =    ',F7.3,' m'/ &
2030              ' Domain size:       x = ',F10.3,' m     y = ',F10.3, &
2031              ' m  z(u) = ',F10.3,' m'/)
2032252 FORMAT (' dz constant up to ',F10.3,' m (k=',I4,'), then stretched by', &
[1697]2033              ' factor:',F6.3/ &
[1]2034            ' maximum dz not to be exceeded is dz_max = ',F10.3,' m'/)
2035254 FORMAT (' Number of gridpoints (x,y,z):  (0:',I4,', 0:',I4,', 0:',I4,')'/ &
2036            ' Subdomain size (x,y,z):        (  ',I4,',   ',I4,',   ',I4,')'/)
2037260 FORMAT (/' The model has a slope in x-direction. Inclination angle: ',F6.2,&
2038             ' degrees')
[1551]2039270 FORMAT (//' Topography information:'/ &
2040              ' ----------------------'// &
[1]2041              1X,'Topography: ',A)
2042271 FORMAT (  ' Building size (x/y/z) in m: ',F5.1,' / ',F5.1,' / ',F5.1/ &
2043              ' Horizontal index bounds (l/r/s/n): ',I4,' / ',I4,' / ',I4, &
2044                ' / ',I4)
[240]2045272 FORMAT (  ' Single quasi-2D street canyon of infinite length in ',A, &
2046              ' direction' / &
2047              ' Canyon height: ', F6.2, 'm, ch = ', I4, '.'      / &
2048              ' Canyon position (',A,'-walls): cxl = ', I4,', cxr = ', I4, '.')
[256]2049278 FORMAT (' Topography grid definition convention:'/ &
2050            ' cell edge (staggered grid points'/  &
2051            ' (u in x-direction, v in y-direction))' /)
2052279 FORMAT (' Topography grid definition convention:'/ &
2053            ' cell center (scalar grid points)' /)
[138]2054280 FORMAT (//' Vegetation canopy (drag) model:'/ &
2055              ' ------------------------------'// &
2056              ' Canopy mode: ', A / &
[1484]2057              ' Canopy height: ',F6.2,'m (',I4,' grid points)' / &
[138]2058              ' Leaf drag coefficient: ',F6.2 /)
[1484]2059281 FORMAT (/ ' Scalar exchange coefficient: ',F6.2 / &
[153]2060              ' Scalar concentration at leaf surfaces in kg/m**3: ',F6.2 /)
2061282 FORMAT (' Predefined constant heatflux at the top of the vegetation: ',F6.2,' K m/s')
2062283 FORMAT (/ ' Characteristic levels of the leaf area density:'// &
[138]2063              ' Height:              ',A,'  m'/ &
2064              ' Leaf area density:   ',A,'  m**2/m**3'/ &
2065              ' Gradient:            ',A,'  m**2/m**4'/ &
2066              ' Gridpoint:           ',A)
[1484]2067284 FORMAT (//' Characteristic levels of the leaf area density and coefficients:'// &
2068              ' Height:              ',A,'  m'/ &
2069              ' Leaf area density:   ',A,'  m**2/m**3'/ &
2070              ' Coefficient alpha: ',F6.2 / &
2071              ' Coefficient beta: ',F6.2 / &
2072              ' Leaf area index: ',F6.2,'  m**2/m**2' /)
[138]2073               
[1]2074300 FORMAT (//' Boundary conditions:'/ &
2075             ' -------------------'// &
2076             '                     p                    uv             ', &
[1551]2077             '                     pt'// &
[1]2078             ' B. bound.: ',A/ &
2079             ' T. bound.: ',A)
[97]2080301 FORMAT (/'                     ',A// &
[1]2081             ' B. bound.: ',A/ &
2082             ' T. bound.: ',A)
[19]2083303 FORMAT (/' Bottom surface fluxes are used in diffusion terms at k=1')
2084304 FORMAT (/' Top surface fluxes are used in diffusion terms at k=nzt')
2085305 FORMAT (//'    Prandtl-Layer between bottom surface and first ', &
2086               'computational u,v-level:'// &
[1697]2087             '       zp = ',F6.2,' m   z0 =',F7.4,' m   z0h =',F8.5,&
2088             ' m   kappa =',F5.2/ &
2089             '       Rif value range:   ',F8.2,' <= rif <=',F6.2)
[97]2090306 FORMAT ('       Predefined constant heatflux:   ',F9.6,' K m/s')
[1]2091307 FORMAT ('       Heatflux has a random normal distribution')
2092308 FORMAT ('       Predefined surface temperature')
[97]2093309 FORMAT ('       Predefined constant salinityflux:   ',F9.6,' psu m/s')
[1]2094310 FORMAT (//'    1D-Model:'// &
2095             '       Rif value range:   ',F6.2,' <= rif <=',F6.2)
2096311 FORMAT ('       Predefined constant humidity flux: ',E10.3,' m/s')
2097312 FORMAT ('       Predefined surface humidity')
2098313 FORMAT ('       Predefined constant scalar flux: ',E10.3,' kg/(m**2 s)')
2099314 FORMAT ('       Predefined scalar value at the surface')
[19]2100315 FORMAT ('       Humidity / scalar flux at top surface is 0.0')
[102]2101316 FORMAT ('       Sensible heatflux and momentum flux from coupled ', &
2102                    'atmosphere model')
[1]2103317 FORMAT (//' Lateral boundaries:'/ &
2104            '       left/right:  ',A/    &
2105            '       north/south: ',A)
[1159]2106318 FORMAT (/'       use_cmax: ',L1 / &
2107            '       pt damping layer width = ',F8.2,' m, pt ', &
[1697]2108                    'damping factor =',F7.4)
[151]2109319 FORMAT ('       turbulence recycling at inflow switched on'/ &
2110            '       width of recycling domain: ',F7.1,' m   grid index: ',I4/ &
2111            '       inflow damping height: ',F6.1,' m   width: ',F6.1,' m')
2112320 FORMAT ('       Predefined constant momentumflux:  u: ',F9.6,' m**2/s**2'/ &
[103]2113            '                                          v: ',F9.6,' m**2/s**2')
[1365]2114321 FORMAT (//' Initial profiles:'/ &
2115              ' ----------------')
[1560]2116322 FORMAT ('       turbulence recycling at inflow switched on'/ &
2117            '       y shift of the recycled inflow turbulence switched on'/ &
2118            '       width of recycling domain: ',F7.1,' m   grid index: ',I4/ &
[1592]2119            '       inflow damping height: ',F6.1,' m   width: ',F6.1,' m'/)
[151]2120325 FORMAT (//' List output:'/ &
[1]2121             ' -----------'//  &
2122            '    1D-Profiles:'/    &
2123            '       Output every             ',F8.2,' s')
[151]2124326 FORMAT ('       Time averaged over       ',F8.2,' s'/ &
[1]2125            '       Averaging input every    ',F8.2,' s')
2126330 FORMAT (//' Data output:'/ &
2127             ' -----------'/)
2128331 FORMAT (/'    1D-Profiles:')
2129332 FORMAT (/'       ',A)
2130333 FORMAT ('       Output every             ',F8.2,' s',/ &
2131            '       Time averaged over       ',F8.2,' s'/ &
2132            '       Averaging input every    ',F8.2,' s')
2133334 FORMAT (/'    2D-Arrays',A,':')
2134335 FORMAT (/'       ',A2,'-cross-section  Arrays: ',A/ &
2135            '       Output every             ',F8.2,' s  ',A/ &
2136            '       Cross sections at ',A1,' = ',A/ &
2137            '       scalar-coordinates:   ',A,' m'/)
2138336 FORMAT (/'    3D-Arrays',A,':')
2139337 FORMAT (/'       Arrays: ',A/ &
2140            '       Output every             ',F8.2,' s  ',A/ &
2141            '       Upper output limit at    ',F8.2,' m  (GP ',I4,')'/)
2142339 FORMAT ('       No output during initial ',F8.2,' s')
2143340 FORMAT (/'    Time series:')
2144341 FORMAT ('       Output every             ',F8.2,' s'/)
2145342 FORMAT (/'       ',A2,'-cross-section  Arrays: ',A/ &
2146            '       Output every             ',F8.2,' s  ',A/ &
2147            '       Time averaged over       ',F8.2,' s'/ &
2148            '       Averaging input every    ',F8.2,' s'/ &
2149            '       Cross sections at ',A1,' = ',A/ &
2150            '       scalar-coordinates:   ',A,' m'/)
2151343 FORMAT (/'       Arrays: ',A/ &
2152            '       Output every             ',F8.2,' s  ',A/ &
2153            '       Time averaged over       ',F8.2,' s'/ &
2154            '       Averaging input every    ',F8.2,' s'/ &
2155            '       Upper output limit at    ',F8.2,' m  (GP ',I4,')'/)
[292]2156344 FORMAT ('       Output format: ',A/)
[410]2157345 FORMAT (/'    Scaling lengths for output locations of all subsequent mask IDs:',/ &
2158            '       mask_scale_x (in x-direction): ',F9.3, ' m',/ &
2159            '       mask_scale_y (in y-direction): ',F9.3, ' m',/ &
2160            '       mask_scale_z (in z-direction): ',F9.3, ' m' )
2161346 FORMAT (/'    Masked data output',A,' for mask ID ',I2, ':')
2162347 FORMAT ('       Variables: ',A/ &
2163            '       Output every             ',F8.2,' s')
2164348 FORMAT ('       Variables: ',A/ &
2165            '       Output every             ',F8.2,' s'/ &
2166            '       Time averaged over       ',F8.2,' s'/ &
2167            '       Averaging input every    ',F8.2,' s')
2168349 FORMAT (/'       Output locations in ',A,'-direction in multiples of ', &
2169            'mask_scale_',A,' predefined by array mask_',I2.2,'_',A,':'/ &
2170            13('       ',8(F8.2,',')/) )
2171350 FORMAT (/'       Output locations in ',A,'-direction: ', &
2172            'all gridpoints along ',A,'-direction (default).' )
2173351 FORMAT (/'       Output locations in ',A,'-direction in multiples of ', &
2174            'mask_scale_',A,' constructed from array mask_',I2.2,'_',A,'_loop:'/ &
2175            '          loop begin:',F8.2,', end:',F8.2,', stride:',F8.2 )
[1313]2176352 FORMAT  (/'       Number of output time levels allowed: ',I3 /)
2177353 FORMAT  (/'       Number of output time levels allowed: unlimited' /)
[1]2178#if defined( __dvrp_graphics )
2179360 FORMAT ('    Plot-Sequence with dvrp-software:'/ &
2180            '       Output every      ',F7.1,' s'/ &
2181            '       Output mode:      ',A/ &
2182            '       Host / User:      ',A,' / ',A/ &
2183            '       Directory:        ',A// &
2184            '       The sequence contains:')
[337]2185361 FORMAT (/'       Isosurface of "',A,'"    Threshold value: ', E12.3/ &
2186            '          Isosurface color: (',F4.2,',',F4.2,',',F4.2,') (R,G,B)')
2187362 FORMAT (/'       Slicer plane ',A/ &
[336]2188            '       Slicer limits: [',F6.2,',',F6.2,']')
[337]2189363 FORMAT (/'       Particles'/ &
[336]2190            '          particle size:  ',F7.2,' m')
2191364 FORMAT ('          particle ',A,' controlled by "',A,'" with interval [', &
2192                       F6.2,',',F6.2,']')
[337]2193365 FORMAT (/'       Groundplate color: (',F4.2,',',F4.2,',',F4.2,') (R,G,B)'/ &
[336]2194            '       Superelevation along (x,y,z): (',F4.1,',',F4.1,',',F4.1, &
2195                     ')'/ &
2196            '       Clipping limits: from x = ',F9.1,' m to x = ',F9.1,' m'/ &
2197            '                        from y = ',F9.1,' m to y = ',F9.1,' m')
[337]2198366 FORMAT (/'       Topography color: (',F4.2,',',F4.2,',',F4.2,') (R,G,B)')
[336]2199367 FORMAT ('       Polygon reduction for topography: cluster_size = ', I1)
[1]2200#endif
2201#if defined( __spectra )
2202370 FORMAT ('    Spectra:')
2203371 FORMAT ('       Output every ',F7.1,' s'/)
2204372 FORMAT ('       Arrays:     ', 10(A5,',')/                         &
2205            '       Directions: ', 10(A5,',')/                         &
[189]2206            '       height levels  k = ', 20(I3,',')/                  &
2207            '                          ', 20(I3,',')/                  &
2208            '                          ', 20(I3,',')/                  &
2209            '                          ', 20(I3,',')/                  &
2210            '                          ', 19(I3,','),I3,'.'/           &
[1]2211            '       height levels selected for standard plot:'/        &
[189]2212            '                      k = ', 20(I3,',')/                  &
2213            '                          ', 20(I3,',')/                  &
2214            '                          ', 20(I3,',')/                  &
2215            '                          ', 20(I3,',')/                  &
2216            '                          ', 19(I3,','),I3,'.'/           &
[1]2217            '       Time averaged over ', F7.1, ' s,' /                &
2218            '       Profiles for the time averaging are taken every ', &
2219                    F6.1,' s')
2220#endif
2221400 FORMAT (//' Physical quantities:'/ &
2222              ' -------------------'/)
[1551]2223410 FORMAT ('    Geograph. latitude  :   phi    = ',F4.1,' degr'/   &
[1697]2224            '    Angular velocity    :   omega  =',E10.3,' rad/s'/  &
[1551]2225            '    Coriolis parameter  :   f      = ',F9.6,' 1/s'/    &
2226            '                            f*     = ',F9.6,' 1/s')
2227411 FORMAT (/'    Gravity             :   g      = ',F4.1,' m/s**2')
[1179]2228412 FORMAT (/'    Reference state used in buoyancy terms: ',A)
2229413 FORMAT ('       Reference density in buoyancy terms: ',F8.3,' kg/m**3')
2230414 FORMAT ('       Reference temperature in buoyancy terms: ',F8.4,' K')
[1551]2231415 FORMAT (/' Cloud physics parameters:'/ &
2232             ' ------------------------'/)
2233416 FORMAT ('    Surface pressure   :   p_0   = ',F7.2,' hPa'/      &
2234            '    Gas constant       :   R     = ',F5.1,' J/(kg K)'/ &
[1697]2235            '    Density of air     :   rho_0 =',F6.3,' kg/m**3'/  &
[1551]2236            '    Specific heat cap. :   c_p   = ',F6.1,' J/(kg K)'/ &
[1697]2237            '    Vapourization heat :   L_v   =',E9.2,' J/kg')
[1551]2238417 FORMAT ('    Geograph. longitude :   lambda = ',F4.1,' degr')
2239418 FORMAT (/'    Day of the year at model start :   day_init      =     ',I3 &
2240            /'    UTC time at model start        :   time_utc_init = ',F7.1' s')
2241419 FORMAT (//' Land surface model information:'/ &
2242              ' ------------------------------'/)
[1]2243420 FORMAT (/'    Characteristic levels of the initial temperature profile:'// &
2244            '       Height:        ',A,'  m'/ &
2245            '       Temperature:   ',A,'  K'/ &
2246            '       Gradient:      ',A,'  K/100m'/ &
2247            '       Gridpoint:     ',A)
2248421 FORMAT (/'    Characteristic levels of the initial humidity profile:'// &
2249            '       Height:      ',A,'  m'/ &
2250            '       Humidity:    ',A,'  kg/kg'/ &
2251            '       Gradient:    ',A,'  (kg/kg)/100m'/ &
2252            '       Gridpoint:   ',A)
2253422 FORMAT (/'    Characteristic levels of the initial scalar profile:'// &
2254            '       Height:                  ',A,'  m'/ &
2255            '       Scalar concentration:    ',A,'  kg/m**3'/ &
2256            '       Gradient:                ',A,'  (kg/m**3)/100m'/ &
2257            '       Gridpoint:               ',A)
2258423 FORMAT (/'    Characteristic levels of the geo. wind component ug:'// &
2259            '       Height:      ',A,'  m'/ &
2260            '       ug:          ',A,'  m/s'/ &
2261            '       Gradient:    ',A,'  1/100s'/ &
2262            '       Gridpoint:   ',A)
2263424 FORMAT (/'    Characteristic levels of the geo. wind component vg:'// &
2264            '       Height:      ',A,'  m'/ &
[97]2265            '       vg:          ',A,'  m/s'/ &
[1]2266            '       Gradient:    ',A,'  1/100s'/ &
2267            '       Gridpoint:   ',A)
[97]2268425 FORMAT (/'    Characteristic levels of the initial salinity profile:'// &
2269            '       Height:     ',A,'  m'/ &
2270            '       Salinity:   ',A,'  psu'/ &
2271            '       Gradient:   ',A,'  psu/100m'/ &
2272            '       Gridpoint:  ',A)
[411]2273426 FORMAT (/'    Characteristic levels of the subsidence/ascent profile:'// &
2274            '       Height:      ',A,'  m'/ &
2275            '       w_subs:      ',A,'  m/s'/ &
2276            '       Gradient:    ',A,'  (m/s)/100m'/ &
2277            '       Gridpoint:   ',A)
[767]2278427 FORMAT (/'    Initial wind profiles (u,v) are interpolated from given'// &
2279                  ' profiles')
[1241]2280428 FORMAT (/'    Initial profiles (u, v, pt, q) are taken from file '/ &
2281             '    NUDGING_DATA')
[824]2282430 FORMAT (//' Cloud physics quantities / methods:'/ &
2283              ' ----------------------------------'/)
2284431 FORMAT ('    Humidity is treated as purely passive scalar (no condensati', &
2285                 'on)')
2286432 FORMAT ('    Bulk scheme with liquid water potential temperature and'/ &
2287            '    total water content is used.'/ &
2288            '    Condensation is parameterized via 0% - or 100% scheme.')
2289433 FORMAT ('    Cloud droplets treated explicitly using the Lagrangian part', &
2290                 'icle model')
2291434 FORMAT ('    Curvature and solution effecs are considered for growth of', &
2292                 ' droplets < 1.0E-6 m')
[825]2293435 FORMAT ('    Droplet collision is handled by ',A,'-kernel')
[828]2294436 FORMAT ('       Fast kernel with fixed radius- and dissipation classes ', &
2295                    'are used'/ &
2296            '          number of radius classes:       ',I3,'    interval ', &
2297                       '[1.0E-6,2.0E-4] m'/ &
2298            '          number of dissipation classes:   ',I2,'    interval ', &
2299                       '[0,1000] cm**2/s**3')
2300437 FORMAT ('    Droplet collision is switched off')
[1551]2301438 FORMAT (' --> Land surface type  : ',A,/ &
2302            ' --> Soil porosity type : ',A)
2303439 FORMAT (/'    Initial soil temperature and moisture profile:'// &
2304            '       Height:        ',A,'  m'/ &
2305            '       Temperature:   ',A,'  K'/ &
2306            '       Moisture:      ',A,'  m**3/m**3'/ &
2307            '       Root fraction: ',A,'  '/ &
2308            '       Gridpoint:     ',A)
2309440 FORMAT (/' --> Dewfall is allowed (default)')
2310441 FORMAT (' --> Dewfall is inhibited')
2311442 FORMAT (' --> Soil bottom is closed (water content is conserved, default)')
2312443 FORMAT (' --> Soil bottom is open (water content is not conserved)')
2313444 FORMAT (//' Radiation model information:'/                                 &
2314              ' ----------------------------'/)
2315445 FORMAT (' --> Using constant net radiation: net_radiation = ', F6.2, '  W/m**2')
2316446 FORMAT (' --> Simple radiation scheme for clear sky is used (no clouds,',  &
2317                   ' default)')
[1585]2318447 FORMAT (' --> RRTMG scheme is used')
[1697]2319448 FORMAT (/'     User-specific surface albedo: albedo =', F6.3)
[1585]2320449 FORMAT  ('     Timestep: dt_radiation = ', F5.2, '  s')
[1551]2321
[1]2322450 FORMAT (//' LES / Turbulence quantities:'/ &
2323              ' ---------------------------'/)
[824]2324451 FORMAT ('    Diffusion coefficients are constant:'/ &
2325            '    Km = ',F6.2,' m**2/s   Kh = ',F6.2,' m**2/s   Pr = ',F5.2)
[1697]2326453 FORMAT ('    Mixing length is limited to',F5.2,' * z')
[824]2327454 FORMAT ('    TKE is not allowed to fall below ',E9.2,' (m/s)**2')
2328455 FORMAT ('    initial TKE is prescribed as ',E9.2,' (m/s)**2')
[1585]2329456 FORMAT (/'    Albedo is set for land surface type: ', A)
2330457 FORMAT (/'    --> Albedo is fixed during the run')
2331458 FORMAT (/'    --> Longwave radiation is disabled')
2332459 FORMAT (/'    --> Shortwave radiation is disabled.')
[1]2333470 FORMAT (//' Actions during the simulation:'/ &
2334              ' -----------------------------'/)
[94]2335471 FORMAT ('    Disturbance impulse (u,v) every :   ',F6.2,' s'/            &
[1697]2336            '    Disturbance amplitude           :    ',F5.2, ' m/s'/       &
[94]2337            '    Lower disturbance level         : ',F8.2,' m (GP ',I4,')'/  &
2338            '    Upper disturbance level         : ',F8.2,' m (GP ',I4,')')
[1]2339472 FORMAT ('    Disturbances continued during the run from i/j =',I4, &
2340                 ' to i/j =',I4)
2341473 FORMAT ('    Disturbances cease as soon as the disturbance energy exceeds',&
[1697]2342                 F6.3, ' m**2/s**2')
[1]2343474 FORMAT ('    Random number generator used    : ',A/)
2344475 FORMAT ('    The surface temperature is increased (or decreased, ', &
2345                 'respectively, if'/ &
2346            '    the value is negative) by ',F5.2,' K at the beginning of the',&
2347                 ' 3D-simulation'/)
2348476 FORMAT ('    The surface humidity is increased (or decreased, ',&
2349                 'respectively, if the'/ &
2350            '    value is negative) by ',E8.1,' kg/kg at the beginning of', &
2351                 ' the 3D-simulation'/)
2352477 FORMAT ('    The scalar value is increased at the surface (or decreased, ',&
2353                 'respectively, if the'/ &
2354            '    value is negative) by ',E8.1,' kg/m**3 at the beginning of', &
2355                 ' the 3D-simulation'/)
2356480 FORMAT ('    Particles:'/ &
2357            '    ---------'// &
2358            '       Particle advection is active (switched on at t = ', F7.1, &
2359                    ' s)'/ &
2360            '       Start of new particle generations every  ',F6.1,' s'/ &
2361            '       Boundary conditions: left/right: ', A, ' north/south: ', A/&
2362            '                            bottom:     ', A, ' top:         ', A/&
2363            '       Maximum particle age:                 ',F9.1,' s'/ &
[1359]2364            '       Advection stopped at t = ',F9.1,' s'/)
[1]2365481 FORMAT ('       Particles have random start positions'/)
[336]2366482 FORMAT ('          Particles are advected only horizontally'/)
[1]2367483 FORMAT ('       Particles have tails with a maximum of ',I3,' points')
2368484 FORMAT ('            Number of tails of the total domain: ',I10/ &
2369            '            Minimum distance between tailpoints: ',F8.2,' m'/ &
2370            '            Maximum age of the end of the tail:  ',F8.2,' s')
2371485 FORMAT ('       Particle data are written on file every ', F9.1, ' s')
2372486 FORMAT ('       Particle statistics are written on file'/)
2373487 FORMAT ('       Number of particle groups: ',I2/)
2374488 FORMAT ('       SGS velocity components are used for particle advection'/ &
[1697]2375            '          minimum timestep for advection:', F8.5/)
[1]2376489 FORMAT ('       Number of particles simultaneously released at each ', &
2377                    'point: ', I5/)
2378490 FORMAT ('       Particle group ',I2,':'/ &
2379            '          Particle radius: ',E10.3, 'm')
2380491 FORMAT ('          Particle inertia is activated'/ &
[1697]2381            '             density_ratio (rho_fluid/rho_particle) =',F6.3/)
[1]2382492 FORMAT ('          Particles are advected only passively (no inertia)'/)
2383493 FORMAT ('          Boundaries of particle source: x:',F8.1,' - ',F8.1,' m'/&
2384            '                                         y:',F8.1,' - ',F8.1,' m'/&
2385            '                                         z:',F8.1,' - ',F8.1,' m'/&
2386            '          Particle distances:  dx = ',F8.1,' m  dy = ',F8.1, &
2387                       ' m  dz = ',F8.1,' m'/)
2388494 FORMAT ('       Output of particle time series in NetCDF format every ', &
2389                    F8.2,' s'/)
2390495 FORMAT ('       Number of particles in total domain: ',I10/)
[1575]2391496 FORMAT ('       Initial vertical particle positions are interpreted ', &
2392                    'as relative to the given topography')
[1]2393500 FORMAT (//' 1D-Model parameters:'/                           &
2394              ' -------------------'//                           &
2395            '    Simulation time:                   ',F8.1,' s'/ &
2396            '    Run-controll output every:         ',F8.1,' s'/ &
2397            '    Vertical profile output every:     ',F8.1,' s'/ &
2398            '    Mixing length calculation:         ',A/         &
2399            '    Dissipation calculation:           ',A/)
2400502 FORMAT ('    Damping layer starts from ',F7.1,' m (GP ',I4,')'/)
[667]2401503 FORMAT (' --> Momentum advection via Wicker-Skamarock-Scheme 5th order')
2402504 FORMAT (' --> Scalar advection via Wicker-Skamarock-Scheme 5th order')
[1115]2403505 FORMAT ('    Precipitation parameterization via Seifert-Beheng-Scheme')
2404506 FORMAT ('    Drizzle parameterization via Stokes law')
2405507 FORMAT ('    Turbulence effects on precipitation process')
2406508 FORMAT ('    Ventilation effects on evaporation of rain drops')
2407509 FORMAT ('    Slope limiter used for sedimentation process')
[1551]2408510 FORMAT ('    Droplet density    :   N_c   = ',F6.1,' 1/cm**3')
2409511 FORMAT ('    Sedimentation Courant number:                  '/&
[1697]2410            '                               C_s   =',F4.1,'        ')
[1429]2411512 FORMAT (/' Date:                 ',A8,6X,'Run:       ',A20/      &
2412            ' Time:                 ',A8,6X,'Run-No.:   ',I2.2/     &
2413            ' Run on host:        ',A10,6X,'En-No.:    ',I2.2)
[1557]2414513 FORMAT (' --> Scalar advection via Wicker-Skamarock-Scheme 5th order ' // & 
2415            '+ monotonic adjustment')
[1764]2416600 FORMAT (/' Nesting informations:'/                                        &
2417            ' Nest id / name:                   ',I2.2,' / ',A,' (parent id: ',I2.2,')'/ &
2418            ' Nesting mode:                     ',A/ &
2419            ' Lower left corner coordinates:    ','x = ',F8.2,' m, y = ',F8.2,' m'/)
[1]2420
2421 END SUBROUTINE header
Note: See TracBrowser for help on using the repository browser.