source: palm/trunk/SOURCE/netcdf_interface_mod.f90 @ 3966

Last change on this file since 3966 was 3966, checked in by gronemeier, 5 years ago

remove origin time from time unit; compose origin_time within subroutine netcdf_create_global_atts

  • Property svn:keywords set to Id
File size: 328.0 KB
Line 
1!> @file netcdf_interface_mod.f90
2!------------------------------------------------------------------------------!
3! This file is part of the PALM model system.
4!
5! PALM is free software: you can redistribute it and/or modify it under the
6! terms of the GNU General Public License as published by the Free Software
7! Foundation, either version 3 of the License, or (at your option) any later
8! version.
9!
10! PALM is distributed in the hope that it will be useful, but WITHOUT ANY
11! WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
12! A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
13!
14! You should have received a copy of the GNU General Public License along with
15! PALM. If not, see <http://www.gnu.org/licenses/>.
16!
17! Copyright 1997-2019 Leibniz Universitaet Hannover
18!------------------------------------------------------------------------------!
19!
20! Current revisions:
21! ------------------
22!
23!
24! Former revisions:
25! -----------------
26! $Id: netcdf_interface_mod.f90 3966 2019-05-09 12:54:44Z gronemeier $
27! remove origin time from time unit, compose origin_time_string within
28! subroutine netcdf_create_global_atts
29!
30! 3954 2019-05-06 12:49:42Z gronemeier
31! bugfix: corrected format for date_time_string
32!
33! 3953 2019-05-06 12:11:55Z gronemeier
34! bugfix: set origin_time and starting point of time coordinate according to
35!         day_of_year_init and time_utc_init
36!
37! 3942 2019-04-30 13:08:30Z kanani
38! Add specifier to netcdf_handle_error to simplify identification of attribute
39! causing the error
40!
41! 3766 2019-02-26 16:23:41Z raasch
42! bugfix in im_define_netcdf_grid argument list
43!
44! 3745 2019-02-15 18:57:56Z suehring
45! Add indoor model
46!
47! 3744 2019-02-15 18:38:58Z suehring
48! Bugfix: - initialize return values to ensure they are set before returning
49!           (routine define_geo_coordinates)
50!         - change order of dimensions for some variables
51!
52! 3727 2019-02-08 14:52:10Z gronemeier
53! make several routines publicly available
54!
55! 3701 2019-01-26 18:57:21Z knoop
56! Statement added to prevent compiler warning about unused variable
57!
58! 3655 2019-01-07 16:51:22Z knoop
59! Move the control parameter "salsa" from salsa_mod to control_parameters
60! (M. Kurppa)
61!
62! 3582 2018-11-29 19:16:36Z suehring
63! dom_dwd_user, Schrempf:
64! Remove uv exposure model code, this is now part of biometeorology_mod
65!
66! 3529 2018-11-15 21:03:15Z gronemeier
67! - set time units
68! - add additional global attributes,
69! - add additinal variable attributes
70! - move definition of UTM and geographic coordinates into subroutine
71! - change fill_value
72!
73! 3525 2018-11-14 16:06:14Z kanani
74! Changes related to clean-up of biometeorology (dom_dwd_user)
75!
76! 3485 2018-11-03 17:09:40Z gronemeier
77! Write geographic coordinates as global attributes to file.
78!
79! 3467 2018-10-30 19:05:21Z suehring
80! - Salsa implemented
81! - Bugfix convert_utm_to...
82!
83! 3464 2018-10-30 18:08:55Z kanani
84! - Add variable crs to output files
85! - Add long_name to UTM coordinates
86! - Add latitude/longitude coordinates. For 3d and xy output, lon and lat are
87!   only written if parallel output is used.
88!
89! 3459 2018-10-30 15:04:11Z gronemeier
90! Adjustment of biometeorology calls
91!
92! 3435 2018-10-26 18:25:44Z gronemeier
93! Bugfix: corrected order of calls to define_netcdf_grid for masked output
94! Add vertical dimensions to masked output in case of terrain-following output
95!
96! 3421 2018-10-24 18:39:32Z gronemeier
97! Bugfix: move ocean output variables to ocean_mod
98! Renamed output variables
99! Add UTM coordinates to mask, 3d, xy, xz, yz output
100!
101! 3337 2018-10-12 15:17:09Z kanani
102! (from branch resler)
103! Add biometeorology
104!
105! 3294 2018-10-01 02:37:10Z raasch
106! changes concerning modularization of ocean option
107!
108! 3274 2018-09-24 15:42:55Z knoop
109! Modularization of all bulk cloud physics code components
110!
111! 3241 2018-09-12 15:02:00Z raasch
112! unused variables removed
113!
114! 3235 2018-09-07 14:06:15Z sward
115! Changed MAS output dimension id_dim_agtnum to be of defined size and no longer
116! unlimited. Also changed some MAS output variables to be of type float
117!
118! 3198 2018-08-15 09:23:10Z sward
119! Redefined MAS limited time dimension to fit usage of multi_agent_system_end
120!
121! 3187 2018-07-31 10:32:34Z sward
122! Changed agent output to precision NF90_DOUBLE
123!
124! 3165 2018-07-24 13:12:42Z sward
125! Added agent ID output
126!
127! 3159 2018-07-20 11:20:01Z sward
128! Added multi agent system
129!
130! 3049 2018-05-29 13:52:36Z Giersch
131! Error messages revised
132!
133! 3045 2018-05-28 07:55:41Z Giersch
134! Error messages revised, code adjusted to PALMs coding standards, CASE pt_ext
135! pt_new disabled, comment revised
136!
137! 3004 2018-04-27 12:33:25Z Giersch
138! .NOT. found in if-query added to account for variables found in tcm
139!
140! 2964 2018-04-12 16:04:03Z Giersch
141! Calculation of fixed number of output time levels for parallel netcdf output
142! has been moved completely to check_parameters
143!
144! 2932 2018-03-26 09:39:22Z maronga
145! Renamed inipar to initialization_parameters.
146!
147! 2817 2018-02-19 16:32:21Z knoop
148! Preliminary gust module interface implemented
149!
150! 2769 2018-01-25 09:22:24Z raasch
151! bugfix for calculating number of required output time levels in case of output
152! at the beginning of a restart run
153!
154! 2766 2018-01-22 17:17:47Z kanani
155! Removed preprocessor directive __chem
156!
157! 2746 2018-01-15 12:06:04Z suehring
158! Move flag plant canopy to modules
159!
160! 2718 2018-01-02 08:49:38Z maronga
161! Corrected "Former revisions" section
162!
163! 2696 2017-12-14 17:12:51Z kanani
164! Change in file header (GPL part)
165! Implementation of uv exposure model (FK)
166! Implemented checks for turbulence_closure_mod (TG)
167! Implementation of chemistry module (FK)
168! Bugfix in setting netcdf grids for LSM variables
169! Enable setting of _FillValue attribute in output files (MS)
170!
171! 2512 2017-10-04 08:26:59Z raasch
172! upper bounds of cross section and 3d output changed from nx+1,ny+1 to nx,ny
173! no output of ghost layer data any more
174!
175! 2302 2017-07-03 14:07:20Z suehring
176! Reading of 3D topography using NetCDF data type NC_BYTE
177!
178! 2292 2017-06-20 09:51:42Z schwenkel
179! Implementation of new microphysic scheme: cloud_scheme = 'morrison'
180! includes two more prognostic equations for cloud drop concentration (nc) 
181! and cloud water content (qc).
182!
183! 2270 2017-06-09 12:18:47Z maronga
184! Removed 2 timeseries (shf_eb + qsws_eb). Removed _eb suffixes
185!
186! 2265 2017-06-08 16:58:28Z schwenkel
187! Unused variables removed.
188!
189! 2239 2017-06-01 12:04:51Z suehring
190! Bugfix xy-output of land-surface variables
191!
192! 2233 2017-05-30 18:08:54Z suehring
193!
194! 2232 2017-05-30 17:47:52Z suehring
195! Adjustments to new topography and surface concept
196!
197! Topograpyh height arrays (zu_s_inner, zw_w_inner) are defined locally, output
198! only if parallel netcdf.
199!
200! Build interface for topography input:
201! - open file in read-only mode
202! - read global attributes
203! - read variables
204!
205! Bugfix in xy output (land-surface case)
206!
207! 2209 2017-04-19 09:34:46Z kanani
208! Added support for plant canopy model output
209!
210! 2189 2017-03-21 09:29:52Z raasch
211! bugfix: rho renamed rho_ocean for the cross section output
212!
213! 2109 2017-01-10 12:18:08Z raasch
214! bugfix: length of character string netcdf_var_name extended to avoid problems
215!         which appeared in restart runs due to truncation
216!
217! 2040 2016-10-26 16:58:09Z gronemeier
218! Increased number of possible statistic_regions to 99
219!
220! 2037 2016-10-26 11:15:40Z knoop
221! Anelastic approximation implemented
222!
223! 2031 2016-10-21 15:11:58Z knoop
224! renamed variable rho to rho_ocean
225!
226! 2011 2016-09-19 17:29:57Z kanani
227! Flag urban_surface is now defined in module control_parameters,
228! changed prefix for urban surface model output to "usm_",
229! introduced control parameter varnamelength for LEN of trimvar.
230!
231! 2007 2016-08-24 15:47:17Z kanani
232! Added support for new urban surface model (temporary modifications of
233! SELECT CASE ( ) necessary, see variable trimvar),
234! increased DIMENSION of do2d_unit, do3d_unit, id_var_do2d, id_var_do3d,
235! increased LEN of char_cross_profiles, var_list, var_list_old
236!
237! 2000 2016-08-20 18:09:15Z knoop
238! Forced header and separation lines into 80 columns
239!
240! 1990 2016-08-12 09:54:36Z gronemeier
241! Bugfix: variable list was not written for time series output
242!
243! 1980 2016-07-29 15:51:57Z suehring
244! Bugfix, in order to steer user-defined output, setting flag found explicitly
245! to .F.
246!
247! 1976 2016-07-27 13:28:04Z maronga
248! Removed remaining 2D land surface quantities. Definition of radiation
249! quantities is now done directly in the respective module
250!
251! 1972 2016-07-26 07:52:02Z maronga
252! Bugfix: wrong units for lsm quantities.
253! Definition of grids for land surface quantities is now done directly in the
254! respective module.
255!
256! 1960 2016-07-12 16:34:24Z suehring
257! Additional labels and units for timeseries output of passive scalar-related
258! quantities
259!
260! 1957 2016-07-07 10:43:48Z suehring
261! flight module added
262!
263! 1850 2016-04-08 13:29:27Z maronga
264! Module renamed
265!
266!
267! 1833 2016-04-07 14:23:03Z raasch
268! spectrum renamed spectra_mod
269!
270! 1786 2016-03-08 05:49:27Z raasch
271! Bugfix: id_var_time_sp made public
272!
273! 1783 2016-03-06 18:36:17Z raasch
274! netcdf interface has been modularized, former file netcdf renamed to
275! netcdf_interface, creation of netcdf-dimensions and -variables moved to
276! specific new subroutines create_netcdf_dim and create_netcdf_var,
277! compression (deflation) of variables implemented,
278! ibmy special cpp directive removed
279!
280! 1745 2016-02-05 13:06:51Z gronemeier
281! Bugfix: recalculating ntdim_3d, ntdim_2d_xy/xz/yz when checking the
282!         extensibility of an existing file (only when using parallel NetCDF).
283!
284! 1691 2015-10-26 16:17:44Z maronga
285! Added output of radiative heating rates for RRTMG. Corrected output of
286! radiative fluxes
287!
288! 1682 2015-10-07 23:56:08Z knoop
289! Code annotations made doxygen readable
290!
291! 1596 2015-05-21 09:34:28Z gronemeier
292! Bugfix in masked data output. Read 'zu_3d' when trying to extend masked data
293!
294! 1551 2015-03-03 14:18:16Z maronga
295! Added support for land surface model and radiation model output. In the course
296! of this action a new vertical grid zs (soil) was introduced.
297!
298! 1353 2014-04-08 15:21:23Z heinze
299! REAL constants provided with KIND-attribute
300!
301! 1322 2014-03-20 16:38:49Z raasch
302! Forgotten ONLY-attribute added to USE-statements
303!
304! 1320 2014-03-20 08:40:49Z raasch
305! ONLY-attribute added to USE-statements,
306! kind-parameters added to all INTEGER and REAL declaration statements,
307! kinds are defined in new module kinds,
308! revision history before 2012 removed,
309! comment fields (!:) to be used for variable explanations added to
310! all variable declaration statements
311!
312! 1308 2014-03-13 14:58:42Z fricke
313! +ntime_count, oldmode
314! Adjust NF90_CREATE and NF90_OPEN statement for parallel output
315! To increase the performance for parallel output, the following is done:
316! - Limit time dimension
317! - Values of axis data are only written by PE0
318! - No fill is set for all variables
319! Check the number of output time levels for restart jobs
320!
321! 1206 2013-07-18 12:49:16Z witha
322! Bugfix: typo in preprocessor directive in subroutine open_write_netcdf_file
323!
324! 1092 2013-02-02 11:24:22Z raasch
325! unused variables removed
326!
327! 1053 2012-11-13 17:11:03Z hoffmann
328! +qr, nr, prr
329!
330! 1036 2012-10-22 13:43:42Z raasch
331! code put under GPL (PALM 3.9)
332!
333! 1031 2012-10-19 14:35:30Z raasch
334! netCDF4 without parallel file support implemented, new routines
335! create_netcdf_file and open_write_netcdf_file at end
336!
337! 992 2012-09-05 15:08:26Z hoffmann
338! Removal of the informative messages PA0352 and PA0353.
339
340! 983 2012-08-21 14:17:57Z hoffmann
341! Bugfix in cross_profiles.
342!
343! 964 2012-07-26 09:14:24Z raasch
344! rev 951 and 959 reformatted
345!
346! 959 2012-07-24 13:13:41Z hoffmann
347! Bugfix in cross_profiles. It is not allowed to arrange more than 100
348! profiles with cross_profiles.
349!
350! 951 2012-07-19 14:22:52Z hoffmann
351! cross_profiles, profile_rows, profile_columns are written to netCDF header
352!
353! Revision 1.1  2005/05/18 15:37:16  raasch
354! Initial revision
355!
356!
357! Description:
358! ------------
359!> In case of extend = .FALSE.:
360!> Define all necessary dimensions, axes and variables for the different
361!> netCDF datasets. This subroutine is called from check_open after a new
362!> dataset is created. It leaves the open netCDF files ready to write.
363!>
364!> In case of extend = .TRUE.:
365!> Find out if dimensions and variables of an existing file match the values
366!> of the actual run. If so, get all necessary information (ids, etc.) from
367!> this file.
368!>
369!> Parameter av can assume values 0 (non-averaged data) and 1 (time averaged
370!> data)
371!>
372!> @todo calculation of output time levels for parallel NetCDF still does not
373!>       cover every exception (change of dt_do, end_time in restart)
374!> @todo timeseries and profile output still needs to be rewritten to allow
375!>       modularization
376!> @todo output 2d UTM coordinates without global arrays
377!> @todo output longitude/latitude also with non-parallel output (3d and xy)
378!------------------------------------------------------------------------------!
379 MODULE netcdf_interface
380
381    USE control_parameters,                                                    &
382        ONLY:  biometeorology, fl_max,                                         &
383               max_masks, multi_agent_system_end,                              &
384               multi_agent_system_start, var_fl_max, varnamelength
385    USE kinds
386#if defined( __netcdf )
387    USE NETCDF
388#endif
389    USE mas_global_attributes,                                                 &
390        ONLY:  dim_size_agtnum
391
392    USE netcdf_data_input_mod,                                                 &
393        ONLY: coord_ref_sys, init_model
394
395    PRIVATE
396
397    CHARACTER (LEN=16), DIMENSION(13) ::  agt_var_names =                      &
398          (/ 'ag_id           ', 'ag_x            ', 'ag_y            ',       &
399             'ag_wind         ', 'ag_temp         ', 'ag_group        ',       &
400             'PM10            ', 'PM25            ', 'ag_iPT          ',       &
401             'ag_uv           ', 'not_used        ', 'not_used        ',       &
402             'not_used        ' /)
403
404    CHARACTER (LEN=16), DIMENSION(13) ::  agt_var_units = &
405          (/ 'dim_less        ', 'meters          ', 'meters          ',       &
406             'm/s             ', 'K               ', 'dim_less        ',       &
407             'tbd             ', 'tbd             ', 'tbd             ',       &
408             'tbd             ', 'not_used        ', 'not_used        ',       &
409             'not_used        ' /)
410
411    INTEGER(iwp), PARAMETER ::  dopr_norm_num = 7, dopts_num = 29, dots_max = 100
412
413    CHARACTER (LEN=7), DIMENSION(dopr_norm_num) ::  dopr_norm_names =          &
414         (/ 'wtheta0', 'ws2    ', 'tsw2   ', 'ws3    ', 'ws2tsw ', 'wstsw2 ',  &
415            'z_i    ' /)
416
417    CHARACTER (LEN=7), DIMENSION(dopr_norm_num) ::  dopr_norm_longnames =      &
418         (/ 'wtheta0', 'w*2    ', 't*w2   ', 'w*3    ', 'w*2t*w ', 'w*t*w2 ',  &
419            'z_i    ' /)
420
421    CHARACTER (LEN=7), DIMENSION(dopts_num) :: dopts_label =                   &
422          (/ 'tnpt   ', 'x_     ', 'y_     ', 'z_     ', 'z_abs  ', 'u      ', &
423             'v      ', 'w      ', 'u"     ', 'v"     ', 'w"     ', 'npt_up ', &
424             'w_up   ', 'w_down ', 'radius ', 'r_min  ', 'r_max  ', 'npt_max', &
425             'npt_min', 'x*2    ', 'y*2    ', 'z*2    ', 'u*2    ', 'v*2    ', &
426             'w*2    ', 'u"2    ', 'v"2    ', 'w"2    ', 'npt*2  ' /)
427
428    CHARACTER (LEN=7), DIMENSION(dopts_num) :: dopts_unit =                    &
429          (/ 'number ', 'm      ', 'm      ', 'm      ', 'm      ', 'm/s    ', &
430             'm/s    ', 'm/s    ', 'm/s    ', 'm/s    ', 'm/s    ', 'number ', &
431             'm/s    ', 'm/s    ', 'm      ', 'm      ', 'm      ', 'number ', &
432             'number ', 'm2     ', 'm2     ', 'm2     ', 'm2/s2  ', 'm2/s2  ', &
433             'm2/s2  ', 'm2/s2  ', 'm2/s2  ', 'm2/s2  ', 'number2' /)
434
435    INTEGER(iwp) ::  dots_num  = 25  !< number of timeseries defined by default
436    INTEGER(iwp) ::  dots_soil = 26  !< starting index for soil-timeseries
437    INTEGER(iwp) ::  dots_rad  = 32  !< starting index for radiation-timeseries
438
439    CHARACTER (LEN=13), DIMENSION(dots_max) :: dots_label =                    &
440          (/ 'E            ', 'E*           ', 'dt           ',                &
441             'us*          ', 'th*          ', 'umax         ',                &
442             'vmax         ', 'wmax         ', 'div_new      ',                &
443             'div_old      ', 'zi_wtheta    ', 'zi_theta     ',                &
444             'w*           ', 'w"theta"0    ', 'w"theta"     ',                &
445             'wtheta       ', 'theta(0)     ', 'theta(z_mo)  ',                &
446             'w"u"0        ', 'w"v"0        ', 'w"q"0        ',                &
447             'ol           ', 'q*           ', 'w"s"         ',                &
448             's*           ', 'ghf          ', 'qsws_liq     ',                &
449             'qsws_soil    ', 'qsws_veg     ', 'r_a          ',                &
450             'r_s          ',                                                  &
451             'rad_net      ', 'rad_lw_in    ', 'rad_lw_out   ',                &
452             'rad_sw_in    ', 'rad_sw_out   ', 'rrtm_aldif   ',                &
453             'rrtm_aldir   ', 'rrtm_asdif   ', 'rrtm_asdir   ',                &                                               
454             ( 'unknown      ', i9 = 1, dots_max-40 ) /)
455
456    CHARACTER (LEN=13), DIMENSION(dots_max) :: dots_unit =                     &
457          (/ 'm2/s2        ', 'm2/s2        ', 's            ',                &
458             'm/s          ', 'K            ', 'm/s          ',                &
459             'm/s          ', 'm/s          ', 's-1          ',                &
460             's-1          ', 'm            ', 'm            ',                &
461             'm/s          ', 'K m/s        ', 'K m/s        ',                &
462             'K m/s        ', 'K            ', 'K            ',                &
463             'm2/s2        ', 'm2/s2        ', 'kg m/s       ',                &
464             'm            ', 'kg/kg        ', 'kg m/(kg s)  ',                &
465             'kg/kg        ', 'W/m2         ', 'W/m2         ',                &
466             'W/m2         ', 'W/m2         ', 's/m          ',                &
467             's/m          ',                                                  &
468             'W/m2         ', 'W/m2         ', 'W/m2         ',                &
469             'W/m2         ', 'W/m2         ', '             ',                &
470             '             ', '             ', '             ',                &
471             ( 'unknown      ', i9 = 1, dots_max-40 ) /)
472
473    CHARACTER (LEN=16) :: heatflux_output_unit     !< unit for heatflux output
474    CHARACTER (LEN=16) :: waterflux_output_unit    !< unit for waterflux output
475    CHARACTER (LEN=16) :: momentumflux_output_unit !< unit for momentumflux output
476
477    CHARACTER (LEN=9), DIMENSION(300) ::  dopr_unit = 'unknown'
478
479    CHARACTER (LEN=7), DIMENSION(0:1,500) ::  do2d_unit, do3d_unit
480
481!    CHARACTER (LEN=16), DIMENSION(25) ::  prt_var_names = &
482!          (/ 'pt_age          ', 'pt_dvrp_size    ', 'pt_origin_x     ', &
483!             'pt_origin_y     ', 'pt_origin_z     ', 'pt_radius       ', &
484!             'pt_speed_x      ', 'pt_speed_y      ', 'pt_speed_z      ', &
485!             'pt_weight_factor', 'pt_x            ', 'pt_y            ', &
486!             'pt_z            ', 'pt_color        ', 'pt_group        ', &
487!             'pt_tailpoints   ', 'pt_tail_id      ', 'pt_density_ratio', &
488!             'pt_exp_arg      ', 'pt_exp_term     ', 'not_used        ', &
489!             'not_used        ', 'not_used        ', 'not_used        ', &
490!             'not_used        ' /)
491
492!    CHARACTER (LEN=16), DIMENSION(25) ::  prt_var_units = &
493!          (/ 'seconds         ', 'meters          ', 'meters          ', &
494!             'meters          ', 'meters          ', 'meters          ', &
495!             'm/s             ', 'm/s             ', 'm/s             ', &
496!             'factor          ', 'meters          ', 'meters          ', &
497!             'meters          ', 'none            ', 'none            ', &
498!             'none            ', 'none            ', 'ratio           ', &
499!             'none            ', 'none            ', 'not_used        ', &
500!             'not_used        ', 'not_used        ', 'not_used        ', &
501!             'not_used        ' /)
502
503    CHARACTER(LEN=20), DIMENSION(11) ::  netcdf_precision = ' '
504    CHARACTER(LEN=40) ::  netcdf_data_format_string
505
506    INTEGER(iwp) ::  id_dim_agtnum, id_dim_time_agt,                           &
507                     id_dim_time_fl, id_dim_time_pr,                           &
508                     id_dim_time_pts, id_dim_time_sp, id_dim_time_ts,          &
509                     id_dim_x_sp, id_dim_y_sp, id_dim_zu_sp, id_dim_zw_sp,     &
510                     id_set_agt, id_set_fl, id_set_pr, id_set_prt, id_set_pts, &
511                     id_set_sp, id_set_ts, id_var_agtnum, id_var_time_agt,     &
512                     id_var_time_fl, id_var_rnoa_agt, id_var_time_pr,          &
513                     id_var_time_pts, id_var_time_sp, id_var_time_ts,          &
514                     id_var_x_sp, id_var_y_sp, id_var_zu_sp, id_var_zw_sp,     &
515                     nc_stat
516
517
518    INTEGER(iwp), DIMENSION(0:1) ::  id_dim_time_xy, id_dim_time_xz, &
519                    id_dim_time_yz, id_dim_time_3d, id_dim_x_xy, id_dim_xu_xy, &
520                    id_dim_x_xz, id_dim_xu_xz, id_dim_x_yz, id_dim_xu_yz, &
521                    id_dim_x_3d, id_dim_xu_3d, id_dim_y_xy, id_dim_yv_xy, &
522                    id_dim_y_xz, id_dim_yv_xz, id_dim_y_yz, id_dim_yv_yz, &
523                    id_dim_y_3d, id_dim_yv_3d, id_dim_zs_xy, id_dim_zs_xz, &
524                    id_dim_zs_yz, id_dim_zs_3d, id_dim_zu_xy, id_dim_zu1_xy, &
525                    id_dim_zu_xz, id_dim_zu_yz, id_dim_zu_3d, id_dim_zw_xy, &
526                    id_dim_zw_xz, id_dim_zw_yz, id_dim_zw_3d, id_set_xy, &
527                    id_set_xz, id_set_yz, id_set_3d, id_var_ind_x_yz, &
528                    id_var_ind_y_xz, id_var_ind_z_xy, id_var_time_xy, &
529                    id_var_time_xz, id_var_time_yz, id_var_time_3d, id_var_x_xy, &
530                    id_var_xu_xy, id_var_x_xz, id_var_xu_xz, id_var_x_yz, &
531                    id_var_xu_yz, id_var_x_3d, id_var_xu_3d, id_var_y_xy, &
532                    id_var_yv_xy, id_var_y_xz, id_var_yv_xz, id_var_y_yz, &
533                    id_var_yv_yz, id_var_y_3d, id_var_yv_3d, id_var_zs_xy, &
534                    id_var_zs_xz, id_var_zs_yz, id_var_zs_3d, id_var_zusi_xy, &
535                    id_var_zusi_3d, id_var_zu_xy, id_var_zu1_xy, id_var_zu_xz, &
536                    id_var_zu_yz, id_var_zu_3d, id_var_zwwi_xy, id_var_zwwi_3d, &
537                    id_var_zw_xy, id_var_zw_xz, id_var_zw_yz, id_var_zw_3d
538
539    INTEGER(iwp), DIMENSION(0:2,0:1) ::  id_var_eutm_3d, id_var_nutm_3d, &
540                                         id_var_eutm_xy, id_var_nutm_xy, &
541                                         id_var_eutm_xz, id_var_nutm_xz, &
542                                         id_var_eutm_yz, id_var_nutm_yz
543
544    INTEGER(iwp), DIMENSION(0:2,0:1) ::  id_var_lat_3d, id_var_lon_3d, &
545                                         id_var_lat_xy, id_var_lon_xy, &
546                                         id_var_lat_xz, id_var_lon_xz, &
547                                         id_var_lat_yz, id_var_lon_yz
548
549    INTEGER ::  netcdf_data_format = 2  !< NetCDF3 64bit offset format
550    INTEGER ::  netcdf_deflate = 0      !< NetCDF compression, default: no
551                                        !< compression
552
553    INTEGER(iwp)                 ::  dofl_time_count
554    INTEGER(iwp), DIMENSION(10)  ::  id_var_dospx, id_var_dospy
555    INTEGER(iwp), DIMENSION(20)  ::  id_var_agt
556!    INTEGER(iwp), DIMENSION(20)  ::  id_var_prt
557    INTEGER(iwp), DIMENSION(11)  ::  nc_precision
558    INTEGER(iwp), DIMENSION(dopr_norm_num) ::  id_var_norm_dopr
559   
560    INTEGER(iwp), DIMENSION(fl_max) ::  id_dim_x_fl, id_dim_y_fl, id_dim_z_fl
561    INTEGER(iwp), DIMENSION(fl_max) ::  id_var_x_fl, id_var_y_fl, id_var_z_fl
562   
563    CHARACTER (LEN=20), DIMENSION(fl_max*var_fl_max) :: dofl_label
564    CHARACTER (LEN=20), DIMENSION(fl_max*var_fl_max) :: dofl_unit 
565    CHARACTER (LEN=20), DIMENSION(fl_max) :: dofl_dim_label_x
566    CHARACTER (LEN=20), DIMENSION(fl_max) :: dofl_dim_label_y
567    CHARACTER (LEN=20), DIMENSION(fl_max) :: dofl_dim_label_z
568
569    INTEGER(iwp), DIMENSION(fl_max*var_fl_max) :: id_var_dofl   
570
571    INTEGER(iwp), DIMENSION(dopts_num,0:10) ::  id_var_dopts
572    INTEGER(iwp), DIMENSION(0:1,500)        ::  id_var_do2d, id_var_do3d
573    INTEGER(iwp), DIMENSION(100,0:99)       ::  id_dim_z_pr, id_var_dopr, &
574                                                id_var_z_pr
575    INTEGER(iwp), DIMENSION(dots_max,0:99)  ::  id_var_dots
576
577!
578!-- Masked output
579    CHARACTER (LEN=7), DIMENSION(max_masks,0:1,100) ::  domask_unit
580
581    LOGICAL ::  output_for_t0 = .FALSE.
582
583    INTEGER(iwp), DIMENSION(1:max_masks,0:1) ::  id_dim_time_mask, id_dim_x_mask, &
584                   id_dim_xu_mask, id_dim_y_mask, id_dim_yv_mask, id_dim_zs_mask, &
585                   id_dim_zu_mask, id_dim_zw_mask, &
586                   id_set_mask, &
587                   id_var_time_mask, id_var_x_mask, id_var_xu_mask, &
588                   id_var_y_mask, id_var_yv_mask, id_var_zs_mask, &
589                   id_var_zu_mask, id_var_zw_mask, &
590                   id_var_zusi_mask, id_var_zwwi_mask
591
592    INTEGER(iwp), DIMENSION(0:2,1:max_masks,0:1) ::  id_var_eutm_mask, &
593                                                     id_var_nutm_mask
594
595    INTEGER(iwp), DIMENSION(0:2,1:max_masks,0:1) ::  id_var_lat_mask, &
596                                                     id_var_lon_mask
597
598    INTEGER(iwp), DIMENSION(1:max_masks,0:1,100) ::  id_var_domask
599
600    REAL(wp) ::  fill_value = -9999.0_wp    !< value for the _FillValue attribute
601
602
603    PUBLIC  dofl_dim_label_x, dofl_dim_label_y, dofl_dim_label_z, dofl_label,  &
604            dofl_time_count, dofl_unit, domask_unit, dopr_unit, dopts_num,     &
605            dots_label, dots_max, dots_num, dots_rad, dots_soil, dots_unit,    &
606            do2d_unit, do3d_unit, fill_value, id_set_agt, id_set_fl,           &
607            id_set_mask, id_set_pr, id_set_prt, id_set_pts, id_set_sp,         &
608            id_set_ts, id_set_xy, id_set_xz, id_set_yz, id_set_3d, id_var_agt, &
609            id_var_domask, id_var_dofl, id_var_dopr, id_var_dopts,             &
610            id_var_dospx, id_var_dospy, id_var_dots, id_var_do2d, id_var_do3d, &
611            id_var_norm_dopr, id_var_time_agt, id_var_time_fl,                 &
612            id_var_time_mask, id_var_time_pr, id_var_rnoa_agt, id_var_time_pts,&
613            id_var_time_sp, id_var_time_ts,                                    &
614            id_var_time_xy, id_var_time_xz, id_var_time_yz, id_var_time_3d,    &
615            id_var_x_fl, id_var_y_fl, id_var_z_fl,  nc_stat,                   &
616            netcdf_data_format, netcdf_data_format_string, netcdf_deflate,     &
617            netcdf_precision, output_for_t0, heatflux_output_unit,             &
618            waterflux_output_unit, momentumflux_output_unit
619
620    SAVE
621
622    INTERFACE netcdf_create_dim
623       MODULE PROCEDURE netcdf_create_dim
624    END INTERFACE netcdf_create_dim
625
626    INTERFACE netcdf_create_file
627       MODULE PROCEDURE netcdf_create_file
628    END INTERFACE netcdf_create_file
629
630    INTERFACE netcdf_create_global_atts
631       MODULE PROCEDURE netcdf_create_global_atts
632    END INTERFACE netcdf_create_global_atts
633
634    INTERFACE netcdf_create_var
635       MODULE PROCEDURE netcdf_create_var
636    END INTERFACE netcdf_create_var
637
638    INTERFACE netcdf_create_att
639       MODULE PROCEDURE netcdf_create_att_string
640    END INTERFACE netcdf_create_att
641
642    INTERFACE netcdf_define_header
643       MODULE PROCEDURE netcdf_define_header
644    END INTERFACE netcdf_define_header
645
646    INTERFACE netcdf_handle_error
647       MODULE PROCEDURE netcdf_handle_error
648    END INTERFACE netcdf_handle_error
649
650    INTERFACE netcdf_open_write_file
651       MODULE PROCEDURE netcdf_open_write_file
652    END INTERFACE netcdf_open_write_file
653
654    PUBLIC netcdf_create_att, netcdf_create_dim, netcdf_create_file,           &
655           netcdf_create_global_atts, netcdf_create_var, netcdf_define_header, &
656           netcdf_handle_error, netcdf_open_write_file
657
658 CONTAINS
659
660 SUBROUTINE netcdf_define_header( callmode, extend, av )
661 
662#if defined( __netcdf )
663
664    USE arrays_3d,                                                             &
665        ONLY:  zu, zw
666
667    USE biometeorology_mod,                                                    &
668        ONLY:  bio_define_netcdf_grid
669
670    USE chemistry_model_mod,                                                   &
671        ONLY:  chem_define_netcdf_grid 
672
673    USE basic_constants_and_equations_mod,                                     &
674        ONLY:  pi
675
676    USE control_parameters,                                                    &
677        ONLY:  agent_time_unlimited, air_chemistry, averaging_interval,        &
678               averaging_interval_pr, data_output_pr, domask, dopr_n,          &
679               dopr_time_count, dopts_time_count, dots_time_count,             &
680               do2d, do2d_at_begin, do2d_xz_time_count, do3d, do3d_at_begin,   &
681               do2d_yz_time_count, dt_data_output_av, dt_do2d_xy, dt_do2d_xz,  &
682               dt_do2d_yz, dt_do3d, dt_write_agent_data, mask_size,            &
683               do2d_xy_time_count, do3d_time_count, domask_time_count,         &
684               end_time, indoor_model, land_surface,                           &
685               mask_size_l, mask_i, mask_i_global, mask_j, mask_j_global,      &
686               mask_k_global, mask_surface,                                    &
687               message_string, mid, ntdim_2d_xy, ntdim_2d_xz,                  &
688               ntdim_2d_yz, ntdim_3d, nz_do3d, ocean_mode, plant_canopy,       &
689               run_description_header, salsa, section, simulated_time,         &
690               simulated_time_at_begin, skip_time_data_output_av,              &
691               skip_time_do2d_xy, skip_time_do2d_xz, skip_time_do2d_yz,        &
692               skip_time_do3d, topography, num_leg, num_var_fl,                &
693               urban_surface
694
695    USE grid_variables,                                                        &
696        ONLY:  dx, dy, zu_s_inner, zw_w_inner
697
698    USE gust_mod,                                                              &
699        ONLY: gust_define_netcdf_grid, gust_module_enabled
700
701    USE indices,                                                               &
702        ONLY:  nx, nxl, nxr, ny, nys, nyn, nz ,nzb, nzt
703
704    USE kinds
705
706    USE indoor_model_mod,                                                      &
707        ONLY: im_define_netcdf_grid
708   
709    USE land_surface_model_mod,                                                &
710        ONLY: lsm_define_netcdf_grid, nzb_soil, nzt_soil, nzs, zs
711
712    USE ocean_mod,                                                             &
713        ONLY:  ocean_define_netcdf_grid
714
715    USE pegrid
716
717    USE particle_attributes,                                                   &
718        ONLY:  number_of_particle_groups
719
720    USE plant_canopy_model_mod,                                                &
721        ONLY:  pcm_define_netcdf_grid
722
723    USE profil_parameter,                                                      &
724        ONLY:  crmax, cross_profiles, dopr_index, profile_columns, profile_rows
725
726    USE radiation_model_mod,                                                   &
727        ONLY: radiation, radiation_define_netcdf_grid     
728     
729    USE salsa_mod,                                                             &
730        ONLY:  salsa_define_netcdf_grid           
731
732    USE spectra_mod,                                                           &
733        ONLY:  averaging_interval_sp, comp_spectra_level, data_output_sp, dosp_time_count, spectra_direction
734
735    USE statistics,                                                            &
736        ONLY:  hom, statistic_regions
737
738    USE turbulence_closure_mod,                                                &
739        ONLY:  tcm_define_netcdf_grid
740
741    USE urban_surface_mod,                                                     &
742        ONLY:  usm_define_netcdf_grid
743
744    USE user,                                                                  &
745        ONLY:  user_module_enabled, user_define_netcdf_grid
746
747
748
749    IMPLICIT NONE
750
751    CHARACTER (LEN=3)              ::  suffix                !<
752    CHARACTER (LEN=2), INTENT (IN) ::  callmode              !<
753    CHARACTER (LEN=4)              ::  grid_x                !<
754    CHARACTER (LEN=4)              ::  grid_y                !<
755    CHARACTER (LEN=4)              ::  grid_z                !<
756    CHARACTER (LEN=6)              ::  mode                  !<
757    CHARACTER (LEN=10)             ::  precision             !<
758    CHARACTER (LEN=10)             ::  var                   !<
759    CHARACTER (LEN=20)             ::  netcdf_var_name       !<
760    CHARACTER (LEN=varnamelength)  ::  trimvar               !< TRIM of output-variable string
761    CHARACTER (LEN=80)             ::  time_average_text     !<
762    CHARACTER (LEN=4000)           ::  char_cross_profiles   !<
763    CHARACTER (LEN=4000)           ::  var_list              !<
764    CHARACTER (LEN=4000)           ::  var_list_old          !<
765
766    CHARACTER (LEN=100), DIMENSION(1:crmax) ::  cross_profiles_adj   !<
767    CHARACTER (LEN=100), DIMENSION(1:crmax) ::  cross_profiles_char  !<
768
769    INTEGER(iwp) ::  av                                      !<
770    INTEGER(iwp) ::  cross_profiles_count                    !<
771    INTEGER(iwp) ::  cross_profiles_maxi                     !<
772    INTEGER(iwp) ::  delim                                   !<
773    INTEGER(iwp) ::  delim_old                               !<
774    INTEGER(iwp) ::  file_id                                 !<
775    INTEGER(iwp) ::  i                                       !<
776    INTEGER(iwp) ::  id_last                                 !<
777    INTEGER(iwp) ::  id_x                                    !<
778    INTEGER(iwp) ::  id_y                                    !<
779    INTEGER(iwp) ::  id_z                                    !<
780    INTEGER(iwp) ::  j                                       !<
781    INTEGER(iwp) ::  k                                       !<
782    INTEGER(iwp) ::  kk                                      !<
783    INTEGER(iwp) ::  ns                                      !<
784    INTEGER(iwp) ::  ns_do                                   !< actual value of ns for soil model data
785    INTEGER(iwp) ::  ns_old                                  !<
786    INTEGER(iwp) ::  ntime_count                             !< number of time levels found in file
787    INTEGER(iwp) ::  nz_old                                  !<
788    INTEGER(iwp) ::  l                                       !<
789
790    INTEGER(iwp), SAVE ::  oldmode                           !<
791
792    INTEGER(iwp), DIMENSION(1) ::  id_dim_time_old           !<
793    INTEGER(iwp), DIMENSION(1) ::  id_dim_x_yz_old           !<
794    INTEGER(iwp), DIMENSION(1) ::  id_dim_y_xz_old           !<
795    INTEGER(iwp), DIMENSION(1) ::  id_dim_zu_sp_old          !<
796    INTEGER(iwp), DIMENSION(1) ::  id_dim_zu_xy_old          !<
797    INTEGER(iwp), DIMENSION(1) ::  id_dim_zu_3d_old          !<
798    INTEGER(iwp), DIMENSION(1) ::  id_dim_zu_mask_old        !<
799
800
801    INTEGER(iwp), DIMENSION(1:crmax) ::  cross_profiles_numb !<
802
803    LOGICAL ::  found                                        !<
804
805    LOGICAL, INTENT (INOUT) ::  extend                       !<
806
807    LOGICAL, SAVE ::  init_netcdf = .FALSE.                  !<
808
809    REAL(wp) ::  cos_ra                                      !< cosine of rotation_angle
810    REAL(wp) ::  eutm                                        !< easting (UTM)
811    REAL(wp) ::  nutm                                        !< northing (UTM)
812    REAL(wp) ::  shift_x                                     !< shift of x coordinate
813    REAL(wp) ::  shift_y                                     !< shift of y coordinate
814    REAL(wp) ::  sin_ra                                      !< sine of rotation_angle
815
816    REAL(wp), DIMENSION(1) ::  last_time_coordinate          !< last time value in file
817    REAL(wp), DIMENSION(8) ::  crs_list                      !< list of coord_ref_sys values
818
819    REAL(wp), DIMENSION(:), ALLOCATABLE   ::  netcdf_data    !<
820    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  netcdf_data_2d !<
821    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  lat            !< latitude
822    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  lon            !< longitude
823
824
825!
826!-- Initializing actions
827    IF ( .NOT. init_netcdf )  THEN
828!
829!--    Check and set accuracy for netCDF output. First set default value
830       nc_precision = NF90_REAL4
831
832       i = 1
833       DO  WHILE ( netcdf_precision(i) /= ' ' )
834          j = INDEX( netcdf_precision(i), '_' )
835          IF ( j == 0 )  THEN
836             WRITE ( message_string, * ) 'netcdf_precision must contain a ', &
837                                         '"_"netcdf_precision(', i, ')="',   &
838                                         TRIM( netcdf_precision(i) ),'"'
839             CALL message( 'netcdf_define_header', 'PA0241', 2, 2, 0, 6, 0 )
840          ENDIF
841
842          var       = netcdf_precision(i)(1:j-1)
843          precision = netcdf_precision(i)(j+1:)
844
845          IF ( precision == 'NF90_REAL4' )  THEN
846             j = NF90_REAL4
847          ELSEIF ( precision == 'NF90_REAL8' )  THEN
848             j = NF90_REAL8
849          ELSE
850             WRITE ( message_string, * ) 'illegal netcdf precision: ',  &
851                                         'netcdf_precision(', i, ')="', &
852                                         TRIM( netcdf_precision(i) ),'"'
853             CALL message( 'netcdf_define_header', 'PA0242', 1, 2, 0, 6, 0 )
854          ENDIF
855
856          SELECT CASE ( var )
857             CASE ( 'xy' )
858                nc_precision(1) = j
859             CASE ( 'xz' )
860                nc_precision(2) = j
861             CASE ( 'yz' )
862                nc_precision(3) = j
863             CASE ( '2d' )
864                nc_precision(1:3) = j
865             CASE ( '3d' )
866                nc_precision(4) = j
867             CASE ( 'pr' )
868                nc_precision(5) = j
869             CASE ( 'ts' )
870                nc_precision(6) = j
871             CASE ( 'sp' )
872                nc_precision(7) = j
873             CASE ( 'prt' )
874                nc_precision(8) = j
875             CASE ( 'masks' )
876                nc_precision(11) = j
877             CASE ( 'fl' )
878                nc_precision(9) = j
879             CASE ( 'all' )
880                nc_precision    = j
881
882             CASE DEFAULT
883                WRITE ( message_string, * ) 'unknown variable in ' //          &
884                                  'initialization_parameters ',                & 
885                                  'assignment: netcdf_precision(', i, ')="',   &
886                                            TRIM( netcdf_precision(i) ),'"'
887                CALL message( 'netcdf_define_header', 'PA0243', 1, 2, 0, 6, 0 )
888
889          END SELECT
890
891          i = i + 1
892          IF ( i > 50 )  EXIT
893       ENDDO
894
895!
896!--    Check for allowed parameter range
897       IF ( netcdf_deflate < 0  .OR.  netcdf_deflate > 9 )  THEN
898          WRITE ( message_string, '(A,I3,A)' ) 'netcdf_deflate out of ' //     &
899                                      'range & given value: ', netcdf_deflate, &
900                                      ', allowed range: 0-9'
901          CALL message( 'netcdf_define_header', 'PA0355', 2, 2, 0, 6, 0 )
902       ENDIF
903!
904!--    Data compression does not work with parallel NetCDF/HDF5
905       IF ( netcdf_deflate > 0  .AND.  netcdf_data_format /= 3 )  THEN
906          message_string = 'netcdf_deflate reset to 0'
907          CALL message( 'netcdf_define_header', 'PA0356', 0, 1, 0, 6, 0 )
908
909          netcdf_deflate = 0
910       ENDIF
911
912       init_netcdf = .TRUE.
913
914    ENDIF
915!
916!-- Convert coord_ref_sys into vector (used for lat/lon calculation)
917    crs_list = (/ coord_ref_sys%semi_major_axis,                  &
918                  coord_ref_sys%inverse_flattening,               &
919                  coord_ref_sys%longitude_of_prime_meridian,      &
920                  coord_ref_sys%longitude_of_central_meridian,    &
921                  coord_ref_sys%scale_factor_at_central_meridian, &
922                  coord_ref_sys%latitude_of_projection_origin,    &
923                  coord_ref_sys%false_easting,                    &
924                  coord_ref_sys%false_northing /)
925
926!
927!-- Determine the mode to be processed
928    IF ( extend )  THEN
929       mode = callmode // '_ext'
930    ELSE
931       mode = callmode // '_new'
932    ENDIF
933
934!
935!-- Select the mode to be processed. Possibilities are 3d, ma (mask), xy, xz,
936!-- yz, pr (profiles), ps (particle timeseries), fl (flight data), ts
937!-- (timeseries) or sp (spectra)
938    SELECT CASE ( mode )
939
940       CASE ( 'ma_new' )
941
942!
943!--       decompose actual parameter file_id (=formal parameter av) into
944!--       mid and av
945          file_id = av
946          IF ( file_id <= 200+max_masks )  THEN
947             mid = file_id - 200
948             av = 0
949          ELSE
950             mid = file_id - (200+max_masks)
951             av = 1
952          ENDIF
953
954!
955!--       Define some global attributes of the dataset
956          IF ( av == 0 )  THEN
957             CALL netcdf_create_global_atts( id_set_mask(mid,av), 'podsmasked', TRIM( run_description_header ), 464 )
958             time_average_text = ' '
959          ELSE
960             CALL netcdf_create_global_atts( id_set_mask(mid,av), 'podsmasked', TRIM( run_description_header ), 464 )
961             WRITE ( time_average_text,'(F7.1,'' s avg'')' )  averaging_interval
962             nc_stat = NF90_PUT_ATT( id_set_mask(mid,av), NF90_GLOBAL, 'time_avg',   &
963                                     TRIM( time_average_text ) )
964             CALL netcdf_handle_error( 'netcdf_define_header', 466 )
965          ENDIF
966
967!
968!--       Define time coordinate for volume data (unlimited dimension)
969          CALL netcdf_create_dim( id_set_mask(mid,av), 'time', NF90_UNLIMITED, &
970                                  id_dim_time_mask(mid,av), 467 )
971          CALL netcdf_create_var( id_set_mask(mid,av),                         &
972                                  (/ id_dim_time_mask(mid,av) /), 'time',      &
973                                  NF90_DOUBLE, id_var_time_mask(mid,av),       &
974                                 'seconds', 'time', 468, 469, 000 )
975          CALL netcdf_create_att( id_set_mask(mid,av), id_var_time_mask(mid,av), 'standard_name', 'time', 000)
976          CALL netcdf_create_att( id_set_mask(mid,av), id_var_time_mask(mid,av), 'axis', 'T', 000)
977
978!
979!--       Define spatial dimensions and coordinates:
980          IF ( mask_surface(mid) )  THEN
981!
982!--          In case of terrain-following output, the vertical dimensions are
983!--          indices, not meters
984             CALL netcdf_create_dim( id_set_mask(mid,av), 'ku_above_surf',     &
985                                     mask_size(mid,3), id_dim_zu_mask(mid,av), &
986                                     470 )
987             CALL netcdf_create_var( id_set_mask(mid,av),                      &
988                                     (/ id_dim_zu_mask(mid,av) /),             &
989                                     'ku_above_surf',                          &
990                                     NF90_DOUBLE, id_var_zu_mask(mid,av),      &
991                                     '1', 'grid point above terrain',          &
992                                     471, 472, 000 )
993             CALL netcdf_create_dim( id_set_mask(mid,av), 'kw_above_surf',     &
994                                     mask_size(mid,3), id_dim_zw_mask(mid,av), &
995                                     473 )
996             CALL netcdf_create_var( id_set_mask(mid,av),                      &
997                                     (/ id_dim_zw_mask(mid,av) /),             &
998                                     'kw_above_surf',                          &
999                                     NF90_DOUBLE, id_var_zw_mask(mid,av),      &
1000                                    '1', 'grid point above terrain',           &
1001                                    474, 475, 000 )
1002          ELSE
1003!
1004!--          Define vertical coordinate grid (zu grid)
1005             CALL netcdf_create_dim( id_set_mask(mid,av), 'zu_3d',             &
1006                                     mask_size(mid,3), id_dim_zu_mask(mid,av), &
1007                                     470 )
1008             CALL netcdf_create_var( id_set_mask(mid,av),                      &
1009                                     (/ id_dim_zu_mask(mid,av) /), 'zu_3d',    &
1010                                     NF90_DOUBLE, id_var_zu_mask(mid,av),      &
1011                                     'meters', '', 471, 472, 000 )
1012!
1013!--          Define vertical coordinate grid (zw grid)
1014             CALL netcdf_create_dim( id_set_mask(mid,av), 'zw_3d',             &
1015                                     mask_size(mid,3), id_dim_zw_mask(mid,av), &
1016                                     473 )
1017             CALL netcdf_create_var( id_set_mask(mid,av),                      &
1018                                     (/ id_dim_zw_mask(mid,av) /), 'zw_3d',    &
1019                                     NF90_DOUBLE, id_var_zw_mask(mid,av),      &
1020                                    'meters', '', 474, 475, 000 )
1021          ENDIF
1022!
1023!--       Define x-axis (for scalar position)
1024          CALL netcdf_create_dim( id_set_mask(mid,av), 'x', mask_size(mid,1),  &
1025                                  id_dim_x_mask(mid,av), 476 )
1026          CALL netcdf_create_var( id_set_mask(mid,av),                         &
1027                                  (/ id_dim_x_mask(mid,av) /), 'x',            &
1028                                  NF90_DOUBLE, id_var_x_mask(mid,av),          &
1029                                  'meters', '', 477, 478, 000 )
1030!
1031!--       Define x-axis (for u position)
1032          CALL netcdf_create_dim( id_set_mask(mid,av), 'xu', mask_size(mid,1), &
1033                                  id_dim_xu_mask(mid,av), 479 )
1034          CALL netcdf_create_var( id_set_mask(mid,av),                         &
1035                                  (/ id_dim_xu_mask(mid,av) /), 'xu',          &
1036                                  NF90_DOUBLE, id_var_xu_mask(mid,av),         &
1037                                  'meters', '', 480, 481, 000 )
1038!
1039!--       Define y-axis (for scalar position)
1040          CALL netcdf_create_dim( id_set_mask(mid,av), 'y', mask_size(mid,2),  &
1041                                  id_dim_y_mask(mid,av), 482 )
1042          CALL netcdf_create_var( id_set_mask(mid,av),                         &
1043                                  (/ id_dim_y_mask(mid,av) /), 'y',            &
1044                                  NF90_DOUBLE, id_var_y_mask(mid,av),          &
1045                                  'meters', '', 483, 484, 000 )
1046!
1047!--       Define y-axis (for v position)
1048          CALL netcdf_create_dim( id_set_mask(mid,av), 'yv', mask_size(mid,2), &
1049                                  id_dim_yv_mask(mid,av), 485 )
1050          CALL netcdf_create_var( id_set_mask(mid,av),                         &
1051                                  (/ id_dim_yv_mask(mid,av) /),                &
1052                                  'yv', NF90_DOUBLE, id_var_yv_mask(mid,av),   &
1053                                  'meters', '', 486, 487, 000 )
1054!
1055!--       Define UTM and geographic coordinates
1056          CALL define_geo_coordinates( id_set_mask(mid,av),               &
1057                  (/ id_dim_x_mask(mid,av), id_dim_xu_mask(mid,av) /),    &
1058                  (/ id_dim_y_mask(mid,av), id_dim_yv_mask(mid,av) /),    &
1059                  id_var_eutm_mask(:,mid,av), id_var_nutm_mask(:,mid,av), &
1060                  id_var_lat_mask(:,mid,av), id_var_lon_mask(:,mid,av)    )
1061!
1062!--       Define coordinate-reference system
1063          CALL netcdf_create_crs( id_set_mask(mid,av), 000 )
1064!
1065!--       In case of non-flat topography define 2d-arrays containing the height
1066!--       information. Only for parallel netcdf output.
1067          IF ( TRIM( topography ) /= 'flat'  .AND.                             &
1068               netcdf_data_format > 4 )  THEN
1069!
1070!--          Define zusi = zu(nzb_s_inner)
1071             CALL netcdf_create_var( id_set_mask(mid,av),                      &
1072                                     (/ id_dim_x_mask(mid,av),                 &
1073                                        id_dim_y_mask(mid,av) /), 'zusi',      &
1074                                     NF90_DOUBLE, id_var_zusi_mask(mid,av),    &
1075                                     'meters', 'zu(nzb_s_inner)', 488, 489,    &
1076                                     490 )
1077!             
1078!--          Define zwwi = zw(nzb_w_inner)
1079             CALL netcdf_create_var( id_set_mask(mid,av),                      &
1080                                     (/ id_dim_x_mask(mid,av),                 &
1081                                        id_dim_y_mask(mid,av) /), 'zwwi',      &
1082                                     NF90_DOUBLE, id_var_zwwi_mask(mid,av),    &
1083                                     'meters', 'zw(nzb_w_inner)', 491, 492,    &
1084                                     493 )
1085          ENDIF             
1086 
1087          IF ( land_surface )  THEN
1088!
1089!--          Define vertical coordinate grid (zw grid)
1090             CALL netcdf_create_dim( id_set_mask(mid,av), 'zs_3d',             &
1091                                     mask_size(mid,3), id_dim_zs_mask(mid,av), &
1092                                     536 )
1093             CALL netcdf_create_var( id_set_mask(mid,av),                      &
1094                                     (/ id_dim_zs_mask(mid,av) /), 'zs_3d',    &
1095                                     NF90_DOUBLE, id_var_zs_mask(mid,av),      &
1096                                     'meters', '', 537, 555, 000 )
1097          ENDIF
1098
1099!
1100!--       Define the variables
1101          var_list = ';'
1102          i = 1
1103
1104          DO WHILE ( domask(mid,av,i)(1:1) /= ' ' )
1105!
1106!--          Temporary solution to account for data output within the new urban
1107!--          surface model (urban_surface_mod.f90), see also SELECT CASE ( trimvar )
1108             trimvar = TRIM( domask(mid,av,i) )
1109             IF ( urban_surface  .AND.  trimvar(1:4) == 'usm_' )  THEN
1110                trimvar = 'usm_output'
1111             ENDIF
1112!
1113!--          Check for the grid
1114             found = .FALSE.
1115             SELECT CASE ( trimvar )
1116!
1117!--             Most variables are defined on the scalar grid
1118                CASE ( 'e', 'nc', 'nr', 'p', 'pc', 'pr', 'prr',                &
1119                       'q', 'qc', 'ql', 'ql_c', 'ql_v', 'ql_vp', 'qr', 'qv',   &
1120                       's', 'theta', 'thetal', 'thetav' )
1121
1122                   grid_x = 'x'
1123                   grid_y = 'y'
1124                   grid_z = 'zu'
1125!
1126!--             u grid
1127                CASE ( 'u' )
1128
1129                   grid_x = 'xu'
1130                   grid_y = 'y'
1131                   grid_z = 'zu'
1132!
1133!--             v grid
1134                CASE ( 'v' )
1135
1136                   grid_x = 'x'
1137                   grid_y = 'yv'
1138                   grid_z = 'zu'
1139!
1140!--             w grid
1141                CASE ( 'w' )
1142
1143                   grid_x = 'x'
1144                   grid_y = 'y'
1145                   grid_z = 'zw'
1146
1147!             
1148!--             Block of urban surface model outputs
1149                CASE ( 'usm_output' )
1150
1151                   CALL usm_define_netcdf_grid( domask( mid,av,i), found,      &
1152                                                        grid_x, grid_y, grid_z )
1153
1154                CASE DEFAULT
1155!
1156!--                Check for quantities defined in other modules                                                       
1157                   CALL tcm_define_netcdf_grid( domask( mid,av,i), found,      &
1158                                                        grid_x, grid_y, grid_z )
1159
1160                   IF ( .NOT. found  .AND.  air_chemistry )  THEN
1161                      CALL chem_define_netcdf_grid( domask(mid,av,i), found,   &
1162                                                    grid_x, grid_y, grid_z )
1163                   ENDIF
1164
1165                   IF ( .NOT. found  .AND.  gust_module_enabled )  THEN
1166                      CALL gust_define_netcdf_grid( domask(mid,av,i), found,   &
1167                                                    grid_x, grid_y, grid_z )
1168                   ENDIF
1169
1170                   IF ( land_surface )  THEN
1171                      CALL lsm_define_netcdf_grid( domask(mid,av,i), found,    &
1172                                                   grid_x, grid_y, grid_z )
1173                   ENDIF
1174
1175                   IF ( .NOT. found  .AND.  ocean_mode )  THEN
1176                      CALL ocean_define_netcdf_grid( domask(mid,av,i), found,  &
1177                                                     grid_x, grid_y, grid_z )
1178                   ENDIF
1179
1180                   IF ( .NOT. found  .AND.  plant_canopy )  THEN
1181                      CALL pcm_define_netcdf_grid( domask(mid,av,i), found,    &
1182                                                   grid_x, grid_y, grid_z )
1183                   ENDIF
1184
1185                   IF ( .NOT. found  .AND.  radiation )  THEN
1186                      CALL radiation_define_netcdf_grid( domask(mid,av,i),     &
1187                                                         found, grid_x, grid_y,&
1188                                                         grid_z )
1189                   ENDIF
1190!
1191!--                Check for SALSA quantities
1192                   IF ( .NOT. found  .AND.  salsa )  THEN
1193                      CALL salsa_define_netcdf_grid( domask(mid,av,i), found,  &
1194                                                     grid_x, grid_y, grid_z )
1195                   ENDIF                                   
1196!
1197!--                Now check for user-defined quantities
1198                   IF ( .NOT. found  .AND.  user_module_enabled )  THEN
1199                      CALL user_define_netcdf_grid( domask(mid,av,i), found,   &
1200                                                    grid_x, grid_y, grid_z )
1201                   ENDIF
1202                                                 
1203                   IF ( .NOT. found )  THEN
1204                      WRITE ( message_string, * ) 'no grid defined for',       &
1205                           ' variable ', TRIM( domask(mid,av,i) )
1206                      CALL message( 'define_netcdf_header', 'PA0244', 0, 1, 0, &
1207                                    6, 0 )
1208                   ENDIF
1209
1210             END SELECT
1211
1212!
1213!--          Select the respective dimension ids
1214             IF ( grid_x == 'x' )  THEN
1215                id_x = id_dim_x_mask(mid,av)
1216             ELSEIF ( grid_x == 'xu' )  THEN
1217                id_x = id_dim_xu_mask(mid,av)
1218             ENDIF
1219
1220             IF ( grid_y == 'y' )  THEN
1221                id_y = id_dim_y_mask(mid,av)
1222             ELSEIF ( grid_y == 'yv' )  THEN
1223                id_y = id_dim_yv_mask(mid,av)
1224             ENDIF
1225
1226             IF ( grid_z == 'zu' )  THEN
1227                id_z = id_dim_zu_mask(mid,av)
1228             ELSEIF ( grid_z == 'zw' )  THEN
1229                id_z = id_dim_zw_mask(mid,av)
1230             ELSEIF ( grid_z == "zs" )  THEN
1231                id_z = id_dim_zs_mask(mid,av)
1232             ENDIF
1233
1234!
1235!--          Define the grid
1236             CALL netcdf_create_var( id_set_mask(mid,av), (/ id_x, id_y, id_z, &
1237                                     id_dim_time_mask(mid,av) /),              &
1238                                     domask(mid,av,i), nc_precision(11),       &
1239                                     id_var_domask(mid,av,i),                  &
1240                                     TRIM( domask_unit(mid,av,i) ),            &
1241                                     domask(mid,av,i), 494, 495, 496, .TRUE. )
1242
1243             var_list = TRIM( var_list ) // TRIM( domask(mid,av,i) ) // ';'
1244
1245             i = i + 1
1246
1247          ENDDO
1248
1249!
1250!--       No arrays to output
1251          IF ( i == 1 )  RETURN
1252
1253!
1254!--       Write the list of variables as global attribute (this is used by
1255!--       restart runs and by combine_plot_fields)
1256          nc_stat = NF90_PUT_ATT( id_set_mask(mid,av), NF90_GLOBAL, &
1257                                  'VAR_LIST', var_list )
1258          CALL netcdf_handle_error( 'netcdf_define_header', 497 )
1259
1260!
1261!--       Leave netCDF define mode
1262          nc_stat = NF90_ENDDEF( id_set_mask(mid,av) )
1263          CALL netcdf_handle_error( 'netcdf_define_header', 498 )
1264
1265!
1266!--       Write data for x (shifted by +dx/2) and xu axis
1267          ALLOCATE( netcdf_data(mask_size(mid,1)) )
1268
1269          netcdf_data = ( mask_i_global(mid,:mask_size(mid,1)) + 0.5_wp ) * dx
1270
1271          nc_stat = NF90_PUT_VAR( id_set_mask(mid,av), id_var_x_mask(mid,av), &
1272                                  netcdf_data, start = (/ 1 /),               &
1273                                  count = (/ mask_size(mid,1) /) )
1274          CALL netcdf_handle_error( 'netcdf_define_header', 499 )
1275
1276          netcdf_data = mask_i_global(mid,:mask_size(mid,1)) * dx
1277
1278          nc_stat = NF90_PUT_VAR( id_set_mask(mid,av), id_var_xu_mask(mid,av),&
1279                                  netcdf_data, start = (/ 1 /),               &
1280                                  count = (/ mask_size(mid,1) /) )
1281          CALL netcdf_handle_error( 'netcdf_define_header', 500 )
1282
1283          DEALLOCATE( netcdf_data )
1284
1285!
1286!--       Write data for y (shifted by +dy/2) and yv axis
1287          ALLOCATE( netcdf_data(mask_size(mid,2)) )
1288
1289          netcdf_data = ( mask_j_global(mid,:mask_size(mid,2)) + 0.5_wp ) * dy
1290
1291          nc_stat = NF90_PUT_VAR( id_set_mask(mid,av), id_var_y_mask(mid,av), &
1292                                  netcdf_data, start = (/ 1 /),               &
1293                                  count = (/ mask_size(mid,2) /))
1294          CALL netcdf_handle_error( 'netcdf_define_header', 501 )
1295
1296          netcdf_data = mask_j_global(mid,:mask_size(mid,2)) * dy
1297
1298          nc_stat = NF90_PUT_VAR( id_set_mask(mid,av), id_var_yv_mask(mid,av), &
1299                                  netcdf_data, start = (/ 1 /),    &
1300                                  count = (/ mask_size(mid,2) /))
1301          CALL netcdf_handle_error( 'netcdf_define_header', 502 )
1302
1303          DEALLOCATE( netcdf_data )
1304
1305!
1306!--       Write UTM coordinates
1307          IF ( init_model%rotation_angle == 0.0_wp )  THEN
1308!
1309!--          1D in case of no rotation
1310             cos_ra = COS( init_model%rotation_angle * pi / 180.0_wp )
1311!
1312!--          x coordinates
1313             ALLOCATE( netcdf_data(mask_size(mid,1)) )
1314             DO  k = 0, 2
1315!           
1316!--             Scalar grid points
1317                IF ( k == 0 )  THEN
1318                   shift_x = 0.5
1319!           
1320!--             u grid points
1321                ELSEIF ( k == 1 )  THEN
1322                   shift_x = 0.0
1323!           
1324!--             v grid points
1325                ELSEIF ( k == 2 )  THEN
1326                   shift_x = 0.5
1327                ENDIF
1328
1329                netcdf_data = init_model%origin_x + cos_ra                     &
1330                       * ( mask_i_global(mid,:mask_size(mid,1)) + shift_x ) * dx
1331
1332                nc_stat = NF90_PUT_VAR( id_set_mask(mid,av), &
1333                                        id_var_eutm_mask(k,mid,av), &
1334                                        netcdf_data, start = (/ 1 /), &
1335                                        count = (/ mask_size(mid,1) /) )
1336                CALL netcdf_handle_error( 'netcdf_define_header', 555 )
1337
1338             ENDDO
1339             DEALLOCATE( netcdf_data )
1340!
1341!--          y coordinates
1342             ALLOCATE( netcdf_data(mask_size(mid,2)) )
1343             DO  k = 0, 2
1344!
1345!--             Scalar grid points
1346                IF ( k == 0 )  THEN
1347                   shift_y = 0.5
1348!
1349!--             u grid points
1350                ELSEIF ( k == 1 )  THEN
1351                   shift_y = 0.5
1352!
1353!--             v grid points
1354                ELSEIF ( k == 2 )  THEN
1355                   shift_y = 0.0
1356                ENDIF
1357
1358                netcdf_data = init_model%origin_y + cos_ra                     &
1359                       * ( mask_j_global(mid,:mask_size(mid,2)) + shift_y ) * dy
1360
1361                nc_stat = NF90_PUT_VAR( id_set_mask(mid,av), &
1362                                        id_var_nutm_mask(k,mid,av), &
1363                                        netcdf_data, start = (/ 1 /), &
1364                                        count = (/ mask_size(mid,2) /) )
1365                CALL netcdf_handle_error( 'netcdf_define_header', 556 )
1366
1367             ENDDO
1368             DEALLOCATE( netcdf_data )
1369
1370          ELSE
1371!
1372!--          2D in case of rotation
1373             ALLOCATE( netcdf_data_2d(mask_size(mid,1),mask_size(mid,2)) )
1374             cos_ra = COS( init_model%rotation_angle * pi / 180.0_wp )
1375             sin_ra = SIN( init_model%rotation_angle * pi / 180.0_wp )
1376
1377             DO  k = 0, 2
1378!           
1379!--            Scalar grid points
1380               IF ( k == 0 )  THEN
1381                  shift_x = 0.5 ; shift_y = 0.5
1382!           
1383!--            u grid points
1384               ELSEIF ( k == 1 )  THEN
1385                  shift_x = 0.0 ; shift_y = 0.5
1386!           
1387!--            v grid points
1388               ELSEIF ( k == 2 )  THEN
1389                  shift_x = 0.5 ; shift_y = 0.0
1390               ENDIF
1391
1392               DO  j = 1, mask_size(mid,2)
1393                  DO  i = 1, mask_size(mid,1)
1394                     netcdf_data_2d(i,j) = init_model%origin_x                 &
1395                           + cos_ra * ( mask_i_global(mid,i) + shift_x ) * dx  &
1396                           + sin_ra * ( mask_j_global(mid,j) + shift_y ) * dy
1397                  ENDDO
1398               ENDDO
1399
1400               nc_stat = NF90_PUT_VAR( id_set_mask(mid,av), &
1401                                       id_var_eutm_mask(k,mid,av), &
1402                                       netcdf_data_2d, start = (/ 1, 1 /), &
1403                                       count = (/ mask_size(mid,1), &
1404                                                  mask_size(mid,2) /) )
1405               CALL netcdf_handle_error( 'netcdf_define_header', 555 )
1406
1407               DO  j = 1, mask_size(mid,2)
1408                  DO  i = 1, mask_size(mid,1)
1409                     netcdf_data_2d(i,j) = init_model%origin_y                 &
1410                           - sin_ra * ( mask_i_global(mid,i) + shift_x ) * dx  &
1411                           + cos_ra * ( mask_j_global(mid,j) + shift_y ) * dy
1412                  ENDDO
1413               ENDDO
1414             
1415               nc_stat = NF90_PUT_VAR( id_set_mask(mid,av), &
1416                                       id_var_nutm_mask(k,mid,av), &
1417                                       netcdf_data_2d, start = (/ 1, 1 /), &
1418                                       count = (/ mask_size(mid,1), &
1419                                                  mask_size(mid,2) /) )
1420               CALL netcdf_handle_error( 'netcdf_define_header', 556 )
1421             
1422             ENDDO
1423             DEALLOCATE( netcdf_data_2d )
1424          ENDIF
1425!
1426!--       Write lon and lat data.
1427          ALLOCATE( lat(mask_size(mid,1),mask_size(mid,2)) )
1428          ALLOCATE( lon(mask_size(mid,1),mask_size(mid,2)) )
1429          cos_ra = COS( init_model%rotation_angle * pi / 180.0_wp )
1430          sin_ra = SIN( init_model%rotation_angle * pi / 180.0_wp )
1431
1432          DO  k = 0, 2
1433!               
1434!--          Scalar grid points
1435             IF ( k == 0 )  THEN
1436                shift_x = 0.5 ; shift_y = 0.5
1437!               
1438!--          u grid points
1439             ELSEIF ( k == 1 )  THEN
1440                shift_x = 0.0 ; shift_y = 0.5
1441!               
1442!--          v grid points
1443             ELSEIF ( k == 2 )  THEN
1444                shift_x = 0.5 ; shift_y = 0.0
1445             ENDIF
1446
1447             DO  j = 1, mask_size(mid,2)
1448                DO  i = 1, mask_size(mid,1)
1449                   eutm = init_model%origin_x                               &
1450                        + cos_ra * ( mask_i_global(mid,i) + shift_x ) * dx  &
1451                        + sin_ra * ( mask_j_global(mid,j) + shift_y ) * dy
1452                   nutm = init_model%origin_y                               &
1453                        - sin_ra * ( mask_i_global(mid,i) + shift_x ) * dx  &
1454                        + cos_ra * ( mask_j_global(mid,j) + shift_y ) * dy
1455
1456                   CALL  convert_utm_to_geographic( crs_list,          &
1457                                                    eutm, nutm,        &
1458                                                    lon(i,j), lat(i,j) )
1459                ENDDO
1460             ENDDO
1461
1462             nc_stat = NF90_PUT_VAR( id_set_mask(mid,av),           &
1463                                     id_var_lon_mask(k,mid,av),     &
1464                                     lon, start = (/ 1, 1 /),       &
1465                                     count = (/ mask_size(mid,1),   &
1466                                                mask_size(mid,2) /) )
1467             CALL netcdf_handle_error( 'netcdf_define_header', 556 )
1468
1469             nc_stat = NF90_PUT_VAR( id_set_mask(mid,av),           &
1470                                     id_var_lat_mask(k,mid,av),     &
1471                                     lat, start = (/ 1, 1 /),       &
1472                                     count = (/ mask_size(mid,1),   &
1473                                                mask_size(mid,2) /) )
1474             CALL netcdf_handle_error( 'netcdf_define_header', 556 )
1475          ENDDO
1476
1477          DEALLOCATE( lat )
1478          DEALLOCATE( lon )
1479!
1480!--       Write zu and zw data (vertical axes)
1481          ALLOCATE( netcdf_data(mask_size(mid,3)) )
1482
1483          IF ( mask_surface(mid) )  THEN
1484
1485             netcdf_data = mask_k_global(mid,:mask_size(mid,3))
1486
1487             nc_stat = NF90_PUT_VAR( id_set_mask(mid,av), id_var_zu_mask(mid,av), &
1488                                     netcdf_data, start = (/ 1 /), &
1489                                     count = (/ mask_size(mid,3) /) )
1490             CALL netcdf_handle_error( 'netcdf_define_header', 503 )
1491
1492             netcdf_data = mask_k_global(mid,:mask_size(mid,3))
1493
1494             nc_stat = NF90_PUT_VAR( id_set_mask(mid,av), id_var_zw_mask(mid,av), &
1495                                     netcdf_data, start = (/ 1 /), &
1496                                     count = (/ mask_size(mid,3) /) )
1497             CALL netcdf_handle_error( 'netcdf_define_header', 504 )
1498
1499          ELSE
1500
1501             netcdf_data = zu( mask_k_global(mid,:mask_size(mid,3)) )
1502
1503             nc_stat = NF90_PUT_VAR( id_set_mask(mid,av), id_var_zu_mask(mid,av), &
1504                                     netcdf_data, start = (/ 1 /), &
1505                                     count = (/ mask_size(mid,3) /) )
1506             CALL netcdf_handle_error( 'netcdf_define_header', 503 )
1507
1508             netcdf_data = zw( mask_k_global(mid,:mask_size(mid,3)) )
1509
1510             nc_stat = NF90_PUT_VAR( id_set_mask(mid,av), id_var_zw_mask(mid,av), &
1511                                     netcdf_data, start = (/ 1 /), &
1512                                     count = (/ mask_size(mid,3) /) )
1513             CALL netcdf_handle_error( 'netcdf_define_header', 504 )
1514
1515          ENDIF
1516
1517          DEALLOCATE( netcdf_data )
1518
1519!
1520!--       In case of non-flat topography write height information
1521          IF ( TRIM( topography ) /= 'flat'  .AND.                             &
1522               netcdf_data_format > 4 )  THEN
1523
1524             ALLOCATE( netcdf_data_2d(mask_size_l(mid,1),mask_size_l(mid,2)) )
1525             netcdf_data_2d = zu_s_inner( mask_i(mid,:mask_size_l(mid,1)),     &
1526                                          mask_j(mid,:mask_size_l(mid,2)) )
1527
1528             nc_stat = NF90_PUT_VAR( id_set_mask(mid,av),                      &
1529                                     id_var_zusi_mask(mid,av),                 &
1530                                     netcdf_data_2d,                           &
1531                                     start = (/ 1, 1 /),                       &
1532                                     count = (/ mask_size_l(mid,1),            &
1533                                                mask_size_l(mid,2) /) )
1534             CALL netcdf_handle_error( 'netcdf_define_header', 505 )
1535
1536             netcdf_data_2d = zw_w_inner( mask_i(mid,:mask_size_l(mid,1)),     &
1537                                          mask_j(mid,:mask_size_l(mid,2)) )
1538
1539             nc_stat = NF90_PUT_VAR( id_set_mask(mid,av),                      &
1540                                     id_var_zwwi_mask(mid,av),                 &
1541                                     netcdf_data_2d,                           &
1542                                     start = (/ 1, 1 /),                       &
1543                                     count = (/ mask_size_l(mid,1),            &
1544                                                mask_size_l(mid,2) /) )
1545             CALL netcdf_handle_error( 'netcdf_define_header', 506 )
1546
1547             DEALLOCATE( netcdf_data_2d )
1548
1549          ENDIF
1550
1551          IF ( land_surface )  THEN
1552!
1553!--          Write zs data (vertical axes for soil model), use negative values
1554!--          to indicate soil depth
1555             ALLOCATE( netcdf_data(mask_size(mid,3)) )
1556
1557             netcdf_data = zs( mask_k_global(mid,:mask_size(mid,3)) )
1558
1559             nc_stat = NF90_PUT_VAR( id_set_mask(mid,av), id_var_zs_mask(mid,av), &
1560                                     netcdf_data, start = (/ 1 /), &
1561                                     count = (/ mask_size(mid,3) /) )
1562             CALL netcdf_handle_error( 'netcdf_define_header', 538 )
1563
1564             DEALLOCATE( netcdf_data )
1565
1566          ENDIF
1567
1568!
1569!--       restore original parameter file_id (=formal parameter av) into av
1570          av = file_id
1571
1572
1573       CASE ( 'ma_ext' )
1574
1575!
1576!--       decompose actual parameter file_id (=formal parameter av) into
1577!--       mid and av
1578          file_id = av
1579          IF ( file_id <= 200+max_masks )  THEN
1580             mid = file_id - 200
1581             av = 0
1582          ELSE
1583             mid = file_id - (200+max_masks)
1584             av = 1
1585          ENDIF
1586
1587!
1588!--       Get the list of variables and compare with the actual run.
1589!--       First var_list_old has to be reset, since GET_ATT does not assign
1590!--       trailing blanks.
1591          var_list_old = ' '
1592          nc_stat = NF90_GET_ATT( id_set_mask(mid,av), NF90_GLOBAL, 'VAR_LIST',&
1593                                  var_list_old )
1594          CALL netcdf_handle_error( 'netcdf_define_header', 507 )
1595
1596          var_list = ';'
1597          i = 1
1598          DO WHILE ( domask(mid,av,i)(1:1) /= ' ' )
1599             var_list = TRIM(var_list) // TRIM( domask(mid,av,i) ) // ';'
1600             i = i + 1
1601          ENDDO
1602
1603          IF ( av == 0 )  THEN
1604             var = '(mask)'
1605          ELSE
1606             var = '(mask_av)'
1607          ENDIF
1608
1609          IF ( TRIM( var_list ) /= TRIM( var_list_old ) )  THEN
1610             WRITE ( message_string, * ) 'netCDF file for ', TRIM( var ),       &
1611                  ' data for mask', mid, ' from previous run found,',           &
1612                  '&but this file cannot be extended due to variable ',         &
1613                  'mismatch.&New file is created instead.'
1614             CALL message( 'define_netcdf_header', 'PA0335', 0, 1, 0, 6, 0 )
1615             extend = .FALSE.
1616             RETURN
1617          ENDIF
1618
1619!
1620!--       Get and compare the number of vertical gridpoints
1621          nc_stat = NF90_INQ_VARID( id_set_mask(mid,av), 'zu_3d', &
1622                                    id_var_zu_mask(mid,av) )
1623          CALL netcdf_handle_error( 'netcdf_define_header', 508 )
1624
1625          nc_stat = NF90_INQUIRE_VARIABLE( id_set_mask(mid,av),     &
1626                                           id_var_zu_mask(mid,av),  &
1627                                           dimids = id_dim_zu_mask_old )
1628          CALL netcdf_handle_error( 'netcdf_define_header', 509 )
1629          id_dim_zu_mask(mid,av) = id_dim_zu_mask_old(1)
1630
1631          nc_stat = NF90_INQUIRE_DIMENSION( id_set_mask(mid,av),               &
1632                                            id_dim_zu_mask(mid,av),            &
1633                                            len = nz_old )
1634          CALL netcdf_handle_error( 'netcdf_define_header', 510 )
1635
1636          IF ( mask_size(mid,3) /= nz_old )  THEN
1637             WRITE ( message_string, * ) 'netCDF file for ', TRIM( var ),      &
1638                  '&data for mask', mid, ' from previous run found,',          &
1639                  ' but this file cannot be extended due to mismatch in ',     &
1640                  ' number of vertical grid points.',                          &
1641                  '&New file is created instead.'
1642             CALL message( 'define_netcdf_header', 'PA0336', 0, 1, 0, 6, 0 )
1643             extend = .FALSE.
1644             RETURN
1645          ENDIF
1646
1647!
1648!--       Get the id of the time coordinate (unlimited coordinate) and its
1649!--       last index on the file. The next time level is plmask..count+1.
1650!--       The current time must be larger than the last output time
1651!--       on the file.
1652          nc_stat = NF90_INQ_VARID( id_set_mask(mid,av), 'time',               &
1653                                    id_var_time_mask(mid,av) )
1654          CALL netcdf_handle_error( 'netcdf_define_header', 511 )
1655
1656          nc_stat = NF90_INQUIRE_VARIABLE( id_set_mask(mid,av),                &
1657                                           id_var_time_mask(mid,av),           &
1658                                           dimids = id_dim_time_old )
1659          CALL netcdf_handle_error( 'netcdf_define_header', 512 )
1660          id_dim_time_mask(mid,av) = id_dim_time_old(1)
1661
1662          nc_stat = NF90_INQUIRE_DIMENSION( id_set_mask(mid,av),               &
1663                                            id_dim_time_mask(mid,av),          &
1664                                            len = domask_time_count(mid,av) )
1665          CALL netcdf_handle_error( 'netcdf_define_header', 513 )
1666
1667          nc_stat = NF90_GET_VAR( id_set_mask(mid,av),                         &
1668                                  id_var_time_mask(mid,av),                    &
1669                                  last_time_coordinate,                        &
1670                                  start = (/ domask_time_count(mid,av) /),     &
1671                                  count = (/ 1 /) )
1672          CALL netcdf_handle_error( 'netcdf_define_header', 514 )
1673
1674          IF ( last_time_coordinate(1) >= simulated_time )  THEN
1675             WRITE ( message_string, * ) 'netCDF file for ', TRIM( var ),      &
1676                  ' data for mask', mid, ' from previous run found,',          &
1677                  '&but this file cannot be extended because the current ',    &
1678                  'output time is less or equal than the last output time ',   &
1679                  'on this file.&New file is created instead.'
1680             CALL message( 'define_netcdf_header', 'PA0337', 0, 1, 0, 6, 0 )
1681             domask_time_count(mid,av) = 0
1682             extend = .FALSE.
1683             RETURN
1684          ENDIF
1685
1686!
1687!--       Dataset seems to be extendable.
1688!--       Now get the variable ids.
1689          i = 1
1690          DO WHILE ( domask(mid,av,i)(1:1) /= ' ' )
1691             nc_stat = NF90_INQ_VARID( id_set_mask(mid,av), &
1692                                       TRIM( domask(mid,av,i) ), &
1693                                       id_var_domask(mid,av,i) )
1694             CALL netcdf_handle_error( 'netcdf_define_header', 515 )
1695             i = i + 1
1696          ENDDO
1697
1698!
1699!--       Update the title attribute on file
1700!--       In order to avoid 'data mode' errors if updated attributes are larger
1701!--       than their original size, NF90_PUT_ATT is called in 'define mode'
1702!--       enclosed by NF90_REDEF and NF90_ENDDEF calls. This implies a possible
1703!--       performance loss due to data copying; an alternative strategy would be
1704!--       to ensure equal attribute size in a job chain. Maybe revise later.
1705          IF ( av == 0 )  THEN
1706             time_average_text = ' '
1707          ELSE
1708             WRITE (time_average_text, '('', '',F7.1,'' s average'')')         &
1709                                                            averaging_interval
1710          ENDIF
1711          nc_stat = NF90_REDEF( id_set_mask(mid,av) )
1712          CALL netcdf_handle_error( 'netcdf_define_header', 516 )
1713          nc_stat = NF90_PUT_ATT( id_set_mask(mid,av), NF90_GLOBAL, 'title',   &
1714                                  TRIM( run_description_header ) //            &
1715                                  TRIM( time_average_text ) )
1716          CALL netcdf_handle_error( 'netcdf_define_header', 517 )
1717          nc_stat = NF90_ENDDEF( id_set_mask(mid,av) )
1718          CALL netcdf_handle_error( 'netcdf_define_header', 518 )
1719          WRITE ( message_string, * ) 'netCDF file for ', TRIM( var ),         &
1720               ' data for mask', mid, ' from previous run found.',             &
1721               ' &This file will be extended.'
1722          CALL message( 'define_netcdf_header', 'PA0338', 0, 0, 0, 6, 0 )
1723!
1724!--       restore original parameter file_id (=formal parameter av) into av
1725          av = file_id
1726
1727
1728       CASE ( '3d_new' )
1729
1730!
1731!--       Define some global attributes of the dataset
1732          IF ( av == 0 )  THEN
1733             CALL netcdf_create_global_atts( id_set_3d(av), '3d', TRIM( run_description_header ), 62 )
1734             time_average_text = ' '
1735          ELSE
1736             CALL netcdf_create_global_atts( id_set_3d(av), '3d_av', TRIM( run_description_header ), 62 )
1737             WRITE ( time_average_text,'(F7.1,'' s avg'')' )  averaging_interval
1738             nc_stat = NF90_PUT_ATT( id_set_3d(av), NF90_GLOBAL, 'time_avg',   &
1739                                     TRIM( time_average_text ) )
1740             CALL netcdf_handle_error( 'netcdf_define_header', 63 )
1741          ENDIF
1742
1743!
1744!--       Define time coordinate for volume data.
1745!--       For parallel output the time dimensions has to be limited, otherwise
1746!--       the performance drops significantly.
1747          IF ( netcdf_data_format < 5 )  THEN
1748             CALL netcdf_create_dim( id_set_3d(av), 'time', NF90_UNLIMITED,    &
1749                                     id_dim_time_3d(av), 64 )
1750          ELSE
1751             CALL netcdf_create_dim( id_set_3d(av), 'time', ntdim_3d(av),      &
1752                                     id_dim_time_3d(av), 523 )
1753          ENDIF
1754
1755          CALL netcdf_create_var( id_set_3d(av), (/ id_dim_time_3d(av) /),     &
1756                                  'time', NF90_DOUBLE, id_var_time_3d(av),     &
1757                                  'seconds', 'time', 65, 66, 00 )
1758          CALL netcdf_create_att( id_set_3d(av), id_var_time_3d(av), 'standard_name', 'time', 000)
1759          CALL netcdf_create_att( id_set_3d(av), id_var_time_3d(av), 'axis', 'T', 000)
1760!
1761!--       Define spatial dimensions and coordinates:
1762!--       Define vertical coordinate grid (zu grid)
1763          CALL netcdf_create_dim( id_set_3d(av), 'zu_3d', nz_do3d-nzb+1,       &
1764                                  id_dim_zu_3d(av), 67 )
1765          CALL netcdf_create_var( id_set_3d(av), (/ id_dim_zu_3d(av) /),       &
1766                                  'zu_3d', NF90_DOUBLE, id_var_zu_3d(av),      &
1767                                  'meters', '', 68, 69, 00 )
1768!
1769!--       Define vertical coordinate grid (zw grid)
1770          CALL netcdf_create_dim( id_set_3d(av), 'zw_3d', nz_do3d-nzb+1,       &
1771                                  id_dim_zw_3d(av), 70 )
1772          CALL netcdf_create_var( id_set_3d(av), (/ id_dim_zw_3d(av) /),       &
1773                                  'zw_3d', NF90_DOUBLE, id_var_zw_3d(av),      &
1774                                  'meters', '', 71, 72, 00 )
1775!
1776!--       Define x-axis (for scalar position)
1777          CALL netcdf_create_dim( id_set_3d(av), 'x', nx+1, id_dim_x_3d(av),   &
1778                                  73 )
1779          CALL netcdf_create_var( id_set_3d(av), (/ id_dim_x_3d(av) /), 'x',   &
1780                                  NF90_DOUBLE, id_var_x_3d(av), 'meters', '',  &
1781                                  74, 75, 00 )
1782!
1783!--       Define x-axis (for u position)
1784          CALL netcdf_create_dim( id_set_3d(av), 'xu', nx+1, id_dim_xu_3d(av), &
1785                                  358 )
1786          CALL netcdf_create_var( id_set_3d(av), (/ id_dim_xu_3d(av) /), 'xu', &
1787                                  NF90_DOUBLE, id_var_xu_3d(av), 'meters', '', &
1788                                  359, 360, 000 )
1789!
1790!--       Define y-axis (for scalar position)
1791          CALL netcdf_create_dim( id_set_3d(av), 'y', ny+1, id_dim_y_3d(av),   &
1792                                  76 )
1793          CALL netcdf_create_var( id_set_3d(av), (/ id_dim_y_3d(av) /), 'y',   &
1794                                  NF90_DOUBLE, id_var_y_3d(av), 'meters', '',  &
1795                                  77, 78, 00 )
1796!
1797!--       Define y-axis (for v position)
1798          CALL netcdf_create_dim( id_set_3d(av), 'yv', ny+1, id_dim_yv_3d(av), &
1799                                  361 )
1800          CALL netcdf_create_var( id_set_3d(av), (/ id_dim_yv_3d(av) /), 'yv', &
1801                                  NF90_DOUBLE, id_var_yv_3d(av), 'meters', '', &
1802                                  362, 363, 000 )
1803!
1804!--       Define UTM and geographic coordinates
1805          CALL define_geo_coordinates( id_set_3d(av),         &
1806                  (/ id_dim_x_3d(av), id_dim_xu_3d(av) /),    &
1807                  (/ id_dim_y_3d(av), id_dim_yv_3d(av) /),    &
1808                  id_var_eutm_3d(:,av), id_var_nutm_3d(:,av), &
1809                  id_var_lat_3d(:,av), id_var_lon_3d(:,av)    )
1810!
1811!--       Define coordinate-reference system
1812          CALL netcdf_create_crs( id_set_3d(av), 000 )
1813!
1814!--       In case of non-flat topography define 2d-arrays containing the height
1815!--       information. Only output 2d topography information in case of parallel
1816!--       output.
1817          IF ( TRIM( topography ) /= 'flat'  .AND.                             &
1818               netcdf_data_format > 4 )  THEN
1819!
1820!--          Define zusi = zu(nzb_s_inner)
1821             CALL netcdf_create_var( id_set_3d(av), (/ id_dim_x_3d(av),        &
1822                                     id_dim_y_3d(av) /), 'zusi', NF90_DOUBLE,  &
1823                                     id_var_zusi_3d(av), 'meters',             &
1824                                     'zu(nzb_s_inner)', 413, 414, 415 )
1825!             
1826!--          Define zwwi = zw(nzb_w_inner)
1827             CALL netcdf_create_var( id_set_3d(av), (/ id_dim_x_3d(av),        &
1828                                     id_dim_y_3d(av) /), 'zwwi', NF90_DOUBLE,  &
1829                                     id_var_zwwi_3d(av), 'meters',             &
1830                                     'zw(nzb_w_inner)', 416, 417, 418 )
1831
1832          ENDIF             
1833
1834          IF ( land_surface )  THEN
1835!
1836!--          Define vertical coordinate grid (zs grid)
1837             CALL netcdf_create_dim( id_set_3d(av), 'zs_3d',                   &
1838                                     nzt_soil-nzb_soil+1, id_dim_zs_3d(av), 70 )
1839             CALL netcdf_create_var( id_set_3d(av), (/ id_dim_zs_3d(av) /),    &
1840                                     'zs_3d', NF90_DOUBLE, id_var_zs_3d(av),   &
1841                                     'meters', '', 71, 72, 00 )
1842
1843          ENDIF
1844
1845!
1846!--       Define the variables
1847          var_list = ';'
1848          i = 1
1849
1850          DO WHILE ( do3d(av,i)(1:1) /= ' ' )
1851!
1852!--          Temporary solution to account for data output within the new urban
1853!--          surface model (urban_surface_mod.f90), see also SELECT CASE ( trimvar )
1854             trimvar = TRIM( do3d(av,i) )
1855             IF ( urban_surface  .AND.  trimvar(1:4) == 'usm_' )  THEN
1856                trimvar = 'usm_output'
1857             ENDIF
1858!
1859!--          Check for the grid
1860             found = .FALSE.
1861             SELECT CASE ( trimvar )
1862!
1863!--             Most variables are defined on the scalar grid
1864                CASE ( 'e', 'nc', 'nr', 'p', 'pc', 'pr', 'prr',   &
1865                       'q', 'qc', 'ql', 'ql_c', 'ql_v', 'ql_vp', 'qr', 'qv',   &
1866                       's', 'theta', 'thetal', 'thetav' )
1867
1868                   grid_x = 'x'
1869                   grid_y = 'y'
1870                   grid_z = 'zu'
1871!
1872!--             u grid
1873                CASE ( 'u' )
1874
1875                   grid_x = 'xu'
1876                   grid_y = 'y'
1877                   grid_z = 'zu'
1878!
1879!--             v grid
1880                CASE ( 'v' )
1881
1882                   grid_x = 'x'
1883                   grid_y = 'yv'
1884                   grid_z = 'zu'
1885!
1886!--             w grid
1887                CASE ( 'w' )
1888
1889                   grid_x = 'x'
1890                   grid_y = 'y'
1891                   grid_z = 'zw'
1892
1893!             
1894!--             Block of urban surface model outputs   
1895                CASE ( 'usm_output' )
1896                   CALL usm_define_netcdf_grid( do3d(av,i), found, &
1897                                                   grid_x, grid_y, grid_z )
1898
1899                CASE DEFAULT
1900
1901                   CALL tcm_define_netcdf_grid( do3d(av,i), found, &
1902                                                   grid_x, grid_y, grid_z )
1903
1904!
1905!--                Check for land surface quantities
1906                   IF ( .NOT. found .AND. land_surface )  THEN
1907                      CALL lsm_define_netcdf_grid( do3d(av,i), found, grid_x,  &
1908                                                   grid_y, grid_z )
1909                   ENDIF
1910!
1911!--                Check for ocean quantities
1912                   IF ( .NOT. found  .AND.  ocean_mode )  THEN
1913                      CALL ocean_define_netcdf_grid( do3d(av,i), found,  &
1914                                                     grid_x, grid_y, grid_z )
1915                   ENDIF
1916
1917!
1918!--                Check for plant canopy quantities
1919                   IF ( .NOT. found  .AND.  plant_canopy )  THEN
1920                      CALL pcm_define_netcdf_grid( do3d(av,i), found, grid_x,  &
1921                                                   grid_y, grid_z )
1922                   ENDIF
1923
1924!
1925!--                Check for radiation quantities
1926                   IF ( .NOT. found  .AND.  radiation )  THEN
1927                      CALL radiation_define_netcdf_grid( do3d(av,i), found,    &
1928                                                         grid_x, grid_y,       &
1929                                                         grid_z )
1930                   ENDIF
1931
1932!--                Check for gust module quantities
1933                   IF ( .NOT. found  .AND.  gust_module_enabled )  THEN
1934                      CALL gust_define_netcdf_grid( do3d(av,i), found, grid_x, &
1935                                                    grid_y, grid_z )
1936                   ENDIF
1937!
1938!--                Check for indoor model quantities                   
1939                   IF ( .NOT. found .AND. indoor_model ) THEN
1940                      CALL im_define_netcdf_grid( do3d(av,i), found,           &
1941                                                  grid_x, grid_y, grid_z )
1942                   ENDIF
1943
1944!
1945!--                Check for biometeorology quantities
1946                   IF ( .NOT. found  .AND.  biometeorology )  THEN
1947                      CALL bio_define_netcdf_grid( do3d(av,i), found,          &
1948                                                   grid_x, grid_y, grid_z )
1949                   ENDIF
1950
1951!
1952!--                Check for chemistry quantities                   
1953                   IF ( .NOT. found  .AND.  air_chemistry )  THEN
1954                      CALL chem_define_netcdf_grid( do3d(av,i), found,         &
1955                                                    grid_x, grid_y, grid_z )
1956                   ENDIF
1957
1958!
1959!--                Check for SALSA quantities
1960                   IF ( .NOT. found  .AND.  salsa )  THEN
1961                      CALL salsa_define_netcdf_grid( do3d(av,i), found, grid_x,&
1962                                                     grid_y, grid_z )
1963                   ENDIF                 
1964!                   
1965!--                Check for user-defined quantities
1966                   IF ( .NOT. found  .AND.  user_module_enabled )  THEN
1967                      CALL user_define_netcdf_grid( do3d(av,i), found, grid_x, &
1968                                                    grid_y, grid_z )
1969                   ENDIF
1970                                                 
1971                   IF ( .NOT. found )  THEN
1972                      WRITE ( message_string, * ) 'no grid defined for varia', &
1973                                                  'ble ', TRIM( do3d(av,i) )
1974                      CALL message( 'define_netcdf_header', 'PA0244', 0, 1, 0, &
1975                                    6, 0 )
1976                   ENDIF
1977
1978             END SELECT
1979
1980!
1981!--          Select the respective dimension ids
1982             IF ( grid_x == 'x' )  THEN
1983                id_x = id_dim_x_3d(av)
1984             ELSEIF ( grid_x == 'xu' )  THEN
1985                id_x = id_dim_xu_3d(av)
1986             ENDIF
1987
1988             IF ( grid_y == 'y' )  THEN
1989                id_y = id_dim_y_3d(av)
1990             ELSEIF ( grid_y == 'yv' )  THEN
1991                id_y = id_dim_yv_3d(av)
1992             ENDIF
1993
1994             IF ( grid_z == 'zu' )  THEN
1995                id_z = id_dim_zu_3d(av)
1996             ELSEIF ( grid_z == 'zw' )  THEN
1997                id_z = id_dim_zw_3d(av)
1998             ELSEIF ( grid_z == 'zs' )  THEN
1999                id_z = id_dim_zs_3d(av)
2000             ENDIF
2001
2002!
2003!--          Define the grid
2004             CALL netcdf_create_var( id_set_3d(av),(/ id_x, id_y, id_z,        &
2005                                     id_dim_time_3d(av) /), do3d(av,i),        &
2006                                     nc_precision(4), id_var_do3d(av,i),       &
2007                                     TRIM( do3d_unit(av,i) ), do3d(av,i), 79,  &
2008                                     80, 357, .TRUE. )
2009#if defined( __netcdf4_parallel )
2010             IF ( netcdf_data_format > 4 )  THEN
2011!
2012!--             Set no fill for every variable to increase performance.
2013                nc_stat = NF90_DEF_VAR_FILL( id_set_3d(av),     &
2014                                             id_var_do3d(av,i), &
2015                                             1, 0 )
2016                CALL netcdf_handle_error( 'netcdf_define_header', 532 )
2017!
2018!--             Set collective io operations for parallel io
2019                nc_stat = NF90_VAR_PAR_ACCESS( id_set_3d(av),     &
2020                                               id_var_do3d(av,i), &
2021                                               NF90_COLLECTIVE )
2022                CALL netcdf_handle_error( 'netcdf_define_header', 445 )
2023             ENDIF
2024#endif
2025             var_list = TRIM( var_list ) // TRIM( do3d(av,i) ) // ';'
2026
2027             i = i + 1
2028
2029          ENDDO
2030
2031!
2032!--       No arrays to output
2033          IF ( i == 1 )  RETURN
2034
2035!
2036!--       Write the list of variables as global attribute (this is used by
2037!--       restart runs and by combine_plot_fields)
2038          nc_stat = NF90_PUT_ATT( id_set_3d(av), NF90_GLOBAL, 'VAR_LIST', &
2039                                  var_list )
2040          CALL netcdf_handle_error( 'netcdf_define_header', 81 )
2041
2042!
2043!--       Set general no fill, otherwise the performance drops significantly for
2044!--       parallel output.
2045          nc_stat = NF90_SET_FILL( id_set_3d(av), NF90_NOFILL, oldmode )
2046          CALL netcdf_handle_error( 'netcdf_define_header', 528 )
2047
2048!
2049!--       Leave netCDF define mode
2050          nc_stat = NF90_ENDDEF( id_set_3d(av) )
2051          CALL netcdf_handle_error( 'netcdf_define_header', 82 )
2052
2053!
2054!--       These data are only written by PE0 for parallel output to increase
2055!--       the performance.
2056          IF ( myid == 0  .OR.  netcdf_data_format < 5 )  THEN
2057!
2058!--          Write data for x (shifted by +dx/2) and xu axis
2059             ALLOCATE( netcdf_data(0:nx) )
2060
2061             DO  i = 0, nx
2062                netcdf_data(i) = ( i + 0.5 ) * dx
2063             ENDDO
2064
2065             nc_stat = NF90_PUT_VAR( id_set_3d(av), id_var_x_3d(av),  &
2066                                     netcdf_data, start = (/ 1 /),    &
2067                                     count = (/ nx+1 /) )
2068             CALL netcdf_handle_error( 'netcdf_define_header', 83 )
2069
2070             DO  i = 0, nx
2071                netcdf_data(i) = i * dx
2072             ENDDO
2073
2074             nc_stat = NF90_PUT_VAR( id_set_3d(av), id_var_xu_3d(av), &
2075                                     netcdf_data, start = (/ 1 /),    &
2076                                     count = (/ nx+1 /) )
2077             CALL netcdf_handle_error( 'netcdf_define_header', 385 )
2078
2079             DEALLOCATE( netcdf_data )
2080
2081!
2082!--          Write data for y (shifted by +dy/2) and yv axis
2083             ALLOCATE( netcdf_data(0:ny) )
2084
2085             DO  i = 0, ny
2086                netcdf_data(i) = ( i + 0.5_wp ) * dy
2087             ENDDO
2088
2089             nc_stat = NF90_PUT_VAR( id_set_3d(av), id_var_y_3d(av),  &
2090                                     netcdf_data, start = (/ 1 /),    &
2091                                     count = (/ ny+1 /) )
2092             CALL netcdf_handle_error( 'netcdf_define_header', 84 )
2093
2094             DO  i = 0, ny
2095                netcdf_data(i) = i * dy
2096             ENDDO
2097
2098             nc_stat = NF90_PUT_VAR( id_set_3d(av), id_var_yv_3d(av), &
2099                                     netcdf_data, start = (/ 1 /),    &
2100                                     count = (/ ny+1 /))
2101             CALL netcdf_handle_error( 'netcdf_define_header', 387 )
2102
2103             DEALLOCATE( netcdf_data )
2104
2105!
2106!--          Write UTM coordinates
2107             IF ( init_model%rotation_angle == 0.0_wp )  THEN
2108!
2109!--             1D in case of no rotation
2110                cos_ra = COS( init_model%rotation_angle * pi / 180.0_wp )
2111!
2112!--             x coordinates
2113                ALLOCATE( netcdf_data(0:nx) )
2114                DO  k = 0, 2
2115!               
2116!--                Scalar grid points
2117                   IF ( k == 0 )  THEN
2118                      shift_x = 0.5
2119!               
2120!--                u grid points
2121                   ELSEIF ( k == 1 )  THEN
2122                      shift_x = 0.0
2123!               
2124!--                v grid points
2125                   ELSEIF ( k == 2 )  THEN
2126                      shift_x = 0.5
2127                   ENDIF
2128               
2129                   DO  i = 0, nx
2130                     netcdf_data(i) = init_model%origin_x            &
2131                                    + cos_ra * ( i + shift_x ) * dx
2132                   ENDDO
2133               
2134                   nc_stat = NF90_PUT_VAR( id_set_3d(av), id_var_eutm_3d(k,av),&
2135                                           netcdf_data, start = (/ 1 /),   &
2136                                           count = (/ nx+1 /) )
2137                   CALL netcdf_handle_error( 'netcdf_define_header', 555 )
2138
2139                ENDDO
2140                DEALLOCATE( netcdf_data )
2141!
2142!--             y coordinates
2143                ALLOCATE( netcdf_data(0:ny) )
2144                DO  k = 0, 2
2145!
2146!--                Scalar grid points
2147                   IF ( k == 0 )  THEN
2148                      shift_y = 0.5
2149!
2150!--                u grid points
2151                   ELSEIF ( k == 1 )  THEN
2152                      shift_y = 0.5
2153!
2154!--                v grid points
2155                   ELSEIF ( k == 2 )  THEN
2156                      shift_y = 0.0
2157                   ENDIF
2158
2159                   DO  j = 0, ny
2160                      netcdf_data(j) = init_model%origin_y            &
2161                                     + cos_ra * ( j + shift_y ) * dy
2162                   ENDDO
2163
2164                   nc_stat = NF90_PUT_VAR( id_set_3d(av), id_var_nutm_3d(k,av),&
2165                                           netcdf_data, start = (/ 1 /),   &
2166                                           count = (/ ny+1 /) )
2167                   CALL netcdf_handle_error( 'netcdf_define_header', 556 )
2168
2169                ENDDO
2170                DEALLOCATE( netcdf_data )
2171
2172             ELSE
2173!
2174!--             2D in case of rotation
2175                ALLOCATE( netcdf_data_2d(0:nx,0:ny) )
2176                cos_ra = COS( init_model%rotation_angle * pi / 180.0_wp )
2177                sin_ra = SIN( init_model%rotation_angle * pi / 180.0_wp )
2178               
2179                DO  k = 0, 2
2180!               
2181!--               Scalar grid points
2182                  IF ( k == 0 )  THEN
2183                     shift_x = 0.5 ; shift_y = 0.5
2184!               
2185!--               u grid points
2186                  ELSEIF ( k == 1 )  THEN
2187                     shift_x = 0.0 ; shift_y = 0.5
2188!               
2189!--               v grid points
2190                  ELSEIF ( k == 2 )  THEN
2191                     shift_x = 0.5 ; shift_y = 0.0
2192                  ENDIF
2193               
2194                  DO  j = 0, ny
2195                     DO  i = 0, nx
2196                        netcdf_data_2d(i,j) = init_model%origin_x            &
2197                                            + cos_ra * ( i + shift_x ) * dx  &
2198                                            + sin_ra * ( j + shift_y ) * dy
2199                     ENDDO
2200                  ENDDO
2201               
2202                  nc_stat = NF90_PUT_VAR( id_set_3d(av), id_var_eutm_3d(k,av),  &
2203                                          netcdf_data_2d, start = (/ 1, 1 /),   &
2204                                          count = (/ nx+1, ny+1 /) )
2205                  CALL netcdf_handle_error( 'netcdf_define_header', 555 )
2206               
2207                  DO  j = 0, ny
2208                     DO  i = 0, nx
2209                        netcdf_data_2d(i,j) = init_model%origin_y            &
2210                                            - sin_ra * ( i + shift_x ) * dx  &
2211                                            + cos_ra * ( j + shift_y ) * dy
2212                     ENDDO
2213                  ENDDO
2214               
2215                  nc_stat = NF90_PUT_VAR( id_set_3d(av), id_var_nutm_3d(k,av),  &
2216                                          netcdf_data_2d, start = (/ 1, 1 /),   &
2217                                          count = (/ nx+1, ny+1 /) )
2218                  CALL netcdf_handle_error( 'netcdf_define_header', 556 )
2219               
2220                ENDDO
2221                DEALLOCATE( netcdf_data_2d )
2222             ENDIF
2223!
2224!--          Write zu and zw data (vertical axes)
2225             nc_stat = NF90_PUT_VAR( id_set_3d(av), id_var_zu_3d(av),  &
2226                                     zu(nzb:nz_do3d), start = (/ 1 /), &
2227                                     count = (/ nz_do3d-nzb+1 /) )
2228             CALL netcdf_handle_error( 'netcdf_define_header', 85 )
2229
2230
2231             nc_stat = NF90_PUT_VAR( id_set_3d(av), id_var_zw_3d(av),  &
2232                                     zw(nzb:nz_do3d), start = (/ 1 /), &
2233                                     count = (/ nz_do3d-nzb+1 /) )
2234             CALL netcdf_handle_error( 'netcdf_define_header', 86 )
2235
2236             IF ( land_surface )  THEN
2237!
2238!--             Write zs grid
2239                nc_stat = NF90_PUT_VAR( id_set_3d(av), id_var_zs_3d(av),  &
2240                                        - zs(nzb_soil:nzt_soil), start = (/ 1 /), &
2241                                        count = (/ nzt_soil-nzb_soil+1 /) )
2242                CALL netcdf_handle_error( 'netcdf_define_header', 86 )
2243             ENDIF
2244
2245          ENDIF
2246!
2247!--       Write lon and lat data. Only for parallel output.
2248          IF ( netcdf_data_format > 4 )  THEN
2249
2250             ALLOCATE( lat(nxl:nxr,nys:nyn) )
2251             ALLOCATE( lon(nxl:nxr,nys:nyn) )
2252             cos_ra = COS( init_model%rotation_angle * pi / 180.0_wp )
2253             sin_ra = SIN( init_model%rotation_angle * pi / 180.0_wp )
2254
2255             DO  k = 0, 2
2256!               
2257!--             Scalar grid points
2258                IF ( k == 0 )  THEN
2259                   shift_x = 0.5 ; shift_y = 0.5
2260!               
2261!--             u grid points
2262                ELSEIF ( k == 1 )  THEN
2263                   shift_x = 0.0 ; shift_y = 0.5
2264!               
2265!--             v grid points
2266                ELSEIF ( k == 2 )  THEN
2267                   shift_x = 0.5 ; shift_y = 0.0
2268                ENDIF
2269
2270                DO  j = nys, nyn
2271                   DO  i = nxl, nxr
2272                      eutm = init_model%origin_x            &
2273                           + cos_ra * ( i + shift_x ) * dx  &
2274                           + sin_ra * ( j + shift_y ) * dy
2275                      nutm = init_model%origin_y            &
2276                           - sin_ra * ( i + shift_x ) * dx  &
2277                           + cos_ra * ( j + shift_y ) * dy
2278
2279                      CALL  convert_utm_to_geographic( crs_list,          &
2280                                                       eutm, nutm,        &
2281                                                       lon(i,j), lat(i,j) )
2282                   ENDDO
2283                ENDDO
2284
2285                nc_stat = NF90_PUT_VAR( id_set_3d(av), id_var_lon_3d(k,av), &
2286                                     lon, start = (/ nxl+1, nys+1 /),       &
2287                                     count = (/ nxr-nxl+1, nyn-nys+1 /) )
2288                CALL netcdf_handle_error( 'netcdf_define_header', 556 )
2289
2290                nc_stat = NF90_PUT_VAR( id_set_3d(av), id_var_lat_3d(k,av), &
2291                                     lat, start = (/ nxl+1, nys+1 /),       &
2292                                     count = (/ nxr-nxl+1, nyn-nys+1 /) )
2293                CALL netcdf_handle_error( 'netcdf_define_header', 556 )
2294             ENDDO
2295
2296             DEALLOCATE( lat )
2297             DEALLOCATE( lon )
2298
2299          ENDIF
2300!
2301!--       In case of non-flat topography write height information. Only for
2302!--       parallel netcdf output.
2303          IF ( TRIM( topography ) /= 'flat'  .AND.                             &
2304               netcdf_data_format > 4 )  THEN
2305
2306!             IF ( nxr == nx  .AND.  nyn /= ny )  THEN
2307!                nc_stat = NF90_PUT_VAR( id_set_3d(av), id_var_zusi_3d(av),     &
2308!                                        zu_s_inner(nxl:nxr+1,nys:nyn),         &
2309!                                        start = (/ nxl+1, nys+1 /),            &
2310!                                        count = (/ nxr-nxl+2, nyn-nys+1 /) )
2311!             ELSEIF ( nxr /= nx  .AND.  nyn == ny )  THEN
2312!                nc_stat = NF90_PUT_VAR( id_set_3d(av), id_var_zusi_3d(av),     &
2313!                                        zu_s_inner(nxl:nxr,nys:nyn+1),         &
2314!                                        start = (/ nxl+1, nys+1 /),            &
2315!                                        count = (/ nxr-nxl+1, nyn-nys+2 /) )
2316!             ELSEIF ( nxr == nx  .AND.  nyn == ny )  THEN
2317!                nc_stat = NF90_PUT_VAR( id_set_3d(av), id_var_zusi_3d(av),     &
2318!                                        zu_s_inner(nxl:nxr+1,nys:nyn+1),       &
2319!                                        start = (/ nxl+1, nys+1 /),            &
2320!                                        count = (/ nxr-nxl+2, nyn-nys+2 /) )
2321!             ELSE
2322                nc_stat = NF90_PUT_VAR( id_set_3d(av), id_var_zusi_3d(av),     &
2323                                        zu_s_inner(nxl:nxr,nys:nyn),           &
2324                                        start = (/ nxl+1, nys+1 /),            &
2325                                        count = (/ nxr-nxl+1, nyn-nys+1 /) )
2326!             ENDIF
2327             CALL netcdf_handle_error( 'netcdf_define_header', 419 )
2328
2329!             IF ( nxr == nx  .AND.  nyn /= ny )  THEN
2330!                nc_stat = NF90_PUT_VAR( id_set_3d(av), id_var_zwwi_3d(av),     &
2331!                                        zw_w_inner(nxl:nxr+1,nys:nyn),         &
2332!                                        start = (/ nxl+1, nys+1 /),            &
2333!                                        count = (/ nxr-nxl+2, nyn-nys+1 /) )
2334!             ELSEIF ( nxr /= nx  .AND.  nyn == ny )  THEN
2335!                nc_stat = NF90_PUT_VAR( id_set_3d(av), id_var_zwwi_3d(av),     &
2336!                                        zw_w_inner(nxl:nxr,nys:nyn+1),         &
2337!                                        start = (/ nxl+1, nys+1 /),            &
2338!                                        count = (/ nxr-nxl+1, nyn-nys+2 /) )
2339!             ELSEIF ( nxr == nx  .AND.  nyn == ny )  THEN
2340!                nc_stat = NF90_PUT_VAR( id_set_3d(av), id_var_zwwi_3d(av),     &
2341!                                        zw_w_inner(nxl:nxr+1,nys:nyn+1),       &
2342!                                        start = (/ nxl+1, nys+1 /),            &
2343!                                        count = (/ nxr-nxl+2, nyn-nys+2 /) )
2344!             ELSE
2345                nc_stat = NF90_PUT_VAR( id_set_3d(av), id_var_zwwi_3d(av),     &
2346                                        zw_w_inner(nxl:nxr,nys:nyn),           &
2347                                        start = (/ nxl+1, nys+1 /),            &
2348                                        count = (/ nxr-nxl+1, nyn-nys+1 /) )
2349!             ENDIF
2350             CALL netcdf_handle_error( 'netcdf_define_header', 420 )
2351
2352          ENDIF
2353
2354       CASE ( '3d_ext' )
2355
2356!
2357!--       Get the list of variables and compare with the actual run.
2358!--       First var_list_old has to be reset, since GET_ATT does not assign
2359!--       trailing blanks.
2360          var_list_old = ' '
2361          nc_stat = NF90_GET_ATT( id_set_3d(av), NF90_GLOBAL, 'VAR_LIST', &
2362                                  var_list_old )
2363          CALL netcdf_handle_error( 'netcdf_define_header', 87 )
2364
2365          var_list = ';'
2366          i = 1
2367          DO WHILE ( do3d(av,i)(1:1) /= ' ' )
2368             var_list = TRIM(var_list) // TRIM( do3d(av,i) ) // ';'
2369             i = i + 1
2370          ENDDO
2371
2372          IF ( av == 0 )  THEN
2373             var = '(3d)'
2374          ELSE
2375             var = '(3d_av)'
2376          ENDIF
2377
2378          IF ( TRIM( var_list ) /= TRIM( var_list_old ) )  THEN
2379             message_string = 'netCDF file for volume data ' //             &
2380                              TRIM( var ) // ' from previous run found,' // &
2381                              '&but this file cannot be extended due to' // &
2382                              ' variable mismatch.' //                      &
2383                              '&New file is created instead.'
2384             CALL message( 'define_netcdf_header', 'PA0245', 0, 1, 0, 6, 0 )
2385             extend = .FALSE.
2386             RETURN
2387          ENDIF
2388
2389!
2390!--       Get and compare the number of vertical gridpoints
2391          nc_stat = NF90_INQ_VARID( id_set_3d(av), 'zu_3d', id_var_zu_3d(av) )
2392          CALL netcdf_handle_error( 'netcdf_define_header', 88 )
2393
2394          nc_stat = NF90_INQUIRE_VARIABLE( id_set_3d(av), id_var_zu_3d(av), &
2395                                           dimids = id_dim_zu_3d_old )
2396          CALL netcdf_handle_error( 'netcdf_define_header', 89 )
2397          id_dim_zu_3d(av) = id_dim_zu_3d_old(1)
2398
2399          nc_stat = NF90_INQUIRE_DIMENSION( id_set_3d(av), id_dim_zu_3d(av), &
2400                                            len = nz_old )
2401          CALL netcdf_handle_error( 'netcdf_define_header', 90 )
2402
2403          IF ( nz_do3d-nzb+1 /= nz_old )  THEN
2404              message_string = 'netCDF file for volume data ' //             &
2405                               TRIM( var ) // ' from previous run found,' // &
2406                               '&but this file cannot be extended due to' // &
2407                               ' mismatch in number of' //                   &
2408                               ' vertical grid points (nz_do3d).' //         &
2409                               '&New file is created instead.'
2410             CALL message( 'define_netcdf_header', 'PA0246', 0, 1, 0, 6, 0 )
2411             extend = .FALSE.
2412             RETURN
2413          ENDIF
2414
2415!
2416!--       Get the id of the time coordinate (unlimited coordinate) and its
2417!--       last index on the file. The next time level is pl3d..count+1.
2418!--       The current time must be larger than the last output time
2419!--       on the file.
2420          nc_stat = NF90_INQ_VARID( id_set_3d(av), 'time', id_var_time_3d(av) )
2421          CALL netcdf_handle_error( 'netcdf_define_header', 91 )
2422
2423          nc_stat = NF90_INQUIRE_VARIABLE( id_set_3d(av), id_var_time_3d(av), &
2424                                           dimids = id_dim_time_old )
2425          CALL netcdf_handle_error( 'netcdf_define_header', 92 )
2426
2427          id_dim_time_3d(av) = id_dim_time_old(1)
2428
2429          nc_stat = NF90_INQUIRE_DIMENSION( id_set_3d(av), id_dim_time_3d(av), &
2430                                            len = ntime_count )
2431          CALL netcdf_handle_error( 'netcdf_define_header', 93 )
2432
2433!
2434!--       For non-parallel output use the last output time level of the netcdf
2435!--       file because the time dimension is unlimited. In case of parallel
2436!--       output the variable ntime_count could get the value of 9*10E36 because
2437!--       the time dimension is limited.
2438          IF ( netcdf_data_format < 5 ) do3d_time_count(av) = ntime_count
2439
2440          nc_stat = NF90_GET_VAR( id_set_3d(av), id_var_time_3d(av), &
2441                                  last_time_coordinate,              &
2442                                  start = (/ do3d_time_count(av) /), &
2443                                  count = (/ 1 /) )
2444          CALL netcdf_handle_error( 'netcdf_define_header', 94 )
2445
2446          IF ( last_time_coordinate(1) >= simulated_time )  THEN
2447             message_string = 'netCDF file for volume data ' //             &
2448                              TRIM( var ) // ' from previous run found,' // &
2449                              '&but this file cannot be extended becaus' // &
2450                              'e the current output time' //                &
2451                              '&is less or equal than the last output t' // &
2452                              'ime on this file.' //                        &
2453                              '&New file is created instead.'
2454             CALL message( 'define_netcdf_header', 'PA0247', 0, 1, 0, 6, 0 )
2455             do3d_time_count(av) = 0
2456             extend = .FALSE.
2457             RETURN
2458          ENDIF
2459
2460          IF ( netcdf_data_format > 4 )  THEN
2461!
2462!--          Check if the needed number of output time levels is increased
2463!--          compared to the number of time levels in the existing file.
2464             IF ( ntdim_3d(av) > ntime_count )  THEN
2465                message_string = 'netCDF file for volume data ' // &
2466                                 TRIM( var ) // ' from previous run found,' // &
2467                                 '&but this file cannot be extended becaus' // &
2468                                 'e the number of output time levels has b' // &
2469                                 'een increased compared to the previous s' // &
2470                                 'imulation.' //                               &
2471                                 '&New file is created instead.'
2472                CALL message( 'define_netcdf_header', 'PA0388', 0, 1, 0, 6, 0 )
2473                do3d_time_count(av) = 0
2474                extend = .FALSE.
2475!
2476!--             Recalculate the needed time levels for the new file.
2477                IF ( av == 0 )  THEN
2478                   ntdim_3d(0) = CEILING(                               &
2479                           ( end_time - MAX( skip_time_do3d,            &
2480                                             simulated_time_at_begin )  &
2481                           ) / dt_do3d )
2482                   IF ( do3d_at_begin )  ntdim_3d(0) = ntdim_3d(0) + 1
2483                ELSE
2484                   ntdim_3d(1) = CEILING(                               &
2485                           ( end_time - MAX( skip_time_data_output_av,  &
2486                                             simulated_time_at_begin )  &
2487                           ) / dt_data_output_av )
2488                ENDIF
2489                RETURN
2490             ENDIF
2491          ENDIF
2492
2493!
2494!--       Dataset seems to be extendable.
2495!--       Now get the variable ids.
2496          i = 1
2497          DO WHILE ( do3d(av,i)(1:1) /= ' ' )
2498             nc_stat = NF90_INQ_VARID( id_set_3d(av), TRIM( do3d(av,i) ), &
2499                                       id_var_do3d(av,i) )
2500             CALL netcdf_handle_error( 'netcdf_define_header', 95 )
2501#if defined( __netcdf4_parallel )
2502!
2503!--          Set collective io operations for parallel io
2504             IF ( netcdf_data_format > 4 )  THEN
2505                nc_stat = NF90_VAR_PAR_ACCESS( id_set_3d(av),     &
2506                                               id_var_do3d(av,i), &
2507                                               NF90_COLLECTIVE )
2508                CALL netcdf_handle_error( 'netcdf_define_header', 453 )
2509             ENDIF
2510#endif
2511             i = i + 1
2512          ENDDO
2513
2514!
2515!--       Update the title attribute on file
2516!--       In order to avoid 'data mode' errors if updated attributes are larger
2517!--       than their original size, NF90_PUT_ATT is called in 'define mode'
2518!--       enclosed by NF90_REDEF and NF90_ENDDEF calls. This implies a possible
2519!--       performance loss due to data copying; an alternative strategy would be
2520!--       to ensure equal attribute size. Maybe revise later.
2521          IF ( av == 0 )  THEN
2522             time_average_text = ' '
2523          ELSE
2524             WRITE (time_average_text, '('', '',F7.1,'' s average'')') &
2525                                                            averaging_interval
2526          ENDIF
2527          nc_stat = NF90_REDEF( id_set_3d(av) )
2528          CALL netcdf_handle_error( 'netcdf_define_header', 429 )
2529          nc_stat = NF90_PUT_ATT( id_set_3d(av), NF90_GLOBAL, 'title', &
2530                                  TRIM( run_description_header ) //    &
2531                                  TRIM( time_average_text ) )
2532          CALL netcdf_handle_error( 'netcdf_define_header', 96 )
2533          nc_stat = NF90_ENDDEF( id_set_3d(av) )
2534          CALL netcdf_handle_error( 'netcdf_define_header', 430 )
2535          message_string = 'netCDF file for volume data ' //             &
2536                           TRIM( var ) // ' from previous run found.' // &
2537                           '&This file will be extended.'
2538          CALL message( 'define_netcdf_header', 'PA0248', 0, 0, 0, 6, 0 )
2539
2540
2541       CASE ( 'ag_new' )
2542
2543!
2544!--       Define some global attributes of the dataset
2545          nc_stat = NF90_PUT_ATT( id_set_agt, NF90_GLOBAL, 'title', &
2546                                  TRIM( run_description_header ) )
2547          CALL netcdf_handle_error( 'netcdf_define_header', 330 )
2548!
2549!--       Switch for unlimited time dimension
2550          IF ( agent_time_unlimited ) THEN
2551             CALL netcdf_create_dim( id_set_agt, 'time', NF90_UNLIMITED,       &
2552                                     id_dim_time_agt, 331 )
2553          ELSE
2554             CALL netcdf_create_dim( id_set_agt, 'time',                       &
2555                                     INT( ( MIN( multi_agent_system_end,       &
2556                                                 end_time ) -                  &
2557                                            multi_agent_system_start ) /       &
2558                                            dt_write_agent_data * 1.1 ),       &
2559                                     id_dim_time_agt, 331 )
2560          ENDIF
2561
2562          CALL netcdf_create_var( id_set_agt, (/ id_dim_time_agt /), 'time',   &
2563                                  NF90_REAL4, id_var_time_agt, 'seconds', 'time',  &
2564                                  332, 333, 000 )
2565          CALL netcdf_create_att( id_set_agt, id_var_time_agt, 'standard_name', 'time', 000)
2566          CALL netcdf_create_att( id_set_agt, id_var_time_agt, 'axis', 'T', 000)
2567
2568          CALL netcdf_create_dim( id_set_agt, 'agent_number',                  &
2569                                  dim_size_agtnum, id_dim_agtnum, 334 )
2570
2571          CALL netcdf_create_var( id_set_agt, (/ id_dim_agtnum /),             &
2572                                  'agent_number', NF90_REAL4,                  &
2573                                  id_var_agtnum, 'agent number', '', 335,      &
2574                                  336, 000 )
2575!
2576!--       Define variable which contains the real number of agents in use
2577          CALL netcdf_create_var( id_set_agt, (/ id_dim_time_agt /),           &
2578                                  'real_num_of_agt', NF90_REAL4,               &
2579                                  id_var_rnoa_agt, 'agent number', '', 337,    &
2580                                  338, 000 )
2581          i = 1
2582          CALL netcdf_create_var( id_set_agt, (/ id_dim_agtnum,                &
2583                                  id_dim_time_agt /), agt_var_names(i),        &
2584                                  NF90_DOUBLE, id_var_agt(i),                  &
2585                                  TRIM( agt_var_units(i) ),                    &
2586                                  TRIM( agt_var_names(i) ), 339, 340, 341 )
2587!
2588!--       Define the variables
2589          DO  i = 2, 6
2590             CALL netcdf_create_var( id_set_agt, (/ id_dim_agtnum,             &
2591                                     id_dim_time_agt /), agt_var_names(i),     &
2592                                     NF90_REAL4, id_var_agt(i),                &
2593                                     TRIM( agt_var_units(i) ),                 &
2594                                     TRIM( agt_var_names(i) ), 339, 340, 341 )
2595
2596          ENDDO
2597!
2598!--       Define vars for biometeorology
2599          CALL netcdf_create_var( id_set_agt, (/ id_dim_agtnum,                &
2600                                  id_dim_time_agt /), agt_var_names(9),        &
2601                                  nc_precision(8), id_var_agt(9),              &
2602                                  TRIM( agt_var_units(9) ),                    &
2603                                  TRIM( agt_var_names(9) ), 339, 340, 341 )
2604
2605!
2606!--       Leave netCDF define mode
2607          nc_stat = NF90_ENDDEF( id_set_agt )
2608          CALL netcdf_handle_error( 'netcdf_define_header', 342 )
2609
2610
2611!        CASE ( 'ag_ext' )
2612! !+?agent extend output for restart runs has to be adapted
2613!
2614! !
2615! !--       Get the id of the time coordinate (unlimited coordinate) and its
2616! !--       last index on the file. The next time level is prt..count+1.
2617! !--       The current time must be larger than the last output time
2618! !--       on the file.
2619!           nc_stat = NF90_INQ_VARID( id_set_agt, 'time', id_var_time_agt )
2620!           CALL netcdf_handle_error( 'netcdf_define_header', 343 )
2621!
2622!           nc_stat = NF90_INQUIRE_VARIABLE( id_set_agt, id_var_time_agt, &
2623!                                            dimids = id_dim_time_old )
2624!           CALL netcdf_handle_error( 'netcdf_define_header', 344 )
2625!           id_dim_time_agt = id_dim_time_old(1)
2626!
2627!           nc_stat = NF90_INQUIRE_DIMENSION( id_set_agt, id_dim_time_agt, &
2628!                                             len = agt_time_count )
2629!           CALL netcdf_handle_error( 'netcdf_define_header', 345 )
2630!
2631!           nc_stat = NF90_GET_VAR( id_set_agt, id_var_time_agt,  &
2632!                                   last_time_coordinate,         &
2633!                                   start = (/ agt_time_count /), &
2634!                                   count = (/ 1 /) )
2635!           CALL netcdf_handle_error( 'netcdf_define_header', 346 )
2636!
2637!           IF ( last_time_coordinate(1) >= simulated_time )  THEN
2638!              message_string = 'netCDF file for agents ' //                  &
2639!                               'from previous run found,' //                 &
2640!                               '&but this file cannot be extended becaus' // &
2641!                               'e the current output time' //                &
2642!                               '&is less or equal than the last output t' // &
2643!                               'ime on this file.' //                        &
2644!                               '&New file is created instead.'
2645!              CALL message( 'define_netcdf_header', 'PA0265', 0, 1, 0, 6, 0 )
2646!              agt_time_count = 0
2647!              extend = .FALSE.
2648!              RETURN
2649!           ENDIF
2650!
2651! !
2652! !--       Dataset seems to be extendable.
2653! !--       Now get the variable ids.
2654!           nc_stat = NF90_INQ_VARID( id_set_agt, 'real_num_of_agt', &
2655!                                     id_var_rnoa_agt )
2656!           CALL netcdf_handle_error( 'netcdf_define_header', 347 )
2657!
2658!           DO  i = 1, 17
2659!
2660!              nc_stat = NF90_INQ_VARID( id_set_agt, agt_var_names(i), &
2661!                                        id_var_prt(i) )
2662!              CALL netcdf_handle_error( 'netcdf_define_header', 348 )
2663!
2664!           ENDDO
2665!
2666!           message_string = 'netCDF file for particles ' // &
2667!                            'from previous run found.' //   &
2668!                            '&This file will be extended.'
2669!           CALL message( 'define_netcdf_header', 'PA0266', 0, 0, 0, 6, 0 )
2670         
2671
2672       CASE ( 'xy_new' )
2673
2674!
2675!--       Define some global attributes of the dataset
2676          IF ( av == 0 )  THEN
2677             CALL netcdf_create_global_atts( id_set_xy(av), 'xy', TRIM( run_description_header ), 97 )
2678             time_average_text = ' '
2679          ELSE
2680             CALL netcdf_create_global_atts( id_set_xy(av), 'xy_av', TRIM( run_description_header ), 97 )
2681             WRITE ( time_average_text,'(F7.1,'' s avg'')' )  averaging_interval
2682             nc_stat = NF90_PUT_ATT( id_set_xy(av), NF90_GLOBAL, 'time_avg',   &
2683                                     TRIM( time_average_text ) )
2684             CALL netcdf_handle_error( 'netcdf_define_header', 98 )
2685          ENDIF
2686
2687!
2688!--       Define time coordinate for xy sections.
2689!--       For parallel output the time dimensions has to be limited, otherwise
2690!--       the performance drops significantly.
2691          IF ( netcdf_data_format < 5 )  THEN
2692             CALL netcdf_create_dim( id_set_xy(av), 'time', NF90_UNLIMITED,    &
2693                                     id_dim_time_xy(av), 99 )
2694          ELSE
2695             CALL netcdf_create_dim( id_set_xy(av), 'time', ntdim_2d_xy(av),   &
2696                                     id_dim_time_xy(av), 524 )
2697          ENDIF
2698
2699          CALL netcdf_create_var( id_set_xy(av), (/ id_dim_time_xy(av) /),     &
2700                                  'time', NF90_DOUBLE, id_var_time_xy(av),     &
2701                                  'seconds', 'time', 100, 101, 000 )
2702          CALL netcdf_create_att( id_set_xy(av), id_var_time_xy(av), 'standard_name', 'time', 000)
2703          CALL netcdf_create_att( id_set_xy(av), id_var_time_xy(av), 'axis', 'T', 000)
2704!
2705!--       Define the spatial dimensions and coordinates for xy-sections.
2706!--       First, determine the number of horizontal sections to be written.
2707          IF ( section(1,1) == -9999 )  THEN
2708             RETURN
2709          ELSE
2710             ns = 1
2711             DO WHILE ( section(ns,1) /= -9999  .AND.  ns <= 100 )
2712                ns = ns + 1
2713             ENDDO
2714             ns = ns - 1
2715          ENDIF
2716
2717!
2718!--       Define vertical coordinate grid (zu grid)
2719          CALL netcdf_create_dim( id_set_xy(av), 'zu_xy', ns,                  &
2720                                  id_dim_zu_xy(av), 102 )
2721          CALL netcdf_create_var( id_set_xy(av), (/ id_dim_zu_xy(av) /),       &
2722                                  'zu_xy', NF90_DOUBLE, id_var_zu_xy(av),      &
2723                                  'meters', '', 103, 104, 000 )
2724!
2725!--       Define vertical coordinate grid (zw grid)
2726          CALL netcdf_create_dim( id_set_xy(av), 'zw_xy', ns,                  &
2727                                  id_dim_zw_xy(av), 105 )
2728          CALL netcdf_create_var( id_set_xy(av), (/ id_dim_zw_xy(av) /),       &
2729                                  'zw_xy', NF90_DOUBLE, id_var_zw_xy(av),      &
2730                                  'meters', '', 106, 107, 000 )
2731
2732          IF ( land_surface )  THEN
2733
2734             ns_do = 1
2735             DO WHILE ( section(ns_do,1) /= -9999  .AND.  ns_do < nzs )
2736                ns_do = ns_do + 1
2737             ENDDO
2738!
2739!--          Define vertical coordinate grid (zs grid)
2740             CALL netcdf_create_dim( id_set_xy(av), 'zs_xy', ns_do,            &
2741                                     id_dim_zs_xy(av), 539 )
2742             CALL netcdf_create_var( id_set_xy(av), (/ id_dim_zs_xy(av) /),    &
2743                                     'zs_xy', NF90_DOUBLE, id_var_zs_xy(av),   &
2744                                     'meters', '', 540, 541, 000 )
2745
2746          ENDIF
2747
2748!
2749!--       Define a pseudo vertical coordinate grid for the surface variables
2750!--       u* and t* to store their height level
2751          CALL netcdf_create_dim( id_set_xy(av), 'zu1_xy', 1,                  &
2752                                  id_dim_zu1_xy(av), 108 )
2753          CALL netcdf_create_var( id_set_xy(av), (/ id_dim_zu1_xy(av) /),      &
2754                                  'zu1_xy', NF90_DOUBLE, id_var_zu1_xy(av),    &
2755                                  'meters', '', 109, 110, 000 )
2756!
2757!--       Define a variable to store the layer indices of the horizontal cross
2758!--       sections, too
2759          CALL netcdf_create_var( id_set_xy(av), (/ id_dim_zu_xy(av) /),       &
2760                                  'ind_z_xy', NF90_DOUBLE,                     &
2761                                  id_var_ind_z_xy(av), 'gridpoints', '', 111,  &
2762                                  112, 000 )
2763!
2764!--       Define x-axis (for scalar position)
2765          CALL netcdf_create_dim( id_set_xy(av), 'x', nx+1, id_dim_x_xy(av),   &
2766                                  113 )
2767          CALL netcdf_create_var( id_set_xy(av), (/ id_dim_x_xy(av) /), 'x',   &
2768                                  NF90_DOUBLE, id_var_x_xy(av), 'meters', '',  &
2769                                  114, 115, 000 )
2770!
2771!--       Define x-axis (for u position)
2772          CALL netcdf_create_dim( id_set_xy(av), 'xu', nx+1,                   &
2773                                  id_dim_xu_xy(av), 388 )
2774          CALL netcdf_create_var( id_set_xy(av), (/ id_dim_xu_xy(av) /), 'xu', &
2775                                  NF90_DOUBLE, id_var_xu_xy(av), 'meters', '', &
2776                                  389, 390, 000 )
2777!
2778!--       Define y-axis (for scalar position)
2779          CALL netcdf_create_dim( id_set_xy(av), 'y', ny+1, id_dim_y_xy(av),   &
2780                                  116 )
2781          CALL netcdf_create_var( id_set_xy(av), (/ id_dim_y_xy(av) /), 'y',   &
2782                                  NF90_DOUBLE, id_var_y_xy(av), 'meters', '',  &
2783                                  117, 118, 000 )
2784!
2785!--       Define y-axis (for scalar position)
2786          CALL netcdf_create_dim( id_set_xy(av), 'yv', ny+1,                   &
2787                                  id_dim_yv_xy(av), 364 )
2788          CALL netcdf_create_var( id_set_xy(av), (/ id_dim_yv_xy(av) /), 'yv', &
2789                                  NF90_DOUBLE, id_var_yv_xy(av), 'meters', '', &
2790                                  365, 366, 000 )
2791!
2792!--       Define UTM and geographic coordinates
2793          CALL define_geo_coordinates( id_set_xy(av),         &
2794                  (/ id_dim_x_xy(av), id_dim_xu_xy(av) /),    &
2795                  (/ id_dim_y_xy(av), id_dim_yv_xy(av) /),    &
2796                  id_var_eutm_xy(:,av), id_var_nutm_xy(:,av), &
2797                  id_var_lat_xy(:,av), id_var_lon_xy(:,av)    )
2798!
2799!--       Define coordinate-reference system
2800          CALL netcdf_create_crs( id_set_xy(av), 000 )
2801!
2802!--       In case of non-flat topography define 2d-arrays containing the height
2803!--       information. Only for parallel netcdf output.
2804          IF ( TRIM( topography ) /= 'flat'  .AND.                             &
2805               netcdf_data_format > 4  )  THEN
2806!
2807!--          Define zusi = zu(nzb_s_inner)
2808             CALL netcdf_create_var( id_set_xy(av), (/ id_dim_x_xy(av),        &
2809                                     id_dim_y_xy(av) /), 'zusi', NF90_DOUBLE,  &
2810                                     id_var_zusi_xy(av), 'meters',             &
2811                                     'zu(nzb_s_inner)', 421, 422, 423 )
2812!             
2813!--          Define zwwi = zw(nzb_w_inner)
2814             CALL netcdf_create_var( id_set_xy(av), (/ id_dim_x_xy(av),        &
2815                                     id_dim_y_xy(av) /), 'zwwi', NF90_DOUBLE,  &
2816                                     id_var_zwwi_xy(av), 'meters',             &
2817                                     'zw(nzb_w_inner)', 424, 425, 426 )
2818
2819          ENDIF
2820
2821!
2822!--       Define the variables
2823          var_list = ';'
2824          i = 1
2825
2826          DO WHILE ( do2d(av,i)(1:1) /= ' ' )
2827
2828             IF ( INDEX( do2d(av,i), 'xy' ) /= 0 )  THEN
2829!
2830!--             If there is a star in the variable name (u* or t*), it is a
2831!--             surface variable. Define it with id_dim_zu1_xy.
2832                IF ( INDEX( do2d(av,i), '*' ) /= 0 )  THEN
2833
2834                   CALL netcdf_create_var( id_set_xy(av), (/ id_dim_x_xy(av),  &
2835                                           id_dim_y_xy(av), id_dim_zu1_xy(av), &
2836                                           id_dim_time_xy(av) /), do2d(av,i),  &
2837                                           nc_precision(1), id_var_do2d(av,i), &
2838                                           TRIM( do2d_unit(av,i) ),            &
2839                                           do2d(av,i), 119, 120, 354, .TRUE. )
2840
2841                ELSE
2842
2843!
2844!--                Check for the grid
2845                   found = .FALSE.
2846                   SELECT CASE ( do2d(av,i) )
2847!
2848!--                   Most variables are defined on the zu grid
2849                      CASE ( 'e_xy', 'nc_xy', 'nr_xy', 'p_xy',                 &
2850                             'pc_xy', 'pr_xy', 'prr_xy', 'q_xy',               &
2851                             'qc_xy', 'ql_xy', 'ql_c_xy', 'ql_v_xy',           &
2852                             'ql_vp_xy', 'qr_xy', 'qv_xy',                     &
2853                             's_xy',                                           &
2854                             'theta_xy', 'thetal_xy', 'thetav_xy' )
2855
2856                         grid_x = 'x'
2857                         grid_y = 'y'
2858                         grid_z = 'zu'
2859!
2860!--                   u grid
2861                      CASE ( 'u_xy' )
2862
2863                         grid_x = 'xu'
2864                         grid_y = 'y'
2865                         grid_z = 'zu'
2866!
2867!--                   v grid
2868                      CASE ( 'v_xy' )
2869
2870                         grid_x = 'x'
2871                         grid_y = 'yv'
2872                         grid_z = 'zu'
2873!
2874!--                   w grid
2875                      CASE ( 'w_xy' )
2876
2877                         grid_x = 'x'
2878                         grid_y = 'y'
2879                         grid_z = 'zw'
2880
2881
2882                      CASE DEFAULT
2883!
2884!--                      Check for land surface quantities
2885                         IF ( land_surface )  THEN
2886                            CALL lsm_define_netcdf_grid( do2d(av,i), found,    &
2887                                                   grid_x, grid_y, grid_z )
2888                         ENDIF
2889
2890                         IF ( .NOT. found )  THEN
2891                            CALL tcm_define_netcdf_grid( do2d(av,i), found,    &
2892                                                         grid_x, grid_y,       &
2893                                                         grid_z )
2894                         ENDIF
2895
2896!
2897!--                      Check for ocean quantities
2898                         IF ( .NOT. found  .AND.  ocean_mode )  THEN
2899                            CALL ocean_define_netcdf_grid( do2d(av,i), found,  &
2900                                                           grid_x, grid_y,     &
2901                                                           grid_z )
2902                         ENDIF
2903!
2904!--                      Check for radiation quantities
2905                         IF ( .NOT. found  .AND.  radiation )  THEN
2906                            CALL radiation_define_netcdf_grid( do2d(av,i),     &
2907                                                         found, grid_x, grid_y,&
2908                                                         grid_z )
2909                         ENDIF
2910
2911!
2912!--                      Check for SALSA quantities
2913                         IF ( .NOT. found  .AND.  salsa )  THEN
2914                            CALL salsa_define_netcdf_grid( do2d(av,i), found,  &
2915                                                           grid_x, grid_y,     &
2916                                                           grid_z )
2917                         ENDIF                       
2918
2919!
2920!--                      Check for gust module quantities
2921                         IF ( .NOT. found  .AND.  gust_module_enabled )  THEN
2922                            CALL gust_define_netcdf_grid( do2d(av,i), found,   &
2923                                                          grid_x, grid_y,      &
2924                                                          grid_z )
2925                         ENDIF
2926!
2927!--                      Check for biometeorology quantities
2928                         IF ( .NOT. found  .AND.  biometeorology )  THEN
2929                            CALL bio_define_netcdf_grid( do2d( av, i), found,  &
2930                                                         grid_x, grid_y,       &
2931                                                         grid_z )
2932                         ENDIF
2933!
2934!--                      Check for chemistry quantities
2935                         IF ( .NOT. found  .AND.  air_chemistry )  THEN
2936                            CALL chem_define_netcdf_grid( do2d(av,i), found,   &
2937                                                          grid_x, grid_y,      &
2938                                                          grid_z )
2939                         ENDIF
2940
2941
2942!
2943!--                      Check for user-defined quantities
2944                         IF ( .NOT. found  .AND.  user_module_enabled )  THEN
2945                            CALL user_define_netcdf_grid( do2d(av,i), found,   &
2946                                                          grid_x, grid_y,      &
2947                                                          grid_z )
2948                         ENDIF
2949
2950                         IF ( .NOT. found )  THEN
2951                            WRITE ( message_string, * ) 'no grid defined for', &
2952                                                ' variable ', TRIM( do2d(av,i) )
2953                            CALL message( 'define_netcdf_header', 'PA0244',    &
2954                                          0, 1, 0, 6, 0 )
2955                         ENDIF
2956
2957                   END SELECT
2958
2959!
2960!--                Select the respective dimension ids
2961                   IF ( grid_x == 'x' )  THEN
2962                      id_x = id_dim_x_xy(av)
2963                   ELSEIF ( grid_x == 'xu' )  THEN
2964                      id_x = id_dim_xu_xy(av)
2965                   ENDIF
2966
2967                   IF ( grid_y == 'y' )  THEN
2968                      id_y = id_dim_y_xy(av)
2969                   ELSEIF ( grid_y == 'yv' )  THEN
2970                      id_y = id_dim_yv_xy(av)
2971                   ENDIF
2972
2973                   IF ( grid_z == 'zu' )  THEN
2974                      id_z = id_dim_zu_xy(av)
2975                   ELSEIF ( grid_z == 'zw' )  THEN
2976                      id_z = id_dim_zw_xy(av)
2977                   ELSEIF ( grid_z == 'zs' )  THEN
2978                      id_z = id_dim_zs_xy(av)
2979                   ELSEIF ( grid_z == 'zu1' )  THEN
2980                      id_z = id_dim_zu1_xy(av)
2981                   ENDIF
2982
2983!
2984!--                Define the grid
2985                   CALL netcdf_create_var( id_set_xy(av), (/ id_x, id_y, id_z, &
2986                                           id_dim_time_xy(av) /), do2d(av,i),  &
2987                                           nc_precision(1), id_var_do2d(av,i), &
2988                                           TRIM( do2d_unit(av,i) ),            &
2989                                           do2d(av,i), 119, 120, 354, .TRUE. )
2990
2991                ENDIF
2992
2993#if defined( __netcdf4_parallel )
2994                IF ( netcdf_data_format > 4 )  THEN
2995!
2996!--                Set no fill for every variable to increase performance.
2997                   nc_stat = NF90_DEF_VAR_FILL( id_set_xy(av),     &
2998                                                id_var_do2d(av,i), &
2999                                                1, 0 )
3000                   CALL netcdf_handle_error( 'netcdf_define_header', 533 )
3001!
3002!--                Set collective io operations for parallel io
3003                   nc_stat = NF90_VAR_PAR_ACCESS( id_set_xy(av),     &
3004                                                  id_var_do2d(av,i), &
3005                                                  NF90_COLLECTIVE )
3006                   CALL netcdf_handle_error( 'netcdf_define_header', 448 )
3007                ENDIF
3008#endif
3009                var_list = TRIM( var_list) // TRIM( do2d(av,i) ) // ';'
3010
3011             ENDIF
3012
3013             i = i + 1
3014
3015          ENDDO
3016
3017!
3018!--       No arrays to output. Close the netcdf file and return.
3019          IF ( i == 1 )  RETURN
3020
3021!
3022!--       Write the list of variables as global attribute (this is used by
3023!--       restart runs and by combine_plot_fields)
3024          nc_stat = NF90_PUT_ATT( id_set_xy(av), NF90_GLOBAL, 'VAR_LIST', &
3025                                  var_list )
3026          CALL netcdf_handle_error( 'netcdf_define_header', 121 )
3027
3028!
3029!--       Set general no fill, otherwise the performance drops significantly for
3030!--       parallel output.
3031          nc_stat = NF90_SET_FILL( id_set_xy(av), NF90_NOFILL, oldmode )
3032          CALL netcdf_handle_error( 'netcdf_define_header', 529 )
3033
3034!
3035!--       Leave netCDF define mode
3036          nc_stat = NF90_ENDDEF( id_set_xy(av) )
3037          CALL netcdf_handle_error( 'netcdf_define_header', 122 )
3038
3039!
3040!--       These data are only written by PE0 for parallel output to increase
3041!--       the performance.
3042          IF ( myid == 0  .OR.  netcdf_data_format < 5 )  THEN
3043
3044!
3045!--          Write axis data: z_xy, x, y
3046             ALLOCATE( netcdf_data(1:ns) )
3047
3048!
3049!--          Write zu data
3050             DO  i = 1, ns
3051                IF( section(i,1) == -1 )  THEN
3052                   netcdf_data(i) = -1.0_wp  ! section averaged along z
3053                ELSE
3054                   netcdf_data(i) = zu( section(i,1) )
3055                ENDIF
3056             ENDDO
3057             nc_stat = NF90_PUT_VAR( id_set_xy(av), id_var_zu_xy(av), &
3058                                     netcdf_data, start = (/ 1 /),    &
3059                                     count = (/ ns /) )
3060             CALL netcdf_handle_error( 'netcdf_define_header', 123 )
3061
3062!
3063!--          Write zw data
3064             DO  i = 1, ns
3065                IF( section(i,1) == -1 )  THEN
3066                   netcdf_data(i) = -1.0_wp  ! section averaged along z
3067                ELSE
3068                   netcdf_data(i) = zw( section(i,1) )
3069                ENDIF
3070             ENDDO
3071             nc_stat = NF90_PUT_VAR( id_set_xy(av), id_var_zw_xy(av), &
3072                                     netcdf_data, start = (/ 1 /),    &
3073                                     count = (/ ns /) )
3074             CALL netcdf_handle_error( 'netcdf_define_header', 124 )
3075
3076!
3077!--          Write zs data
3078             IF ( land_surface )  THEN
3079                ns_do = 0
3080                DO  i = 1, ns
3081                   IF( section(i,1) == -1 )  THEN
3082                      netcdf_data(i) = 1.0_wp  ! section averaged along z
3083                      ns_do = ns_do + 1
3084                   ELSEIF ( section(i,1) < nzs )  THEN
3085                      netcdf_data(i) = - zs( section(i,1) )
3086                      ns_do = ns_do + 1
3087                   ENDIF
3088                ENDDO
3089
3090                nc_stat = NF90_PUT_VAR( id_set_xy(av), id_var_zs_xy(av), &
3091                                        netcdf_data(1:ns_do), start = (/ 1 /),    &
3092                                        count = (/ ns_do /) )
3093                CALL netcdf_handle_error( 'netcdf_define_header', 124 )
3094
3095             ENDIF
3096
3097!
3098!--          Write gridpoint number data
3099             netcdf_data(1:ns) = section(1:ns,1)
3100             nc_stat = NF90_PUT_VAR( id_set_xy(av), id_var_ind_z_xy(av), &
3101                                     netcdf_data, start = (/ 1 /),       &
3102                                     count = (/ ns /) )
3103             CALL netcdf_handle_error( 'netcdf_define_header', 125 )
3104
3105             DEALLOCATE( netcdf_data )
3106
3107!
3108!--          Write the cross section height u*, t*
3109             nc_stat = NF90_PUT_VAR( id_set_xy(av), id_var_zu1_xy(av), &
3110                                     (/ zu(nzb+1) /), start = (/ 1 /), &
3111                                     count = (/ 1 /) )
3112             CALL netcdf_handle_error( 'netcdf_define_header', 126 )
3113
3114!
3115!--          Write data for x (shifted by +dx/2) and xu axis
3116             ALLOCATE( netcdf_data(0:nx) )
3117
3118             DO  i = 0, nx
3119                netcdf_data(i) = ( i + 0.5_wp ) * dx
3120             ENDDO
3121
3122             nc_stat = NF90_PUT_VAR( id_set_xy(av), id_var_x_xy(av), &
3123                                     netcdf_data, start = (/ 1 /),   &
3124                                     count = (/ nx+1 /) )
3125             CALL netcdf_handle_error( 'netcdf_define_header', 127 )
3126
3127             DO  i = 0, nx
3128                netcdf_data(i) = i * dx
3129             ENDDO
3130
3131             nc_stat = NF90_PUT_VAR( id_set_xy(av), id_var_xu_xy(av), &
3132                                     netcdf_data, start = (/ 1 /),    &
3133                                     count = (/ nx+1 /) )
3134             CALL netcdf_handle_error( 'netcdf_define_header', 367 )
3135
3136             DEALLOCATE( netcdf_data )
3137
3138!
3139!--          Write data for y (shifted by +dy/2) and yv axis
3140             ALLOCATE( netcdf_data(0:ny+1) )
3141
3142             DO  i = 0, ny
3143                netcdf_data(i) = ( i + 0.5_wp ) * dy
3144             ENDDO
3145
3146             nc_stat = NF90_PUT_VAR( id_set_xy(av), id_var_y_xy(av), &
3147                                     netcdf_data, start = (/ 1 /),   &
3148                                     count = (/ ny+1 /))
3149             CALL netcdf_handle_error( 'netcdf_define_header', 128 )
3150
3151             DO  i = 0, ny
3152                netcdf_data(i) = i * dy
3153             ENDDO
3154
3155             nc_stat = NF90_PUT_VAR( id_set_xy(av), id_var_yv_xy(av), &
3156                                     netcdf_data, start = (/ 1 /),    &
3157                                     count = (/ ny+1 /))
3158             CALL netcdf_handle_error( 'netcdf_define_header', 368 )
3159
3160             DEALLOCATE( netcdf_data )
3161!
3162!--          Write UTM coordinates
3163             IF ( init_model%rotation_angle == 0.0_wp )  THEN
3164!
3165!--             1D in case of no rotation
3166                cos_ra = COS( init_model%rotation_angle * pi / 180.0_wp )
3167!
3168!--             x coordinates
3169                ALLOCATE( netcdf_data(0:nx) )
3170                DO  k = 0, 2
3171!               
3172!--                Scalar grid points
3173                   IF ( k == 0 )  THEN
3174                      shift_x = 0.5
3175!               
3176!--                u grid points
3177                   ELSEIF ( k == 1 )  THEN
3178                      shift_x = 0.0
3179!               
3180!--                v grid points
3181                   ELSEIF ( k == 2 )  THEN
3182                      shift_x = 0.5
3183                   ENDIF
3184               
3185                   DO  i = 0, nx
3186                     netcdf_data(i) = init_model%origin_x            &
3187                                    + cos_ra * ( i + shift_x ) * dx
3188                   ENDDO
3189               
3190                   nc_stat = NF90_PUT_VAR( id_set_xy(av), id_var_eutm_xy(k,av),&
3191                                           netcdf_data, start = (/ 1 /),   &
3192                                           count = (/ nx+1 /) )
3193                   CALL netcdf_handle_error( 'netcdf_define_header', 555 )
3194
3195                ENDDO
3196                DEALLOCATE( netcdf_data )
3197!
3198!--             y coordinates
3199                ALLOCATE( netcdf_data(0:ny) )
3200                DO  k = 0, 2
3201!
3202!--                Scalar grid points
3203                   IF ( k == 0 )  THEN
3204                      shift_y = 0.5
3205!
3206!--                u grid points
3207                   ELSEIF ( k == 1 )  THEN
3208                      shift_y = 0.5
3209!
3210!--                v grid points
3211                   ELSEIF ( k == 2 )  THEN
3212                      shift_y = 0.0
3213                   ENDIF
3214
3215                   DO  j = 0, ny
3216                      netcdf_data(j) = init_model%origin_y            &
3217                                     + cos_ra * ( j + shift_y ) * dy
3218                   ENDDO
3219
3220                   nc_stat = NF90_PUT_VAR( id_set_xy(av), id_var_nutm_xy(k,av),&
3221                                           netcdf_data, start = (/ 1 /),   &
3222                                           count = (/ ny+1 /) )
3223                   CALL netcdf_handle_error( 'netcdf_define_header', 556 )
3224
3225                ENDDO
3226                DEALLOCATE( netcdf_data )
3227
3228             ELSE
3229!
3230!--             2D in case of rotation
3231                ALLOCATE( netcdf_data_2d(0:nx,0:ny) )
3232                cos_ra = COS( init_model%rotation_angle * pi / 180.0_wp )
3233                sin_ra = SIN( init_model%rotation_angle * pi / 180.0_wp )
3234               
3235                DO  k = 0, 2
3236!               
3237!--               Scalar grid points
3238                  IF ( k == 0 )  THEN
3239                     shift_x = 0.5 ; shift_y = 0.5
3240!               
3241!--               u grid points
3242                  ELSEIF ( k == 1 )  THEN
3243                     shift_x = 0.0 ; shift_y = 0.5
3244!               
3245!--               v grid points
3246                  ELSEIF ( k == 2 )  THEN
3247                     shift_x = 0.5 ; shift_y = 0.0
3248                  ENDIF
3249               
3250                  DO  j = 0, ny
3251                     DO  i = 0, nx
3252                        netcdf_data_2d(i,j) = init_model%origin_x            &
3253                                            + cos_ra * ( i + shift_x ) * dx  &
3254                                            + sin_ra * ( j + shift_y ) * dy
3255                     ENDDO
3256                  ENDDO
3257               
3258                  nc_stat = NF90_PUT_VAR( id_set_xy(av), id_var_eutm_xy(k,av),  &
3259                                          netcdf_data_2d, start = (/ 1, 1 /),   &
3260                                          count = (/ nx+1, ny+1 /) )
3261                  CALL netcdf_handle_error( 'netcdf_define_header', 555 )
3262               
3263                  DO  j = 0, ny
3264                     DO  i = 0, nx
3265                        netcdf_data_2d(i,j) = init_model%origin_y            &
3266                                            - sin_ra * ( i + shift_x ) * dx  &
3267                                            + cos_ra * ( j + shift_y ) * dy
3268                     ENDDO
3269                  ENDDO
3270               
3271                  nc_stat = NF90_PUT_VAR( id_set_xy(av), id_var_nutm_xy(k,av),  &
3272                                          netcdf_data_2d, start = (/ 1, 1 /),   &
3273                                          count = (/ nx+1, ny+1 /) )
3274                  CALL netcdf_handle_error( 'netcdf_define_header', 556 )
3275
3276                ENDDO
3277                DEALLOCATE( netcdf_data_2d )
3278             ENDIF
3279
3280          ENDIF
3281!
3282!--       Write lon and lat data. Only for parallel output.
3283          IF ( netcdf_data_format > 4 )  THEN
3284
3285             ALLOCATE( lat(nxl:nxr,nys:nyn) )
3286             ALLOCATE( lon(nxl:nxr,nys:nyn) )
3287             cos_ra = COS( init_model%rotation_angle * pi / 180.0_wp )
3288             sin_ra = SIN( init_model%rotation_angle * pi / 180.0_wp )
3289
3290             DO  k = 0, 2
3291!               
3292!--             Scalar grid points
3293                IF ( k == 0 )  THEN
3294                   shift_x = 0.5 ; shift_y = 0.5
3295!               
3296!--             u grid points
3297                ELSEIF ( k == 1 )  THEN
3298                   shift_x = 0.0 ; shift_y = 0.5
3299!               
3300!--             v grid points
3301                ELSEIF ( k == 2 )  THEN
3302                   shift_x = 0.5 ; shift_y = 0.0
3303                ENDIF
3304
3305                DO  j = nys, nyn
3306                   DO  i = nxl, nxr
3307                      eutm = init_model%origin_x            &
3308                           + cos_ra * ( i + shift_x ) * dx  &
3309                           + sin_ra * ( j + shift_y ) * dy
3310                      nutm = init_model%origin_y            &
3311                           - sin_ra * ( i + shift_x ) * dx  &
3312                           + cos_ra * ( j + shift_y ) * dy
3313
3314                      CALL  convert_utm_to_geographic( crs_list,          &
3315                                                       eutm, nutm,        &
3316                                                       lon(i,j), lat(i,j) )
3317                   ENDDO
3318                ENDDO
3319
3320                nc_stat = NF90_PUT_VAR( id_set_xy(av), id_var_lon_xy(k,av), &
3321                                     lon, start = (/ nxl+1, nys+1 /),       &
3322                                     count = (/ nxr-nxl+1, nyn-nys+1 /) )
3323                CALL netcdf_handle_error( 'netcdf_define_header', 556 )
3324
3325                nc_stat = NF90_PUT_VAR( id_set_xy(av), id_var_lat_xy(k,av), &
3326                                     lat, start = (/ nxl+1, nys+1 /),       &
3327                                     count = (/ nxr-nxl+1, nyn-nys+1 /) )
3328                CALL netcdf_handle_error( 'netcdf_define_header', 556 )
3329             ENDDO
3330
3331             DEALLOCATE( lat )
3332             DEALLOCATE( lon )
3333
3334          ENDIF
3335!
3336!--       In case of non-flat topography write height information. Only for
3337!--       parallel netcdf output.
3338          IF ( TRIM( topography ) /= 'flat'  .AND.                             &
3339               netcdf_data_format > 4  )  THEN
3340
3341!             IF ( nxr == nx  .AND.  nyn /= ny )  THEN
3342!                nc_stat = NF90_PUT_VAR( id_set_xy(av), id_var_zusi_xy(av),     &
3343!                                        zu_s_inner(nxl:nxr+1,nys:nyn),         &
3344!                                        start = (/ nxl+1, nys+1 /),            &
3345!                                        count = (/ nxr-nxl+2, nyn-nys+1 /) )
3346!             ELSEIF ( nxr /= nx  .AND.  nyn == ny )  THEN
3347!                nc_stat = NF90_PUT_VAR( id_set_xy(av), id_var_zusi_xy(av),     &
3348!                                        zu_s_inner(nxl:nxr,nys:nyn+1),         &
3349!                                        start = (/ nxl+1, nys+1 /),            &
3350!                                        count = (/ nxr-nxl+1, nyn-nys+2 /) )
3351!             ELSEIF ( nxr == nx  .AND.  nyn == ny )  THEN
3352!                nc_stat = NF90_PUT_VAR( id_set_xy(av), id_var_zusi_xy(av),     &
3353!                                        zu_s_inner(nxl:nxr+1,nys:nyn+1),       &
3354!                                        start = (/ nxl+1, nys+1 /),            &
3355!                                        count = (/ nxr-nxl+2, nyn-nys+2 /) )
3356!             ELSE
3357                nc_stat = NF90_PUT_VAR( id_set_xy(av), id_var_zusi_xy(av),     &
3358                                        zu_s_inner(nxl:nxr,nys:nyn),           &
3359                                        start = (/ nxl+1, nys+1 /),            &
3360                                        count = (/ nxr-nxl+1, nyn-nys+1 /) )
3361!             ENDIF
3362             CALL netcdf_handle_error( 'netcdf_define_header', 427 )
3363
3364!             IF ( nxr == nx  .AND.  nyn /= ny )  THEN
3365!                nc_stat = NF90_PUT_VAR( id_set_xy(av), id_var_zwwi_xy(av),     &
3366!                                        zw_w_inner(nxl:nxr+1,nys:nyn),         &
3367!                                        start = (/ nxl+1, nys+1 /),            &
3368!                                        count = (/ nxr-nxl+2, nyn-nys+1 /) )
3369!             ELSEIF ( nxr /= nx  .AND.  nyn == ny )  THEN
3370!                nc_stat = NF90_PUT_VAR( id_set_xy(av), id_var_zwwi_xy(av),     &
3371!                                        zw_w_inner(nxl:nxr,nys:nyn+1),         &
3372!                                        start = (/ nxl+1, nys+1 /),            &
3373!                                        count = (/ nxr-nxl+1, nyn-nys+2 /) )
3374!             ELSEIF ( nxr == nx  .AND.  nyn == ny )  THEN
3375!                nc_stat = NF90_PUT_VAR( id_set_xy(av), id_var_zwwi_xy(av),     &
3376!                                        zw_w_inner(nxl:nxr+1,nys:nyn+1),       &
3377!                                        start = (/ nxl+1, nys+1 /),            &
3378!                                        count = (/ nxr-nxl+2, nyn-nys+2 /) )
3379!             ELSE
3380                nc_stat = NF90_PUT_VAR( id_set_xy(av), id_var_zwwi_xy(av),     &
3381                                        zw_w_inner(nxl:nxr,nys:nyn),           &
3382                                        start = (/ nxl+1, nys+1 /),            &
3383                                        count = (/ nxr-nxl+1, nyn-nys+1 /) )
3384!             ENDIF
3385             CALL netcdf_handle_error( 'netcdf_define_header', 428 )
3386
3387          ENDIF
3388
3389       CASE ( 'xy_ext' )
3390
3391!
3392!--       Get the list of variables and compare with the actual run.
3393!--       First var_list_old has to be reset, since GET_ATT does not assign
3394!--       trailing blanks.
3395          var_list_old = ' '
3396          nc_stat = NF90_GET_ATT( id_set_xy(av), NF90_GLOBAL, 'VAR_LIST', &
3397                                  var_list_old )
3398          CALL netcdf_handle_error( 'netcdf_define_header', 129 )
3399
3400          var_list = ';'
3401          i = 1
3402          DO WHILE ( do2d(av,i)(1:1) /= ' ' )
3403             IF ( INDEX( do2d(av,i), 'xy' ) /= 0 )  THEN
3404                var_list = TRIM( var_list ) // TRIM( do2d(av,i) ) // ';'
3405             ENDIF
3406             i = i + 1
3407          ENDDO
3408
3409          IF ( av == 0 )  THEN
3410             var = '(xy)'
3411          ELSE
3412             var = '(xy_av)'
3413          ENDIF
3414
3415          IF ( TRIM( var_list ) /= TRIM( var_list_old ) )  THEN
3416             message_string = 'netCDF file for cross-sections ' //           &
3417                              TRIM( var ) // ' from previous run found,' //  &
3418                              '&but this file cannot be extended due to' //  &
3419                              ' variable mismatch.' //                       &
3420                              '&New file is created instead.'
3421             CALL message( 'define_netcdf_header', 'PA0249', 0, 1, 0, 6, 0 )
3422             extend = .FALSE.
3423             RETURN
3424          ENDIF
3425
3426!
3427!--       Calculate the number of current sections
3428          ns = 1
3429          DO WHILE ( section(ns,1) /= -9999  .AND.  ns <= 100 )
3430             ns = ns + 1
3431          ENDDO
3432          ns = ns - 1
3433
3434!
3435!--       Get and compare the number of horizontal cross sections
3436          nc_stat = NF90_INQ_VARID( id_set_xy(av), 'zu_xy', id_var_zu_xy(av) )
3437          CALL netcdf_handle_error( 'netcdf_define_header', 130 )
3438
3439          nc_stat = NF90_INQUIRE_VARIABLE( id_set_xy(av), id_var_zu_xy(av), &
3440                                           dimids = id_dim_zu_xy_old )
3441          CALL netcdf_handle_error( 'netcdf_define_header', 131 )
3442          id_dim_zu_xy(av) = id_dim_zu_xy_old(1)
3443
3444          nc_stat = NF90_INQUIRE_DIMENSION( id_set_xy(av), id_dim_zu_xy(av), &
3445                                            len = ns_old )
3446          CALL netcdf_handle_error( 'netcdf_define_header', 132 )
3447
3448          IF ( ns /= ns_old )  THEN
3449             message_string = 'netCDF file for cross-sections ' //          &
3450                              TRIM( var ) // ' from previous run found,' // &
3451                              '&but this file cannot be extended due to' // &
3452                              ' mismatch in number of' //                   &
3453                              ' cross sections.' //                         &
3454                              '&New file is created instead.'
3455             CALL message( 'define_netcdf_header', 'PA0250', 0, 1, 0, 6, 0 )
3456             extend = .FALSE.
3457             RETURN
3458          ENDIF
3459
3460!
3461!--       Get and compare the heights of the cross sections
3462          ALLOCATE( netcdf_data(1:ns_old) )
3463
3464          nc_stat = NF90_GET_VAR( id_set_xy(av), id_var_zu_xy(av), netcdf_data )
3465          CALL netcdf_handle_error( 'netcdf_define_header', 133 )
3466
3467          DO  i = 1, ns
3468             IF ( section(i,1) /= -1 )  THEN
3469                IF ( zu(section(i,1)) /= netcdf_data(i) )  THEN
3470                   message_string = 'netCDF file for cross-sections ' //       &
3471                               TRIM( var ) // ' from previous run found,' //   &
3472                               ' but this file cannot be extended' //          &
3473                               ' due to mismatch in cross' //                  &
3474                               ' section levels.' //                           &
3475                               ' New file is created instead.'
3476                   CALL message( 'define_netcdf_header', 'PA0251',             &
3477                                                                 0, 1, 0, 6, 0 )
3478                   extend = .FALSE.
3479                   RETURN
3480                ENDIF
3481             ELSE
3482                IF ( -1.0_wp /= netcdf_data(i) )  THEN
3483                   message_string = 'netCDF file for cross-sections ' //       &
3484                               TRIM( var ) // ' from previous run found,' //   &
3485                               ' but this file cannot be extended' //          &
3486                               ' due to mismatch in cross' //                  &
3487                               ' section levels.' //                           &
3488                               ' New file is created instead.'
3489                   CALL message( 'define_netcdf_header', 'PA0251',             &
3490                                                                 0, 1, 0, 6, 0 )
3491                   extend = .FALSE.
3492                   RETURN
3493                ENDIF
3494             ENDIF
3495          ENDDO
3496
3497          DEALLOCATE( netcdf_data )
3498
3499!
3500!--       Get the id of the time coordinate (unlimited coordinate) and its
3501!--       last index on the file. The next time level is do2d..count+1.
3502!--       The current time must be larger than the last output time
3503!--       on the file.
3504          nc_stat = NF90_INQ_VARID( id_set_xy(av), 'time', id_var_time_xy(av) )
3505          CALL netcdf_handle_error( 'netcdf_define_header', 134 )
3506
3507          nc_stat = NF90_INQUIRE_VARIABLE( id_set_xy(av), id_var_time_xy(av), &
3508                                           dimids = id_dim_time_old )
3509          CALL netcdf_handle_error( 'netcdf_define_header', 135 )
3510          id_dim_time_xy(av) = id_dim_time_old(1)
3511
3512          nc_stat = NF90_INQUIRE_DIMENSION( id_set_xy(av), id_dim_time_xy(av), &
3513                                            len = ntime_count )
3514          CALL netcdf_handle_error( 'netcdf_define_header', 136 )
3515
3516!
3517!--       For non-parallel output use the last output time level of the netcdf
3518!--       file because the time dimension is unlimited. In case of parallel
3519!--       output the variable ntime_count could get the value of 9*10E36 because
3520!--       the time dimension is limited.
3521          IF ( netcdf_data_format < 5 ) do2d_xy_time_count(av) = ntime_count
3522
3523          nc_stat = NF90_GET_VAR( id_set_xy(av), id_var_time_xy(av),           &
3524                                  last_time_coordinate,                        &
3525                                  start = (/ do2d_xy_time_count(av) /),        &
3526                                  count = (/ 1 /) )
3527          CALL netcdf_handle_error( 'netcdf_define_header', 137 )
3528
3529          IF ( last_time_coordinate(1) >= simulated_time )  THEN
3530             message_string = 'netCDF file for cross sections ' //             &
3531                              TRIM( var ) // ' from previous run found,' //    &
3532                              '&but this file cannot be extended becaus' //    &
3533                              'e the current output time' //                   &
3534                              '&is less or equal than the last output t' //    &
3535                              'ime on this file.' //                           &
3536                              '&New file is created instead.'
3537             CALL message( 'define_netcdf_header', 'PA0252', 0, 1, 0, 6, 0 )
3538             do2d_xy_time_count(av) = 0
3539             extend = .FALSE.
3540             RETURN
3541          ENDIF
3542
3543          IF ( netcdf_data_format > 4 )  THEN
3544!
3545!--          Check if the needed number of output time levels is increased
3546!--          compared to the number of time levels in the existing file.
3547             IF ( ntdim_2d_xy(av) > ntime_count )  THEN
3548                message_string = 'netCDF file for cross sections ' //          &
3549                                 TRIM( var ) // ' from previous run found,' // &
3550                                 '&but this file cannot be extended becaus' // &
3551                                 'e the number of output time levels has b' // &
3552                                 'een increased compared to the previous s' // &
3553                                 'imulation.' //                               &
3554                                 '&New file is created instead.'
3555                CALL message( 'define_netcdf_header', 'PA0389', 0, 1, 0, 6, 0 )
3556                do2d_xy_time_count(av) = 0
3557                extend = .FALSE.
3558!
3559!--             Recalculate the needed time levels for the new file.
3560                IF ( av == 0 )  THEN
3561                   ntdim_2d_xy(0) = CEILING(                            &
3562                           ( end_time - MAX( skip_time_do2d_xy,         &
3563                                             simulated_time_at_begin )  &
3564                           ) / dt_do2d_xy )
3565                   IF ( do2d_at_begin )  ntdim_2d_xy(0) = ntdim_2d_xy(0) + 1
3566                ELSE
3567                   ntdim_2d_xy(1) = CEILING(                            &
3568                           ( end_time - MAX( skip_time_data_output_av,  &
3569                                             simulated_time_at_begin )  &
3570                           ) / dt_data_output_av )
3571                ENDIF
3572                RETURN
3573             ENDIF
3574          ENDIF
3575
3576!
3577!--       Dataset seems to be extendable.
3578!--       Now get the variable ids.
3579          i = 1
3580          DO WHILE ( do2d(av,i)(1:1) /= ' ' )
3581             IF ( INDEX( do2d(av,i), 'xy' ) /= 0 )  THEN
3582                nc_stat = NF90_INQ_VARID( id_set_xy(av), do2d(av,i), &
3583                                          id_var_do2d(av,i) )
3584                CALL netcdf_handle_error( 'netcdf_define_header', 138 )
3585#if defined( __netcdf4_parallel )
3586!
3587!--             Set collective io operations for parallel io
3588                IF ( netcdf_data_format > 4 )  THEN
3589                   nc_stat = NF90_VAR_PAR_ACCESS( id_set_xy(av),     &
3590                                                  id_var_do2d(av,i), &
3591                                                  NF90_COLLECTIVE )
3592                   CALL netcdf_handle_error( 'netcdf_define_header', 454 )
3593                ENDIF
3594#endif
3595             ENDIF
3596             i = i + 1
3597          ENDDO
3598
3599!
3600!--       Update the title attribute on file
3601!--       In order to avoid 'data mode' errors if updated attributes are larger
3602!--       than their original size, NF90_PUT_ATT is called in 'define mode'
3603!--       enclosed by NF90_REDEF and NF90_ENDDEF calls. This implies a possible
3604!--       performance loss due to data copying; an alternative strategy would be
3605!--       to ensure equal attribute size in a job chain. Maybe revise later.
3606          IF ( av == 0 )  THEN
3607             time_average_text = ' '
3608          ELSE
3609             WRITE (time_average_text, '('', '',F7.1,'' s average'')') &
3610                                                            averaging_interval
3611          ENDIF
3612          nc_stat = NF90_REDEF( id_set_xy(av) )
3613          CALL netcdf_handle_error( 'netcdf_define_header', 431 )
3614          nc_stat = NF90_PUT_ATT( id_set_xy(av), NF90_GLOBAL, 'title',         &
3615                                  TRIM( run_description_header ) //            &
3616                                  TRIM( time_average_text ) )
3617          CALL netcdf_handle_error( 'netcdf_define_header', 139 )
3618          nc_stat = NF90_ENDDEF( id_set_xy(av) )
3619          CALL netcdf_handle_error( 'netcdf_define_header', 432 )
3620          message_string = 'netCDF file for cross-sections ' //                &
3621                            TRIM( var ) // ' from previous run found.' //      &
3622                           '&This file will be extended.'
3623          CALL message( 'define_netcdf_header', 'PA0253', 0, 0, 0, 6, 0 )
3624         
3625
3626       CASE ( 'xz_new' )
3627
3628!
3629!--       Define some global attributes of the dataset
3630          IF ( av == 0 )  THEN
3631             CALL netcdf_create_global_atts( id_set_xz(av), 'xz', TRIM( run_description_header ), 140 )
3632             time_average_text = ' '
3633          ELSE
3634             CALL netcdf_create_global_atts( id_set_xz(av), 'xz_av', TRIM( run_description_header ), 140 )
3635             WRITE ( time_average_text,'(F7.1,'' s avg'')' )  averaging_interval
3636             nc_stat = NF90_PUT_ATT( id_set_xz(av), NF90_GLOBAL, 'time_avg',   &
3637                                     TRIM( time_average_text ) )
3638             CALL netcdf_handle_error( 'netcdf_define_header', 141 )
3639          ENDIF
3640
3641!
3642!--       Define time coordinate for xz sections.
3643!--       For parallel output the time dimensions has to be limited, otherwise
3644!--       the performance drops significantly.
3645          IF ( netcdf_data_format < 5 )  THEN
3646             CALL netcdf_create_dim( id_set_xz(av), 'time', NF90_UNLIMITED,    &
3647                                     id_dim_time_xz(av), 142 )
3648          ELSE
3649             CALL netcdf_create_dim( id_set_xz(av), 'time', ntdim_2d_xz(av),   &
3650                                     id_dim_time_xz(av), 525 )
3651          ENDIF
3652
3653          CALL netcdf_create_var( id_set_xz(av), (/ id_dim_time_xz(av) /),     &
3654                                  'time', NF90_DOUBLE, id_var_time_xz(av),     &
3655                                  'seconds', 'time', 143, 144, 000 )
3656          CALL netcdf_create_att( id_set_xz(av), id_var_time_xz(av), 'standard_name', 'time', 000)
3657          CALL netcdf_create_att( id_set_xz(av), id_var_time_xz(av), 'axis', 'T', 000)
3658!
3659!--       Define the spatial dimensions and coordinates for xz-sections.
3660!--       First, determine the number of vertical sections to be written.
3661          IF ( section(1,2) == -9999 )  THEN
3662             RETURN
3663          ELSE
3664             ns = 1
3665             DO WHILE ( section(ns,2) /= -9999  .AND.  ns <= 100 )
3666                ns = ns + 1
3667             ENDDO
3668             ns = ns - 1
3669          ENDIF
3670
3671!
3672!--       Define y-axis (for scalar position)
3673          CALL netcdf_create_dim( id_set_xz(av), 'y_xz', ns, id_dim_y_xz(av),  &
3674                                  145 )
3675          CALL netcdf_create_var( id_set_xz(av), (/ id_dim_y_xz(av) /),        &
3676                                  'y_xz', NF90_DOUBLE, id_var_y_xz(av),        &
3677                                  'meters', '', 146, 147, 000 )
3678!
3679!--       Define y-axis (for v position)
3680          CALL netcdf_create_dim( id_set_xz(av), 'yv_xz', ns,                  &
3681                                  id_dim_yv_xz(av), 369 )
3682          CALL netcdf_create_var( id_set_xz(av), (/ id_dim_yv_xz(av) /),       &
3683                                  'yv_xz', NF90_DOUBLE, id_var_yv_xz(av),      &
3684                                  'meters', '', 370, 371, 000 )
3685!
3686!--       Define a variable to store the layer indices of the vertical cross
3687!--       sections
3688          CALL netcdf_create_var( id_set_xz(av), (/ id_dim_y_xz(av) /),        &
3689                                  'ind_y_xz', NF90_DOUBLE,                     &
3690                                  id_var_ind_y_xz(av), 'gridpoints', '', 148,  &
3691                                  149, 000 )
3692!
3693!--       Define x-axis (for scalar position)
3694          CALL netcdf_create_dim( id_set_xz(av), 'x', nx+1, id_dim_x_xz(av),   &
3695                                  150 )
3696          CALL netcdf_create_var( id_set_xz(av), (/ id_dim_x_xz(av) /), 'x',   &
3697                                  NF90_DOUBLE, id_var_x_xz(av), 'meters', '',  &
3698                                  151, 152, 000 )
3699!
3700!--       Define x-axis (for u position)
3701          CALL netcdf_create_dim( id_set_xz(av), 'xu', nx+1, id_dim_xu_xz(av), &
3702                                  372 )
3703          CALL netcdf_create_var( id_set_xz(av), (/ id_dim_xu_xz(av) /), 'xu', &
3704                                  NF90_DOUBLE, id_var_xu_xz(av), 'meters', '', &
3705                                  373, 374, 000 )
3706!
3707!--       Define the three z-axes (zu, zw, and zs)
3708          CALL netcdf_create_dim( id_set_xz(av), 'zu', nz+2, id_dim_zu_xz(av), &
3709                                  153 )
3710          CALL netcdf_create_var( id_set_xz(av), (/ id_dim_zu_xz(av) /), 'zu', &
3711                                  NF90_DOUBLE, id_var_zu_xz(av), 'meters', '', &
3712                                  154, 155, 000 )
3713          CALL netcdf_create_dim( id_set_xz(av), 'zw', nz+2, id_dim_zw_xz(av), &
3714                                  156 )
3715          CALL netcdf_create_var( id_set_xz(av), (/ id_dim_zw_xz(av) /), 'zw', &
3716                                  NF90_DOUBLE, id_var_zw_xz(av), 'meters', '', &
3717                                  157, 158, 000 )
3718!
3719!--       Define UTM and geographic coordinates
3720          CALL define_geo_coordinates( id_set_xz(av),         &
3721                  (/ id_dim_x_xz(av), id_dim_xu_xz(av) /),    &
3722                  (/ id_dim_y_xz(av), id_dim_yv_xz(av) /),    &
3723                  id_var_eutm_xz(:,av), id_var_nutm_xz(:,av), &
3724                  id_var_lat_xz(:,av), id_var_lon_xz(:,av)    )
3725!
3726!--       Define coordinate-reference system
3727          CALL netcdf_create_crs( id_set_xz(av), 000 )
3728
3729          IF ( land_surface )  THEN
3730
3731             CALL netcdf_create_dim( id_set_xz(av), 'zs', nzs,                 &
3732                                     id_dim_zs_xz(av), 542 )
3733             CALL netcdf_create_var( id_set_xz(av), (/ id_dim_zs_xz(av) /),    &
3734                                     'zs', NF90_DOUBLE, id_var_zs_xz(av),      &
3735                                     'meters', '', 543, 544, 000 )
3736
3737          ENDIF
3738
3739!
3740!--       Define the variables
3741          var_list = ';'
3742          i = 1
3743
3744          DO WHILE ( do2d(av,i)(1:1) /= ' ' )
3745
3746             IF ( INDEX( do2d(av,i), 'xz' ) /= 0 )  THEN
3747
3748!
3749!--             Check for the grid
3750                found = .FALSE.
3751                SELECT CASE ( do2d(av,i) )
3752!
3753!--                Most variables are defined on the zu grid
3754                   CASE ( 'e_xz', 'nc_xz', 'nr_xz', 'p_xz', 'pc_xz',           &
3755                          'pr_xz', 'prr_xz', 'q_xz', 'qc_xz',                  &
3756                          'ql_xz', 'ql_c_xz', 'ql_v_xz', 'ql_vp_xz', 'qr_xz',  &
3757                          'qv_xz', 's_xz',                                     &
3758                          'theta_xz', 'thetal_xz', 'thetav_xz'                 )
3759
3760                      grid_x = 'x'
3761                      grid_y = 'y'
3762                      grid_z = 'zu'
3763!
3764!--                u grid
3765                   CASE ( 'u_xz' )
3766
3767                      grid_x = 'xu'
3768                      grid_y = 'y'
3769                      grid_z = 'zu'
3770!
3771!--                v grid
3772                   CASE ( 'v_xz' )
3773
3774                      grid_x = 'x'
3775                      grid_y = 'yv'
3776                      grid_z = 'zu'
3777!
3778!--                w grid
3779                   CASE ( 'w_xz' )
3780
3781                      grid_x = 'x'
3782                      grid_y = 'y'
3783                      grid_z = 'zw'
3784
3785                   CASE DEFAULT
3786
3787!
3788!--                   Check for land surface quantities
3789                      IF ( land_surface )  THEN
3790                         CALL lsm_define_netcdf_grid( do2d(av,i), found,       &
3791                                                      grid_x, grid_y, grid_z )
3792                      ENDIF
3793
3794                      IF ( .NOT. found )  THEN
3795                         CALL tcm_define_netcdf_grid( do2d(av,i), found,       &
3796                                                      grid_x, grid_y, grid_z )
3797                      ENDIF
3798
3799!
3800!--                   Check for ocean quantities
3801                      IF ( .NOT. found  .AND.  ocean_mode )  THEN
3802                         CALL ocean_define_netcdf_grid( do2d(av,i), found,  &
3803                                                        grid_x, grid_y, grid_z )
3804                      ENDIF
3805!
3806!--                   Check for radiation quantities
3807                      IF ( .NOT. found  .AND.  radiation )  THEN
3808                         CALL radiation_define_netcdf_grid( do2d(av,i), found, &
3809                                                            grid_x, grid_y,    &
3810                                                            grid_z )
3811                      ENDIF
3812!
3813!--                   Check for SALSA quantities
3814                      IF ( .NOT. found  .AND.  salsa )  THEN
3815                         CALL salsa_define_netcdf_grid( do2d(av,i), found,     &
3816                                                        grid_x, grid_y, grid_z )
3817                      ENDIF                         
3818
3819!
3820!--                   Check for gust module quantities
3821                      IF ( .NOT. found  .AND.  gust_module_enabled )  THEN
3822                         CALL gust_define_netcdf_grid( do2d(av,i), found,      &
3823                                                       grid_x, grid_y, grid_z )
3824                      ENDIF
3825
3826!
3827!--                   Check for chemistry quantities
3828                      IF ( .NOT. found  .AND.  air_chemistry )  THEN
3829                         CALL chem_define_netcdf_grid( do2d(av,i), found,      &
3830                                                       grid_x, grid_y,         &
3831                                                       grid_z )
3832                      ENDIF
3833
3834!
3835!--                   Check for user-defined quantities
3836                      IF ( .NOT. found  .AND.  user_module_enabled )  THEN
3837                         CALL user_define_netcdf_grid( do2d(av,i), found,      &
3838                                                       grid_x, grid_y, grid_z )
3839                      ENDIF
3840
3841                      IF ( .NOT. found )  THEN
3842                         WRITE ( message_string, * ) 'no grid defined for',    &
3843                                                ' variable ', TRIM( do2d(av,i) )
3844                         CALL message( 'define_netcdf_header', 'PA0244',       &
3845                                       0, 1, 0, 6, 0 )
3846                      ENDIF
3847
3848                END SELECT
3849
3850!
3851!--             Select the respective dimension ids
3852                IF ( grid_x == 'x' )  THEN
3853                   id_x = id_dim_x_xz(av)
3854                ELSEIF ( grid_x == 'xu' )  THEN
3855                   id_x = id_dim_xu_xz(av)
3856                ENDIF
3857
3858                IF ( grid_y == 'y' )  THEN
3859                   id_y = id_dim_y_xz(av)
3860                ELSEIF ( grid_y == 'yv' )  THEN
3861                   id_y = id_dim_yv_xz(av)
3862                ENDIF
3863
3864                IF ( grid_z == 'zu' )  THEN
3865                   id_z = id_dim_zu_xz(av)
3866                ELSEIF ( grid_z == 'zw' )  THEN
3867                   id_z = id_dim_zw_xz(av)
3868                ELSEIF ( grid_z == 'zs' )  THEN
3869                   id_z = id_dim_zs_xz(av)
3870                ENDIF
3871
3872!
3873!--             Define the grid
3874                CALL netcdf_create_var( id_set_xz(av), (/ id_x, id_y, id_z,    &
3875                                        id_dim_time_xz(av) /), do2d(av,i),     &
3876                                        nc_precision(2), id_var_do2d(av,i),    &
3877                                        TRIM( do2d_unit(av,i) ), do2d(av,i),   &
3878                                        159, 160, 355, .TRUE. )
3879
3880#if defined( __netcdf4_parallel )
3881
3882                IF ( netcdf_data_format > 4 )  THEN
3883!
3884!--                Set no fill for every variable to increase performance.
3885                   nc_stat = NF90_DEF_VAR_FILL( id_set_xz(av),     &
3886                                                id_var_do2d(av,i), &
3887                                                1, 0 )
3888                   CALL netcdf_handle_error( 'netcdf_define_header', 534 )
3889!
3890!--                Set independent io operations for parallel io. Collective io
3891!--                is only allowed in case of a 1d-decomposition along x,
3892!--                because otherwise, not all PEs have output data.
3893                   IF ( npey == 1 )  THEN
3894                      nc_stat = NF90_VAR_PAR_ACCESS( id_set_xz(av),     &
3895                                                     id_var_do2d(av,i), &
3896                                                     NF90_COLLECTIVE )
3897                   ELSE
3898!
3899!--                   Test simulations showed that the output of cross sections
3900!--                   by all PEs in data_output_2d using NF90_COLLECTIVE is
3901!--                   faster than the output by the first row of PEs in
3902!--                   x-direction using NF90_INDEPENDENT.
3903                      nc_stat = NF90_VAR_PAR_ACCESS( id_set_xz(av),    & 
3904                                                    id_var_do2d(av,i), &
3905                                                    NF90_COLLECTIVE )
3906!                      nc_stat = NF90_VAR_PAR_ACCESS( id_set_xz(av),     &
3907!                                                     id_var_do2d(av,i), &
3908!                                                     NF90_INDEPENDENT )
3909                   ENDIF
3910                   CALL netcdf_handle_error( 'netcdf_define_header', 449 )
3911                ENDIF
3912#endif
3913                var_list = TRIM( var_list ) // TRIM( do2d(av,i) ) // ';'
3914
3915             ENDIF
3916
3917             i = i + 1
3918
3919          ENDDO
3920
3921!
3922!--       No arrays to output. Close the netcdf file and return.
3923          IF ( i == 1 )  RETURN
3924
3925!
3926!--       Write the list of variables as global attribute (this is used by
3927!--       restart runs and by combine_plot_fields)
3928          nc_stat = NF90_PUT_ATT( id_set_xz(av), NF90_GLOBAL, 'VAR_LIST', &
3929                                  var_list )
3930          CALL netcdf_handle_error( 'netcdf_define_header', 161 )
3931
3932!
3933!--       Set general no fill, otherwise the performance drops significantly for
3934!--       parallel output.
3935          nc_stat = NF90_SET_FILL( id_set_xz(av), NF90_NOFILL, oldmode )
3936          CALL netcdf_handle_error( 'netcdf_define_header', 530 )
3937
3938!
3939!--       Leave netCDF define mode
3940          nc_stat = NF90_ENDDEF( id_set_xz(av) )
3941          CALL netcdf_handle_error( 'netcdf_define_header', 162 )
3942
3943!
3944!--       These data are only written by PE0 for parallel output to increase
3945!--       the performance.
3946          IF ( myid == 0  .OR.  netcdf_data_format < 5 )  THEN
3947
3948!
3949!--          Write axis data: y_xz, x, zu, zw
3950             ALLOCATE( netcdf_data(1:ns) )
3951
3952!
3953!--          Write y_xz data (shifted by +dy/2)
3954             DO  i = 1, ns
3955                IF( section(i,2) == -1 )  THEN
3956                   netcdf_data(i) = -1.0_wp  ! section averaged along y
3957                ELSE
3958                   netcdf_data(i) = ( section(i,2) + 0.5_wp ) * dy
3959                ENDIF
3960             ENDDO
3961             nc_stat = NF90_PUT_VAR( id_set_xz(av), id_var_y_xz(av), &
3962                                     netcdf_data, start = (/ 1 /),   &
3963                                     count = (/ ns /) )
3964             CALL netcdf_handle_error( 'netcdf_define_header', 163 )
3965
3966!
3967!--          Write yv_xz data
3968             DO  i = 1, ns
3969                IF( section(i,2) == -1 )  THEN
3970                   netcdf_data(i) = -1.0_wp  ! section averaged along y
3971                ELSE
3972                   netcdf_data(i) = section(i,2) * dy
3973                ENDIF
3974             ENDDO
3975             nc_stat = NF90_PUT_VAR( id_set_xz(av), id_var_yv_xz(av), &
3976                                     netcdf_data, start = (/ 1 /),    &
3977                                     count = (/ ns /) )
3978             CALL netcdf_handle_error( 'netcdf_define_header', 375 )
3979
3980!
3981!--          Write gridpoint number data
3982             netcdf_data(1:ns) = section(1:ns,2)
3983             nc_stat = NF90_PUT_VAR( id_set_xz(av), id_var_ind_y_xz(av), &
3984                                     netcdf_data, start = (/ 1 /),       &
3985                                     count = (/ ns /) )
3986             CALL netcdf_handle_error( 'netcdf_define_header', 164 )
3987
3988
3989             DEALLOCATE( netcdf_data )
3990
3991!
3992!--          Write data for x (shifted by +dx/2) and xu axis
3993             ALLOCATE( netcdf_data(0:nx) )
3994
3995             DO  i = 0, nx
3996                netcdf_data(i) = ( i + 0.5_wp ) * dx
3997             ENDDO
3998
3999             nc_stat = NF90_PUT_VAR( id_set_xz(av), id_var_x_xz(av), &
4000                                     netcdf_data, start = (/ 1 /),   &
4001                                     count = (/ nx+1 /) )
4002             CALL netcdf_handle_error( 'netcdf_define_header', 165 )
4003
4004             DO  i = 0, nx
4005                netcdf_data(i) = i * dx
4006             ENDDO
4007
4008             nc_stat = NF90_PUT_VAR( id_set_xz(av), id_var_xu_xz(av), &
4009                                     netcdf_data, start = (/ 1 /),    &
4010                                     count = (/ nx+1 /) )
4011             CALL netcdf_handle_error( 'netcdf_define_header', 377 )
4012
4013             DEALLOCATE( netcdf_data )
4014
4015!
4016!--          Write zu and zw data (vertical axes)
4017             ALLOCATE( netcdf_data(0:nz+1) )
4018
4019             netcdf_data(0:nz+1) = zu(nzb:nzt+1)
4020             nc_stat = NF90_PUT_VAR( id_set_xz(av), id_var_zu_xz(av), &
4021                                     netcdf_data, start = (/ 1 /),    &
4022                                     count = (/ nz+2 /) )
4023             CALL netcdf_handle_error( 'netcdf_define_header', 166 )
4024
4025             netcdf_data(0:nz+1) = zw(nzb:nzt+1)
4026             nc_stat = NF90_PUT_VAR( id_set_xz(av), id_var_zw_xz(av), &
4027                                     netcdf_data, start = (/ 1 /),    &
4028                                     count = (/ nz+2 /) )
4029             CALL netcdf_handle_error( 'netcdf_define_header', 167 )
4030
4031!
4032!--          Write zs data
4033             IF ( land_surface )  THEN
4034                netcdf_data(0:nzs-1) = - zs(nzb_soil:nzt_soil)
4035                nc_stat = NF90_PUT_VAR( id_set_xz(av), id_var_zs_xz(av), &
4036                                        netcdf_data(0:nzs), start = (/ 1 /),    &
4037                                        count = (/ nzt_soil-nzb_soil+1 /) )
4038               CALL netcdf_handle_error( 'netcdf_define_header', 548 )
4039             ENDIF
4040
4041             DEALLOCATE( netcdf_data )
4042!
4043!--          Write UTM coordinates
4044             IF ( init_model%rotation_angle == 0.0_wp )  THEN
4045!
4046!--             1D in case of no rotation
4047                cos_ra = COS( init_model%rotation_angle * pi / 180.0_wp )
4048!
4049!--             x coordinates
4050                ALLOCATE( netcdf_data(0:nx) )
4051                DO  k = 0, 2
4052!               
4053!--                Scalar grid points
4054                   IF ( k == 0 )  THEN
4055                      shift_x = 0.5
4056!               
4057!--                u grid points
4058                   ELSEIF ( k == 1 )  THEN
4059                      shift_x = 0.0
4060!               
4061!--                v grid points
4062                   ELSEIF ( k == 2 )  THEN
4063                      shift_x = 0.5
4064                   ENDIF
4065               
4066                   DO  i = 0, nx
4067                     netcdf_data(i) = init_model%origin_x            &
4068                                    + cos_ra * ( i + shift_x ) * dx
4069                   ENDDO
4070               
4071                   nc_stat = NF90_PUT_VAR( id_set_xz(av), id_var_eutm_xz(k,av),&
4072                                           netcdf_data, start = (/ 1 /),   &
4073                                           count = (/ nx+1 /) )
4074                   CALL netcdf_handle_error( 'netcdf_define_header', 555 )
4075
4076                ENDDO
4077                DEALLOCATE( netcdf_data )
4078!
4079!--             y coordinates
4080                ALLOCATE( netcdf_data(1:ns) )
4081                DO  k = 0, 2
4082!
4083!--                Scalar grid points
4084                   IF ( k == 0 )  THEN
4085                      shift_y = 0.5
4086!
4087!--                u grid points
4088                   ELSEIF ( k == 1 )  THEN
4089                      shift_y = 0.5
4090!
4091!--                v grid points
4092                   ELSEIF ( k == 2 )  THEN
4093                      shift_y = 0.0
4094                   ENDIF
4095
4096                   DO  i = 1, ns
4097                      IF( section(i,2) == -1 )  THEN
4098                         netcdf_data(i) = -1.0_wp  ! section averaged along y
4099                      ELSE
4100                         netcdf_data(i) = init_model%origin_y &
4101                                     + cos_ra * ( section(i,2) + shift_y ) * dy
4102                      ENDIF
4103                   ENDDO
4104
4105                   nc_stat = NF90_PUT_VAR( id_set_xz(av), id_var_nutm_xz(k,av),&
4106                                           netcdf_data, start = (/ 1 /),   &
4107                                           count = (/ ns /) )
4108                   CALL netcdf_handle_error( 'netcdf_define_header', 556 )
4109
4110                ENDDO
4111                DEALLOCATE( netcdf_data )
4112
4113             ELSE
4114!
4115!--             2D in case of rotation
4116                ALLOCATE( netcdf_data_2d(0:nx,1:ns) )
4117                cos_ra = COS( init_model%rotation_angle * pi / 180.0_wp )
4118                sin_ra = SIN( init_model%rotation_angle * pi / 180.0_wp )
4119               
4120                DO  k = 0, 2
4121!               
4122!--                Scalar grid points
4123                   IF ( k == 0 )  THEN
4124                      shift_x = 0.5 ; shift_y = 0.5
4125!                 
4126!--                u grid points
4127                   ELSEIF ( k == 1 )  THEN
4128                      shift_x = 0.0 ; shift_y = 0.5
4129!                 
4130!--                v grid points
4131                   ELSEIF ( k == 2 )  THEN
4132                      shift_x = 0.5 ; shift_y = 0.0
4133                   ENDIF
4134
4135                   DO  j = 1, ns
4136                      IF( section(j,2) == -1 )  THEN
4137                         netcdf_data_2d(:,j) = -1.0_wp  ! section averaged along y
4138                      ELSE
4139                         DO  i = 0, nx
4140                            netcdf_data_2d(i,j) = init_model%origin_x          &
4141                                    + cos_ra * ( i + shift_x ) * dx            &
4142                                    + sin_ra * ( section(j,2) + shift_y ) * dy
4143                         ENDDO
4144                      ENDIF
4145                   ENDDO
4146                   
4147                   nc_stat = NF90_PUT_VAR( id_set_xz(av), id_var_eutm_xz(k,av),  &
4148                                           netcdf_data_2d, start = (/ 1, 1 /),   &
4149                                           count = (/ nx+1, ns /) )
4150                   CALL netcdf_handle_error( 'netcdf_define_header', 555 )
4151                   
4152                   DO  j = 1, ns
4153                      IF( section(j,2) == -1 )  THEN
4154                         netcdf_data_2d(:,j) = -1.0_wp  ! section averaged along y
4155                      ELSE
4156                         DO  i = 0, nx
4157                            netcdf_data_2d(i,j) = init_model%origin_y          &
4158                                    - sin_ra * ( i + shift_x ) * dx            &
4159                                    + cos_ra * ( section(j,2) + shift_y ) * dy
4160                         ENDDO
4161                      ENDIF
4162                   ENDDO
4163                   
4164                   nc_stat = NF90_PUT_VAR( id_set_xz(av), id_var_nutm_xz(k,av),  &
4165                                           netcdf_data_2d, start = (/ 1, 1 /),   &
4166                                           count = (/ nx+1, ns /) )
4167                   CALL netcdf_handle_error( 'netcdf_define_header', 556 )
4168               
4169                ENDDO
4170                DEALLOCATE( netcdf_data_2d )
4171             ENDIF
4172!
4173!--          Write lon and lat data
4174             ALLOCATE( lat(0:nx,1:ns) )
4175             ALLOCATE( lon(0:nx,1:ns) )
4176             cos_ra = COS( init_model%rotation_angle * pi / 180.0_wp )
4177             sin_ra = SIN( init_model%rotation_angle * pi / 180.0_wp )
4178
4179             DO  k = 0, 2
4180!               
4181!--             Scalar grid points
4182                IF ( k == 0 )  THEN
4183                   shift_x = 0.5 ; shift_y = 0.5
4184!               
4185!--             u grid points
4186                ELSEIF ( k == 1 )  THEN
4187                   shift_x = 0.0 ; shift_y = 0.5
4188!               
4189!--             v grid points
4190                ELSEIF ( k == 2 )  THEN
4191                   shift_x = 0.5 ; shift_y = 0.0
4192                ENDIF
4193
4194                DO  j = 1, ns
4195                   IF( section(j,2) == -1 )  THEN
4196                      lat(:,j) = -90.0_wp  ! section averaged along y
4197                      lon(:,j) = -180.0_wp  ! section averaged along y
4198                   ELSE
4199                      DO  i = 0, nx
4200                         eutm = init_model%origin_x            &
4201                              + cos_ra * ( i + shift_x ) * dx  &
4202                              + sin_ra * ( section(j,2) + shift_y ) * dy
4203                         nutm = init_model%origin_y            &
4204                              - sin_ra * ( i + shift_x ) * dx  &
4205                              + cos_ra * ( section(j,2) + shift_y ) * dy
4206
4207                         CALL  convert_utm_to_geographic( crs_list,          &
4208                                                          eutm, nutm,        &
4209                                                          lon(i,j), lat(i,j) )
4210                      ENDDO
4211                   ENDIF
4212                ENDDO
4213
4214                nc_stat = NF90_PUT_VAR( id_set_xz(av), id_var_lon_xz(k,av), &
4215                                     lon, start = (/ 1, 1 /),       &
4216                                     count = (/ nx+1, ns /) )
4217                CALL netcdf_handle_error( 'netcdf_define_header', 556 )
4218
4219                nc_stat = NF90_PUT_VAR( id_set_xz(av), id_var_lat_xz(k,av), &
4220                                     lat, start = (/ 1, 1 /),       &
4221                                     count = (/ nx+1, ns /) )
4222                CALL netcdf_handle_error( 'netcdf_define_header', 556 )
4223             ENDDO
4224
4225             DEALLOCATE( lat )
4226             DEALLOCATE( lon )
4227
4228          ENDIF
4229
4230
4231       CASE ( 'xz_ext' )
4232
4233!
4234!--       Get the list of variables and compare with the actual run.
4235!--       First var_list_old has to be reset, since GET_ATT does not assign
4236!--       trailing blanks.
4237          var_list_old = ' '
4238          nc_stat = NF90_GET_ATT( id_set_xz(av), NF90_GLOBAL, 'VAR_LIST', &
4239                                  var_list_old )
4240          CALL netcdf_handle_error( 'netcdf_define_header', 168 )
4241
4242          var_list = ';'
4243          i = 1
4244          DO WHILE ( do2d(av,i)(1:1) /= ' ' )
4245             IF ( INDEX( do2d(av,i), 'xz' ) /= 0 )  THEN
4246                var_list = TRIM( var_list ) // TRIM( do2d(av,i) ) // ';'
4247             ENDIF
4248             i = i + 1
4249          ENDDO
4250
4251          IF ( av == 0 )  THEN
4252             var = '(xz)'
4253          ELSE
4254             var = '(xz_av)'
4255          ENDIF
4256
4257          IF ( TRIM( var_list ) /= TRIM( var_list_old ) )  THEN
4258             message_string = 'netCDF file for cross-sections ' //           &
4259                              TRIM( var ) // ' from previous run found,' //  &
4260                              '&but this file cannot be extended due to' //  &
4261                              ' variable mismatch.' //                       &
4262                              '&New file is created instead.'
4263             CALL message( 'define_netcdf_header', 'PA0249', 0, 1, 0, 6, 0 )
4264             extend = .FALSE.
4265             RETURN
4266          ENDIF
4267
4268!
4269!--       Calculate the number of current sections
4270          ns = 1
4271          DO WHILE ( section(ns,2) /= -9999  .AND.  ns <= 100 )
4272             ns = ns + 1
4273          ENDDO
4274          ns = ns - 1
4275
4276!
4277!--       Get and compare the number of vertical cross sections
4278          nc_stat = NF90_INQ_VARID( id_set_xz(av), 'y_xz', id_var_y_xz(av) )
4279          CALL netcdf_handle_error( 'netcdf_define_header', 169 )
4280
4281          nc_stat = NF90_INQUIRE_VARIABLE( id_set_xz(av), id_var_y_xz(av), &
4282                                           dimids = id_dim_y_xz_old )
4283          CALL netcdf_handle_error( 'netcdf_define_header', 170 )
4284          id_dim_y_xz(av) = id_dim_y_xz_old(1)
4285
4286          nc_stat = NF90_INQUIRE_DIMENSION( id_set_xz(av), id_dim_y_xz(av), &
4287                                            len = ns_old )
4288          CALL netcdf_handle_error( 'netcdf_define_header', 171 )
4289
4290          IF ( ns /= ns_old )  THEN
4291             message_string = 'netCDF file for cross-sections ' //          &
4292                              TRIM( var ) // ' from previous run found,' // &
4293                              '&but this file cannot be extended due to' // &
4294                              ' mismatch in number of' //                   & 
4295                              ' cross sections.' //                         &
4296                              '&New file is created instead.'
4297             CALL message( 'define_netcdf_header', 'PA0250', 0, 1, 0, 6, 0 )
4298             extend = .FALSE.
4299             RETURN
4300          ENDIF
4301
4302!
4303!--       Get and compare the heights of the cross sections
4304          ALLOCATE( netcdf_data(1:ns_old) )
4305
4306          nc_stat = NF90_GET_VAR( id_set_xz(av), id_var_y_xz(av), netcdf_data )
4307          CALL netcdf_handle_error( 'netcdf_define_header', 172 )
4308
4309          DO  i = 1, ns
4310             IF ( section(i,2) /= -1 )  THEN
4311                IF ( ( ( section(i,2) + 0.5 ) * dy ) /= netcdf_data(i) )  THEN
4312                   message_string = 'netCDF file for cross-sections ' //       &
4313                               TRIM( var ) // ' from previous run found,' //   &
4314                               ' but this file cannot be extended' //          &
4315                               ' due to mismatch in cross' //                  &
4316                               ' section levels.' //                           &
4317                               ' New file is created instead.'
4318                   CALL message( 'define_netcdf_header', 'PA0251',             &
4319                                                                 0, 1, 0, 6, 0 )
4320                   extend = .FALSE.
4321                   RETURN
4322                ENDIF
4323             ELSE
4324                IF ( -1.0_wp /= netcdf_data(i) )  THEN
4325                   message_string = 'netCDF file for cross-sections ' //       &
4326                               TRIM( var ) // ' from previous run found,' //   &
4327                               ' but this file cannot be extended' //          &
4328                               ' due to mismatch in cross' //                  &
4329                               ' section levels.' //                           &
4330                               ' New file is created instead.'
4331                   CALL message( 'define_netcdf_header', 'PA0251',             &
4332                                                                 0, 1, 0, 6, 0 )
4333                   extend = .FALSE.
4334                   RETURN
4335                ENDIF
4336             ENDIF
4337          ENDDO
4338
4339          DEALLOCATE( netcdf_data )
4340
4341!
4342!--       Get the id of the time coordinate (unlimited coordinate) and its
4343!--       last index on the file. The next time level is do2d..count+1.
4344!--       The current time must be larger than the last output time
4345!--       on the file.
4346          nc_stat = NF90_INQ_VARID( id_set_xz(av), 'time', id_var_time_xz(av) )
4347          CALL netcdf_handle_error( 'netcdf_define_header', 173 )
4348
4349          nc_stat = NF90_INQUIRE_VARIABLE( id_set_xz(av), id_var_time_xz(av), &
4350                                           dimids = id_dim_time_old )
4351          CALL netcdf_handle_error( 'netcdf_define_header', 174 )
4352          id_dim_time_xz(av) = id_dim_time_old(1)
4353
4354          nc_stat = NF90_INQUIRE_DIMENSION( id_set_xz(av), id_dim_time_xz(av), &
4355                                            len = ntime_count )
4356          CALL netcdf_handle_error( 'netcdf_define_header', 175 )
4357
4358!
4359!--       For non-parallel output use the last output time level of the netcdf
4360!--       file because the time dimension is unlimited. In case of parallel
4361!--       output the variable ntime_count could get the value of 9*10E36 because
4362!--       the time dimension is limited.
4363          IF ( netcdf_data_format < 5 ) do2d_xz_time_count(av) = ntime_count
4364
4365          nc_stat = NF90_GET_VAR( id_set_xz(av), id_var_time_xz(av),           &
4366                                  last_time_coordinate,                        &
4367                                  start = (/ do2d_xz_time_count(av) /),        &
4368                                  count = (/ 1 /) )
4369          CALL netcdf_handle_error( 'netcdf_define_header', 176 )
4370
4371          IF ( last_time_coordinate(1) >= simulated_time )  THEN
4372             message_string = 'netCDF file for cross sections ' //             &
4373                              TRIM( var ) // ' from previous run found,' //    &
4374                              '&but this file cannot be extended becaus' //    &
4375                              'e the current output time' //                   &
4376                              '&is less or equal than the last output t' //    &
4377                              'ime on this file.' //                           &
4378                              '&New file is created instead.'
4379             CALL message( 'define_netcdf_header', 'PA0252', 0, 1, 0, 6, 0 )
4380             do2d_xz_time_count(av) = 0
4381             extend = .FALSE.
4382             RETURN
4383          ENDIF
4384
4385          IF ( netcdf_data_format > 4 )  THEN
4386!
4387!--          Check if the needed number of output time levels is increased
4388!--          compared to the number of time levels in the existing file.
4389             IF ( ntdim_2d_xz(av) > ntime_count )  THEN
4390                message_string = 'netCDF file for cross sections ' // &
4391                                 TRIM( var ) // ' from previous run found,' // &
4392                                 '&but this file cannot be extended becaus' // &
4393                                 'e the number of output time levels has b' // &
4394                                 'een increased compared to the previous s' // &
4395                                 'imulation.' //                               &
4396                                 '&New file is created instead.'
4397                CALL message( 'define_netcdf_header', 'PA0390', 0, 1, 0, 6, 0 )
4398                do2d_xz_time_count(av) = 0
4399                extend = .FALSE.
4400!
4401!--             Recalculate the needed time levels for the new file.
4402                IF ( av == 0 )  THEN
4403                   ntdim_2d_xz(0) = CEILING(                            &
4404                           ( end_time - MAX( skip_time_do2d_xz,         &
4405                                             simulated_time_at_begin )  &
4406                           ) / dt_do2d_xz )
4407                   IF ( do2d_at_begin )  ntdim_2d_xz(0) = ntdim_2d_xz(0) + 1
4408                ELSE
4409                   ntdim_2d_xz(1) = CEILING(                            &
4410                           ( end_time - MAX( skip_time_data_output_av,  &
4411                                             simulated_time_at_begin )  &
4412                           ) / dt_data_output_av )
4413                ENDIF
4414                RETURN
4415             ENDIF
4416          ENDIF
4417
4418!
4419!--       Dataset seems to be extendable.
4420!--       Now get the variable ids.
4421          i = 1
4422          DO WHILE ( do2d(av,i)(1:1) /= ' ' )
4423             IF ( INDEX( do2d(av,i), 'xz' ) /= 0 )  THEN
4424                nc_stat = NF90_INQ_VARID( id_set_xz(av), do2d(av,i), &
4425                                          id_var_do2d(av,i) )
4426                CALL netcdf_handle_error( 'netcdf_define_header', 177 )
4427#if defined( __netcdf4_parallel )
4428!
4429!--             Set independent io operations for parallel io. Collective io
4430!--             is only allowed in case of a 1d-decomposition along x, because
4431!--             otherwise, not all PEs have output data.
4432                IF ( netcdf_data_format > 4 )  THEN
4433                   IF ( npey == 1 )  THEN