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

Last change on this file since 3727 was 3727, checked in by gronemeier, 6 years ago

New: surface output available in NetCDF format (Makefile, netcdf_interface_mod, surface_data_output_mod)

  • Property svn:keywords set to Id
File size: 323.9 KB
RevLine 
[1850]1!> @file netcdf_interface_mod.f90
[2000]2!------------------------------------------------------------------------------!
[2696]3! This file is part of the PALM model system.
[1036]4!
[2000]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.
[1036]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!
[3655]17! Copyright 1997-2019 Leibniz Universitaet Hannover
[2000]18!------------------------------------------------------------------------------!
[1036]19!
[1]20! Current revisions:
21! ------------------
[3464]22!
[3589]23!
[3464]24! Former revisions:
25! -----------------
26! $Id: netcdf_interface_mod.f90 3727 2019-02-08 14:52:10Z gronemeier $
[3727]27! make several routines publicly available
28!
29! 3701 2019-01-26 18:57:21Z knoop
[3665]30! Statement added to prevent compiler warning about unused variable
31!
32! 3655 2019-01-07 16:51:22Z knoop
[3589]33! Move the control parameter "salsa" from salsa_mod to control_parameters
34! (M. Kurppa)
35!
36! 3582 2018-11-29 19:16:36Z suehring
[3569]37! dom_dwd_user, Schrempf:
38! Remove uv exposure model code, this is now part of biometeorology_mod
39!
40! 3529 2018-11-15 21:03:15Z gronemeier
[3529]41! - set time units
42! - add additional global attributes,
43! - add additinal variable attributes
44! - move definition of UTM and geographic coordinates into subroutine
45! - change fill_value
46!
47! 3525 2018-11-14 16:06:14Z kanani
[3525]48! Changes related to clean-up of biometeorology (dom_dwd_user)
49!
50! 3485 2018-11-03 17:09:40Z gronemeier
[3485]51! Write geographic coordinates as global attributes to file.
52!
53! 3467 2018-10-30 19:05:21Z suehring
[3467]54! - Salsa implemented
55! - Bugfix convert_utm_to...
56!
57! 3464 2018-10-30 18:08:55Z kanani
[3459]58! - Add variable crs to output files
59! - Add long_name to UTM coordinates
60! - Add latitude/longitude coordinates. For 3d and xy output, lon and lat are
61!   only written if parallel output is used.
[2233]62!
[3464]63! 3459 2018-10-30 15:04:11Z gronemeier
[3448]64! Adjustment of biometeorology calls
65!
66! 3435 2018-10-26 18:25:44Z gronemeier
[3435]67! Bugfix: corrected order of calls to define_netcdf_grid for masked output
68! Add vertical dimensions to masked output in case of terrain-following output
69!
70! 3421 2018-10-24 18:39:32Z gronemeier
[3421]71! Bugfix: move ocean output variables to ocean_mod
72! Renamed output variables
73! Add UTM coordinates to mask, 3d, xy, xz, yz output
74!
75! 3337 2018-10-12 15:17:09Z kanani
[3337]76! (from branch resler)
77! Add biometeorology
78!
79! 3294 2018-10-01 02:37:10Z raasch
[3294]80! changes concerning modularization of ocean option
81!
82! 3274 2018-09-24 15:42:55Z knoop
[3274]83! Modularization of all bulk cloud physics code components
84!
85! 3241 2018-09-12 15:02:00Z raasch
[3241]86! unused variables removed
87!
88! 3235 2018-09-07 14:06:15Z sward
[3235]89! Changed MAS output dimension id_dim_agtnum to be of defined size and no longer
90! unlimited. Also changed some MAS output variables to be of type float
91!
92! 3198 2018-08-15 09:23:10Z sward
[3198]93! Redefined MAS limited time dimension to fit usage of multi_agent_system_end
94!
95! 3187 2018-07-31 10:32:34Z sward
[3187]96! Changed agent output to precision NF90_DOUBLE
97!
98! 3165 2018-07-24 13:12:42Z sward
[3165]99! Added agent ID output
100!
101! 3159 2018-07-20 11:20:01Z sward
[3159]102! Added multi agent system
103!
104! 3049 2018-05-29 13:52:36Z Giersch
[3049]105! Error messages revised
106!
107! 3045 2018-05-28 07:55:41Z Giersch
[3045]108! Error messages revised, code adjusted to PALMs coding standards, CASE pt_ext
109! pt_new disabled, comment revised
110!
111! 3004 2018-04-27 12:33:25Z Giersch
[3004]112! .NOT. found in if-query added to account for variables found in tcm
113!
114! 2964 2018-04-12 16:04:03Z Giersch
[2964]115! Calculation of fixed number of output time levels for parallel netcdf output
116! has been moved completely to check_parameters
117!
118! 2932 2018-03-26 09:39:22Z maronga
[2932]119! Renamed inipar to initialization_parameters.
120!
121! 2817 2018-02-19 16:32:21Z knoop
[2817]122! Preliminary gust module interface implemented
123!
124! 2769 2018-01-25 09:22:24Z raasch
[2769]125! bugfix for calculating number of required output time levels in case of output
126! at the beginning of a restart run
127!
128! 2766 2018-01-22 17:17:47Z kanani
[2766]129! Removed preprocessor directive __chem
130!
131! 2746 2018-01-15 12:06:04Z suehring
[2746]132! Move flag plant canopy to modules
133!
134! 2718 2018-01-02 08:49:38Z maronga
[2716]135! Corrected "Former revisions" section
[3467]136!
[2716]137! 2696 2017-12-14 17:12:51Z kanani
138! Change in file header (GPL part)
[2696]139! Implementation of uv exposure model (FK)
140! Implemented checks for turbulence_closure_mod (TG)
141! Implementation of chemistry module (FK)
142! Bugfix in setting netcdf grids for LSM variables
143! Enable setting of _FillValue attribute in output files (MS)
144!
145! 2512 2017-10-04 08:26:59Z raasch
[2512]146! upper bounds of cross section and 3d output changed from nx+1,ny+1 to nx,ny
147! no output of ghost layer data any more
148!
149! 2302 2017-07-03 14:07:20Z suehring
[2302]150! Reading of 3D topography using NetCDF data type NC_BYTE
151!
152! 2292 2017-06-20 09:51:42Z schwenkel
[2292]153! Implementation of new microphysic scheme: cloud_scheme = 'morrison'
154! includes two more prognostic equations for cloud drop concentration (nc) 
155! and cloud water content (qc).
156!
157! 2270 2017-06-09 12:18:47Z maronga
[2270]158! Removed 2 timeseries (shf_eb + qsws_eb). Removed _eb suffixes
159!
160! 2265 2017-06-08 16:58:28Z schwenkel
[2265]161! Unused variables removed.
162!
163! 2239 2017-06-01 12:04:51Z suehring
[2239]164! Bugfix xy-output of land-surface variables
165!
166! 2233 2017-05-30 18:08:54Z suehring
[2233]167!
168! 2232 2017-05-30 17:47:52Z suehring
[2232]169! Adjustments to new topography and surface concept
[2201]170!
[2232]171! Topograpyh height arrays (zu_s_inner, zw_w_inner) are defined locally, output
172! only if parallel netcdf.
173!
174! Build interface for topography input:
175! - open file in read-only mode
176! - read global attributes
177! - read variables
178!
179! Bugfix in xy output (land-surface case)
180!
[2210]181! 2209 2017-04-19 09:34:46Z kanani
182! Added support for plant canopy model output
183!
[2201]184! 2189 2017-03-21 09:29:52Z raasch
185! bugfix: rho renamed rho_ocean for the cross section output
186!
[2110]187! 2109 2017-01-10 12:18:08Z raasch
188! bugfix: length of character string netcdf_var_name extended to avoid problems
189!         which appeared in restart runs due to truncation
190!
[2041]191! 2040 2016-10-26 16:58:09Z gronemeier
[2040]192! Increased number of possible statistic_regions to 99
193!
[2038]194! 2037 2016-10-26 11:15:40Z knoop
195! Anelastic approximation implemented
196!
[2032]197! 2031 2016-10-21 15:11:58Z knoop
198! renamed variable rho to rho_ocean
199!
[2012]200! 2011 2016-09-19 17:29:57Z kanani
201! Flag urban_surface is now defined in module control_parameters,
202! changed prefix for urban surface model output to "usm_",
203! introduced control parameter varnamelength for LEN of trimvar.
204!
[2008]205! 2007 2016-08-24 15:47:17Z kanani
[2007]206! Added support for new urban surface model (temporary modifications of
207! SELECT CASE ( ) necessary, see variable trimvar),
208! increased DIMENSION of do2d_unit, do3d_unit, id_var_do2d, id_var_do3d,
209! increased LEN of char_cross_profiles, var_list, var_list_old
[1834]210!
[2001]211! 2000 2016-08-20 18:09:15Z knoop
212! Forced header and separation lines into 80 columns
213!
[1991]214! 1990 2016-08-12 09:54:36Z gronemeier
215! Bugfix: variable list was not written for time series output
216!
[1981]217! 1980 2016-07-29 15:51:57Z suehring
218! Bugfix, in order to steer user-defined output, setting flag found explicitly
219! to .F.
220!
[1977]221! 1976 2016-07-27 13:28:04Z maronga
222! Removed remaining 2D land surface quantities. Definition of radiation
223! quantities is now done directly in the respective module
224!
[1973]225! 1972 2016-07-26 07:52:02Z maronga
226! Bugfix: wrong units for lsm quantities.
227! Definition of grids for land surface quantities is now done directly in the
228! respective module.
229!
[1961]230! 1960 2016-07-12 16:34:24Z suehring
231! Additional labels and units for timeseries output of passive scalar-related
232! quantities
233!
[1958]234! 1957 2016-07-07 10:43:48Z suehring
235! flight module added
236!
[1851]237! 1850 2016-04-08 13:29:27Z maronga
238! Module renamed
239!
240!
[1834]241! 1833 2016-04-07 14:23:03Z raasch
242! spectrum renamed spectra_mod
243!
[1787]244! 1786 2016-03-08 05:49:27Z raasch
245! Bugfix: id_var_time_sp made public
246!
[1784]247! 1783 2016-03-06 18:36:17Z raasch
[1783]248! netcdf interface has been modularized, former file netcdf renamed to
249! netcdf_interface, creation of netcdf-dimensions and -variables moved to
250! specific new subroutines create_netcdf_dim and create_netcdf_var,
251! compression (deflation) of variables implemented,
252! ibmy special cpp directive removed
[1321]253!
[1746]254! 1745 2016-02-05 13:06:51Z gronemeier
255! Bugfix: recalculating ntdim_3d, ntdim_2d_xy/xz/yz when checking the
256!         extensibility of an existing file (only when using parallel NetCDF).
257!
[1692]258! 1691 2015-10-26 16:17:44Z maronga
259! Added output of radiative heating rates for RRTMG. Corrected output of
260! radiative fluxes
261!
[1683]262! 1682 2015-10-07 23:56:08Z knoop
263! Code annotations made doxygen readable
264!
[1597]265! 1596 2015-05-21 09:34:28Z gronemeier
266! Bugfix in masked data output. Read 'zu_3d' when trying to extend masked data
267!
[1552]268! 1551 2015-03-03 14:18:16Z maronga
269! Added support for land surface model and radiation model output. In the course
270! of this action a new vertical grid zs (soil) was introduced.
271!
[1354]272! 1353 2014-04-08 15:21:23Z heinze
273! REAL constants provided with KIND-attribute
274!
[1323]275! 1322 2014-03-20 16:38:49Z raasch
276! Forgotten ONLY-attribute added to USE-statements
277!
[1321]278! 1320 2014-03-20 08:40:49Z raasch
[1320]279! ONLY-attribute added to USE-statements,
280! kind-parameters added to all INTEGER and REAL declaration statements,
281! kinds are defined in new module kinds,
282! revision history before 2012 removed,
283! comment fields (!:) to be used for variable explanations added to
284! all variable declaration statements
[1309]285!
286! 1308 2014-03-13 14:58:42Z fricke
[1308]287! +ntime_count, oldmode
288! Adjust NF90_CREATE and NF90_OPEN statement for parallel output
289! To increase the performance for parallel output, the following is done:
290! - Limit time dimension
291! - Values of axis data are only written by PE0
292! - No fill is set for all variables
293! Check the number of output time levels for restart jobs
[520]294!
[1207]295! 1206 2013-07-18 12:49:16Z witha
296! Bugfix: typo in preprocessor directive in subroutine open_write_netcdf_file
297!
[1093]298! 1092 2013-02-02 11:24:22Z raasch
299! unused variables removed
300!
[1054]301! 1053 2012-11-13 17:11:03Z hoffmann
302! +qr, nr, prr
303!
[1037]304! 1036 2012-10-22 13:43:42Z raasch
305! code put under GPL (PALM 3.9)
306!
[1035]307! 1031 2012-10-19 14:35:30Z raasch
308! netCDF4 without parallel file support implemented, new routines
309! create_netcdf_file and open_write_netcdf_file at end
310!
[993]311! 992 2012-09-05 15:08:26Z hoffmann
312! Removal of the informative messages PA0352 and PA0353.
[984]313
314! 983 2012-08-21 14:17:57Z hoffmann
315! Bugfix in cross_profiles.
[520]316!
[965]317! 964 2012-07-26 09:14:24Z raasch
318! rev 951 and 959 reformatted
319!
[960]320! 959 2012-07-24 13:13:41Z hoffmann
[964]321! Bugfix in cross_profiles. It is not allowed to arrange more than 100
[960]322! profiles with cross_profiles.
323!
[952]324! 951 2012-07-19 14:22:52Z hoffmann
[1031]325! cross_profiles, profile_rows, profile_columns are written to netCDF header
[952]326!
[1]327! Revision 1.1  2005/05/18 15:37:16  raasch
328! Initial revision
329!
330!
331! Description:
332! ------------
[1682]333!> In case of extend = .FALSE.:
334!> Define all necessary dimensions, axes and variables for the different
335!> netCDF datasets. This subroutine is called from check_open after a new
336!> dataset is created. It leaves the open netCDF files ready to write.
337!>
338!> In case of extend = .TRUE.:
339!> Find out if dimensions and variables of an existing file match the values
340!> of the actual run. If so, get all necessary information (ids, etc.) from
341!> this file.
342!>
343!> Parameter av can assume values 0 (non-averaged data) and 1 (time averaged
344!> data)
[1745]345!>
346!> @todo calculation of output time levels for parallel NetCDF still does not
347!>       cover every exception (change of dt_do, end_time in restart)
[1976]348!> @todo timeseries and profile output still needs to be rewritten to allow
349!>       modularization
[3459]350!> @todo output 2d UTM coordinates without global arrays
351!> @todo output longitude/latitude also with non-parallel output (3d and xy)
[1]352!------------------------------------------------------------------------------!
[1783]353 MODULE netcdf_interface
354
[2232]355    USE control_parameters,                                                    &
[3448]356        ONLY:  biometeorology, fl_max,                                         &
357               max_masks, multi_agent_system_end,                              &
[3198]358               multi_agent_system_start, var_fl_max, varnamelength
[1783]359    USE kinds
360#if defined( __netcdf )
361    USE NETCDF
[1682]362#endif
[3235]363    USE mas_global_attributes,                                                 &
364        ONLY:  dim_size_agtnum
[1783]365
[3459]366    USE netcdf_data_input_mod,                                                 &
[3485]367        ONLY: coord_ref_sys, init_model
[3459]368
[1783]369    PRIVATE
370
[3159]371    CHARACTER (LEN=16), DIMENSION(13) ::  agt_var_names =                      &
[3235]372          (/ 'ag_id           ', 'ag_x            ', 'ag_y            ',       &
373             'ag_wind         ', 'ag_temp         ', 'ag_group        ',       &
[3448]374             'PM10            ', 'PM25            ', 'ag_iPT          ',       &
[3165]375             'ag_uv           ', 'not_used        ', 'not_used        ',       &
[3159]376             'not_used        ' /)
377
378    CHARACTER (LEN=16), DIMENSION(13) ::  agt_var_units = &
[3235]379          (/ 'dim_less        ', 'meters          ', 'meters          ',       &
380             'm/s             ', 'K               ', 'dim_less        ',       &
[3159]381             'tbd             ', 'tbd             ', 'tbd             ',       &
[3165]382             'tbd             ', 'not_used        ', 'not_used        ',       &
[3159]383             'not_used        ' /)
384
[1783]385    INTEGER(iwp), PARAMETER ::  dopr_norm_num = 7, dopts_num = 29, dots_max = 100
386
[3421]387    CHARACTER (LEN=7), DIMENSION(dopr_norm_num) ::  dopr_norm_names =          &
388         (/ 'wtheta0', 'ws2    ', 'tsw2   ', 'ws3    ', 'ws2tsw ', 'wstsw2 ',  &
389            'z_i    ' /)
[1783]390
[3421]391    CHARACTER (LEN=7), DIMENSION(dopr_norm_num) ::  dopr_norm_longnames =      &
392         (/ 'wtheta0', 'w*2    ', 't*w2   ', 'w*3    ', 'w*2t*w ', 'w*t*w2 ',  &
393            'z_i    ' /)
[1783]394
395    CHARACTER (LEN=7), DIMENSION(dopts_num) :: dopts_label =                   &
396          (/ 'tnpt   ', 'x_     ', 'y_     ', 'z_     ', 'z_abs  ', 'u      ', &
397             'v      ', 'w      ', 'u"     ', 'v"     ', 'w"     ', 'npt_up ', &
398             'w_up   ', 'w_down ', 'radius ', 'r_min  ', 'r_max  ', 'npt_max', &
399             'npt_min', 'x*2    ', 'y*2    ', 'z*2    ', 'u*2    ', 'v*2    ', &
400             'w*2    ', 'u"2    ', 'v"2    ', 'w"2    ', 'npt*2  ' /)
401
402    CHARACTER (LEN=7), DIMENSION(dopts_num) :: dopts_unit =                    &
403          (/ 'number ', 'm      ', 'm      ', 'm      ', 'm      ', 'm/s    ', &
404             'm/s    ', 'm/s    ', 'm/s    ', 'm/s    ', 'm/s    ', 'number ', &
405             'm/s    ', 'm/s    ', 'm      ', 'm      ', 'm      ', 'number ', &
406             'number ', 'm2     ', 'm2     ', 'm2     ', 'm2/s2  ', 'm2/s2  ', &
407             'm2/s2  ', 'm2/s2  ', 'm2/s2  ', 'm2/s2  ', 'number2' /)
408
[2270]409    INTEGER(iwp) ::  dots_num  = 25  !< number of timeseries defined by default
[1960]410    INTEGER(iwp) ::  dots_soil = 26  !< starting index for soil-timeseries
[2270]411    INTEGER(iwp) ::  dots_rad  = 32  !< starting index for radiation-timeseries
[1783]412
413    CHARACTER (LEN=13), DIMENSION(dots_max) :: dots_label =                    &
414          (/ 'E            ', 'E*           ', 'dt           ',                &
[3421]415             'us*          ', 'th*          ', 'umax         ',                &
[1783]416             'vmax         ', 'wmax         ', 'div_new      ',                &
[3421]417             'div_old      ', 'zi_wtheta    ', 'zi_theta     ',                &
418             'w*           ', 'w"theta"0    ', 'w"theta"     ',                &
419             'wtheta       ', 'theta(0)     ', 'theta(z_mo)  ',                &
[1783]420             'w"u"0        ', 'w"v"0        ', 'w"q"0        ',                &
[1960]421             'ol           ', 'q*           ', 'w"s"         ',                &
[2270]422             's*           ', 'ghf          ', 'qsws_liq     ',                &
423             'qsws_soil    ', 'qsws_veg     ', 'r_a          ',                &
424             'r_s          ',                                                  &
[1960]425             'rad_net      ', 'rad_lw_in    ', 'rad_lw_out   ',                &
426             'rad_sw_in    ', 'rad_sw_out   ', 'rrtm_aldif   ',                &
427             'rrtm_aldir   ', 'rrtm_asdif   ', 'rrtm_asdir   ',                &                                               
[2270]428             ( 'unknown      ', i9 = 1, dots_max-40 ) /)
[1783]429
430    CHARACTER (LEN=13), DIMENSION(dots_max) :: dots_unit =                     &
431          (/ 'm2/s2        ', 'm2/s2        ', 's            ',                &
432             'm/s          ', 'K            ', 'm/s          ',                &
433             'm/s          ', 'm/s          ', 's-1          ',                &
434             's-1          ', 'm            ', 'm            ',                &
435             'm/s          ', 'K m/s        ', 'K m/s        ',                &
436             'K m/s        ', 'K            ', 'K            ',                &
437             'm2/s2        ', 'm2/s2        ', 'kg m/s       ',                &
[1960]438             'm            ', 'kg/kg        ', 'kg m/(kg s)  ',                &
[1972]439             'kg/kg        ', 'W/m2         ', 'W/m2         ',                &
[2270]440             'W/m2         ', 'W/m2         ', 's/m          ',                &
441             's/m          ',                                                  &
[1783]442             'W/m2         ', 'W/m2         ', 'W/m2         ',                &
[1960]443             'W/m2         ', 'W/m2         ', '             ',                &
[1783]444             '             ', '             ', '             ',                &
[2270]445             ( 'unknown      ', i9 = 1, dots_max-40 ) /)
[1783]446
[2037]447    CHARACTER (LEN=16) :: heatflux_output_unit     !< unit for heatflux output
448    CHARACTER (LEN=16) :: waterflux_output_unit    !< unit for waterflux output
449    CHARACTER (LEN=16) :: momentumflux_output_unit !< unit for momentumflux output
450
[1783]451    CHARACTER (LEN=9), DIMENSION(300) ::  dopr_unit = 'unknown'
452
[2007]453    CHARACTER (LEN=7), DIMENSION(0:1,500) ::  do2d_unit, do3d_unit
[1783]454
[3241]455!    CHARACTER (LEN=16), DIMENSION(25) ::  prt_var_names = &
456!          (/ 'pt_age          ', 'pt_dvrp_size    ', 'pt_origin_x     ', &
457!             'pt_origin_y     ', 'pt_origin_z     ', 'pt_radius       ', &
458!             'pt_speed_x      ', 'pt_speed_y      ', 'pt_speed_z      ', &
459!             'pt_weight_factor', 'pt_x            ', 'pt_y            ', &
460!             'pt_z            ', 'pt_color        ', 'pt_group        ', &
461!             'pt_tailpoints   ', 'pt_tail_id      ', 'pt_density_ratio', &
462!             'pt_exp_arg      ', 'pt_exp_term     ', 'not_used        ', &
463!             'not_used        ', 'not_used        ', 'not_used        ', &
464!             'not_used        ' /)
[1783]465
[3241]466!    CHARACTER (LEN=16), DIMENSION(25) ::  prt_var_units = &
467!          (/ 'seconds         ', 'meters          ', 'meters          ', &
468!             'meters          ', 'meters          ', 'meters          ', &
469!             'm/s             ', 'm/s             ', 'm/s             ', &
470!             'factor          ', 'meters          ', 'meters          ', &
471!             'meters          ', 'none            ', 'none            ', &
472!             'none            ', 'none            ', 'ratio           ', &
473!             'none            ', 'none            ', 'not_used        ', &
474!             'not_used        ', 'not_used        ', 'not_used        ', &
475!             'not_used        ' /)
[1783]476
477    CHARACTER(LEN=20), DIMENSION(11) ::  netcdf_precision = ' '
478    CHARACTER(LEN=40) ::  netcdf_data_format_string
479
[3241]480    INTEGER(iwp) ::  id_dim_agtnum, id_dim_time_agt,                           &
481                     id_dim_time_fl, id_dim_time_pr,                           &
[3159]482                     id_dim_time_pts, id_dim_time_sp, id_dim_time_ts,          &
483                     id_dim_x_sp, id_dim_y_sp, id_dim_zu_sp, id_dim_zw_sp,     &
484                     id_set_agt, id_set_fl, id_set_pr, id_set_prt, id_set_pts, &
485                     id_set_sp, id_set_ts, id_var_agtnum, id_var_time_agt,     &
[3241]486                     id_var_time_fl, id_var_rnoa_agt, id_var_time_pr,          &
[3159]487                     id_var_time_pts, id_var_time_sp, id_var_time_ts,          &
488                     id_var_x_sp, id_var_y_sp, id_var_zu_sp, id_var_zw_sp,     &
489                     nc_stat
[1783]490
[1957]491
[1783]492    INTEGER(iwp), DIMENSION(0:1) ::  id_dim_time_xy, id_dim_time_xz, &
493                    id_dim_time_yz, id_dim_time_3d, id_dim_x_xy, id_dim_xu_xy, &
494                    id_dim_x_xz, id_dim_xu_xz, id_dim_x_yz, id_dim_xu_yz, &
495                    id_dim_x_3d, id_dim_xu_3d, id_dim_y_xy, id_dim_yv_xy, &
496                    id_dim_y_xz, id_dim_yv_xz, id_dim_y_yz, id_dim_yv_yz, &
497                    id_dim_y_3d, id_dim_yv_3d, id_dim_zs_xy, id_dim_zs_xz, &
498                    id_dim_zs_yz, id_dim_zs_3d, id_dim_zu_xy, id_dim_zu1_xy, &
499                    id_dim_zu_xz, id_dim_zu_yz, id_dim_zu_3d, id_dim_zw_xy, &
500                    id_dim_zw_xz, id_dim_zw_yz, id_dim_zw_3d, id_set_xy, &
501                    id_set_xz, id_set_yz, id_set_3d, id_var_ind_x_yz, &
502                    id_var_ind_y_xz, id_var_ind_z_xy, id_var_time_xy, &
503                    id_var_time_xz, id_var_time_yz, id_var_time_3d, id_var_x_xy, &
504                    id_var_xu_xy, id_var_x_xz, id_var_xu_xz, id_var_x_yz, &
505                    id_var_xu_yz, id_var_x_3d, id_var_xu_3d, id_var_y_xy, &
506                    id_var_yv_xy, id_var_y_xz, id_var_yv_xz, id_var_y_yz, &
507                    id_var_yv_yz, id_var_y_3d, id_var_yv_3d, id_var_zs_xy, &
508                    id_var_zs_xz, id_var_zs_yz, id_var_zs_3d, id_var_zusi_xy, &
509                    id_var_zusi_3d, id_var_zu_xy, id_var_zu1_xy, id_var_zu_xz, &
510                    id_var_zu_yz, id_var_zu_3d, id_var_zwwi_xy, id_var_zwwi_3d, &
511                    id_var_zw_xy, id_var_zw_xz, id_var_zw_yz, id_var_zw_3d
512
[3421]513    INTEGER(iwp), DIMENSION(0:1,0:2) ::  id_var_eutm_3d, id_var_nutm_3d, &
514                                         id_var_eutm_xy, id_var_nutm_xy, &
515                                         id_var_eutm_xz, id_var_nutm_xz, &
[3459]516                                         id_var_eutm_yz, id_var_nutm_yz
[3421]517
[3459]518    INTEGER(iwp), DIMENSION(0:1,0:2) ::  id_var_lat_3d, id_var_lon_3d, &
519                                         id_var_lat_xy, id_var_lon_xy, &
520                                         id_var_lat_xz, id_var_lon_xz, &
521                                         id_var_lat_yz, id_var_lon_yz
522
[1783]523    INTEGER ::  netcdf_data_format = 2  !< NetCDF3 64bit offset format
524    INTEGER ::  netcdf_deflate = 0      !< NetCDF compression, default: no
525                                        !< compression
526
[1957]527    INTEGER(iwp)                 ::  dofl_time_count
[1783]528    INTEGER(iwp), DIMENSION(10)  ::  id_var_dospx, id_var_dospy
[3159]529    INTEGER(iwp), DIMENSION(20)  ::  id_var_agt
[3241]530!    INTEGER(iwp), DIMENSION(20)  ::  id_var_prt
[1783]531    INTEGER(iwp), DIMENSION(11)  ::  nc_precision
532    INTEGER(iwp), DIMENSION(dopr_norm_num) ::  id_var_norm_dopr
[1957]533   
534    INTEGER(iwp), DIMENSION(fl_max) ::  id_dim_x_fl, id_dim_y_fl, id_dim_z_fl
535    INTEGER(iwp), DIMENSION(fl_max) ::  id_var_x_fl, id_var_y_fl, id_var_z_fl
536   
537    CHARACTER (LEN=20), DIMENSION(fl_max*var_fl_max) :: dofl_label
538    CHARACTER (LEN=20), DIMENSION(fl_max*var_fl_max) :: dofl_unit 
539    CHARACTER (LEN=20), DIMENSION(fl_max) :: dofl_dim_label_x
540    CHARACTER (LEN=20), DIMENSION(fl_max) :: dofl_dim_label_y
541    CHARACTER (LEN=20), DIMENSION(fl_max) :: dofl_dim_label_z
[1783]542
[1957]543    INTEGER(iwp), DIMENSION(fl_max*var_fl_max) :: id_var_dofl   
544
[1783]545    INTEGER(iwp), DIMENSION(dopts_num,0:10) ::  id_var_dopts
[2007]546    INTEGER(iwp), DIMENSION(0:1,500)        ::  id_var_do2d, id_var_do3d
[2039]547    INTEGER(iwp), DIMENSION(100,0:99)       ::  id_dim_z_pr, id_var_dopr, &
[1783]548                                                id_var_z_pr
[2039]549    INTEGER(iwp), DIMENSION(dots_max,0:99)  ::  id_var_dots
[1783]550
551!
552!-- Masked output
553    CHARACTER (LEN=7), DIMENSION(max_masks,0:1,100) ::  domask_unit
554
555    LOGICAL ::  output_for_t0 = .FALSE.
556
557    INTEGER(iwp), DIMENSION(1:max_masks,0:1) ::  id_dim_time_mask, id_dim_x_mask, &
558                   id_dim_xu_mask, id_dim_y_mask, id_dim_yv_mask, id_dim_zs_mask, &
559                   id_dim_zu_mask, id_dim_zw_mask, &
560                   id_set_mask, &
561                   id_var_time_mask, id_var_x_mask, id_var_xu_mask, &
562                   id_var_y_mask, id_var_yv_mask, id_var_zs_mask, &
563                   id_var_zu_mask, id_var_zw_mask, &
564                   id_var_zusi_mask, id_var_zwwi_mask
[3448]565
[3421]566    INTEGER(iwp), DIMENSION(1:max_masks,0:1,0:2) ::  id_var_eutm_mask, &
567                                                     id_var_nutm_mask
[1783]568
[3459]569    INTEGER(iwp), DIMENSION(1:max_masks,0:1,0:2) ::  id_var_lat_mask, &
570                                                     id_var_lon_mask
571
[1783]572    INTEGER(iwp), DIMENSION(1:max_masks,0:1,100) ::  id_var_domask
573
[3529]574    REAL(wp) ::  fill_value = -9999.0_wp    !< value for the _FillValue attribute
[1783]575
[2696]576
[1957]577    PUBLIC  dofl_dim_label_x, dofl_dim_label_y, dofl_dim_label_z, dofl_label,  &
578            dofl_time_count, dofl_unit, domask_unit, dopr_unit, dopts_num,     &
579            dots_label, dots_max, dots_num, dots_rad, dots_soil, dots_unit,    &
[3159]580            do2d_unit, do3d_unit, fill_value, id_set_agt, id_set_fl,           &
581            id_set_mask, id_set_pr, id_set_prt, id_set_pts, id_set_sp,         &
582            id_set_ts, id_set_xy, id_set_xz, id_set_yz, id_set_3d, id_var_agt, &
583            id_var_domask, id_var_dofl, id_var_dopr, id_var_dopts,             &
584            id_var_dospx, id_var_dospy, id_var_dots, id_var_do2d, id_var_do3d, &
585            id_var_norm_dopr, id_var_time_agt, id_var_time_fl,                 &
586            id_var_time_mask, id_var_time_pr, id_var_rnoa_agt, id_var_time_pts,&
587            id_var_time_sp, id_var_time_ts,                                    &
[1957]588            id_var_time_xy, id_var_time_xz, id_var_time_yz, id_var_time_3d,    &
589            id_var_x_fl, id_var_y_fl, id_var_z_fl,  nc_stat,                   &
590            netcdf_data_format, netcdf_data_format_string, netcdf_deflate,     &
[2037]591            netcdf_precision, output_for_t0, heatflux_output_unit,             &
592            waterflux_output_unit, momentumflux_output_unit
593
[1783]594    SAVE
595
596    INTERFACE netcdf_create_dim
597       MODULE PROCEDURE netcdf_create_dim
598    END INTERFACE netcdf_create_dim
599
600    INTERFACE netcdf_create_file
601       MODULE PROCEDURE netcdf_create_file
602    END INTERFACE netcdf_create_file
603
[3727]604    INTERFACE netcdf_create_global_atts
605       MODULE PROCEDURE netcdf_create_global_atts
606    END INTERFACE netcdf_create_global_atts
607
[1783]608    INTERFACE netcdf_create_var
609       MODULE PROCEDURE netcdf_create_var
610    END INTERFACE netcdf_create_var
611
[3529]612    INTERFACE netcdf_create_att
613       MODULE PROCEDURE netcdf_create_att_string
614    END INTERFACE netcdf_create_att
615
[1783]616    INTERFACE netcdf_define_header
617       MODULE PROCEDURE netcdf_define_header
618    END INTERFACE netcdf_define_header
619
620    INTERFACE netcdf_handle_error
621       MODULE PROCEDURE netcdf_handle_error
622    END INTERFACE netcdf_handle_error
623
624    INTERFACE netcdf_open_write_file
625       MODULE PROCEDURE netcdf_open_write_file
626    END INTERFACE netcdf_open_write_file
627
[3727]628    PUBLIC netcdf_create_att, netcdf_create_dim, netcdf_create_file,           &
629           netcdf_create_global_atts, netcdf_create_var, netcdf_define_header, &
[2696]630           netcdf_handle_error, netcdf_open_write_file
[1783]631
632 CONTAINS
633
634 SUBROUTINE netcdf_define_header( callmode, extend, av )
[1682]635 
[1]636#if defined( __netcdf )
637
[1691]638    USE arrays_3d,                                                             &
[1320]639        ONLY:  zu, zw
640
[3448]641    USE biometeorology_mod,                                                    &
[3525]642        ONLY:  bio_define_netcdf_grid
[3448]643
[2696]644    USE chemistry_model_mod,                                                   &
645        ONLY:  chem_define_netcdf_grid 
646
[3274]647    USE basic_constants_and_equations_mod,                                     &
[1320]648        ONLY:  pi
649
[1691]650    USE control_parameters,                                                    &
[3159]651        ONLY:  agent_time_unlimited, air_chemistry, averaging_interval,        &
652               averaging_interval_pr, data_output_pr, domask, dopr_n,          &
[1691]653               dopr_time_count, dopts_time_count, dots_time_count,             &
[2769]654               do2d, do2d_at_begin, do2d_xz_time_count, do3d, do3d_at_begin,   &
[1745]655               do2d_yz_time_count, dt_data_output_av, dt_do2d_xy, dt_do2d_xz,  &
[3159]656               dt_do2d_yz, dt_do3d, dt_write_agent_data, mask_size,            &
657               do2d_xy_time_count,                                             &
[2232]658               do3d_time_count, domask_time_count, end_time, land_surface,     &
[2696]659               mask_size_l, mask_i, mask_i_global, mask_j, mask_j_global,      &
[3435]660               mask_k_global, mask_surface,                                    &
661               message_string, mid, ntdim_2d_xy, ntdim_2d_xz,                  &
[3294]662               ntdim_2d_yz, ntdim_3d, nz_do3d, ocean_mode, plant_canopy,       &
[3582]663               run_description_header, salsa, section, simulated_time,         &
[1745]664               simulated_time_at_begin, skip_time_data_output_av,              &
665               skip_time_do2d_xy, skip_time_do2d_xz, skip_time_do2d_yz,        &
[2011]666               skip_time_do3d, topography, num_leg, num_var_fl,                &
[3569]667               urban_surface
[1320]668
[1691]669    USE grid_variables,                                                        &
[1320]670        ONLY:  dx, dy, zu_s_inner, zw_w_inner
671
[2817]672    USE gust_mod,                                                              &
673        ONLY: gust_define_netcdf_grid, gust_module_enabled
674
[1691]675    USE indices,                                                               &
[2232]676        ONLY:  nx, nxl, nxr, ny, nys, nyn, nz ,nzb, nzt
[1320]677
678    USE kinds
679
[1551]680    USE land_surface_model_mod,                                                &
[2232]681        ONLY: lsm_define_netcdf_grid, nzb_soil, nzt_soil, nzs, zs
[1551]682
[3294]683    USE ocean_mod,                                                             &
684        ONLY:  ocean_define_netcdf_grid
685
[1]686    USE pegrid
687
[1691]688    USE particle_attributes,                                                   &
[2265]689        ONLY:  number_of_particle_groups
[1]690
[2209]691    USE plant_canopy_model_mod,                                                &
[2746]692        ONLY:  pcm_define_netcdf_grid
[2209]693
[1691]694    USE profil_parameter,                                                      &
695        ONLY:  crmax, cross_profiles, dopr_index, profile_columns, profile_rows
[1320]696
[1976]697    USE radiation_model_mod,                                                   &
[3467]698        ONLY: radiation, radiation_define_netcdf_grid     
699     
700    USE salsa_mod,                                                             &
[3582]701        ONLY:  salsa_define_netcdf_grid           
[1976]702
[1833]703    USE spectra_mod,                                                           &
704        ONLY:  averaging_interval_sp, comp_spectra_level, data_output_sp, dosp_time_count, spectra_direction
[1320]705
[1691]706    USE statistics,                                                            &
[1320]707        ONLY:  hom, statistic_regions
708
[2696]709    USE turbulence_closure_mod,                                                &
710        ONLY:  tcm_define_netcdf_grid
711
[2007]712    USE urban_surface_mod,                                                     &
[2011]713        ONLY:  usm_define_netcdf_grid
[1320]714
[3701]715    USE user,                                                                  &
716        ONLY:  user_module_enabled, user_define_netcdf_grid
[2007]717
[2696]718
[3701]719
[1]720    IMPLICIT NONE
721
[2039]722    CHARACTER (LEN=3)              ::  suffix                !<
[1682]723    CHARACTER (LEN=2), INTENT (IN) ::  callmode              !<
724    CHARACTER (LEN=4)              ::  grid_x                !<
725    CHARACTER (LEN=4)              ::  grid_y                !<
726    CHARACTER (LEN=4)              ::  grid_z                !<
727    CHARACTER (LEN=6)              ::  mode                  !<
728    CHARACTER (LEN=10)             ::  precision             !<
729    CHARACTER (LEN=10)             ::  var                   !<
[2109]730    CHARACTER (LEN=20)             ::  netcdf_var_name       !<
[2011]731    CHARACTER (LEN=varnamelength)  ::  trimvar               !< TRIM of output-variable string
[1682]732    CHARACTER (LEN=80)             ::  time_average_text     !<
[2007]733    CHARACTER (LEN=4000)           ::  char_cross_profiles   !<
734    CHARACTER (LEN=4000)           ::  var_list              !<
735    CHARACTER (LEN=4000)           ::  var_list_old          !<
[1]736
[1682]737    CHARACTER (LEN=100), DIMENSION(1:crmax) ::  cross_profiles_adj   !<
738    CHARACTER (LEN=100), DIMENSION(1:crmax) ::  cross_profiles_char  !<
[1]739
[1682]740    INTEGER(iwp) ::  av                                      !<
741    INTEGER(iwp) ::  cross_profiles_count                    !<
742    INTEGER(iwp) ::  cross_profiles_maxi                     !<
743    INTEGER(iwp) ::  delim                                   !<
744    INTEGER(iwp) ::  delim_old                               !<
745    INTEGER(iwp) ::  file_id                                 !<
746    INTEGER(iwp) ::  i                                       !<
747    INTEGER(iwp) ::  id_last                                 !<
748    INTEGER(iwp) ::  id_x                                    !<
749    INTEGER(iwp) ::  id_y                                    !<
750    INTEGER(iwp) ::  id_z                                    !<
751    INTEGER(iwp) ::  j                                       !<
752    INTEGER(iwp) ::  k                                       !<
753    INTEGER(iwp) ::  kk                                      !<
754    INTEGER(iwp) ::  ns                                      !<
755    INTEGER(iwp) ::  ns_do                                   !< actual value of ns for soil model data
756    INTEGER(iwp) ::  ns_old                                  !<
[1745]757    INTEGER(iwp) ::  ntime_count                             !< number of time levels found in file
[1682]758    INTEGER(iwp) ::  nz_old                                  !<
[1957]759    INTEGER(iwp) ::  l                                       !<
[951]760
[1682]761    INTEGER(iwp), SAVE ::  oldmode                           !<
[1308]762
[1682]763    INTEGER(iwp), DIMENSION(1) ::  id_dim_time_old           !<
764    INTEGER(iwp), DIMENSION(1) ::  id_dim_x_yz_old           !<
765    INTEGER(iwp), DIMENSION(1) ::  id_dim_y_xz_old           !<
766    INTEGER(iwp), DIMENSION(1) ::  id_dim_zu_sp_old          !<
767    INTEGER(iwp), DIMENSION(1) ::  id_dim_zu_xy_old          !<
768    INTEGER(iwp), DIMENSION(1) ::  id_dim_zu_3d_old          !<
769    INTEGER(iwp), DIMENSION(1) ::  id_dim_zu_mask_old        !<
[1]770
771
[1682]772    INTEGER(iwp), DIMENSION(1:crmax) ::  cross_profiles_numb !<
[951]773
[1682]774    LOGICAL ::  found                                        !<
[1]775
[1682]776    LOGICAL, INTENT (INOUT) ::  extend                       !<
[1]777
[1682]778    LOGICAL, SAVE ::  init_netcdf = .FALSE.                  !<
[1]779
[3421]780    REAL(wp) ::  cos_ra                                      !< cosine of rotation_angle
[3459]781    REAL(wp) ::  eutm                                        !< easting (UTM)
782    REAL(wp) ::  nutm                                        !< northing (UTM)
[3421]783    REAL(wp) ::  shift_x                                     !< shift of x coordinate
784    REAL(wp) ::  shift_y                                     !< shift of y coordinate
785    REAL(wp) ::  sin_ra                                      !< sine of rotation_angle
786
[1745]787    REAL(wp), DIMENSION(1) ::  last_time_coordinate          !< last time value in file
[3459]788    REAL(wp), DIMENSION(8) ::  crs_list                      !< list of coord_ref_sys values
[1]789
[1682]790    REAL(wp), DIMENSION(:), ALLOCATABLE   ::  netcdf_data    !<
791    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  netcdf_data_2d !<
[3459]792    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  lat            !< latitude
793    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  lon            !< longitude
[1320]794
[2007]795
[1]796!
[1783]797!-- Initializing actions
[1]798    IF ( .NOT. init_netcdf )  THEN
799!
[1031]800!--    Check and set accuracy for netCDF output. First set default value
[1]801       nc_precision = NF90_REAL4
802
803       i = 1
804       DO  WHILE ( netcdf_precision(i) /= ' ' )
805          j = INDEX( netcdf_precision(i), '_' )
806          IF ( j == 0 )  THEN
[274]807             WRITE ( message_string, * ) 'netcdf_precision must contain a ', &
808                                         '"_"netcdf_precision(', i, ')="',   &
[257]809                                         TRIM( netcdf_precision(i) ),'"'
[1783]810             CALL message( 'netcdf_define_header', 'PA0241', 2, 2, 0, 6, 0 )
[1]811          ENDIF
812
813          var       = netcdf_precision(i)(1:j-1)
814          precision = netcdf_precision(i)(j+1:)
815
816          IF ( precision == 'NF90_REAL4' )  THEN
817             j = NF90_REAL4
818          ELSEIF ( precision == 'NF90_REAL8' )  THEN
819             j = NF90_REAL8
820          ELSE
[257]821             WRITE ( message_string, * ) 'illegal netcdf precision: ',  &
822                                         'netcdf_precision(', i, ')="', &
823                                         TRIM( netcdf_precision(i) ),'"'
[1783]824             CALL message( 'netcdf_define_header', 'PA0242', 1, 2, 0, 6, 0 )
[1]825          ENDIF
826
827          SELECT CASE ( var )
828             CASE ( 'xy' )
829                nc_precision(1) = j
830             CASE ( 'xz' )
831                nc_precision(2) = j
832             CASE ( 'yz' )
833                nc_precision(3) = j
834             CASE ( '2d' )
835                nc_precision(1:3) = j
836             CASE ( '3d' )
837                nc_precision(4) = j
838             CASE ( 'pr' )
839                nc_precision(5) = j
840             CASE ( 'ts' )
841                nc_precision(6) = j
842             CASE ( 'sp' )
843                nc_precision(7) = j
844             CASE ( 'prt' )
845                nc_precision(8) = j
[410]846             CASE ( 'masks' )
847                nc_precision(11) = j
[1957]848             CASE ( 'fl' )
849                nc_precision(9) = j
[1]850             CASE ( 'all' )
851                nc_precision    = j
852
853             CASE DEFAULT
[2932]854                WRITE ( message_string, * ) 'unknown variable in ' //          &
855                                  'initialization_parameters ',                & 
856                                  'assignment: netcdf_precision(', i, ')="',   &
[257]857                                            TRIM( netcdf_precision(i) ),'"'
[1783]858                CALL message( 'netcdf_define_header', 'PA0243', 1, 2, 0, 6, 0 )
[1]859
860          END SELECT
861
862          i = i + 1
[410]863          IF ( i > 50 )  EXIT
[1]864       ENDDO
865
[1783]866!
867!--    Check for allowed parameter range
868       IF ( netcdf_deflate < 0  .OR.  netcdf_deflate > 9 )  THEN
869          WRITE ( message_string, '(A,I3,A)' ) 'netcdf_deflate out of ' //     &
[3046]870                                      'range & given value: ', netcdf_deflate, &
[1783]871                                      ', allowed range: 0-9'
872          CALL message( 'netcdf_define_header', 'PA0355', 2, 2, 0, 6, 0 )
873       ENDIF
874!
875!--    Data compression does not work with parallel NetCDF/HDF5
876       IF ( netcdf_deflate > 0  .AND.  netcdf_data_format /= 3 )  THEN
877          message_string = 'netcdf_deflate reset to 0'
878          CALL message( 'netcdf_define_header', 'PA0356', 0, 1, 0, 6, 0 )
879
880          netcdf_deflate = 0
881       ENDIF
882
[1]883       init_netcdf = .TRUE.
884
885    ENDIF
886
887!
[3459]888!-- Convert coord_ref_sys into vector (used for lat/lon calculation)
889    crs_list = (/ coord_ref_sys%semi_major_axis,                  &
890                  coord_ref_sys%inverse_flattening,               &
891                  coord_ref_sys%longitude_of_prime_meridian,      &
892                  coord_ref_sys%longitude_of_central_meridian,    &
893                  coord_ref_sys%scale_factor_at_central_meridian, &
894                  coord_ref_sys%latitude_of_projection_origin,    &
895                  coord_ref_sys%false_easting,                    &
896                  coord_ref_sys%false_northing /)
897
898!
[1]899!-- Determine the mode to be processed
900    IF ( extend )  THEN
901       mode = callmode // '_ext'
902    ELSE
903       mode = callmode // '_new'
904    ENDIF
905
906!
[3045]907!-- Select the mode to be processed. Possibilities are 3d, ma (mask), xy, xz,
908!-- yz, pr (profiles), ps (particle timeseries), fl (flight data), ts
909!-- (timeseries) or sp (spectra)
[1]910    SELECT CASE ( mode )
911
[410]912       CASE ( 'ma_new' )
913
914!
915!--       decompose actual parameter file_id (=formal parameter av) into
916!--       mid and av
917          file_id = av
[564]918          IF ( file_id <= 200+max_masks )  THEN
919             mid = file_id - 200
[410]920             av = 0
921          ELSE
[564]922             mid = file_id - (200+max_masks)
[410]923             av = 1
924          ENDIF
925
926!
927!--       Define some global attributes of the dataset
928          IF ( av == 0 )  THEN
[3529]929             CALL netcdf_create_global_atts( id_set_mask(mid,av), 'podsmasked', TRIM( run_description_header ), 464 )
[410]930             time_average_text = ' '
931          ELSE
[3529]932             CALL netcdf_create_global_atts( id_set_mask(mid,av), 'podsmasked', TRIM( run_description_header ), 464 )
[410]933             WRITE ( time_average_text,'(F7.1,'' s avg'')' )  averaging_interval
[3529]934             nc_stat = NF90_PUT_ATT( id_set_mask(mid,av), NF90_GLOBAL, 'time_avg',   &
935                                     TRIM( time_average_text ) )
[1783]936             CALL netcdf_handle_error( 'netcdf_define_header', 466 )
[410]937          ENDIF
938
939!
940!--       Define time coordinate for volume data (unlimited dimension)
[1783]941          CALL netcdf_create_dim( id_set_mask(mid,av), 'time', NF90_UNLIMITED, &
942                                  id_dim_time_mask(mid,av), 467 )
943          CALL netcdf_create_var( id_set_mask(mid,av),                         &
944                                  (/ id_dim_time_mask(mid,av) /), 'time',      &
945                                  NF90_DOUBLE, id_var_time_mask(mid,av),       &
[3529]946                                 'seconds since '//TRIM(init_model%origin_time), 'time', 468, 469, 000 )
947          CALL netcdf_create_att( id_set_mask(mid,av), id_var_time_mask(mid,av), 'standard_name', 'time', 000)
948          CALL netcdf_create_att( id_set_mask(mid,av), id_var_time_mask(mid,av), 'axis', 'T', 000)
949
[410]950!
951!--       Define spatial dimensions and coordinates:
[3435]952          IF ( mask_surface(mid) )  THEN
[410]953!
[3435]954!--          In case of terrain-following output, the vertical dimensions are
955!--          indices, not meters
956             CALL netcdf_create_dim( id_set_mask(mid,av), 'ku_above_surf',     &
957                                     mask_size(mid,3), id_dim_zu_mask(mid,av), &
958                                     470 )
959             CALL netcdf_create_var( id_set_mask(mid,av),                      &
960                                     (/ id_dim_zu_mask(mid,av) /),             &
961                                     'ku_above_surf',                          &
962                                     NF90_DOUBLE, id_var_zu_mask(mid,av),      &
963                                     '1', 'grid point above terrain',          &
964                                     471, 472, 000 )
965             CALL netcdf_create_dim( id_set_mask(mid,av), 'kw_above_surf',     &
966                                     mask_size(mid,3), id_dim_zw_mask(mid,av), &
967                                     473 )
968             CALL netcdf_create_var( id_set_mask(mid,av),                      &
969                                     (/ id_dim_zw_mask(mid,av) /),             &
970                                     'kw_above_surf',                          &
971                                     NF90_DOUBLE, id_var_zw_mask(mid,av),      &
972                                    '1', 'grid point above terrain',           &
973                                    474, 475, 000 )
974          ELSE
[410]975!
[3435]976!--          Define vertical coordinate grid (zu grid)
977             CALL netcdf_create_dim( id_set_mask(mid,av), 'zu_3d',             &
978                                     mask_size(mid,3), id_dim_zu_mask(mid,av), &
979                                     470 )
980             CALL netcdf_create_var( id_set_mask(mid,av),                      &
981                                     (/ id_dim_zu_mask(mid,av) /), 'zu_3d',    &
982                                     NF90_DOUBLE, id_var_zu_mask(mid,av),      &
983                                     'meters', '', 471, 472, 000 )
984!
985!--          Define vertical coordinate grid (zw grid)
986             CALL netcdf_create_dim( id_set_mask(mid,av), 'zw_3d',             &
987                                     mask_size(mid,3), id_dim_zw_mask(mid,av), &
988                                     473 )
989             CALL netcdf_create_var( id_set_mask(mid,av),                      &
990                                     (/ id_dim_zw_mask(mid,av) /), 'zw_3d',    &
991                                     NF90_DOUBLE, id_var_zw_mask(mid,av),      &
992                                    'meters', '', 474, 475, 000 )
993          ENDIF
994!
[410]995!--       Define x-axis (for scalar position)
[1783]996          CALL netcdf_create_dim( id_set_mask(mid,av), 'x', mask_size(mid,1),  &
997                                  id_dim_x_mask(mid,av), 476 )
998          CALL netcdf_create_var( id_set_mask(mid,av),                         &
999                                  (/ id_dim_x_mask(mid,av) /), 'x',            &
1000                                  NF90_DOUBLE, id_var_x_mask(mid,av),          &
1001                                  'meters', '', 477, 478, 000 )
[410]1002!
1003!--       Define x-axis (for u position)
[1783]1004          CALL netcdf_create_dim( id_set_mask(mid,av), 'xu', mask_size(mid,1), &
1005                                  id_dim_xu_mask(mid,av), 479 )
1006          CALL netcdf_create_var( id_set_mask(mid,av),                         &
1007                                  (/ id_dim_xu_mask(mid,av) /), 'xu',          &
1008                                  NF90_DOUBLE, id_var_xu_mask(mid,av),         &
1009                                  'meters', '', 480, 481, 000 )
[410]1010!
1011!--       Define y-axis (for scalar position)
[1783]1012          CALL netcdf_create_dim( id_set_mask(mid,av), 'y', mask_size(mid,2),  &
1013                                  id_dim_y_mask(mid,av), 482 )
1014          CALL netcdf_create_var( id_set_mask(mid,av),                         &
1015                                  (/ id_dim_y_mask(mid,av) /), 'y',            &
1016                                  NF90_DOUBLE, id_var_y_mask(mid,av),          &
1017                                  'meters', '', 483, 484, 000 )
[410]1018!
1019!--       Define y-axis (for v position)
[1783]1020          CALL netcdf_create_dim( id_set_mask(mid,av), 'yv', mask_size(mid,2), &
1021                                  id_dim_yv_mask(mid,av), 485 )
1022          CALL netcdf_create_var( id_set_mask(mid,av),                         &
1023                                  (/ id_dim_yv_mask(mid,av) /),                &
1024                                  'yv', NF90_DOUBLE, id_var_yv_mask(mid,av),   &
1025                                  'meters', '', 486, 487, 000 )
[410]1026!
[3529]1027!--       Define UTM and geographic coordinates
1028          CALL define_geo_coordinates( id_set_mask(mid,av),               &
1029                  (/ id_dim_x_mask(mid,av), id_dim_xu_mask(mid,av) /),    &
1030                  (/ id_dim_y_mask(mid,av), id_dim_yv_mask(mid,av) /),    &
1031                  id_var_eutm_mask(mid,av,:), id_var_nutm_mask(mid,av,:), &
1032                  id_var_lat_mask(mid,av,:), id_var_lon_mask(mid,av,:)    )
[3421]1033!
[3459]1034!--       Define coordinate-reference system
1035          CALL netcdf_create_crs( id_set_mask(mid,av), 000 )
1036!
[410]1037!--       In case of non-flat topography define 2d-arrays containing the height
[2232]1038!--       information. Only for parallel netcdf output.
1039          IF ( TRIM( topography ) /= 'flat'  .AND.                             &
1040               netcdf_data_format > 4 )  THEN
[410]1041!
1042!--          Define zusi = zu(nzb_s_inner)
[1783]1043             CALL netcdf_create_var( id_set_mask(mid,av),                      &
1044                                     (/ id_dim_x_mask(mid,av),                 &
1045                                        id_dim_y_mask(mid,av) /), 'zusi',      &
1046                                     NF90_DOUBLE, id_var_zusi_mask(mid,av),    &
1047                                     'meters', 'zu(nzb_s_inner)', 488, 489,    &
1048                                     490 )
[410]1049!             
1050!--          Define zwwi = zw(nzb_w_inner)
[1783]1051             CALL netcdf_create_var( id_set_mask(mid,av),                      &
1052                                     (/ id_dim_x_mask(mid,av),                 &
1053                                        id_dim_y_mask(mid,av) /), 'zwwi',      &
1054                                     NF90_DOUBLE, id_var_zwwi_mask(mid,av),    &
1055                                     'meters', 'zw(nzb_w_inner)', 491, 492,    &
1056                                     493 )
[410]1057          ENDIF             
[1551]1058 
1059          IF ( land_surface )  THEN
1060!
1061!--          Define vertical coordinate grid (zw grid)
[1783]1062             CALL netcdf_create_dim( id_set_mask(mid,av), 'zs_3d',             &
1063                                     mask_size(mid,3), id_dim_zs_mask(mid,av), &
1064                                     536 )
1065             CALL netcdf_create_var( id_set_mask(mid,av),                      &
1066                                     (/ id_dim_zs_mask(mid,av) /), 'zs_3d',    &
1067                                     NF90_DOUBLE, id_var_zs_mask(mid,av),      &
1068                                     'meters', '', 537, 555, 000 )
[1551]1069          ENDIF
1070
[410]1071!
1072!--       Define the variables
1073          var_list = ';'
1074          i = 1
1075
1076          DO WHILE ( domask(mid,av,i)(1:1) /= ' ' )
1077!
[2007]1078!--          Temporary solution to account for data output within the new urban
1079!--          surface model (urban_surface_mod.f90), see also SELECT CASE ( trimvar )
1080             trimvar = TRIM( domask(mid,av,i) )
[2011]1081             IF ( urban_surface  .AND.  trimvar(1:4) == 'usm_' )  THEN
[2007]1082                trimvar = 'usm_output'
1083             ENDIF
1084!
[410]1085!--          Check for the grid
[1980]1086             found = .FALSE.
[2007]1087             SELECT CASE ( trimvar )
[410]1088!
1089!--             Most variables are defined on the scalar grid
[3421]1090                CASE ( 'e', 'nc', 'nr', 'p', 'pc', 'pr', 'prr',                &
[2292]1091                       'q', 'qc', 'ql', 'ql_c', 'ql_v', 'ql_vp', 'qr', 'qv',   &
[3421]1092                       's', 'theta', 'thetal', 'thetav' )
[410]1093
1094                   grid_x = 'x'
1095                   grid_y = 'y'
1096                   grid_z = 'zu'
1097!
1098!--             u grid
1099                CASE ( 'u' )
1100
1101                   grid_x = 'xu'
1102                   grid_y = 'y'
1103                   grid_z = 'zu'
1104!
1105!--             v grid
1106                CASE ( 'v' )
1107
1108                   grid_x = 'x'
1109                   grid_y = 'yv'
1110                   grid_z = 'zu'
1111!
1112!--             w grid
[1976]1113                CASE ( 'w' )
[410]1114
1115                   grid_x = 'x'
1116                   grid_y = 'y'
1117                   grid_z = 'zw'
1118
[2007]1119!             
[3294]1120!--             Block of urban surface model outputs
[2007]1121                CASE ( 'usm_output' )
[1551]1122
[3294]1123                   CALL usm_define_netcdf_grid( domask( mid,av,i), found,      &
[2007]1124                                                        grid_x, grid_y, grid_z )
1125
[410]1126                CASE DEFAULT
[3294]1127!
[3467]1128!--                Check for quantities defined in other modules                                                       
[3435]1129                   CALL tcm_define_netcdf_grid( domask( mid,av,i), found,      &
1130                                                        grid_x, grid_y, grid_z )
1131
[3294]1132                   IF ( .NOT. found  .AND.  air_chemistry )  THEN
1133                      CALL chem_define_netcdf_grid( domask(mid,av,i), found,   &
1134                                                    grid_x, grid_y, grid_z )
1135                   ENDIF
[1972]1136
[3294]1137                   IF ( .NOT. found  .AND.  gust_module_enabled )  THEN
1138                      CALL gust_define_netcdf_grid( domask(mid,av,i), found,   &
1139                                                    grid_x, grid_y, grid_z )
1140                   ENDIF
[2696]1141
[1972]1142                   IF ( land_surface )  THEN
1143                      CALL lsm_define_netcdf_grid( domask(mid,av,i), found,    &
1144                                                   grid_x, grid_y, grid_z )
1145                   ENDIF
[3294]1146
1147                   IF ( .NOT. found  .AND.  ocean_mode )  THEN
1148                      CALL ocean_define_netcdf_grid( domask(mid,av,i), found,  &
1149                                                     grid_x, grid_y, grid_z )
1150                   ENDIF
1151
[2696]1152                   IF ( .NOT. found  .AND.  plant_canopy )  THEN
[2209]1153                      CALL pcm_define_netcdf_grid( domask(mid,av,i), found,    &
1154                                                   grid_x, grid_y, grid_z )
1155                   ENDIF
[1972]1156
[1976]1157                   IF ( .NOT. found  .AND.  radiation )  THEN
1158                      CALL radiation_define_netcdf_grid( domask(mid,av,i),     &
1159                                                         found, grid_x, grid_y,&
1160                                                         grid_z )
1161                   ENDIF
[3337]1162!
[3467]1163!--                Check for SALSA quantities
1164                   IF ( .NOT. found  .AND.  salsa )  THEN
1165                      CALL salsa_define_netcdf_grid( domask(mid,av,i), found,  &
1166                                                     grid_x, grid_y, grid_z )
[3582]1167                   ENDIF                                   
[3467]1168!
[3294]1169!--                Now check for user-defined quantities
[3701]1170                   IF ( .NOT. found  .AND.  user_module_enabled )  THEN
[1972]1171                      CALL user_define_netcdf_grid( domask(mid,av,i), found,   &
1172                                                    grid_x, grid_y, grid_z )
1173                   ENDIF
[2007]1174                                                 
[1783]1175                   IF ( .NOT. found )  THEN
1176                      WRITE ( message_string, * ) 'no grid defined for',       &
1177                           ' variable ', TRIM( domask(mid,av,i) )
1178                      CALL message( 'define_netcdf_header', 'PA0244', 0, 1, 0, &
1179                                    6, 0 )
1180                   ENDIF
1181
[410]1182             END SELECT
1183
1184!
1185!--          Select the respective dimension ids
1186             IF ( grid_x == 'x' )  THEN
1187                id_x = id_dim_x_mask(mid,av)
1188             ELSEIF ( grid_x == 'xu' )  THEN
1189                id_x = id_dim_xu_mask(mid,av)
1190             ENDIF
1191
1192             IF ( grid_y == 'y' )  THEN
1193                id_y = id_dim_y_mask(mid,av)
1194             ELSEIF ( grid_y == 'yv' )  THEN
1195                id_y = id_dim_yv_mask(mid,av)
1196             ENDIF
1197
1198             IF ( grid_z == 'zu' )  THEN
1199                id_z = id_dim_zu_mask(mid,av)
1200             ELSEIF ( grid_z == 'zw' )  THEN
1201                id_z = id_dim_zw_mask(mid,av)
[1551]1202             ELSEIF ( grid_z == "zs" )  THEN
1203                id_z = id_dim_zs_mask(mid,av)
[410]1204             ENDIF
1205
1206!
1207!--          Define the grid
[1783]1208             CALL netcdf_create_var( id_set_mask(mid,av), (/ id_x, id_y, id_z, &
1209                                     id_dim_time_mask(mid,av) /),              &
1210                                     domask(mid,av,i), nc_precision(11),       &
1211                                     id_var_domask(mid,av,i),                  &
1212                                     TRIM( domask_unit(mid,av,i) ),            &
[2696]1213                                     domask(mid,av,i), 494, 495, 496, .TRUE. )
[410]1214
1215             var_list = TRIM( var_list ) // TRIM( domask(mid,av,i) ) // ';'
1216
1217             i = i + 1
1218
1219          ENDDO
1220
1221!
1222!--       No arrays to output
1223          IF ( i == 1 )  RETURN
1224
1225!
1226!--       Write the list of variables as global attribute (this is used by
1227!--       restart runs and by combine_plot_fields)
1228          nc_stat = NF90_PUT_ATT( id_set_mask(mid,av), NF90_GLOBAL, &
1229                                  'VAR_LIST', var_list )
[1783]1230          CALL netcdf_handle_error( 'netcdf_define_header', 497 )
[410]1231
1232!
[1031]1233!--       Leave netCDF define mode
[410]1234          nc_stat = NF90_ENDDEF( id_set_mask(mid,av) )
[1783]1235          CALL netcdf_handle_error( 'netcdf_define_header', 498 )
[410]1236
1237!
1238!--       Write data for x (shifted by +dx/2) and xu axis
1239          ALLOCATE( netcdf_data(mask_size(mid,1)) )
1240
[1353]1241          netcdf_data = ( mask_i_global(mid,:mask_size(mid,1)) + 0.5_wp ) * dx
[410]1242
1243          nc_stat = NF90_PUT_VAR( id_set_mask(mid,av), id_var_x_mask(mid,av), &
1244                                  netcdf_data, start = (/ 1 /),               &
1245                                  count = (/ mask_size(mid,1) /) )
[1783]1246          CALL netcdf_handle_error( 'netcdf_define_header', 499 )
[410]1247
1248          netcdf_data = mask_i_global(mid,:mask_size(mid,1)) * dx
1249
1250          nc_stat = NF90_PUT_VAR( id_set_mask(mid,av), id_var_xu_mask(mid,av),&
1251                                  netcdf_data, start = (/ 1 /),               &
1252                                  count = (/ mask_size(mid,1) /) )
[1783]1253          CALL netcdf_handle_error( 'netcdf_define_header', 500 )
[410]1254
1255          DEALLOCATE( netcdf_data )
1256
1257!
1258!--       Write data for y (shifted by +dy/2) and yv axis
1259          ALLOCATE( netcdf_data(mask_size(mid,2)) )
1260
[1353]1261          netcdf_data = ( mask_j_global(mid,:mask_size(mid,2)) + 0.5_wp ) * dy
[410]1262
1263          nc_stat = NF90_PUT_VAR( id_set_mask(mid,av), id_var_y_mask(mid,av), &
1264                                  netcdf_data, start = (/ 1 /),               &
1265                                  count = (/ mask_size(mid,2) /))
[1783]1266          CALL netcdf_handle_error( 'netcdf_define_header', 501 )
[410]1267
1268          netcdf_data = mask_j_global(mid,:mask_size(mid,2)) * dy
1269
1270          nc_stat = NF90_PUT_VAR( id_set_mask(mid,av), id_var_yv_mask(mid,av), &
1271                                  netcdf_data, start = (/ 1 /),    &
1272                                  count = (/ mask_size(mid,2) /))
[1783]1273          CALL netcdf_handle_error( 'netcdf_define_header', 502 )
[410]1274
1275          DEALLOCATE( netcdf_data )
1276
1277!
[3421]1278!--       Write UTM coordinates
1279          IF ( init_model%rotation_angle == 0.0_wp )  THEN
1280!
1281!--          1D in case of no rotation
1282             cos_ra = COS( init_model%rotation_angle * pi / 180.0_wp )
1283!
1284!--          x coordinates
1285             ALLOCATE( netcdf_data(mask_size(mid,1)) )
1286             DO  k = 0, 2
1287!           
1288!--             Scalar grid points
1289                IF ( k == 0 )  THEN
1290                   shift_x = 0.5
1291!           
1292!--             u grid points
1293                ELSEIF ( k == 1 )  THEN
1294                   shift_x = 0.0
1295!           
1296!--             v grid points
1297                ELSEIF ( k == 2 )  THEN
1298                   shift_x = 0.5
1299                ENDIF
1300
1301                netcdf_data = init_model%origin_x + cos_ra                     &
1302                       * ( mask_i_global(mid,:mask_size(mid,1)) + shift_x ) * dx
1303
1304                nc_stat = NF90_PUT_VAR( id_set_mask(mid,av), &
1305                                        id_var_eutm_mask(mid,av,k), &
1306                                        netcdf_data, start = (/ 1 /), &
1307                                        count = (/ mask_size(mid,1) /) )
1308                CALL netcdf_handle_error( 'netcdf_define_header', 555 )
1309
1310             ENDDO
1311             DEALLOCATE( netcdf_data )
1312!
1313!--          y coordinates
1314             ALLOCATE( netcdf_data(mask_size(mid,2)) )
1315             DO  k = 0, 2
1316!
1317!--             Scalar grid points
1318                IF ( k == 0 )  THEN
1319                   shift_y = 0.5
1320!
1321!--             u grid points
1322                ELSEIF ( k == 1 )  THEN
1323                   shift_y = 0.5
1324!
1325!--             v grid points
1326                ELSEIF ( k == 2 )  THEN
1327                   shift_y = 0.0
1328                ENDIF
1329
1330                netcdf_data = init_model%origin_y + cos_ra                     &
1331                       * ( mask_j_global(mid,:mask_size(mid,2)) + shift_y ) * dy
1332
1333                nc_stat = NF90_PUT_VAR( id_set_mask(mid,av), &
1334                                        id_var_nutm_mask(mid,av,k), &
1335                                        netcdf_data, start = (/ 1 /), &
1336                                        count = (/ mask_size(mid,2) /) )
1337                CALL netcdf_handle_error( 'netcdf_define_header', 556 )
1338
1339             ENDDO
1340             DEALLOCATE( netcdf_data )
1341
1342          ELSE
1343!
1344!--          2D in case of rotation
1345             ALLOCATE( netcdf_data_2d(mask_size(mid,1),mask_size(mid,2)) )
1346             cos_ra = COS( init_model%rotation_angle * pi / 180.0_wp )
1347             sin_ra = SIN( init_model%rotation_angle * pi / 180.0_wp )
1348
1349             DO  k = 0, 2
1350!           
1351!--            Scalar grid points
1352               IF ( k == 0 )  THEN
1353                  shift_x = 0.5 ; shift_y = 0.5
1354!           
1355!--            u grid points
1356               ELSEIF ( k == 1 )  THEN
1357                  shift_x = 0.0 ; shift_y = 0.5
1358!           
1359!--            v grid points
1360               ELSEIF ( k == 2 )  THEN
1361                  shift_x = 0.5 ; shift_y = 0.0
1362               ENDIF
1363
1364               DO  j = 1, mask_size(mid,2)
1365                  DO  i = 1, mask_size(mid,1)
1366                     netcdf_data_2d(i,j) = init_model%origin_x                 &
1367                           + cos_ra * ( mask_i_global(mid,i) + shift_x ) * dx  &
1368                           + sin_ra * ( mask_j_global(mid,j) + shift_y ) * dy
1369                  ENDDO
1370               ENDDO
1371
1372               nc_stat = NF90_PUT_VAR( id_set_mask(mid,av), &
1373                                       id_var_eutm_mask(mid,av,k), &
1374                                       netcdf_data_2d, start = (/ 1, 1 /), &
1375                                       count = (/ mask_size(mid,1), &
1376                                                  mask_size(mid,2) /) )
1377               CALL netcdf_handle_error( 'netcdf_define_header', 555 )
1378
1379               DO  j = 1, mask_size(mid,2)
1380                  DO  i = 1, mask_size(mid,1)
1381                     netcdf_data_2d(i,j) = init_model%origin_y                 &
1382                           - sin_ra * ( mask_i_global(mid,i) + shift_x ) * dx  &
1383                           + cos_ra * ( mask_j_global(mid,j) + shift_y ) * dy
1384                  ENDDO
1385               ENDDO
1386             
1387               nc_stat = NF90_PUT_VAR( id_set_mask(mid,av), &
1388                                       id_var_nutm_mask(mid,av,k), &
1389                                       netcdf_data_2d, start = (/ 1, 1 /), &
1390                                       count = (/ mask_size(mid,1), &
1391                                                  mask_size(mid,2) /) )
1392               CALL netcdf_handle_error( 'netcdf_define_header', 556 )
1393             
1394             ENDDO
1395             DEALLOCATE( netcdf_data_2d )
1396          ENDIF
[3459]1397!
1398!--       Write lon and lat data.
1399          ALLOCATE( lat(mask_size(mid,1),mask_size(mid,2)) )
1400          ALLOCATE( lon(mask_size(mid,1),mask_size(mid,2)) )
1401          cos_ra = COS( init_model%rotation_angle * pi / 180.0_wp )
1402          sin_ra = SIN( init_model%rotation_angle * pi / 180.0_wp )
[3421]1403
[3459]1404          DO  k = 0, 2
1405!               
1406!--          Scalar grid points
1407             IF ( k == 0 )  THEN
1408                shift_x = 0.5 ; shift_y = 0.5
1409!               
1410!--          u grid points
1411             ELSEIF ( k == 1 )  THEN
1412                shift_x = 0.0 ; shift_y = 0.5
1413!               
1414!--          v grid points
1415             ELSEIF ( k == 2 )  THEN
1416                shift_x = 0.5 ; shift_y = 0.0
1417             ENDIF
1418
1419             DO  j = 1, mask_size(mid,2)
1420                DO  i = 1, mask_size(mid,1)
1421                   eutm = init_model%origin_x                               &
1422                        + cos_ra * ( mask_i_global(mid,i) + shift_x ) * dx  &
1423                        + sin_ra * ( mask_j_global(mid,j) + shift_y ) * dy
1424                   nutm = init_model%origin_y                               &
1425                        - sin_ra * ( mask_i_global(mid,i) + shift_x ) * dx  &
1426                        + cos_ra * ( mask_j_global(mid,j) + shift_y ) * dy
1427
1428                   CALL  convert_utm_to_geographic( crs_list,          &
1429                                                    eutm, nutm,        &
1430                                                    lon(i,j), lat(i,j) )
1431                ENDDO
1432             ENDDO
1433
1434             nc_stat = NF90_PUT_VAR( id_set_mask(mid,av),           &
1435                                     id_var_lon_mask(mid,av,k),     &
1436                                     lon, start = (/ 1, 1 /),       &
1437                                     count = (/ mask_size(mid,1),   &
1438                                                mask_size(mid,2) /) )
1439             CALL netcdf_handle_error( 'netcdf_define_header', 556 )
1440
1441             nc_stat = NF90_PUT_VAR( id_set_mask(mid,av),           &
1442                                     id_var_lat_mask(mid,av,k),     &
1443                                     lat, start = (/ 1, 1 /),       &
1444                                     count = (/ mask_size(mid,1),   &
1445                                                mask_size(mid,2) /) )
1446             CALL netcdf_handle_error( 'netcdf_define_header', 556 )
1447          ENDDO
1448
1449          DEALLOCATE( lat )
1450          DEALLOCATE( lon )
[3421]1451!
[410]1452!--       Write zu and zw data (vertical axes)
1453          ALLOCATE( netcdf_data(mask_size(mid,3)) )
1454
[3435]1455          IF ( mask_surface(mid) )  THEN
[410]1456
[3435]1457             netcdf_data = mask_k_global(mid,:mask_size(mid,3))
[410]1458
[3435]1459             nc_stat = NF90_PUT_VAR( id_set_mask(mid,av), id_var_zu_mask(mid,av), &
1460                                     netcdf_data, start = (/ 1 /), &
1461                                     count = (/ mask_size(mid,3) /) )
1462             CALL netcdf_handle_error( 'netcdf_define_header', 503 )
[410]1463
[3435]1464             netcdf_data = mask_k_global(mid,:mask_size(mid,3))
[410]1465
[3435]1466             nc_stat = NF90_PUT_VAR( id_set_mask(mid,av), id_var_zw_mask(mid,av), &
1467                                     netcdf_data, start = (/ 1 /), &
1468                                     count = (/ mask_size(mid,3) /) )
1469             CALL netcdf_handle_error( 'netcdf_define_header', 504 )
1470
1471          ELSE
1472
1473             netcdf_data = zu( mask_k_global(mid,:mask_size(mid,3)) )
1474
1475             nc_stat = NF90_PUT_VAR( id_set_mask(mid,av), id_var_zu_mask(mid,av), &
1476                                     netcdf_data, start = (/ 1 /), &
1477                                     count = (/ mask_size(mid,3) /) )
1478             CALL netcdf_handle_error( 'netcdf_define_header', 503 )
1479
1480             netcdf_data = zw( mask_k_global(mid,:mask_size(mid,3)) )
1481
1482             nc_stat = NF90_PUT_VAR( id_set_mask(mid,av), id_var_zw_mask(mid,av), &
1483                                     netcdf_data, start = (/ 1 /), &
1484                                     count = (/ mask_size(mid,3) /) )
1485             CALL netcdf_handle_error( 'netcdf_define_header', 504 )
1486
1487          ENDIF
1488
[410]1489          DEALLOCATE( netcdf_data )
1490
1491!
1492!--       In case of non-flat topography write height information
[2232]1493          IF ( TRIM( topography ) /= 'flat'  .AND.                             &
1494               netcdf_data_format > 4 )  THEN
[410]1495
[2232]1496             ALLOCATE( netcdf_data_2d(mask_size_l(mid,1),mask_size_l(mid,2)) )
1497             netcdf_data_2d = zu_s_inner( mask_i(mid,:mask_size_l(mid,1)),     &
1498                                          mask_j(mid,:mask_size_l(mid,2)) )
[410]1499
[2232]1500             nc_stat = NF90_PUT_VAR( id_set_mask(mid,av),                      &
1501                                     id_var_zusi_mask(mid,av),                 &
1502                                     netcdf_data_2d,                           &
1503                                     start = (/ 1, 1 /),                       &
1504                                     count = (/ mask_size_l(mid,1),            &
1505                                                mask_size_l(mid,2) /) )
[1783]1506             CALL netcdf_handle_error( 'netcdf_define_header', 505 )
[410]1507
[2232]1508             netcdf_data_2d = zw_w_inner( mask_i(mid,:mask_size_l(mid,1)),     &
1509                                          mask_j(mid,:mask_size_l(mid,2)) )
[410]1510
[2232]1511             nc_stat = NF90_PUT_VAR( id_set_mask(mid,av),                      &
1512                                     id_var_zwwi_mask(mid,av),                 &
1513                                     netcdf_data_2d,                           &
1514                                     start = (/ 1, 1 /),                       &
1515                                     count = (/ mask_size_l(mid,1),            &
1516                                                mask_size_l(mid,2) /) )
[1783]1517             CALL netcdf_handle_error( 'netcdf_define_header', 506 )
[410]1518
1519             DEALLOCATE( netcdf_data_2d )
1520
1521          ENDIF
[1551]1522
1523          IF ( land_surface )  THEN
[410]1524!
[1551]1525!--          Write zs data (vertical axes for soil model), use negative values
1526!--          to indicate soil depth
1527             ALLOCATE( netcdf_data(mask_size(mid,3)) )
1528
1529             netcdf_data = zs( mask_k_global(mid,:mask_size(mid,3)) )
1530
1531             nc_stat = NF90_PUT_VAR( id_set_mask(mid,av), id_var_zs_mask(mid,av), &
1532                                     netcdf_data, start = (/ 1 /), &
1533                                     count = (/ mask_size(mid,3) /) )
[1783]1534             CALL netcdf_handle_error( 'netcdf_define_header', 538 )
[1551]1535
1536             DEALLOCATE( netcdf_data )
1537
1538          ENDIF
1539
1540!
[410]1541!--       restore original parameter file_id (=formal parameter av) into av
1542          av = file_id
1543
1544
1545       CASE ( 'ma_ext' )
1546
1547!
1548!--       decompose actual parameter file_id (=formal parameter av) into
1549!--       mid and av
1550          file_id = av
[564]1551          IF ( file_id <= 200+max_masks )  THEN
1552             mid = file_id - 200
[410]1553             av = 0
1554          ELSE
[564]1555             mid = file_id - (200+max_masks)
[410]1556             av = 1
1557          ENDIF
1558
1559!
1560!--       Get the list of variables and compare with the actual run.
1561!--       First var_list_old has to be reset, since GET_ATT does not assign
1562!--       trailing blanks.
1563          var_list_old = ' '
1564          nc_stat = NF90_GET_ATT( id_set_mask(mid,av), NF90_GLOBAL, 'VAR_LIST',&
1565                                  var_list_old )
[1783]1566          CALL netcdf_handle_error( 'netcdf_define_header', 507 )
[410]1567
1568          var_list = ';'
1569          i = 1
1570          DO WHILE ( domask(mid,av,i)(1:1) /= ' ' )
1571             var_list = TRIM(var_list) // TRIM( domask(mid,av,i) ) // ';'
1572             i = i + 1
1573          ENDDO
1574
1575          IF ( av == 0 )  THEN
1576             var = '(mask)'
1577          ELSE
1578             var = '(mask_av)'
1579          ENDIF
1580
1581          IF ( TRIM( var_list ) /= TRIM( var_list_old ) )  THEN
[3045]1582             WRITE ( message_string, * ) 'netCDF file for ', TRIM( var ),       &
1583                  ' data for mask', mid, ' from previous run found,',           &
[3046]1584                  '&but this file cannot be extended due to variable ',         &
1585                  'mismatch.&New file is created instead.'
[564]1586             CALL message( 'define_netcdf_header', 'PA0335', 0, 1, 0, 6, 0 )
[410]1587             extend = .FALSE.
1588             RETURN
1589          ENDIF
1590
1591!
1592!--       Get and compare the number of vertical gridpoints
[1596]1593          nc_stat = NF90_INQ_VARID( id_set_mask(mid,av), 'zu_3d', &
[410]1594                                    id_var_zu_mask(mid,av) )
[1783]1595          CALL netcdf_handle_error( 'netcdf_define_header', 508 )
[410]1596
1597          nc_stat = NF90_INQUIRE_VARIABLE( id_set_mask(mid,av),     &
1598                                           id_var_zu_mask(mid,av),  &
1599                                           dimids = id_dim_zu_mask_old )
[1783]1600          CALL netcdf_handle_error( 'netcdf_define_header', 509 )
[410]1601          id_dim_zu_mask(mid,av) = id_dim_zu_mask_old(1)
1602
[3045]1603          nc_stat = NF90_INQUIRE_DIMENSION( id_set_mask(mid,av),               &
1604                                            id_dim_zu_mask(mid,av),            &
[410]1605                                            len = nz_old )
[1783]1606          CALL netcdf_handle_error( 'netcdf_define_header', 510 )
[410]1607
1608          IF ( mask_size(mid,3) /= nz_old )  THEN
[3045]1609             WRITE ( message_string, * ) 'netCDF file for ', TRIM( var ),      &
[3046]1610                  '&data for mask', mid, ' from previous run found,',          &
[3045]1611                  ' but this file cannot be extended due to mismatch in ',     &
1612                  ' number of vertical grid points.',                          &
[3046]1613                  '&New file is created instead.'
[564]1614             CALL message( 'define_netcdf_header', 'PA0336', 0, 1, 0, 6, 0 )
[410]1615             extend = .FALSE.
1616             RETURN
1617          ENDIF
1618
1619!
1620!--       Get the id of the time coordinate (unlimited coordinate) and its
1621!--       last index on the file. The next time level is plmask..count+1.
1622!--       The current time must be larger than the last output time
1623!--       on the file.
[3045]1624          nc_stat = NF90_INQ_VARID( id_set_mask(mid,av), 'time',               &
[410]1625                                    id_var_time_mask(mid,av) )
[1783]1626          CALL netcdf_handle_error( 'netcdf_define_header', 511 )
[410]1627
[3045]1628          nc_stat = NF90_INQUIRE_VARIABLE( id_set_mask(mid,av),                &
1629                                           id_var_time_mask(mid,av),           &
[410]1630                                           dimids = id_dim_time_old )
[1783]1631          CALL netcdf_handle_error( 'netcdf_define_header', 512 )
[410]1632          id_dim_time_mask(mid,av) = id_dim_time_old(1)
1633
[3045]1634          nc_stat = NF90_INQUIRE_DIMENSION( id_set_mask(mid,av),               &
1635                                            id_dim_time_mask(mid,av),          &
[410]1636                                            len = domask_time_count(mid,av) )
[1783]1637          CALL netcdf_handle_error( 'netcdf_define_header', 513 )
[410]1638
[3045]1639          nc_stat = NF90_GET_VAR( id_set_mask(mid,av),                         &
1640                                  id_var_time_mask(mid,av),                    &
1641                                  last_time_coordinate,                        &
1642                                  start = (/ domask_time_count(mid,av) /),     &
[410]1643                                  count = (/ 1 /) )
[1783]1644          CALL netcdf_handle_error( 'netcdf_define_header', 514 )
[410]1645
1646          IF ( last_time_coordinate(1) >= simulated_time )  THEN
[3045]1647             WRITE ( message_string, * ) 'netCDF file for ', TRIM( var ),      &
1648                  ' data for mask', mid, ' from previous run found,',          &
[3046]1649                  '&but this file cannot be extended because the current ',    &
[3045]1650                  'output time is less or equal than the last output time ',   &
[3046]1651                  'on this file.&New file is created instead.'
[564]1652             CALL message( 'define_netcdf_header', 'PA0337', 0, 1, 0, 6, 0 )
[410]1653             domask_time_count(mid,av) = 0
1654             extend = .FALSE.
1655             RETURN
1656          ENDIF
1657
1658!
1659!--       Dataset seems to be extendable.
1660!--       Now get the variable ids.
1661          i = 1
1662          DO WHILE ( domask(mid,av,i)(1:1) /= ' ' )
1663             nc_stat = NF90_INQ_VARID( id_set_mask(mid,av), &
1664                                       TRIM( domask(mid,av,i) ), &
1665                                       id_var_domask(mid,av,i) )
[1783]1666             CALL netcdf_handle_error( 'netcdf_define_header', 515 )
[410]1667             i = i + 1
1668          ENDDO
1669
1670!
1671!--       Update the title attribute on file
1672!--       In order to avoid 'data mode' errors if updated attributes are larger
1673!--       than their original size, NF90_PUT_ATT is called in 'define mode'
1674!--       enclosed by NF90_REDEF and NF90_ENDDEF calls. This implies a possible
1675!--       performance loss due to data copying; an alternative strategy would be
1676!--       to ensure equal attribute size in a job chain. Maybe revise later.
1677          IF ( av == 0 )  THEN
1678             time_average_text = ' '
1679          ELSE
[3045]1680             WRITE (time_average_text, '('', '',F7.1,'' s average'')')         &
[410]1681                                                            averaging_interval
1682          ENDIF
1683          nc_stat = NF90_REDEF( id_set_mask(mid,av) )
[1783]1684          CALL netcdf_handle_error( 'netcdf_define_header', 516 )
[3045]1685          nc_stat = NF90_PUT_ATT( id_set_mask(mid,av), NF90_GLOBAL, 'title',   &
1686                                  TRIM( run_description_header ) //            &
[410]1687                                  TRIM( time_average_text ) )
[1783]1688          CALL netcdf_handle_error( 'netcdf_define_header', 517 )
[410]1689          nc_stat = NF90_ENDDEF( id_set_mask(mid,av) )
[1783]1690          CALL netcdf_handle_error( 'netcdf_define_header', 518 )
[3045]1691          WRITE ( message_string, * ) 'netCDF file for ', TRIM( var ),         &
1692               ' data for mask', mid, ' from previous run found.',             &
[3046]1693               ' &This file will be extended.'
[564]1694          CALL message( 'define_netcdf_header', 'PA0338', 0, 0, 0, 6, 0 )
[410]1695!
1696!--       restore original parameter file_id (=formal parameter av) into av
1697          av = file_id
1698
1699
[1]1700       CASE ( '3d_new' )
1701
1702!
1703!--       Define some global attributes of the dataset
1704          IF ( av == 0 )  THEN
[3529]1705             CALL netcdf_create_global_atts( id_set_3d(av), '3d', TRIM( run_description_header ), 62 )
[1]1706             time_average_text = ' '
1707          ELSE
[3529]1708             CALL netcdf_create_global_atts( id_set_3d(av), '3d_av', TRIM( run_description_header ), 62 )
[1]1709             WRITE ( time_average_text,'(F7.1,'' s avg'')' )  averaging_interval
[3529]1710             nc_stat = NF90_PUT_ATT( id_set_3d(av), NF90_GLOBAL, 'time_avg',   &
[1]1711                                     TRIM( time_average_text ) )
[1783]1712             CALL netcdf_handle_error( 'netcdf_define_header', 63 )
[1]1713          ENDIF
1714
1715!
[1308]1716!--       Define time coordinate for volume data.
1717!--       For parallel output the time dimensions has to be limited, otherwise
1718!--       the performance drops significantly.
1719          IF ( netcdf_data_format < 5 )  THEN
[1783]1720             CALL netcdf_create_dim( id_set_3d(av), 'time', NF90_UNLIMITED,    &
1721                                     id_dim_time_3d(av), 64 )
[1308]1722          ELSE
[1783]1723             CALL netcdf_create_dim( id_set_3d(av), 'time', ntdim_3d(av),      &
1724                                     id_dim_time_3d(av), 523 )
[1308]1725          ENDIF
[1]1726
[1783]1727          CALL netcdf_create_var( id_set_3d(av), (/ id_dim_time_3d(av) /),     &
1728                                  'time', NF90_DOUBLE, id_var_time_3d(av),     &
[3529]1729                                  'seconds since '//TRIM(init_model%origin_time), 'time', 65, 66, 00 )
1730          CALL netcdf_create_att( id_set_3d(av), id_var_time_3d(av), 'standard_name', 'time', 000)
1731          CALL netcdf_create_att( id_set_3d(av), id_var_time_3d(av), 'axis', 'T', 000)
[1]1732!
1733!--       Define spatial dimensions and coordinates:
1734!--       Define vertical coordinate grid (zu grid)
[1783]1735          CALL netcdf_create_dim( id_set_3d(av), 'zu_3d', nz_do3d-nzb+1,       &
1736                                  id_dim_zu_3d(av), 67 )
1737          CALL netcdf_create_var( id_set_3d(av), (/ id_dim_zu_3d(av) /),       &
1738                                  'zu_3d', NF90_DOUBLE, id_var_zu_3d(av),      &
1739                                  'meters', '', 68, 69, 00 )
[1]1740!
1741!--       Define vertical coordinate grid (zw grid)
[1783]1742          CALL netcdf_create_dim( id_set_3d(av), 'zw_3d', nz_do3d-nzb+1,       &
1743                                  id_dim_zw_3d(av), 70 )
1744          CALL netcdf_create_var( id_set_3d(av), (/ id_dim_zw_3d(av) /),       &
1745                                  'zw_3d', NF90_DOUBLE, id_var_zw_3d(av),      &
1746                                  'meters', '', 71, 72, 00 )
[1]1747!
1748!--       Define x-axis (for scalar position)
[2512]1749          CALL netcdf_create_dim( id_set_3d(av), 'x', nx+1, id_dim_x_3d(av),   &
[1783]1750                                  73 )
1751          CALL netcdf_create_var( id_set_3d(av), (/ id_dim_x_3d(av) /), 'x',   &
1752                                  NF90_DOUBLE, id_var_x_3d(av), 'meters', '',  &
1753                                  74, 75, 00 )
[1]1754!
1755!--       Define x-axis (for u position)
[2512]1756          CALL netcdf_create_dim( id_set_3d(av), 'xu', nx+1, id_dim_xu_3d(av), &
[1783]1757                                  358 )
1758          CALL netcdf_create_var( id_set_3d(av), (/ id_dim_xu_3d(av) /), 'xu', &
1759                                  NF90_DOUBLE, id_var_xu_3d(av), 'meters', '', &
1760                                  359, 360, 000 )
[1]1761!
1762!--       Define y-axis (for scalar position)
[2512]1763          CALL netcdf_create_dim( id_set_3d(av), 'y', ny+1, id_dim_y_3d(av),   &
[1783]1764                                  76 )
1765          CALL netcdf_create_var( id_set_3d(av), (/ id_dim_y_3d(av) /), 'y',   &
1766                                  NF90_DOUBLE, id_var_y_3d(av), 'meters', '',  &
1767                                  77, 78, 00 )
[1]1768!
1769!--       Define y-axis (for v position)
[2512]1770          CALL netcdf_create_dim( id_set_3d(av), 'yv', ny+1, id_dim_yv_3d(av), &
[1783]1771                                  361 )
1772          CALL netcdf_create_var( id_set_3d(av), (/ id_dim_yv_3d(av) /), 'yv', &
1773                                  NF90_DOUBLE, id_var_yv_3d(av), 'meters', '', &
1774                                  362, 363, 000 )
[1]1775!
[3529]1776!--       Define UTM and geographic coordinates
1777          CALL define_geo_coordinates( id_set_3d(av),         &
1778                  (/ id_dim_x_3d(av), id_dim_xu_3d(av) /),    &
1779                  (/ id_dim_y_3d(av), id_dim_yv_3d(av) /),    &
1780                  id_var_eutm_3d(av,:), id_var_nutm_3d(av,:), &
1781                  id_var_lat_3d(av,:), id_var_lon_3d(av,:)    )
[3421]1782!
[3459]1783!--       Define coordinate-reference system
1784          CALL netcdf_create_crs( id_set_3d(av), 000 )
1785!
[48]1786!--       In case of non-flat topography define 2d-arrays containing the height
[2232]1787!--       information. Only output 2d topography information in case of parallel
1788!--       output.
1789          IF ( TRIM( topography ) /= 'flat'  .AND.                             &
1790               netcdf_data_format > 4 )  THEN
[48]1791!
1792!--          Define zusi = zu(nzb_s_inner)
[1783]1793             CALL netcdf_create_var( id_set_3d(av), (/ id_dim_x_3d(av),        &
1794                                     id_dim_y_3d(av) /), 'zusi', NF90_DOUBLE,  &
1795                                     id_var_zusi_3d(av), 'meters',             &
1796                                     'zu(nzb_s_inner)', 413, 414, 415 )
[48]1797!             
1798!--          Define zwwi = zw(nzb_w_inner)
[1783]1799             CALL netcdf_create_var( id_set_3d(av), (/ id_dim_x_3d(av),        &
1800                                     id_dim_y_3d(av) /), 'zwwi', NF90_DOUBLE,  &
1801                                     id_var_zwwi_3d(av), 'meters',             &
1802                                     'zw(nzb_w_inner)', 416, 417, 418 )
[48]1803
1804          ENDIF             
1805
[1551]1806          IF ( land_surface )  THEN
1807!
1808!--          Define vertical coordinate grid (zs grid)
[1783]1809             CALL netcdf_create_dim( id_set_3d(av), 'zs_3d',                   &
1810                                     nzt_soil-nzb_soil+1, id_dim_zs_3d(av), 70 )
1811             CALL netcdf_create_var( id_set_3d(av), (/ id_dim_zs_3d(av) /),    &
1812                                     'zs_3d', NF90_DOUBLE, id_var_zs_3d(av),   &
1813                                     'meters', '', 71, 72, 00 )
[48]1814
[1551]1815          ENDIF
1816
[48]1817!
[1]1818!--       Define the variables
1819          var_list = ';'
1820          i = 1
1821
1822          DO WHILE ( do3d(av,i)(1:1) /= ' ' )
1823!
[2007]1824!--          Temporary solution to account for data output within the new urban
1825!--          surface model (urban_surface_mod.f90), see also SELECT CASE ( trimvar )
1826             trimvar = TRIM( do3d(av,i) )
[2011]1827             IF ( urban_surface  .AND.  trimvar(1:4) == 'usm_' )  THEN
[2007]1828                trimvar = 'usm_output'
1829             ENDIF
1830!
[1]1831!--          Check for the grid
[1980]1832             found = .FALSE.
[2007]1833             SELECT CASE ( trimvar )
[1]1834!
1835!--             Most variables are defined on the scalar grid
[3421]1836                CASE ( 'e', 'nc', 'nr', 'p', 'pc', 'pr', 'prr',   &
[2292]1837                       'q', 'qc', 'ql', 'ql_c', 'ql_v', 'ql_vp', 'qr', 'qv',   &
[3421]1838                       's', 'theta', 'thetal', 'thetav' )
[1]1839
1840                   grid_x = 'x'
1841                   grid_y = 'y'
1842                   grid_z = 'zu'
1843!
1844!--             u grid
1845                CASE ( 'u' )
1846
1847                   grid_x = 'xu'
1848                   grid_y = 'y'
1849                   grid_z = 'zu'
1850!
1851!--             v grid
1852                CASE ( 'v' )
1853
1854                   grid_x = 'x'
1855                   grid_y = 'yv'
1856                   grid_z = 'zu'
1857!
1858!--             w grid
[1976]1859                CASE ( 'w' )
[1]1860
1861                   grid_x = 'x'
1862                   grid_y = 'y'
1863                   grid_z = 'zw'
1864
[2007]1865!             
1866!--             Block of urban surface model outputs   
1867                CASE ( 'usm_output' )
1868                   CALL usm_define_netcdf_grid( do3d(av,i), found, &
1869                                                   grid_x, grid_y, grid_z )
[1551]1870
[1]1871                CASE DEFAULT
[1972]1872
[2696]1873                   CALL tcm_define_netcdf_grid( do3d(av,i), found, &
1874                                                   grid_x, grid_y, grid_z )
1875
[1]1876!
[1972]1877!--                Check for land surface quantities
[3004]1878                   IF ( .NOT. found .AND. land_surface )  THEN
[1972]1879                      CALL lsm_define_netcdf_grid( do3d(av,i), found, grid_x,  &
[1976]1880                                                   grid_y, grid_z )
[1972]1881                   ENDIF
[3421]1882!
1883!--                Check for ocean quantities
1884                   IF ( .NOT. found  .AND.  ocean_mode )  THEN
1885                      CALL ocean_define_netcdf_grid( do3d(av,i), found,  &
1886                                                     grid_x, grid_y, grid_z )
1887                   ENDIF
[1976]1888
1889!
[2209]1890!--                Check for plant canopy quantities
[2696]1891                   IF ( .NOT. found  .AND.  plant_canopy )  THEN
[2209]1892                      CALL pcm_define_netcdf_grid( do3d(av,i), found, grid_x,  &
1893                                                   grid_y, grid_z )
1894                   ENDIF
[3337]1895
[2209]1896!
[1976]1897!--                Check for radiation quantities
1898                   IF ( .NOT. found  .AND.  radiation )  THEN
1899                      CALL radiation_define_netcdf_grid( do3d(av,i), found,    &
1900                                                         grid_x, grid_y,       &
1901                                                         grid_z )
1902                   ENDIF
[2696]1903
[2817]1904!--                Check for gust module quantities
1905                   IF ( .NOT. found  .AND.  gust_module_enabled )  THEN
1906                      CALL gust_define_netcdf_grid( do3d(av,i), found, grid_x, &
1907                                                    grid_y, grid_z )
1908                   ENDIF
1909
[2696]1910!
[3448]1911!--                Check for biometeorology quantities
1912                   IF ( .NOT. found  .AND.  biometeorology )  THEN
[3525]1913                      CALL bio_define_netcdf_grid( do3d(av,i), found,          &
1914                                                   grid_x, grid_y, grid_z )
[3448]1915                   ENDIF
1916
1917!
[2696]1918!--                Check for chemistry quantities                   
1919                   IF ( .NOT. found  .AND.  air_chemistry )  THEN
1920                      CALL chem_define_netcdf_grid( do3d(av,i), found,         &
1921                                                    grid_x, grid_y, grid_z )
1922                   ENDIF
1923
[3467]1924!
1925!--                Check for SALSA quantities
1926                   IF ( .NOT. found  .AND.  salsa )  THEN
1927                      CALL salsa_define_netcdf_grid( do3d(av,i), found, grid_x,&
1928                                                     grid_y, grid_z )
1929                   ENDIF                 
[3582]1930!                   
[1]1931!--                Check for user-defined quantities
[3701]1932                   IF ( .NOT. found  .AND.  user_module_enabled )  THEN
[1972]1933                      CALL user_define_netcdf_grid( do3d(av,i), found, grid_x, &
1934                                                    grid_y, grid_z )
1935                   ENDIF
[2007]1936                                                 
[1783]1937                   IF ( .NOT. found )  THEN
1938                      WRITE ( message_string, * ) 'no grid defined for varia', &
1939                                                  'ble ', TRIM( do3d(av,i) )
1940                      CALL message( 'define_netcdf_header', 'PA0244', 0, 1, 0, &
1941                                    6, 0 )
1942                   ENDIF
1943
[1]1944             END SELECT
1945
1946!
1947!--          Select the respective dimension ids
1948             IF ( grid_x == 'x' )  THEN
1949                id_x = id_dim_x_3d(av)
1950             ELSEIF ( grid_x == 'xu' )  THEN
1951                id_x = id_dim_xu_3d(av)
1952             ENDIF
1953
1954             IF ( grid_y == 'y' )  THEN
1955                id_y = id_dim_y_3d(av)
1956             ELSEIF ( grid_y == 'yv' )  THEN
1957                id_y = id_dim_yv_3d(av)
1958             ENDIF
1959
1960             IF ( grid_z == 'zu' )  THEN
1961                id_z = id_dim_zu_3d(av)
1962             ELSEIF ( grid_z == 'zw' )  THEN
1963                id_z = id_dim_zw_3d(av)
[1551]1964             ELSEIF ( grid_z == 'zs' )  THEN
1965                id_z = id_dim_zs_3d(av)
[1]1966             ENDIF
1967
1968!
1969!--          Define the grid
[1783]1970             CALL netcdf_create_var( id_set_3d(av),(/ id_x, id_y, id_z,        &
1971                                     id_dim_time_3d(av) /), do3d(av,i),        &
1972                                     nc_precision(4), id_var_do3d(av,i),       &
1973                                     TRIM( do3d_unit(av,i) ), do3d(av,i), 79,  &
[2696]1974                                     80, 357, .TRUE. )
[1031]1975#if defined( __netcdf4_parallel )
[1308]1976             IF ( netcdf_data_format > 4 )  THEN
[493]1977!
[1308]1978!--             Set no fill for every variable to increase performance.
1979                nc_stat = NF90_DEF_VAR_FILL( id_set_3d(av),     &
1980                                             id_var_do3d(av,i), &
1981                                             1, 0 )
[1783]1982                CALL netcdf_handle_error( 'netcdf_define_header', 532 )
[1308]1983!
1984!--             Set collective io operations for parallel io
[493]1985                nc_stat = NF90_VAR_PAR_ACCESS( id_set_3d(av),     &
1986                                               id_var_do3d(av,i), &
1987                                               NF90_COLLECTIVE )
[1783]1988                CALL netcdf_handle_error( 'netcdf_define_header', 445 )
[493]1989             ENDIF
1990#endif
[1783]1991             var_list = TRIM( var_list ) // TRIM( do3d(av,i) ) // ';'
1992
[1]1993             i = i + 1
1994
1995          ENDDO
1996
1997!
1998!--       No arrays to output
1999          IF ( i == 1 )  RETURN
2000
2001!
2002!--       Write the list of variables as global attribute (this is used by
2003!--       restart runs and by combine_plot_fields)
2004          nc_stat = NF90_PUT_ATT( id_set_3d(av), NF90_GLOBAL, 'VAR_LIST', &
2005                                  var_list )
[1783]2006          CALL netcdf_handle_error( 'netcdf_define_header', 81 )
[1]2007
2008!
[1308]2009!--       Set general no fill, otherwise the performance drops significantly for
2010!--       parallel output.
2011          nc_stat = NF90_SET_FILL( id_set_3d(av), NF90_NOFILL, oldmode )
[1783]2012          CALL netcdf_handle_error( 'netcdf_define_header', 528 )
[1308]2013
2014!
[1031]2015!--       Leave netCDF define mode
[1]2016          nc_stat = NF90_ENDDEF( id_set_3d(av) )
[1783]2017          CALL netcdf_handle_error( 'netcdf_define_header', 82 )
[1]2018
2019!
[1308]2020!--       These data are only written by PE0 for parallel output to increase
2021!--       the performance.
2022          IF ( myid == 0  .OR.  netcdf_data_format < 5 )  THEN
2023!
2024!--          Write data for x (shifted by +dx/2) and xu axis
[2512]2025             ALLOCATE( netcdf_data(0:nx) )
[1]2026
[2512]2027             DO  i = 0, nx
[1308]2028                netcdf_data(i) = ( i + 0.5 ) * dx
2029             ENDDO
[1]2030
[1308]2031             nc_stat = NF90_PUT_VAR( id_set_3d(av), id_var_x_3d(av),  &
2032                                     netcdf_data, start = (/ 1 /),    &
[2512]2033                                     count = (/ nx+1 /) )
[1783]2034             CALL netcdf_handle_error( 'netcdf_define_header', 83 )
[1]2035
[2512]2036             DO  i = 0, nx
[1308]2037                netcdf_data(i) = i * dx
2038             ENDDO
[1]2039
[1308]2040             nc_stat = NF90_PUT_VAR( id_set_3d(av), id_var_xu_3d(av), &
2041                                     netcdf_data, start = (/ 1 /),    &
[2512]2042                                     count = (/ nx+1 /) )
[1783]2043             CALL netcdf_handle_error( 'netcdf_define_header', 385 )
[1]2044
[1308]2045             DEALLOCATE( netcdf_data )
[1]2046
2047!
[1308]2048!--          Write data for y (shifted by +dy/2) and yv axis
[2512]2049             ALLOCATE( netcdf_data(0:ny) )
[1]2050
[2512]2051             DO  i = 0, ny
[1353]2052                netcdf_data(i) = ( i + 0.5_wp ) * dy
[1308]2053             ENDDO
[1]2054
[1308]2055             nc_stat = NF90_PUT_VAR( id_set_3d(av), id_var_y_3d(av),  &
2056                                     netcdf_data, start = (/ 1 /),    &
[2512]2057                                     count = (/ ny+1 /) )
[1783]2058             CALL netcdf_handle_error( 'netcdf_define_header', 84 )
[1]2059
[2512]2060             DO  i = 0, ny
[1308]2061                netcdf_data(i) = i * dy
2062             ENDDO
[1]2063
[1308]2064             nc_stat = NF90_PUT_VAR( id_set_3d(av), id_var_yv_3d(av), &
2065                                     netcdf_data, start = (/ 1 /),    &
[2512]2066                                     count = (/ ny+1 /))
[1783]2067             CALL netcdf_handle_error( 'netcdf_define_header', 387 )
[1]2068
[1308]2069             DEALLOCATE( netcdf_data )
[1]2070
2071!
[3421]2072!--          Write UTM coordinates
2073             IF ( init_model%rotation_angle == 0.0_wp )  THEN
2074!
2075!--             1D in case of no rotation
2076                cos_ra = COS( init_model%rotation_angle * pi / 180.0_wp )
2077!
2078!--             x coordinates
2079                ALLOCATE( netcdf_data(0:nx) )
2080                DO  k = 0, 2
2081!               
2082!--                Scalar grid points
2083                   IF ( k == 0 )  THEN
2084                      shift_x = 0.5
2085!               
2086!--                u grid points
2087                   ELSEIF ( k == 1 )  THEN
2088                      shift_x = 0.0
2089!               
2090!--                v grid points
2091                   ELSEIF ( k == 2 )  THEN
2092                      shift_x = 0.5
2093                   ENDIF
2094               
2095                   DO  i = 0, nx
2096                     netcdf_data(i) = init_model%origin_x            &
2097                                    + cos_ra * ( i + shift_x ) * dx
2098                   ENDDO
2099               
2100                   nc_stat = NF90_PUT_VAR( id_set_3d(av), id_var_eutm_3d(av,k),&
2101                                           netcdf_data, start = (/ 1 /),   &
2102                                           count = (/ nx+1 /) )
2103                   CALL netcdf_handle_error( 'netcdf_define_header', 555 )
2104
2105                ENDDO
2106                DEALLOCATE( netcdf_data )
2107!
2108!--             y coordinates
2109                ALLOCATE( netcdf_data(0:ny) )
2110                DO  k = 0, 2
2111!
2112!--                Scalar grid points
2113                   IF ( k == 0 )  THEN
2114                      shift_y = 0.5
2115!
2116!--                u grid points
2117                   ELSEIF ( k == 1 )  THEN
2118                      shift_y = 0.5
2119!
2120!--                v grid points
2121                   ELSEIF ( k == 2 )  THEN
2122                      shift_y = 0.0
2123                   ENDIF
2124
2125                   DO  j = 0, ny
2126                      netcdf_data(j) = init_model%origin_y            &
2127                                     + cos_ra * ( j + shift_y ) * dy
2128                   ENDDO
2129
2130                   nc_stat = NF90_PUT_VAR( id_set_3d(av), id_var_nutm_3d(av,k),&
2131                                           netcdf_data, start = (/ 1 /),   &
2132                                           count = (/ ny+1 /) )
2133                   CALL netcdf_handle_error( 'netcdf_define_header', 556 )
2134
2135                ENDDO
2136                DEALLOCATE( netcdf_data )
2137
2138             ELSE
2139!
2140!--             2D in case of rotation
2141                ALLOCATE( netcdf_data_2d(0:nx,0:ny) )
2142                cos_ra = COS( init_model%rotation_angle * pi / 180.0_wp )
2143                sin_ra = SIN( init_model%rotation_angle * pi / 180.0_wp )
2144               
2145                DO  k = 0, 2
2146!               
2147!--               Scalar grid points
2148                  IF ( k == 0 )  THEN
2149                     shift_x = 0.5 ; shift_y = 0.5
2150!               
2151!--               u grid points
2152                  ELSEIF ( k == 1 )  THEN
2153                     shift_x = 0.0 ; shift_y = 0.5
2154!               
2155!--               v grid points
2156                  ELSEIF ( k == 2 )  THEN
2157                     shift_x = 0.5 ; shift_y = 0.0
2158                  ENDIF
2159               
2160                  DO  j = 0, ny
2161                     DO  i = 0, nx
2162                        netcdf_data_2d(i,j) = init_model%origin_x            &
2163                                            + cos_ra * ( i + shift_x ) * dx  &
2164                                            + sin_ra * ( j + shift_y ) * dy
2165                     ENDDO
2166                  ENDDO
2167               
2168                  nc_stat = NF90_PUT_VAR( id_set_3d(av), id_var_eutm_3d(av,k),  &
2169                                          netcdf_data_2d, start = (/ 1, 1 /),   &
2170                                          count = (/ nx+1, ny+1 /) )
2171                  CALL netcdf_handle_error( 'netcdf_define_header', 555 )
2172               
2173                  DO  j = 0, ny
2174                     DO  i = 0, nx
2175                        netcdf_data_2d(i,j) = init_model%origin_y            &
2176                                            - sin_ra * ( i + shift_x ) * dx  &
2177                                            + cos_ra * ( j + shift_y ) * dy
2178                     ENDDO
2179                  ENDDO
2180               
2181                  nc_stat = NF90_PUT_VAR( id_set_3d(av), id_var_nutm_3d(av,k),  &
2182                                          netcdf_data_2d, start = (/ 1, 1 /),   &
2183                                          count = (/ nx+1, ny+1 /) )
2184                  CALL netcdf_handle_error( 'netcdf_define_header', 556 )
2185               
2186                ENDDO
2187                DEALLOCATE( netcdf_data_2d )
2188             ENDIF
2189!
[1308]2190!--          Write zu and zw data (vertical axes)
2191             nc_stat = NF90_PUT_VAR( id_set_3d(av), id_var_zu_3d(av),  &
2192                                     zu(nzb:nz_do3d), start = (/ 1 /), &
2193                                     count = (/ nz_do3d-nzb+1 /) )
[1783]2194             CALL netcdf_handle_error( 'netcdf_define_header', 85 )
[1]2195
[263]2196
[1308]2197             nc_stat = NF90_PUT_VAR( id_set_3d(av), id_var_zw_3d(av),  &
2198                                     zw(nzb:nz_do3d), start = (/ 1 /), &
2199                                     count = (/ nz_do3d-nzb+1 /) )
[1783]2200             CALL netcdf_handle_error( 'netcdf_define_header', 86 )
[1]2201
[1551]2202             IF ( land_surface )  THEN
2203!
2204!--             Write zs grid
2205                nc_stat = NF90_PUT_VAR( id_set_3d(av), id_var_zs_3d(av),  &
2206                                        - zs(nzb_soil:nzt_soil), start = (/ 1 /), &
2207                                        count = (/ nzt_soil-nzb_soil+1 /) )
[1783]2208                CALL netcdf_handle_error( 'netcdf_define_header', 86 )
[1551]2209             ENDIF
2210
[48]2211          ENDIF
[2232]2212!
[3459]2213!--       Write lon and lat data. Only for parallel output.
2214          IF ( netcdf_data_format > 4 )  THEN
2215
2216             ALLOCATE( lat(nxl:nxr,nys:nyn) )
2217             ALLOCATE( lon(nxl:nxr,nys:nyn) )
2218             cos_ra = COS( init_model%rotation_angle * pi / 180.0_wp )
2219             sin_ra = SIN( init_model%rotation_angle * pi / 180.0_wp )
2220
2221             DO  k = 0, 2
2222!               
2223!--             Scalar grid points
2224                IF ( k == 0 )  THEN
2225                   shift_x = 0.5 ; shift_y = 0.5
2226!               
2227!--             u grid points
2228                ELSEIF ( k == 1 )  THEN
2229                   shift_x = 0.0 ; shift_y = 0.5
2230!               
2231!--             v grid points
2232                ELSEIF ( k == 2 )  THEN
2233                   shift_x = 0.5 ; shift_y = 0.0
2234                ENDIF
2235
2236                DO  j = nys, nyn
2237                   DO  i = nxl, nxr
2238                      eutm = init_model%origin_x            &
2239                           + cos_ra * ( i + shift_x ) * dx  &
2240                           + sin_ra * ( j + shift_y ) * dy
2241                      nutm = init_model%origin_y            &
2242                           - sin_ra * ( i + shift_x ) * dx  &
2243                           + cos_ra * ( j + shift_y ) * dy
2244
2245                      CALL  convert_utm_to_geographic( crs_list,          &
2246                                                       eutm, nutm,        &
2247                                                       lon(i,j), lat(i,j) )
2248                   ENDDO
2249                ENDDO
2250
2251                nc_stat = NF90_PUT_VAR( id_set_3d(av), id_var_lon_3d(av,k), &
2252                                     lon, start = (/ nxl+1, nys+1 /),       &
2253                                     count = (/ nxr-nxl+1, nyn-nys+1 /) )
2254                CALL netcdf_handle_error( 'netcdf_define_header', 556 )
2255
2256                nc_stat = NF90_PUT_VAR( id_set_3d(av), id_var_lat_3d(av,k), &
2257                                     lat, start = (/ nxl+1, nys+1 /),       &
2258                                     count = (/ nxr-nxl+1, nyn-nys+1 /) )
2259                CALL netcdf_handle_error( 'netcdf_define_header', 556 )
2260             ENDDO
2261
2262             DEALLOCATE( lat )
2263             DEALLOCATE( lon )
2264
2265          ENDIF
2266!
[2232]2267!--       In case of non-flat topography write height information. Only for
2268!--       parallel netcdf output.
2269          IF ( TRIM( topography ) /= 'flat'  .AND.                             &
2270               netcdf_data_format > 4 )  THEN
[48]2271
[2512]2272!             IF ( nxr == nx  .AND.  nyn /= ny )  THEN
2273!                nc_stat = NF90_PUT_VAR( id_set_3d(av), id_var_zusi_3d(av),     &
2274!                                        zu_s_inner(nxl:nxr+1,nys:nyn),         &
2275!                                        start = (/ nxl+1, nys+1 /),            &
2276!                                        count = (/ nxr-nxl+2, nyn-nys+1 /) )
2277!             ELSEIF ( nxr /= nx  .AND.  nyn == ny )  THEN
2278!                nc_stat = NF90_PUT_VAR( id_set_3d(av), id_var_zusi_3d(av),     &
2279!                                        zu_s_inner(nxl:nxr,nys:nyn+1),         &
2280!                                        start = (/ nxl+1, nys+1 /),            &
2281!                                        count = (/ nxr-nxl+1, nyn-nys+2 /) )
2282!             ELSEIF ( nxr == nx  .AND.  nyn == ny )  THEN
2283!                nc_stat = NF90_PUT_VAR( id_set_3d(av), id_var_zusi_3d(av),     &
2284!                                        zu_s_inner(nxl:nxr+1,nys:nyn+1),       &
2285!                                        start = (/ nxl+1, nys+1 /),            &
2286!                                        count = (/ nxr-nxl+2, nyn-nys+2 /) )
2287!             ELSE
[2232]2288                nc_stat = NF90_PUT_VAR( id_set_3d(av), id_var_zusi_3d(av),     &
2289                                        zu_s_inner(nxl:nxr,nys:nyn),           &
2290                                        start = (/ nxl+1, nys+1 /),            &
2291                                        count = (/ nxr-nxl+1, nyn-nys+1 /) )
[2512]2292!             ENDIF
[2232]2293             CALL netcdf_handle_error( 'netcdf_define_header', 419 )
2294
[2512]2295!             IF ( nxr == nx  .AND.  nyn /= ny )  THEN
2296!                nc_stat = NF90_PUT_VAR( id_set_3d(av), id_var_zwwi_3d(av),     &
2297!                                        zw_w_inner(nxl:nxr+1,nys:nyn),         &
2298!                                        start = (/ nxl+1, nys+1 /),            &
2299!                                        count = (/ nxr-nxl+2, nyn-nys+1 /) )
2300!             ELSEIF ( nxr /= nx  .AND.  nyn == ny )  THEN
2301!                nc_stat = NF90_PUT_VAR( id_set_3d(av), id_var_zwwi_3d(av),     &
2302!                                        zw_w_inner(nxl:nxr,nys:nyn+1),         &
2303!                                        start = (/ nxl+1, nys+1 /),            &
2304!                                        count = (/ nxr-nxl+1, nyn-nys+2 /) )
2305!             ELSEIF ( nxr == nx  .AND.  nyn == ny )  THEN
2306!                nc_stat = NF90_PUT_VAR( id_set_3d(av), id_var_zwwi_3d(av),     &
2307!                                        zw_w_inner(nxl:nxr+1,nys:nyn+1),       &
2308!                                        start = (/ nxl+1, nys+1 /),            &
2309!                                        count = (/ nxr-nxl+2, nyn-nys+2 /) )
2310!             ELSE
[2232]2311                nc_stat = NF90_PUT_VAR( id_set_3d(av), id_var_zwwi_3d(av),     &
2312                                        zw_w_inner(nxl:nxr,nys:nyn),           &
2313                                        start = (/ nxl+1, nys+1 /),            &
2314                                        count = (/ nxr-nxl+1, nyn-nys+1 /) )
[2512]2315!             ENDIF
[2232]2316             CALL netcdf_handle_error( 'netcdf_define_header', 420 )
2317
2318          ENDIF
2319
[1]2320       CASE ( '3d_ext' )
2321
2322!
2323!--       Get the list of variables and compare with the actual run.
2324!--       First var_list_old has to be reset, since GET_ATT does not assign
2325!--       trailing blanks.
2326          var_list_old = ' '
2327          nc_stat = NF90_GET_ATT( id_set_3d(av), NF90_GLOBAL, 'VAR_LIST', &
2328                                  var_list_old )
[1783]2329          CALL netcdf_handle_error( 'netcdf_define_header', 87 )
[1]2330
2331          var_list = ';'
2332          i = 1
2333          DO WHILE ( do3d(av,i)(1:1) /= ' ' )
2334             var_list = TRIM(var_list) // TRIM( do3d(av,i) ) // ';'
2335             i = i + 1
2336          ENDDO
2337
2338          IF ( av == 0 )  THEN
2339             var = '(3d)'
2340          ELSE
2341             var = '(3d_av)'
2342          ENDIF
2343
2344          IF ( TRIM( var_list ) /= TRIM( var_list_old ) )  THEN
[1031]2345             message_string = 'netCDF file for volume data ' //             &
[292]2346                              TRIM( var ) // ' from previous run found,' // &
[3046]2347                              '&but this file cannot be extended due to' // &
[257]2348                              ' variable mismatch.' //                      &
[3046]2349                              '&New file is created instead.'
[257]2350             CALL message( 'define_netcdf_header', 'PA0245', 0, 1, 0, 6, 0 )
[1]2351             extend = .FALSE.
2352             RETURN
2353          ENDIF
2354
2355!
2356!--       Get and compare the number of vertical gridpoints
2357          nc_stat = NF90_INQ_VARID( id_set_3d(av), 'zu_3d', id_var_zu_3d(av) )
[1783]2358          CALL netcdf_handle_error( 'netcdf_define_header', 88 )
[1]2359
2360          nc_stat = NF90_INQUIRE_VARIABLE( id_set_3d(av), id_var_zu_3d(av), &
2361                                           dimids = id_dim_zu_3d_old )
[1783]2362          CALL netcdf_handle_error( 'netcdf_define_header', 89 )
[1]2363          id_dim_zu_3d(av) = id_dim_zu_3d_old(1)
2364
2365          nc_stat = NF90_INQUIRE_DIMENSION( id_set_3d(av), id_dim_zu_3d(av), &
2366                                            len = nz_old )
[1783]2367          CALL netcdf_handle_error( 'netcdf_define_header', 90 )
[1]2368
2369          IF ( nz_do3d-nzb+1 /= nz_old )  THEN
[1031]2370              message_string = 'netCDF file for volume data ' //             &
[292]2371                               TRIM( var ) // ' from previous run found,' // &
[3046]2372                               '&but this file cannot be extended due to' // &
[257]2373                               ' mismatch in number of' //                   &
[3045]2374                               ' vertical grid points (nz_do3d).' //         &
[3046]2375                               '&New file is created instead.'
[257]2376             CALL message( 'define_netcdf_header', 'PA0246', 0, 1, 0, 6, 0 )
[1]2377             extend = .FALSE.
2378             RETURN
2379          ENDIF
2380
2381!
2382!--       Get the id of the time coordinate (unlimited coordinate) and its
2383!--       last index on the file. The next time level is pl3d..count+1.
2384!--       The current time must be larger than the last output time
2385!--       on the file.
2386          nc_stat = NF90_INQ_VARID( id_set_3d(av), 'time', id_var_time_3d(av) )
[1783]2387          CALL netcdf_handle_error( 'netcdf_define_header', 91 )
[1]2388
2389          nc_stat = NF90_INQUIRE_VARIABLE( id_set_3d(av), id_var_time_3d(av), &
2390                                           dimids = id_dim_time_old )
[1783]2391          CALL netcdf_handle_error( 'netcdf_define_header', 92 )
[263]2392
[1]2393          id_dim_time_3d(av) = id_dim_time_old(1)
2394
2395          nc_stat = NF90_INQUIRE_DIMENSION( id_set_3d(av), id_dim_time_3d(av), &
[1308]2396                                            len = ntime_count )
[1783]2397          CALL netcdf_handle_error( 'netcdf_define_header', 93 )
[1]2398
[1308]2399!
2400!--       For non-parallel output use the last output time level of the netcdf
2401!--       file because the time dimension is unlimited. In case of parallel
2402!--       output the variable ntime_count could get the value of 9*10E36 because
2403!--       the time dimension is limited.
2404          IF ( netcdf_data_format < 5 ) do3d_time_count(av) = ntime_count
2405
[1]2406          nc_stat = NF90_GET_VAR( id_set_3d(av), id_var_time_3d(av), &
2407                                  last_time_coordinate,              &
2408                                  start = (/ do3d_time_count(av) /), &
2409                                  count = (/ 1 /) )
[1783]2410          CALL netcdf_handle_error( 'netcdf_define_header', 94 )
[1]2411
2412          IF ( last_time_coordinate(1) >= simulated_time )  THEN
[3045]2413             message_string = 'netCDF file for volume data ' //             &
[292]2414                              TRIM( var ) // ' from previous run found,' // &
[3046]2415                              '&but this file cannot be extended becaus' // &
[257]2416                              'e the current output time' //                &
[3046]2417                              '&is less or equal than the last output t' // &
[257]2418                              'ime on this file.' //                        &
[3046]2419                              '&New file is created instead.'
[257]2420             CALL message( 'define_netcdf_header', 'PA0247', 0, 1, 0, 6, 0 )
[1]2421             do3d_time_count(av) = 0
2422             extend = .FALSE.
2423             RETURN
2424          ENDIF
2425
[1308]2426          IF ( netcdf_data_format > 4 )  THEN
[1745]2427!
2428!--          Check if the needed number of output time levels is increased
2429!--          compared to the number of time levels in the existing file.
[1308]2430             IF ( ntdim_3d(av) > ntime_count )  THEN
2431                message_string = 'netCDF file for volume data ' // &
2432                                 TRIM( var ) // ' from previous run found,' // &
[3046]2433                                 '&but this file cannot be extended becaus' // &
[3045]2434                                 'e the number of output time levels has b' // &
[1308]2435                                 'een increased compared to the previous s' // &
[1745]2436                                 'imulation.' //                               &
[3046]2437                                 '&New file is created instead.'
[1308]2438                CALL message( 'define_netcdf_header', 'PA0388', 0, 1, 0, 6, 0 )
2439                do3d_time_count(av) = 0
2440                extend = .FALSE.
[1745]2441!
2442!--             Recalculate the needed time levels for the new file.
2443                IF ( av == 0 )  THEN
2444                   ntdim_3d(0) = CEILING(                               &
2445                           ( end_time - MAX( skip_time_do3d,            &
2446                                             simulated_time_at_begin )  &
2447                           ) / dt_do3d )
[2769]2448                   IF ( do3d_at_begin )  ntdim_3d(0) = ntdim_3d(0) + 1
[1745]2449                ELSE
2450                   ntdim_3d(1) = CEILING(                               &
2451                           ( end_time - MAX( skip_time_data_output_av,  &
2452                                             simulated_time_at_begin )  &
2453                           ) / dt_data_output_av )
2454                ENDIF
[1308]2455                RETURN
2456             ENDIF
2457          ENDIF
2458
[1]2459!
2460!--       Dataset seems to be extendable.
2461!--       Now get the variable ids.
2462          i = 1
2463          DO WHILE ( do3d(av,i)(1:1) /= ' ' )
2464             nc_stat = NF90_INQ_VARID( id_set_3d(av), TRIM( do3d(av,i) ), &
2465                                       id_var_do3d(av,i) )
[1783]2466             CALL netcdf_handle_error( 'netcdf_define_header', 95 )
[1031]2467#if defined( __netcdf4_parallel )
[493]2468!
2469!--          Set collective io operations for parallel io
[1031]2470             IF ( netcdf_data_format > 4 )  THEN
[493]2471                nc_stat = NF90_VAR_PAR_ACCESS( id_set_3d(av),     &
2472                                               id_var_do3d(av,i), &
2473                                               NF90_COLLECTIVE )
[1783]2474                CALL netcdf_handle_error( 'netcdf_define_header', 453 )
[493]2475             ENDIF
2476#endif
[1]2477             i = i + 1
2478          ENDDO
2479
2480!
[359]2481!--       Update the title attribute on file
2482!--       In order to avoid 'data mode' errors if updated attributes are larger
2483!--       than their original size, NF90_PUT_ATT is called in 'define mode'
2484!--       enclosed by NF90_REDEF and NF90_ENDDEF calls. This implies a possible
2485!--       performance loss due to data copying; an alternative strategy would be
2486!--       to ensure equal attribute size. Maybe revise later.
2487          IF ( av == 0 )  THEN
2488             time_average_text = ' '
2489          ELSE
2490             WRITE (time_average_text, '('', '',F7.1,'' s average'')') &
2491                                                            averaging_interval
2492          ENDIF
2493          nc_stat = NF90_REDEF( id_set_3d(av) )
[1783]2494          CALL netcdf_handle_error( 'netcdf_define_header', 429 )
[1]2495          nc_stat = NF90_PUT_ATT( id_set_3d(av), NF90_GLOBAL, 'title', &
[359]2496                                  TRIM( run_description_header ) //    &
2497                                  TRIM( time_average_text ) )
[1783]2498          CALL netcdf_handle_error( 'netcdf_define_header', 96 )
[359]2499          nc_stat = NF90_ENDDEF( id_set_3d(av) )
[1783]2500          CALL netcdf_handle_error( 'netcdf_define_header', 430 )
[1031]2501          message_string = 'netCDF file for volume data ' //             &
[257]2502                           TRIM( var ) // ' from previous run found.' // &
[3046]2503                           '&This file will be extended.'
[257]2504          CALL message( 'define_netcdf_header', 'PA0248', 0, 0, 0, 6, 0 )
[1]2505
[3159]2506
2507       CASE ( 'ag_new' )
2508
2509!
2510!--       Define some global attributes of the dataset
2511          nc_stat = NF90_PUT_ATT( id_set_agt, NF90_GLOBAL, 'title', &
2512                                  TRIM( run_description_header ) )
2513          CALL netcdf_handle_error( 'netcdf_define_header', 330 )
2514!
2515!--       Switch for unlimited time dimension
2516          IF ( agent_time_unlimited ) THEN
2517             CALL netcdf_create_dim( id_set_agt, 'time', NF90_UNLIMITED,       &
2518                                     id_dim_time_agt, 331 )
2519          ELSE
2520             CALL netcdf_create_dim( id_set_agt, 'time',                       &
[3198]2521                                     INT( ( MIN( multi_agent_system_end,       &
2522                                                 end_time ) -                  &
2523                                            multi_agent_system_start ) /       &
2524                                            dt_write_agent_data * 1.1 ),       &
[3159]2525                                     id_dim_time_agt, 331 )
2526          ENDIF
2527
2528          CALL netcdf_create_var( id_set_agt, (/ id_dim_time_agt /), 'time',   &
[3529]2529                                  NF90_REAL4, id_var_time_agt, 'seconds since '//TRIM(init_model%origin_time), 'time',  &
[3159]2530                                  332, 333, 000 )
[3529]2531          CALL netcdf_create_att( id_set_agt, id_var_time_agt, 'standard_name', 'time', 000)
2532          CALL netcdf_create_att( id_set_agt, id_var_time_agt, 'axis', 'T', 000)
[3159]2533
[3235]2534          CALL netcdf_create_dim( id_set_agt, 'agent_number',                  &
2535                                  dim_size_agtnum, id_dim_agtnum, 334 )
2536
[3159]2537          CALL netcdf_create_var( id_set_agt, (/ id_dim_agtnum /),             &
[3235]2538                                  'agent_number', NF90_REAL4,                  &
2539                                  id_var_agtnum, 'agent number', '', 335,      &
[3159]2540                                  336, 000 )
2541!
2542!--       Define variable which contains the real number of agents in use
2543          CALL netcdf_create_var( id_set_agt, (/ id_dim_time_agt /),           &
[3235]2544                                  'real_num_of_agt', NF90_REAL4,               &
2545                                  id_var_rnoa_agt, 'agent number', '', 337,    &
[3159]2546                                  338, 000 )
[3235]2547          i = 1
2548          CALL netcdf_create_var( id_set_agt, (/ id_dim_agtnum,                &
2549                                  id_dim_time_agt /), agt_var_names(i),        &
2550                                  NF90_DOUBLE, id_var_agt(i),                  &
2551                                  TRIM( agt_var_units(i) ),                    &
2552                                  TRIM( agt_var_names(i) ), 339, 340, 341 )
[3159]2553!
2554!--       Define the variables
[3235]2555          DO  i = 2, 6
[3159]2556             CALL netcdf_create_var( id_set_agt, (/ id_dim_agtnum,             &
2557                                     id_dim_time_agt /), agt_var_names(i),     &
[3235]2558                                     NF90_REAL4, id_var_agt(i),                &
[3159]2559                                     TRIM( agt_var_units(i) ),                 &
2560                                     TRIM( agt_var_names(i) ), 339, 340, 341 )
2561
2562          ENDDO
2563!
[3448]2564!--       Define vars for biometeorology
2565          CALL netcdf_create_var( id_set_agt, (/ id_dim_agtnum,                &
2566                                  id_dim_time_agt /), agt_var_names(9),        &
2567                                  nc_precision(8), id_var_agt(9),              &
2568                                  TRIM( agt_var_units(9) ),                    &
2569                                  TRIM( agt_var_names(9) ), 339, 340, 341 )
2570
2571!
[3159]2572!--       Leave netCDF define mode
2573          nc_stat = NF90_ENDDEF( id_set_agt )
2574          CALL netcdf_handle_error( 'netcdf_define_header', 342 )
2575
2576
2577!        CASE ( 'ag_ext' )
2578! !+?agent extend output for restart runs has to be adapted
2579!
2580! !
2581! !--       Get the id of the time coordinate (unlimited coordinate) and its
2582! !--       last index on the file. The next time level is prt..count+1.
2583! !--       The current time must be larger than the last output time
2584! !--       on the file.
2585!           nc_stat = NF90_INQ_VARID( id_set_agt, 'time', id_var_time_agt )
2586!           CALL netcdf_handle_error( 'netcdf_define_header', 343 )
2587!
2588!           nc_stat = NF90_INQUIRE_VARIABLE( id_set_agt, id_var_time_agt, &
2589!                                            dimids = id_dim_time_old )
2590!           CALL netcdf_handle_error( 'netcdf_define_header', 344 )
2591!           id_dim_time_agt = id_dim_time_old(1)
2592!
2593!           nc_stat = NF90_INQUIRE_DIMENSION( id_set_agt, id_dim_time_agt, &
2594!                                             len = agt_time_count )
2595!           CALL netcdf_handle_error( 'netcdf_define_header', 345 )
2596!
2597!           nc_stat = NF90_GET_VAR( id_set_agt, id_var_time_agt,  &
2598!                                   last_time_coordinate,         &
2599!                                   start = (/ agt_time_count /), &
2600!                                   count = (/ 1 /) )
2601!           CALL netcdf_handle_error( 'netcdf_define_header', 346 )
2602!
2603!           IF ( last_time_coordinate(1) >= simulated_time )  THEN
2604!              message_string = 'netCDF file for agents ' //                  &
2605!                               'from previous run found,' //                 &
2606!                               '&but this file cannot be extended becaus' // &
2607!                               'e the current output time' //                &
2608!                               '&is less or equal than the last output t' // &
2609!                               'ime on this file.' //                        &
2610!                               '&New file is created instead.'
2611!              CALL message( 'define_netcdf_header', 'PA0265', 0, 1, 0, 6, 0 )
2612!              agt_time_count = 0
2613!              extend = .FALSE.
2614!              RETURN
2615!           ENDIF
2616!
2617! !
2618! !--       Dataset seems to be extendable.
2619! !--       Now get the variable ids.
2620!           nc_stat = NF90_INQ_VARID( id_set_agt, 'real_num_of_agt', &
2621!                                     id_var_rnoa_agt )
2622!           CALL netcdf_handle_error( 'netcdf_define_header', 347 )
2623!
2624!           DO  i = 1, 17
2625!
2626!              nc_stat = NF90_INQ_VARID( id_set_agt, agt_var_names(i), &
2627!                                        id_var_prt(i) )
2628!              CALL netcdf_handle_error( 'netcdf_define_header', 348 )
2629!
2630!           ENDDO
2631!
2632!           message_string = 'netCDF file for particles ' // &
2633!                            'from previous run found.' //   &
2634!                            '&This file will be extended.'
2635!           CALL message( 'define_netcdf_header', 'PA0266', 0, 0, 0, 6, 0 )
2636         
2637
[1]2638       CASE ( 'xy_new' )
2639
2640!
2641!--       Define some global attributes of the dataset
2642          IF ( av == 0 )  THEN
[3529]2643             CALL netcdf_create_global_atts( id_set_xy(av), 'xy', TRIM( run_description_header ), 97 )
[1]2644             time_average_text = ' '
2645          ELSE
[3529]2646             CALL netcdf_create_global_atts( id_set_xy(av), 'xy_av', TRIM( run_description_header ), 97 )
[1]2647             WRITE ( time_average_text,'(F7.1,'' s avg'')' )  averaging_interval
[3529]2648             nc_stat = NF90_PUT_ATT( id_set_xy(av), NF90_GLOBAL, 'time_avg',   &
[1]2649                                     TRIM( time_average_text ) )
[1783]2650             CALL netcdf_handle_error( 'netcdf_define_header', 98 )
[1]2651          ENDIF
2652
2653!
[1308]2654!--       Define time coordinate for xy sections.
2655!--       For parallel output the time dimensions has to be limited, otherwise
2656!--       the performance drops significantly.
2657          IF ( netcdf_data_format < 5 )  THEN
[1783]2658             CALL netcdf_create_dim( id_set_xy(av), 'time', NF90_UNLIMITED,    &
2659                                     id_dim_time_xy(av), 99 )
[1308]2660          ELSE
[1783]2661             CALL netcdf_create_dim( id_set_xy(av), 'time', ntdim_2d_xy(av),   &
2662                                     id_dim_time_xy(av), 524 )
[1308]2663          ENDIF
[1]2664
[1783]2665          CALL netcdf_create_var( id_set_xy(av), (/ id_dim_time_xy(av) /),     &
2666                                  'time', NF90_DOUBLE, id_var_time_xy(av),     &
[3529]2667                                  'seconds since '//TRIM(init_model%origin_time), 'time', 100, 101, 000 )
2668          CALL netcdf_create_att( id_set_xy(av), id_var_time_xy(av), 'standard_name', 'time', 000)
2669          CALL netcdf_create_att( id_set_xy(av), id_var_time_xy(av), 'axis', 'T', 000)
[1]2670!
2671!--       Define the spatial dimensions and coordinates for xy-sections.
2672!--       First, determine the number of horizontal sections to be written.
2673          IF ( section(1,1) == -9999 )  THEN
2674             RETURN
2675          ELSE
2676             ns = 1
2677             DO WHILE ( section(ns,1) /= -9999  .AND.  ns <= 100 )
2678                ns = ns + 1
2679             ENDDO
2680             ns = ns - 1
2681          ENDIF
2682
2683!
2684!--       Define vertical coordinate grid (zu grid)
[1783]2685          CALL netcdf_create_dim( id_set_xy(av), 'zu_xy', ns,                  &
2686                                  id_dim_zu_xy(av), 102 )
2687          CALL netcdf_create_var( id_set_xy(av), (/ id_dim_zu_xy(av) /),       &
2688                                  'zu_xy', NF90_DOUBLE, id_var_zu_xy(av),      &
2689                                  'meters', '', 103, 104, 000 )
[1]2690!
2691!--       Define vertical coordinate grid (zw grid)
[1783]2692          CALL netcdf_create_dim( id_set_xy(av), 'zw_xy', ns,                  &
2693                                  id_dim_zw_xy(av), 105 )
2694          CALL netcdf_create_var( id_set_xy(av), (/ id_dim_zw_xy(av) /),       &
2695                                  'zw_xy', NF90_DOUBLE, id_var_zw_xy(av),      &
2696                                  'meters', '', 106, 107, 000 )
[1]2697
[1551]2698          IF ( land_surface )  THEN
2699
[2232]2700             ns_do = 1
[2239]2701             DO WHILE ( section(ns_do,1) /= -9999  .AND.  ns_do < nzs )
[1551]2702                ns_do = ns_do + 1
2703             ENDDO
[1]2704!
[1551]2705!--          Define vertical coordinate grid (zs grid)
[1783]2706             CALL netcdf_create_dim( id_set_xy(av), 'zs_xy', ns_do,            &
2707                                     id_dim_zs_xy(av), 539 )
2708             CALL netcdf_create_var( id_set_xy(av), (/ id_dim_zs_xy(av) /),    &
2709                                     'zs_xy', NF90_DOUBLE, id_var_zs_xy(av),   &
2710                                     'meters', '', 540, 541, 000 )
[1551]2711
2712          ENDIF
2713
2714!
[1]2715!--       Define a pseudo vertical coordinate grid for the surface variables
2716!--       u* and t* to store their height level
[1783]2717          CALL netcdf_create_dim( id_set_xy(av), 'zu1_xy', 1,                  &
2718                                  id_dim_zu1_xy(av), 108 )
2719          CALL netcdf_create_var( id_set_xy(av), (/ id_dim_zu1_xy(av) /),      &
2720                                  'zu1_xy', NF90_DOUBLE, id_var_zu1_xy(av),    &
2721                                  'meters', '', 109, 110, 000 )
[1]2722!
2723!--       Define a variable to store the layer indices of the horizontal cross
2724!--       sections, too
[1783]2725          CALL netcdf_create_var( id_set_xy(av), (/ id_dim_zu_xy(av) /),       &
2726                                  'ind_z_xy', NF90_DOUBLE,                     &
2727                                  id_var_ind_z_xy(av), 'gridpoints', '', 111,  &
2728                                  112, 000 )
[1]2729!
2730!--       Define x-axis (for scalar position)
[2512]2731          CALL netcdf_create_dim( id_set_xy(av), 'x', nx+1, id_dim_x_xy(av),   &
[1783]2732                                  113 )
2733          CALL netcdf_create_var( id_set_xy(av), (/ id_dim_x_xy(av) /), 'x',   &
2734                                  NF90_DOUBLE, id_var_x_xy(av), 'meters', '',  &
2735                                  114, 115, 000 )
[1]2736!
2737!--       Define x-axis (for u position)
[2512]2738          CALL netcdf_create_dim( id_set_xy(av), 'xu', nx+1,                   &
[1783]2739                                  id_dim_xu_xy(av), 388 )
2740          CALL netcdf_create_var( id_set_xy(av), (/ id_dim_xu_xy(av) /), 'xu', &
2741                                  NF90_DOUBLE, id_var_xu_xy(av), 'meters', '', &
2742                                  389, 390, 000 )
[1]2743!
2744!--       Define y-axis (for scalar position)
[2512]2745          CALL netcdf_create_dim( id_set_xy(av), 'y', ny+1, id_dim_y_xy(av),   &
[1783]2746                                  116 )
2747          CALL netcdf_create_var( id_set_xy(av), (/ id_dim_y_xy(av) /), 'y',   &
2748                                  NF90_DOUBLE, id_var_y_xy(av), 'meters', '',  &
2749                                  117, 118, 000 )
[1]2750!
2751!--       Define y-axis (for scalar position)
[2512]2752          CALL netcdf_create_dim( id_set_xy(av), 'yv', ny+1,                   &
[1783]2753                                  id_dim_yv_xy(av), 364 )
2754          CALL netcdf_create_var( id_set_xy(av), (/ id_dim_yv_xy(av) /), 'yv', &
2755                                  NF90_DOUBLE, id_var_yv_xy(av), 'meters', '', &
2756                                  365, 366, 000 )
[1]2757!
[3529]2758!--       Define UTM and geographic coordinates
2759          CALL define_geo_coordinates( id_set_xy(av),         &
2760                  (/ id_dim_x_xy(av), id_dim_xu_xy(av) /),    &
2761                  (/ id_dim_y_xy(av), id_dim_yv_xy(av) /),    &
2762                  id_var_eutm_xy(av,:), id_var_nutm_xy(av,:), &
2763                  id_var_lat_xy(av,:), id_var_lon_xy(av,:)    )
[3421]2764!
[3459]2765!--       Define coordinate-reference system
2766          CALL netcdf_create_crs( id_set_xy(av), 000 )
2767!
[48]2768!--       In case of non-flat topography define 2d-arrays containing the height
[2232]2769!--       information. Only for parallel netcdf output.
2770          IF ( TRIM( topography ) /= 'flat'  .AND.                             &
2771               netcdf_data_format > 4  )  THEN
[48]2772!
2773!--          Define zusi = zu(nzb_s_inner)
[1783]2774             CALL netcdf_create_var( id_set_xy(av), (/ id_dim_x_xy(av),        &
2775                                     id_dim_y_xy(av) /), 'zusi', NF90_DOUBLE,  &
2776                                     id_var_zusi_xy(av), 'meters',             &
2777                                     'zu(nzb_s_inner)', 421, 422, 423 )
[48]2778!             
2779!--          Define zwwi = zw(nzb_w_inner)
[1783]2780             CALL netcdf_create_var( id_set_xy(av), (/ id_dim_x_xy(av),        &
2781                                     id_dim_y_xy(av) /), 'zwwi', NF90_DOUBLE,  &
2782                                     id_var_zwwi_xy(av), 'meters',             &
2783                                     'zw(nzb_w_inner)', 424, 425, 426 )
[48]2784
2785          ENDIF
2786
2787!
[1]2788!--       Define the variables
2789          var_list = ';'
2790          i = 1
2791
2792          DO WHILE ( do2d(av,i)(1:1) /= ' ' )
2793
2794             IF ( INDEX( do2d(av,i), 'xy' ) /= 0 )  THEN
2795!
2796!--             If there is a star in the variable name (u* or t*), it is a
2797!--             surface variable. Define it with id_dim_zu1_xy.
2798                IF ( INDEX( do2d(av,i), '*' ) /= 0 )  THEN
2799
[1783]2800                   CALL netcdf_create_var( id_set_xy(av), (/ id_dim_x_xy(av),  &
2801                                           id_dim_y_xy(av), id_dim_zu1_xy(av), &
2802                                           id_dim_time_xy(av) /), do2d(av,i),  &
2803                                           nc_precision(1), id_var_do2d(av,i), &
2804                                           TRIM( do2d_unit(av,i) ),            &
[2696]2805                                           do2d(av,i), 119, 120, 354, .TRUE. )
[1]2806
2807                ELSE
2808
2809!
2810!--                Check for the grid
[1980]2811                   found = .FALSE.
[1]2812                   SELECT CASE ( do2d(av,i) )
2813!
2814!--                   Most variables are defined on the zu grid
[3421]2815                      CASE ( 'e_xy', 'nc_xy', 'nr_xy', 'p_xy',                 &
2816                             'pc_xy', 'pr_xy', 'prr_xy', 'q_xy',               &
[2292]2817                             'qc_xy', 'ql_xy', 'ql_c_xy', 'ql_v_xy',           &
[3421]2818                             'ql_vp_xy', 'qr_xy', 'qv_xy',                     &
2819                             's_xy',                                           &
2820                             'theta_xy', 'thetal_xy', 'thetav_xy' )
[1]2821
2822                         grid_x = 'x'
2823                         grid_y = 'y'
2824                         grid_z = 'zu'
2825!
2826!--                   u grid
2827                      CASE ( 'u_xy' )
2828
2829                         grid_x = 'xu'
2830                         grid_y = 'y'
2831                         grid_z = 'zu'
2832!
2833!--                   v grid
2834                      CASE ( 'v_xy' )
2835
2836                         grid_x = 'x'
2837                         grid_y = 'yv'
2838                         grid_z = 'zu'
2839!
2840!--                   w grid
[1976]2841                      CASE ( 'w_xy' )
[1]2842
2843                         grid_x = 'x'
2844                         grid_y = 'y'
2845                         grid_z = 'zw'
2846
[1976]2847
[1]2848                      CASE DEFAULT
2849!
[1976]2850!--                      Check for land surface quantities
2851                         IF ( land_surface )  THEN
2852                            CALL lsm_define_netcdf_grid( do2d(av,i), found,    &
2853                                                   grid_x, grid_y, grid_z )
2854                         ENDIF
2855
[2696]2856                         IF ( .NOT. found )  THEN
2857                            CALL tcm_define_netcdf_grid( do2d(av,i), found,    &
2858                                                         grid_x, grid_y,       &
2859                                                         grid_z )
2860                         ENDIF
2861
[1976]2862!
[3421]2863!--                      Check for ocean quantities
2864                         IF ( .NOT. found  .AND.  ocean_mode )  THEN
2865                            CALL ocean_define_netcdf_grid( do2d(av,i), found,  &
2866                                                           grid_x, grid_y,     &
2867                                                           grid_z )
2868                         ENDIF
2869!
[1976]2870!--                      Check for radiation quantities
2871                         IF ( .NOT. found  .AND.  radiation )  THEN
2872                            CALL radiation_define_netcdf_grid( do2d(av,i),     &
2873                                                         found, grid_x, grid_y,&
2874                                                         grid_z )
2875                         ENDIF
[3582]2876
[3467]2877!
2878!--                      Check for SALSA quantities
2879                         IF ( .NOT. found  .AND.  salsa )  THEN
2880                            CALL salsa_define_netcdf_grid( do2d(av,i), found,  &
2881                                                           grid_x, grid_y,     &
2882                                                           grid_z )
2883                         ENDIF                       
[1976]2884
2885!
[2817]2886!--                      Check for gust module quantities
2887                         IF ( .NOT. found  .AND.  gust_module_enabled )  THEN
2888                            CALL gust_define_netcdf_grid( do2d(av,i), found,   &
2889                                                          grid_x, grid_y,      &
2890                                                          grid_z )
2891                         ENDIF
2892!
[3569]2893!--                      Check for biometeorology quantities
[3448]2894                         IF ( .NOT. found  .AND.  biometeorology )  THEN
[3525]2895                            CALL bio_define_netcdf_grid( do2d( av, i), found,  &
2896                                                         grid_x, grid_y,       &
2897                                                         grid_z )
[3448]2898                         ENDIF
2899!
[2696]2900!--                      Check for chemistry quantities
2901                         IF ( .NOT. found  .AND.  air_chemistry )  THEN
2902                            CALL chem_define_netcdf_grid( do2d(av,i), found,   &
2903                                                          grid_x, grid_y,      &
2904                                                          grid_z )
2905                         ENDIF
2906
2907
2908!
[1]2909!--                      Check for user-defined quantities
[3701]2910                         IF ( .NOT. found  .AND.  user_module_enabled )  THEN
[1976]2911                            CALL user_define_netcdf_grid( do2d(av,i), found,   &
2912                                                          grid_x, grid_y,      &
2913                                                          grid_z )
2914                         ENDIF
[1]2915
[1783]2916                         IF ( .NOT. found )  THEN
2917                            WRITE ( message_string, * ) 'no grid defined for', &
2918                                                ' variable ', TRIM( do2d(av,i) )
2919                            CALL message( 'define_netcdf_header', 'PA0244',    &
2920                                          0, 1, 0, 6, 0 )
2921                         ENDIF
2922
[1]2923                   END SELECT
2924
2925!
2926!--                Select the respective dimension ids
2927                   IF ( grid_x == 'x' )  THEN
2928                      id_x = id_dim_x_xy(av)
2929                   ELSEIF ( grid_x == 'xu' )  THEN
2930                      id_x = id_dim_xu_xy(av)
2931                   ENDIF
2932
2933                   IF ( grid_y == 'y' )  THEN
2934                      id_y = id_dim_y_xy(av)
2935                   ELSEIF ( grid_y == 'yv' )  THEN
2936                      id_y = id_dim_yv_xy(av)
2937                   ENDIF
2938
2939                   IF ( grid_z == 'zu' )  THEN
2940                      id_z = id_dim_zu_xy(av)
2941                   ELSEIF ( grid_z == 'zw' )  THEN
2942                      id_z = id_dim_zw_xy(av)
[1551]2943                   ELSEIF ( grid_z == 'zs' )  THEN
2944                      id_z = id_dim_zs_xy(av)
[3448]2945                   ELSEIF ( grid_z == 'zu1' )  THEN
2946                      id_z = id_dim_zu1_xy(av)
[1]2947                   ENDIF
2948
2949!
2950!--                Define the grid
[1783]2951                   CALL netcdf_create_var( id_set_xy(av), (/ id_x, id_y, id_z, &
2952                                           id_dim_time_xy(av) /), do2d(av,i),  &
2953                                           nc_precision(1), id_var_do2d(av,i), &
2954                                           TRIM( do2d_unit(av,i) ),            &
[2696]2955                                           do2d(av,i), 119, 120, 354, .TRUE. )
[1]2956
2957                ENDIF
2958
[1031]2959#if defined( __netcdf4_parallel )
[1308]2960                IF ( netcdf_data_format > 4 )  THEN
[493]2961!
[1308]2962!--                Set no fill for every variable to increase performance.
2963                   nc_stat = NF90_DEF_VAR_FILL( id_set_xy(av),     &
2964                                                id_var_do2d(av,i), &
2965                                                1, 0 )
[1783]2966                   CALL netcdf_handle_error( 'netcdf_define_header', 533 )
[1308]2967!
2968!--                Set collective io operations for parallel io
[493]2969                   nc_stat = NF90_VAR_PAR_ACCESS( id_set_xy(av),     &
2970                                                  id_var_do2d(av,i), &
2971                                                  NF90_COLLECTIVE )
[1783]2972                   CALL netcdf_handle_error( 'netcdf_define_header', 448 )
[493]2973                ENDIF
2974#endif
[1783]2975                var_list = TRIM( var_list) // TRIM( do2d(av,i) ) // ';'
2976
[1]2977             ENDIF
2978
2979             i = i + 1
2980
2981          ENDDO
2982
2983!
2984!--       No arrays to output. Close the netcdf file and return.
2985          IF ( i == 1 )  RETURN
2986
2987!
2988!--       Write the list of variables as global attribute (this is used by
2989!--       restart runs and by combine_plot_fields)
2990          nc_stat = NF90_PUT_ATT( id_set_xy(av), NF90_GLOBAL, 'VAR_LIST', &
2991                                  var_list )
[1783]2992          CALL netcdf_handle_error( 'netcdf_define_header', 121 )
[1]2993
2994!
[1308]2995!--       Set general no fill, otherwise the performance drops significantly for
2996!--       parallel output.
2997          nc_stat = NF90_SET_FILL( id_set_xy(av), NF90_NOFILL, oldmode )
[1783]2998          CALL netcdf_handle_error( 'netcdf_define_header', 529 )
[1308]2999
3000!
[1031]3001!--       Leave netCDF define mode
[1]3002          nc_stat = NF90_ENDDEF( id_set_xy(av) )
[1783]3003          CALL netcdf_handle_error( 'netcdf_define_header', 122 )
[1]3004
3005!
[1308]3006!--       These data are only written by PE0 for parallel output to increase
3007!--       the performance.
3008          IF ( myid == 0  .OR.  netcdf_data_format < 5 )  THEN
[1]3009
3010!
[1308]3011!--          Write axis data: z_xy, x, y
3012             ALLOCATE( netcdf_data(1:ns) )
[1]3013
3014!
[1308]3015!--          Write zu data
3016             DO  i = 1, ns
3017                IF( section(i,1) == -1 )  THEN
[1353]3018                   netcdf_data(i) = -1.0_wp  ! section averaged along z
[1308]3019                ELSE
3020                   netcdf_data(i) = zu( section(i,1) )
3021                ENDIF
3022             ENDDO
3023             nc_stat = NF90_PUT_VAR( id_set_xy(av), id_var_zu_xy(av), &
3024                                     netcdf_data, start = (/ 1 /),    &
3025                                     count = (/ ns /) )
[1783]3026             CALL netcdf_handle_error( 'netcdf_define_header', 123 )
[1]3027
3028!
[1308]3029!--          Write zw data
3030             DO  i = 1, ns
3031                IF( section(i,1) == -1 )  THEN
[1353]3032                   netcdf_data(i) = -1.0_wp  ! section averaged along z
[1308]3033                ELSE
3034                   netcdf_data(i) = zw( section(i,1) )
3035                ENDIF
3036             ENDDO
3037             nc_stat = NF90_PUT_VAR( id_set_xy(av), id_var_zw_xy(av), &
3038                                     netcdf_data, start = (/ 1 /),    &
3039                                     count = (/ ns /) )
[1783]3040             CALL netcdf_handle_error( 'netcdf_define_header', 124 )
[1]3041
[1308]3042!
[1972]3043!--          Write zs data
[1551]3044             IF ( land_surface )  THEN
3045                ns_do = 0
3046                DO  i = 1, ns
3047                   IF( section(i,1) == -1 )  THEN
3048                      netcdf_data(i) = 1.0_wp  ! section averaged along z
3049                      ns_do = ns_do + 1
3050                   ELSEIF ( section(i,1) < nzs )  THEN
3051                      netcdf_data(i) = - zs( section(i,1) )
3052                      ns_do = ns_do + 1
3053                   ENDIF
3054                ENDDO
3055
3056                nc_stat = NF90_PUT_VAR( id_set_xy(av), id_var_zs_xy(av), &
3057                                        netcdf_data(1:ns_do), start = (/ 1 /),    &
3058                                        count = (/ ns_do /) )
[1783]3059                CALL netcdf_handle_error( 'netcdf_define_header', 124 )
[1551]3060
3061             ENDIF
3062
3063!
[1308]3064!--          Write gridpoint number data
3065             netcdf_data(1:ns) = section(1:ns,1)
3066             nc_stat = NF90_PUT_VAR( id_set_xy(av), id_var_ind_z_xy(av), &
3067                                     netcdf_data, start = (/ 1 /),       &
3068                                     count = (/ ns /) )
[1783]3069             CALL netcdf_handle_error( 'netcdf_define_header', 125 )
[1]3070
[1308]3071             DEALLOCATE( netcdf_data )
3072
[1]3073!
[1308]3074!--          Write the cross section height u*, t*
3075             nc_stat = NF90_PUT_VAR( id_set_xy(av), id_var_zu1_xy(av), &
3076                                     (/ zu(nzb+1) /), start = (/ 1 /), &
3077                                     count = (/ 1 /) )
[1783]3078             CALL netcdf_handle_error( 'netcdf_define_header', 126 )
[1]3079
3080!
[1308]3081!--          Write data for x (shifted by +dx/2) and xu axis
[2512]3082             ALLOCATE( netcdf_data(0:nx) )
[1]3083
[2512]3084             DO  i = 0, nx
[1353]3085                netcdf_data(i) = ( i + 0.5_wp ) * dx
[1308]3086             ENDDO
[1]3087
[1308]3088             nc_stat = NF90_PUT_VAR( id_set_xy(av), id_var_x_xy(av), &
3089                                     netcdf_data, start = (/ 1 /),   &
[2512]3090                                     count = (/ nx+1 /) )
[1783]3091             CALL netcdf_handle_error( 'netcdf_define_header', 127 )
[1]3092
[2512]3093             DO  i = 0, nx
[1308]3094                netcdf_data(i) = i * dx
3095             ENDDO
[1]3096
[1308]3097             nc_stat = NF90_PUT_VAR( id_set_xy(av), id_var_xu_xy(av), &
3098                                     netcdf_data, start = (/ 1 /),    &
[2512]3099                                     count = (/ nx+1 /) )
[1783]3100             CALL netcdf_handle_error( 'netcdf_define_header', 367 )
[1]3101
[1308]3102             DEALLOCATE( netcdf_data )
[1]3103
3104!
[1308]3105!--          Write data for y (shifted by +dy/2) and yv axis
3106             ALLOCATE( netcdf_data(0:ny+1) )
[1]3107
[2512]3108             DO  i = 0, ny
[1353]3109                netcdf_data(i) = ( i + 0.5_wp ) * dy
[1308]3110             ENDDO
[1]3111
[1308]3112             nc_stat = NF90_PUT_VAR( id_set_xy(av), id_var_y_xy(av), &
3113                                     netcdf_data, start = (/ 1 /),   &
[2512]3114                                     count = (/ ny+1 /))
[1783]3115             CALL netcdf_handle_error( 'netcdf_define_header', 128 )
[1]3116
[2512]3117             DO  i = 0, ny
[1308]3118                netcdf_data(i) = i * dy
3119             ENDDO
[1]3120
[1308]3121             nc_stat = NF90_PUT_VAR( id_set_xy(av), id_var_yv_xy(av), &
3122                                     netcdf_data, start = (/ 1 /),    &
[2512]3123                                     count = (/ ny+1 /))
[1783]3124             CALL netcdf_handle_error( 'netcdf_define_header', 368 )
[1]3125
[1308]3126             DEALLOCATE( netcdf_data )
[3421]3127!
3128!--          Write UTM coordinates
3129             IF ( init_model%rotation_angle == 0.0_wp )  THEN
3130!
3131!--             1D in case of no rotation
3132                cos_ra = COS( init_model%rotation_angle * pi / 180.0_wp )
3133!
3134!--             x coordinates
3135                ALLOCATE( netcdf_data(0:nx) )
3136                DO  k = 0, 2
3137!               
3138!--                Scalar grid points
3139                   IF ( k == 0 )  THEN
3140                      shift_x = 0.5
3141!               
3142!--                u grid points
3143                   ELSEIF ( k == 1 )  THEN
3144                      shift_x = 0.0
3145!               
3146!--                v grid points
3147                   ELSEIF ( k == 2 )  THEN
3148                      shift_x = 0.5
3149                   ENDIF
3150               
3151                   DO  i = 0, nx
3152                     netcdf_data(i) = init_model%origin_x            &
3153                                    + cos_ra * ( i + shift_x ) * dx
3154                   ENDDO
3155               
3156                   nc_stat = NF90_PUT_VAR( id_set_xy(av), id_var_eutm_xy(av,k),&
3157                                           netcdf_data, start = (/ 1 /),   &
3158                                           count = (/ nx+1 /) )
3159                   CALL netcdf_handle_error( 'netcdf_define_header', 555 )
[1]3160
[3421]3161                ENDDO
3162                DEALLOCATE( netcdf_data )
3163!
3164!--             y coordinates
3165                ALLOCATE( netcdf_data(0:ny) )
3166                DO  k = 0, 2
3167!
3168!--                Scalar grid points
3169                   IF ( k == 0 )  THEN
3170                      shift_y = 0.5
3171!
3172!--                u grid points
3173                   ELSEIF ( k == 1 )  THEN
3174                      shift_y = 0.5
3175!
3176!--                v grid points
3177                   ELSEIF ( k == 2 )  THEN
3178                      shift_y = 0.0
3179                   ENDIF
[2232]3180
[3421]3181                   DO  j = 0, ny
3182                      netcdf_data(j) = init_model%origin_y            &
3183                                     + cos_ra * ( j + shift_y ) * dy
3184                   ENDDO
3185
3186                   nc_stat = NF90_PUT_VAR( id_set_xy(av), id_var_nutm_xy(av,k),&
3187                                           netcdf_data, start = (/ 1 /),   &
3188                                           count = (/ ny+1 /) )
3189                   CALL netcdf_handle_error( 'netcdf_define_header', 556 )
3190
3191                ENDDO
3192                DEALLOCATE( netcdf_data )
3193
3194             ELSE
[48]3195!
[3421]3196!--             2D in case of rotation
3197                ALLOCATE( netcdf_data_2d(0:nx,0:ny) )
3198                cos_ra = COS( init_model%rotation_angle * pi / 180.0_wp )
3199                sin_ra = SIN( init_model%rotation_angle * pi / 180.0_wp )
3200               
3201                DO  k = 0, 2
3202!               
3203!--               Scalar grid points
3204                  IF ( k == 0 )  THEN
3205                     shift_x = 0.5 ; shift_y = 0.5
3206!               
3207!--               u grid points
3208                  ELSEIF ( k == 1 )  THEN
3209                     shift_x = 0.0 ; shift_y = 0.5
3210!               
3211!--               v grid points
3212                  ELSEIF ( k == 2 )  THEN
3213                     shift_x = 0.5 ; shift_y = 0.0
3214                  ENDIF
3215               
3216                  DO  j = 0, ny
3217                     DO  i = 0, nx
3218                        netcdf_data_2d(i,j) = init_model%origin_x            &
3219                                            + cos_ra * ( i + shift_x ) * dx  &
3220                                            + sin_ra * ( j + shift_y ) * dy
3221                     ENDDO
3222                  ENDDO
3223               
3224                  nc_stat = NF90_PUT_VAR( id_set_xy(av), id_var_eutm_xy(av,k),  &
3225                                          netcdf_data_2d, start = (/ 1, 1 /),   &
3226                                          count = (/ nx+1, ny+1 /) )
3227                  CALL netcdf_handle_error( 'netcdf_define_header', 555 )
3228               
3229                  DO  j = 0, ny
3230                     DO  i = 0, nx
3231                        netcdf_data_2d(i,j) = init_model%origin_y            &
3232                                            - sin_ra * ( i + shift_x ) * dx  &
3233                                            + cos_ra * ( j + shift_y ) * dy
3234                     ENDDO
3235                  ENDDO
3236               
3237                  nc_stat = NF90_PUT_VAR( id_set_xy(av), id_var_nutm_xy(av,k),  &
3238                                          netcdf_data_2d, start = (/ 1, 1 /),   &
3239                                          count = (/ nx+1, ny+1 /) )
3240                  CALL netcdf_handle_error( 'netcdf_define_header', 556 )
[3448]3241
[3421]3242                ENDDO
3243                DEALLOCATE( netcdf_data_2d )
3244             ENDIF
3245
3246          ENDIF
3247!
[3459]3248!--       Write lon and lat data. Only for parallel output.
3249          IF ( netcdf_data_format > 4 )  THEN
3250
3251             ALLOCATE( lat(nxl:nxr,nys:nyn) )
3252             ALLOCATE( lon(nxl:nxr,nys:nyn) )
3253             cos_ra = COS( init_model%rotation_angle * pi / 180.0_wp )
3254             sin_ra = SIN( init_model%rotation_angle * pi / 180.0_wp )
3255
3256             DO  k = 0, 2
3257!               
3258!--             Scalar grid points
3259                IF ( k == 0 )  THEN
3260                   shift_x = 0.5 ; shift_y = 0.5
3261!               
3262!--             u grid points
3263                ELSEIF ( k == 1 )  THEN
3264                   shift_x = 0.0 ; shift_y = 0.5
3265!               
3266!--             v grid points
3267                ELSEIF ( k == 2 )  THEN
3268                   shift_x = 0.5 ; shift_y = 0.0
3269                ENDIF
3270
3271                DO  j = nys, nyn
3272                   DO  i = nxl, nxr
3273                      eutm = init_model%origin_x            &
3274                           + cos_ra * ( i + shift_x ) * dx  &
3275                           + sin_ra * ( j + shift_y ) * dy
3276                      nutm = init_model%origin_y            &
3277                           - sin_ra * ( i + shift_x ) * dx  &
3278                           + cos_ra * ( j + shift_y ) * dy
3279
3280                      CALL  convert_utm_to_geographic( crs_list,          &
3281                                                       eutm, nutm,        &
3282                                                       lon(i,j), lat(i,j) )
3283                   ENDDO
3284                ENDDO
3285
3286                nc_stat = NF90_PUT_VAR( id_set_xy(av), id_var_lon_xy(av,k), &
3287                                     lon, start = (/ nxl+1, nys+1 /),       &
3288                                     count = (/ nxr-nxl+1, nyn-nys+1 /) )
3289                CALL netcdf_handle_error( 'netcdf_define_header', 556 )
3290
3291                nc_stat = NF90_PUT_VAR( id_set_xy(av), id_var_lat_xy(av,k), &
3292                                     lat, start = (/ nxl+1, nys+1 /),       &
3293                                     count = (/ nxr-nxl+1, nyn-nys+1 /) )
3294                CALL netcdf_handle_error( 'netcdf_define_header', 556 )
3295             ENDDO
3296
3297             DEALLOCATE( lat )
3298             DEALLOCATE( lon )
3299
3300          ENDIF
3301!
[2232]3302!--       In case of non-flat topography write height information. Only for
3303!--       parallel netcdf output.
3304          IF ( TRIM( topography ) /= 'flat'  .AND.                             &
3305               netcdf_data_format > 4  )  THEN
[1]3306
[2512]3307!             IF ( nxr == nx  .AND.  nyn /= ny )  THEN
3308!                nc_stat = NF90_PUT_VAR( id_set_xy(av), id_var_zusi_xy(av),     &
3309!                                        zu_s_inner(nxl:nxr+1,nys:nyn),         &
3310!                                        start = (/ nxl+1, nys+1 /),            &
3311!                                        count = (/ nxr-nxl+2, nyn-nys+1 /) )
3312!             ELSEIF ( nxr /= nx  .AND.  nyn == ny )  THEN
3313!                nc_stat = NF90_PUT_VAR( id_set_xy(av), id_var_zusi_xy(av),     &
3314!                                        zu_s_inner(nxl:nxr,nys:nyn+1),         &
3315!                                        start = (/ nxl+1, nys+1 /),            &
3316!                                        count = (/ nxr-nxl+1, nyn-nys+2 /) )
3317!             ELSEIF ( nxr == nx  .AND.  nyn == ny )  THEN
3318!                nc_stat = NF90_PUT_VAR( id_set_xy(av), id_var_zusi_xy(av),     &
3319!                                        zu_s_inner(nxl:nxr+1,nys:nyn+1),       &
3320!                                        start = (/ nxl+1, nys+1 /),            &
3321!                                        count = (/ nxr-nxl+2, nyn-nys+2 /) )
3322!             ELSE
[2232]3323                nc_stat = NF90_PUT_VAR( id_set_xy(av), id_var_zusi_xy(av),     &
3324                                        zu_s_inner(nxl:nxr,nys:nyn),           &
3325                                        start = (/ nxl+1, nys+1 /),            &
3326                                        count = (/ nxr-nxl+1, nyn-nys+1 /) )
[2512]3327!             ENDIF
[2232]3328             CALL netcdf_handle_error( 'netcdf_define_header', 427 )
[48]3329
[2512]3330!             IF ( nxr == nx  .AND.  nyn /= ny )  THEN
3331!                nc_stat = NF90_PUT_VAR( id_set_xy(av), id_var_zwwi_xy(av),     &
3332!                                        zw_w_inner(nxl:nxr+1,nys:nyn),         &
3333!                                        start = (/ nxl+1, nys+1 /),            &
3334!                                        count = (/ nxr-nxl+2, nyn-nys+1 /) )
3335!             ELSEIF ( nxr /= nx  .AND.  nyn == ny )  THEN
3336!                nc_stat = NF90_PUT_VAR( id_set_xy(av), id_var_zwwi_xy(av),     &
3337!                                        zw_w_inner(nxl:nxr,nys:nyn+1),         &
3338!                                        start = (/ nxl+1, nys+1 /),            &
3339!                                        count = (/ nxr-nxl+1, nyn-nys+2 /) )
3340!             ELSEIF ( nxr == nx  .AND.  nyn == ny )  THEN
3341!                nc_stat = NF90_PUT_VAR( id_set_xy(av), id_var_zwwi_xy(av),     &
3342!                                        zw_w_inner(nxl:nxr+1,nys:nyn+1),       &
3343!                                        start = (/ nxl+1, nys+1 /),            &
3344!                                        count = (/ nxr-nxl+2, nyn-nys+2 /) )
3345!             ELSE
[2232]3346                nc_stat = NF90_PUT_VAR( id_set_xy(av), id_var_zwwi_xy(av),     &
3347                                        zw_w_inner(nxl:nxr,nys:nyn),           &
3348                                        start = (/ nxl+1, nys+1 /),            &
3349                                        count = (/ nxr-nxl+1, nyn-nys+1 /) )
[2512]3350!             ENDIF
[2232]3351             CALL netcdf_handle_error( 'netcdf_define_header', 428 )
[1551]3352
[48]3353          ENDIF
3354
[1]3355       CASE ( 'xy_ext' )
3356
3357!
3358!--       Get the list of variables and compare with the actual run.
3359!--       First var_list_old has to be reset, since GET_ATT does not assign
3360!--       trailing blanks.
3361          var_list_old = ' '
3362          nc_stat = NF90_GET_ATT( id_set_xy(av), NF90_GLOBAL, 'VAR_LIST', &
3363                                  var_list_old )
[1783]3364          CALL netcdf_handle_error( 'netcdf_define_header', 129 )
[1]3365
3366          var_list = ';'
3367          i = 1
3368          DO WHILE ( do2d(av,i)(1:1) /= ' ' )
3369             IF ( INDEX( do2d(av,i), 'xy' ) /= 0 )  THEN
[519]3370                var_list = TRIM( var_list ) // TRIM( do2d(av,i) ) // ';'
[1]3371             ENDIF
3372             i = i + 1
3373          ENDDO
3374
3375          IF ( av == 0 )  THEN
3376             var = '(xy)'
3377          ELSE
3378             var = '(xy_av)'
3379          ENDIF
3380
3381          IF ( TRIM( var_list ) /= TRIM( var_list_old ) )  THEN
[1031]3382             message_string = 'netCDF file for cross-sections ' //           &
[292]3383                              TRIM( var ) // ' from previous run found,' //  &
[3046]3384                              '&but this file cannot be extended due to' //  &
[257]3385                              ' variable mismatch.' //                       &
[3046]3386                              '&New file is created instead.'
[257]3387             CALL message( 'define_netcdf_header', 'PA0249', 0, 1, 0, 6, 0 )
[1]3388             extend = .FALSE.
3389             RETURN
3390          ENDIF
3391
3392!
3393!--       Calculate the number of current sections
3394          ns = 1
3395          DO WHILE ( section(ns,1) /= -9999  .AND.  ns <= 100 )
3396             ns = ns + 1
3397          ENDDO
3398          ns = ns - 1
3399
3400!
3401!--       Get and compare the number of horizontal cross sections
3402          nc_stat = NF90_INQ_VARID( id_set_xy(av), 'zu_xy', id_var_zu_xy(av) )
[1783]3403          CALL netcdf_handle_error( 'netcdf_define_header', 130 )
[1]3404
3405          nc_stat = NF90_INQUIRE_VARIABLE( id_set_xy(av), id_var_zu_xy(av), &
3406                                           dimids = id_dim_zu_xy_old )
[1783]3407          CALL netcdf_handle_error( 'netcdf_define_header', 131 )
[1]3408          id_dim_zu_xy(av) = id_dim_zu_xy_old(1)
3409
3410          nc_stat = NF90_INQUIRE_DIMENSION( id_set_xy(av), id_dim_zu_xy(av), &
3411                                            len = ns_old )
[1783]3412          CALL netcdf_handle_error( 'netcdf_define_header', 132 )
[1]3413
3414          IF ( ns /= ns_old )  THEN
[1031]3415             message_string = 'netCDF file for cross-sections ' //          &
[292]3416                              TRIM( var ) // ' from previous run found,' // &
[3046]3417                              '&but this file cannot be extended due to' // &
[257]3418                              ' mismatch in number of' //                   &
[3045]3419                              ' cross sections.' //                         &
[3046]3420                              '&New file is created instead.'
[257]3421             CALL message( 'define_netcdf_header', 'PA0250', 0, 1, 0, 6, 0 )
[1]3422             extend = .FALSE.
3423             RETURN
3424          ENDIF
3425
3426!
3427!--       Get and compare the heights of the cross sections
3428          ALLOCATE( netcdf_data(1:ns_old) )
3429
3430          nc_stat = NF90_GET_VAR( id_set_xy(av), id_var_zu_xy(av), netcdf_data )
[1783]3431          CALL netcdf_handle_error( 'netcdf_define_header', 133 )
[1]3432
3433          DO  i = 1, ns
3434             IF ( section(i,1) /= -1 )  THEN
3435                IF ( zu(section(i,1)) /= netcdf_data(i) )  THEN
[3045]3436                   message_string = 'netCDF file for cross-sections ' //       &
3437                               TRIM( var ) // ' from previous run found,' //   &
3438                               ' but this file cannot be extended' //          &
3439                               ' due to mismatch in cross' //                  &
3440                               ' section levels.' //                           &
3441                               ' New file is created instead.'
3442                   CALL message( 'define_netcdf_header', 'PA0251',             &
[274]3443                                                                 0, 1, 0, 6, 0 )
[1]3444                   extend = .FALSE.
3445                   RETURN
3446                ENDIF
3447             ELSE
[1353]3448                IF ( -1.0_wp /= netcdf_data(i) )  THEN
[3045]3449                   message_string = 'netCDF file for cross-sections ' //       &
3450                               TRIM( var ) // ' from previous run found,' //   &
3451                               ' but this file cannot be extended' //          &
3452                               ' due to mismatch in cross' //                  &
3453                               ' section levels.' //                           &
3454                               ' New file is created instead.'
3455                   CALL message( 'define_netcdf_header', 'PA0251',             &
[274]3456                                                                 0, 1, 0, 6, 0 )
[1]3457                   extend = .FALSE.
3458                   RETURN
3459                ENDIF
3460             ENDIF
3461          ENDDO
3462
3463          DEALLOCATE( netcdf_data )
3464
3465!
3466!--       Get the id of the time coordinate (unlimited coordinate) and its
3467!--       last index on the file. The next time level is do2d..count+1.
3468!--       The current time must be larger than the last output time
3469!--       on the file.
3470          nc_stat = NF90_INQ_VARID( id_set_xy(av), 'time', id_var_time_xy(av) )
[1783]3471          CALL netcdf_handle_error( 'netcdf_define_header', 134 )
[1]3472
3473          nc_stat = NF90_INQUIRE_VARIABLE( id_set_xy(av), id_var_time_xy(av), &
3474                                           dimids = id_dim_time_old )
[1783]3475          CALL netcdf_handle_error( 'netcdf_define_header', 135 )
[1]3476          id_dim_time_xy(av) = id_dim_time_old(1)
3477
3478          nc_stat = NF90_INQUIRE_DIMENSION( id_set_xy(av), id_dim_time_xy(av), &
[1308]3479                                            len = ntime_count )
[1783]3480          CALL netcdf_handle_error( 'netcdf_define_header', 136 )
[1]3481
[1308]3482!
3483!--       For non-parallel output use the last output time level of the netcdf
3484!--       file because the time dimension is unlimited. In case of parallel
3485!--       output the variable ntime_count could get the value of 9*10E36 because
3486!--       the time dimension is limited.
3487          IF ( netcdf_data_format < 5 ) do2d_xy_time_count(av) = ntime_count
3488
[3045]3489          nc_stat = NF90_GET_VAR( id_set_xy(av), id_var_time_xy(av),           &
3490                                  last_time_coordinate,                        &
3491                                  start = (/ do2d_xy_time_count(av) /),        &
[1]3492                                  count = (/ 1 /) )
[1783]3493          CALL netcdf_handle_error( 'netcdf_define_header', 137 )
[1]3494
3495          IF ( last_time_coordinate(1) >= simulated_time )  THEN
[3045]3496             message_string = 'netCDF file for cross sections ' //             &
3497                              TRIM( var ) // ' from previous run found,' //    &
[3046]3498                              '&but this file cannot be extended becaus' //    &
[3045]3499                              'e the current output time' //                   &
[3046]3500                              '&is less or equal than the last output t' //    &
[3045]3501                              'ime on this file.' //                           &
[3046]3502                              '&New file is created instead.'
[257]3503             CALL message( 'define_netcdf_header', 'PA0252', 0, 1, 0, 6, 0 )
[1]3504             do2d_xy_time_count(av) = 0
3505             extend = .FALSE.
3506             RETURN
3507          ENDIF
3508
[1308]3509          IF ( netcdf_data_format > 4 )  THEN
[1745]3510!
3511!--          Check if the needed number of output time levels is increased
3512!--          compared to the number of time levels in the existing file.
[1308]3513             IF ( ntdim_2d_xy(av) > ntime_count )  THEN
3514                message_string = 'netCDF file for cross sections ' //          &
3515                                 TRIM( var ) // ' from previous run found,' // &
[3046]3516                                 '&but this file cannot be extended becaus' // &
[3045]3517                                 'e the number of output time levels has b' // &
[1308]3518                                 'een increased compared to the previous s' // &
[1745]3519                                 'imulation.' //                               &
[3046]3520                                 '&New file is created instead.'
[1308]3521                CALL message( 'define_netcdf_header', 'PA0389', 0, 1, 0, 6, 0 )
3522                do2d_xy_time_count(av) = 0
3523                extend = .FALSE.
[1745]3524!
3525!--             Recalculate the needed time levels for the new file.
3526                IF ( av == 0 )  THEN
3527                   ntdim_2d_xy(0) = CEILING(                            &
3528                           ( end_time - MAX( skip_time_do2d_xy,         &
3529                                             simulated_time_at_begin )  &
3530                           ) / dt_do2d_xy )
[2769]3531                   IF ( do2d_at_begin )  ntdim_2d_xy(0) = ntdim_2d_xy(0) + 1
[1745]3532                ELSE
3533                   ntdim_2d_xy(1) = CEILING(                            &
3534                           ( end_time - MAX( skip_time_data_output_av,  &
3535                                             simulated_time_at_begin )  &
3536                           ) / dt_data_output_av )
3537                ENDIF
[1308]3538                RETURN
3539             ENDIF
3540          ENDIF
3541
[1]3542!
3543!--       Dataset seems to be extendable.
3544!--       Now get the variable ids.
3545          i = 1
3546          DO WHILE ( do2d(av,i)(1:1) /= ' ' )
3547             IF ( INDEX( do2d(av,i), 'xy' ) /= 0 )  THEN
[519]3548                nc_stat = NF90_INQ_VARID( id_set_xy(av), do2d(av,i), &
[1]3549                                          id_var_do2d(av,i) )
[1783]3550                CALL netcdf_handle_error( 'netcdf_define_header', 138 )
[1031]3551#if defined( __netcdf4_parallel )
[493]3552!
3553!--             Set collective io operations for parallel io
[1031]3554                IF ( netcdf_data_format > 4 )  THEN
[493]3555                   nc_stat = NF90_VAR_PAR_ACCESS( id_set_xy(av),     &
3556                                                  id_var_do2d(av,i), &
3557                                                  NF90_COLLECTIVE )
[1783]3558                   CALL netcdf_handle_error( 'netcdf_define_header', 454 )
[493]3559                ENDIF
3560#endif
[1]3561             ENDIF
3562             i = i + 1
3563          ENDDO
3564
3565!
[359]3566!--       Update the title attribute on file
3567!--       In order to avoid 'data mode' errors if updated attributes are larger
3568!--       than their original size, NF90_PUT_ATT is called in 'define mode'
3569!--       enclosed by NF90_REDEF and NF90_ENDDEF calls. This implies a possible
3570!--       performance loss due to data copying; an alternative strategy would be
3571!--       to ensure equal attribute size in a job chain. Maybe revise later.
3572          IF ( av == 0 )  THEN
3573             time_average_text = ' '
3574          ELSE
3575             WRITE (time_average_text, '('', '',F7.1,'' s average'')') &
3576                                                            averaging_interval
3577          ENDIF
3578          nc_stat = NF90_REDEF( id_set_xy(av) )
[1783]3579          CALL netcdf_handle_error( 'netcdf_define_header', 431 )
[3045]3580          nc_stat = NF90_PUT_ATT( id_set_xy(av), NF90_GLOBAL, 'title',         &
3581                                  TRIM( run_description_header ) //            &
[359]3582                                  TRIM( time_average_text ) )
[1783]3583          CALL netcdf_handle_error( 'netcdf_define_header', 139 )
[359]3584          nc_stat = NF90_ENDDEF( id_set_xy(av) )
[1783]3585          CALL netcdf_handle_error( 'netcdf_define_header', 432 )
[3045]3586          message_string = 'netCDF file for cross-sections ' //                &
3587                            TRIM( var ) // ' from previous run found.' //      &
[3046]3588                           '&This file will be extended.'
[257]3589          CALL message( 'define_netcdf_header', 'PA0253', 0, 0, 0, 6, 0 )
3590         
[1]3591
3592       CASE ( 'xz_new' )
3593
3594!
3595!--       Define some global attributes of the dataset
3596          IF ( av == 0 )  THEN
[3529]3597             CALL netcdf_create_global_atts( id_set_xz(av), 'xz', TRIM( run_description_header ), 140 )
[1]3598             time_average_text = ' '
3599          ELSE
[3529]3600             CALL netcdf_create_global_atts( id_set_xz(av), 'xz_av', TRIM( run_description_header ), 140 )
[1]3601             WRITE ( time_average_text,'(F7.1,'' s avg'')' )  averaging_interval
[3529]3602             nc_stat = NF90_PUT_ATT( id_set_xz(av), NF90_GLOBAL, 'time_avg',   &
[1]3603                                     TRIM( time_average_text ) )
[1783]3604             CALL netcdf_handle_error( 'netcdf_define_header', 141 )
[1]3605          ENDIF
3606
3607!
[1308]3608!--       Define time coordinate for xz sections.
3609!--       For parallel output the time dimensions has to be limited, otherwise
3610!--       the performance drops significantly.
3611          IF ( netcdf_data_format < 5 )  THEN
[1783]3612             CALL netcdf_create_dim( id_set_xz(av), 'time', NF90_UNLIMITED,    &
3613                                     id_dim_time_xz(av), 142 )
[1308]3614          ELSE
[1783]3615             CALL netcdf_create_dim( id_set_xz(av), 'time', ntdim_2d_xz(av),   &
3616                                     id_dim_time_xz(av), 525 )
[1308]3617          ENDIF
[1]3618
[1783]3619          CALL netcdf_create_var( id_set_xz(av), (/ id_dim_time_xz(av) /),     &
3620                                  'time', NF90_DOUBLE, id_var_time_xz(av),     &
[3529]3621                                  'seconds since '//TRIM(init_model%origin_time), 'time', 143, 144, 000 )
3622          CALL netcdf_create_att( id_set_xz(av), id_var_time_xz(av), 'standard_name', 'time', 000)
3623          CALL netcdf_create_att( id_set_xz(av), id_var_time_xz(av), 'axis', 'T', 000)
[1]3624!
3625!--       Define the spatial dimensions and coordinates for xz-sections.
3626!--       First, determine the number of vertical sections to be written.
3627          IF ( section(1,2) == -9999 )  THEN
3628             RETURN
3629          ELSE
3630             ns = 1
3631             DO WHILE ( section(ns,2) /= -9999  .AND.  ns <= 100 )
3632                ns = ns + 1
3633             ENDDO
3634             ns = ns - 1
3635          ENDIF
3636
3637!
3638!--       Define y-axis (for scalar position)
[1783]3639          CALL netcdf_create_dim( id_set_xz(av), 'y_xz', ns, id_dim_y_xz(av),  &
3640                                  145 )
3641          CALL netcdf_create_var( id_set_xz(av), (/ id_dim_y_xz(av) /),        &
3642                                  'y_xz', NF90_DOUBLE, id_var_y_xz(av),        &
3643                                  'meters', '', 146, 147, 000 )
[1]3644!
3645!--       Define y-axis (for v position)
[1783]3646          CALL netcdf_create_dim( id_set_xz(av), 'yv_xz', ns,                  &
3647                                  id_dim_yv_xz(av), 369 )
3648          CALL netcdf_create_var( id_set_xz(av), (/ id_dim_yv_xz(av) /),       &
3649                                  'yv_xz', NF90_DOUBLE, id_var_yv_xz(av),      &
3650                                  'meters', '', 370, 371, 000 )
[1]3651!
3652!--       Define a variable to store the layer indices of the vertical cross
3653!--       sections
[1783]3654          CALL netcdf_create_var( id_set_xz(av), (/ id_dim_y_xz(av) /),        &
3655                                  'ind_y_xz', NF90_DOUBLE,                     &
3656                                  id_var_ind_y_xz(av), 'gridpoints', '', 148,  &
3657                                  149, 000 )
[1]3658!
3659!--       Define x-axis (for scalar position)
[2512]3660          CALL netcdf_create_dim( id_set_xz(av), 'x', nx+1, id_dim_x_xz(av),   &
[1783]3661                                  150 )
3662          CALL netcdf_create_var( id_set_xz(av), (/ id_dim_x_xz(av) /), 'x',   &
3663                                  NF90_DOUBLE, id_var_x_xz(av), 'meters', '',  &
3664                                  151, 152, 000 )
[1]3665!
3666!--       Define x-axis (for u position)
[2512]3667          CALL netcdf_create_dim( id_set_xz(av), 'xu', nx+1, id_dim_xu_xz(av), &
[1783]3668                                  372 )
3669          CALL netcdf_create_var( id_set_xz(av), (/ id_dim_xu_xz(av) /), 'xu', &
3670                                  NF90_DOUBLE, id_var_xu_xz(av), 'meters', '', &
3671                                  373, 374, 000 )
[1]3672!
[1551]3673!--       Define the three z-axes (zu, zw, and zs)
[1783]3674          CALL netcdf_create_dim( id_set_xz(av), 'zu', nz+2, id_dim_zu_xz(av), &
3675                                  153 )
3676          CALL netcdf_create_var( id_set_xz(av), (/ id_dim_zu_xz(av) /), 'zu', &
3677                                  NF90_DOUBLE, id_var_zu_xz(av), 'meters', '', &
3678                                  154, 155, 000 )
3679          CALL netcdf_create_dim( id_set_xz(av), 'zw', nz+2, id_dim_zw_xz(av), &
3680                                  156 )
3681          CALL netcdf_create_var( id_set_xz(av), (/ id_dim_zw_xz(av) /), 'zw', &
3682                                  NF90_DOUBLE, id_var_zw_xz(av), 'meters', '', &
3683                                  157, 158, 000 )
[3421]3684!
[3529]3685!--       Define UTM and geographic coordinates
3686          CALL define_geo_coordinates( id_set_xz(av),         &
3687                  (/ id_dim_x_xz(av), id_dim_xu_xz(av) /),    &
3688                  (/ id_dim_y_xz(av), id_dim_yv_xz(av) /),    &
3689                  id_var_eutm_xz(av,:), id_var_nutm_xz(av,:), &
3690                  id_var_lat_xz(av,:), id_var_lon_xz(av,:)    )
[3459]3691!
3692!--       Define coordinate-reference system
3693          CALL netcdf_create_crs( id_set_xz(av), 000 )
[1]3694
[1551]3695          IF ( land_surface )  THEN
[1]3696
[1783]3697             CALL netcdf_create_dim( id_set_xz(av), 'zs', nzs,                 &
3698                                     id_dim_zs_xz(av), 542 )
3699             CALL netcdf_create_var( id_set_xz(av), (/ id_dim_zs_xz(av) /),    &
3700                                     'zs', NF90_DOUBLE, id_var_zs_xz(av),      &
3701                                     'meters', '', 543, 544, 000 )
[1551]3702
3703          ENDIF
3704
[1]3705!
3706!--       Define the variables
3707          var_list = ';'
3708          i = 1
3709
3710          DO WHILE ( do2d(av,i)(1:1) /= ' ' )
3711
3712             IF ( INDEX( do2d(av,i), 'xz' ) /= 0 )  THEN
3713
3714!
3715!--             Check for the grid
[1980]3716                found = .FALSE.
[1]3717                SELECT CASE ( do2d(av,i) )
3718!
3719!--                Most variables are defined on the zu grid
[3421]3720                   CASE ( 'e_xz', 'nc_xz', 'nr_xz', 'p_xz', 'pc_xz',           &
3721                          'pr_xz', 'prr_xz', 'q_xz', 'qc_xz',                  &
[2292]3722                          'ql_xz', 'ql_c_xz', 'ql_v_xz', 'ql_vp_xz', 'qr_xz',  &
[3421]3723                          'qv_xz', 's_xz',                                     &
3724                          'theta_xz', 'thetal_xz', 'thetav_xz'                 )
[1]3725
3726                      grid_x = 'x'
3727                      grid_y = 'y'
3728                      grid_z = 'zu'
3729!
3730!--                u grid
3731                   CASE ( 'u_xz' )
3732
3733                      grid_x = 'xu'
3734                      grid_y = 'y'
3735                      grid_z = 'zu'
3736!
3737!--                v grid
3738                   CASE ( 'v_xz' )
3739
3740                      grid_x = 'x'
3741                      grid_y = 'yv'
3742                      grid_z = 'zu'
3743!
3744!--                w grid
[1976]3745                   CASE ( 'w_xz' )
[1]3746
3747                      grid_x = 'x'
3748                      grid_y = 'y'
3749                      grid_z = 'zw'
3750
[1976]3751                   CASE DEFAULT
3752
[1551]3753!
[1976]3754!--                   Check for land surface quantities
3755                      IF ( land_surface )  THEN
3756                         CALL lsm_define_netcdf_grid( do2d(av,i), found,       &
3757                                                      grid_x, grid_y, grid_z )
3758                      ENDIF
[1551]3759
[2696]3760                      IF ( .NOT. found )  THEN
3761                         CALL tcm_define_netcdf_grid( do2d(av,i), found,       &
3762                                                      grid_x, grid_y, grid_z )
3763                      ENDIF
3764
[1976]3765!
[3421]3766!--                   Check for ocean quantities
3767                      IF ( .NOT. found  .AND.  ocean_mode )  THEN
3768                         CALL ocean_define_netcdf_grid( do2d(av,i), found,  &
3769                                                        grid_x, grid_y, grid_z )
3770                      ENDIF
3771!
[1976]3772!--                   Check for radiation quantities
3773                      IF ( .NOT. found  .AND.  radiation )  THEN
3774                         CALL radiation_define_netcdf_grid( do2d(av,i), found, &
3775                                                            grid_x, grid_y,    &
3776                                                            grid_z )
3777                      ENDIF
[3467]3778!
3779!--                   Check for SALSA quantities
3780                      IF ( .NOT. found  .AND.  salsa )  THEN
3781                         CALL salsa_define_netcdf_grid( do2d(av,i), found,     &
3782                                                        grid_x, grid_y, grid_z )
3783                      ENDIF                         
[1551]3784
[1]3785!
[2817]3786!--                   Check for gust module quantities
3787                      IF ( .NOT. found  .AND.  gust_module_enabled )  THEN
3788                         CALL gust_define_netcdf_grid( do2d(av,i), found,      &
3789                                                       grid_x, grid_y, grid_z )
3790                      ENDIF
3791
3792!
[2696]3793!--                   Check for chemistry quantities
3794                      IF ( .NOT. found  .AND.  air_chemistry )  THEN
3795                         CALL chem_define_netcdf_grid( do2d(av,i), found,      &
3796                                                       grid_x, grid_y,         &
3797                                                       grid_z )
3798                      ENDIF
3799
3800!
[1]3801!--                   Check for user-defined quantities
[3701]3802                      IF ( .NOT. found  .AND.  user_module_enabled )  THEN
[1976]3803                         CALL user_define_netcdf_grid( do2d(av,i), found,      &
3804                                                       grid_x, grid_y, grid_z )
3805                      ENDIF
3806
3807                      IF ( .NOT. found )  THEN
[3045]3808                         WRITE ( message_string, * ) 'no grid defined for',    &
[1783]3809                                                ' variable ', TRIM( do2d(av,i) )
[3045]3810                         CALL message( 'define_netcdf_header', 'PA0244',       &
[1783]3811                                       0, 1, 0, 6, 0 )
3812                      ENDIF
[1]3813
3814                END SELECT
3815
3816!
3817!--             Select the respective dimension ids
3818                IF ( grid_x == 'x' )  THEN
3819                   id_x = id_dim_x_xz(av)
3820                ELSEIF ( grid_x == 'xu' )  THEN
3821                   id_x = id_dim_xu_xz(av)
3822                ENDIF
3823
3824                IF ( grid_y == 'y' )  THEN
3825                   id_y = id_dim_y_xz(av)
3826                ELSEIF ( grid_y == 'yv' )  THEN
3827                   id_y = id_dim_yv_xz(av)
3828                ENDIF
3829
3830                IF ( grid_z == 'zu' )  THEN
3831                   id_z = id_dim_zu_xz(av)
3832                ELSEIF ( grid_z == 'zw' )  THEN
3833                   id_z = id_dim_zw_xz(av)
[1551]3834                ELSEIF ( grid_z == 'zs' )  THEN
3835                   id_z = id_dim_zs_xz(av)
[1]3836                ENDIF
3837
3838!
3839!--             Define the grid
[1783]3840                CALL netcdf_create_var( id_set_xz(av), (/ id_x, id_y, id_z,    &
3841                                        id_dim_time_xz(av) /), do2d(av,i),     &
3842                                        nc_precision(2), id_var_do2d(av,i),    &
3843                                        TRIM( do2d_unit(av,i) ), do2d(av,i),   &
[2696]3844                                        159, 160, 355, .TRUE. )
[1]3845
[1031]3846#if defined( __netcdf4_parallel )
[1308]3847
3848                IF ( netcdf_data_format > 4 )  THEN
[493]3849!
[1308]3850!--                Set no fill for every variable to increase performance.
3851                   nc_stat = NF90_DEF_VAR_FILL( id_set_xz(av),     &
3852                                                id_var_do2d(av,i), &
3853                                                1, 0 )
[1783]3854                   CALL netcdf_handle_error( 'netcdf_define_header', 534 )
[1308]3855!
3856!--                Set independent io operations for parallel io. Collective io
3857!--                is only allowed in case of a 1d-decomposition along x,
3858!--                because otherwise, not all PEs have output data.
[493]3859                   IF ( npey == 1 )  THEN
3860                      nc_stat = NF90_VAR_PAR_ACCESS( id_set_xz(av),     &
3861                                                     id_var_do2d(av,i), &
3862                                                     NF90_COLLECTIVE )
3863                   ELSE
3864!
[1308]3865!--                   Test simulations showed that the output of cross sections
3866!--                   by all PEs in data_output_2d using NF90_COLLECTIVE is
3867!--                   faster than the output by the first row of PEs in
3868!--                   x-direction using NF90_INDEPENDENT.
3869                      nc_stat = NF90_VAR_PAR_ACCESS( id_set_xz(av),    & 
3870                                                    id_var_do2d(av,i), &
3871                                                    NF90_COLLECTIVE )
[493]3872!                      nc_stat = NF90_VAR_PAR_ACCESS( id_set_xz(av),     &
3873!                                                     id_var_do2d(av,i), &
3874!                                                     NF90_INDEPENDENT )
3875                   ENDIF
[1783]3876                   CALL netcdf_handle_error( 'netcdf_define_header', 449 )
[493]3877                ENDIF
3878#endif
[1783]3879                var_list = TRIM( var_list ) // TRIM( do2d(av,i) ) // ';'
3880
[1]3881             ENDIF
3882
3883             i = i + 1
3884
3885          ENDDO
3886
3887!
3888!--       No arrays to output. Close the netcdf file and return.
3889          IF ( i == 1 )  RETURN
3890
3891!
3892!--       Write the list of variables as global attribute (this is used by
3893!--       restart runs and by combine_plot_fields)
3894          nc_stat = NF90_PUT_ATT( id_set_xz(av), NF90_GLOBAL, 'VAR_LIST', &
3895                                  var_list )
[1783]3896          CALL netcdf_handle_error( 'netcdf_define_header', 161 )
[1]3897
3898!
[1308]3899!--       Set general no fill, otherwise the performance drops significantly for
3900!--       parallel output.
3901          nc_stat = NF90_SET_FILL( id_set_xz(av), NF90_NOFILL, oldmode )
[1783]3902          CALL netcdf_handle_error( 'netcdf_define_header', 530 )
[1308]3903
3904!
[1031]3905!--       Leave netCDF define mode
[1]3906          nc_stat = NF90_ENDDEF( id_set_xz(av) )
[1783]3907          CALL netcdf_handle_error( 'netcdf_define_header', 162 )
[1]3908
3909!
[1308]3910!--       These data are only written by PE0 for parallel output to increase
3911!--       the performance.
3912          IF ( myid == 0  .OR.  netcdf_data_format < 5 )  THEN
[1]3913
3914!
[1308]3915!--          Write axis data: y_xz, x, zu, zw
3916             ALLOCATE( netcdf_data(1:ns) )
[1]3917
3918!
[1308]3919!--          Write y_xz data (shifted by +dy/2)
3920             DO  i = 1, ns
3921                IF( section(i,2) == -1 )  THEN
[1353]3922                   netcdf_data(i) = -1.0_wp  ! section averaged along y
[1308]3923                ELSE
[1353]3924                   netcdf_data(i) = ( section(i,2) + 0.5_wp ) * dy
[1308]3925                ENDIF
3926             ENDDO
3927             nc_stat = NF90_PUT_VAR( id_set_xz(av), id_var_y_xz(av), &
3928                                     netcdf_data, start = (/ 1 /),   &
3929                                     count = (/ ns /) )
[1783]3930             CALL netcdf_handle_error( 'netcdf_define_header', 163 )
[1]3931
3932!
[1308]3933!--          Write yv_xz data
3934             DO  i = 1, ns
3935                IF( section(i,2) == -1 )  THEN
[1353]3936                   netcdf_data(i) = -1.0_wp  ! section averaged along y
[1308]3937                ELSE
3938                   netcdf_data(i) = section(i,2) * dy
3939                ENDIF
3940             ENDDO
3941             nc_stat = NF90_PUT_VAR( id_set_xz(av), id_var_yv_xz(av), &
3942                                     netcdf_data, start = (/ 1 /),    &
3943                                     count = (/ ns /) )
[1783]3944             CALL netcdf_handle_error( 'netcdf_define_header', 375 )
[1]3945
[1308]3946!
3947!--          Write gridpoint number data
3948             netcdf_data(1:ns) = section(1:ns,2)
3949             nc_stat = NF90_PUT_VAR( id_set_xz(av), id_var_ind_y_xz(av), &
3950                                     netcdf_data, start = (/ 1 /),       &
3951                                     count = (/ ns /) )
[1783]3952             CALL netcdf_handle_error( 'netcdf_define_header', 164 )
[263]3953
[1]3954
[1308]3955             DEALLOCATE( netcdf_data )
3956
[1]3957!
[1308]3958!--          Write data for x (shifted by +dx/2) and xu axis
[2512]3959             ALLOCATE( netcdf_data(0:nx) )
[1]3960
[2512]3961             DO  i = 0, nx
[1353]3962                netcdf_data(i) = ( i + 0.5_wp ) * dx
[1308]3963             ENDDO
[1]3964
[1308]3965             nc_stat = NF90_PUT_VAR( id_set_xz(av), id_var_x_xz(av), &
3966                                     netcdf_data, start = (/ 1 /),   &
[2512]3967                                     count = (/ nx+1 /) )
[1783]3968             CALL netcdf_handle_error( 'netcdf_define_header', 165 )
[1]3969
[2512]3970             DO  i = 0, nx
[1308]3971                netcdf_data(i) = i * dx
3972             ENDDO
[1]3973
[1308]3974             nc_stat = NF90_PUT_VAR( id_set_xz(av), id_var_xu_xz(av), &
3975                                     netcdf_data, start = (/ 1 /),    &
[2512]3976                                     count = (/ nx+1 /) )
[1783]3977             CALL netcdf_handle_error( 'netcdf_define_header', 377 )
[1]3978
[1308]3979             DEALLOCATE( netcdf_data )
[1]3980
3981!
[1308]3982!--          Write zu and zw data (vertical axes)
3983             ALLOCATE( netcdf_data(0:nz+1) )
[1]3984
[1308]3985             netcdf_data(0:nz+1) = zu(nzb:nzt+1)
3986             nc_stat = NF90_PUT_VAR( id_set_xz(av), id_var_zu_xz(av), &
3987                                     netcdf_data, start = (/ 1 /),    &
3988                                     count = (/ nz+2 /) )
[1783]3989             CALL netcdf_handle_error( 'netcdf_define_header', 166 )
[1]3990
[1308]3991             netcdf_data(0:nz+1) = zw(nzb:nzt+1)
3992             nc_stat = NF90_PUT_VAR( id_set_xz(av), id_var_zw_xz(av), &
3993                                     netcdf_data, start = (/ 1 /),    &
3994                                     count = (/ nz+2 /) )
[1783]3995             CALL netcdf_handle_error( 'netcdf_define_header', 167 )
[1]3996
[1551]3997!
3998!--          Write zs data
3999             IF ( land_surface )  THEN
4000                netcdf_data(0:nzs-1) = - zs(nzb_soil:nzt_soil)
4001                nc_stat = NF90_PUT_VAR( id_set_xz(av), id_var_zs_xz(av), &
4002                                        netcdf_data(0:nzs), start = (/ 1 /),    &
4003                                        count = (/ nzt_soil-nzb_soil+1 /) )
[1783]4004               CALL netcdf_handle_error( 'netcdf_define_header', 548 )
[1551]4005             ENDIF
4006
[1308]4007             DEALLOCATE( netcdf_data )
[3421]4008!
4009!--          Write UTM coordinates
4010             IF ( init_model%rotation_angle == 0.0_wp )  THEN
4011!
4012!--             1D in case of no rotation
4013                cos_ra = COS( init_model%rotation_angle * pi / 180.0_wp )
4014!
4015!--             x coordinates
4016                ALLOCATE( netcdf_data(0:nx) )
4017                DO  k = 0, 2
4018!               
4019!--                Scalar grid points
4020                   IF ( k == 0 )  THEN
4021                      shift_x = 0.5
4022!               
4023!--                u grid points
4024                   ELSEIF ( k == 1 )  THEN
4025                      shift_x = 0.0
4026!               
4027!--                v grid points
4028                   ELSEIF ( k == 2 )  THEN
4029                      shift_x = 0.5
4030                   ENDIF
4031               
4032                   DO  i = 0, nx
4033                     netcdf_data(i) = init_model%origin_x            &
4034                                    + cos_ra * ( i + shift_x ) * dx
4035                   ENDDO
4036               
4037                   nc_stat = NF90_PUT_VAR( id_set_xz(av), id_var_eutm_xz(av,k),&
4038                                           netcdf_data, start = (/ 1 /),   &
4039                                           count = (/ nx+1 /) )
4040                   CALL netcdf_handle_error( 'netcdf_define_header', 555 )
[1]4041
[3421]4042                ENDDO
4043                DEALLOCATE( netcdf_data )
4044!
4045!--             y coordinates
4046                ALLOCATE( netcdf_data(1:ns) )
4047                DO  k = 0, 2
4048!
4049!--                Scalar grid points
4050                   IF ( k == 0 )  THEN
4051                      shift_y = 0.5
4052!
4053!--                u grid points
4054                   ELSEIF ( k == 1 )  THEN
4055                      shift_y = 0.5
4056!
4057!--                v grid points
4058                   ELSEIF ( k == 2 )  THEN
4059                      shift_y = 0.0
4060                   ENDIF
4061
4062                   DO  i = 1, ns
4063                      IF( section(i,2) == -1 )  THEN
4064                         netcdf_data(i) = -1.0_wp  ! section averaged along y
4065                      ELSE
4066                         netcdf_data(i) = init_model%origin_y &
4067                                     + cos_ra * ( section(i,2) + shift_y ) * dy
4068                      ENDIF
4069                   ENDDO
4070
4071                   nc_stat = NF90_PUT_VAR( id_set_xz(av), id_var_nutm_xz(av,k),&
4072                                           netcdf_data, start = (/ 1 /),   &
4073                                           count = (/ ns /) )
4074                   CALL netcdf_handle_error( 'netcdf_define_header', 556 )
4075
4076                ENDDO
4077                DEALLOCATE( netcdf_data )
4078
4079             ELSE
4080!
4081!--             2D in case of rotation
4082                ALLOCATE( netcdf_data_2d(0:nx,1:ns) )
4083                cos_ra = COS( init_model%rotation_angle * pi / 180.0_wp )
4084                sin_ra = SIN( init_model%rotation_angle * pi / 180.0_wp )
4085               
4086                DO  k = 0, 2
4087!               
4088!--                Scalar grid points
4089                   IF ( k == 0 )  THEN
4090                      shift_x = 0.5 ; shift_y = 0.5
4091!                 
4092!--                u grid points
4093                   ELSEIF ( k == 1 )  THEN
4094                      shift_x = 0.0 ; shift_y = 0.5
4095!                 
4096!--                v grid points
4097                   ELSEIF ( k == 2 )  THEN
4098                      shift_x = 0.5 ; shift_y = 0.0
4099                   ENDIF
4100
4101                   DO  j = 1, ns
4102                      IF( section(j,2) == -1 )  THEN
4103                         netcdf_data_2d(:,j) = -1.0_wp  ! section averaged along y
4104                      ELSE
4105                         DO  i = 0, nx
4106                            netcdf_data_2d(i,j) = init_model%origin_x          &
4107                                    + cos_ra * ( i + shift_x ) * dx            &
4108                                    + sin_ra * ( section(j,2) + shift_y ) * dy
4109                         ENDDO
4110                      ENDIF
4111                   ENDDO
4112                   
4113                   nc_stat = NF90_PUT_VAR( id_set_xz(av), id_var_eutm_xz(av,k),  &
4114                                           netcdf_data_2d, start = (/ 1, 1 /),   &
4115                                           count = (/ nx+1, ns /) )
4116                   CALL netcdf_handle_error( 'netcdf_define_header', 555 )
4117                   
4118                   DO  j = 1, ns
4119                      IF( section(j,2) == -1 )  THEN
4120                         netcdf_data_2d(:,j) = -1.0_wp  ! section averaged along y
4121                      ELSE
4122                         DO  i = 0, nx
4123                            netcdf_data_2d(i,j) = init_model%origin_y          &
4124                                    - sin_ra * ( i + shift_x ) * dx            &
4125                                    + cos_ra * ( section(j,2) + shift_y ) * dy
4126                         ENDDO
4127                      ENDIF
4128                   ENDDO
4129                   
4130                   nc_stat = NF90_PUT_VAR( id_set_xz(av), id_var_nutm_xz(av,k),  &
4131                                           netcdf_data_2d, start = (/ 1, 1 /),   &
4132                                           count = (/ nx+1, ns /) )
4133                   CALL netcdf_handle_error( 'netcdf_define_header', 556 )
4134               
4135                ENDDO
4136                DEALLOCATE( netcdf_data_2d )
4137             ENDIF
[3459]4138!
4139!--          Write lon and lat data
4140             ALLOCATE( lat(0:nx,1:ns) )
4141             ALLOCATE( lon(0:nx,1:ns) )
4142             cos_ra = COS( init_model%rotation_angle * pi / 180.0_wp )
4143             sin_ra = SIN( init_model%rotation_angle * pi / 180.0_wp )
[3421]4144
[3459]4145             DO  k = 0, 2
4146!               
4147!--             Scalar grid points
4148                IF ( k == 0 )  THEN
4149                   shift_x = 0.5 ; shift_y = 0.5
4150!               
4151!--             u grid points
4152                ELSEIF ( k == 1 )  THEN
4153                   shift_x = 0.0 ; shift_y = 0.5
4154!               
4155!--             v grid points
4156                ELSEIF ( k == 2 )  THEN
4157                   shift_x = 0.5 ; shift_y = 0.0
4158                ENDIF
4159
4160                DO  j = 1, ns
4161                   IF( section(j,2) == -1 )  THEN
4162                      lat(:,j) = -90.0_wp  ! section averaged along y
4163                      lon(:,j) = -180.0_wp  ! section averaged along y
4164                   ELSE
4165                      DO  i = 0, nx
4166                         eutm = init_model%origin_x            &
4167                              + cos_ra * ( i + shift_x ) * dx  &
4168                              + sin_ra * ( section(j,2) + shift_y ) * dy
4169                         nutm = init_model%origin_y            &
4170                              - sin_ra * ( i + shift_x ) * dx  &
4171                              + cos_ra * ( section(j,2) + shift_y ) * dy
4172
4173                         CALL  convert_utm_to_geographic( crs_list,          &
4174                                                          eutm, nutm,        &
4175                                                          lon(i,j), lat(i,j) )
4176                      ENDDO
4177                   ENDIF
4178                ENDDO
4179
4180                nc_stat = NF90_PUT_VAR( id_set_xz(av), id_var_lon_xz(av,k), &
4181                                     lon, start = (/ 1, 1 /),       &
4182                                     count = (/ nx+1, ns /) )
4183                CALL netcdf_handle_error( 'netcdf_define_header', 556 )
4184
4185                nc_stat = NF90_PUT_VAR( id_set_xz(av), id_var_lat_xz(av,k), &
4186                                     lat, start = (/ 1, 1 /),       &
4187                                     count = (/ nx+1, ns /) )
4188                CALL netcdf_handle_error( 'netcdf_define_header', 556 )
4189             ENDDO
4190
4191             DEALLOCATE( lat )
4192             DEALLOCATE( lon )
4193
[1308]4194          ENDIF
[1]4195
[1308]4196
[1]4197       CASE ( 'xz_ext' )
4198
4199!
4200!--       Get the list of variables and compare with the actual run.
4201!--       First var_list_old has to be reset, since GET_ATT does not assign
4202!--       trailing blanks.
4203          var_list_old = ' '
4204          nc_stat = NF90_GET_ATT( id_set_xz(av), NF90_GLOBAL, 'VAR_LIST', &
4205                                  var_list_old )
[1783]4206          CALL netcdf_handle_error( 'netcdf_define_header', 168 )
[1]4207
4208          var_list = ';'
4209          i = 1
4210          DO WHILE ( do2d(av,i)(1:1) /= ' ' )
4211             IF ( INDEX( do2d(av,i), 'xz' ) /= 0 )  THEN
[519]4212                var_list = TRIM( var_list ) // TRIM( do2d(av,i) ) // ';'
[1]4213             ENDIF
4214             i = i + 1
4215          ENDDO
4216
4217          IF ( av == 0 )  THEN
4218             var = '(xz)'
4219          ELSE
4220             var = '(xz_av)'
4221          ENDIF
4222
4223          IF ( TRIM( var_list ) /= TRIM( var_list_old ) )  THEN
[1031]4224             message_string = 'netCDF file for cross-sections ' //           &
[292]4225                              TRIM( var ) // ' from previous run found,' //  &
[3046]4226                              '&but this file cannot be extended due to' //  &
[257]4227                              ' variable mismatch.' //                       &
[3046]4228                              '&New file is created instead.'
[257]4229             CALL message( 'define_netcdf_header', 'PA0249', 0, 1, 0, 6, 0 )
[1]4230             extend = .FALSE.
4231             RETURN
4232          ENDIF
4233
4234!
4235!--       Calculate the number of current sections
4236          ns = 1
4237          DO WHILE ( section(ns,2) /= -9999  .AND.  ns <= 100 )
4238             ns = ns + 1
4239          ENDDO
4240          ns = ns - 1
4241
4242!
4243!--       Get and compare the number of vertical cross sections
4244          nc_stat = NF90_INQ_VARID( id_set_xz(av), 'y_xz', id_var_y_xz(av) )
[1783]4245          CALL netcdf_handle_error( 'netcdf_define_header', 169 )
[1]4246
4247          nc_stat = NF90_INQUIRE_VARIABLE( id_set_xz(av), id_var_y_xz(av), &
4248                                           dimids = id_dim_y_xz_old )
[1783]4249          CALL netcdf_handle_error( 'netcdf_define_header', 170 )
[1]4250          id_dim_y_xz(av) = id_dim_y_xz_old(1)
4251
4252          nc_stat = NF90_INQUIRE_DIMENSION( id_set_xz(av), id_dim_y_xz(av), &
4253                                            len = ns_old )
[1783]4254          CALL netcdf_handle_error( 'netcdf_define_header', 171 )
[1]4255
4256          IF ( ns /= ns_old )  THEN
[1031]4257             message_string = 'netCDF file for cross-sections ' //          &
[292]4258                              TRIM( var ) // ' from previous run found,' // &
[3046]4259                              '&but this file cannot be extended due to' // &
[257]4260                              ' mismatch in number of' //                   & 
[3045]4261                              ' cross sections.' //                         &
[3046]4262                              '&New file is created instead.'
[257]4263             CALL message( 'define_netcdf_header', 'PA0250', 0, 1, 0, 6, 0 )
[1]4264             extend = .FALSE.
4265             RETURN
4266          ENDIF
4267
4268!
4269!--       Get and compare the heights of the cross sections
4270          ALLOCATE( netcdf_data(1:ns_old) )
4271
4272          nc_stat = NF90_GET_VAR( id_set_xz(av), id_var_y_xz(av), netcdf_data )
[1783]4273          CALL netcdf_handle_error( 'netcdf_define_header', 172 )
[1]4274
4275          DO  i = 1, ns
4276             IF ( section(i,2) /= -1 )  THEN
[600]4277                IF ( ( ( section(i,2) + 0.5 ) * dy ) /= netcdf_data(i) )  THEN
[3045]4278                   message_string = 'netCDF file for cross-sections ' //       &
4279                               TRIM( var ) // ' from previous run found,' //   &
4280                               ' but this file cannot be extended' //          &
4281                               ' due to mismatch in cross' //                  &
4282                               ' section levels.' //                           &
4283                               ' New file is created instead.'
4284                   CALL message( 'define_netcdf_header', 'PA0251',             &
[274]4285                                                                 0, 1, 0, 6, 0 )
[1]4286                   extend = .FALSE.
4287                   RETURN
4288                ENDIF
4289             ELSE
[1353]4290                IF ( -1.0_wp /= netcdf_data(i) )  THEN
[3045]4291                   message_string = 'netCDF file for cross-sections ' //       &
4292                               TRIM( var ) // ' from previous run found,' //   &
4293                               ' but this file cannot be extended' //          &
4294                               ' due to mismatch in cross' //                  &
4295                               ' section levels.' //                           &
4296                               ' New file is created instead.'
4297                   CALL message( 'define_netcdf_header', 'PA0251',             &
[274]4298                                                                 0, 1, 0, 6, 0 )
[1]4299                   extend = .FALSE.
4300                   RETURN
4301                ENDIF
4302             ENDIF
4303          ENDDO
4304
4305          DEALLOCATE( netcdf_data )
4306
4307!
4308!--       Get the id of the time coordinate (unlimited coordinate) and its
4309!--       last index on the file. The next time level is do2d..count+1.
4310!--       The current time must be larger than the last output time
4311!--       on the file.
4312          nc_stat = NF90_INQ_VARID( id_set_xz(av), 'time', id_var_time_xz(av) )
[1783]4313          CALL netcdf_handle_error( 'netcdf_define_header', 173 )
[1]4314
4315          nc_stat = NF90_INQUIRE_VARIABLE( id_set_xz(av), id_var_time_xz(av), &
4316                                           dimids = id_dim_time_old )
[1783]4317          CALL netcdf_handle_error( 'netcdf_define_header', 174 )
[1]4318          id_dim_time_xz(av) = id_dim_time_old(1)
4319
4320          nc_stat = NF90_INQUIRE_DIMENSION( id_set_xz(av), id_dim_time_xz(av), &
[1308]4321                                            len = ntime_count )
[1783]4322          CALL netcdf_handle_error( 'netcdf_define_header', 175 )
[1]4323
[1308]4324!
4325!--       For non-parallel output use the last output time level of the netcdf
4326!--       file because the time dimension is unlimited. In case of parallel
4327!--       output the variable ntime_count could get the value of 9*10E36 because
4328!--       the time dimension is limited.
4329          IF ( netcdf_data_format < 5 ) do2d_xz_time_count(av) = ntime_count
4330
[3045]4331          nc_stat = NF90_GET_VAR( id_set_xz(av), id_var_time_xz(av),           &
4332                                  last_time_coordinate,                        &
4333                                  start = (/ do2d_xz_time_count(av) /),        &
[1]4334                                  count = (/ 1 /) )
[1783]4335          CALL netcdf_handle_error( 'netcdf_define_header', 176 )
[1]4336
4337          IF ( last_time_coordinate(1) >= simulated_time )  THEN
[3045]4338             message_string = 'netCDF file for cross sections ' //             &
4339                              TRIM( var ) // ' from previous run found,' //    &
[3046]4340                              '&but this file cannot be extended becaus' //    &
[3045]4341                              'e the current output time' //                   &
[3046]4342                              '&is less or equal than the last output t' //    &
[3045]4343                              'ime on this file.' //                           &
[3046]4344                              '&New file is created instead.'
[257]4345             CALL message( 'define_netcdf_header', 'PA0252', 0, 1, 0, 6, 0 )
[1]4346             do2d_xz_time_count(av) = 0
4347             extend = .FALSE.
4348             RETURN
4349          ENDIF
[1745]4350
[1308]4351          IF ( netcdf_data_format > 4 )  THEN
[1745]4352!
4353!--          Check if the needed number of output time levels is increased
4354!--          compared to the number of time levels in the existing file.
[1308]4355             IF ( ntdim_2d_xz(av) > ntime_count )  THEN
4356                message_string = 'netCDF file for cross sections ' // &
4357                                 TRIM( var ) // ' from previous run found,' // &
[3046]4358                                 '&but this file cannot be extended becaus' // &
[3045]4359                                 'e the number of output time levels has b' // &
[1308]4360                                 'een increased compared to the previous s' // &
[1745]4361                                 'imulation.' //                               &
[3046]4362                                 '&New file is created instead.'
[1308]4363                CALL message( 'define_netcdf_header', 'PA0390', 0, 1, 0, 6, 0 )
4364                do2d_xz_time_count(av) = 0
4365                extend = .FALSE.
[1745]4366!
4367!--             Recalculate the needed time levels for the new file.
4368                IF ( av == 0 )  THEN
4369                   ntdim_2d_xz(0) = CEILING(                            &
4370                           ( end_time - MAX( skip_time_do2d_xz,         &
4371                                             simulated_time_at_begin )  &
4372                           ) / dt_do2d_xz )
[2769]4373                   IF ( do2d_at_begin )  ntdim_2d_xz(0) = ntdim_2d_xz(0) + 1
[1745]4374                ELSE
4375                   ntdim_2d_xz(1) = CEILING(                            &
4376                           ( end_time - MAX( skip_time_data_output_av,  &
4377                                             simulated_time_at_begin )  &
4378                           ) / dt_data_output_av )
4379                ENDIF
[1308]4380                RETURN
4381             ENDIF
4382          ENDIF
[1]4383
4384!
4385!--       Dataset seems to be extendable.
4386!--       Now get the variable ids.
4387          i = 1
4388          DO WHILE ( do2d(av,i)(1:1) /= ' ' )
4389             IF ( INDEX( do2d(av,i), 'xz' ) /= 0 )  THEN
[519]4390                nc_stat = NF90_INQ_VARID( id_set_xz(av), do2d(av,i), &
[1]4391                                          id_var_do2d(av,i) )
[1783]4392                CALL netcdf_handle_error( 'netcdf_define_header', 177 )
[1031]4393#if defined( __netcdf4_parallel )
[493]4394!
4395!--             Set independent io operations for parallel io. Collective io
4396!--             is only allowed in case of a 1d-decomposition along x, because
4397!--             otherwise, not all PEs have output data.
[1031]4398                IF ( netcdf_data_format > 4 )  THEN
[493]4399                   IF ( npey == 1 )  THEN
4400                      nc_stat = NF90_VAR_PAR_ACCESS( id_set_xz(av),     &
4401                                                     id_var_do2d(av,i), &
4402                                                     NF90_COLLECTIVE )
4403                   ELSE
4404!
[1308]4405!--                   Test simulations showed that the output of cross sections
4406!--                   by all PEs in data_output_2d using NF90_COLLECTIVE is
4407!--                   faster than the output by the first row of PEs in
4408!--                   x-direction using NF90_INDEPENDENT.
[493]4409                      nc_stat = NF90_VAR_PAR_ACCESS( id_set_xz(av),     &
4410                                                     id_var_do2d(av,i), &
4411                                                     NF90_COLLECTIVE )
4412!                      nc_stat = NF90_VAR_PAR_ACCESS( id_set_xz(av),     &
4413!                                                     id_var_do2d(av,i), &
4414!                                                     NF90_INDEPENDENT )
4415                   ENDIF
[1783]4416                   CALL netcdf_handle_error( 'netcdf_define_header', 455 )
[493]4417                ENDIF
4418#endif
[1]4419             ENDIF
4420             i = i + 1
4421          ENDDO
4422
4423!
[359]4424!--       Update the title attribute on file
4425!--       In order to avoid 'data mode' errors if updated attributes are larger
4426!--       than their original size, NF90_PUT_ATT is called in 'define mode'
4427!--       enclosed by NF90_REDEF and NF90_ENDDEF calls. This implies a possible
4428!--       performance loss due to data copying; an alternative strategy would be
4429!--       to ensure equal attribute size in a job chain. Maybe revise later.
4430          IF ( av == 0 )  THEN
4431             time_average_text = ' '
4432          ELSE
4433             WRITE (time_average_text, '('', '',F7.1,'' s average'')') &
4434                                                            averaging_interval
4435          ENDIF
4436          nc_stat = NF90_REDEF( id_set_xz(av) )
[1783]4437          CALL netcdf_handle_error( 'netcdf_define_header', 433 )
[3045]4438          nc_stat = NF90_PUT_ATT( id_set_xz(av), NF90_GLOBAL, 'title',         &
4439                                  TRIM( run_description_header ) //            &
[359]4440                                  TRIM( time_average_text ) )
[1783]4441          CALL netcdf_handle_error( 'netcdf_define_header', 178 )
[359]4442          nc_stat = NF90_ENDDEF( id_set_xz(av) )
[1783]4443          CALL netcdf_handle_error( 'netcdf_define_header', 434 )
[3045]4444          message_string = 'netCDF file for cross-sections ' //                &
4445                            TRIM( var ) // ' from previous run found.' //      &
[3046]4446                           '&This file will be extended.'
[257]4447          CALL message( 'define_netcdf_header', 'PA0253', 0, 0, 0, 6, 0 )
[1]4448
4449
4450       CASE ( 'yz_new' )
4451
4452!
4453!--       Define some global attributes of the dataset
4454          IF ( av == 0 )  THEN
[3529]4455             CALL netcdf_create_global_atts( id_set_yz(av), 'yz', TRIM( run_description_header ), 179 )
[1]4456             time_average_text = ' '
4457          ELSE
[3529]4458             CALL netcdf_create_global_atts( id_set_yz(av), 'yz_av', TRIM( run_description_header ), 179 )
[1]4459             WRITE ( time_average_text,'(F7.1,'' s avg'')' )  averaging_interval
[3045]4460             nc_stat = NF90_PUT_ATT( id_set_yz(av), NF90_GLOBAL, 'time_avg',   &
[1]4461                                     TRIM( time_average_text ) )
[1783]4462             CALL netcdf_handle_error( 'netcdf_define_header', 180 )
[1]4463          ENDIF
4464
4465!
[1308]4466!--       Define time coordinate for yz sections.
4467!--       For parallel output the time dimensions has to be limited, otherwise
4468!--       the performance drops significantly.
4469          IF ( netcdf_data_format < 5 )  THEN
[1783]4470             CALL netcdf_create_dim( id_set_yz(av), 'time', NF90_UNLIMITED,    &
4471                                     id_dim_time_yz(av), 181 )
[1308]4472          ELSE
[1783]4473             CALL netcdf_create_dim( id_set_yz(av), 'time', ntdim_2d_yz(av),   &
4474                                     id_dim_time_yz(av), 526 )
[1308]4475          ENDIF
[1]4476
[1783]4477          CALL netcdf_create_var( id_set_yz(av), (/ id_dim_time_yz(av) /),     &
4478                                  'time', NF90_DOUBLE, id_var_time_yz(av),     &
[3529]4479                                  'seconds since '//TRIM(init_model%origin_time), 'time', 182, 183, 000 )
4480          CALL netcdf_create_att( id_set_yz(av), id_var_time_yz(av), 'standard_name', 'time', 000)
4481          CALL netcdf_create_att( id_set_yz(av), id_var_time_yz(av), 'axis', 'T', 000)
[1]4482!
4483!--       Define the spatial dimensions and coordinates for yz-sections.
4484!--       First, determine the number of vertical sections to be written.
4485          IF ( section(1,3) == -9999 )  THEN
4486             RETURN
4487          ELSE
4488             ns = 1
4489             DO WHILE ( section(ns,3) /= -9999  .AND.  ns <= 100 )
4490                ns = ns + 1
4491             ENDDO
4492             ns = ns - 1
4493          ENDIF
4494
4495!
4496!--       Define x axis (for scalar position)
[1783]4497          CALL netcdf_create_dim( id_set_yz(av), 'x_yz', ns, id_dim_x_yz(av),  &
4498                                  184 )
4499          CALL netcdf_create_var( id_set_yz(av), (/ id_dim_x_yz(av) /),        &
4500                                  'x_yz', NF90_DOUBLE, id_var_x_yz(av),        &
4501                                  'meters', '', 185, 186, 000 )
[1]4502!
4503!--       Define x axis (for u position)
[1783]4504          CALL netcdf_create_dim( id_set_yz(av), 'xu_yz', ns,                  &
4505                                  id_dim_xu_yz(av), 377 )
4506          CALL netcdf_create_var( id_set_yz(av), (/ id_dim_xu_yz(av) /),       &
4507                                  'xu_yz', NF90_DOUBLE, id_var_xu_yz(av),      &
4508                                  'meters', '', 378, 379, 000 )
[1]4509!
4510!--       Define a variable to store the layer indices of the vertical cross
4511!--       sections
[1783]4512          CALL netcdf_create_var( id_set_yz(av), (/ id_dim_x_yz(av) /),        &
4513                                  'ind_x_yz', NF90_DOUBLE,                     &
4514                                  id_var_ind_x_yz(av), 'gridpoints', '', 187,  &
4515                                  188, 000 )
[1]4516!
4517!--       Define y-axis (for scalar position)
[2512]4518          CALL netcdf_create_dim( id_set_yz(av), 'y', ny+1, id_dim_y_yz(av),   &
[1783]4519                                  189 )
4520          CALL netcdf_create_var( id_set_yz(av), (/ id_dim_y_yz(av) /), 'y',   &
4521                                  NF90_DOUBLE, id_var_y_yz(av), 'meters', '',  &
4522                                  190, 191, 000 )
[1]4523!
4524!--       Define y-axis (for v position)
[2512]4525          CALL netcdf_create_dim( id_set_yz(av), 'yv', ny+1, id_dim_yv_yz(av), &
[1783]4526                                  380 )
4527          CALL netcdf_create_var( id_set_yz(av), (/ id_dim_yv_yz(av) /), 'yv', &
4528                                  NF90_DOUBLE, id_var_yv_yz(av), 'meters', '', &
4529                                  381, 382, 000 )
[1]4530!
4531!--       Define the two z-axes (zu and zw)
[1783]4532          CALL netcdf_create_dim( id_set_yz(av), 'zu', nz+2, id_dim_zu_yz(av), &
4533                                  192 )
4534          CALL netcdf_create_var( id_set_yz(av), (/ id_dim_zu_yz(av) /), 'zu', &
4535                                  NF90_DOUBLE, id_var_zu_yz(av), 'meters', '', &
4536                                  193, 194, 000 )
[1]4537
[1783]4538          CALL netcdf_create_dim( id_set_yz(av), 'zw', nz+2, id_dim_zw_yz(av), &
4539                                  195 )
4540          CALL netcdf_create_var( id_set_yz(av), (/ id_dim_zw_yz(av) /), 'zw', &
4541                                  NF90_DOUBLE, id_var_zw_yz(av), 'meters', '', &
4542                                  196, 197, 000 )
[3421]4543!
[3529]4544!--       Define UTM and geographic coordinates
4545          CALL define_geo_coordinates( id_set_yz(av),         &
4546                  (/ id_dim_x_yz(av), id_dim_xu_yz(av) /),    &
4547                  (/ id_dim_y_yz(av), id_dim_yv_yz(av) /),    &
4548                  id_var_eutm_yz(av,:), id_var_nutm_yz(av,:), &
4549                  id_var_lat_yz(av,:), id_var_lon_yz(av,:)    )
[3459]4550!
4551!--       Define coordinate-reference system
4552          CALL netcdf_create_crs( id_set_yz(av), 000 )
[1]4553
[1551]4554          IF ( land_surface )  THEN
[1]4555
[1783]4556             CALL netcdf_create_dim( id_set_yz(av), 'zs', nzs,                 &
4557                                     id_dim_zs_yz(av), 545 )
4558             CALL netcdf_create_var( id_set_yz(av), (/ id_dim_zs_yz(av) /),    &
4559                                     'zs', NF90_DOUBLE, id_var_zs_yz(av),      &
4560                                     'meters', '', 546, 547, 000 )
[1551]4561
4562          ENDIF
4563
[1]4564!
4565!--       Define the variables
4566          var_list = ';'
4567          i = 1
4568
4569          DO WHILE ( do2d(av,i)(1:1) /= ' ' )
4570
4571             IF ( INDEX( do2d(av,i), 'yz' ) /= 0 )  THEN
4572
4573!
4574!--             Check for the grid
[1980]4575                found = .FALSE.
[1]4576                SELECT CASE ( do2d(av,i) )
4577!
4578!--                Most variables are defined on the zu grid
[3421]4579                   CASE ( 'e_yz', 'nc_yz', 'nr_yz', 'p_yz', 'pc_yz',           &
4580                          'pr_yz','prr_yz', 'q_yz', 'qc_yz', 'ql_yz',          &
[1691]4581                          'ql_c_yz', 'ql_v_yz', 'ql_vp_yz', 'qr_yz', 'qv_yz',  &
[3421]4582                          's_yz',                                              &
4583                          'theta_yz', 'thetal_yz', 'thetav_yz' )
[1]4584
4585                      grid_x = 'x'
4586                      grid_y = 'y'
4587                      grid_z = 'zu'
4588!
4589!--                u grid
4590                   CASE ( 'u_yz' )
4591
4592                      grid_x = 'xu'
4593                      grid_y = 'y'
4594                      grid_z = 'zu'
4595!
4596!--                v grid
4597                   CASE ( 'v_yz' )
4598
4599                      grid_x = 'x'
4600                      grid_y = 'yv'
4601                      grid_z = 'zu'
4602!
4603!--                w grid
[1976]4604                   CASE ( 'w_yz' )
[1]4605
4606                      grid_x = 'x'
4607                      grid_y = 'y'
4608                      grid_z = 'zw'
4609
[1551]4610
[1]4611                   CASE DEFAULT
4612!
[1976]4613!--                   Check for land surface quantities
4614                      IF ( land_surface )  THEN
4615                         CALL lsm_define_netcdf_grid( do2d(av,i), found,       &
4616                                                      grid_x, grid_y, grid_z )
4617                      ENDIF
4618
[2696]4619                      IF ( .NOT. found )  THEN
4620                         CALL tcm_define_netcdf_grid( do2d(av,i), found,       &
4621                                                      grid_x, grid_y, grid_z )
4622                      ENDIF
4623
[1976]4624!
[3421]4625!--                   Check for ocean quantities
4626                      IF ( .NOT. found  .AND.  ocean_mode )  THEN
4627                         CALL ocean_define_netcdf_grid( do2d(av,i), found,     &
4628                                                       grid_x, grid_y, grid_z )
4629                      ENDIF
4630!
[1976]4631!--                   Check for radiation quantities
4632                      IF ( .NOT. found  .AND.  radiation )  THEN
4633                         CALL radiation_define_netcdf_grid( do2d(av,i), found, &
4634                                                            grid_x, grid_y,    &
4635                                                            grid_z )
4636                      ENDIF
4637!
[3467]4638!--                   Check for SALSA quantities
4639                      IF ( .NOT. found  .AND.  salsa )  THEN
4640                         CALL salsa_define_netcdf_grid( do2d(av,i), found,     &
4641                                                        grid_x, grid_y, grid_z )
4642                      ENDIF                           
4643!
[2817]4644!--                   Check for gust module quantities
4645                      IF ( .NOT. found  .AND.  gust_module_enabled )  THEN
4646                         CALL gust_define_netcdf_grid( do2d(av,i), found,      &
4647                                                       grid_x, grid_y, grid_z )
4648                      ENDIF
4649
4650!
[2696]4651!--                   Check for chemistry quantities
4652                      IF ( .NOT. found  .AND.  air_chemistry )  THEN
4653                         CALL chem_define_netcdf_grid( do2d(av,i), found,      &
4654                                                       grid_x, grid_y,         &
4655                                                       grid_z )
4656                      ENDIF
4657!
[1]4658!--                   Check for user-defined quantities
[3701]4659                      IF ( .NOT. found  .AND.  user_module_enabled )  THEN
[1976]4660                         CALL user_define_netcdf_grid( do2d(av,i), found,      &
4661                                                       grid_x, grid_y, grid_z )
4662                      ENDIF
[1]4663
[1783]4664                      IF ( .NOT. found )  THEN
4665                         WRITE ( message_string, * ) 'no grid defined for',    &
4666                                                ' variable ', TRIM( do2d(av,i) )
4667                         CALL message( 'define_netcdf_header', 'PA0244',       &
4668                                       0, 1, 0, 6, 0 )
4669                      ENDIF
4670
[1]4671                END SELECT
4672
4673!
4674!--             Select the respective dimension ids
4675                IF ( grid_x == 'x' )  THEN
4676                   id_x = id_dim_x_yz(av)
4677                ELSEIF ( grid_x == 'xu' )  THEN
4678                   id_x = id_dim_xu_yz(av)
4679                ENDIF
4680
4681                IF ( grid_y == 'y' )  THEN
4682                   id_y = id_dim_y_yz(av)
4683                ELSEIF ( grid_y == 'yv' )  THEN
4684                   id_y = id_dim_yv_yz(av)
4685                ENDIF
4686
4687                IF ( grid_z == 'zu' )  THEN
4688                   id_z = id_dim_zu_yz(av)
4689                ELSEIF ( grid_z == 'zw' )  THEN
4690                   id_z = id_dim_zw_yz(av)
[1551]4691                ELSEIF ( grid_z == 'zs' )  THEN
4692                   id_z = id_dim_zs_yz(av)
[1]4693                ENDIF
4694
4695!
4696!--             Define the grid
[1783]4697                CALL netcdf_create_var( id_set_yz(av),  (/ id_x, id_y, id_z,   &
4698                                        id_dim_time_yz(av) /), do2d(av,i),     &
4699                                        nc_precision(3), id_var_do2d(av,i),    &
4700                                        TRIM( do2d_unit(av,i) ), do2d(av,i),   &
[2696]4701                                        198, 199, 356, .TRUE. )
[1]4702
[1031]4703#if defined( __netcdf4_parallel )
[1308]4704                IF ( netcdf_data_format > 4 )  THEN
[493]4705!
[1308]4706!--                Set no fill for every variable to increase performance.
4707                   nc_stat = NF90_DEF_VAR_FILL( id_set_yz(av),     &
4708                                                id_var_do2d(av,i), &
4709                                                1, 0 )
[1783]4710                   CALL netcdf_handle_error( 'netcdf_define_header', 535 )
[1308]4711!
4712!--                Set independent io operations for parallel io. Collective io
4713!--                is only allowed in case of a 1d-decomposition along y,
4714!--                because otherwise, not all PEs have output data.
[493]4715                   IF ( npex == 1 )  THEN
4716                      nc_stat = NF90_VAR_PAR_ACCESS( id_set_yz(av),     &
4717                                                     id_var_do2d(av,i), &
4718                                                     NF90_COLLECTIVE )
4719                   ELSE
4720!
[1308]4721!--                   Test simulations showed that the output of cross sections
4722!--                   by all PEs in data_output_2d using NF90_COLLECTIVE is
4723!--                   faster than the output by the first row of PEs in
4724!--                   y-direction using NF90_INDEPENDENT.
[493]4725                      nc_stat = NF90_VAR_PAR_ACCESS( id_set_yz(av),     &
4726                                                     id_var_do2d(av,i), &
4727                                                     NF90_COLLECTIVE )
4728!                      nc_stat = NF90_VAR_PAR_ACCESS( id_set_yz(av),     &
4729!                                                     id_var_do2d(av,i), &
4730!                                                     NF90_INDEPENDENT )
4731                   ENDIF
[1783]4732                   CALL netcdf_handle_error( 'netcdf_define_header', 450 )
[493]4733                ENDIF
4734#endif
[1783]4735                var_list = TRIM( var_list ) // TRIM( do2d(av,i) ) // ';'
4736
[1]4737             ENDIF
4738
4739             i = i + 1
4740
4741          ENDDO
4742
4743!
4744!--       No arrays to output. Close the netcdf file and return.
4745          IF ( i == 1 )  RETURN
4746
4747!
4748!--       Write the list of variables as global attribute (this is used by
4749!--       restart runs and by combine_plot_fields)
4750          nc_stat = NF90_PUT_ATT( id_set_yz(av), NF90_GLOBAL, 'VAR_LIST', &
4751                                  var_list )
[1783]4752          CALL netcdf_handle_error( 'netcdf_define_header', 200 )
[1]4753
4754!
[1308]4755!--       Set general no fill, otherwise the performance drops significantly for
4756!--       parallel output.
4757          nc_stat = NF90_SET_FILL( id_set_yz(av), NF90_NOFILL, oldmode )
[1783]4758          CALL netcdf_handle_error( 'netcdf_define_header', 531 )
[1308]4759
4760!
[1031]4761!--       Leave netCDF define mode
[1]4762          nc_stat = NF90_ENDDEF( id_set_yz(av) )
[1783]4763          CALL netcdf_handle_error( 'netcdf_define_header', 201 )
[1]4764
4765!
[1308]4766!--       These data are only written by PE0 for parallel output to increase
4767!--       the performance.
4768          IF ( myid == 0  .OR.  netcdf_data_format < 5 )  THEN
[1]4769
4770!
[1308]4771!--          Write axis data: x_yz, y, zu, zw
4772             ALLOCATE( netcdf_data(1:ns) )
[1]4773
4774!
[1308]4775!--          Write x_yz data (shifted by +dx/2)
4776             DO  i = 1, ns
4777                IF( section(i,3) == -1 )  THEN
[1353]4778                   netcdf_data(i) = -1.0_wp  ! section averaged along x
[1308]4779                ELSE
[1353]4780                   netcdf_data(i) = ( section(i,3) + 0.5_wp ) * dx
[1308]4781                ENDIF
4782             ENDDO
4783             nc_stat = NF90_PUT_VAR( id_set_yz(av), id_var_x_yz(av), &
4784                                     netcdf_data, start = (/ 1 /),   &
4785                                     count = (/ ns /) )
[1783]4786             CALL netcdf_handle_error( 'netcdf_define_header', 202 )
[1]4787
4788!
[1308]4789!--          Write x_yz data (xu grid)
4790             DO  i = 1, ns
4791                IF( section(i,3) == -1 )  THEN
[1353]4792                   netcdf_data(i) = -1.0_wp  ! section averaged along x
[1308]4793                ELSE
4794                   netcdf_data(i) = section(i,3) * dx
4795                ENDIF
4796             ENDDO
4797             nc_stat = NF90_PUT_VAR( id_set_yz(av), id_var_xu_yz(av), &
4798                                     netcdf_data, start = (/ 1 /),    &
4799                                     count = (/ ns /) )
[1783]4800             CALL netcdf_handle_error( 'netcdf_define_header', 383 )
[1]4801
[1308]4802!
4803!--          Write gridpoint number data
4804             netcdf_data(1:ns) = section(1:ns,3)
4805             nc_stat = NF90_PUT_VAR( id_set_yz(av), id_var_ind_x_yz(av), &
4806                                     netcdf_data, start = (/ 1 /),       &
4807                                     count = (/ ns /) )
[1783]4808             CALL netcdf_handle_error( 'netcdf_define_header', 203 )
[1]4809
[1308]4810             DEALLOCATE( netcdf_data )
4811
[1]4812!
[1308]4813!--          Write data for y (shifted by +dy/2) and yv axis
[2512]4814             ALLOCATE( netcdf_data(0:ny) )
[1]4815
[2512]4816             DO  j = 0, ny
[1353]4817                netcdf_data(j) = ( j + 0.5_wp ) * dy
[1308]4818             ENDDO
[1]4819
[1308]4820             nc_stat = NF90_PUT_VAR( id_set_yz(av), id_var_y_yz(av), &
4821                                     netcdf_data, start = (/ 1 /),   &
[2512]4822                                     count = (/ ny+1 /) )
[1783]4823             CALL netcdf_handle_error( 'netcdf_define_header', 204 )
[1]4824
[2512]4825             DO  j = 0, ny
[1308]4826                netcdf_data(j) = j * dy
4827             ENDDO
[1]4828
[1308]4829             nc_stat = NF90_PUT_VAR( id_set_yz(av), id_var_yv_yz(av), &
4830                                     netcdf_data, start = (/ 1 /),    &
[2512]4831                                     count = (/ ny+1 /) )
[1783]4832             CALL netcdf_handle_error( 'netcdf_define_header', 384 )
[1]4833
[1308]4834             DEALLOCATE( netcdf_data )
[1]4835
4836!
[1308]4837!--          Write zu and zw data (vertical axes)
4838             ALLOCATE( netcdf_data(0:nz+1) )
[1]4839
[1308]4840             netcdf_data(0:nz+1) = zu(nzb:nzt+1)
4841             nc_stat = NF90_PUT_VAR( id_set_yz(av), id_var_zu_yz(av), &
4842                                     netcdf_data, start = (/ 1 /),    &
4843                                     count = (/ nz+2 /) )
[1783]4844             CALL netcdf_handle_error( 'netcdf_define_header', 205 )
[1]4845
[1308]4846             netcdf_data(0:nz+1) = zw(nzb:nzt+1)
4847             nc_stat = NF90_PUT_VAR( id_set_yz(av), id_var_zw_yz(av), &
4848                                     netcdf_data, start = (/ 1 /),    &
4849                                     count = (/ nz+2 /) )
[1783]4850             CALL netcdf_handle_error( 'netcdf_define_header', 206 )
[1]4851
[1308]4852             DEALLOCATE( netcdf_data )
[3421]4853!
4854!--          Write UTM coordinates
4855             IF ( init_model%rotation_angle == 0.0_wp )  THEN
4856!
4857!--             1D in case of no rotation
4858                cos_ra = COS( init_model%rotation_angle * pi / 180.0_wp )
4859!
4860!--             x coordinates
4861                ALLOCATE( netcdf_data(1:ns) )
4862                DO  k = 0, 2
4863!               
4864!--                Scalar grid points
4865                   IF ( k == 0 )  THEN
4866                      shift_x = 0.5
4867!               
4868!--                u grid points
4869                   ELSEIF ( k == 1 )  THEN
4870                      shift_x = 0.0
4871!               
4872!--                v grid points
4873                   ELSEIF ( k == 2 )  THEN
4874                      shift_x = 0.5
4875                   ENDIF
4876               
4877                   DO  i = 1, ns
4878                      IF( section(i,3) == -1 )  THEN
4879                         netcdf_data(i) = -1.0_wp  ! section averaged along x
4880                      ELSE
4881                         netcdf_data(i) = init_model%origin_x &
4882                                     + cos_ra * ( section(i,3) + shift_x ) * dx
4883                      ENDIF
4884                   ENDDO
4885               
4886                   nc_stat = NF90_PUT_VAR( id_set_yz(av), id_var_eutm_yz(av,k),&
4887                                           netcdf_data, start = (/ 1 /),   &
4888                                           count = (/ ns /) )
4889                   CALL netcdf_handle_error( 'netcdf_define_header', 555 )
[1]4890
[3421]4891                ENDDO
4892                DEALLOCATE( netcdf_data )
4893!
4894!--             y coordinates
4895                ALLOCATE( netcdf_data(0:ny) )
4896                DO  k = 0, 2
4897!
4898!--                Scalar grid points
4899                   IF ( k == 0 )  THEN
4900                      shift_y = 0.5
4901!
4902!--                u grid points
4903                   ELSEIF ( k == 1 )  THEN
4904                      shift_y = 0.5
4905!
4906!--                v grid points
4907                   ELSEIF ( k == 2 )  THEN
4908                      shift_y = 0.0
4909                   ENDIF
4910
4911                   DO  i = 0, ny
4912                     netcdf_data(i) = init_model%origin_y            &
4913                                    + cos_ra * ( i + shift_y ) * dy
4914                   ENDDO
4915
4916                   nc_stat = NF90_PUT_VAR( id_set_yz(av), id_var_nutm_yz(av,k),&
4917                                           netcdf_data, start = (/ 1 /),   &
4918                                           count = (/ ny+1 /) )
4919                   CALL netcdf_handle_error( 'netcdf_define_header', 556 )
4920
4921                ENDDO
4922                DEALLOCATE( netcdf_data )
4923
4924             ELSE
4925!
4926!--             2D in case of rotation
4927                ALLOCATE( netcdf_data_2d(1:ns,0:ny) )
4928                cos_ra = COS( init_model%rotation_angle * pi / 180.0_wp )
4929                sin_ra = SIN( init_model%rotation_angle * pi / 180.0_wp )
4930
4931                DO  k = 0, 2
4932!               
4933!--                Scalar grid points
4934                   IF ( k == 0 )  THEN
4935                      shift_x = 0.5 ; shift_y = 0.5
4936!                 
4937!--                u grid points
4938                   ELSEIF ( k == 1 )  THEN
4939                      shift_x = 0.0 ; shift_y = 0.5
4940!                 
4941!--                v grid points
4942                   ELSEIF ( k == 2 )  THEN
4943                      shift_x = 0.5 ; shift_y = 0.0
4944                   ENDIF
4945
4946                   DO  j = 0, ny
4947                      DO  i = 1, ns
4948                         IF( section(i,3) == -1 )  THEN
4949                            netcdf_data_2d(i,:) = -1.0_wp !section averaged along x
4950                         ELSE
4951                            netcdf_data_2d(i,j) = init_model%origin_x          &
4952                                    + cos_ra * ( section(i,3) + shift_x ) * dx &
4953                                    + sin_ra * ( j + shift_y ) * dy
4954                         ENDIF
4955                      ENDDO
4956                   ENDDO
4957                   
4958                   nc_stat = NF90_PUT_VAR( id_set_yz(av), id_var_eutm_yz(av,k),  &
4959                                           netcdf_data_2d, start = (/ 1, 1 /),   &
4960                                           count = (/ ns, ny+1 /) )
4961                   CALL netcdf_handle_error( 'netcdf_define_header', 555 )
4962                   
4963                   DO  j = 0, ny
4964                      DO  i = 1, ns
4965                         IF( section(i,3) == -1 )  THEN
4966                            netcdf_data_2d(i,:) = -1.0_wp !section averaged along x
4967                         ELSE
4968                            netcdf_data_2d(i,j) = init_model%origin_y          &
4969                                    - sin_ra * ( section(i,3) + shift_x ) * dx &
4970                                    + cos_ra * ( j + shift_y ) * dy
4971                         ENDIF
4972                      ENDDO
4973                   ENDDO
4974
4975                   nc_stat = NF90_PUT_VAR( id_set_yz(av), id_var_nutm_yz(av,k),  &
4976                                           netcdf_data_2d, start = (/ 1, 1 /),   &
4977                                           count = (/ ns, ny+1 /) )
4978                   CALL netcdf_handle_error( 'netcdf_define_header', 556 )
4979               
4980                ENDDO
4981                DEALLOCATE( netcdf_data_2d )
4982             ENDIF
[3459]4983!
4984!--          Write lon and lat data
4985             ALLOCATE( lat(1:ns,0:ny) )
4986             ALLOCATE( lon(1:ns,0:ny) )
4987             cos_ra = COS( init_model%rotation_angle * pi / 180.0_wp )
4988             sin_ra = SIN( init_model%rotation_angle * pi / 180.0_wp )
[3421]4989
[3459]4990             DO  k = 0, 2
4991!               
4992!--             Scalar grid points
4993                IF ( k == 0 )  THEN
4994                   shift_x = 0.5 ; shift_y = 0.5
4995!               
4996!--             u grid points
4997                ELSEIF ( k == 1 )  THEN
4998                   shift_x = 0.0 ; shift_y = 0.5
4999!               
5000!--             v grid points
5001                ELSEIF ( k == 2 )  THEN
5002                   shift_x = 0.5 ; shift_y = 0.0
5003                ENDIF
5004
5005                DO  j = 0, ny
5006                   DO  i = 1, ns
5007                      IF( section(i,3) == -1 )  THEN
5008                         lat(i,:) = -90.0_wp   ! section averaged along x
5009                         lon(i,:) = -180.0_wp  ! section averaged along x
5010                      ELSE
5011                         eutm = init_model%origin_x            &
5012                              + cos_ra * ( section(i,3) + shift_x ) * dx  &
5013                              + sin_ra * ( j + shift_y ) * dy
5014                         nutm = init_model%origin_y            &
5015                              - sin_ra * ( section(i,3) + shift_x ) * dx  &
5016                              + cos_ra * ( j + shift_y ) * dy
5017
5018                         CALL  convert_utm_to_geographic( crs_list,          &
5019                                                          eutm, nutm,        &
5020                                                          lon(i,j), lat(i,j) )
5021                      ENDIF
5022                   ENDDO
5023                ENDDO
5024
5025                nc_stat = NF90_PUT_VAR( id_set_yz(av), id_var_lon_yz(av,k), &
5026                                     lon, start = (/ 1, 1 /),       &
5027                                     count = (/ ns, ny+1 /) )
5028                CALL netcdf_handle_error( 'netcdf_define_header', 556 )
5029
5030                nc_stat = NF90_PUT_VAR( id_set_yz(av), id_var_lat_yz(av,k), &
5031                                     lat, start = (/ 1, 1 /),       &
5032                                     count = (/ ns, ny+1 /) )
5033                CALL netcdf_handle_error( 'netcdf_define_header', 556 )
5034             ENDDO
5035
5036             DEALLOCATE( lat )
5037             DEALLOCATE( lon )
5038
[1308]5039          ENDIF
[1]5040
[1308]5041
[1]5042       CASE ( 'yz_ext' )
5043
5044!
5045!--       Get the list of variables and compare with the actual run.
5046!--       First var_list_old has to be reset, since GET_ATT does not assign
5047!--       trailing blanks.
5048          var_list_old = ' '
5049          nc_stat = NF90_GET_ATT( id_set_yz(av), NF90_GLOBAL, 'VAR_LIST', &
5050                                  var_list_old )
[1783]5051          CALL netcdf_handle_error( 'netcdf_define_header', 207 )
[1]5052
5053          var_list = ';'
5054          i = 1
5055          DO WHILE ( do2d(av,i)(1:1) /= ' ' )
5056             IF ( INDEX( do2d(av,i), 'yz' ) /= 0 )  THEN
[519]5057                var_list = TRIM( var_list ) // TRIM( do2d(av,i) ) // ';'
[1]5058             ENDIF
5059             i = i + 1
5060          ENDDO
5061
5062          IF ( av == 0 )  THEN
5063             var = '(yz)'
5064          ELSE
5065             var = '(yz_av)'
5066          ENDIF
5067
5068          IF ( TRIM( var_list ) /= TRIM( var_list_old ) )  THEN
[1031]5069             message_string = 'netCDF file for cross-sections ' //           &
[292]5070                              TRIM( var ) // ' from previous run found,' //  &
[3046]5071                              '&but this file cannot be extended due to' //  &
[257]5072                              ' variable mismatch.' //                       & 
[3046]5073                              '&New file is created instead.'
[257]5074             CALL message( 'define_netcdf_header', 'PA0249', 0, 1, 0, 6, 0 )
[1]5075             extend = .FALSE.
5076             RETURN
5077          ENDIF
5078
5079!
5080!--       Calculate the number of current sections
5081          ns = 1
5082          DO WHILE ( section(ns,3) /= -9999  .AND.  ns <= 100 )
5083             ns = ns + 1
5084          ENDDO
5085          ns = ns - 1
5086
5087!
5088!--       Get and compare the number of vertical cross sections
5089          nc_stat = NF90_INQ_VARID( id_set_yz(av), 'x_yz', id_var_x_yz(av) )
[1783]5090          CALL netcdf_handle_error( 'netcdf_define_header', 208 )
[1]5091
5092          nc_stat = NF90_INQUIRE_VARIABLE( id_set_yz(av), id_var_x_yz(av), &
5093                                           dimids = id_dim_x_yz_old )
[1783]5094          CALL netcdf_handle_error( 'netcdf_define_header', 209 )
[1]5095          id_dim_x_yz(av) = id_dim_x_yz_old(1)
5096
5097          nc_stat = NF90_INQUIRE_DIMENSION( id_set_yz(av), id_dim_x_yz(av), &
5098                                            len = ns_old )
[1783]5099          CALL netcdf_handle_error( 'netcdf_define_header', 210 )
[1]5100
5101          IF ( ns /= ns_old )  THEN
[1031]5102             message_string = 'netCDF file for cross-sections ' //          &
[292]5103                              TRIM( var ) // ' from previous run found,' // &
[3046]5104                              '&but this file cannot be extended due to' // &
[257]5105                              ' mismatch in number of' //                   &
[3045]5106                              ' cross sections.' //                         &
[3046]5107                              '&New file is created instead.'
[257]5108             CALL message( 'define_netcdf_header', 'PA0250', 0, 1, 0, 6, 0 )
[1]5109             extend = .FALSE.
5110             RETURN
5111          ENDIF
5112
5113!
5114!--       Get and compare the heights of the cross sections
5115          ALLOCATE( netcdf_data(1:ns_old) )
5116
5117          nc_stat = NF90_GET_VAR( id_set_yz(av), id_var_x_yz(av), netcdf_data )
[1783]5118          CALL netcdf_handle_error( 'netcdf_define_header', 211 )
[1]5119
5120          DO  i = 1, ns
5121             IF ( section(i,3) /= -1 )  THEN
[600]5122                IF ( ( ( section(i,3) + 0.5 ) * dx ) /= netcdf_data(i) )  THEN
[3045]5123                   message_string = 'netCDF file for cross-sections ' //       &
5124                              TRIM( var ) // ' from previous run found,' //    &
5125                              ' but this file cannot be extended' //           &
5126                              ' due to mismatch in cross' //                   &
5127                              ' section levels.' //                            &
5128                              ' New file is created instead.'
5129                   CALL message( 'define_netcdf_header', 'PA0251',             &
[274]5130                                                                 0, 1, 0, 6, 0 )
[1]5131                   extend = .FALSE.
5132                   RETURN
5133                ENDIF
5134             ELSE
[1353]5135                IF ( -1.0_wp /= netcdf_data(i) )  THEN
[3045]5136                   message_string = 'netCDF file for cross-sections ' //       &
5137                              TRIM( var ) // ' from previous run found,' //    &
5138                              ' but this file cannot be extended' //           &
5139                              ' due to mismatch in cross' //                   &
5140                              ' section levels.' //                            &
5141                              ' New file is created instead.'
5142                   CALL message( 'define_netcdf_header', 'PA0251',             &
[274]5143                                                                 0, 1, 0, 6, 0 )
[1]5144                   extend = .FALSE.
5145                   RETURN
5146                ENDIF
5147             ENDIF
5148          ENDDO
5149
5150          DEALLOCATE( netcdf_data )
5151
5152!
5153!--       Get the id of the time coordinate (unlimited coordinate) and its
5154!--       last index on the file. The next time level is pl2d..count+1.
5155!--       The current time must be larger than the last output time
5156!--       on the file.
5157          nc_stat = NF90_INQ_VARID( id_set_yz(av), 'time', id_var_time_yz(av) )
[1783]5158          CALL netcdf_handle_error( 'netcdf_define_header', 212 )
[1]5159
5160          nc_stat = NF90_INQUIRE_VARIABLE( id_set_yz(av), id_var_time_yz(av), &
5161                                           dimids = id_dim_time_old )
[1783]5162          CALL netcdf_handle_error( 'netcdf_define_header', 213 )
[1]5163          id_dim_time_yz(av) = id_dim_time_old(1)
5164
5165          nc_stat = NF90_INQUIRE_DIMENSION( id_set_yz(av), id_dim_time_yz(av), &
[1308]5166                                            len = ntime_count )
[1783]5167          CALL netcdf_handle_error( 'netcdf_define_header', 214 )
[1]5168
[1308]5169!
5170!--       For non-parallel output use the last output time level of the netcdf
5171!--       file because the time dimension is unlimited. In case of parallel
5172!--       output the variable ntime_count could get the value of 9*10E36 because
5173!--       the time dimension is limited.
5174          IF ( netcdf_data_format < 5 ) do2d_yz_time_count(av) = ntime_count
5175
[3045]5176          nc_stat = NF90_GET_VAR( id_set_yz(av), id_var_time_yz(av),           &
5177                                  last_time_coordinate,                        &
5178                                  start = (/ do2d_yz_time_count(av) /),        &
[1]5179                                  count = (/ 1 /) )
[1783]5180          CALL netcdf_handle_error( 'netcdf_define_header', 215 )
[1]5181
5182          IF ( last_time_coordinate(1) >= simulated_time )  THEN
[3045]5183             message_string = 'netCDF file for cross sections ' //             &
5184                              TRIM( var ) // ' from previous run found,' //    &
[3046]5185                              '&but this file cannot be extended becaus' //    &
[3045]5186                              'e the current output time' //                   &
[3046]5187                              '&is less or equal than the last output t' //    &
[3045]5188                              'ime on this file.' //                           &
[3046]5189                              '&New file is created instead.'
[257]5190             CALL message( 'define_netcdf_header', 'PA0252', 0, 1, 0, 6, 0 )
[1]5191             do2d_yz_time_count(av) = 0
5192             extend = .FALSE.
5193             RETURN
5194          ENDIF
5195
[1308]5196          IF ( netcdf_data_format > 4 )  THEN
[1745]5197!
5198!--          Check if the needed number of output time levels is increased
5199!--          compared to the number of time levels in the existing file.
[1308]5200             IF ( ntdim_2d_yz(av) > ntime_count )  THEN
5201                message_string = 'netCDF file for cross sections ' //          &
5202                                 TRIM( var ) // ' from previous run found,' // &
[3046]5203                                 '&but this file cannot be extended becaus' // &
[3045]5204                                 'e the number of output time levels has b' // &
[1308]5205                                 'een increased compared to the previous s' // &
5206                                 'imulation.' //                               &
[3046]5207                                 '&New file is created instead.'
[1308]5208                CALL message( 'define_netcdf_header', 'PA0391', 0, 1, 0, 6, 0 )
5209                do2d_yz_time_count(av) = 0
5210                extend = .FALSE.
[1745]5211!
5212!--             Recalculate the needed time levels for the new file.
5213                IF ( av == 0 )  THEN
5214                   ntdim_2d_yz(0) = CEILING(                            &
5215                           ( end_time - MAX( skip_time_do2d_yz,         &
5216                                             simulated_time_at_begin )  &
5217                           ) / dt_do2d_yz )
[2769]5218                   IF ( do2d_at_begin )  ntdim_2d_yz(0) = ntdim_2d_yz(0) + 1
[1745]5219                ELSE
5220                   ntdim_2d_yz(1) = CEILING(                            &
5221                           ( end_time - MAX( skip_time_data_output_av,  &
5222                                             simulated_time_at_begin )  &
5223                           ) / dt_data_output_av )
5224                ENDIF
[1308]5225                RETURN
5226             ENDIF
5227          ENDIF
5228
[1]5229!
5230!--       Dataset seems to be extendable.
5231!--       Now get the variable ids.
5232          i = 1
5233          DO WHILE ( do2d(av,i)(1:1) /= ' ' )
5234             IF ( INDEX( do2d(av,i), 'yz' ) /= 0 )  THEN
[519]5235                nc_stat = NF90_INQ_VARID( id_set_yz(av), do2d(av,i), &
[1]5236                                          id_var_do2d(av,i) )
[1783]5237                CALL netcdf_handle_error( 'netcdf_define_header', 216 )
[1031]5238#if defined( __netcdf4_parallel )
[493]5239!
5240!--             Set independent io operations for parallel io. Collective io
5241!--             is only allowed in case of a 1d-decomposition along y, because
5242!--             otherwise, not all PEs have output data.
[1031]5243                IF ( netcdf_data_format > 4 )  THEN
[493]5244                   IF ( npex == 1 )  THEN
5245                      nc_stat = NF90_VAR_PAR_ACCESS( id_set_yz(av),     &
5246                                                     id_var_do2d(av,i), &
5247                                                     NF90_COLLECTIVE )
5248                   ELSE
5249!
[1308]5250!--                   Test simulations showed that the output of cross sections
5251!--                   by all PEs in data_output_2d using NF90_COLLECTIVE is
5252!--                   faster than the output by the first row of PEs in
5253!--                   y-direction using NF90_INDEPENDENT.
[493]5254                      nc_stat = NF90_VAR_PAR_ACCESS( id_set_yz(av),     &
5255                                                     id_var_do2d(av,i), &
5256                                                     NF90_COLLECTIVE )
5257!                      nc_stat = NF90_VAR_PAR_ACCESS( id_set_yz(av),     &
5258!                                                     id_var_do2d(av,i), &
5259!                                                     NF90_INDEPENDENT )
5260                   ENDIF
[1783]5261                   CALL netcdf_handle_error( 'netcdf_define_header', 450 )
[493]5262                ENDIF
5263#endif
[1]5264             ENDIF
5265             i = i + 1
5266          ENDDO
5267
5268!
[359]5269!--       Update the title attribute on file
5270!--       In order to avoid 'data mode' errors if updated attributes are larger
5271!--       than their original size, NF90_PUT_ATT is called in 'define mode'
5272!--       enclosed by NF90_REDEF and NF90_ENDDEF calls. This implies a possible
5273!--       performance loss due to data copying; an alternative strategy would be
5274!--       to ensure equal attribute size in a job chain. Maybe revise later.
5275          IF ( av == 0 )  THEN
5276             time_average_text = ' '
5277          ELSE
5278             WRITE (time_average_text, '('', '',F7.1,'' s average'')') &
5279                                                            averaging_interval
5280          ENDIF
5281          nc_stat = NF90_REDEF( id_set_yz(av) )
[1783]5282          CALL netcdf_handle_error( 'netcdf_define_header', 435 )
[3045]5283          nc_stat = NF90_PUT_ATT( id_set_yz(av), NF90_GLOBAL, 'title',         &
5284                                  TRIM( run_description_header ) //            &
[359]5285                                  TRIM( time_average_text ) )
[1783]5286          CALL netcdf_handle_error( 'netcdf_define_header', 217 )
[359]5287          nc_stat = NF90_ENDDEF( id_set_yz(av) )
[1783]5288          CALL netcdf_handle_error( 'netcdf_define_header', 436 )
[3045]5289          message_string = 'netCDF file for cross-sections ' //                &
5290                            TRIM( var ) // ' from previous run found.' //      &
[3046]5291                           '&This file will be extended.'
[257]5292          CALL message( 'define_netcdf_header', 'PA0253', 0, 0, 0, 6, 0 )
[1]5293
5294
5295       CASE ( 'pr_new' )
5296
5297!
5298!--       Define some global attributes of the dataset
[3485]5299
[1353]5300          IF ( averaging_interval_pr /= 0.0_wp )  THEN
[3529]5301             CALL netcdf_create_global_atts( id_set_pr, 'podsprav', TRIM( run_description_header ), 451 )
[1]5302             WRITE ( time_average_text,'(F7.1,'' s avg'')' ) averaging_interval_pr
[3045]5303             nc_stat = NF90_PUT_ATT( id_set_pr, NF90_GLOBAL, 'time_avg',       &
[1]5304                                     TRIM( time_average_text ) )
5305          ELSE
[3529]5306             CALL netcdf_create_global_atts( id_set_pr, 'podspr', TRIM( run_description_header ), 451 )
[1]5307          ENDIF
[1783]5308          CALL netcdf_handle_error( 'netcdf_define_header', 219 )
[1]5309!
[964]5310!--       Write number of columns and rows of coordinate systems to be plotted
5311!--       on one page to the netcdf header.
[951]5312!--       This information can be used by palmplot.
5313          nc_stat = NF90_PUT_ATT( id_set_pr, NF90_GLOBAL,                     &
5314                                  'no_rows',                                  & 
5315                                  profile_rows ) 
[1783]5316          CALL netcdf_handle_error( 'netcdf_define_header', 519 )
[951]5317
5318          nc_stat = NF90_PUT_ATT( id_set_pr, NF90_GLOBAL,                     &
5319                                  'no_columns',                               & 
5320                                  profile_columns ) 
[1783]5321          CALL netcdf_handle_error( 'netcdf_define_header', 520 )
[951]5322
5323
[964]5324          cross_profiles_adj  = ADJUSTL( cross_profiles )
[951]5325          cross_profiles_numb = 999999
[983]5326          cross_profiles_char = ''
[951]5327
5328!
[964]5329!--       Each profile defined in cross_profiles is written to an array
5330!--       (cross_profiles_char). The number of the respective coordinate
5331!--       system is assigned in a second array (cross_profiles_numb).
5332          k = 1
[951]5333
[964]5334          DO  i = 1, crmax
[951]5335
[964]5336             IF ( TRIM( cross_profiles_adj(i) ) == ' ' )  EXIT
5337             delim_old = 0
5338
5339             DO   j = 1, crmax
5340                delim = INDEX( cross_profiles_adj(i)(delim_old+1:), ' ' )
5341                IF ( delim == 1 )  EXIT
5342                kk = MIN( crmax, k )
5343                cross_profiles_char(kk) = cross_profiles_adj(i)(delim_old+1: &
5344                                                              delim_old+delim-1)
5345                cross_profiles_numb(kk) = i
5346                k = k + 1
5347                cross_profiles_maxi  = i
5348                delim_old = delim_old + delim
5349             ENDDO
5350
5351          ENDDO
5352
[959]5353          cross_profiles_count = MIN( crmax, k-1 )
[951]5354!
5355!--       Check if all profiles defined in cross_profiles are defined in
5356!--       data_output_pr. If not, they will be skipped.
[964]5357          DO  i = 1, cross_profiles_count
5358             DO  j = 1, dopr_n
[951]5359
[964]5360                IF ( TRIM(cross_profiles_char(i)) == TRIM(data_output_pr(j)) ) &
5361                THEN
5362                   EXIT
5363                ENDIF
[951]5364
[964]5365                IF ( j == dopr_n )  THEN
5366                   cross_profiles_numb(i) = 999999
5367                ENDIF
5368
5369             ENDDO
5370          ENDDO
5371
[983]5372          DO i = 1, crmax
5373             IF ( cross_profiles_numb(i) == 999999 ) THEN
5374                DO j = i + 1, crmax
5375                   IF ( cross_profiles_numb(j) /= 999999 ) THEN
5376                      cross_profiles_char(i) = cross_profiles_char(j)
5377                      cross_profiles_numb(i) = cross_profiles_numb(j)
5378                      cross_profiles_numb(j) = 999999
5379                      EXIT
5380                   ENDIF
5381                ENDDO
5382             ENDIF
5383          ENDDO
5384
5385          DO i = 1, crmax-1
5386             IF ( cross_profiles_numb(i + 1) == 999999 ) THEN
5387                cross_profiles_count = i
5388                EXIT
5389             ENDIF
5390          ENDDO
[951]5391!
5392!--       Check if all profiles defined in data_output_pr are defined in
5393!--       cross_profiles. If not, they will be added to cross_profiles.
[964]5394          DO  i = 1, dopr_n
5395             DO  j = 1, cross_profiles_count
5396
[3045]5397                IF ( TRIM(cross_profiles_char(j)) == TRIM(data_output_pr(i)))  &
[964]5398                THEN
5399                   EXIT
5400                ENDIF
5401
[983]5402                IF (( j == cross_profiles_count ) .AND.                        &
5403                    ( cross_profiles_count <= crmax - 1))  THEN
[964]5404                   cross_profiles_count = cross_profiles_count + 1
5405                   cross_profiles_maxi  = cross_profiles_maxi  + 1
[3045]5406                   cross_profiles_char(MIN( crmax, cross_profiles_count )) =   &
[951]5407                                                      TRIM( data_output_pr(i) )
[3045]5408                   cross_profiles_numb(MIN( crmax, cross_profiles_count )) =   &
[959]5409                                                      cross_profiles_maxi
[964]5410                ENDIF
[951]5411
[964]5412             ENDDO
5413          ENDDO
[951]5414
[964]5415          IF ( cross_profiles_count >= crmax )  THEN
[3045]5416             message_string = 'It is not allowed to arrange more than '        &
[3046]5417                              // '100 profiles with & cross_profiles. Apart'   &
5418                              // ' from that, all profiles are saved & to '    &
[992]5419                              // 'the netCDF file.'
[964]5420             CALL message( 'define_netcdf_header', 'PA0354', 0, 0, 0, 6, 0 )
5421          ENDIF
5422
[951]5423!
5424!--       Writing cross_profiles to netcdf header. This information can be
5425!--       used by palmplot. Each profile is separated by ",", each cross is
5426!--       separated by ";".
[964]5427          char_cross_profiles = ';'
5428          id_last = 1
[983]5429          cross_profiles_count = MIN( cross_profiles_count, crmax )
[951]5430
[964]5431          DO  i = 1, cross_profiles_count
[951]5432
[964]5433             IF ( cross_profiles_numb(i) /= 999999 )  THEN
5434                IF ( TRIM( char_cross_profiles ) == ';' )  THEN
5435                   char_cross_profiles = TRIM( char_cross_profiles ) // &
5436                                         TRIM( cross_profiles_char(i) )
5437                ELSEIF ( id_last == cross_profiles_numb(i) )  THEN
5438                   char_cross_profiles = TRIM( char_cross_profiles ) // &
5439                                         ',' // TRIM( cross_profiles_char(i) )
5440                ELSE
5441                   char_cross_profiles = TRIM( char_cross_profiles ) // &
5442                                         ';' // TRIM( cross_profiles_char(i) )
5443                ENDIF
5444                id_last = cross_profiles_numb(i)
5445             ENDIF
5446
5447          ENDDO
5448
[951]5449          char_cross_profiles = TRIM( char_cross_profiles ) // ';'
5450
[964]5451          nc_stat = NF90_PUT_ATT( id_set_pr, NF90_GLOBAL, 'cross_profiles',   &
[951]5452                                  TRIM( char_cross_profiles ) )
[1783]5453          CALL netcdf_handle_error( 'netcdf_define_header', 521 )
[951]5454
5455!
[1]5456!--       Define time coordinate for profiles (unlimited dimension)
[1783]5457          CALL netcdf_create_dim( id_set_pr, 'time', NF90_UNLIMITED,           &
5458                                  id_dim_time_pr, 220 )
5459          CALL netcdf_create_var( id_set_pr, (/ id_dim_time_pr /), 'time',     &
[3529]5460                                  NF90_DOUBLE, id_var_time_pr, 'seconds since '//TRIM(init_model%origin_time), 'time',  &
[1783]5461                                  221, 222, 000 )
[3529]5462          CALL netcdf_create_att( id_set_pr, id_var_time_pr, 'standard_name', 'time', 000)
5463          CALL netcdf_create_att( id_set_pr, id_var_time_pr, 'axis', 'T', 000)
[1]5464!
5465!--       Define the variables
5466          var_list = ';'
5467          DO  i = 1, dopr_n
5468
5469             IF ( statistic_regions == 0 )  THEN
5470
5471!
5472!--             Define the z-axes (each variable gets its own z-axis)
[1783]5473                CALL netcdf_create_dim( id_set_pr,                             &
5474                                        'z' // TRIM( data_output_pr(i) ),      &
5475                                        nzt+2-nzb, id_dim_z_pr(i,0), 223 )
5476                CALL netcdf_create_var( id_set_pr, (/ id_dim_z_pr(i,0) /),     &
5477                                        'z' // TRIM( data_output_pr(i) ),      &
5478                                       NF90_DOUBLE, id_var_z_pr(i,0),          &
5479                                       'meters', '', 224, 225, 000 )
[1]5480!
5481!--             Define the variable
[1783]5482                CALL netcdf_create_var( id_set_pr, (/ id_dim_z_pr(i,0),        &
5483                                        id_dim_time_pr /), data_output_pr(i),  &
5484                                        nc_precision(5), id_var_dopr(i,0),     &
5485                                        TRIM( dopr_unit(i) ),                  &
5486                                        TRIM( data_output_pr(i) ), 226, 227,   &
5487                                        228 )
[1]5488
[519]5489                var_list = TRIM( var_list ) // TRIM( data_output_pr(i) ) //  ';'
[1]5490
5491             ELSE
5492!
5493!--             If statistic regions are defined, add suffix _SR+#SR to the
5494!--             names
5495                DO  j = 0, statistic_regions
[2039]5496                   WRITE ( suffix, '(''_'',I2.2)' )  j
[1]5497
5498!
5499!--                Define the z-axes (each variable gets it own z-axis)
[1783]5500                   CALL netcdf_create_dim( id_set_pr, 'z' //                   &
5501                                           TRIM(data_output_pr(i)) // suffix,  &
5502                                           nzt+2-nzb, id_dim_z_pr(i,j), 229 )
5503                   CALL netcdf_create_var( id_set_pr, (/ id_dim_z_pr(i,j) /),  &
5504                                           'z' // TRIM(data_output_pr(i)) //   &
5505                                           suffix, NF90_DOUBLE,                &
5506                                           id_var_z_pr(i,j), 'meters', '',     &
5507                                           230, 231, 000 )
[1]5508!
5509!--                Define the variable
[1783]5510                   CALL netcdf_create_var( id_set_pr, (/ id_dim_z_pr(i,j),     &
5511                                           id_dim_time_pr /),                  &
5512                                           TRIM(data_output_pr(i)) // suffix,  &
5513                                           nc_precision(5), id_var_dopr(i,j),  &
5514                                           TRIM( dopr_unit(i) ),               &
5515                                           TRIM( data_output_pr(i) ) //        &
5516                                           ' SR ', 232, 233, 234 )
[1]5517
[519]5518                   var_list = TRIM( var_list ) // TRIM( data_output_pr(i) ) // &
[1]5519                              suffix // ';'
5520
5521                ENDDO
5522
5523             ENDIF
5524
5525          ENDDO
5526
5527!
5528!--       Write the list of variables as global attribute (this is used by
5529!--       restart runs)
5530          nc_stat = NF90_PUT_ATT( id_set_pr, NF90_GLOBAL, 'VAR_LIST', var_list )
[1783]5531          CALL netcdf_handle_error( 'netcdf_define_header', 235 )
[1]5532
5533!
5534!--       Define normalization variables (as time series)
5535          DO  i = 1, dopr_norm_num
5536
[1783]5537             CALL netcdf_create_var( id_set_pr, (/ id_dim_time_pr /),          &
5538                                     'NORM_' // TRIM( dopr_norm_names(i) ),    &
5539                                     nc_precision(5), id_var_norm_dopr(i),     &
5540                                     '', TRIM( dopr_norm_longnames(i) ), 236,  &
5541                                     000, 237 )
[1]5542
5543          ENDDO
5544
5545!
[1031]5546!--       Leave netCDF define mode
[1]5547          nc_stat = NF90_ENDDEF( id_set_pr )
[1783]5548          CALL netcdf_handle_error( 'netcdf_define_header', 238 )
[1]5549
5550!
5551!--       Write z-axes data
5552          DO  i = 1, dopr_n
5553             DO  j = 0, statistic_regions
5554
5555                nc_stat = NF90_PUT_VAR( id_set_pr, id_var_z_pr(i,j),      &
5556                                        hom(nzb:nzt+1,2,dopr_index(i),0), &
5557                                        start = (/ 1 /),                  &
5558                                        count = (/ nzt-nzb+2 /) )
[1783]5559                CALL netcdf_handle_error( 'netcdf_define_header', 239 )
[1]5560
5561             ENDDO
5562          ENDDO
5563
5564
5565       CASE ( 'pr_ext' )
5566
5567!
5568!--       Get the list of variables and compare with the actual run.
5569!--       First var_list_old has to be reset, since GET_ATT does not assign
5570!--       trailing blanks.
5571          var_list_old = ' '
5572          nc_stat = NF90_GET_ATT( id_set_pr, NF90_GLOBAL, 'VAR_LIST', &
5573                                  var_list_old )
[1783]5574          CALL netcdf_handle_error( 'netcdf_define_header', 240 )
[1]5575
5576          var_list = ';'
5577          DO  i = 1, dopr_n
5578
5579             IF ( statistic_regions == 0 )  THEN
[519]5580                var_list = TRIM( var_list ) // TRIM( data_output_pr(i) ) // ';'
[1]5581             ELSE
5582                DO  j = 0, statistic_regions
[2039]5583                   WRITE ( suffix, '(''_'',I2.2)' )  j
[519]5584                   var_list = TRIM( var_list ) // TRIM( data_output_pr(i) ) // &
[1]5585                              suffix // ';'
5586                ENDDO
5587             ENDIF
5588
5589          ENDDO
5590
5591          IF ( TRIM( var_list ) /= TRIM( var_list_old ) )  THEN
[3045]5592             message_string = 'netCDF file for vertical profiles ' //          &
5593                              'from previous run found,' //                    &
[3046]5594                              '&but this file cannot be extended due to' //    &
[3045]5595                              ' variable mismatch.' //                         &
[3046]5596                              '&New file is created instead.'
[257]5597             CALL message( 'define_netcdf_header', 'PA0254', 0, 1, 0, 6, 0 )
[1]5598             extend = .FALSE.
5599             RETURN
5600          ENDIF
5601
5602!
5603!--       Get the id of the time coordinate (unlimited coordinate) and its
5604!--       last index on the file. The next time level is dopr..count+1.
5605!--       The current time must be larger than the last output time
5606!--       on the file.
5607          nc_stat = NF90_INQ_VARID( id_set_pr, 'time', id_var_time_pr )
[1783]5608          CALL netcdf_handle_error( 'netcdf_define_header', 241 )
[1]5609
5610          nc_stat = NF90_INQUIRE_VARIABLE( id_set_pr, id_var_time_pr, &
5611                                           dimids = id_dim_time_old )
[1783]5612          CALL netcdf_handle_error( 'netcdf_define_header', 242 )
[1]5613          id_dim_time_pr = id_dim_time_old(1)
5614
5615          nc_stat = NF90_INQUIRE_DIMENSION( id_set_pr, id_dim_time_pr, &
5616                                            len = dopr_time_count )
[1783]5617          CALL netcdf_handle_error( 'netcdf_define_header', 243 )
[1]5618
5619          nc_stat = NF90_GET_VAR( id_set_pr, id_var_time_pr,        &
5620                                  last_time_coordinate,             &
5621                                  start = (/ dopr_time_count /), &
5622                                  count = (/ 1 /) )
[1783]5623          CALL netcdf_handle_error( 'netcdf_define_header', 244 )
[1]5624
5625          IF ( last_time_coordinate(1) >= simulated_time )  THEN
[3045]5626             message_string = 'netCDF file for vertical profiles ' //          &
5627                              'from previous run found,' //                    &
[3046]5628                              '&but this file cannot be extended becaus' //    &
[3045]5629                              'e the current output time' //                   &
[3046]5630                              '&is less or equal than the last output t' //    &
[3045]5631                              'ime on this file.' //                           &
[3046]5632                              '&New file is created instead.'
[257]5633             CALL message( 'define_netcdf_header', 'PA0255', 0, 1, 0, 6, 0 )
[1]5634             dopr_time_count = 0
5635             extend = .FALSE.
5636             RETURN
5637          ENDIF
5638
5639!
5640!--       Dataset seems to be extendable.
5641!--       Now get the variable ids.
5642          i = 1
5643          DO  i = 1, dopr_n
5644 
5645             IF ( statistic_regions == 0 )  THEN
[3045]5646                nc_stat = NF90_INQ_VARID( id_set_pr, data_output_pr(i),        &
[1]5647                                          id_var_dopr(i,0) )
[1783]5648                CALL netcdf_handle_error( 'netcdf_define_header', 245 )
[1]5649             ELSE
5650                DO  j = 0, statistic_regions
[2039]5651                   WRITE ( suffix, '(''_'',I2.2)' )  j
[519]5652                   netcdf_var_name = TRIM( data_output_pr(i) ) // suffix
[3045]5653                   nc_stat = NF90_INQ_VARID( id_set_pr, netcdf_var_name,       &
[1]5654                                             id_var_dopr(i,j) )
[1783]5655                   CALL netcdf_handle_error( 'netcdf_define_header', 246 )
[1]5656                ENDDO
5657             ENDIF
5658
5659          ENDDO
5660
5661!
5662!--       Get ids of the normalization variables
5663          DO  i = 1, dopr_norm_num
5664             nc_stat = NF90_INQ_VARID( id_set_pr,                             &
5665                                       'NORM_' // TRIM( dopr_norm_names(i) ), &
5666                                       id_var_norm_dopr(i) )
[1783]5667             CALL netcdf_handle_error( 'netcdf_define_header', 247 )
[1]5668          ENDDO
5669
5670!
[359]5671!--       Update the title attribute on file
5672!--       In order to avoid 'data mode' errors if updated attributes are larger
5673!--       than their original size, NF90_PUT_ATT is called in 'define mode'
5674!--       enclosed by NF90_REDEF and NF90_ENDDEF calls. This implies a possible
5675!--       performance loss due to data copying; an alternative strategy would be
5676!--       to ensure equal attribute size in a job chain. Maybe revise later.
[1353]5677          IF ( averaging_interval_pr == 0.0_wp )  THEN
[359]5678             time_average_text = ' '
5679          ELSE
5680             WRITE (time_average_text, '('', '',F7.1,'' s average'')') &
5681                                                            averaging_interval_pr
5682          ENDIF
5683          nc_stat = NF90_REDEF( id_set_pr )
[1783]5684          CALL netcdf_handle_error( 'netcdf_define_header', 437 )
[3045]5685          nc_stat = NF90_PUT_ATT( id_set_pr, NF90_GLOBAL, 'title',             &
5686                                  TRIM( run_description_header ) //            &
[359]5687                                  TRIM( time_average_text ) )
[1783]5688          CALL netcdf_handle_error( 'netcdf_define_header', 248 )
[951]5689
[359]5690          nc_stat = NF90_ENDDEF( id_set_pr )
[1783]5691          CALL netcdf_handle_error( 'netcdf_define_header', 438 )
[3045]5692          message_string = 'netCDF file for vertical profiles ' //             &
5693                           'from previous run found.' //                       &
[3046]5694                           '&This file will be extended.'
[257]5695          CALL message( 'define_netcdf_header', 'PA0256', 0, 0, 0, 6, 0 )
[1]5696
5697
5698       CASE ( 'ts_new' )
5699
5700!
5701!--       Define some global attributes of the dataset
[3529]5702          CALL netcdf_create_global_atts( id_set_ts, 'podsts', TRIM(run_description_header), 329 )
[3485]5703
[3529]5704          ! nc_stat = NF90_PUT_ATT( id_set_ts, NF90_GLOBAL, 'title',             &
5705          !                         TRIM( run_description_header ) )
5706          ! CALL netcdf_handle_error( 'netcdf_define_header', 249 )
[1]5707
5708!
5709!--       Define time coordinate for time series (unlimited dimension)
[1783]5710          CALL netcdf_create_dim( id_set_ts, 'time', NF90_UNLIMITED,           &
5711                                  id_dim_time_ts, 250 )
5712          CALL netcdf_create_var( id_set_ts, (/ id_dim_time_ts /), 'time',     &
[3529]5713                                  NF90_DOUBLE, id_var_time_ts, 'seconds since '//TRIM(init_model%origin_time), 'time',  &
[1783]5714                                  251, 252, 000 )
[3529]5715          CALL netcdf_create_att( id_set_ts, id_var_time_ts, 'standard_name', 'time', 000)
5716          CALL netcdf_create_att( id_set_ts, id_var_time_ts, 'axis', 'T', 000)
[1]5717!
5718!--       Define the variables
5719          var_list = ';'
5720          DO  i = 1, dots_num
5721
5722             IF ( statistic_regions == 0 )  THEN
5723
[1783]5724                CALL netcdf_create_var( id_set_ts, (/ id_dim_time_ts /),       &
5725                                        dots_label(i), nc_precision(6),        &
5726                                        id_var_dots(i,0),                      &
5727                                        TRIM( dots_unit(i) ),                  &
5728                                        TRIM( dots_label(i) ), 253, 254, 255 )
[1]5729
[1990]5730                var_list = TRIM( var_list ) // TRIM( dots_label(i) ) // ';'
5731
[1]5732             ELSE
5733!
5734!--             If statistic regions are defined, add suffix _SR+#SR to the
5735!--             names
5736                DO  j = 0, statistic_regions
[2039]5737                   WRITE ( suffix, '(''_'',I2.2)' )  j
[1]5738
[1783]5739                   CALL netcdf_create_var( id_set_ts, (/ id_dim_time_ts /),    &
5740                                           TRIM( dots_label(i) ) // suffix,    &
5741                                           nc_precision(6), id_var_dots(i,j),  &
5742                                           TRIM( dots_unit(i) ),               &
5743                                           TRIM( dots_label(i) ) // ' SR ' //  &
5744                                           suffix(2:2), 256, 257, 347)
[1]5745
[1990]5746                   var_list = TRIM( var_list ) // TRIM( dots_label(i) ) // &
5747                              suffix // ';'
5748
[1]5749                ENDDO
5750
5751             ENDIF
5752
5753          ENDDO
5754
5755!
5756!--       Write the list of variables as global attribute (this is used by
5757!--       restart runs)
5758          nc_stat = NF90_PUT_ATT( id_set_ts, NF90_GLOBAL, 'VAR_LIST', var_list )
[1783]5759          CALL netcdf_handle_error( 'netcdf_define_header', 258 )
[1]5760
5761!
[1031]5762!--       Leave netCDF define mode
[1]5763          nc_stat = NF90_ENDDEF( id_set_ts )
[1783]5764          CALL netcdf_handle_error( 'netcdf_define_header', 259 )
[1]5765
5766
5767       CASE ( 'ts_ext' )
5768
5769!
5770!--       Get the list of variables and compare with the actual run.
5771!--       First var_list_old has to be reset, since GET_ATT does not assign
5772!--       trailing blanks.
5773          var_list_old = ' '
5774          nc_stat = NF90_GET_ATT( id_set_ts, NF90_GLOBAL, 'VAR_LIST', &
5775                                  var_list_old )
[1783]5776          CALL netcdf_handle_error( 'netcdf_define_header', 260 )
[1]5777
5778          var_list = ';'
5779          i = 1
5780          DO  i = 1, dots_num
5781
5782             IF ( statistic_regions == 0 )  THEN
[519]5783                var_list = TRIM( var_list ) // TRIM( dots_label(i) ) // ';'
[1]5784             ELSE
5785                DO  j = 0, statistic_regions
[2039]5786                   WRITE ( suffix, '(''_'',I2.2)' )  j
[3045]5787                   var_list = TRIM( var_list ) // TRIM( dots_label(i) ) //     &
[1]5788                              suffix // ';'
5789                ENDDO
5790             ENDIF
5791
5792          ENDDO
5793
5794          IF ( TRIM( var_list ) /= TRIM( var_list_old ) )  THEN
[3045]5795             message_string = 'netCDF file for time series ' //                &
5796                              'from previous run found,' //                    &
[3046]5797                              '&but this file cannot be extended due to' //    &
[3045]5798                              ' variable mismatch.' //                         &
[3046]5799                              '&New file is created instead.'
[257]5800             CALL message( 'define_netcdf_header', 'PA0257', 0, 1, 0, 6, 0 )
[1]5801             extend = .FALSE.
5802             RETURN
5803          ENDIF
5804
5805!
5806!--       Get the id of the time coordinate (unlimited coordinate) and its
5807!--       last index on the file. The next time level is dots..count+1.
5808!--       The current time must be larger than the last output time
5809!--       on the file.
5810          nc_stat = NF90_INQ_VARID( id_set_ts, 'time', id_var_time_ts )
[1783]5811          CALL netcdf_handle_error( 'netcdf_define_header', 261 )
[1]5812
[3045]5813          nc_stat = NF90_INQUIRE_VARIABLE( id_set_ts, id_var_time_ts,          &
[1]5814                                           dimids = id_dim_time_old )
[1783]5815          CALL netcdf_handle_error( 'netcdf_define_header', 262 )
[1]5816          id_dim_time_ts = id_dim_time_old(1)
5817
[3045]5818          nc_stat = NF90_INQUIRE_DIMENSION( id_set_ts, id_dim_time_ts,         &
[1]5819                                            len = dots_time_count )
[1783]5820          CALL netcdf_handle_error( 'netcdf_define_header', 263 )
[1]5821
[3045]5822          nc_stat = NF90_GET_VAR( id_set_ts, id_var_time_ts,                   &
5823                                  last_time_coordinate,                        &
5824                                  start = (/ dots_time_count /),               &
[1]5825                                  count = (/ 1 /) )
[1783]5826          CALL netcdf_handle_error( 'netcdf_define_header', 264 )
[1]5827
5828          IF ( last_time_coordinate(1) >= simulated_time )  THEN
[3045]5829             message_string = 'netCDF file for time series ' //                &
5830                              'from previous run found,' //                    &
[3046]5831                              '&but this file cannot be extended becaus' //    &
[3045]5832                              'e the current output time' //                   &
[3046]5833                              '&is less or equal than the last output t' //    &
[3045]5834                              'ime on this file.' //                           &
[3046]5835                              '&New file is created instead.'
[257]5836             CALL message( 'define_netcdf_header', 'PA0258', 0, 1, 0, 6, 0 )
[1]5837             dots_time_count = 0
5838             extend = .FALSE.
5839             RETURN
5840          ENDIF
5841
5842!
5843!--       Dataset seems to be extendable.
5844!--       Now get the variable ids
5845          i = 1
5846          DO  i = 1, dots_num
5847 
5848             IF ( statistic_regions == 0 )  THEN
[519]5849                nc_stat = NF90_INQ_VARID( id_set_ts, dots_label(i), &
[1]5850                                          id_var_dots(i,0) )
[1783]5851                CALL netcdf_handle_error( 'netcdf_define_header', 265 )
[1]5852             ELSE
5853                DO  j = 0, statistic_regions
[2039]5854                   WRITE ( suffix, '(''_'',I2.2)' )  j
[519]5855                   netcdf_var_name = TRIM( dots_label(i) ) // suffix
[1]5856                   nc_stat = NF90_INQ_VARID( id_set_ts, netcdf_var_name, &
5857                                             id_var_dots(i,j) )
[1783]5858                   CALL netcdf_handle_error( 'netcdf_define_header', 266 )
[1]5859                ENDDO
5860             ENDIF
5861
5862          ENDDO
5863
5864!
[359]5865!--       Update the title attribute on file
5866!--       In order to avoid 'data mode' errors if updated attributes are larger
5867!--       than their original size, NF90_PUT_ATT is called in 'define mode'
5868!--       enclosed by NF90_REDEF and NF90_ENDDEF calls. This implies a possible
5869!--       performance loss due to data copying; an alternative strategy would be
5870!--       to ensure equal attribute size in a job chain. Maybe revise later.
5871          nc_stat = NF90_REDEF( id_set_ts )
[1783]5872          CALL netcdf_handle_error( 'netcdf_define_header', 439 )
[3045]5873          nc_stat = NF90_PUT_ATT( id_set_ts, NF90_GLOBAL, 'title',             &
[1]5874                                  TRIM( run_description_header ) )
[1783]5875          CALL netcdf_handle_error( 'netcdf_define_header', 267 )
[359]5876          nc_stat = NF90_ENDDEF( id_set_ts )
[1783]5877          CALL netcdf_handle_error( 'netcdf_define_header', 440 )
[3045]5878          message_string = 'netCDF file for time series ' //                   &
5879                           'from previous run found.' //                       &
[3046]5880                           '&This file will be extended.'
[257]5881          CALL message( 'define_netcdf_header', 'PA0259', 0, 0, 0, 6, 0 )
[1]5882
5883
5884       CASE ( 'sp_new' )
5885
5886!
5887!--       Define some global attributes of the dataset
[1353]5888          IF ( averaging_interval_sp /= 0.0_wp )  THEN
[3045]5889             WRITE (time_average_text,'('', '',F7.1,'' s average'')')          &
[1]5890                                                            averaging_interval_sp
[3045]5891             nc_stat = NF90_PUT_ATT( id_set_sp, NF90_GLOBAL, 'title',          &
5892                                     TRIM( run_description_header ) //         &
[1]5893                                     TRIM( time_average_text ) )
[1783]5894             CALL netcdf_handle_error( 'netcdf_define_header', 268 )
[1]5895
5896             WRITE ( time_average_text,'(F7.1,'' s avg'')' )  averaging_interval_sp
5897             nc_stat = NF90_PUT_ATT( id_set_sp, NF90_GLOBAL, 'time_avg', &
5898                                     TRIM( time_average_text ) )
5899          ELSE
5900             nc_stat = NF90_PUT_ATT( id_set_sp, NF90_GLOBAL, 'title', &
5901                                     TRIM( run_description_header ) )
5902          ENDIF
[1783]5903          CALL netcdf_handle_error( 'netcdf_define_header', 269 )
[1]5904
5905!
5906!--       Define time coordinate for spectra (unlimited dimension)
[1783]5907          CALL netcdf_create_dim( id_set_sp, 'time', NF90_UNLIMITED,           &
5908                                  id_dim_time_sp, 270 )
5909          CALL netcdf_create_var( id_set_sp, (/ id_dim_time_sp /), 'time',     &
[3529]5910                                  NF90_DOUBLE, id_var_time_sp, 'seconds since '//TRIM(init_model%origin_time), 'time',  &
[1783]5911                                  271, 272, 000 )
[3529]5912          CALL netcdf_create_att( id_set_sp, id_var_time_sp, 'standard_name', 'time', 000)
5913          CALL netcdf_create_att( id_set_sp, id_var_time_sp, 'axis', 'T', 000)
[1]5914!
5915!--       Define the spatial dimensions and coordinates for spectra.
5916!--       First, determine the number of vertical levels for which spectra
5917!--       are to be output.
5918          ns = 1
5919          DO WHILE ( comp_spectra_level(ns) /= 999999  .AND.  ns <= 100 )
5920             ns = ns + 1
5921          ENDDO
5922          ns = ns - 1
5923
5924!
5925!--       Define vertical coordinate grid (zu grid)
[1783]5926          CALL netcdf_create_dim( id_set_sp, 'zu_sp', ns, id_dim_zu_sp, 273 )
5927          CALL netcdf_create_var( id_set_sp, (/ id_dim_zu_sp /), 'zu_sp',      &
5928                                  NF90_DOUBLE, id_var_zu_sp, 'meters', '',     &
5929                                  274, 275, 000 )
[1]5930!
5931!--       Define vertical coordinate grid (zw grid)
[1783]5932          CALL netcdf_create_dim( id_set_sp, 'zw_sp', ns, id_dim_zw_sp, 276 )
5933          CALL netcdf_create_var( id_set_sp, (/ id_dim_zw_sp /), 'zw_sp',      &
5934                                  NF90_DOUBLE, id_var_zw_sp, 'meters', '',     &
5935                                  277, 278, 000 )
[1]5936!
5937!--       Define x-axis
[1783]5938          CALL netcdf_create_dim( id_set_sp, 'k_x', nx/2, id_dim_x_sp, 279 )
5939          CALL netcdf_create_var( id_set_sp, (/ id_dim_x_sp /), 'k_x',         &
5940                                  NF90_DOUBLE, id_var_x_sp, 'm-1', '', 280,    &
5941                                  281, 000 )
[1]5942!
5943!--       Define y-axis
[3294]5944          CALL netcdf_create_dim( id_set_sp, 'k_y', ny/2, id_dim_y_sp, 282 )
[1783]5945          CALL netcdf_create_var( id_set_sp, (/ id_dim_y_sp /), 'k_y',         &
5946                                  NF90_DOUBLE, id_var_y_sp, 'm-1', '', 283,    &
5947                                  284, 000 )
[1]5948!
5949!--       Define the variables
5950          var_list = ';'
5951          i = 1
5952          DO WHILE ( data_output_sp(i) /= ' '  .AND.  i <= 10 )
[144]5953!
5954!--          First check for the vertical grid
[1980]5955             found = .FALSE.
[144]5956             SELECT CASE ( data_output_sp(i) )
5957!
5958!--             Most variables are defined on the zu levels
[3421]5959                CASE ( 'e', 'nc', 'nr', 'p', 'pc', 'pr', 'prr',   &
[2292]5960                       'q', 'qc', 'ql', 'ql_c', 'ql_v', 'ql_vp', 'qr', 'qv',   &
[3421]5961                       'rho_sea_water', 's', 'sa', &
5962                       'theta', 'thetal', 'thetav', 'u', 'v' )
[1]5963
[144]5964                   grid_z = 'zu'
5965!
5966!--             zw levels
5967                CASE ( 'w' )
5968
5969                   grid_z = 'zw'
5970
5971                CASE DEFAULT
5972!
5973!--                Check for user-defined quantities (found, grid_x and grid_y
5974!--                are dummies)
[3701]5975                   IF ( user_module_enabled )  THEN
5976                      CALL user_define_netcdf_grid( data_output_sp(i), found,  &
5977                                                    grid_x, grid_y, grid_z )
5978                   ENDIF
[144]5979
5980             END SELECT
5981
[1]5982             IF ( INDEX( spectra_direction(i), 'x' ) /= 0 )  THEN
5983
5984!
5985!--             Define the variable
5986                netcdf_var_name = TRIM( data_output_sp(i) ) // '_x'
[144]5987                IF ( TRIM( grid_z ) == 'zw' )  THEN
[1783]5988                   CALL netcdf_create_var( id_set_sp, (/ id_dim_x_sp,          &
5989                                           id_dim_zw_sp, id_dim_time_sp /),    &
5990                                           netcdf_var_name, nc_precision(7),   &
5991                                           id_var_dospx(i), 'unknown',         &
5992                                           netcdf_var_name, 285, 286, 287 )
[1]5993                ELSE
[1783]5994                   CALL netcdf_create_var( id_set_sp, (/ id_dim_x_sp,          &
5995                                           id_dim_zu_sp, id_dim_time_sp /),    &
5996                                           netcdf_var_name, nc_precision(7),   &
5997                                           id_var_dospx(i), 'unknown',         &
5998                                           netcdf_var_name, 285, 286, 287 )
[1]5999                ENDIF
6000
6001                var_list = TRIM( var_list ) // TRIM( netcdf_var_name ) // ';'
6002
6003             ENDIF
6004
6005             IF ( INDEX( spectra_direction(i), 'y' ) /= 0 )  THEN
6006
6007!
6008!--             Define the variable
6009                netcdf_var_name = TRIM( data_output_sp(i) ) // '_y'
[144]6010                IF ( TRIM( grid_z ) == 'zw' )  THEN
[1783]6011                   CALL netcdf_create_var( id_set_sp, (/ id_dim_y_sp,          &
6012                                           id_dim_zw_sp, id_dim_time_sp /),    &
6013                                           netcdf_var_name, nc_precision(7),   &
6014                                           id_var_dospy(i), 'unknown',         &
6015                                           netcdf_var_name, 288, 289, 290 )
[1]6016                ELSE
[1783]6017                   CALL netcdf_create_var( id_set_sp, (/ id_dim_y_sp,          &
6018                                           id_dim_zu_sp, id_dim_time_sp /),    &
6019                                           netcdf_var_name, nc_precision(7),   &
6020                                           id_var_dospy(i), 'unknown',         &
6021                                           netcdf_var_name, 288, 289, 290 )
[1]6022                ENDIF
6023
6024                var_list = TRIM( var_list ) // TRIM( netcdf_var_name ) // ';'
6025
6026             ENDIF
6027
6028             i = i + 1
6029
6030          ENDDO
6031
6032!
6033!--       Write the list of variables as global attribute (this is used by
6034!--       restart runs)
6035          nc_stat = NF90_PUT_ATT( id_set_sp, NF90_GLOBAL, 'VAR_LIST', var_list )
[1783]6036          CALL netcdf_handle_error( 'netcdf_define_header', 291 )
[1]6037
6038!
[1031]6039!--       Leave netCDF define mode
[1]6040          nc_stat = NF90_ENDDEF( id_set_sp )
[1783]6041          CALL netcdf_handle_error( 'netcdf_define_header', 292 )
[1]6042
6043!
6044!--       Write axis data: zu_sp, zw_sp, k_x, k_y
6045          ALLOCATE( netcdf_data(1:ns) )
6046
6047!
6048!--       Write zu data
6049          netcdf_data(1:ns) = zu( comp_spectra_level(1:ns) )
6050          nc_stat = NF90_PUT_VAR( id_set_sp, id_var_zu_sp, netcdf_data, &
6051                                  start = (/ 1 /), count = (/ ns /) )
[1783]6052          CALL netcdf_handle_error( 'netcdf_define_header', 293 )
[1]6053
6054!
6055!--       Write zw data
6056          netcdf_data(1:ns) = zw( comp_spectra_level(1:ns) )
6057          nc_stat = NF90_PUT_VAR( id_set_sp, id_var_zw_sp, netcdf_data, &
6058                                  start = (/ 1 /), count = (/ ns /) )
[1783]6059          CALL netcdf_handle_error( 'netcdf_define_header', 294 )
[1]6060
6061          DEALLOCATE( netcdf_data )
6062
6063!
6064!--       Write data for x and y axis (wavenumbers)
6065          ALLOCATE( netcdf_data(nx/2) )
6066          DO  i = 1, nx/2
[1353]6067             netcdf_data(i) = 2.0_wp * pi * i / ( dx * ( nx + 1 ) )
[1]6068          ENDDO
6069
6070          nc_stat = NF90_PUT_VAR( id_set_sp, id_var_x_sp, netcdf_data, &
6071                                  start = (/ 1 /), count = (/ nx/2 /) )
[1783]6072          CALL netcdf_handle_error( 'netcdf_define_header', 295 )
[1]6073
6074          DEALLOCATE( netcdf_data )
6075
6076          ALLOCATE( netcdf_data(ny/2) )
6077          DO  i = 1, ny/2
[1353]6078             netcdf_data(i) = 2.0_wp * pi * i / ( dy * ( ny + 1 ) )
[1]6079          ENDDO
6080
6081          nc_stat = NF90_PUT_VAR( id_set_sp, id_var_y_sp, netcdf_data, &
6082                                  start = (/ 1 /), count = (/ ny/2 /) )
[1783]6083          CALL netcdf_handle_error( 'netcdf_define_header', 296 )
[1]6084
6085          DEALLOCATE( netcdf_data )
6086
6087
6088       CASE ( 'sp_ext' )
6089
6090!
6091!--       Get the list of variables and compare with the actual run.
6092!--       First var_list_old has to be reset, since GET_ATT does not assign
6093!--       trailing blanks.
6094          var_list_old = ' '
6095          nc_stat = NF90_GET_ATT( id_set_sp, NF90_GLOBAL, 'VAR_LIST', &
6096                                  var_list_old )
[1783]6097          CALL netcdf_handle_error( 'netcdf_define_header', 297 )
[1]6098          var_list = ';'
6099          i = 1
6100          DO WHILE ( data_output_sp(i) /= ' '  .AND.  i <= 10 )
6101
6102             IF ( INDEX( spectra_direction(i), 'x' ) /= 0 )  THEN
6103                netcdf_var_name = TRIM( data_output_sp(i) ) // '_x'
6104                var_list = TRIM( var_list ) // TRIM( netcdf_var_name ) // ';'
6105             ENDIF
6106
6107             IF ( INDEX( spectra_direction(i), 'y' ) /= 0 )  THEN
6108                netcdf_var_name = TRIM( data_output_sp(i) ) // '_y'
6109                var_list = TRIM( var_list ) // TRIM( netcdf_var_name ) // ';'
6110             ENDIF
6111
6112             i = i + 1
6113
6114          ENDDO
6115
6116          IF ( TRIM( var_list ) /= TRIM( var_list_old ) )  THEN
[3045]6117             message_string = 'netCDF file for spectra  ' //                   &
6118                              'from previous run found,' //                    &
[3046]6119                              '&but this file cannot be extended due to' //    &
[3045]6120                              ' variable mismatch.' //                         &
[3046]6121                              '&New file is created instead.'
[257]6122             CALL message( 'define_netcdf_header', 'PA0260', 0, 1, 0, 6, 0 )
[1]6123             extend = .FALSE.
6124             RETURN
6125          ENDIF
6126
6127!
6128!--       Determine the number of current vertical levels for which spectra
6129!--       shall be output
6130          ns = 1
[189]6131          DO WHILE ( comp_spectra_level(ns) /= 999999  .AND.  ns <= 100 )
[1]6132             ns = ns + 1
6133          ENDDO
6134          ns = ns - 1
6135
6136!
6137!--       Get and compare the number of vertical levels
6138          nc_stat = NF90_INQ_VARID( id_set_sp, 'zu_sp', id_var_zu_sp )
[1783]6139          CALL netcdf_handle_error( 'netcdf_define_header', 298 )
[1]6140
6141          nc_stat = NF90_INQUIRE_VARIABLE( id_set_sp, id_var_zu_sp, &
6142                                           dimids = id_dim_zu_sp_old )
[1783]6143          CALL netcdf_handle_error( 'netcdf_define_header', 299 )
[1]6144          id_dim_zu_sp = id_dim_zu_sp_old(1)
6145
6146          nc_stat = NF90_INQUIRE_DIMENSION( id_set_sp, id_dim_zu_sp, &
6147                                            len = ns_old )
[1783]6148          CALL netcdf_handle_error( 'netcdf_define_header', 300 )
[1]6149
6150          IF ( ns /= ns_old )  THEN
[3045]6151             message_string = 'netCDF file for spectra ' //                    &
6152                              ' from previous run found,' //                   &
[3046]6153                              '&but this file cannot be extended due to' //    &
[3045]6154                              ' mismatch in number of' //                      &
6155                              ' vertical levels.' //                           &
[3046]6156                              '&New file is created instead.'
[257]6157             CALL message( 'define_netcdf_header', 'PA0261', 0, 1, 0, 6, 0 )
[1]6158             extend = .FALSE.
6159             RETURN
6160          ENDIF
6161
6162!
6163!--       Get and compare the heights of the cross sections
6164          ALLOCATE( netcdf_data(1:ns_old) )
6165
6166          nc_stat = NF90_GET_VAR( id_set_sp, id_var_zu_sp, netcdf_data )
[1783]6167          CALL netcdf_handle_error( 'netcdf_define_header', 301 )
[1]6168
6169          DO  i = 1, ns
6170             IF ( zu(comp_spectra_level(i)) /= netcdf_data(i) )  THEN
[1031]6171                message_string = 'netCDF file for spectra ' //                 &
[292]6172                                 ' from previous run found,' //                &
[3046]6173                                 '&but this file cannot be extended due to' // &
[257]6174                                 ' mismatch in heights of' //                  &
[3045]6175                                 ' vertical levels.' //                        &
[3046]6176                                 '&New file is created instead.'
[257]6177                CALL message( 'define_netcdf_header', 'PA0262', 0, 1, 0, 6, 0 )
[1]6178                extend = .FALSE.
6179                RETURN
6180             ENDIF
6181          ENDDO
6182
6183          DEALLOCATE( netcdf_data )
6184
6185!
6186!--       Get the id of the time coordinate (unlimited coordinate) and its
6187!--       last index on the file. The next time level is plsp..count+1.
6188!--       The current time must be larger than the last output time
6189!--       on the file.
6190          nc_stat = NF90_INQ_VARID( id_set_sp, 'time', id_var_time_sp )
[1783]6191          CALL netcdf_handle_error( 'netcdf_define_header', 302 )
[1]6192
6193          nc_stat = NF90_INQUIRE_VARIABLE( id_set_sp, id_var_time_sp, &
6194                                           dimids = id_dim_time_old )
[1783]6195          CALL netcdf_handle_error( 'netcdf_define_header', 303 )
[1]6196          id_dim_time_sp = id_dim_time_old(1)
6197
6198          nc_stat = NF90_INQUIRE_DIMENSION( id_set_sp, id_dim_time_sp, &
6199                                            len = dosp_time_count )
[1783]6200          CALL netcdf_handle_error( 'netcdf_define_header', 304 )
[1]6201
6202          nc_stat = NF90_GET_VAR( id_set_sp, id_var_time_sp,        &
6203                                  last_time_coordinate,             &
6204                                  start = (/ dosp_time_count /), &
6205                                  count = (/ 1 /) )
[1783]6206          CALL netcdf_handle_error( 'netcdf_define_header', 305 )
[1]6207
6208          IF ( last_time_coordinate(1) >= simulated_time )  THEN
[3045]6209             message_string = 'netCDF file for spectra ' //                    &
6210                              'from previous run found,' //                    &
[3046]6211                              '&but this file cannot be extended becaus' //    &
[3045]6212                              'e the current output time' //                   & 
[3046]6213                              '&is less or equal than the last output t' //    &
[3045]6214                              'ime on this file.' //                           &
[3046]6215                              '&New file is created instead.'
[257]6216             CALL message( 'define_netcdf_header', 'PA0263', 0, 1, 0, 6, 0 )
[1]6217             dosp_time_count = 0
6218             extend = .FALSE.
6219             RETURN
6220          ENDIF
6221
6222!
6223!--       Dataset seems to be extendable.
6224!--       Now get the variable ids.
6225          i = 1
6226          DO WHILE ( data_output_sp(i) /= ' '  .AND.  i <= 10 )
6227
6228             IF ( INDEX( spectra_direction(i), 'x' ) /= 0 )  THEN
6229                netcdf_var_name = TRIM( data_output_sp(i) ) // '_x'
6230                nc_stat = NF90_INQ_VARID( id_set_sp, netcdf_var_name, &
6231                                          id_var_dospx(i) )
[1783]6232                CALL netcdf_handle_error( 'netcdf_define_header', 306 )
[1]6233             ENDIF
6234
6235             IF ( INDEX( spectra_direction(i), 'y' ) /= 0 )  THEN
6236                netcdf_var_name = TRIM( data_output_sp(i) ) // '_y'
6237                nc_stat = NF90_INQ_VARID( id_set_sp, netcdf_var_name, &
6238                                          id_var_dospy(i) )
[1783]6239                CALL netcdf_handle_error( 'netcdf_define_header', 307 )
[1]6240             ENDIF
6241
6242             i = i + 1
6243
6244          ENDDO
6245
6246!
[359]6247!--       Update the title attribute on file
6248!--       In order to avoid 'data mode' errors if updated attributes are larger
6249!--       than their original size, NF90_PUT_ATT is called in 'define mode'
6250!--       enclosed by NF90_REDEF and NF90_ENDDEF calls. This implies a possible
6251!--       performance loss due to data copying; an alternative strategy would be
6252!--       to ensure equal attribute size in a job chain. Maybe revise later.
6253          nc_stat = NF90_REDEF( id_set_sp )
[1783]6254          CALL netcdf_handle_error( 'netcdf_define_header', 441 )
[1353]6255          IF ( averaging_interval_sp /= 0.0_wp )  THEN
[1]6256             WRITE (time_average_text,'('', '',F7.1,'' s average'')') &
[274]6257                                                           averaging_interval_sp
[1]6258             nc_stat = NF90_PUT_ATT( id_set_sp, NF90_GLOBAL, 'title',  &
6259                                     TRIM( run_description_header ) // &
6260                                     TRIM( time_average_text ) )
[1783]6261             CALL netcdf_handle_error( 'netcdf_define_header', 308 )
[1]6262
6263             WRITE ( time_average_text,'(F7.1,'' s avg'')' )  averaging_interval_sp
[3045]6264             nc_stat = NF90_PUT_ATT( id_set_sp, NF90_GLOBAL, 'time_avg',       &
[1]6265                                     TRIM( time_average_text ) )
6266          ELSE
[3045]6267             nc_stat = NF90_PUT_ATT( id_set_sp, NF90_GLOBAL, 'title',          &
[1]6268                                     TRIM( run_description_header ) )
6269          ENDIF
[1783]6270          CALL netcdf_handle_error( 'netcdf_define_header', 309 )
[359]6271          nc_stat = NF90_ENDDEF( id_set_sp )
[1783]6272          CALL netcdf_handle_error( 'netcdf_define_header', 442 )
[3045]6273          message_string = 'netCDF file for spectra ' //                       &
6274                           'from previous run found.' //                       &
[3046]6275                           '&This file will be extended.'
[257]6276          CALL message( 'define_netcdf_header', 'PA0264', 0, 0, 0, 6, 0 )
[1]6277
[3045]6278!
6279!--     Currently disabled (DATA_PRT_NETCDF)
6280!       CASE ( 'pt_new' )
[1]6281
6282!
6283!--       Define some global attributes of the dataset
[3045]6284!          nc_stat = NF90_PUT_ATT( id_set_prt, NF90_GLOBAL, 'title',            &
6285!                                  TRIM( run_description_header ) )
6286!          CALL netcdf_handle_error( 'netcdf_define_header', 310 )
[1]6287
6288!
6289!--       Define time coordinate for particles (unlimited dimension)
[3045]6290!          CALL netcdf_create_dim( id_set_prt, 'time', NF90_UNLIMITED,          &
6291!                                  id_dim_time_prt, 311 )
6292!          CALL netcdf_create_var( id_set_prt, (/ id_dim_time_prt /), 'time',   &
6293!                                  NF90_DOUBLE, id_var_time_prt, 'seconds', '', &
6294!                                  312, 313, 000 )
[1]6295!
[2265]6296!--       netCDF4 allows more than one unlimited dimension
[3045]6297!          CALL netcdf_create_dim( id_set_prt, 'particle_number',            &
6298!                                  NF90_UNLIMITED, id_dim_prtnum, 314 )
[1]6299
[3045]6300!          CALL netcdf_create_var( id_set_prt, (/ id_dim_prtnum /),             &
6301!                                  'particle_number', NF90_DOUBLE,              &
6302!                                  id_var_prtnum, 'particle number', '', 315,   &
6303!                                  316, 000 )
[1]6304!
6305!--       Define variable which contains the real number of particles in use
[3045]6306!          CALL netcdf_create_var( id_set_prt, (/ id_dim_time_prt /),           &
6307!                                  'real_num_of_prt', NF90_DOUBLE,              &
6308!                                  id_var_rnop_prt, 'particle number', '', 317, &
6309!                                  318, 000 )
[1]6310!
6311!--       Define the variables
[3045]6312!          DO  i = 1, 17
[1]6313
[3045]6314!             CALL netcdf_create_var( id_set_prt, (/ id_dim_prtnum,             &
6315!                                     id_dim_time_prt /), prt_var_names(i),     &
6316!                                     nc_precision(8), id_var_prt(i),           &
6317!                                     TRIM( prt_var_units(i) ),                 &
6318!                                     TRIM( prt_var_names(i) ), 319, 320, 321 )
[1]6319
[3045]6320!          ENDDO
[1]6321
6322!
[1031]6323!--       Leave netCDF define mode
[3045]6324!          nc_stat = NF90_ENDDEF( id_set_prt )
6325!          CALL netcdf_handle_error( 'netcdf_define_header', 322 )
[1]6326
[3045]6327!
6328!--     Currently disabled (DATA_PRT_NETCDF)
6329!       CASE ( 'pt_ext' )
[1]6330
6331!
6332!--       Get the id of the time coordinate (unlimited coordinate) and its
6333!--       last index on the file. The next time level is prt..count+1.
6334!--       The current time must be larger than the last output time
6335!--       on the file.
[3045]6336!          nc_stat = NF90_INQ_VARID( id_set_prt, 'time', id_var_time_prt )
6337!          CALL netcdf_handle_error( 'netcdf_define_header', 323 )
[1]6338
[3045]6339!          nc_stat = NF90_INQUIRE_VARIABLE( id_set_prt, id_var_time_prt, &
6340!                                           dimids = id_dim_time_old )
6341!          CALL netcdf_handle_error( 'netcdf_define_header', 324 )
6342!          id_dim_time_prt = id_dim_time_old(1)
[1]6343
[3045]6344!          nc_stat = NF90_INQUIRE_DIMENSION( id_set_prt, id_dim_time_prt, &
6345!                                            len = prt_time_count )
6346!          CALL netcdf_handle_error( 'netcdf_define_header', 325 )
[1]6347
[3045]6348!          nc_stat = NF90_GET_VAR( id_set_prt, id_var_time_prt,  &
6349!                                  last_time_coordinate,         &
6350!                                  start = (/ prt_time_count /), &
6351!                                  count = (/ 1 /) )
6352!          CALL netcdf_handle_error( 'netcdf_define_header', 326 )
[1]6353
[3045]6354!          IF ( last_time_coordinate(1) >= simulated_time )  THEN
6355!             message_string = 'netCDF file for particles ' //                  &
6356!                              'from previous run found,' //                    &
[3046]6357!                              '&but this file cannot be extended becaus' //    &
[3045]6358!                              'e the current output time' //                   &
[3046]6359!                              '&is less or equal than the last output t' //    &
[3045]6360!                              'ime on this file.' //                           &
[3046]6361!                              '&New file is created instead.'
[3045]6362!             CALL message( 'define_netcdf_header', 'PA0265', 0, 1, 0, 6, 0 )
6363!             prt_time_count = 0
6364!             extend = .FALSE.
6365!             RETURN
6366!          ENDIF
[1]6367
6368!
6369!--       Dataset seems to be extendable.
6370!--       Now get the variable ids.
[3045]6371!         nc_stat = NF90_INQ_VARID( id_set_prt, 'real_num_of_prt',             &
6372!                                   id_var_rnop_prt )
6373!         CALL netcdf_handle_error( 'netcdf_define_header', 327 )
[1]6374
[3045]6375!          DO  i = 1, 17
[1]6376
[3045]6377!             nc_stat = NF90_INQ_VARID( id_set_prt, prt_var_names(i),           &
6378!                                       id_var_prt(i) )
6379!             CALL netcdf_handle_error( 'netcdf_define_header', 328 )
[1]6380
[3045]6381!          ENDDO
[1]6382
[3045]6383!          message_string = 'netCDF file for particles ' //                     &
6384!                           'from previous run found.' //                       &
[3046]6385!                           '&This file will be extended.'
[3045]6386!          CALL message( 'define_netcdf_header', 'PA0266', 0, 0, 0, 6, 0 )
[257]6387       
[1]6388
6389
6390       CASE ( 'ps_new' )
6391
6392!
6393!--       Define some global attributes of the dataset
[3045]6394          nc_stat = NF90_PUT_ATT( id_set_pts, NF90_GLOBAL, 'title',            &
[1]6395                                  TRIM( run_description_header ) )
[1783]6396          CALL netcdf_handle_error( 'netcdf_define_header', 396 )
[1]6397
6398!
6399!--       Define time coordinate for particle time series (unlimited dimension)
[1783]6400          CALL netcdf_create_dim( id_set_pts, 'time', NF90_UNLIMITED,          &
6401                                  id_dim_time_pts, 397 )
6402          CALL netcdf_create_var( id_set_pts, (/ id_dim_time_pts /), 'time',   &
[3529]6403                                  NF90_DOUBLE, id_var_time_pts, 'seconds since '//TRIM(init_model%origin_time), 'time', &
[1783]6404                                  398, 399, 000 )
[3529]6405          CALL netcdf_create_att( id_set_pts, id_var_time_pts, 'standard_name', 'time', 000)
6406          CALL netcdf_create_att( id_set_pts, id_var_time_pts, 'axis', 'T', 000)
[1]6407!
6408!--       Define the variables. If more than one particle group is defined,
6409!--       define seperate variables for each group
6410          var_list = ';'
6411          DO  i = 1, dopts_num
6412
6413             DO  j = 0, number_of_particle_groups
6414
6415                IF ( j == 0 )  THEN
[2039]6416                   suffix = ''
[1]6417                ELSE
[2039]6418                   WRITE ( suffix, '(''_'',I2.2)' )  j
[1]6419                ENDIF
6420
6421                IF ( j == 0 )  THEN
[1783]6422                   CALL netcdf_create_var( id_set_pts, (/ id_dim_time_pts /),  &
[2039]6423                                           TRIM( dopts_label(i) ) // suffix,  &
[1783]6424                                           nc_precision(6), id_var_dopts(i,j), &
6425                                           TRIM( dopts_unit(i) ),              &
6426                                           TRIM( dopts_label(i) ), 400, 401,   &
6427                                           402 )
[1]6428                ELSE
[1783]6429                   CALL netcdf_create_var( id_set_pts, (/ id_dim_time_pts /),  &
[2039]6430                                           TRIM( dopts_label(i) ) // suffix,  &
[1783]6431                                           nc_precision(6), id_var_dopts(i,j), &
6432                                           TRIM( dopts_unit(i) ),              &
[1]6433                                           TRIM( dopts_label(i) ) // ' PG ' // &
[2039]6434                                           suffix(2:3), 400, 401, 402 )
[1]6435                ENDIF
6436
[519]6437                var_list = TRIM( var_list ) // TRIM( dopts_label(i) ) // &
[2039]6438                           suffix // ';'
[1]6439
6440                IF ( number_of_particle_groups == 1 )  EXIT
6441
6442             ENDDO
6443
6444          ENDDO
6445
6446!
6447!--       Write the list of variables as global attribute (this is used by
6448!--       restart runs)
6449          nc_stat = NF90_PUT_ATT( id_set_pts, NF90_GLOBAL, 'VAR_LIST', &
6450                                  var_list )
[1783]6451          CALL netcdf_handle_error( 'netcdf_define_header', 403 )
[1]6452
[263]6453
[1]6454!
[1031]6455!--       Leave netCDF define mode
[1]6456          nc_stat = NF90_ENDDEF( id_set_pts )
[1783]6457          CALL netcdf_handle_error( 'netcdf_define_header', 404 )
[1]6458
6459
6460       CASE ( 'ps_ext' )
6461
6462!
6463!--       Get the list of variables and compare with the actual run.
6464!--       First var_list_old has to be reset, since GET_ATT does not assign
6465!--       trailing blanks.
6466          var_list_old = ' '
6467          nc_stat = NF90_GET_ATT( id_set_pts, NF90_GLOBAL, 'VAR_LIST', &
6468                                  var_list_old )
[1783]6469          CALL netcdf_handle_error( 'netcdf_define_header', 405 )
[1]6470
6471          var_list = ';'
6472          i = 1
6473          DO  i = 1, dopts_num
6474
6475             DO  j = 0, number_of_particle_groups
6476
6477                IF ( j == 0 )  THEN
[2039]6478                   suffix = ''
[1]6479                ELSE
[2039]6480                   WRITE ( suffix, '(''_'',I2.2)' )  j
[1]6481                ENDIF
6482
[519]6483                var_list = TRIM( var_list ) // TRIM( dopts_label(i) ) // &
[2039]6484                           suffix // ';'
[1]6485
6486                IF ( number_of_particle_groups == 1 )  EXIT
6487
6488             ENDDO
6489
6490          ENDDO
6491
6492          IF ( TRIM( var_list ) /= TRIM( var_list_old ) )  THEN
[3045]6493             message_string = 'netCDF file for particle time series ' //       &
6494                              'from previous run found,' //                    &
[3046]6495                              '&but this file cannot be extended due to' //    &
[3045]6496                              ' variable mismatch.' //                         &
[3046]6497                              '&New file is created instead.'
[257]6498             CALL message( 'define_netcdf_header', 'PA0267', 0, 1, 0, 6, 0 )
[1]6499             extend = .FALSE.
6500             RETURN
6501          ENDIF
6502
6503!
6504!--       Get the id of the time coordinate (unlimited coordinate) and its
6505!--       last index on the file. The next time level is dots..count+1.
6506!--       The current time must be larger than the last output time
6507!--       on the file.
6508          nc_stat = NF90_INQ_VARID( id_set_pts, 'time', id_var_time_pts )
[1783]6509          CALL netcdf_handle_error( 'netcdf_define_header', 406 )
[1]6510
6511          nc_stat = NF90_INQUIRE_VARIABLE( id_set_pts, id_var_time_pts, &
6512                                           dimids = id_dim_time_old )
[1783]6513          CALL netcdf_handle_error( 'netcdf_define_header', 407 )
[1]6514          id_dim_time_pts = id_dim_time_old(1)
6515
6516          nc_stat = NF90_INQUIRE_DIMENSION( id_set_pts, id_dim_time_pts, &
6517                                            len = dopts_time_count )
[1783]6518          CALL netcdf_handle_error( 'netcdf_define_header', 408 )
[1]6519
6520          nc_stat = NF90_GET_VAR( id_set_pts, id_var_time_pts,    &
6521                                  last_time_coordinate,           &
6522                                  start = (/ dopts_time_count /), &
6523                                  count = (/ 1 /) )
[1783]6524          CALL netcdf_handle_error( 'netcdf_define_header', 409 )
[1]6525
6526          IF ( last_time_coordinate(1) >= simulated_time )  THEN
[3045]6527             message_string = 'netCDF file for particle time series ' //       &
6528                              'from previous run found,' //                    &
[3046]6529                              '&but this file cannot be extended becaus' //    &
[3045]6530                              'e the current output time' //                   &
[3046]6531                              '&is less or equal than the last output t' //    &
[3045]6532                              'ime on this file.' //                           &
[3046]6533                              '&New file is created instead.'
[257]6534             CALL message( 'define_netcdf_header', 'PA0268', 0, 1, 0, 6, 0 )
[1]6535             dopts_time_count = 0
6536             extend = .FALSE.
6537             RETURN
6538          ENDIF
6539
6540!
6541!--       Dataset seems to be extendable.
6542!--       Now get the variable ids
6543          i = 1
6544          DO  i = 1, dopts_num
6545 
6546             DO  j = 0, number_of_particle_groups
6547
6548                IF ( j == 0 )  THEN
[2039]6549                   suffix = ''
[1]6550                ELSE
[2039]6551                   WRITE ( suffix, '(''_'',I2.2)' )  j
[1]6552                ENDIF
6553
[2039]6554                netcdf_var_name = TRIM( dopts_label(i) ) // suffix
[1]6555
6556                nc_stat = NF90_INQ_VARID( id_set_pts, netcdf_var_name, &
6557                                          id_var_dopts(i,j) )
[1783]6558                CALL netcdf_handle_error( 'netcdf_define_header', 410 )
[1]6559
6560                IF ( number_of_particle_groups == 1 )  EXIT
6561
6562             ENDDO
6563
6564          ENDDO
6565
6566!
[359]6567!--       Update the title attribute on file
6568!--       In order to avoid 'data mode' errors if updated attributes are larger
6569!--       than their original size, NF90_PUT_ATT is called in 'define mode'
6570!--       enclosed by NF90_REDEF and NF90_ENDDEF calls. This implies a possible
6571!--       performance loss due to data copying; an alternative strategy would be
6572!--       to ensure equal attribute size in a job chain. Maybe revise later.
6573          nc_stat = NF90_REDEF( id_set_pts )
[1783]6574          CALL netcdf_handle_error( 'netcdf_define_header', 443 )
[3045]6575          nc_stat = NF90_PUT_ATT( id_set_pts, NF90_GLOBAL, 'title',            &
[1]6576                                  TRIM( run_description_header ) )
[1783]6577          CALL netcdf_handle_error( 'netcdf_define_header', 411 )
[359]6578          nc_stat = NF90_ENDDEF( id_set_pts )
[1783]6579          CALL netcdf_handle_error( 'netcdf_define_header', 444 )
[3045]6580          message_string = 'netCDF file for particle time series ' //          &
6581                           'from previous run found.' //                       &
[3046]6582                           '&This file will be extended.'
[1783]6583          CALL message( 'netcdf_define_header', 'PA0269', 0, 0, 0, 6, 0 )
[1]6584
[1957]6585!
6586!--    Flight data
6587       CASE ( 'fl_new' )
6588!
6589!--       Define some global attributes of the dataset
6590          nc_stat = NF90_PUT_ATT( id_set_fl, NF90_GLOBAL, 'title',             &
6591                                  TRIM( run_description_header ) )
6592          CALL netcdf_handle_error( 'netcdf_define_header', 249 )
[1]6593
[1957]6594!
6595!--       Define time and location coordinates for flight space-time series
6596!--       (unlimited dimension)
6597!--       Error number must still be set appropriately.
6598          CALL netcdf_create_dim( id_set_fl, 'time', NF90_UNLIMITED,           &
6599                                  id_dim_time_fl, 250 )
6600          CALL netcdf_create_var( id_set_fl, (/ id_dim_time_fl /), 'time',     &
[3529]6601                                  NF90_DOUBLE, id_var_time_fl, 'seconds since '//TRIM(init_model%origin_time), 'time',  &
[1957]6602                                  251, 252, 000 )
[3529]6603          CALL netcdf_create_att( id_set_fl, id_var_time_fl, 'standard_name', 'time', 000)
6604          CALL netcdf_create_att( id_set_fl, id_var_time_fl, 'axis', 'T', 000)
[1957]6605
6606          DO l = 1, num_leg
6607             CALL netcdf_create_dim( id_set_fl, dofl_dim_label_x(l),           &
6608                                     NF90_UNLIMITED, id_dim_x_fl(l), 250 )
6609             CALL netcdf_create_dim( id_set_fl, dofl_dim_label_y(l),           &
6610                                     NF90_UNLIMITED, id_dim_y_fl(l), 250 )
6611             CALL netcdf_create_dim( id_set_fl, dofl_dim_label_z(l),           &
6612                                     NF90_UNLIMITED, id_dim_z_fl(l), 250 )
6613
6614             CALL netcdf_create_var( id_set_fl, (/ id_dim_x_fl(l) /),          &
6615                                     dofl_dim_label_x(l), NF90_DOUBLE,         &
6616                                     id_var_x_fl(l), 'm', '', 251, 252, 000 )
6617             CALL netcdf_create_var( id_set_fl, (/ id_dim_y_fl(l) /),          &
6618                                     dofl_dim_label_y(l), NF90_DOUBLE,         &
6619                                     id_var_y_fl(l), 'm', '', 251, 252, 000 )
6620             CALL netcdf_create_var( id_set_fl, (/ id_dim_z_fl(l) /),          &
6621                                     dofl_dim_label_z(l), NF90_DOUBLE,         &
6622                                     id_var_z_fl(l), 'm', '', 251, 252, 000 )
6623          ENDDO
6624!
6625!--       Define the variables
6626          var_list = ';'
6627          k = 1
6628          DO  l = 1, num_leg
6629             DO i = 1, num_var_fl
6630
6631                CALL netcdf_create_var( id_set_fl, (/ id_dim_time_fl /),       &
6632                                        dofl_label(k), nc_precision(9),        &
6633                                        id_var_dofl(k),                        &
6634                                        TRIM( dofl_unit(k) ),                  &
6635                                        TRIM( dofl_label(k) ), 253, 254, 255 )
6636
6637                k = k + 1
6638               
6639             ENDDO
6640
6641          ENDDO
6642
6643!
6644!--       Write the list of variables as global attribute (this is used by
6645!--       restart runs)
6646          nc_stat = NF90_PUT_ATT( id_set_fl, NF90_GLOBAL, 'VAR_LIST', var_list )
6647          CALL netcdf_handle_error( 'netcdf_define_header', 258 )
6648
6649!
6650!--       Leave netCDF define mode
6651          nc_stat = NF90_ENDDEF( id_set_fl )
6652          CALL netcdf_handle_error( 'netcdf_define_header', 259 )
6653
6654
6655       CASE ( 'fl_ext' )
6656
6657!
6658!--       Get the list of variables and compare with the actual run.
6659!--       First var_list_old has to be reset, since GET_ATT does not assign
6660!--       trailing blanks.
6661          var_list_old = ' '
6662          nc_stat = NF90_GET_ATT( id_set_fl, NF90_GLOBAL, 'VAR_LIST',          &
6663                                  var_list_old )
6664          CALL netcdf_handle_error( 'netcdf_define_header', 260 )
6665
6666          var_list = ';'
6667          i = 1
6668          DO  i = 1, num_leg * num_var_fl
6669
6670             var_list = TRIM( var_list ) // TRIM( dofl_label(i) ) // ';'
6671
6672          ENDDO
6673
6674          IF ( TRIM( var_list ) /= TRIM( var_list_old ) )  THEN
6675             message_string = 'netCDF file for flight time series ' //         &
6676                              'from previous run found,' //                    &
[3046]6677                              '&but this file cannot be extended due to' //    &
[1957]6678                              ' variable mismatch.' //                         &
[3046]6679                              '&New file is created instead.'
[1957]6680             CALL message( 'define_netcdf_header', 'PA0257', 0, 1, 0, 6, 0 )
6681             extend = .FALSE.
6682             RETURN
6683          ENDIF
6684
6685!
6686!--       Get the id of the time coordinate (unlimited coordinate) and its
6687!--       last index on the file. The next time level is dofl_time_count+1.
6688!--       The current time must be larger than the last output time
6689!--       on the file.
6690          nc_stat = NF90_INQ_VARID( id_set_fl, 'time', id_var_time_fl )
6691          CALL netcdf_handle_error( 'netcdf_define_header', 261 )
6692
[3045]6693          nc_stat = NF90_INQUIRE_VARIABLE( id_set_fl, id_var_time_fl,          &
[1957]6694                                           dimids = id_dim_time_old )
6695          CALL netcdf_handle_error( 'netcdf_define_header', 262 )
6696          id_dim_time_fl = id_dim_time_old(1)
6697
[3045]6698          nc_stat = NF90_INQUIRE_DIMENSION( id_set_fl, id_dim_time_fl,         &
[1957]6699                                            len = dofl_time_count )
6700          CALL netcdf_handle_error( 'netcdf_define_header', 263 )
6701
6702          nc_stat = NF90_GET_VAR( id_set_fl, id_var_time_fl,        &
6703                                  last_time_coordinate,             &
6704                                  start = (/ dofl_time_count /), &
6705                                  count = (/ 1 /) )
6706          CALL netcdf_handle_error( 'netcdf_define_header', 264 )
6707
6708          IF ( last_time_coordinate(1) >= simulated_time )  THEN
[3045]6709             message_string = 'netCDF file for flight-time series ' //         &
6710                              'from previous run found,' //                    &
[3046]6711                              '&but this file cannot be extended becaus' //    &
[3045]6712                              'e the current output time' //                   &
[3046]6713                              '&is less or equal than the last output t' //    &
[3045]6714                              'ime on this file.' //                           &
[3046]6715                              '&New file is created instead.'
[1957]6716             CALL message( 'define_netcdf_header', 'PA0258', 0, 1, 0, 6, 0 )
6717             dofl_time_count = 0
6718             extend = .FALSE.
6719             RETURN
6720          ENDIF
6721
6722!
6723!--       Dataset seems to be extendable.
6724!--       Now get the remaining dimension and variable ids
6725          DO l = 1, num_leg
6726             nc_stat = NF90_INQ_VARID( id_set_fl, dofl_dim_label_x(l),         &
6727                                       id_var_x_fl(l) )
6728             CALL netcdf_handle_error( 'netcdf_define_header', 265 )
6729             nc_stat = NF90_INQ_VARID( id_set_fl, dofl_dim_label_y(l),         &
6730                                       id_var_y_fl(l) )
6731             CALL netcdf_handle_error( 'netcdf_define_header', 265 )
6732             nc_stat = NF90_INQ_VARID( id_set_fl, dofl_dim_label_z(l),         &
6733                                       id_var_z_fl(l) )
6734             CALL netcdf_handle_error( 'netcdf_define_header', 265 )
6735
6736          ENDDO
6737
6738
6739          DO  i = 1, num_leg * num_var_fl
6740 
6741            nc_stat = NF90_INQ_VARID( id_set_fl, dofl_label(i), &
6742                                       id_var_dofl(i) )
6743            CALL netcdf_handle_error( 'netcdf_define_header', 265 )
6744
6745          ENDDO
6746
6747!
6748!--       Update the title attribute on file
6749!--       In order to avoid 'data mode' errors if updated attributes are larger
6750!--       than their original size, NF90_PUT_ATT is called in 'define mode'
6751!--       enclosed by NF90_REDEF and NF90_ENDDEF calls. This implies a possible
6752!--       performance loss due to data copying; an alternative strategy would be
6753!--       to ensure equal attribute size in a job chain. Maybe revise later.
6754          nc_stat = NF90_REDEF( id_set_fl )
6755          CALL netcdf_handle_error( 'netcdf_define_header', 439 )
6756          nc_stat = NF90_PUT_ATT( id_set_fl, NF90_GLOBAL, 'title',             &
6757                                  TRIM( run_description_header ) )
6758          CALL netcdf_handle_error( 'netcdf_define_header', 267 )
6759          nc_stat = NF90_ENDDEF( id_set_fl )
6760          CALL netcdf_handle_error( 'netcdf_define_header', 440 )
6761          message_string = 'netCDF file for flight-time series ' //            &
6762                           'from previous run found.' //                       &
[3046]6763                           '&This file will be extended.'
[1957]6764          CALL message( 'define_netcdf_header', 'PA0259', 0, 0, 0, 6, 0 )
6765
[3727]6766
[1]6767       CASE DEFAULT
6768
[257]6769          message_string = 'mode "' // TRIM( mode) // '" not supported'
[1783]6770          CALL message( 'netcdf_define_header', 'PA0270', 0, 0, 0, 6, 0 )
[1]6771
6772    END SELECT
6773
6774#endif
[1783]6775 END SUBROUTINE netcdf_define_header
[1]6776
6777
6778!------------------------------------------------------------------------------!
[1031]6779! Description:
6780! ------------
[1682]6781!> Creates a netCDF file and give back the id. The parallel flag has to be TRUE
6782!> for parallel netCDF output support.
[1031]6783!------------------------------------------------------------------------------!
[1682]6784 
[1783]6785 SUBROUTINE netcdf_create_file( filename , id, parallel, errno )
[1682]6786#if defined( __netcdf )
[1031]6787
6788    USE pegrid
6789
6790    IMPLICIT NONE
6791
6792    CHARACTER (LEN=*), INTENT(IN) :: filename
6793    INTEGER, INTENT(IN)           :: errno
6794    INTEGER, INTENT(OUT)          :: id
[3665]6795    INTEGER                       :: idum  !< dummy variable used to avoid compiler warnings about unused variables
[1031]6796    LOGICAL, INTENT(IN)           :: parallel
6797
[3665]6798!
6799!-- Next line is just to avoid compiler warning about unused variable
6800    IF ( parallel )  idum = 0
[1031]6801
[1]6802!
[1031]6803!-- Create a new netCDF output file with requested netCDF format
6804    IF ( netcdf_data_format == 1 )  THEN
6805!
[1745]6806!--    Classic netCDF format
6807       nc_stat = NF90_CREATE( filename, NF90_NOCLOBBER, id )
[1031]6808
6809    ELSEIF ( netcdf_data_format == 2 )  THEN
6810!
6811!--    64bit-offset format
6812       nc_stat = NF90_CREATE( filename,                                        &
[1308]6813                              IOR( NF90_NOCLOBBER, NF90_64BIT_OFFSET ), id )
[1031]6814
6815#if defined( __netcdf4 )
6816    ELSEIF ( netcdf_data_format == 3  .OR.                                     &
6817             ( .NOT. parallel  .AND.  netcdf_data_format == 5 ) )  THEN
6818!
6819!--    netCDF4/HDF5 format
[1308]6820       nc_stat = NF90_CREATE( filename, IOR( NF90_NOCLOBBER, NF90_NETCDF4 ), id )
[1031]6821
6822    ELSEIF ( netcdf_data_format == 4  .OR.                                     &
6823             ( .NOT. parallel  .AND.  netcdf_data_format == 6 ) )  THEN
6824!
6825!--    netCDF4/HDF5 format with classic model flag
6826       nc_stat = NF90_CREATE( filename,                                        &
[1745]6827                              IOR( NF90_NOCLOBBER,                             &
[1308]6828                              IOR( NF90_CLASSIC_MODEL, NF90_HDF5 ) ), id )
[1031]6829
6830#if defined( __netcdf4_parallel )
6831    ELSEIF ( netcdf_data_format == 5  .AND.  parallel )  THEN
6832!
6833!--    netCDF4/HDF5 format, parallel
[1308]6834       nc_stat = NF90_CREATE( filename,                                        &
[1745]6835                              IOR( NF90_NOCLOBBER,                             &
6836                              IOR( NF90_NETCDF4, NF90_MPIIO ) ),               &
[1031]6837                              id, COMM = comm2d, INFO = MPI_INFO_NULL )
6838
6839    ELSEIF ( netcdf_data_format == 6  .AND.  parallel )  THEN
6840!
6841!--    netCDF4/HDF5 format with classic model flag, parallel
6842       nc_stat = NF90_CREATE( filename,                                        &
[1745]6843                              IOR( NF90_NOCLOBBER,                             &
6844                              IOR( NF90_MPIIO,                                 &
6845                              IOR( NF90_CLASSIC_MODEL, NF90_HDF5 ) ) ),        &
[1031]6846                              id, COMM = comm2d, INFO = MPI_INFO_NULL )
6847
6848#endif
6849#endif
6850    ENDIF
6851
[1783]6852    CALL netcdf_handle_error( 'netcdf_create_file', errno )
[1031]6853#endif
[1783]6854 END SUBROUTINE netcdf_create_file
[1031]6855
6856!------------------------------------------------------------------------------!
[1]6857! Description:
6858! ------------
[1682]6859!> Opens an existing netCDF file for writing and gives back the id.
6860!> The parallel flag has to be TRUE for parallel netCDF output support.
[1031]6861!------------------------------------------------------------------------------!
[1783]6862 SUBROUTINE netcdf_open_write_file( filename, id, parallel, errno )
[1682]6863#if defined( __netcdf )
[1031]6864
6865    USE pegrid
6866
6867    IMPLICIT NONE
6868
6869    CHARACTER (LEN=*), INTENT(IN) :: filename
6870    INTEGER, INTENT(IN)           :: errno
6871    INTEGER, INTENT(OUT)          :: id
6872    LOGICAL, INTENT(IN)           :: parallel
6873
6874
6875    IF ( netcdf_data_format < 5  .OR.  .NOT. parallel )  THEN
6876       nc_stat = NF90_OPEN( filename, NF90_WRITE, id )
6877#if defined( __netcdf4 )
[1206]6878#if defined( __netcdf4_parallel )
[1031]6879    ELSEIF ( netcdf_data_format > 4  .AND.  parallel )  THEN
[1308]6880       nc_stat = NF90_OPEN( filename, IOR( NF90_WRITE, NF90_MPIIO ), id,  &
6881                            COMM = comm2d, INFO = MPI_INFO_NULL )
[1031]6882#endif
6883#endif
6884    ENDIF
6885
[1783]6886    CALL netcdf_handle_error( 'netcdf_open_write_file', errno )
[1031]6887#endif
[1783]6888 END SUBROUTINE netcdf_open_write_file
[1031]6889
6890
6891!------------------------------------------------------------------------------!
6892! Description:
6893! ------------
[1682]6894!> Prints out a text message corresponding to the current status.
[1]6895!------------------------------------------------------------------------------!
[1682]6896 
[1783]6897 SUBROUTINE netcdf_handle_error( routine_name, errno )
[1682]6898#if defined( __netcdf )
[1]6899
[1682]6900
[1322]6901    USE control_parameters,                                                    &
6902        ONLY:  message_string
6903
[1]6904    IMPLICIT NONE
6905
[263]6906    CHARACTER(LEN=6) ::  message_identifier
6907    CHARACTER(LEN=*) ::  routine_name
6908
[1320]6909    INTEGER(iwp) ::  errno
[1]6910
6911    IF ( nc_stat /= NF90_NOERR )  THEN
[263]6912
6913       WRITE( message_identifier, '(''NC'',I4.4)' )  errno
[3467]6914
[263]6915       message_string = TRIM( NF90_STRERROR( nc_stat ) )
6916
[288]6917       CALL message( routine_name, message_identifier, 2, 2, 0, 6, 1 )
[263]6918
[1]6919    ENDIF
6920
6921#endif
[1783]6922 END SUBROUTINE netcdf_handle_error
6923
6924
6925!------------------------------------------------------------------------------!
6926! Description:
6927! ------------
6928!> Create a dimension in NetCDF file
6929!------------------------------------------------------------------------------!
6930
6931 SUBROUTINE netcdf_create_dim(ncid, dim_name, ncdim_type, ncdim_id, error_no)
6932
6933#if defined( __netcdf )
6934
6935    USE kinds
6936
6937    IMPLICIT NONE
6938
6939    CHARACTER(LEN=*), INTENT(IN) ::  dim_name
6940
6941    INTEGER, INTENT(IN)  ::  error_no
6942    INTEGER, INTENT(IN)  ::  ncid
6943    INTEGER, INTENT(OUT) ::  ncdim_id
6944    INTEGER, INTENT(IN)  ::  ncdim_type
6945
6946!
6947!-- Define time coordinate for volume data (unlimited dimension)
6948    nc_stat = NF90_DEF_DIM( ncid, dim_name, ncdim_type, ncdim_id )
6949    CALL netcdf_handle_error( 'netcdf_create_dim', error_no )
6950
6951#endif
6952
6953 END SUBROUTINE netcdf_create_dim
6954
6955
6956!------------------------------------------------------------------------------!
6957! Description:
6958! ------------
6959!> Create a one dimensional variable in specific units in NetCDF file
6960!------------------------------------------------------------------------------!
6961
6962 SUBROUTINE netcdf_create_var( ncid, dim_id, var_name, var_type, var_id,       &
6963                               unit_name, long_name, error_no1, error_no2,     &
[2696]6964                               error_no3, fill )
[1783]6965
6966#if defined( __netcdf )
6967    IMPLICIT NONE
6968
6969    CHARACTER(LEN=*), INTENT(IN) ::  long_name
6970    CHARACTER(LEN=*), INTENT(IN) ::  unit_name
6971    CHARACTER(LEN=*), INTENT(IN) ::  var_name
6972
[2696]6973    LOGICAL, OPTIONAL ::  fill  !< indicates setting of _FillValue attribute
6974
[1783]6975    INTEGER, INTENT(IN)  ::  error_no1
6976    INTEGER, INTENT(IN)  ::  error_no2
6977    INTEGER, INTENT(IN)  ::  error_no3
6978    INTEGER, INTENT(IN)  ::  ncid
6979    INTEGER, INTENT(OUT) ::  var_id
6980    INTEGER, INTENT(IN)  ::  var_type
6981
6982    INTEGER, DIMENSION(:), INTENT(IN) ::  dim_id
6983
6984!
6985!-- Define variable
6986    nc_stat = NF90_DEF_VAR( ncid, var_name, var_type, dim_id, var_id )
6987    CALL netcdf_handle_error( 'netcdf_create_var', error_no1 )
6988
6989#if defined( __netcdf4 )
6990!
6991!-- Check if variable should be deflate (including shuffling)
6992!-- and if it is possible (only NetCDF4 with HDF5 supports compression)
6993    IF ( netcdf_data_format > 2  .AND.  netcdf_deflate > 0 )  THEN
6994       nc_stat = NF90_DEF_VAR_DEFLATE( ncid, var_id, 1, 1, netcdf_deflate )
6995       CALL netcdf_handle_error( 'netcdf_create_var_deflate', error_no1 )
6996    ENDIF
6997#endif
6998!
6999!-- Set unit name if set
7000    IF ( unit_name /= '' )  THEN
7001       nc_stat = NF90_PUT_ATT( ncid, var_id, 'units', unit_name )
7002       CALL netcdf_handle_error( 'netcdf_create_var', error_no2 )
7003    ENDIF
7004
7005!
7006!-- Set long name if set
7007    IF ( long_name /= '' )  THEN
7008       nc_stat = NF90_PUT_ATT( ncid, var_id, 'long_name', long_name )
7009       CALL netcdf_handle_error( 'netcdf_create_var', error_no3 )
7010    ENDIF
7011
[2696]7012!
7013!-- Set _FillValue for all variables, except for dimension variables.
7014!-- Set the fill values accordingly to the corresponding output precision.
7015    IF ( PRESENT( fill ) )  THEN
7016       IF ( var_type == NF90_REAL4 )  THEN
7017          nc_stat = NF90_PUT_ATT( ncid, var_id, '_FillValue',                  &
7018                                  REAL( fill_value, KIND = 4 ) )
7019          CALL netcdf_handle_error( 'netcdf_create_var', 0 )
7020       ELSE
7021          nc_stat = NF90_PUT_ATT( ncid, var_id, '_FillValue',                  &
7022                                  REAL( fill_value, KIND = 8 ) )
7023          CALL netcdf_handle_error( 'netcdf_create_var', 0 )
7024       ENDIF
7025    ENDIF
7026
[1783]7027#endif
7028 END SUBROUTINE netcdf_create_var
7029
[3459]7030
7031!------------------------------------------------------------------------------!
7032! Description:
7033! ------------
[3529]7034!> Write attributes to file.
7035!------------------------------------------------------------------------------!
7036 SUBROUTINE netcdf_create_att_string( ncid, varid, name, value, err )
7037
7038    IMPLICIT NONE
7039
7040    CHARACTER(LEN=*), INTENT(IN) ::  name    !< attribute name
7041    CHARACTER(LEN=*), INTENT(IN) ::  value   !< attribute value
7042
7043    INTEGER, INTENT(IN) ::  err              !< error id
7044    INTEGER, INTENT(IN) ::  ncid             !< file id
7045
7046    INTEGER, INTENT(IN), OPTIONAL ::  varid  !< variable id
7047
7048#if defined( __netcdf )
7049    IF ( PRESENT( varid ) )  THEN
7050       nc_stat = NF90_PUT_ATT( ncid, varid, TRIM( name ), TRIM( value ) )
7051    ELSE
7052       nc_stat = NF90_PUT_ATT( ncid, NF90_GLOBAL, TRIM( name ), TRIM( value ) )
7053    ENDIF
7054    CALL netcdf_handle_error( 'netcdf_create_att_string', err )
7055#endif
7056
7057 END SUBROUTINE netcdf_create_att_string
7058
7059
7060!------------------------------------------------------------------------------!
7061! Description:
7062! ------------
[3485]7063!> Write a set of global attributes to file.
7064!------------------------------------------------------------------------------!
[3529]7065 SUBROUTINE netcdf_create_global_atts( ncid, data_content, title, error_no )
[3485]7066
[3529]7067    USE control_parameters,  &
7068        ONLY:  revision, run_date, run_time, run_zone, runnr, version
7069       
7070    USE netcdf_data_input_mod,  &
7071        ONLY:  input_file_atts
7072
[3485]7073    IMPLICIT NONE
7074
[3529]7075    CHARACTER(LEN=*), INTENT(IN)  ::  data_content  !< describes the type of data in file
7076    CHARACTER(LEN=*), INTENT(IN)  ::  title         !< file title
7077
[3485]7078    INTEGER, INTENT(IN)  ::  error_no  !< error number
7079    INTEGER, INTENT(IN)  ::  ncid      !< file id
7080
7081#if defined( __netcdf )
[3529]7082    nc_stat = NF90_PUT_ATT( ncid, NF90_GLOBAL, 'title', TRIM( title ) )
[3485]7083    CALL netcdf_handle_error( 'netcdf_create_global_atts', error_no )
[3529]7084    nc_stat = NF90_PUT_ATT( ncid, NF90_GLOBAL, 'Conventions', 'CF-1.7' )
[3485]7085    CALL netcdf_handle_error( 'netcdf_create_global_atts', error_no )
[3529]7086    nc_stat = NF90_PUT_ATT( ncid, NF90_GLOBAL, 'creation_time', TRIM( run_date )//' '//TRIM( run_time )//' '//run_zone(1:3) )
[3485]7087    CALL netcdf_handle_error( 'netcdf_create_global_atts', error_no )
[3529]7088    nc_stat = NF90_PUT_ATT( ncid, NF90_GLOBAL, 'data_content', TRIM(data_content) )
[3485]7089    CALL netcdf_handle_error( 'netcdf_create_global_atts', error_no )
[3529]7090    nc_stat = NF90_PUT_ATT( ncid, NF90_GLOBAL, 'version', runnr+1 )
[3485]7091    CALL netcdf_handle_error( 'netcdf_create_global_atts', error_no )
[3529]7092
7093    nc_stat = NF90_PUT_ATT( ncid, NF90_GLOBAL, 'origin_time', init_model%origin_time )
[3485]7094    CALL netcdf_handle_error( 'netcdf_create_global_atts', error_no )
[3529]7095    nc_stat = NF90_PUT_ATT( ncid, NF90_GLOBAL, 'origin_lat', init_model%latitude )
[3485]7096    CALL netcdf_handle_error( 'netcdf_create_global_atts', error_no )
[3529]7097    nc_stat = NF90_PUT_ATT( ncid, NF90_GLOBAL, 'origin_lon', init_model%longitude )
7098    CALL netcdf_handle_error( 'netcdf_create_global_atts', error_no )
7099    nc_stat = NF90_PUT_ATT( ncid, NF90_GLOBAL, 'origin_x', init_model%origin_x )
7100    CALL netcdf_handle_error( 'netcdf_create_global_atts', error_no )
7101    nc_stat = NF90_PUT_ATT( ncid, NF90_GLOBAL, 'origin_y', init_model%origin_y )
7102    CALL netcdf_handle_error( 'netcdf_create_global_atts', error_no )
7103    nc_stat = NF90_PUT_ATT( ncid, NF90_GLOBAL, 'origin_z', init_model%origin_z )
7104    CALL netcdf_handle_error( 'netcdf_create_global_atts', error_no )
7105    nc_stat = NF90_PUT_ATT( ncid, NF90_GLOBAL, 'rotation_angle', init_model%rotation_angle )
7106    CALL netcdf_handle_error( 'netcdf_create_global_atts', error_no )
7107
7108    nc_stat = NF90_PUT_ATT( ncid, NF90_GLOBAL, 'dependencies', '' )
7109    CALL netcdf_handle_error( 'netcdf_create_global_atts', error_no )
7110    nc_stat = NF90_PUT_ATT( ncid, NF90_GLOBAL, 'history', '' )
7111    CALL netcdf_handle_error( 'netcdf_create_global_atts', error_no )
7112
7113    nc_stat = NF90_PUT_ATT( ncid, NF90_GLOBAL, TRIM( input_file_atts%author_char ), TRIM( input_file_atts%author ) )
7114    CALL netcdf_handle_error( 'netcdf_create_global_atts', error_no )
7115    nc_stat = NF90_PUT_ATT( ncid, NF90_GLOBAL, TRIM( input_file_atts%contact_person_char ), TRIM( input_file_atts%contact_person ) )
7116    CALL netcdf_handle_error( 'netcdf_create_global_atts', error_no )
7117    nc_stat = NF90_PUT_ATT( ncid, NF90_GLOBAL, TRIM( input_file_atts%institution_char ), TRIM( input_file_atts%institution ) )
7118    CALL netcdf_handle_error( 'netcdf_create_global_atts', error_no )
7119    nc_stat = NF90_PUT_ATT( ncid, NF90_GLOBAL, TRIM( input_file_atts%acronym_char ), TRIM( input_file_atts%acronym ) )
7120    CALL netcdf_handle_error( 'netcdf_create_global_atts', error_no )
7121
7122    nc_stat = NF90_PUT_ATT( ncid, NF90_GLOBAL, TRIM( input_file_atts%campaign_char ), TRIM( input_file_atts%campaign ) )
7123    CALL netcdf_handle_error( 'netcdf_create_global_atts', error_no )
7124    nc_stat = NF90_PUT_ATT( ncid, NF90_GLOBAL, TRIM( input_file_atts%location_char ), TRIM( input_file_atts%location ) )
7125    CALL netcdf_handle_error( 'netcdf_create_global_atts', error_no )
7126    nc_stat = NF90_PUT_ATT( ncid, NF90_GLOBAL, TRIM( input_file_atts%site_char ), TRIM( input_file_atts%site ) )
7127    CALL netcdf_handle_error( 'netcdf_create_global_atts', error_no )
7128
7129    nc_stat = NF90_PUT_ATT( ncid, NF90_GLOBAL, 'source', TRIM( version )//' '//TRIM( revision ) )
7130    CALL netcdf_handle_error( 'netcdf_create_global_atts', error_no )
7131    nc_stat = NF90_PUT_ATT( ncid, NF90_GLOBAL, TRIM( input_file_atts%references_char ), TRIM( input_file_atts%references ) )
7132    CALL netcdf_handle_error( 'netcdf_create_global_atts', error_no )
7133    nc_stat = NF90_PUT_ATT( ncid, NF90_GLOBAL, TRIM( input_file_atts%keywords_char ), TRIM( input_file_atts%keywords ) )
7134    CALL netcdf_handle_error( 'netcdf_create_global_atts', error_no )
7135    nc_stat = NF90_PUT_ATT( ncid, NF90_GLOBAL, TRIM( input_file_atts%licence_char ), TRIM( input_file_atts%licence ) )
7136    CALL netcdf_handle_error( 'netcdf_create_global_atts', error_no )
7137    nc_stat = NF90_PUT_ATT( ncid, NF90_GLOBAL, TRIM( input_file_atts%comment_char ), TRIM( input_file_atts%comment ) )
7138    CALL netcdf_handle_error( 'netcdf_create_global_atts', error_no )
7139
[3485]7140#endif
7141
7142 END SUBROUTINE netcdf_create_global_atts
7143
7144!------------------------------------------------------------------------------!
7145! Description:
7146! ------------
[3459]7147!> Create a variable holding the coordinate-reference-system information.
7148!------------------------------------------------------------------------------!
7149 SUBROUTINE netcdf_create_crs( ncid, error_no )
7150
7151    IMPLICIT NONE
7152
7153    INTEGER, INTENT(IN)  ::  error_no  !< error number
7154    INTEGER, INTENT(IN)  ::  ncid      !< file id
7155    INTEGER              ::  var_id    !< variable id
7156
[3485]7157#if defined( __netcdf )
[3459]7158!
7159!-- Define variable
7160    nc_stat = NF90_DEF_VAR( ncid, 'crs', NF90_INT, VARID = var_id )
7161    CALL netcdf_handle_error( 'netcdf_create_crs', error_no )
7162!
7163!-- Set attributes
7164    nc_stat = NF90_PUT_ATT( ncid, var_id, 'epsg_code', &
7165                            coord_ref_sys%epsg_code )
7166    CALL netcdf_handle_error( 'netcdf_create_crs', error_no )
7167
7168    nc_stat = NF90_PUT_ATT( ncid, var_id, 'false_easting', &
7169                            coord_ref_sys%false_easting )
7170    CALL netcdf_handle_error( 'netcdf_create_crs', error_no )
7171
7172    nc_stat = NF90_PUT_ATT( ncid, var_id, 'false_northing', &
7173                            coord_ref_sys%false_northing )
7174    CALL netcdf_handle_error( 'netcdf_create_crs', error_no )
7175
7176    nc_stat = NF90_PUT_ATT( ncid, var_id, 'grid_mapping_name', &
7177                            coord_ref_sys%grid_mapping_name )
7178    CALL netcdf_handle_error( 'netcdf_create_crs', error_no )
7179
7180    nc_stat = NF90_PUT_ATT( ncid, var_id, 'inverse_flattening', &
7181                            coord_ref_sys%inverse_flattening )
7182    CALL netcdf_handle_error( 'netcdf_create_crs', error_no )
7183
7184    nc_stat = NF90_PUT_ATT( ncid, var_id, 'latitude_of_projection_origin', &
7185                            coord_ref_sys%latitude_of_projection_origin )
7186    CALL netcdf_handle_error( 'netcdf_create_crs', error_no )
7187
7188    nc_stat = NF90_PUT_ATT( ncid, var_id, 'long_name', &
7189                            coord_ref_sys%long_name )
7190    CALL netcdf_handle_error( 'netcdf_create_crs', error_no )
7191
7192    nc_stat = NF90_PUT_ATT( ncid, var_id, 'longitude_of_central_meridian', &
7193                            coord_ref_sys%longitude_of_central_meridian )
7194    CALL netcdf_handle_error( 'netcdf_create_crs', error_no )
7195
7196    nc_stat = NF90_PUT_ATT( ncid, var_id, 'longitude_of_prime_meridian', &
7197                            coord_ref_sys%longitude_of_prime_meridian )
7198    CALL netcdf_handle_error( 'netcdf_create_crs', error_no )
7199
7200    nc_stat = NF90_PUT_ATT( ncid, var_id, 'scale_factor_at_central_meridian', &
7201                            coord_ref_sys%scale_factor_at_central_meridian )
7202    CALL netcdf_handle_error( 'netcdf_create_crs', error_no )
7203
7204    nc_stat = NF90_PUT_ATT( ncid, var_id, 'semi_major_axis', &
7205                            coord_ref_sys%semi_major_axis )
7206    CALL netcdf_handle_error( 'netcdf_create_crs', error_no )
7207
7208    nc_stat = NF90_PUT_ATT( ncid, var_id, 'units', &
7209                            coord_ref_sys%units )
7210    CALL netcdf_handle_error( 'netcdf_create_crs', error_no )
7211
7212#endif
[3529]7213 END SUBROUTINE netcdf_create_crs
[3459]7214
7215
7216!------------------------------------------------------------------------------!
7217! Description:
7218! ------------
[3529]7219!> Define UTM coordinates and longitude and latitude in file.
7220!------------------------------------------------------------------------------!
7221 SUBROUTINE define_geo_coordinates( id_set, id_dim_x, id_dim_y, id_var_eutm, id_var_nutm, id_var_lat, id_var_lon )
7222
7223    IMPLICIT NONE
7224
7225    INTEGER ::  i                    !< loop index
7226    INTEGER, INTENT(IN)  ::  id_set  !< file id
7227
7228    INTEGER(iwp), DIMENSION(0:1), INTENT(IN) ::  id_dim_x  !< dimension id of x and xu
7229    INTEGER(iwp), DIMENSION(0:1), INTENT(IN) ::  id_dim_y  !< dimension id of y and yv
7230
7231    INTEGER(iwp), DIMENSION(0:2), INTENT(OUT) ::  id_var_eutm  !< variable id for E_UTM coordinates
7232    INTEGER(iwp), DIMENSION(0:2), INTENT(OUT) ::  id_var_lat   !< variable id for latitude coordinates
7233    INTEGER(iwp), DIMENSION(0:2), INTENT(OUT) ::  id_var_lon   !< variable id for longitude coordinates
7234    INTEGER(iwp), DIMENSION(0:2), INTENT(OUT) ::  id_var_nutm  !< variable id for N_UTM coordinates
7235
7236#if defined( __netcdf )
7237
7238!
7239!-- Define UTM coordinates
7240    IF ( init_model%rotation_angle == 0.0_wp )  THEN
7241       CALL netcdf_create_var( id_set, (/ id_dim_x(0) /), 'E_UTM', NF90_DOUBLE, id_var_eutm(0), 'm', 'easting', 000, 000, 000 )
7242       CALL netcdf_create_var( id_set, (/ id_dim_y(0) /), 'N_UTM', NF90_DOUBLE, id_var_nutm(0), 'm', 'northing', 000, 000, 000 )
7243       CALL netcdf_create_var( id_set, (/ id_dim_x(1) /), 'Eu_UTM', NF90_DOUBLE, id_var_eutm(1), 'm', 'easting', 000, 000, 000 )
7244       CALL netcdf_create_var( id_set, (/ id_dim_y(0) /), 'Nu_UTM', NF90_DOUBLE, id_var_nutm(1), 'm', 'northing', 000, 000, 000 )
7245       CALL netcdf_create_var( id_set, (/ id_dim_x(0) /), 'Ev_UTM', NF90_DOUBLE, id_var_eutm(2), 'm', 'easting', 000, 000, 000 )
7246       CALL netcdf_create_var( id_set, (/ id_dim_y(1) /), 'Nv_UTM', NF90_DOUBLE, id_var_nutm(2), 'm', 'northing', 000, 000, 000 )
7247    ELSE
7248       CALL netcdf_create_var( id_set, (/ id_dim_x(0), id_dim_y(0) /), &
7249                               'E_UTM', NF90_DOUBLE, id_var_eutm(0), 'm', 'easting', 000, 000, 000 )
7250       CALL netcdf_create_var( id_set, (/ id_dim_x(0), id_dim_y(0) /), &
7251                               'N_UTM', NF90_DOUBLE, id_var_nutm(0), 'm', 'northing', 000, 000, 000 )
7252       CALL netcdf_create_var( id_set, (/ id_dim_x(1), id_dim_y(0) /), &
7253                               'Eu_UTM', NF90_DOUBLE, id_var_eutm(1), 'm', 'easting', 000, 000, 000 )
7254       CALL netcdf_create_var( id_set, (/ id_dim_x(1), id_dim_y(0) /), &
7255                               'Nu_UTM', NF90_DOUBLE, id_var_nutm(1), 'm', 'northing', 000, 000, 000 )
7256       CALL netcdf_create_var( id_set, (/ id_dim_x(0), id_dim_y(1) /), &
7257                               'Ev_UTM', NF90_DOUBLE, id_var_eutm(2), 'm', 'easting', 000, 000, 000 )
7258       CALL netcdf_create_var( id_set, (/ id_dim_x(0), id_dim_y(1) /), &
7259                               'Nv_UTM', NF90_DOUBLE, id_var_nutm(2), 'm', 'northing', 000, 000, 000 )
7260    ENDIF
7261!
7262!-- Define geographic coordinates
7263    CALL netcdf_create_var( id_set, (/ id_dim_x(0), id_dim_y(0) /), 'lon', NF90_DOUBLE, id_var_lon(0), &
7264                            'degrees_east', 'longitude', 000, 000, 000 )
7265    CALL netcdf_create_var( id_set, (/ id_dim_x(0), id_dim_y(0) /), 'lat', NF90_DOUBLE, id_var_lat(0), &
7266                            'degrees_north', 'latitude', 000, 000, 000 )
7267    CALL netcdf_create_var( id_set, (/ id_dim_x(1), id_dim_y(0) /), 'lonu', NF90_DOUBLE, id_var_lon(1), &
7268                            'degrees_east', 'longitude', 000, 000, 000 )
7269    CALL netcdf_create_var( id_set, (/ id_dim_x(1), id_dim_y(0) /), 'latu', NF90_DOUBLE, id_var_lat(1), &
7270                            'degrees_north', 'latitude', 000, 000, 000 )
7271    CALL netcdf_create_var( id_set, (/ id_dim_x(0), id_dim_y(1) /), 'lonv', NF90_DOUBLE, id_var_lon(2), &
7272                            'degrees_east', 'longitude', 000, 000, 000 )
7273    CALL netcdf_create_var( id_set, (/ id_dim_x(0), id_dim_y(1) /), 'latv', NF90_DOUBLE, id_var_lat(2), &
7274                            'degrees_north', 'latitude', 000, 000, 000 )
7275
7276    DO  i = 0, 2
7277       CALL netcdf_create_att( id_set, id_var_eutm(i), 'standard_name', 'projection_x_coordinate', 000)
7278       CALL netcdf_create_att( id_set, id_var_nutm(i), 'standard_name', 'projection_y_coordinate', 000)
7279
7280       CALL netcdf_create_att( id_set, id_var_lat(i), 'standard_name', 'latitude', 000)
7281       CALL netcdf_create_att( id_set, id_var_lon(i), 'standard_name', 'longitude', 000)
7282    ENDDO
7283
7284#endif
7285 END SUBROUTINE define_geo_coordinates
7286
7287
7288!------------------------------------------------------------------------------!
7289! Description:
7290! ------------
[3459]7291!> Convert UTM coordinates into geographic latitude and longitude. Conversion
7292!> is based on the work of KrÃŒger (1912) DOI: 10.2312/GFZ.b103-krueger28
7293!> and Karney (2013) DOI: 10.1007/s00190-012-0578-z
7294!> Based on a JavaScript of the geodesy function library written by chrisveness
7295!> https://github.com/chrisveness/geodesy
7296!------------------------------------------------------------------------------!
7297 SUBROUTINE convert_utm_to_geographic( crs, eutm, nutm, lon, lat )
7298
7299    USE basic_constants_and_equations_mod,                                     &
7300        ONLY:  pi
7301
7302    IMPLICIT NONE
7303
[3467]7304    INTEGER(iwp) ::  j   !< loop index
7305   
[3459]7306    REAL(wp), INTENT(in)  ::  eutm !< easting (UTM)
7307    REAL(wp), INTENT(out) ::  lat  !< geographic latitude in degree
7308    REAL(wp), INTENT(out) ::  lon  !< geographic longitude in degree
7309    REAL(wp), INTENT(in)  ::  nutm !< northing (UTM)
7310
7311    REAL(wp) ::  a           !< 2*pi*a is the circumference of a meridian
7312    REAL(wp) ::  cos_eta_s   !< cos(eta_s)
7313    REAL(wp) ::  delta_i     !<
7314    REAL(wp) ::  delta_tau_i !<
7315    REAL(wp) ::  e           !< eccentricity
7316    REAL(wp) ::  eta         !<
7317    REAL(wp) ::  eta_s       !<
7318    REAL(wp) ::  n           !< 3rd flattening
7319    REAL(wp) ::  n2          !< n^2
7320    REAL(wp) ::  n3          !< n^3
7321    REAL(wp) ::  n4          !< n^4
7322    REAL(wp) ::  n5          !< n^5
7323    REAL(wp) ::  n6          !< n^6
7324    REAL(wp) ::  nu          !<
7325    REAL(wp) ::  nu_s        !<
7326    REAL(wp) ::  sin_eta_s   !< sin(eta_s)
7327    REAL(wp) ::  sinh_nu_s   !< sinush(nu_s)
7328    REAL(wp) ::  tau_i       !<
7329    REAL(wp) ::  tau_i_s     !<
7330    REAL(wp) ::  tau_s       !<
7331    REAL(wp) ::  x           !< adjusted easting
7332    REAL(wp) ::  y           !< adjusted northing
7333
7334    REAL(wp), DIMENSION(6) ::  beta !< 6th order KrÃŒger expressions
7335
7336    REAL(wp), DIMENSION(8), INTENT(in) ::  crs !< coordinate reference system, consists of
7337                                               !< (/semi_major_axis,
7338                                               !<   inverse_flattening,
7339                                               !<   longitude_of_prime_meridian,
7340                                               !<   longitude_of_central_meridian,
7341                                               !<   scale_factor_at_central_meridian,
7342                                               !<   latitude_of_projection_origin,
7343                                               !<   false_easting,
7344                                               !<   false_northing /)
7345
7346    x = eutm - crs(7)  ! remove false easting
7347    y = nutm - crs(8)  ! remove false northing
7348
7349!-- from Karney 2011 Eq 15-22, 36:
7350    e = SQRT( 1.0_wp / crs(2) * ( 2.0_wp - 1.0_wp / crs(2) ) )
7351    n = 1.0_wp / crs(2) / ( 2.0_wp - 1.0_wp / crs(2) )
7352    n2 = n * n
7353    n3 = n * n2
7354    n4 = n * n3
7355    n5 = n * n4
7356    n6 = n * n5
7357
7358    a = crs(1) / ( 1.0_wp + n ) * ( 1.0_wp + 0.25_wp * n2       &
7359                                           + 0.015625_wp * n4   &
7360                                           + 3.90625E-3_wp * n6 )
7361
7362    nu  = x / ( crs(5) * a )
7363    eta = y / ( crs(5) * a )
7364
7365!-- According to KrÃŒger (1912), eq. 26*
7366    beta(1) =        0.5_wp                  * n  &
7367            -        2.0_wp /         3.0_wp * n2 &
7368            +       37.0_wp /        96.0_wp * n3 &
7369            -        1.0_wp /       360.0_wp * n4 &
7370            -       81.0_wp /       512.0_wp * n5 &
7371            +    96199.0_wp /    604800.0_wp * n6
7372
7373    beta(2) =        1.0_wp /        48.0_wp * n2 &
7374            +        1.0_wp /        15.0_wp * n3 &
7375            -      437.0_wp /      1440.0_wp * n4 &
7376            +       46.0_wp /       105.0_wp * n5 &
7377            -  1118711.0_wp /   3870720.0_wp * n6
7378
7379    beta(3) =       17.0_wp /       480.0_wp * n3 &
7380            -       37.0_wp /       840.0_wp * n4 &
7381            -      209.0_wp /      4480.0_wp * n5 &
7382            +     5569.0_wp /     90720.0_wp * n6
7383
7384    beta(4) =     4397.0_wp /    161280.0_wp * n4 &
7385            -       11.0_wp /       504.0_wp * n5 &
7386            -   830251.0_wp /   7257600.0_wp * n6
7387
7388    beta(5) =     4583.0_wp /    161280.0_wp * n5 &
7389            -   108847.0_wp /   3991680.0_wp * n6
7390
7391    beta(6) = 20648693.0_wp / 638668800.0_wp * n6
7392
7393    eta_s = eta
7394    nu_s  = nu
7395    DO  j = 1, 6
7396      eta_s = eta_s - beta(j) * SIN(2.0_wp * j * eta) * COSH(2.0_wp * j * nu)
7397      nu_s  = nu_s  - beta(j) * COS(2.0_wp * j * eta) * SINH(2.0_wp * j * nu)
7398    ENDDO
7399
7400    sinh_nu_s = SINH( nu_s )
7401    sin_eta_s = SIN( eta_s )
7402    cos_eta_s = COS( eta_s )
7403
7404    tau_s = sin_eta_s / SQRT( sinh_nu_s**2 + cos_eta_s**2 )
7405
7406    tau_i = tau_s
7407    delta_tau_i = 1.0_wp
7408
7409    DO WHILE ( ABS( delta_tau_i ) > 1.0E-12_wp )
7410
7411      delta_i = SINH( e * ATANH( e * tau_i / SQRT( 1.0_wp + tau_i**2 ) ) )
7412
7413      tau_i_s = tau_i   * SQRT( 1.0_wp + delta_i**2 )  &
7414               - delta_i * SQRT( 1.0_wp + tau_i**2 )
7415
7416      delta_tau_i = ( tau_s - tau_i_s ) / SQRT( 1.0_wp + tau_i_s**2 )  &
7417                   * ( 1.0_wp + ( 1.0_wp - e**2 ) * tau_i**2 )          &
7418                   / ( ( 1.0_wp - e**2 ) * SQRT( 1.0_wp + tau_i**2 ) )
7419
7420      tau_i = tau_i + delta_tau_i
7421
7422    ENDDO
7423
7424    lat = ATAN( tau_i ) / pi * 180.0_wp
7425    lon = ATAN2( sinh_nu_s, cos_eta_s ) / pi * 180.0_wp + crs(4)
7426
7427 END SUBROUTINE convert_utm_to_geographic
7428
[1783]7429 END MODULE netcdf_interface
Note: See TracBrowser for help on using the repository browser.