Home

Context Navigation

source: palm/trunk/SOURCE/netcdf_data_input_mod.f90 @ 4362

Last change on this file since 4362 was 4362, checked in by suehring, 5 years ago
Input of plant-canopy variables from static driver moved from netcdf_data_input_mod to plant-canopy model
Property svn:keywords set to `Id`
File size: 257.9 KB

Line
1	!> @file netcdf_data_input_mod.f90
2	!------------------------------------------------------------------------------!
3	! This file is part of the PALM model system.
4	!
5	! PALM is free software: you can redistribute it and/or modify it under the
6	! terms of the GNU General Public License as published by the Free Software
7	! Foundation, either version 3 of the License, or (at your option) any later
8	! version.
9	!
10	! PALM is distributed in the hope that it will be useful, but WITHOUT ANY
11	! WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
12	! A PARTICULAR PURPOSE. See the GNU General Public License for more details.
13	!
14	! You should have received a copy of the GNU General Public License along with
15	! PALM. If not, see <http://www.gnu.org/licenses/>.
16	!
17	! Copyright 1997-2020 Leibniz Universitaet Hannover
18	!------------------------------------------------------------------------------!
19	!
20	! Current revisions:
21	! -----------------
22	!
23	!
24	! Former revisions:
25	! -----------------
26	! $Id: netcdf_data_input_mod.f90 4362 2020-01-07 17:15:02Z suehring $
27	! Input of plant canopy variables from static driver moved to plant-canopy
28	! model
29	!
30	! 4360 2020-01-07 11:25:50Z suehring
31	! Correct single message calls, local checks must be given by the respective
32	! mpi rank.
33	!
34	! 4346 2019-12-18 11:55:56Z motisi
35	! Introduction of wall_flags_total_0, which currently sets bits based on static
36	! topography information used in wall_flags_static_0
37	!
38	! 4329 2019-12-10 15:46:36Z motisi
39	! Renamed wall_flags_0 to wall_flags_static_0
40	!
41	! 4321 2019-12-04 10:26:38Z pavelkrc
42	! Further revise check for surface fractions
43	!
44	! 4313 2019-11-27 14:07:00Z suehring
45	! Checks for surface fractions revised
46	!
47	! 4312 2019-11-27 14:06:25Z suehring
48	! Open input files with read-only attribute instead of write attribute.
49	!
50	! 4280 2019-10-29 14:34:15Z monakurppa
51	! Remove id_emis flags from get_variable_4d_to_3d_real and
52	! get_variable_5d_to_4d_real
53	!
54	! 4258 2019-10-07 13:29:08Z suehring
55	! - Migrate input of soil temperature and moisture to land-surface model.
56	! - Remove interpolate routines and move the only required subroutine to
57	! land-surface model.
58	!
59	! 4247 2019-09-30 10:18:24Z pavelkrc
60	! Add reading and processing of building_surface_pars
61	!
62	! 4226 2019-09-10 17:03:24Z suehring
63	! - Netcdf input routine for dimension length renamed
64	! - Move offline-nesting-specific checks to nesting_offl_mod
65	! - Module-specific input of boundary data for offline nesting moved to
66	! nesting_offl_mod
67	! - Define module specific data type for offline nesting in nesting_offl_mod
68	!
69	! 4190 2019-08-27 15:42:37Z suehring
70	! type real_1d changed to real_1d_3d
71	!
72	! 4186 2019-08-23 16:06:14Z suehring
73	! Minor formatting adjustments
74	!
75	! 4182 2019-08-22 15:20:23Z scharf
76	! Corrected "Former revisions" section
77	!
78	! 4178 2019-08-21 11:13:06Z suehring
79	! Implement input of external radiation forcing. Therefore, provide public
80	! subroutines and variables.
81	!
82	! 4150 2019-08-08 20:00:47Z suehring
83	! Some variables are given the public attribute, in order to call netcdf input
84	! from single routines
85	!
86	! 4125 2019-07-29 13:31:44Z suehring
87	! To enable netcdf-parallel access for lateral boundary data (dynamic input),
88	! zero number of elements are passed to the respective get_variable routine
89	! for non-boundary cores.
90	!
91	! 4100 2019-07-17 08:11:29Z forkel
92	! Made check for input_pids_dynamic and 'inifor' more general
93	!
94	! 4012 2019-05-31 15:19:05Z monakurppa
95	!
96	! 3994 2019-05-22 18:08:09Z suehring
97	! Remove single location message
98	!
99	! 3976 2019-05-15 11:02:34Z hellstea
100	! Remove unused variables from last commit
101	!
102	! 3969 2019-05-13 12:14:33Z suehring
103	! - clean-up index notations for emission_values to eliminate magic numbers
104	! - introduce temporary variable dum_var_5d as well as subroutines
105	! get_var_5d_real and get_var_5d_real_dynamic
106	! - remove emission-specific code in generic get_variable routines
107	! - in subroutine netcdf_data_input_chemistry_data change netCDF LOD 1
108	! (default) emission_values to the following index order:
109	! z, y, x, species, category
110	! - in subroutine netcdf_data_input_chemistry_data
111	! changed netCDF LOD 2 pre-processed emission_values to the following index
112	! order: time, z, y, x, species
113	! - in type chem_emis_att_type replace nspec with n_emiss_species
114	! but retained nspec for backward compatibility with salsa_mod. (E.C. Chan)
115	!
116	! 3961 2019-05-08 16:12:31Z suehring
117	! Revise checks for building IDs and types
118	!
119	! 3943 2019-05-02 09:50:41Z maronga
120	! Temporarily disabled some (faulty) checks for static driver.
121	!
122	! 3942 2019-04-30 13:08:30Z kanani
123	! Fix: increase LEN of all NetCDF attribute values (caused crash in
124	! netcdf_create_global_atts due to insufficient length)
125	!
126	! 3941 2019-04-30 09:48:33Z suehring
127	! Move check for grid dimension to an earlier point in time when first array
128	! is read.
129	! Improve checks for building types / IDs with respect to 2D/3D buildings.
130	!
131	! 3885 2019-04-11 11:29:34Z kanani
132	! Changes related to global restructuring of location messages and introduction
133	! of additional debug messages
134	!
135	! 3864 2019-04-05 09:01:56Z monakurppa
136	! get_variable_4d_to_3d_real modified to enable read in data of type
137	! data(t,y,x,n) one timestep at a time + some routines made public
138	!
139	! 3855 2019-04-03 10:00:59Z suehring
140	! Typo removed
141	!
142	! 3854 2019-04-02 16:59:33Z suehring
143	! Bugfix in one of the checks. Typo removed.
144	!
145	! 3744 2019-02-15 18:38:58Z suehring
146	! Enable mesoscale offline nesting for chemistry variables as well as
147	! initialization of chemistry via dynamic input file.
148	!
149	! 3705 2019-01-29 19:56:39Z suehring
150	! Interface for attribute input of 8-bit and 32-bit integer
151	!
152	! 3704 2019-01-29 19:51:41Z suehring
153	! unused variables removed
154	!
155	! 2696 2017-12-14 17:12:51Z kanani
156	! Initial revision (suehring)
157	!
158	! Authors:
159	! --------
160	! @author Matthias Suehring
161	! @author Edward C. Chan
162	! @author Emanuele Russo
163	!
164	! Description:
165	! ------------
166	!> Modulue contains routines to input data according to Palm input data
167	!> standart using dynamic and static input files.
168	!> @todo - Chemistry: revise reading of netcdf file and ajdust formatting
169	!> according to standard!!! (ecc/done)
170	!> @todo - Order input alphabetically
171	!> @todo - Revise error messages and error numbers
172	!> @todo - Input of missing quantities (chemical species, emission rates)
173	!> @todo - Defninition and input of still missing variable attributes
174	!> (ecc/what are they?)
175	!> @todo - Input of initial geostrophic wind profiles with cyclic conditions.
176	!> @todo - remove z dimension from default_emission_data nad preproc_emission_data
177	! and correpsonding subroutines get_var_5d_real and get_var_5d_dynamic (ecc)
178	!> @todo - decpreciate chem_emis_att_type@nspec (ecc)
179	!> @todo - depreciate subroutines get_variable_4d_to_3d_real and
180	!> get_variable_5d_to_4d_real (ecc)
181	!> @todo - introduce useful debug_message(s)
182	!------------------------------------------------------------------------------!
183	MODULE netcdf_data_input_mod
184
185	USE control_parameters, &
186	ONLY: coupling_char, io_blocks, io_group
187
188	USE cpulog, &
189	ONLY: cpu_log, log_point_s
190
191	USE indices, &
192	ONLY: nbgp
193
194	USE kinds
195
196	#if defined ( __netcdf )
197	USE NETCDF
198	#endif
199
200	USE pegrid
201
202	USE surface_mod, &
203	ONLY: ind_pav_green, ind_veg_wall, ind_wat_win
204	!
205	!-- Define type for dimensions.
206	TYPE dims_xy
207	INTEGER(iwp) :: nx !< dimension length in x
208	INTEGER(iwp) :: ny !< dimension length in y
209	INTEGER(iwp) :: nz !< dimension length in z
210	REAL(wp), DIMENSION(:), ALLOCATABLE :: x !< dimension array in x
211	REAL(wp), DIMENSION(:), ALLOCATABLE :: y !< dimension array in y
212	REAL(wp), DIMENSION(:), ALLOCATABLE :: z !< dimension array in z
213	END TYPE dims_xy
214	TYPE init_type
215
216	CHARACTER(LEN=16) :: init_char = 'init_atmosphere_' !< leading substring for init variables
217	CHARACTER(LEN=23) :: origin_time = '2000-01-01 00:00:00 +00' !< reference time of input data
218	CHARACTER(LEN=100), DIMENSION(:), ALLOCATABLE :: var_names_chem !< list of chemistry variable names that can potentially be on file
219
220	INTEGER(iwp) :: lod_msoil !< level of detail - soil moisture
221	INTEGER(iwp) :: lod_pt !< level of detail - pt
222	INTEGER(iwp) :: lod_q !< level of detail - q
223	INTEGER(iwp) :: lod_tsoil !< level of detail - soil temperature
224	INTEGER(iwp) :: lod_u !< level of detail - u-component
225	INTEGER(iwp) :: lod_v !< level of detail - v-component
226	INTEGER(iwp) :: lod_w !< level of detail - w-component
227	INTEGER(iwp) :: nx !< number of scalar grid points along x in dynamic input file
228	INTEGER(iwp) :: nxu !< number of u grid points along x in dynamic input file
229	INTEGER(iwp) :: ny !< number of scalar grid points along y in dynamic input file
230	INTEGER(iwp) :: nyv !< number of v grid points along y in dynamic input file
231	INTEGER(iwp) :: nzs !< number of vertical soil levels in dynamic input file
232	INTEGER(iwp) :: nzu !< number of vertical levels on scalar grid in dynamic input file
233	INTEGER(iwp) :: nzw !< number of vertical levels on w grid in dynamic input file
234
235	INTEGER(iwp), DIMENSION(:), ALLOCATABLE :: lod_chem !< level of detail - chemistry variables
236
237	LOGICAL :: from_file_msoil = .FALSE. !< flag indicating whether soil moisture is already initialized from file
238	LOGICAL :: from_file_pt = .FALSE. !< flag indicating whether pt is already initialized from file
239	LOGICAL :: from_file_q = .FALSE. !< flag indicating whether q is already initialized from file
240	LOGICAL :: from_file_tsoil = .FALSE. !< flag indicating whether soil temperature is already initialized from file
241	LOGICAL :: from_file_u = .FALSE. !< flag indicating whether u is already initialized from file
242	LOGICAL :: from_file_ug = .FALSE. !< flag indicating whether ug is already initialized from file
243	LOGICAL :: from_file_v = .FALSE. !< flag indicating whether v is already initialized from file
244	LOGICAL :: from_file_vg = .FALSE. !< flag indicating whether ug is already initialized from file
245	LOGICAL :: from_file_w = .FALSE. !< flag indicating whether w is already initialized from file
246
247	LOGICAL, DIMENSION(:), ALLOCATABLE :: from_file_chem !< flag indicating whether chemistry variable is read from file
248
249	REAL(wp) :: fill_msoil !< fill value for soil moisture
250	REAL(wp) :: fill_pt !< fill value for pt
251	REAL(wp) :: fill_q !< fill value for q
252	REAL(wp) :: fill_tsoil !< fill value for soil temperature
253	REAL(wp) :: fill_u !< fill value for u
254	REAL(wp) :: fill_v !< fill value for v
255	REAL(wp) :: fill_w !< fill value for w
256	REAL(wp) :: latitude = 0.0_wp !< latitude of the lower left corner
257	REAL(wp) :: longitude = 0.0_wp !< longitude of the lower left corner
258	REAL(wp) :: origin_x = 500000.0_wp !< UTM easting of the lower left corner
259	REAL(wp) :: origin_y = 0.0_wp !< UTM northing of the lower left corner
260	REAL(wp) :: origin_z = 0.0_wp !< reference height of input data
261	REAL(wp) :: rotation_angle = 0.0_wp !< rotation angle of input data
262
263	REAL(wp), DIMENSION(:), ALLOCATABLE :: fill_chem !< fill value - chemistry variables
264	REAL(wp), DIMENSION(:), ALLOCATABLE :: msoil_1d !< initial vertical profile of soil moisture
265	REAL(wp), DIMENSION(:), ALLOCATABLE :: pt_init !< initial vertical profile of pt
266	REAL(wp), DIMENSION(:), ALLOCATABLE :: q_init !< initial vertical profile of q
267	REAL(wp), DIMENSION(:), ALLOCATABLE :: tsoil_1d !< initial vertical profile of soil temperature
268	REAL(wp), DIMENSION(:), ALLOCATABLE :: u_init !< initial vertical profile of u
269	REAL(wp), DIMENSION(:), ALLOCATABLE :: ug_init !< initial vertical profile of ug
270	REAL(wp), DIMENSION(:), ALLOCATABLE :: v_init !< initial vertical profile of v
271	REAL(wp), DIMENSION(:), ALLOCATABLE :: vg_init !< initial vertical profile of ug
272	REAL(wp), DIMENSION(:), ALLOCATABLE :: w_init !< initial vertical profile of w
273	REAL(wp), DIMENSION(:), ALLOCATABLE :: z_soil !< vertical levels in soil in dynamic input file, used for interpolation
274	REAL(wp), DIMENSION(:), ALLOCATABLE :: zu_atmos !< vertical levels at scalar grid in dynamic input file, used for interpolation
275	REAL(wp), DIMENSION(:), ALLOCATABLE :: zw_atmos !< vertical levels at w grid in dynamic input file, used for interpolation
276
277	REAL(wp), DIMENSION(:,:), ALLOCATABLE :: chem_init !< initial vertical profiles of chemistry variables
278
279
280	REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: msoil_3d !< initial 3d soil moisture provide by Inifor and interpolated onto soil grid
281	REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: tsoil_3d !< initial 3d soil temperature provide by Inifor and interpolated onto soil grid
282
283	END TYPE init_type
284
285	!-- Data type for the general information of chemistry emissions, do not dependent on the particular chemical species
286	TYPE chem_emis_att_type
287
288	!-DIMENSIONS
289
290	INTEGER(iwp) :: nspec=0 !< no of chem species provided in emission_values
291	INTEGER(iwp) :: n_emiss_species=0 !< no of chem species provided in emission_values
292	!< same function as nspec, which will be depreciated (ecc)
293
294	INTEGER(iwp) :: ncat=0 !< number of emission categories
295	INTEGER(iwp) :: nvoc=0 !< number of VOC components
296	INTEGER(iwp) :: npm=0 !< number of PM components
297	INTEGER(iwp) :: nnox=2 !< number of NOx components: NO and NO2
298	INTEGER(iwp) :: nsox=2 !< number of SOX components: SO and SO4
299	INTEGER(iwp) :: nhoursyear !< number of hours of a specific year in the HOURLY mode
300	!< of the default mode
301	INTEGER(iwp) :: nmonthdayhour !< number of month days and hours in the MDH mode
302	!< of the default mode
303	INTEGER(iwp) :: dt_emission !< Number of emissions timesteps for one year
304	!< in the pre-processed emissions case
305	!-- 1d emission input variables
306	CHARACTER (LEN=25),ALLOCATABLE, DIMENSION(:) :: pm_name !< Names of PM components
307	CHARACTER (LEN=25),ALLOCATABLE, DIMENSION(:) :: cat_name !< Emission category names
308	CHARACTER (LEN=25),ALLOCATABLE, DIMENSION(:) :: species_name !< Names of emission chemical species
309	CHARACTER (LEN=25),ALLOCATABLE, DIMENSION(:) :: voc_name !< Names of VOCs components
310	CHARACTER (LEN=25) :: units !< Units
311
312	INTEGER(iwp) :: i_hour !< indices for assigning emission values at different timesteps
313	INTEGER(iwp),ALLOCATABLE, DIMENSION(:) :: cat_index !< Indices for emission categories
314	INTEGER(iwp),ALLOCATABLE, DIMENSION(:) :: species_index !< Indices for emission chem species
315
316	REAL(wp),ALLOCATABLE, DIMENSION(:) :: xm !< Molecular masses of emission chem species
317
318	!-- 2d emission input variables
319	REAL(wp),ALLOCATABLE, DIMENSION(:,:) :: hourly_emis_time_factor !< Time factors for HOURLY emissions (DEFAULT mode)
320	REAL(wp),ALLOCATABLE, DIMENSION(:,:) :: mdh_emis_time_factor !< Time factors for MDH emissions (DEFAULT mode)
321	REAL(wp),ALLOCATABLE, DIMENSION(:,:) :: nox_comp !< Composition of NO and NO2
322	REAL(wp),ALLOCATABLE, DIMENSION(:,:) :: sox_comp !< Composition of SO2 and SO4
323	REAL(wp),ALLOCATABLE, DIMENSION(:,:) :: voc_comp !< Composition of VOC components (not fixed)
324
325	!-- 3d emission input variables
326	REAL(wp),ALLOCATABLE, DIMENSION(:,:,:) :: pm_comp !< Composition of PM components (not fixed)
327
328	END TYPE chem_emis_att_type
329
330
331	!-- Data type for the values of chemistry emissions
332	TYPE chem_emis_val_type
333
334	!REAL(wp),ALLOCATABLE, DIMENSION(:,:) :: stack_height !< stack height (ecc / to be implemented)
335	REAL(wp),ALLOCATABLE, DIMENSION(:,:,:) :: default_emission_data !< Emission input values for LOD1 (DEFAULT mode)
336	REAL(wp),ALLOCATABLE, DIMENSION(:,:,:,:) :: preproc_emission_data !< Emission input values for LOD2 (PRE-PROCESSED mode)
337
338	END TYPE chem_emis_val_type
339
340	!
341	!-- Define data structures for different input data types.
342	!-- 8-bit Integer 2D
343	TYPE int_2d_8bit
344	INTEGER(KIND=1) :: fill = -127 !< fill value
345	INTEGER(KIND=1), DIMENSION(:,:), ALLOCATABLE :: var !< respective variable
346
347	LOGICAL :: from_file = .FALSE. !< flag indicating whether an input variable is available and read from file or default values are used
348	END TYPE int_2d_8bit
349	!
350	!-- 8-bit Integer 3D
351	TYPE int_3d_8bit
352	INTEGER(KIND=1) :: fill = -127 !< fill value
353	INTEGER(KIND=1), DIMENSION(:,:,:), ALLOCATABLE :: var_3d !< respective variable
354
355	LOGICAL :: from_file = .FALSE. !< flag indicating whether an input variable is available and read from file or default values are used
356	END TYPE int_3d_8bit
357	!
358	!-- 32-bit Integer 2D
359	TYPE int_2d_32bit
360	INTEGER(iwp) :: fill = -9999 !< fill value
361	INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE :: var !< respective variable
362
363	LOGICAL :: from_file = .FALSE. !< flag indicating whether an input variable is available and read from file or default values are used
364	END TYPE int_2d_32bit
365	!
366	!-- Define data type to read 1D or 3D real variables.
367	TYPE real_1d_3d
368	LOGICAL :: from_file = .FALSE. !< flag indicating whether an input variable is available and read from file or default values are used
369
370	INTEGER(iwp) :: lod = -1 !< level-of-detail
371
372	REAL(wp) :: fill = -9999.9_wp !< fill value
373
374	REAL(wp), DIMENSION(:), ALLOCATABLE :: var1d !< respective 1D variable
375	REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: var3d !< respective 3D variable
376	END TYPE real_1d_3d
377	!
378	!-- Define data type to read 2D real variables
379	TYPE real_2d
380	LOGICAL :: from_file = .FALSE. !< flag indicating whether an input variable is available and read from file or default values are used
381
382	INTEGER(iwp) :: lod !< level-of-detail
383
384	REAL(wp) :: fill = -9999.9_wp !< fill value
385	REAL(wp), DIMENSION(:,:), ALLOCATABLE :: var !< respective variable
386	END TYPE real_2d
387
388	!
389	!-- Define data type to read 3D real variables
390	TYPE real_3d
391	LOGICAL :: from_file = .FALSE. !< flag indicating whether an input variable is available and read from file or default values are used
392
393	INTEGER(iwp) :: nz !< number of grid points along vertical dimension
394
395	REAL(wp) :: fill = -9999.9_wp !< fill value
396	REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: var !< respective variable
397	END TYPE real_3d
398	!
399	!-- Define data structure where the dimension and type of the input depends
400	!-- on the given level of detail.
401	!-- For buildings, the input is either 2D float, or 3d byte.
402	TYPE build_in
403	INTEGER(iwp) :: lod = 1 !< level of detail
404	INTEGER(KIND=1) :: fill2 = -127 !< fill value for lod = 2
405	INTEGER(iwp) :: nz !< number of vertical layers in file
406	INTEGER(KIND=1), DIMENSION(:,:,:), ALLOCATABLE :: var_3d !< 3d variable (lod = 2)
407
408	REAL(wp), DIMENSION(:), ALLOCATABLE :: z !< vertical coordinate for 3D building, used for consistency check
409
410	LOGICAL :: from_file = .FALSE. !< flag indicating whether an input variable is available and read from file or default values are used
411
412	REAL(wp) :: fill1 = -9999.9_wp !< fill values for lod = 1
413	REAL(wp), DIMENSION(:,:), ALLOCATABLE :: var_2d !< 2d variable (lod = 1)
414	REAL(wp), DIMENSION(:,:), ALLOCATABLE :: oro_max !< terraing height under particular buildings
415	END TYPE build_in
416
417	!
418	!-- For soil_type, the input is either 2D or 3D one-byte integer.
419	TYPE soil_in
420	INTEGER(iwp) :: lod = 1 !< level of detail
421	INTEGER(KIND=1) :: fill = -127 !< fill value for lod = 2
422	INTEGER(KIND=1), DIMENSION(:,:), ALLOCATABLE :: var_2d !< 2d variable (lod = 1)
423	INTEGER(KIND=1), DIMENSION(:,:,:), ALLOCATABLE :: var_3d !< 3d variable (lod = 2)
424
425	LOGICAL :: from_file = .FALSE. !< flag indicating whether an input variable is available and read from file or default values are used
426	END TYPE soil_in
427
428	!
429	!-- Define data type for fractions between surface types
430	TYPE fracs
431	INTEGER(iwp) :: nf !< total number of fractions
432	INTEGER(iwp), DIMENSION(:), ALLOCATABLE :: nfracs !< dimension array for fraction
433
434	LOGICAL :: from_file = .FALSE. !< flag indicating whether an input variable is available and read from file or default values are used
435
436	REAL(wp) :: fill = -9999.9_wp !< fill value
437	REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: frac !< respective fraction between different surface types
438	END TYPE fracs
439	!
440	!-- Data type for parameter lists, Depending on the given level of detail,
441	!-- the input is 3D or 4D
442	TYPE pars
443	INTEGER(iwp) :: lod = 1 !< level of detail
444	INTEGER(iwp) :: np !< total number of parameters
445	INTEGER(iwp) :: nz !< vertical dimension - number of soil layers
446	INTEGER(iwp), DIMENSION(:), ALLOCATABLE :: layers !< dimension array for soil layers
447	INTEGER(iwp), DIMENSION(:), ALLOCATABLE :: pars !< dimension array for parameters
448
449	LOGICAL :: from_file = .FALSE. !< flag indicating whether an input variable is available and read from file or default values are used
450
451	REAL(wp) :: fill = -9999.9_wp !< fill value
452	REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: pars_xy !< respective parameters, level of detail = 1
453	REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: pars_xyz !< respective parameters, level of detail = 2
454	END TYPE pars
455	!
456	!-- Data type for surface parameter lists
457	TYPE pars_surf
458	INTEGER(iwp) :: np !< total number of parameters
459	INTEGER(iwp) :: nsurf !< number of local surfaces
460	INTEGER(iwp), DIMENSION(:,:,:), ALLOCATABLE :: index_ji !< index for beginning and end of surfaces at (j,i)
461	INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE :: coords !< (k,j,i,norm_z,norm_y,norm_x)
462	!< k,j,i: surface position
463	!< norm_z,norm_y,norm_x: surface normal vector
464
465	LOGICAL :: from_file = .FALSE. !< flag indicating whether an input variable is available and read from file or default values are used
466
467	REAL(wp) :: fill = -9999.9_wp !< fill value
468	REAL(wp), DIMENSION(:,:), ALLOCATABLE :: pars !< respective parameters per surface
469	END TYPE pars_surf
470	!
471	!-- Define type for global file attributes
472	!-- Please refer to the PALM data standard for a detailed description of each
473	!-- attribute.
474	TYPE global_atts_type
475	CHARACTER(LEN=200) :: acronym = ' ' !< acronym of institution
476	CHARACTER(LEN=7) :: acronym_char = 'acronym' !< name of attribute
477	CHARACTER(LEN=200) :: author = ' ' !< first name, last name, email adress
478	CHARACTER(LEN=6) :: author_char = 'author' !< name of attribute
479	CHARACTER(LEN=200) :: campaign = 'PALM-4U' !< name of campaign
480	CHARACTER(LEN=8) :: campaign_char = 'campaign' !< name of attribute
481	CHARACTER(LEN=200) :: comment = ' ' !< comment to data
482	CHARACTER(LEN=7) :: comment_char = 'comment' !< name of attribute
483	CHARACTER(LEN=200) :: contact_person = ' ' !< first name, last name, email adress
484	CHARACTER(LEN=14) :: contact_person_char = 'contact_person' !< name of attribute
485	CHARACTER(LEN=200) :: conventions = 'CF-1.7' !< netCDF convention
486	CHARACTER(LEN=11) :: conventions_char = 'Conventions' !< name of attribute
487	CHARACTER(LEN=23 ) :: creation_time = ' ' !< creation time of data set
488	CHARACTER(LEN=13) :: creation_time_char = 'creation_time' !< name of attribute
489	CHARACTER(LEN=200) :: data_content = ' ' !< content of data set
490	CHARACTER(LEN=12) :: data_content_char = 'data_content' !< name of attribute
491	CHARACTER(LEN=200) :: dependencies = ' ' !< dependencies of data set
492	CHARACTER(LEN=12) :: dependencies_char = 'dependencies' !< name of attribute
493	CHARACTER(LEN=200) :: history = ' ' !< information about data processing
494	CHARACTER(LEN=7) :: history_char = 'history' !< name of attribute
495	CHARACTER(LEN=200) :: institution = ' ' !< name of responsible institution
496	CHARACTER(LEN=11) :: institution_char = 'institution' !< name of attribute
497	CHARACTER(LEN=200) :: keywords = ' ' !< keywords of data set
498	CHARACTER(LEN=8) :: keywords_char = 'keywords' !< name of attribute
499	CHARACTER(LEN=200) :: licence = ' ' !< licence of data set
500	CHARACTER(LEN=7) :: licence_char = 'licence' !< name of attribute
501	CHARACTER(LEN=200) :: location = ' ' !< place which refers to data set
502	CHARACTER(LEN=8) :: location_char = 'location' !< name of attribute
503	CHARACTER(LEN=10) :: origin_lat_char = 'origin_lat' !< name of attribute
504	CHARACTER(LEN=10) :: origin_lon_char = 'origin_lon' !< name of attribute
505	CHARACTER(LEN=23 ) :: origin_time = '2000-01-01 00:00:00 +00' !< reference time
506	CHARACTER(LEN=11) :: origin_time_char = 'origin_time' !< name of attribute
507	CHARACTER(LEN=8) :: origin_x_char = 'origin_x' !< name of attribute
508	CHARACTER(LEN=8) :: origin_y_char = 'origin_y' !< name of attribute
509	CHARACTER(LEN=8) :: origin_z_char = 'origin_z' !< name of attribute
510	CHARACTER(LEN=12) :: palm_version_char = 'palm_version' !< name of attribute
511	CHARACTER(LEN=200) :: references = ' ' !< literature referring to data set
512	CHARACTER(LEN=10) :: references_char = 'references' !< name of attribute
513	CHARACTER(LEN=14) :: rotation_angle_char = 'rotation_angle' !< name of attribute
514	CHARACTER(LEN=200) :: site = ' ' !< name of model domain
515	CHARACTER(LEN=4) :: site_char = 'site' !< name of attribute
516	CHARACTER(LEN=200) :: source = ' ' !< source of data set
517	CHARACTER(LEN=6) :: source_char = 'source' !< name of attribute
518	CHARACTER(LEN=200) :: title = ' ' !< title of data set
519	CHARACTER(LEN=5) :: title_char = 'title' !< name of attribute
520	CHARACTER(LEN=7) :: version_char = 'version' !< name of attribute
521
522	INTEGER(iwp) :: version !< version of data set
523
524	REAL(wp) :: origin_lat !< latitude of lower left corner
525	REAL(wp) :: origin_lon !< longitude of lower left corner
526	REAL(wp) :: origin_x !< easting (UTM coordinate) of lower left corner
527	REAL(wp) :: origin_y !< northing (UTM coordinate) of lower left corner
528	REAL(wp) :: origin_z !< reference height
529	REAL(wp) :: palm_version !< PALM version of data set
530	REAL(wp) :: rotation_angle !< rotation angle of coordinate system of data set
531	END TYPE global_atts_type
532	!
533	!-- Define type for coordinate reference system (crs)
534	TYPE crs_type
535	CHARACTER(LEN=200) :: epsg_code = 'EPSG:25831' !< EPSG code
536	CHARACTER(LEN=200) :: grid_mapping_name = 'transverse_mercator' !< name of grid mapping
537	CHARACTER(LEN=200) :: long_name = 'coordinate reference system' !< name of variable crs
538	CHARACTER(LEN=200) :: units = 'm' !< unit of crs
539
540	REAL(wp) :: false_easting = 500000.0_wp !< false easting
541	REAL(wp) :: false_northing = 0.0_wp !< false northing
542	REAL(wp) :: inverse_flattening = 298.257223563_wp !< 1/f (default for WGS84)
543	REAL(wp) :: latitude_of_projection_origin = 0.0_wp !< latitude of projection origin
544	REAL(wp) :: longitude_of_central_meridian = 3.0_wp !< longitude of central meridian of UTM zone (default: zone 31)
545	REAL(wp) :: longitude_of_prime_meridian = 0.0_wp !< longitude of prime meridian
546	REAL(wp) :: scale_factor_at_central_meridian = 0.9996_wp !< scale factor of UTM coordinates
547	REAL(wp) :: semi_major_axis = 6378137.0_wp !< length of semi major axis (default for WGS84)
548	END TYPE crs_type
549
550	!
551	!-- Define variables
552	TYPE(crs_type) :: coord_ref_sys !< coordinate reference system
553
554	TYPE(dims_xy) :: dim_static !< data structure for x, y-dimension in static input file
555
556	TYPE(init_type) :: init_3d !< data structure for the initialization of the 3D flow and soil fields
557	TYPE(init_type) :: init_model !< data structure for the initialization of the model
558
559	!
560	!-- Define 2D variables of type NC_BYTE
561	TYPE(int_2d_8bit) :: albedo_type_f !< input variable for albedo type
562	TYPE(int_2d_8bit) :: building_type_f !< input variable for building type
563	TYPE(int_2d_8bit) :: pavement_type_f !< input variable for pavenment type
564	TYPE(int_2d_8bit) :: street_crossing_f !< input variable for water type
565	TYPE(int_2d_8bit) :: street_type_f !< input variable for water type
566	TYPE(int_2d_8bit) :: vegetation_type_f !< input variable for vegetation type
567	TYPE(int_2d_8bit) :: water_type_f !< input variable for water type
568	!
569	!-- Define 3D variables of type NC_BYTE
570	TYPE(int_3d_8bit) :: building_obstruction_f !< input variable for building obstruction
571	TYPE(int_3d_8bit) :: building_obstruction_full !< input variable for building obstruction
572	!
573	!-- Define 2D variables of type NC_INT
574	TYPE(int_2d_32bit) :: building_id_f !< input variable for building ID
575	!
576	!-- Define 2D variables of type NC_FLOAT
577	TYPE(real_2d) :: terrain_height_f !< input variable for terrain height
578	TYPE(real_2d) :: uvem_irradiance_f !< input variable for uvem irradiance lookup table
579	TYPE(real_2d) :: uvem_integration_f !< input variable for uvem integration
580	!
581	!-- Define 3D variables of type NC_FLOAT
582	TYPE(real_3d) :: root_area_density_lsm_f !< input variable for root area density - parametrized vegetation
583	TYPE(real_3d) :: uvem_radiance_f !< input variable for uvem radiance lookup table
584	TYPE(real_3d) :: uvem_projarea_f !< input variable for uvem projection area lookup table
585	!
586	!-- Define input variable for buildings
587	TYPE(build_in) :: buildings_f !< input variable for buildings
588	!
589	!-- Define input variables for soil_type
590	TYPE(soil_in) :: soil_type_f !< input variable for soil type
591
592	TYPE(fracs) :: surface_fraction_f !< input variable for surface fraction
593
594	TYPE(pars) :: albedo_pars_f !< input variable for albedo parameters
595	TYPE(pars) :: building_pars_f !< input variable for building parameters
596	TYPE(pars) :: pavement_pars_f !< input variable for pavement parameters
597	TYPE(pars) :: pavement_subsurface_pars_f !< input variable for pavement parameters
598	TYPE(pars) :: soil_pars_f !< input variable for soil parameters
599	TYPE(pars) :: vegetation_pars_f !< input variable for vegetation parameters
600	TYPE(pars) :: water_pars_f !< input variable for water parameters
601
602	TYPE(pars_surf) :: building_surface_pars_f !< input variable for building surface parameters
603
604	TYPE(chem_emis_att_type) :: chem_emis_att !< Input Information of Chemistry Emission Data from netcdf
605	TYPE(chem_emis_val_type), ALLOCATABLE, DIMENSION(:) :: chem_emis !< Input Chemistry Emission Data from netcdf
606
607	CHARACTER(LEN=3) :: char_lod = 'lod' !< name of level-of-detail attribute in NetCDF file
608
609	CHARACTER(LEN=10) :: char_fill = '_FillValue' !< name of fill value attribute in NetCDF file
610
611	CHARACTER(LEN=100) :: input_file_static = 'PIDS_STATIC' !< Name of file which comprises static input data
612	CHARACTER(LEN=100) :: input_file_dynamic = 'PIDS_DYNAMIC' !< Name of file which comprises dynamic input data
613	CHARACTER(LEN=100) :: input_file_chem = 'PIDS_CHEM' !< Name of file which comprises chemistry input data
614	CHARACTER(LEN=100) :: input_file_uvem = 'PIDS_UVEM' !< Name of file which comprises static uv_exposure model input data
615	CHARACTER(LEN=100) :: input_file_vm = 'PIDS_VM' !< Name of file which comprises virtual measurement data
616
617	CHARACTER(LEN=25), ALLOCATABLE, DIMENSION(:) :: string_values !< output of string variables read from netcdf input files
618	CHARACTER(LEN=50), DIMENSION(:), ALLOCATABLE :: vars_pids !< variable in input file
619
620	INTEGER(iwp) :: id_emis !< NetCDF id of input file for chemistry emissions: TBD: It has to be removed
621
622	INTEGER(iwp) :: nc_stat !< return value of nf90 function call
623	INTEGER(iwp) :: num_var_pids !< number of variables in file
624	INTEGER(iwp) :: pids_id !< file id
625
626	LOGICAL :: input_pids_static = .FALSE. !< Flag indicating whether Palm-input-data-standard file containing static information exists
627	LOGICAL :: input_pids_dynamic = .FALSE. !< Flag indicating whether Palm-input-data-standard file containing dynamic information exists
628	LOGICAL :: input_pids_chem = .FALSE. !< Flag indicating whether Palm-input-data-standard file containing chemistry information exists
629	LOGICAL :: input_pids_uvem = .FALSE. !< Flag indicating whether uv-expoure-model input file containing static information exists
630	LOGICAL :: input_pids_vm = .FALSE. !< Flag indicating whether input file for virtual measurements exist
631
632	LOGICAL :: collective_read = .FALSE. !< Enable NetCDF collective read
633
634	TYPE(global_atts_type) :: input_file_atts !< global attributes of input file
635
636	SAVE
637
638	PRIVATE
639
640	INTERFACE netcdf_data_input_check_dynamic
641	MODULE PROCEDURE netcdf_data_input_check_dynamic
642	END INTERFACE netcdf_data_input_check_dynamic
643
644	INTERFACE netcdf_data_input_check_static
645	MODULE PROCEDURE netcdf_data_input_check_static
646	END INTERFACE netcdf_data_input_check_static
647
648	INTERFACE netcdf_data_input_chemistry_data
649	MODULE PROCEDURE netcdf_data_input_chemistry_data
650	END INTERFACE netcdf_data_input_chemistry_data
651
652	INTERFACE get_dimension_length
653	MODULE PROCEDURE get_dimension_length
654	END INTERFACE get_dimension_length
655
656	INTERFACE netcdf_data_input_inquire_file
657	MODULE PROCEDURE netcdf_data_input_inquire_file
658	END INTERFACE netcdf_data_input_inquire_file
659
660	INTERFACE netcdf_data_input_init
661	MODULE PROCEDURE netcdf_data_input_init
662	END INTERFACE netcdf_data_input_init
663
664	INTERFACE netcdf_data_input_att
665	MODULE PROCEDURE netcdf_data_input_att_int8
666	MODULE PROCEDURE netcdf_data_input_att_int32
667	MODULE PROCEDURE netcdf_data_input_att_real
668	MODULE PROCEDURE netcdf_data_input_att_string
669	END INTERFACE netcdf_data_input_att
670
671	INTERFACE netcdf_data_input_init_3d
672	MODULE PROCEDURE netcdf_data_input_init_3d
673	END INTERFACE netcdf_data_input_init_3d
674
675	INTERFACE netcdf_data_input_surface_data
676	MODULE PROCEDURE netcdf_data_input_surface_data
677	END INTERFACE netcdf_data_input_surface_data
678
679	INTERFACE netcdf_data_input_var
680	MODULE PROCEDURE netcdf_data_input_var_char
681	MODULE PROCEDURE netcdf_data_input_var_real_1d
682	MODULE PROCEDURE netcdf_data_input_var_real_2d
683	END INTERFACE netcdf_data_input_var
684
685	INTERFACE netcdf_data_input_uvem
686	MODULE PROCEDURE netcdf_data_input_uvem
687	END INTERFACE netcdf_data_input_uvem
688
689	INTERFACE get_variable
690	MODULE PROCEDURE get_variable_1d_char
691	MODULE PROCEDURE get_variable_1d_int
692	MODULE PROCEDURE get_variable_1d_real
693	MODULE PROCEDURE get_variable_2d_int8
694	MODULE PROCEDURE get_variable_2d_int32
695	MODULE PROCEDURE get_variable_2d_real
696	MODULE PROCEDURE get_variable_3d_int8
697	MODULE PROCEDURE get_variable_3d_real
698	MODULE PROCEDURE get_variable_3d_real_dynamic
699	MODULE PROCEDURE get_variable_4d_to_3d_real
700	MODULE PROCEDURE get_variable_4d_real
701	MODULE PROCEDURE get_variable_5d_to_4d_real
702	MODULE PROCEDURE get_variable_5d_real ! (ecc) temp subroutine 4 reading 5D NC arrays
703	MODULE PROCEDURE get_variable_5d_real_dynamic ! 2B removed as z is out of emission_values
704	MODULE PROCEDURE get_variable_string
705	END INTERFACE get_variable
706
707	INTERFACE get_variable_pr
708	MODULE PROCEDURE get_variable_pr
709	END INTERFACE get_variable_pr
710
711	INTERFACE get_attribute
712	MODULE PROCEDURE get_attribute_real
713	MODULE PROCEDURE get_attribute_int8
714	MODULE PROCEDURE get_attribute_int32
715	MODULE PROCEDURE get_attribute_string
716	END INTERFACE get_attribute
717
718	!
719	!-- Public data structures
720	PUBLIC real_1d_3d, &
721	real_2d, &
722	real_3d
723	!
724	!-- Public variables
725	PUBLIC albedo_pars_f, albedo_type_f, buildings_f, &
726	building_id_f, building_pars_f, building_surface_pars_f, &
727	building_type_f, &
728	char_fill, &
729	char_lod, &
730	chem_emis, chem_emis_att, chem_emis_att_type, chem_emis_val_type, &
731	coord_ref_sys, &
732	init_3d, init_model, input_file_atts, &
733	input_file_dynamic, &
734	input_file_static, &
735	input_pids_static, &
736	input_pids_dynamic, input_pids_vm, input_file_vm, &
737	num_var_pids, &
738	pavement_pars_f, pavement_subsurface_pars_f, pavement_type_f, &
739	pids_id, &
740	root_area_density_lsm_f, soil_pars_f, &
741	soil_type_f, street_crossing_f, street_type_f, surface_fraction_f, &
742	terrain_height_f, vegetation_pars_f, vegetation_type_f, &
743	vars_pids, &
744	water_pars_f, water_type_f
745	!
746	!-- Public uv exposure variables
747	PUBLIC building_obstruction_f, input_file_uvem, input_pids_uvem, &
748	netcdf_data_input_uvem, &
749	uvem_integration_f, uvem_irradiance_f, &
750	uvem_projarea_f, uvem_radiance_f
751
752	!
753	!-- Public subroutines
754	PUBLIC netcdf_data_input_check_dynamic, &
755	netcdf_data_input_check_static, &
756	netcdf_data_input_chemistry_data, &
757	get_dimension_length, &
758	netcdf_data_input_inquire_file, &
759	netcdf_data_input_init, &
760	netcdf_data_input_init_3d, &
761	netcdf_data_input_att, &
762	netcdf_data_input_surface_data, &
763	netcdf_data_input_topo, &
764	netcdf_data_input_var, &
765	get_attribute, &
766	get_variable, &
767	get_variable_pr, &
768	open_read_file, &
769	check_existence, &
770	inquire_num_variables, &
771	inquire_variable_names, &
772	close_input_file
773
774
775	CONTAINS
776
777	!------------------------------------------------------------------------------!
778	! Description:
779	! ------------
780	!> Inquires whether NetCDF input files according to Palm-input-data standard
781	!> exist. Moreover, basic checks are performed.
782	!------------------------------------------------------------------------------!
783	SUBROUTINE netcdf_data_input_inquire_file
784
785	USE control_parameters, &
786	ONLY: topo_no_distinct
787
788	IMPLICIT NONE
789
790	#if defined ( __netcdf )
791	INQUIRE( FILE = TRIM( input_file_static ) // TRIM( coupling_char ), &
792	EXIST = input_pids_static )
793	INQUIRE( FILE = TRIM( input_file_dynamic ) // TRIM( coupling_char ), &
794	EXIST = input_pids_dynamic )
795	INQUIRE( FILE = TRIM( input_file_chem ) // TRIM( coupling_char ), &
796	EXIST = input_pids_chem )
797	INQUIRE( FILE = TRIM( input_file_uvem ) // TRIM( coupling_char ), &
798	EXIST = input_pids_uvem )
799	INQUIRE( FILE = TRIM( input_file_vm ) // TRIM( coupling_char ), &
800	EXIST = input_pids_vm )
801	#endif
802
803	!
804	!-- As long as topography can be input via ASCII format, no distinction
805	!-- between building and terrain can be made. This case, classify all
806	!-- surfaces as default type. Same in case land-surface and urban-surface
807	!-- model are not applied.
808	IF ( .NOT. input_pids_static ) THEN
809	topo_no_distinct = .TRUE.
810	ENDIF
811
812	END SUBROUTINE netcdf_data_input_inquire_file
813
814	!------------------------------------------------------------------------------!
815	! Description:
816	! ------------
817	!> Reads global attributes and coordinate reference system required for
818	!> initialization of the model.
819	!------------------------------------------------------------------------------!
820	SUBROUTINE netcdf_data_input_init
821
822	IMPLICIT NONE
823
824	INTEGER(iwp) :: id_mod !< NetCDF id of input file
825	INTEGER(iwp) :: var_id_crs !< NetCDF id of variable crs
826
827	IF ( .NOT. input_pids_static ) RETURN
828
829	#if defined ( __netcdf )
830	!
831	!-- Open file in read-only mode
832	CALL open_read_file( TRIM( input_file_static ) // &
833	TRIM( coupling_char ), id_mod )
834	!
835	!-- Read global attributes
836	CALL get_attribute( id_mod, input_file_atts%origin_lat_char, &
837	input_file_atts%origin_lat, .TRUE. )
838
839	CALL get_attribute( id_mod, input_file_atts%origin_lon_char, &
840	input_file_atts%origin_lon, .TRUE. )
841
842	CALL get_attribute( id_mod, input_file_atts%origin_time_char, &
843	input_file_atts%origin_time, .TRUE. )
844
845	CALL get_attribute( id_mod, input_file_atts%origin_x_char, &
846	input_file_atts%origin_x, .TRUE. )
847
848	CALL get_attribute( id_mod, input_file_atts%origin_y_char, &
849	input_file_atts%origin_y, .TRUE. )
850
851	CALL get_attribute( id_mod, input_file_atts%origin_z_char, &
852	input_file_atts%origin_z, .TRUE. )
853
854	CALL get_attribute( id_mod, input_file_atts%rotation_angle_char, &
855	input_file_atts%rotation_angle, .TRUE. )
856
857	CALL get_attribute( id_mod, input_file_atts%author_char, &
858	input_file_atts%author, .TRUE., no_abort=.FALSE. )
859	CALL get_attribute( id_mod, input_file_atts%contact_person_char, &
860	input_file_atts%contact_person, .TRUE., no_abort=.FALSE. )
861	CALL get_attribute( id_mod, input_file_atts%institution_char, &
862	input_file_atts%institution, .TRUE., no_abort=.FALSE. )
863	CALL get_attribute( id_mod, input_file_atts%acronym_char, &
864	input_file_atts%acronym, .TRUE., no_abort=.FALSE. )
865
866	CALL get_attribute( id_mod, input_file_atts%campaign_char, &
867	input_file_atts%campaign, .TRUE., no_abort=.FALSE. )
868	CALL get_attribute( id_mod, input_file_atts%location_char, &
869	input_file_atts%location, .TRUE., no_abort=.FALSE. )
870	CALL get_attribute( id_mod, input_file_atts%site_char, &
871	input_file_atts%site, .TRUE., no_abort=.FALSE. )
872
873	CALL get_attribute( id_mod, input_file_atts%source_char, &
874	input_file_atts%source, .TRUE., no_abort=.FALSE. )
875	CALL get_attribute( id_mod, input_file_atts%references_char, &
876	input_file_atts%references, .TRUE., no_abort=.FALSE. )
877	CALL get_attribute( id_mod, input_file_atts%keywords_char, &
878	input_file_atts%keywords, .TRUE., no_abort=.FALSE. )
879	CALL get_attribute( id_mod, input_file_atts%licence_char, &
880	input_file_atts%licence, .TRUE., no_abort=.FALSE. )
881	CALL get_attribute( id_mod, input_file_atts%comment_char, &
882	input_file_atts%comment, .TRUE., no_abort=.FALSE. )
883	!
884	!-- Read coordinate reference system if available
885	nc_stat = NF90_INQ_VARID( id_mod, 'crs', var_id_crs )
886	IF ( nc_stat == NF90_NOERR ) THEN
887	CALL get_attribute( id_mod, 'epsg_code', &
888	coord_ref_sys%epsg_code, &
889	.FALSE., 'crs' )
890	CALL get_attribute( id_mod, 'false_easting', &
891	coord_ref_sys%false_easting, &
892	.FALSE., 'crs' )
893	CALL get_attribute( id_mod, 'false_northing', &
894	coord_ref_sys%false_northing, &
895	.FALSE., 'crs' )
896	CALL get_attribute( id_mod, 'grid_mapping_name', &
897	coord_ref_sys%grid_mapping_name, &
898	.FALSE., 'crs' )
899	CALL get_attribute( id_mod, 'inverse_flattening', &
900	coord_ref_sys%inverse_flattening, &
901	.FALSE., 'crs' )
902	CALL get_attribute( id_mod, 'latitude_of_projection_origin', &
903	coord_ref_sys%latitude_of_projection_origin, &
904	.FALSE., 'crs' )
905	CALL get_attribute( id_mod, 'long_name', &
906	coord_ref_sys%long_name, &
907	.FALSE., 'crs' )
908	CALL get_attribute( id_mod, 'longitude_of_central_meridian', &
909	coord_ref_sys%longitude_of_central_meridian, &
910	.FALSE., 'crs' )
911	CALL get_attribute( id_mod, 'longitude_of_prime_meridian', &
912	coord_ref_sys%longitude_of_prime_meridian, &
913	.FALSE., 'crs' )
914	CALL get_attribute( id_mod, 'scale_factor_at_central_meridian', &
915	coord_ref_sys%scale_factor_at_central_meridian, &
916	.FALSE., 'crs' )
917	CALL get_attribute( id_mod, 'semi_major_axis', &
918	coord_ref_sys%semi_major_axis, &
919	.FALSE., 'crs' )
920	CALL get_attribute( id_mod, 'units', &
921	coord_ref_sys%units, &
922	.FALSE., 'crs' )
923	ELSE
924	!
925	!-- Calculate central meridian from origin_lon
926	coord_ref_sys%longitude_of_central_meridian = &
927	CEILING( input_file_atts%origin_lon / 6.0_wp ) * 6.0_wp - 3.0_wp
928	ENDIF
929	!
930	!-- Finally, close input file
931	CALL close_input_file( id_mod )
932	#endif
933	!
934	!-- Copy latitude, longitude, origin_z, rotation angle on init type
935	init_model%latitude = input_file_atts%origin_lat
936	init_model%longitude = input_file_atts%origin_lon
937	init_model%origin_time = input_file_atts%origin_time
938	init_model%origin_x = input_file_atts%origin_x
939	init_model%origin_y = input_file_atts%origin_y
940	init_model%origin_z = input_file_atts%origin_z
941	init_model%rotation_angle = input_file_atts%rotation_angle
942
943	!
944	!-- In case of nested runs, each model domain might have different longitude
945	!-- and latitude, which would result in different Coriolis parameters and
946	!-- sun-zenith angles. To avoid this, longitude and latitude in each model
947	!-- domain will be set to the values of the root model. Please note, this
948	!-- synchronization is required already here.
949	#if defined( __parallel )
950	CALL MPI_BCAST( init_model%latitude, 1, MPI_REAL, 0, &
951	MPI_COMM_WORLD, ierr )
952	CALL MPI_BCAST( init_model%longitude, 1, MPI_REAL, 0, &
953	MPI_COMM_WORLD, ierr )
954	#endif
955
956	END SUBROUTINE netcdf_data_input_init
957
958	!------------------------------------------------------------------------------!
959	! Description:
960	! ------------
961	!> Read an array of characters.
962	!------------------------------------------------------------------------------!
963	SUBROUTINE netcdf_data_input_var_char( val, search_string, id_mod )
964
965	IMPLICIT NONE
966
967	CHARACTER(LEN=*) :: search_string !< name of the variable
968	CHARACTER(LEN=*), DIMENSION(:) :: val !< variable which should be read
969
970	INTEGER(iwp) :: id_mod !< NetCDF id of input file
971
972	#if defined ( __netcdf )
973	!
974	!-- Read variable
975	CALL get_variable( id_mod, search_string, val )
976	#endif
977
978	END SUBROUTINE netcdf_data_input_var_char
979
980	!------------------------------------------------------------------------------!
981	! Description:
982	! ------------
983	!> Read an 1D array of REAL values.
984	!------------------------------------------------------------------------------!
985	SUBROUTINE netcdf_data_input_var_real_1d( val, search_string, id_mod )
986
987	IMPLICIT NONE
988
989	CHARACTER(LEN=*) :: search_string !< name of the variable
990
991	INTEGER(iwp) :: id_mod !< NetCDF id of input file
992
993	REAL(wp), DIMENSION(:) :: val !< variable which should be read
994
995	#if defined ( __netcdf )
996	!
997	!-- Read variable
998	CALL get_variable( id_mod, search_string, val )
999	#endif
1000
1001	END SUBROUTINE netcdf_data_input_var_real_1d
1002
1003	!------------------------------------------------------------------------------!
1004	! Description:
1005	! ------------
1006	!> Read an 1D array of REAL values.
1007	!------------------------------------------------------------------------------!
1008	SUBROUTINE netcdf_data_input_var_real_2d( val, search_string, &
1009	id_mod, d1s, d1e, d2s, d2e )
1010
1011	IMPLICIT NONE
1012
1013	CHARACTER(LEN=*) :: search_string !< name of the variable
1014
1015	INTEGER(iwp) :: id_mod !< NetCDF id of input file
1016	INTEGER(iwp) :: d1e !< end index of first dimension to be read
1017	INTEGER(iwp) :: d2e !< end index of second dimension to be read
1018	INTEGER(iwp) :: d1s !< start index of first dimension to be read
1019	INTEGER(iwp) :: d2s !< start index of second dimension to be read
1020
1021	REAL(wp), DIMENSION(:,:) :: val !< variable which should be read
1022
1023	#if defined ( __netcdf )
1024	!
1025	!-- Read character variable
1026	CALL get_variable( id_mod, search_string, val, d1s, d1e, d2s, d2e )
1027	#endif
1028
1029	END SUBROUTINE netcdf_data_input_var_real_2d
1030
1031	!------------------------------------------------------------------------------!
1032	! Description:
1033	! ------------
1034	!> Read a global string attribute
1035	!------------------------------------------------------------------------------!
1036	SUBROUTINE netcdf_data_input_att_string( val, search_string, id_mod, &
1037	input_file, global, openclose, &
1038	variable_name )
1039
1040	IMPLICIT NONE
1041
1042	CHARACTER(LEN=*) :: search_string !< name of the attribue
1043	CHARACTER(LEN=*) :: val !< attribute
1044
1045	CHARACTER(LEN=*) :: input_file !< name of input file
1046	CHARACTER(LEN=*) :: openclose !< string indicating whether NetCDF needs to be opend or closed
1047	CHARACTER(LEN=*) :: variable_name !< string indicating whether NetCDF needs to be opend or closed
1048
1049	INTEGER(iwp) :: id_mod !< NetCDF id of input file
1050
1051	LOGICAL :: global !< flag indicating a global or a variable's attribute
1052
1053	#if defined ( __netcdf )
1054	!
1055	!-- Open file in read-only mode if necessary
1056	IF ( openclose == 'open' ) THEN
1057	CALL open_read_file( TRIM( input_file ) // TRIM( coupling_char ), &
1058	id_mod )
1059	ENDIF
1060	!
1061	!-- Read global attribute
1062	IF ( global ) THEN
1063	CALL get_attribute( id_mod, search_string, val, global )
1064	!
1065	!-- Read variable attribute
1066	ELSE
1067	CALL get_attribute( id_mod, search_string, val, global, variable_name )
1068	ENDIF
1069	!
1070	!-- Close input file
1071	IF ( openclose == 'close' ) CALL close_input_file( id_mod )
1072	#endif
1073
1074	END SUBROUTINE netcdf_data_input_att_string
1075
1076	!------------------------------------------------------------------------------!
1077	! Description:
1078	! ------------
1079	!> Read a global 8-bit integer attribute
1080	!------------------------------------------------------------------------------!
1081	SUBROUTINE netcdf_data_input_att_int8( val, search_string, id_mod, &
1082	input_file, global, openclose, &
1083	variable_name )
1084
1085	IMPLICIT NONE
1086
1087	CHARACTER(LEN=*) :: search_string !< name of the attribue
1088
1089	CHARACTER(LEN=*) :: input_file !< name of input file
1090	CHARACTER(LEN=*) :: openclose !< string indicating whether NetCDF needs to be opend or closed
1091	CHARACTER(LEN=*) :: variable_name !< string indicating whether NetCDF needs to be opend or closed
1092
1093	INTEGER(iwp) :: id_mod !< NetCDF id of input file
1094	INTEGER(KIND=1) :: val !< value of the attribute
1095
1096	LOGICAL :: global !< flag indicating a global or a variable's attribute
1097
1098	#if defined ( __netcdf )
1099	!
1100	!-- Open file in read-only mode
1101	IF ( openclose == 'open' ) THEN
1102	CALL open_read_file( TRIM( input_file ) // TRIM( coupling_char ), &
1103	id_mod )
1104	ENDIF
1105	!
1106	!-- Read global attribute
1107	IF ( global ) THEN
1108	CALL get_attribute( id_mod, search_string, val, global )
1109	!
1110	!-- Read variable attribute
1111	ELSE
1112	CALL get_attribute( id_mod, search_string, val, global, variable_name )
1113	ENDIF
1114	!
1115	!-- Finally, close input file
1116	IF ( openclose == 'close' ) CALL close_input_file( id_mod )
1117	#endif
1118
1119	END SUBROUTINE netcdf_data_input_att_int8
1120
1121	!------------------------------------------------------------------------------!
1122	! Description:
1123	! ------------
1124	!> Read a global 32-bit integer attribute
1125	!------------------------------------------------------------------------------!
1126	SUBROUTINE netcdf_data_input_att_int32( val, search_string, id_mod, &
1127	input_file, global, openclose, &
1128	variable_name )
1129
1130	IMPLICIT NONE
1131
1132	CHARACTER(LEN=*) :: search_string !< name of the attribue
1133
1134	CHARACTER(LEN=*) :: input_file !< name of input file
1135	CHARACTER(LEN=*) :: openclose !< string indicating whether NetCDF needs to be opend or closed
1136	CHARACTER(LEN=*) :: variable_name !< string indicating whether NetCDF needs to be opend or closed
1137
1138	INTEGER(iwp) :: id_mod !< NetCDF id of input file
1139	INTEGER(iwp) :: val !< value of the attribute
1140
1141	LOGICAL :: global !< flag indicating a global or a variable's attribute
1142
1143	#if defined ( __netcdf )
1144	!
1145	!-- Open file in read-only mode
1146	IF ( openclose == 'open' ) THEN
1147	CALL open_read_file( TRIM( input_file ) // TRIM( coupling_char ), &
1148	id_mod )
1149	ENDIF
1150	!
1151	!-- Read global attribute
1152	IF ( global ) THEN
1153	CALL get_attribute( id_mod, search_string, val, global )
1154	!
1155	!-- Read variable attribute
1156	ELSE
1157	CALL get_attribute( id_mod, search_string, val, global, variable_name )
1158	ENDIF
1159	!
1160	!-- Finally, close input file
1161	IF ( openclose == 'close' ) CALL close_input_file( id_mod )
1162	#endif
1163
1164	END SUBROUTINE netcdf_data_input_att_int32
1165
1166	!------------------------------------------------------------------------------!
1167	! Description:
1168	! ------------
1169	!> Read a global real attribute
1170	!------------------------------------------------------------------------------!
1171	SUBROUTINE netcdf_data_input_att_real( val, search_string, id_mod, &
1172	input_file, global, openclose, &
1173	variable_name )
1174
1175	IMPLICIT NONE
1176
1177	CHARACTER(LEN=*) :: search_string !< name of the attribue
1178
1179	CHARACTER(LEN=*) :: input_file !< name of input file
1180	CHARACTER(LEN=*) :: openclose !< string indicating whether NetCDF needs to be opend or closed
1181	CHARACTER(LEN=*) :: variable_name !< string indicating whether NetCDF needs to be opend or closed
1182
1183	INTEGER(iwp) :: id_mod !< NetCDF id of input file
1184
1185	LOGICAL :: global !< flag indicating a global or a variable's attribute
1186
1187	REAL(wp) :: val !< value of the attribute
1188
1189	#if defined ( __netcdf )
1190	!
1191	!-- Open file in read-only mode
1192	IF ( openclose == 'open' ) THEN
1193	CALL open_read_file( TRIM( input_file ) // TRIM( coupling_char ), &
1194	id_mod )
1195	ENDIF
1196	!
1197	!-- Read global attribute
1198	IF ( global ) THEN
1199	CALL get_attribute( id_mod, search_string, val, global )
1200	!
1201	!-- Read variable attribute
1202	ELSE
1203	CALL get_attribute( id_mod, search_string, val, global, variable_name )
1204	ENDIF
1205	!
1206	!-- Finally, close input file
1207	IF ( openclose == 'close' ) CALL close_input_file( id_mod )
1208	#endif
1209
1210	END SUBROUTINE netcdf_data_input_att_real
1211
1212	!------------------------------------------------------------------------------!
1213	! Description:
1214	! ------------
1215	!> Reads Chemistry NETCDF Input data, such as emission values, emission species, etc.
1216	!------------------------------------------------------------------------------!
1217
1218	SUBROUTINE netcdf_data_input_chemistry_data(emt_att,emt)
1219
1220	USE chem_modules, &
1221	ONLY: emiss_lod, time_fac_type, surface_csflux_name
1222
1223	USE control_parameters, &
1224	ONLY: message_string
1225
1226	USE indices, &
1227	ONLY: nxl, nxr, nys, nyn
1228
1229	IMPLICIT NONE
1230
1231	TYPE(chem_emis_att_type), INTENT(INOUT) :: emt_att
1232	TYPE(chem_emis_val_type), ALLOCATABLE, DIMENSION(:), INTENT(INOUT) :: emt
1233
1234	INTEGER(iwp) :: i, j, k !< generic counters
1235	INTEGER(iwp) :: ispec !< index for number of emission species in input
1236	INTEGER(iwp) :: len_dims !< Length of dimension
1237	INTEGER(iwp) :: num_vars !< number of variables in netcdf input file
1238
1239	!
1240	!-- dum_var_4d are designed to read in emission_values from the chemistry netCDF file.
1241	!-- Currently the vestigial "z" dimension in emission_values makes it a 5D array,
1242	!-- hence the corresponding dum_var_5d array. When the "z" dimension is removed
1243	!-- completely, dum_var_4d will be used instead
1244	!-- (ecc 20190425)
1245
1246	! REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:) :: dum_var_4d !< temp array 4 4D chem emission data
1247	REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:,:) :: dum_var_5d !< temp array 4 5D chem emission data
1248
1249	!
1250	!-- Start processing data
1251	!
1252	!-- Emission LOD 0 (Parameterized mode)
1253
1254	IF ( emiss_lod == 0 ) THEN
1255
1256	! for reference (ecc)
1257	! IF (TRIM(mode_emis) == "PARAMETERIZED" .OR. TRIM(mode_emis) == "parameterized") THEN
1258
1259	ispec=1
1260	emt_att%n_emiss_species = 0
1261
1262	!
1263	!-- number of species
1264
1265	DO WHILE (TRIM( surface_csflux_name( ispec ) ) /= 'novalue' )
1266
1267	emt_att%n_emiss_species = emt_att%n_emiss_species + 1
1268	ispec=ispec+1
1269	!
1270	!-- followling line retained for compatibility with salsa_mod
1271	!-- which still uses emt_att%nspec heavily (ecc)
1272
1273	emt_att%nspec = emt_att%nspec + 1
1274
1275	ENDDO
1276
1277	!
1278	!-- allocate emission values data type arrays
1279
1280	ALLOCATE ( emt(emt_att%n_emiss_species) )
1281
1282	!
1283	!-- Read EMISSION SPECIES NAMES
1284
1285	!
1286	!-- allocate space for strings
1287
1288	ALLOCATE (emt_att%species_name(emt_att%n_emiss_species) )
1289
1290	DO ispec = 1, emt_att%n_emiss_species
1291	emt_att%species_name(ispec) = TRIM(surface_csflux_name(ispec))
1292	ENDDO
1293
1294	!
1295	!-- LOD 1 (default mode) and LOD 2 (pre-processed mode)
1296
1297	ELSE
1298
1299	#if defined ( __netcdf )
1300
1301	IF ( .NOT. input_pids_chem ) RETURN
1302
1303	!
1304	!-- first we allocate memory space for the emission species and then
1305	!-- we differentiate between LOD 1 (default mode) and LOD 2 (pre-processed mode)
1306
1307	!
1308	!-- open emission data file ( {palmcase}_chemistry )
1309
1310	CALL open_read_file ( TRIM(input_file_chem) // TRIM(coupling_char), id_emis )
1311
1312	!
1313	!-- inquire number of variables
1314
1315	CALL inquire_num_variables ( id_emis, num_vars )
1316
1317	!
1318	!-- Get General Dimension Lengths: only # species and # categories.
1319	!-- Tther dimensions depend on the emission mode or specific components
1320
1321	CALL get_dimension_length ( id_emis, emt_att%n_emiss_species, 'nspecies' )
1322
1323	!
1324	!-- backward compatibility for salsa_mod (ecc)
1325
1326	emt_att%nspec = emt_att%n_emiss_species
1327
1328	!
1329	!-- Allocate emission values data type arrays
1330
1331	ALLOCATE ( emt(emt_att%n_emiss_species) )
1332
1333	!
1334	!-- READING IN SPECIES NAMES
1335
1336	!
1337	!-- Allocate memory for species names
1338
1339	ALLOCATE ( emt_att%species_name(emt_att%n_emiss_species) )
1340
1341	!
1342	!-- Retrieve variable name (again, should use n_emiss_strlen)
1343
1344	CALL get_variable( id_emis, 'emission_name', &
1345	string_values, emt_att%n_emiss_species )
1346	emt_att%species_name=string_values
1347
1348	!
1349	!-- dealocate string_values previously allocated in get_variable call
1350
1351	IF ( ALLOCATED(string_values) ) DEALLOCATE (string_values)
1352
1353	!
1354	!-- READING IN SPECIES INDICES
1355
1356	!
1357	!-- Allocate memory for species indices
1358
1359	ALLOCATE ( emt_att%species_index(emt_att%n_emiss_species) )
1360
1361	!
1362	!-- Retrieve variable data
1363
1364	CALL get_variable( id_emis, 'emission_index', emt_att%species_index )
1365	!
1366	!-- Now the routine has to distinguish between chemistry emission
1367	!-- LOD 1 (DEFAULT mode) and LOD 2 (PRE-PROCESSED mode)
1368
1369	!
1370	!-- START OF EMISSION LOD 1 (DEFAULT MODE)
1371
1372
1373	IF ( emiss_lod == 1 ) THEN
1374
1375	! for reference (ecc)
1376	! IF (TRIM(mode_emis) == "DEFAULT" .OR. TRIM(mode_emis) == "default") THEN
1377
1378	!
1379	!-- get number of emission categories
1380
1381	CALL get_dimension_length ( id_emis, emt_att%ncat, 'ncat' )
1382
1383	!-- READING IN EMISSION CATEGORIES INDICES
1384
1385	ALLOCATE ( emt_att%cat_index(emt_att%ncat) )
1386
1387	!
1388	!-- Retrieve variable data
1389
1390	CALL get_variable( id_emis, 'emission_cat_index', emt_att%cat_index )
1391
1392
1393	!
1394	!-- Loop through individual species to get basic information on
1395	!-- VOC/PM/NOX/SOX
1396
1397	!------------------------------------------------------------------------------
1398	!-- NOTE - CHECK ARRAY INDICES FOR READING IN NAMES AND SPECIES
1399	!-- IN LOD1 (DEFAULT MODE) FOR THE VARIOUS MODE SPLITS
1400	!-- AS ALL ID_EMIS CONDITIONALS HAVE BEEN REMOVED FROM GET_VAR
1401	!-- FUNCTIONS. IN THEORY THIS WOULD MEAN ALL ARRAYS SHOULD BE
1402	!-- READ FROM 0 to N-1 (C CONVENTION) AS OPPOSED TO 1 to N
1403	!-- (FORTRAN CONVENTION). KEEP THIS IN MIND !!
1404	!-- (ecc 20190424)
1405	!------------------------------------------------------------------------------
1406
1407	DO ispec = 1, emt_att%n_emiss_species
1408
1409	!
1410	!-- VOC DATA (name and composition)
1411
1412	IF ( TRIM(emt_att%species_name(ispec)) == "VOC" .OR. &
1413	TRIM(emt_att%species_name(ispec)) == "voc" ) THEN
1414
1415	!
1416	!-- VOC name
1417	CALL get_dimension_length ( id_emis, emt_att%nvoc, 'nvoc' )
1418	ALLOCATE ( emt_att%voc_name(emt_att%nvoc) )
1419	CALL get_variable ( id_emis,"emission_voc_name", &
1420	string_values, emt_att%nvoc )
1421	emt_att%voc_name = string_values
1422	IF ( ALLOCATED(string_values) ) DEALLOCATE (string_values)
1423
1424	!
1425	!-- VOC composition
1426
1427	ALLOCATE ( emt_att%voc_comp(emt_att%ncat,emt_att%nvoc) )
1428	CALL get_variable ( id_emis, "composition_voc", emt_att%voc_comp, &
1429	1, emt_att%ncat, 1, emt_att%nvoc )
1430
1431	ENDIF ! VOC
1432
1433	!
1434	!-- PM DATA (name and composition)
1435
1436	IF ( TRIM(emt_att%species_name(ispec)) == "PM" .OR. &
1437	TRIM(emt_att%species_name(ispec)) == "pm") THEN
1438
1439	!
1440	!-- PM name
1441
1442	CALL get_dimension_length ( id_emis, emt_att%npm, 'npm' )
1443	ALLOCATE ( emt_att%pm_name(emt_att%npm) )
1444	CALL get_variable ( id_emis, "pm_name", string_values, emt_att%npm )
1445	emt_att%pm_name = string_values
1446	IF ( ALLOCATED(string_values) ) DEALLOCATE (string_values)
1447
1448	!
1449	!-- PM composition (PM1, PM2.5 and PM10)
1450
1451	len_dims = 3 ! PM1, PM2.5, PM10
1452	ALLOCATE(emt_att%pm_comp(emt_att%ncat,emt_att%npm,len_dims))
1453	CALL get_variable ( id_emis, "composition_pm", emt_att%pm_comp, &
1454	1, emt_att%ncat, 1, emt_att%npm, 1, len_dims )
1455
1456	ENDIF ! PM
1457
1458	!
1459	!-- NOX (NO and NO2)
1460
1461	IF ( TRIM(emt_att%species_name(ispec)) == "NOX" .OR. &
1462	TRIM(emt_att%species_name(ispec)) == "nox" ) THEN
1463
1464	ALLOCATE ( emt_att%nox_comp(emt_att%ncat,emt_att%nnox) )
1465	CALL get_variable ( id_emis, "composition_nox", emt_att%nox_comp, &
1466	1, emt_att%ncat, 1, emt_att%nnox )
1467
1468	ENDIF ! NOX
1469
1470	!
1471	!-- SOX (SO2 and SO4)
1472
1473	IF ( TRIM(emt_att%species_name(ispec)) == "SOX" .OR. &
1474	TRIM(emt_att%species_name(ispec)) == "sox" ) THEN
1475
1476	ALLOCATE ( emt_att%sox_comp(emt_att%ncat,emt_att%nsox) )
1477	CALL get_variable ( id_emis, "composition_sox", emt_att%sox_comp, &
1478	1, emt_att%ncat, 1, emt_att%nsox )
1479
1480	ENDIF ! SOX
1481
1482	ENDDO ! do ispec
1483
1484	!
1485	!-- EMISSION TIME SCALING FACTORS (hourly and MDH data)
1486
1487	!
1488	!-- HOUR
1489	IF ( TRIM(time_fac_type) == "HOUR" .OR. &
1490	TRIM(time_fac_type) == "hour" ) THEN
1491
1492	CALL get_dimension_length ( id_emis, emt_att%nhoursyear, 'nhoursyear' )
1493	ALLOCATE ( emt_att%hourly_emis_time_factor(emt_att%ncat,emt_att%nhoursyear) )
1494	CALL get_variable ( id_emis, "emission_time_factors", &
1495	emt_att%hourly_emis_time_factor, &
1496	1, emt_att%ncat, 1, emt_att%nhoursyear )
1497
1498	!
1499	!-- MDH
1500
1501	ELSE IF ( TRIM(time_fac_type) == "MDH" .OR. &
1502	TRIM(time_fac_type) == "mdh" ) THEN
1503
1504	CALL get_dimension_length ( id_emis, emt_att%nmonthdayhour, 'nmonthdayhour' )
1505	ALLOCATE ( emt_att%mdh_emis_time_factor(emt_att%ncat,emt_att%nmonthdayhour) )
1506	CALL get_variable ( id_emis, "emission_time_factors", &
1507	emt_att%mdh_emis_time_factor, &
1508	1, emt_att%ncat, 1, emt_att%nmonthdayhour )
1509
1510	!
1511	!-- ERROR (time factor undefined)
1512
1513	ELSE
1514
1515	message_string = 'We are in the DEFAULT chemistry emissions mode: ' // &
1516	' !no time-factor type specified!' // &
1517	'Please specify the value of time_fac_type:' // &
1518	' either "MDH" or "HOUR"'
1519	CALL message( 'netcdf_data_input_chemistry_data', 'CM0200', 2, 2, 0, 6, 0 )
1520
1521
1522	ENDIF ! time_fac_type
1523
1524	!
1525	!-- read in default (LOD1) emissions from chemisty netCDF file per species
1526
1527	!
1528	!-- NOTE - at the moment the data is read in per species, but in the future it would
1529	!-- be much more sensible to read in per species per time step to reduce
1530	!-- memory consumption and, to a lesser degree, dimensionality of data exchange
1531	!-- (I expect this will be necessary when the problem size is large)
1532
1533	DO ispec = 1, emt_att%n_emiss_species
1534
1535	!
1536	!-- allocate space for species specific emission values
1537	!-- NOTE - this array is extended by 1 cell in each horizontal direction
1538	!-- to compensate for an apparent linear offset. The reason of this
1539	!-- offset is not known but it has been determined to take place beyond the
1540	!-- scope of this module, and has little to do with index conventions.
1541	!-- That is, setting the array horizontal limit from nx0:nx1 to 1:(nx1-nx0+1)
1542	!-- or nx0+1:nx1+1 did not result in correct or definite behavior
1543	!-- This must be looked at at some point by the Hannover team but for now
1544	!-- this workaround is deemed reasonable (ecc 20190417)
1545
1546	IF ( .NOT. ALLOCATED ( emt(ispec)%default_emission_data ) ) THEN
1547	ALLOCATE ( emt(ispec)%default_emission_data(emt_att%ncat,nys:nyn+1,nxl:nxr+1) )
1548	ENDIF
1549	!
1550	!-- allocate dummy variable w/ index order identical to that shown in the netCDF header
1551
1552	ALLOCATE ( dum_var_5d(1,nys:nyn,nxl:nxr,1,emt_att%ncat) )
1553	!
1554	!-- get variable. be very careful
1555	!-- I am using get_variable_5d_real_dynamic (note logical argument at the end)
1556	!-- 1) use Fortran index convention (i.e., 1 to N)
1557	!-- 2) index order must be in reverse order from above allocation order
1558
1559	CALL get_variable ( id_emis, "emission_values", dum_var_5d, &
1560	1, ispec, nxl+1, nys+1, 1, &
1561	emt_att%ncat, 1, nxr-nxl+1, nyn-nys+1, emt_att%dt_emission, &
1562	.FALSE. )
1563	!
1564	!-- assign temp array to data structure then deallocate temp array
1565	!-- NOTE - indices are shifted from nx0:nx1 to nx0+1:nx1+1 to offset
1566	!-- the emission data array to counter said domain offset
1567	!-- (ecc 20190417)
1568
1569	DO k = 1, emt_att%ncat
1570	DO j = nys+1, nyn+1
1571	DO i = nxl+1, nxr+1
1572	emt(ispec)%default_emission_data(k,j,i) = dum_var_5d(1,j-1,i-1,1,k)
1573	ENDDO
1574	ENDDO
1575	ENDDO
1576
1577	DEALLOCATE ( dum_var_5d )
1578
1579	ENDDO ! ispec
1580	!
1581	!-- UNITS
1582
1583	CALL get_attribute(id_emis,"units",emt_att%units,.FALSE.,"emission_values")
1584
1585	!
1586	!-- END DEFAULT MODE
1587
1588
1589	!
1590	!-- START LOD 2 (PRE-PROCESSED MODE)
1591
1592	ELSE IF ( emiss_lod == 2 ) THEN
1593
1594	! for reference (ecc)
1595	! ELSE IF (TRIM(mode_emis) == "PRE-PROCESSED" .OR. TRIM(mode_emis) == "pre-processed") THEN
1596
1597	!
1598	!-- For LOD 2 only VOC and emission data need be read
1599
1600	!------------------------------------------------------------------------------
1601	!-- NOTE - CHECK ARRAY INDICES FOR READING IN NAMES AND SPECIES
1602	!-- IN LOD2 (PRE-PROCESSED MODE) FOR THE VARIOUS MODE SPLITS
1603	!-- AS ALL ID_EMIS CONDITIONALS HAVE BEEN REMOVED FROM GET_VAR
1604	!-- FUNCTIONS. IN THEORY THIS WOULD MEAN ALL ARRAYS SHOULD BE
1605	!-- READ FROM 0 to N-1 (C CONVENTION) AS OPPOSED TO 1 to N
1606	!-- (FORTRAN CONVENTION). KEEP THIS IN MIND !!
1607	!-- (ecc 20190424)
1608	!------------------------------------------------------------------------------
1609
1610	DO ispec = 1, emt_att%n_emiss_species
1611
1612	!
1613	!-- VOC DATA (name and composition)
1614
1615	IF ( TRIM(emt_att%species_name(ispec)) == "VOC" .OR. &
1616	TRIM(emt_att%species_name(ispec)) == "voc" ) THEN
1617
1618	!
1619	!-- VOC name
1620	CALL get_dimension_length ( id_emis, emt_att%nvoc, 'nvoc' )
1621	ALLOCATE ( emt_att%voc_name(emt_att%nvoc) )
1622	CALL get_variable ( id_emis, "emission_voc_name", &
1623	string_values, emt_att%nvoc)
1624	emt_att%voc_name = string_values
1625	IF ( ALLOCATED(string_values) ) DEALLOCATE (string_values)
1626
1627	!
1628	!-- VOC composition
1629
1630	ALLOCATE ( emt_att%voc_comp(emt_att%ncat,emt_att%nvoc) )
1631	CALL get_variable ( id_emis, "composition_voc", emt_att%voc_comp, &
1632	1, emt_att%ncat, 1, emt_att%nvoc )
1633	ENDIF ! VOC
1634
1635	ENDDO ! ispec
1636
1637	!
1638	!-- EMISSION DATA
1639
1640	CALL get_dimension_length ( id_emis, emt_att%dt_emission, 'time' )
1641
1642	!
1643	!-- read in pre-processed (LOD2) emissions from chemisty netCDF file per species
1644
1645	!
1646	!-- NOTE - at the moment the data is read in per species, but in the future it would
1647	!-- be much more sensible to read in per species per time step to reduce
1648	!-- memory consumption and, to a lesser degree, dimensionality of data exchange
1649	!-- (I expect this will be necessary when the problem size is large)
1650
1651	DO ispec = 1, emt_att%n_emiss_species
1652
1653	!
1654	!-- allocate space for species specific emission values
1655	!-- NOTE - this array is extended by 1 cell in each horizontal direction
1656	!-- to compensate for an apparent linear offset. The reason of this
1657	!-- offset is not known but it has been determined to take place beyond the
1658	!-- scope of this module, and has little to do with index conventions.
1659	!-- That is, setting the array horizontal limit from nx0:nx1 to 1:(nx1-nx0+1)
1660	!-- or nx0+1:nx1+1 did not result in correct or definite behavior
1661	!-- This must be looked at at some point by the Hannover team but for now
1662	!-- this workaround is deemed reasonable (ecc 20190417)
1663
1664	IF ( .NOT. ALLOCATED( emt(ispec)%preproc_emission_data ) ) THEN
1665	ALLOCATE( emt(ispec)%preproc_emission_data( &
1666	emt_att%dt_emission, 1, nys:nyn+1, nxl:nxr+1) )
1667	ENDIF
1668	!
1669	!-- allocate dummy variable w/ index order identical to that shown in the netCDF header
1670
1671	ALLOCATE ( dum_var_5d(emt_att%dt_emission,1,nys:nyn,nxl:nxr,1) )
1672	!
1673	!-- get variable. be very careful
1674	!-- I am using get_variable_5d_real_dynamic (note logical argument at the end)
1675	!-- 1) use Fortran index convention (i.e., 1 to N)
1676	!-- 2) index order must be in reverse order from above allocation order
1677
1678	CALL get_variable ( id_emis, "emission_values", dum_var_5d, &
1679	ispec, nxl+1, nys+1, 1, 1, &
1680	1, nxr-nxl+1, nyn-nys+1, 1, emt_att%dt_emission, &
1681	.FALSE. )
1682	!
1683	!-- assign temp array to data structure then deallocate temp array
1684	!-- NOTE - indices are shifted from nx0:nx1 to nx0+1:nx1+1 to offset
1685	!-- the emission data array to counter said unkonwn offset
1686	!-- (ecc 20190417)
1687
1688	DO k = 1, emt_att%dt_emission
1689	DO j = nys+1, nyn+1
1690	DO i = nxl+1, nxr+1
1691	emt(ispec)%preproc_emission_data(k,1,j,i) = dum_var_5d(k,1,j-1,i-1,1)
1692	ENDDO
1693	ENDDO
1694	ENDDO
1695
1696	DEALLOCATE ( dum_var_5d )
1697
1698	ENDDO ! ispec
1699	!
1700	!-- UNITS
1701
1702	CALL get_attribute ( id_emis, "units", emt_att%units, .FALSE. , "emission_values" )
1703
1704	ENDIF ! LOD1 & LOD2 (default and pre-processed mode)
1705
1706	CALL close_input_file (id_emis)
1707
1708	#endif
1709
1710	ENDIF ! LOD0 (parameterized mode)
1711
1712	END SUBROUTINE netcdf_data_input_chemistry_data
1713
1714
1715	!------------------------------------------------------------------------------!
1716	! Description:
1717	! ------------
1718	!> Reads surface classification data, such as vegetation and soil type, etc. .
1719	!------------------------------------------------------------------------------!
1720	SUBROUTINE netcdf_data_input_surface_data
1721
1722	USE control_parameters, &
1723	ONLY: land_surface, urban_surface
1724
1725	USE indices, &
1726	ONLY: nbgp, nxl, nxr, nyn, nys
1727
1728
1729	IMPLICIT NONE
1730
1731	CHARACTER(LEN=100), DIMENSION(:), ALLOCATABLE :: var_names !< variable names in static input file
1732
1733	INTEGER(iwp) :: id_surf !< NetCDF id of input file
1734	INTEGER(iwp) :: k !< running index along z-direction
1735	INTEGER(iwp) :: k2 !< running index
1736	INTEGER(iwp) :: num_vars !< number of variables in input file
1737	INTEGER(iwp) :: nz_soil !< number of soil layers in file
1738
1739	!
1740	!-- If not static input file is available, skip this routine
1741	IF ( .NOT. input_pids_static ) RETURN
1742	!
1743	!-- Measure CPU time
1744	CALL cpu_log( log_point_s(82), 'NetCDF input', 'start' )
1745	!
1746	!-- Skip the following if no land-surface or urban-surface module are
1747	!-- applied. This case, no one of the following variables is used anyway.
1748	IF ( .NOT. land_surface .AND. .NOT. urban_surface ) RETURN
1749
1750	#if defined ( __netcdf )
1751	!
1752	!-- Open file in read-only mode
1753	CALL open_read_file( TRIM( input_file_static ) // &
1754	TRIM( coupling_char ) , id_surf )
1755	!
1756	!-- Inquire all variable names.
1757	!-- This will be used to check whether an optional input variable exist
1758	!-- or not.
1759	CALL inquire_num_variables( id_surf, num_vars )
1760
1761	ALLOCATE( var_names(1:num_vars) )
1762	CALL inquire_variable_names( id_surf, var_names )
1763	!
1764	!-- Read vegetation type and required attributes
1765	IF ( check_existence( var_names, 'vegetation_type' ) ) THEN
1766	vegetation_type_f%from_file = .TRUE.
1767	CALL get_attribute( id_surf, char_fill, &
1768	vegetation_type_f%fill, &
1769	.FALSE., 'vegetation_type' )
1770
1771	ALLOCATE ( vegetation_type_f%var(nys:nyn,nxl:nxr) )
1772
1773	CALL get_variable( id_surf, 'vegetation_type', &
1774	vegetation_type_f%var, nxl, nxr, nys, nyn )
1775	ELSE
1776	vegetation_type_f%from_file = .FALSE.
1777	ENDIF
1778
1779	!
1780	!-- Read soil type and required attributes
1781	IF ( check_existence( var_names, 'soil_type' ) ) THEN
1782	soil_type_f%from_file = .TRUE.
1783	!
1784	!-- Note, lod is currently not on file; skip for the moment
1785	! CALL get_attribute( id_surf, char_lod, &
1786	! soil_type_f%lod, &
1787	! .FALSE., 'soil_type' )
1788	CALL get_attribute( id_surf, char_fill, &
1789	soil_type_f%fill, &
1790	.FALSE., 'soil_type' )
1791
1792	IF ( soil_type_f%lod == 1 ) THEN
1793
1794	ALLOCATE ( soil_type_f%var_2d(nys:nyn,nxl:nxr) )
1795
1796	CALL get_variable( id_surf, 'soil_type', soil_type_f%var_2d, &
1797	nxl, nxr, nys, nyn )
1798
1799	ELSEIF ( soil_type_f%lod == 2 ) THEN
1800	!
1801	!-- Obtain number of soil layers from file.
1802	CALL get_dimension_length( id_surf, nz_soil, 'zsoil' )
1803
1804	ALLOCATE ( soil_type_f%var_3d(0:nz_soil,nys:nyn,nxl:nxr) )
1805
1806	CALL get_variable( id_surf, 'soil_type', soil_type_f%var_3d, &
1807	nxl, nxr, nys, nyn, 0, nz_soil )
1808
1809	ENDIF
1810	ELSE
1811	soil_type_f%from_file = .FALSE.
1812	ENDIF
1813
1814	!
1815	!-- Read pavement type and required attributes
1816	IF ( check_existence( var_names, 'pavement_type' ) ) THEN
1817	pavement_type_f%from_file = .TRUE.
1818	CALL get_attribute( id_surf, char_fill, &
1819	pavement_type_f%fill, .FALSE., &
1820	'pavement_type' )
1821
1822	ALLOCATE ( pavement_type_f%var(nys:nyn,nxl:nxr) )
1823
1824	CALL get_variable( id_surf, 'pavement_type', pavement_type_f%var, &
1825	nxl, nxr, nys, nyn )
1826	ELSE
1827	pavement_type_f%from_file = .FALSE.
1828	ENDIF
1829
1830	!
1831	!-- Read water type and required attributes
1832	IF ( check_existence( var_names, 'water_type' ) ) THEN
1833	water_type_f%from_file = .TRUE.
1834	CALL get_attribute( id_surf, char_fill, water_type_f%fill, &
1835	.FALSE., 'water_type' )
1836
1837	ALLOCATE ( water_type_f%var(nys:nyn,nxl:nxr) )
1838
1839	CALL get_variable( id_surf, 'water_type', water_type_f%var, &
1840	nxl, nxr, nys, nyn )
1841
1842	ELSE
1843	water_type_f%from_file = .FALSE.
1844	ENDIF
1845	!
1846	!-- Read relative surface fractions of vegetation, pavement and water.
1847	IF ( check_existence( var_names, 'surface_fraction' ) ) THEN
1848	surface_fraction_f%from_file = .TRUE.
1849	CALL get_attribute( id_surf, char_fill, &
1850	surface_fraction_f%fill, &
1851	.FALSE., 'surface_fraction' )
1852	!
1853	!-- Inquire number of surface fractions
1854	CALL get_dimension_length( id_surf, &
1855	surface_fraction_f%nf, &
1856	'nsurface_fraction' )
1857	!
1858	!-- Allocate dimension array and input array for surface fractions
1859	ALLOCATE( surface_fraction_f%nfracs(0:surface_fraction_f%nf-1) )
1860	ALLOCATE( surface_fraction_f%frac(0:surface_fraction_f%nf-1, &
1861	nys:nyn,nxl:nxr) )
1862	!
1863	!-- Get dimension of surface fractions
1864	CALL get_variable( id_surf, 'nsurface_fraction', &
1865	surface_fraction_f%nfracs )
1866	!
1867	!-- Read surface fractions
1868	CALL get_variable( id_surf, 'surface_fraction', &
1869	surface_fraction_f%frac, nxl, nxr, nys, nyn, &
1870	0, surface_fraction_f%nf-1 )
1871	ELSE
1872	surface_fraction_f%from_file = .FALSE.
1873	ENDIF
1874	!
1875	!-- Read building parameters and related information
1876	IF ( check_existence( var_names, 'building_pars' ) ) THEN
1877	building_pars_f%from_file = .TRUE.
1878	CALL get_attribute( id_surf, char_fill, &
1879	building_pars_f%fill, &
1880	.FALSE., 'building_pars' )
1881	!
1882	!-- Inquire number of building parameters
1883	CALL get_dimension_length( id_surf, &
1884	building_pars_f%np, &
1885	'nbuilding_pars' )
1886	!
1887	!-- Allocate dimension array and input array for building parameters
1888	ALLOCATE( building_pars_f%pars(0:building_pars_f%np-1) )
1889	ALLOCATE( building_pars_f%pars_xy(0:building_pars_f%np-1, &
1890	nys:nyn,nxl:nxr) )
1891	!
1892	!-- Get dimension of building parameters
1893	CALL get_variable( id_surf, 'nbuilding_pars', &
1894	building_pars_f%pars )
1895	!
1896	!-- Read building_pars
1897	CALL get_variable( id_surf, 'building_pars', &
1898	building_pars_f%pars_xy, nxl, nxr, nys, nyn, &
1899	0, building_pars_f%np-1 )
1900	ELSE
1901	building_pars_f%from_file = .FALSE.
1902	ENDIF
1903	!
1904	!-- Read building surface parameters
1905	IF ( check_existence( var_names, 'building_surface_pars' ) ) THEN
1906	building_surface_pars_f%from_file = .TRUE.
1907	CALL get_attribute( id_surf, char_fill, &
1908	building_surface_pars_f%fill, &
1909	.FALSE., 'building_surface_pars' )
1910	!
1911	!-- Read building_surface_pars
1912	CALL get_variable_surf( id_surf, 'building_surface_pars', &
1913	building_surface_pars_f )
1914	ELSE
1915	building_surface_pars_f%from_file = .FALSE.
1916	ENDIF
1917
1918	!
1919	!-- Read albedo type and required attributes
1920	IF ( check_existence( var_names, 'albedo_type' ) ) THEN
1921	albedo_type_f%from_file = .TRUE.
1922	CALL get_attribute( id_surf, char_fill, albedo_type_f%fill, &
1923	.FALSE., 'albedo_type' )
1924
1925	ALLOCATE ( albedo_type_f%var(nys:nyn,nxl:nxr) )
1926
1927	CALL get_variable( id_surf, 'albedo_type', albedo_type_f%var, &
1928	nxl, nxr, nys, nyn )
1929	ELSE
1930	albedo_type_f%from_file = .FALSE.
1931	ENDIF
1932	!
1933	!-- Read albedo parameters and related information
1934	IF ( check_existence( var_names, 'albedo_pars' ) ) THEN
1935	albedo_pars_f%from_file = .TRUE.
1936	CALL get_attribute( id_surf, char_fill, albedo_pars_f%fill, &
1937	.FALSE., 'albedo_pars' )
1938	!
1939	!-- Inquire number of albedo parameters
1940	CALL get_dimension_length( id_surf, &
1941	albedo_pars_f%np, &
1942	'nalbedo_pars' )
1943	!
1944	!-- Allocate dimension array and input array for albedo parameters
1945	ALLOCATE( albedo_pars_f%pars(0:albedo_pars_f%np-1) )
1946	ALLOCATE( albedo_pars_f%pars_xy(0:albedo_pars_f%np-1, &
1947	nys:nyn,nxl:nxr) )
1948	!
1949	!-- Get dimension of albedo parameters
1950	CALL get_variable( id_surf, 'nalbedo_pars', albedo_pars_f%pars )
1951
1952	CALL get_variable( id_surf, 'albedo_pars', albedo_pars_f%pars_xy, &
1953	nxl, nxr, nys, nyn, &
1954	0, albedo_pars_f%np-1 )
1955	ELSE
1956	albedo_pars_f%from_file = .FALSE.
1957	ENDIF
1958
1959	!
1960	!-- Read pavement parameters and related information
1961	IF ( check_existence( var_names, 'pavement_pars' ) ) THEN
1962	pavement_pars_f%from_file = .TRUE.
1963	CALL get_attribute( id_surf, char_fill, &
1964	pavement_pars_f%fill, &
1965	.FALSE., 'pavement_pars' )
1966	!
1967	!-- Inquire number of pavement parameters
1968	CALL get_dimension_length( id_surf, &
1969	pavement_pars_f%np, &
1970	'npavement_pars' )
1971	!
1972	!-- Allocate dimension array and input array for pavement parameters
1973	ALLOCATE( pavement_pars_f%pars(0:pavement_pars_f%np-1) )
1974	ALLOCATE( pavement_pars_f%pars_xy(0:pavement_pars_f%np-1, &
1975	nys:nyn,nxl:nxr) )
1976	!
1977	!-- Get dimension of pavement parameters
1978	CALL get_variable( id_surf, 'npavement_pars', pavement_pars_f%pars )
1979
1980	CALL get_variable( id_surf, 'pavement_pars', pavement_pars_f%pars_xy,&
1981	nxl, nxr, nys, nyn, &
1982	0, pavement_pars_f%np-1 )
1983	ELSE
1984	pavement_pars_f%from_file = .FALSE.
1985	ENDIF
1986
1987	!
1988	!-- Read pavement subsurface parameters and related information
1989	IF ( check_existence( var_names, 'pavement_subsurface_pars' ) ) &
1990	THEN
1991	pavement_subsurface_pars_f%from_file = .TRUE.
1992	CALL get_attribute( id_surf, char_fill, &
1993	pavement_subsurface_pars_f%fill, &
1994	.FALSE., 'pavement_subsurface_pars' )
1995	!
1996	!-- Inquire number of parameters
1997	CALL get_dimension_length( id_surf, &
1998	pavement_subsurface_pars_f%np, &
1999	'npavement_subsurface_pars' )
2000	!
2001	!-- Inquire number of soil layers
2002	CALL get_dimension_length( id_surf, &
2003	pavement_subsurface_pars_f%nz, &
2004	'zsoil' )
2005	!
2006	!-- Allocate dimension array and input array for pavement parameters
2007	ALLOCATE( pavement_subsurface_pars_f%pars &
2008	(0:pavement_subsurface_pars_f%np-1) )
2009	ALLOCATE( pavement_subsurface_pars_f%pars_xyz &
2010	(0:pavement_subsurface_pars_f%np-1, &
2011	0:pavement_subsurface_pars_f%nz-1, &
2012	nys:nyn,nxl:nxr) )
2013	!
2014	!-- Get dimension of pavement parameters
2015	CALL get_variable( id_surf, 'npavement_subsurface_pars', &
2016	pavement_subsurface_pars_f%pars )
2017
2018	CALL get_variable( id_surf, 'pavement_subsurface_pars', &
2019	pavement_subsurface_pars_f%pars_xyz, &
2020	nxl, nxr, nys, nyn, &
2021	0, pavement_subsurface_pars_f%nz-1, &
2022	0, pavement_subsurface_pars_f%np-1 )
2023	ELSE
2024	pavement_subsurface_pars_f%from_file = .FALSE.
2025	ENDIF
2026
2027
2028	!
2029	!-- Read vegetation parameters and related information
2030	IF ( check_existence( var_names, 'vegetation_pars' ) ) THEN
2031	vegetation_pars_f%from_file = .TRUE.
2032	CALL get_attribute( id_surf, char_fill, &
2033	vegetation_pars_f%fill, &
2034	.FALSE., 'vegetation_pars' )
2035	!
2036	!-- Inquire number of vegetation parameters
2037	CALL get_dimension_length( id_surf, &
2038	vegetation_pars_f%np, &
2039	'nvegetation_pars' )
2040	!
2041	!-- Allocate dimension array and input array for surface fractions
2042	ALLOCATE( vegetation_pars_f%pars(0:vegetation_pars_f%np-1) )
2043	ALLOCATE( vegetation_pars_f%pars_xy(0:vegetation_pars_f%np-1, &
2044	nys:nyn,nxl:nxr) )
2045	!
2046	!-- Get dimension of the parameters
2047	CALL get_variable( id_surf, 'nvegetation_pars', &
2048	vegetation_pars_f%pars )
2049
2050	CALL get_variable( id_surf, 'vegetation_pars', &
2051	vegetation_pars_f%pars_xy, nxl, nxr, nys, nyn, &
2052	0, vegetation_pars_f%np-1 )
2053	ELSE
2054	vegetation_pars_f%from_file = .FALSE.
2055	ENDIF
2056
2057	!
2058	!-- Read root parameters/distribution and related information
2059	IF ( check_existence( var_names, 'soil_pars' ) ) THEN
2060	soil_pars_f%from_file = .TRUE.
2061	CALL get_attribute( id_surf, char_fill, &
2062	soil_pars_f%fill, &
2063	.FALSE., 'soil_pars' )
2064
2065	CALL get_attribute( id_surf, char_lod, &
2066	soil_pars_f%lod, &
2067	.FALSE., 'soil_pars' )
2068
2069	!
2070	!-- Inquire number of soil parameters
2071	CALL get_dimension_length( id_surf, &
2072	soil_pars_f%np, &
2073	'nsoil_pars' )
2074	!
2075	!-- Read parameters array
2076	ALLOCATE( soil_pars_f%pars(0:soil_pars_f%np-1) )
2077	CALL get_variable( id_surf, 'nsoil_pars', soil_pars_f%pars )
2078
2079	!
2080	!-- In case of level of detail 2, also inquire number of vertical
2081	!-- soil layers, allocate memory and read the respective dimension
2082	IF ( soil_pars_f%lod == 2 ) THEN
2083	CALL get_dimension_length( id_surf, &
2084	soil_pars_f%nz, &
2085	'zsoil' )
2086
2087	ALLOCATE( soil_pars_f%layers(0:soil_pars_f%nz-1) )
2088	CALL get_variable( id_surf, 'zsoil', soil_pars_f%layers )
2089
2090	ENDIF
2091
2092	!
2093	!-- Read soil parameters, depending on level of detail
2094	IF ( soil_pars_f%lod == 1 ) THEN
2095	ALLOCATE( soil_pars_f%pars_xy(0:soil_pars_f%np-1, &
2096	nys:nyn,nxl:nxr) )
2097
2098	CALL get_variable( id_surf, 'soil_pars', soil_pars_f%pars_xy, &
2099	nxl, nxr, nys, nyn, 0, soil_pars_f%np-1 )
2100
2101	ELSEIF ( soil_pars_f%lod == 2 ) THEN
2102	ALLOCATE( soil_pars_f%pars_xyz(0:soil_pars_f%np-1, &
2103	0:soil_pars_f%nz-1, &
2104	nys:nyn,nxl:nxr) )
2105	CALL get_variable( id_surf, 'soil_pars', &
2106	soil_pars_f%pars_xyz, &
2107	nxl, nxr, nys, nyn, 0, soil_pars_f%nz-1, &
2108	0, soil_pars_f%np-1 )
2109
2110	ENDIF
2111	ELSE
2112	soil_pars_f%from_file = .FALSE.
2113	ENDIF
2114
2115	!
2116	!-- Read water parameters and related information
2117	IF ( check_existence( var_names, 'water_pars' ) ) THEN
2118	water_pars_f%from_file = .TRUE.
2119	CALL get_attribute( id_surf, char_fill, &
2120	water_pars_f%fill, &
2121	.FALSE., 'water_pars' )
2122	!
2123	!-- Inquire number of water parameters
2124	CALL get_dimension_length( id_surf, &
2125	water_pars_f%np, &
2126	'nwater_pars' )
2127	!
2128	!-- Allocate dimension array and input array for water parameters
2129	ALLOCATE( water_pars_f%pars(0:water_pars_f%np-1) )
2130	ALLOCATE( water_pars_f%pars_xy(0:water_pars_f%np-1, &
2131	nys:nyn,nxl:nxr) )
2132	!
2133	!-- Get dimension of water parameters
2134	CALL get_variable( id_surf, 'nwater_pars', water_pars_f%pars )
2135
2136	CALL get_variable( id_surf, 'water_pars', water_pars_f%pars_xy, &
2137	nxl, nxr, nys, nyn, 0, water_pars_f%np-1 )
2138	ELSE
2139	water_pars_f%from_file = .FALSE.
2140	ENDIF
2141	!
2142	!-- Read root area density - parametrized vegetation
2143	IF ( check_existence( var_names, 'root_area_dens_s' ) ) THEN
2144	root_area_density_lsm_f%from_file = .TRUE.
2145	CALL get_attribute( id_surf, char_fill, &
2146	root_area_density_lsm_f%fill, &
2147	.FALSE., 'root_area_dens_s' )
2148	!
2149	!-- Obtain number of soil layers from file and allocate variable
2150	CALL get_dimension_length( id_surf, &
2151	root_area_density_lsm_f%nz, &
2152	'zsoil' )
2153	ALLOCATE( root_area_density_lsm_f%var &
2154	(0:root_area_density_lsm_f%nz-1, &
2155	nys:nyn,nxl:nxr) )
2156
2157	!
2158	!-- Read root-area density
2159	CALL get_variable( id_surf, 'root_area_dens_s', &
2160	root_area_density_lsm_f%var, &
2161	nxl, nxr, nys, nyn, &
2162	0, root_area_density_lsm_f%nz-1 )
2163
2164	ELSE
2165	root_area_density_lsm_f%from_file = .FALSE.
2166	ENDIF
2167	!
2168	!-- Read street type and street crossing
2169	IF ( check_existence( var_names, 'street_type' ) ) THEN
2170	street_type_f%from_file = .TRUE.
2171	CALL get_attribute( id_surf, char_fill, &
2172	street_type_f%fill, .FALSE., &
2173	'street_type' )
2174
2175	ALLOCATE ( street_type_f%var(nys:nyn,nxl:nxr) )
2176
2177	CALL get_variable( id_surf, 'street_type', street_type_f%var, &
2178	nxl, nxr, nys, nyn )
2179	ELSE
2180	street_type_f%from_file = .FALSE.
2181	ENDIF
2182
2183	IF ( check_existence( var_names, 'street_crossing' ) ) THEN
2184	street_crossing_f%from_file = .TRUE.
2185	CALL get_attribute( id_surf, char_fill, &
2186	street_crossing_f%fill, .FALSE., &
2187	'street_crossing' )
2188
2189	ALLOCATE ( street_crossing_f%var(nys:nyn,nxl:nxr) )
2190
2191	CALL get_variable( id_surf, 'street_crossing', &
2192	street_crossing_f%var, nxl, nxr, nys, nyn )
2193
2194	ELSE
2195	street_crossing_f%from_file = .FALSE.
2196	ENDIF
2197	!
2198	!-- Still missing: root_resolved and building_surface_pars.
2199	!-- Will be implemented as soon as they are available.
2200
2201	!
2202	!-- Finally, close input file
2203	CALL close_input_file( id_surf )
2204	#endif
2205	!
2206	!-- End of CPU measurement
2207	CALL cpu_log( log_point_s(82), 'NetCDF input', 'stop' )
2208	!
2209	!-- Exchange ghost points for surface variables. Therefore, resize
2210	!-- variables.
2211	IF ( albedo_type_f%from_file ) THEN
2212	CALL resize_array_2d_int8( albedo_type_f%var, nys, nyn, nxl, nxr )
2213	CALL exchange_horiz_2d_byte( albedo_type_f%var, nys, nyn, nxl, nxr, &
2214	nbgp )
2215	ENDIF
2216	IF ( pavement_type_f%from_file ) THEN
2217	CALL resize_array_2d_int8( pavement_type_f%var, nys, nyn, nxl, nxr )
2218	CALL exchange_horiz_2d_byte( pavement_type_f%var, nys, nyn, nxl, nxr,&
2219	nbgp )
2220	ENDIF
2221	IF ( soil_type_f%from_file .AND. ALLOCATED( soil_type_f%var_2d ) ) THEN
2222	CALL resize_array_2d_int8( soil_type_f%var_2d, nys, nyn, nxl, nxr )
2223	CALL exchange_horiz_2d_byte( soil_type_f%var_2d, nys, nyn, nxl, nxr, &
2224	nbgp )
2225	ENDIF
2226	IF ( vegetation_type_f%from_file ) THEN
2227	CALL resize_array_2d_int8( vegetation_type_f%var, nys, nyn, nxl, nxr )
2228	CALL exchange_horiz_2d_byte( vegetation_type_f%var, nys, nyn, nxl, &
2229	nxr, nbgp )
2230	ENDIF
2231	IF ( water_type_f%from_file ) THEN
2232	CALL resize_array_2d_int8( water_type_f%var, nys, nyn, nxl, nxr )
2233	CALL exchange_horiz_2d_byte( water_type_f%var, nys, nyn, nxl, nxr, &
2234	nbgp )
2235	ENDIF
2236	!
2237	!-- Exchange ghost points for 3/4-D variables. For the sake of simplicity,
2238	!-- loop further dimensions to use 2D exchange routines. Unfortunately this
2239	!-- is necessary, else new MPI-data types need to be introduced just for
2240	!-- 2 variables.
2241	IF ( soil_type_f%from_file .AND. ALLOCATED( soil_type_f%var_3d ) ) &
2242	THEN
2243	CALL resize_array_3d_int8( soil_type_f%var_3d, 0, nz_soil, &
2244	nys, nyn, nxl, nxr )
2245	DO k = 0, nz_soil
2246	CALL exchange_horiz_2d_int( &
2247	soil_type_f%var_3d(k,:,:), nys, nyn, nxl, nxr, nbgp )
2248	ENDDO
2249	ENDIF
2250
2251	IF ( surface_fraction_f%from_file ) THEN
2252	CALL resize_array_3d_real( surface_fraction_f%frac, &
2253	0, surface_fraction_f%nf-1, &
2254	nys, nyn, nxl, nxr )
2255	DO k = 0, surface_fraction_f%nf-1
2256	CALL exchange_horiz_2d( surface_fraction_f%frac(k,:,:), nbgp )
2257	ENDDO
2258	ENDIF
2259
2260	IF ( building_pars_f%from_file ) THEN
2261	CALL resize_array_3d_real( building_pars_f%pars_xy, &
2262	0, building_pars_f%np-1, &
2263	nys, nyn, nxl, nxr )
2264	DO k = 0, building_pars_f%np-1
2265	CALL exchange_horiz_2d( building_pars_f%pars_xy(k,:,:), nbgp )
2266	ENDDO
2267	ENDIF
2268
2269	IF ( albedo_pars_f%from_file ) THEN
2270	CALL resize_array_3d_real( albedo_pars_f%pars_xy, &
2271	0, albedo_pars_f%np-1, &
2272	nys, nyn, nxl, nxr )
2273	DO k = 0, albedo_pars_f%np-1
2274	CALL exchange_horiz_2d( albedo_pars_f%pars_xy(k,:,:), nbgp )
2275	ENDDO
2276	ENDIF
2277
2278	IF ( pavement_pars_f%from_file ) THEN
2279	CALL resize_array_3d_real( pavement_pars_f%pars_xy, &
2280	0, pavement_pars_f%np-1, &
2281	nys, nyn, nxl, nxr )
2282	DO k = 0, pavement_pars_f%np-1
2283	CALL exchange_horiz_2d( pavement_pars_f%pars_xy(k,:,:), nbgp )
2284	ENDDO
2285	ENDIF
2286
2287	IF ( vegetation_pars_f%from_file ) THEN
2288	CALL resize_array_3d_real( vegetation_pars_f%pars_xy, &
2289	0, vegetation_pars_f%np-1, &
2290	nys, nyn, nxl, nxr )
2291	DO k = 0, vegetation_pars_f%np-1
2292	CALL exchange_horiz_2d( vegetation_pars_f%pars_xy(k,:,:), nbgp )
2293	ENDDO
2294	ENDIF
2295
2296	IF ( water_pars_f%from_file ) THEN
2297	CALL resize_array_3d_real( water_pars_f%pars_xy, &
2298	0, water_pars_f%np-1, &
2299	nys, nyn, nxl, nxr )
2300	DO k = 0, water_pars_f%np-1
2301	CALL exchange_horiz_2d( water_pars_f%pars_xy(k,:,:), nbgp )
2302	ENDDO
2303	ENDIF
2304
2305	IF ( root_area_density_lsm_f%from_file ) THEN
2306	CALL resize_array_3d_real( root_area_density_lsm_f%var, &
2307	0, root_area_density_lsm_f%nz-1, &
2308	nys, nyn, nxl, nxr )
2309	DO k = 0, root_area_density_lsm_f%nz-1
2310	CALL exchange_horiz_2d( root_area_density_lsm_f%var(k,:,:), nbgp )
2311	ENDDO
2312	ENDIF
2313
2314	IF ( soil_pars_f%from_file ) THEN
2315	IF ( soil_pars_f%lod == 1 ) THEN
2316
2317	CALL resize_array_3d_real( soil_pars_f%pars_xy, &
2318	0, soil_pars_f%np-1, &
2319	nys, nyn, nxl, nxr )
2320	DO k = 0, soil_pars_f%np-1
2321	CALL exchange_horiz_2d( soil_pars_f%pars_xy(k,:,:), nbgp )
2322	ENDDO
2323
2324	ELSEIF ( soil_pars_f%lod == 2 ) THEN
2325	CALL resize_array_4d_real( soil_pars_f%pars_xyz, &
2326	0, soil_pars_f%np-1, &
2327	0, soil_pars_f%nz-1, &
2328	nys, nyn, nxl, nxr )
2329
2330	DO k2 = 0, soil_pars_f%nz-1
2331	DO k = 0, soil_pars_f%np-1
2332	CALL exchange_horiz_2d( soil_pars_f%pars_xyz(k,k2,:,:), &
2333	nbgp )
2334	ENDDO
2335	ENDDO
2336	ENDIF
2337	ENDIF
2338
2339	IF ( pavement_subsurface_pars_f%from_file ) THEN
2340	CALL resize_array_4d_real( pavement_subsurface_pars_f%pars_xyz, &
2341	0, pavement_subsurface_pars_f%np-1, &
2342	0, pavement_subsurface_pars_f%nz-1, &
2343	nys, nyn, nxl, nxr )
2344
2345	DO k2 = 0, pavement_subsurface_pars_f%nz-1
2346	DO k = 0, pavement_subsurface_pars_f%np-1
2347	CALL exchange_horiz_2d( &
2348	pavement_subsurface_pars_f%pars_xyz(k,k2,:,:), nbgp )
2349	ENDDO
2350	ENDDO
2351	ENDIF
2352
2353	END SUBROUTINE netcdf_data_input_surface_data
2354
2355	!------------------------------------------------------------------------------!
2356	! Description:
2357	! ------------
2358	!> Reads uvem lookup table information.
2359	!------------------------------------------------------------------------------!
2360	SUBROUTINE netcdf_data_input_uvem
2361
2362	USE indices, &
2363	ONLY: nxl, nxr, nyn, nys
2364
2365	IMPLICIT NONE
2366
2367	CHARACTER(LEN=100), DIMENSION(:), ALLOCATABLE :: var_names !< variable names in static input file
2368
2369
2370	INTEGER(iwp) :: id_uvem !< NetCDF id of uvem lookup table input file
2371	INTEGER(iwp) :: nli = 35 !< dimension length of lookup table in x
2372	INTEGER(iwp) :: nlj = 9 !< dimension length of lookup table in y
2373	INTEGER(iwp) :: nlk = 90 !< dimension length of lookup table in z
2374	INTEGER(iwp) :: num_vars !< number of variables in netcdf input file
2375	!
2376	!-- Input via uv exposure model lookup table input
2377	IF ( input_pids_uvem ) THEN
2378
2379	#if defined ( __netcdf )
2380	!
2381	!-- Open file in read-only mode
2382	CALL open_read_file( TRIM( input_file_uvem ) // &
2383	TRIM( coupling_char ), id_uvem )
2384	!
2385	!-- At first, inquire all variable names.
2386	!-- This will be used to check whether an input variable exist or not.
2387	CALL inquire_num_variables( id_uvem, num_vars )
2388	!
2389	!-- Allocate memory to store variable names and inquire them.
2390	ALLOCATE( var_names(1:num_vars) )
2391	CALL inquire_variable_names( id_uvem, var_names )
2392	!
2393	!-- uvem integration
2394	IF ( check_existence( var_names, 'int_factors' ) ) THEN
2395	uvem_integration_f%from_file = .TRUE.
2396	!
2397	!-- Input 2D uvem integration.
2398	ALLOCATE ( uvem_integration_f%var(0:nlj,0:nli) )
2399
2400	CALL get_variable( id_uvem, 'int_factors', uvem_integration_f%var, 0, nli, 0, nlj )
2401	ELSE
2402	uvem_integration_f%from_file = .FALSE.
2403	ENDIF
2404	!
2405	!-- uvem irradiance
2406	IF ( check_existence( var_names, 'irradiance' ) ) THEN
2407	uvem_irradiance_f%from_file = .TRUE.
2408	!
2409	!-- Input 2D uvem irradiance.
2410	ALLOCATE ( uvem_irradiance_f%var(0:nlk, 0:2) )
2411
2412	CALL get_variable( id_uvem, 'irradiance', uvem_irradiance_f%var, 0, 2, 0, nlk )
2413	ELSE
2414	uvem_irradiance_f%from_file = .FALSE.
2415	ENDIF
2416	!
2417	!-- uvem porjection areas
2418	IF ( check_existence( var_names, 'projarea' ) ) THEN
2419	uvem_projarea_f%from_file = .TRUE.
2420	!
2421	!-- Input 3D uvem projection area (human geometgry)
2422	ALLOCATE ( uvem_projarea_f%var(0:2,0:nlj,0:nli) )
2423
2424	CALL get_variable( id_uvem, 'projarea', uvem_projarea_f%var, 0, nli, 0, nlj, 0, 2 )
2425	ELSE
2426	uvem_projarea_f%from_file = .FALSE.
2427	ENDIF
2428	!
2429	!-- uvem radiance
2430	IF ( check_existence( var_names, 'radiance' ) ) THEN
2431	uvem_radiance_f%from_file = .TRUE.
2432	!
2433	!-- Input 3D uvem radiance
2434	ALLOCATE ( uvem_radiance_f%var(0:nlk,0:nlj,0:nli) )
2435
2436	CALL get_variable( id_uvem, 'radiance', uvem_radiance_f%var, 0, nli, 0, nlj, 0, nlk )
2437	ELSE
2438	uvem_radiance_f%from_file = .FALSE.
2439	ENDIF
2440	!
2441	!-- Read building obstruction
2442	IF ( check_existence( var_names, 'obstruction' ) ) THEN
2443	building_obstruction_full%from_file = .TRUE.
2444	!-- Input 3D uvem building obstruction
2445	ALLOCATE ( building_obstruction_full%var_3d(0:44,0:2,0:2) )
2446	CALL get_variable( id_uvem, 'obstruction', building_obstruction_full%var_3d,0, 2, 0, 2, 0, 44 )
2447	ELSE
2448	building_obstruction_full%from_file = .FALSE.
2449	ENDIF
2450	!
2451	IF ( check_existence( var_names, 'obstruction' ) ) THEN
2452	building_obstruction_f%from_file = .TRUE.
2453	!
2454	!-- Input 3D uvem building obstruction
2455	ALLOCATE ( building_obstruction_f%var_3d(0:44,nys:nyn,nxl:nxr) )
2456	!
2457	CALL get_variable( id_uvem, 'obstruction', building_obstruction_f%var_3d, &
2458	nxl, nxr, nys, nyn, 0, 44 )
2459	ELSE
2460	building_obstruction_f%from_file = .FALSE.
2461	ENDIF
2462	!
2463	!-- Close uvem lookup table input file
2464	CALL close_input_file( id_uvem )
2465	#else
2466	CONTINUE
2467	#endif
2468	ENDIF
2469	END SUBROUTINE netcdf_data_input_uvem
2470
2471	!------------------------------------------------------------------------------!
2472	! Description:
2473	! ------------
2474	!> Reads orography and building information.
2475	!------------------------------------------------------------------------------!
2476	SUBROUTINE netcdf_data_input_topo
2477
2478	USE control_parameters, &
2479	ONLY: message_string, topography
2480
2481	USE grid_variables, &
2482	ONLY: dx, dy
2483
2484	USE indices, &
2485	ONLY: nbgp, nx, nxl, nxr, ny, nyn, nys, nzb
2486
2487
2488	IMPLICIT NONE
2489
2490	CHARACTER(LEN=100), DIMENSION(:), ALLOCATABLE :: var_names !< variable names in static input file
2491
2492
2493	INTEGER(iwp) :: i !< running index along x-direction
2494	INTEGER(iwp) :: ii !< running index for IO blocks
2495	INTEGER(iwp) :: id_topo !< NetCDF id of topograhy input file
2496	INTEGER(iwp) :: j !< running index along y-direction
2497	INTEGER(iwp) :: num_vars !< number of variables in netcdf input file
2498	INTEGER(iwp) :: skip_n_rows !< counting variable to skip rows while reading topography file
2499
2500	REAL(wp) :: dum !< dummy variable to skip columns while reading topography file
2501	!
2502	!-- CPU measurement
2503	CALL cpu_log( log_point_s(83), 'NetCDF/ASCII input topo', 'start' )
2504
2505	!
2506	!-- Input via palm-input data standard
2507	IF ( input_pids_static ) THEN
2508	#if defined ( __netcdf )
2509	!
2510	!-- Open file in read-only mode
2511	CALL open_read_file( TRIM( input_file_static ) // &
2512	TRIM( coupling_char ), id_topo )
2513	!
2514	!-- At first, inquire all variable names.
2515	!-- This will be used to check whether an input variable exist
2516	!-- or not.
2517	CALL inquire_num_variables( id_topo, num_vars )
2518	!
2519	!-- Allocate memory to store variable names and inquire them.
2520	ALLOCATE( var_names(1:num_vars) )
2521	CALL inquire_variable_names( id_topo, var_names )
2522	!
2523	!-- Read x, y - dimensions. Only required for consistency checks.
2524	CALL get_dimension_length( id_topo, dim_static%nx, 'x' )
2525	CALL get_dimension_length( id_topo, dim_static%ny, 'y' )
2526	ALLOCATE( dim_static%x(0:dim_static%nx-1) )
2527	ALLOCATE( dim_static%y(0:dim_static%ny-1) )
2528	CALL get_variable( id_topo, 'x', dim_static%x )
2529	CALL get_variable( id_topo, 'y', dim_static%y )
2530	!
2531	!-- Check whether dimension size in input file matches the model dimensions
2532	IF ( dim_static%nx-1 /= nx .OR. dim_static%ny-1 /= ny ) THEN
2533	message_string = 'Static input file: horizontal dimension in ' // &
2534	'x- and/or y-direction ' // &
2535	'do not match the respective model dimension'
2536	CALL message( 'netcdf_data_input_mod', 'PA0548', 1, 2, 0, 6, 0 )
2537	ENDIF
2538	!
2539	!-- Check if grid spacing of provided input data matches the respective
2540	!-- grid spacing in the model.
2541	IF ( ABS( dim_static%x(1) - dim_static%x(0) - dx ) > 10E-6_wp .OR. &
2542	ABS( dim_static%y(1) - dim_static%y(0) - dy ) > 10E-6_wp ) THEN
2543	message_string = 'Static input file: horizontal grid spacing ' // &
2544	'in x- and/or y-direction ' // &
2545	'do not match the respective model grid spacing.'
2546	CALL message( 'netcdf_data_input_mod', 'PA0549', 1, 2, 0, 6, 0 )
2547	ENDIF
2548	!
2549	!-- Terrain height. First, get variable-related _FillValue attribute
2550	IF ( check_existence( var_names, 'zt' ) ) THEN
2551	terrain_height_f%from_file = .TRUE.
2552	CALL get_attribute( id_topo, char_fill, terrain_height_f%fill, &
2553	.FALSE., 'zt' )
2554	!
2555	!-- Input 2D terrain height.
2556	ALLOCATE ( terrain_height_f%var(nys:nyn,nxl:nxr) )
2557
2558	CALL get_variable( id_topo, 'zt', terrain_height_f%var, &
2559	nxl, nxr, nys, nyn )
2560
2561	ELSE
2562	terrain_height_f%from_file = .FALSE.
2563	ENDIF
2564
2565	!
2566	!-- Read building height. First, read its _FillValue attribute,
2567	!-- as well as lod attribute
2568	buildings_f%from_file = .FALSE.
2569	IF ( check_existence( var_names, 'buildings_2d' ) ) THEN
2570	buildings_f%from_file = .TRUE.
2571	CALL get_attribute( id_topo, char_lod, buildings_f%lod, &
2572	.FALSE., 'buildings_2d' )
2573
2574	CALL get_attribute( id_topo, char_fill, buildings_f%fill1, &
2575	.FALSE., 'buildings_2d' )
2576
2577	!
2578	!-- Read 2D buildings
2579	IF ( buildings_f%lod == 1 ) THEN
2580	ALLOCATE ( buildings_f%var_2d(nys:nyn,nxl:nxr) )
2581
2582	CALL get_variable( id_topo, 'buildings_2d', &
2583	buildings_f%var_2d, &
2584	nxl, nxr, nys, nyn )
2585	ELSE
2586	message_string = 'NetCDF attribute lod ' // &
2587	'(level of detail) is not set ' // &
2588	'properly for buildings_2d.'
2589	CALL message( 'netcdf_data_input_mod', 'PA0540', &
2590	1, 2, 0, 6, 0 )
2591	ENDIF
2592	ENDIF
2593	!
2594	!-- If available, also read 3D building information. If both are
2595	!-- available, use 3D information.
2596	IF ( check_existence( var_names, 'buildings_3d' ) ) THEN
2597	buildings_f%from_file = .TRUE.
2598	CALL get_attribute( id_topo, char_lod, buildings_f%lod, &
2599	.FALSE., 'buildings_3d' )
2600
2601	CALL get_attribute( id_topo, char_fill, buildings_f%fill2, &
2602	.FALSE., 'buildings_3d' )
2603
2604	CALL get_dimension_length( id_topo, buildings_f%nz, 'z' )
2605	!
2606	!-- Read 3D buildings
2607	IF ( buildings_f%lod == 2 ) THEN
2608	ALLOCATE( buildings_f%z(nzb:buildings_f%nz-1) )
2609	CALL get_variable( id_topo, 'z', buildings_f%z )
2610
2611	ALLOCATE( buildings_f%var_3d(nzb:buildings_f%nz-1, &
2612	nys:nyn,nxl:nxr) )
2613	buildings_f%var_3d = 0
2614
2615	CALL get_variable( id_topo, 'buildings_3d', &
2616	buildings_f%var_3d, &
2617	nxl, nxr, nys, nyn, 0, buildings_f%nz-1 )
2618	ELSE
2619	message_string = 'NetCDF attribute lod ' // &
2620	'(level of detail) is not set ' // &
2621	'properly for buildings_3d.'
2622	CALL message( 'netcdf_data_input_mod', 'PA0541', &
2623	1, 2, 0, 6, 0 )
2624	ENDIF
2625	ENDIF
2626	!
2627	!-- Read building IDs and its FillValue attribute. Further required
2628	!-- for mapping buildings on top of orography.
2629	IF ( check_existence( var_names, 'building_id' ) ) THEN
2630	building_id_f%from_file = .TRUE.
2631	CALL get_attribute( id_topo, char_fill, &
2632	building_id_f%fill, .FALSE., &
2633	'building_id' )
2634
2635	ALLOCATE ( building_id_f%var(nys:nyn,nxl:nxr) )
2636
2637	CALL get_variable( id_topo, 'building_id', building_id_f%var, &
2638	nxl, nxr, nys, nyn )
2639	ELSE
2640	building_id_f%from_file = .FALSE.
2641	ENDIF
2642	!
2643	!-- Read building_type and required attributes.
2644	IF ( check_existence( var_names, 'building_type' ) ) THEN
2645	building_type_f%from_file = .TRUE.
2646	CALL get_attribute( id_topo, char_fill, &
2647	building_type_f%fill, .FALSE., &
2648	'building_type' )
2649
2650	ALLOCATE ( building_type_f%var(nys:nyn,nxl:nxr) )
2651
2652	CALL get_variable( id_topo, 'building_type', building_type_f%var, &
2653	nxl, nxr, nys, nyn )
2654
2655	ELSE
2656	building_type_f%from_file = .FALSE.
2657	ENDIF
2658	!
2659	!-- Close topography input file
2660	CALL close_input_file( id_topo )
2661	#else
2662	CONTINUE
2663	#endif
2664	!
2665	!-- ASCII input
2666	ELSEIF ( TRIM( topography ) == 'read_from_file' ) THEN
2667
2668	DO ii = 0, io_blocks-1
2669	IF ( ii == io_group ) THEN
2670
2671	OPEN( 90, FILE='TOPOGRAPHY_DATA'//TRIM( coupling_char ), &
2672	STATUS='OLD', FORM='FORMATTED', ERR=10 )
2673	!
2674	!-- Read topography PE-wise. Rows are read from nyn to nys, columns
2675	!-- are read from nxl to nxr. At first, ny-nyn rows need to be skipped.
2676	skip_n_rows = 0
2677	DO WHILE ( skip_n_rows < ny - nyn )
2678	READ( 90, * )
2679	skip_n_rows = skip_n_rows + 1
2680	ENDDO
2681	!
2682	!-- Read data from nyn to nys and nxl to nxr. Therefore, skip
2683	!-- column until nxl-1 is reached
2684	ALLOCATE ( buildings_f%var_2d(nys:nyn,nxl:nxr) )
2685	DO j = nyn, nys, -1
2686	READ( 90, *, ERR=11, END=11 ) &
2687	( dum, i = 0, nxl-1 ), &
2688	( buildings_f%var_2d(j,i), i = nxl, nxr )
2689	ENDDO
2690
2691	GOTO 12
2692
2693	10 message_string = 'file TOPOGRAPHY_DATA'// &
2694	TRIM( coupling_char )// ' does not exist'
2695	CALL message( 'netcdf_data_input_mod', 'PA0208', 1, 2, 0, 6, 0 )
2696
2697	11 message_string = 'errors in file TOPOGRAPHY_DATA'// &
2698	TRIM( coupling_char )
2699	CALL message( 'netcdf_data_input_mod', 'PA0209', 2, 2, 0, 6, 0 )
2700
2701	12 CLOSE( 90 )
2702	buildings_f%from_file = .TRUE.
2703
2704	ENDIF
2705	#if defined( __parallel )
2706	CALL MPI_BARRIER( comm2d, ierr )
2707	#endif
2708	ENDDO
2709
2710	ENDIF
2711	!
2712	!-- End of CPU measurement
2713	CALL cpu_log( log_point_s(83), 'NetCDF/ASCII input topo', 'stop' )
2714	!
2715	!-- Check for minimum requirement to setup building topography. If buildings
2716	!-- are provided, also an ID and a type are required.
2717	!-- Note, doing this check in check_parameters
2718	!-- will be too late (data will be used for grid inititialization before).
2719	IF ( input_pids_static ) THEN
2720	IF ( buildings_f%from_file .AND. &
2721	.NOT. building_id_f%from_file ) THEN
2722	message_string = 'If building heights are prescribed in ' // &
2723	'static input file, also an ID is required.'
2724	CALL message( 'netcdf_data_input_mod', 'PA0542', 1, 2, 0, 6, 0 )
2725	ENDIF
2726	ENDIF
2727	!
2728	!-- In case no terrain height is provided by static input file, allocate
2729	!-- array nevertheless and set terrain height to 0, which simplifies
2730	!-- topography initialization.
2731	IF ( .NOT. terrain_height_f%from_file ) THEN
2732	ALLOCATE ( terrain_height_f%var(nys:nyn,nxl:nxr) )
2733	terrain_height_f%var = 0.0_wp
2734	ENDIF
2735	!
2736	!-- Finally, exchange 1 ghost point for building ID and type.
2737	!-- In case of non-cyclic boundary conditions set Neumann conditions at the
2738	!-- lateral boundaries.
2739	IF ( building_id_f%from_file ) THEN
2740	CALL resize_array_2d_int32( building_id_f%var, nys, nyn, nxl, nxr )
2741	CALL exchange_horiz_2d_int( building_id_f%var, nys, nyn, nxl, nxr, &
2742	nbgp )
2743	ENDIF
2744
2745	IF ( building_type_f%from_file ) THEN
2746	CALL resize_array_2d_int8( building_type_f%var, nys, nyn, nxl, nxr )
2747	CALL exchange_horiz_2d_byte( building_type_f%var, nys, nyn, nxl, nxr, &
2748	nbgp )
2749	ENDIF
2750
2751	END SUBROUTINE netcdf_data_input_topo
2752
2753	!------------------------------------------------------------------------------!
2754	! Description:
2755	! ------------
2756	!> Reads initialization data of u, v, w, pt, q, geostrophic wind components,
2757	!> as well as soil moisture and soil temperature, derived from larger-scale
2758	!> model (COSMO) by Inifor.
2759	!------------------------------------------------------------------------------!
2760	SUBROUTINE netcdf_data_input_init_3d
2761
2762	USE arrays_3d, &
2763	ONLY: q, pt, u, v, w, zu, zw
2764
2765	USE control_parameters, &
2766	ONLY: air_chemistry, bc_lr_cyc, bc_ns_cyc, humidity, &
2767	message_string, neutral
2768
2769	USE indices, &
2770	ONLY: nx, nxl, nxlu, nxr, ny, nyn, nys, nysv, nzb, nz, nzt
2771
2772	IMPLICIT NONE
2773
2774	CHARACTER(LEN=100), DIMENSION(:), ALLOCATABLE :: var_names
2775
2776	LOGICAL :: dynamic_3d = .TRUE. !< flag indicating that 3D data is read from dynamic file
2777
2778	INTEGER(iwp) :: id_dynamic !< NetCDF id of dynamic input file
2779	INTEGER(iwp) :: n !< running index for chemistry variables
2780	INTEGER(iwp) :: num_vars !< number of variables in netcdf input file
2781
2782	LOGICAL :: check_passed !< flag indicating if a check passed
2783
2784	!
2785	!-- Skip routine if no input file with dynamic input data is available.
2786	IF ( .NOT. input_pids_dynamic ) RETURN
2787	!
2788	!-- Please note, Inifor is designed to provide initial data for u and v for
2789	!-- the prognostic grid points in case of lateral Dirichlet conditions.
2790	!-- This means that Inifor provides data from nxlu:nxr (for u) and
2791	!-- from nysv:nyn (for v) at the left and south domain boundary, respectively.
2792	!-- However, as work-around for the moment, PALM will run with cyclic
2793	!-- conditions and will be initialized with data provided by Inifor
2794	!-- boundaries in case of Dirichlet.
2795	!-- Hence, simply set set nxlu/nysv to 1 (will be reset to its original value
2796	!-- at the end of this routine.
2797	IF ( bc_lr_cyc .AND. nxl == 0 ) nxlu = 1
2798	IF ( bc_ns_cyc .AND. nys == 0 ) nysv = 1
2799
2800	!
2801	!-- CPU measurement
2802	CALL cpu_log( log_point_s(85), 'NetCDF input init', 'start' )
2803
2804	#if defined ( __netcdf )
2805	!
2806	!-- Open file in read-only mode
2807	CALL open_read_file( TRIM( input_file_dynamic ) // &
2808	TRIM( coupling_char ), id_dynamic )
2809
2810	!
2811	!-- At first, inquire all variable names.
2812	CALL inquire_num_variables( id_dynamic, num_vars )
2813	!
2814	!-- Allocate memory to store variable names.
2815	ALLOCATE( var_names(1:num_vars) )
2816	CALL inquire_variable_names( id_dynamic, var_names )
2817	!
2818	!-- Read vertical dimension of scalar und w grid.
2819	CALL get_dimension_length( id_dynamic, init_3d%nzu, 'z' )
2820	CALL get_dimension_length( id_dynamic, init_3d%nzw, 'zw' )
2821	!
2822	!-- Read also the horizontal dimensions. These are used just used fo
2823	!-- checking the compatibility with the PALM grid before reading.
2824	CALL get_dimension_length( id_dynamic, init_3d%nx, 'x' )
2825	CALL get_dimension_length( id_dynamic, init_3d%nxu, 'xu' )
2826	CALL get_dimension_length( id_dynamic, init_3d%ny, 'y' )
2827	CALL get_dimension_length( id_dynamic, init_3d%nyv, 'yv' )
2828
2829	!
2830	!-- Check for correct horizontal and vertical dimension. Please note,
2831	!-- checks are performed directly here and not called from
2832	!-- check_parameters as some varialbes are still not allocated there.
2833	!-- Moreover, please note, u- and v-grid has 1 grid point less on
2834	!-- Inifor grid.
2835	IF ( init_3d%nx-1 /= nx .OR. init_3d%nxu-1 /= nx - 1 .OR. &
2836	init_3d%ny-1 /= ny .OR. init_3d%nyv-1 /= ny - 1 ) THEN
2837	message_string = 'Number of horizontal grid points in '// &
2838	'dynamic input file does not match ' // &
2839	'the number of numeric grid points.'
2840	CALL message( 'netcdf_data_input_mod', 'PA0543', 1, 2, 0, 6, 0 )
2841	ENDIF
2842
2843	IF ( init_3d%nzu /= nz ) THEN
2844	message_string = 'Number of vertical grid points in '// &
2845	'dynamic input file does not match ' // &
2846	'the number of numeric grid points.'
2847	CALL message( 'netcdf_data_input_mod', 'PA0543', 1, 2, 0, 6, 0 )
2848	ENDIF
2849	!
2850	!-- Read vertical dimensions. Later, these are required for eventual
2851	!-- inter- and extrapolations of the initialization data.
2852	IF ( check_existence( var_names, 'z' ) ) THEN
2853	ALLOCATE( init_3d%zu_atmos(1:init_3d%nzu) )
2854	CALL get_variable( id_dynamic, 'z', init_3d%zu_atmos )
2855	ENDIF
2856	IF ( check_existence( var_names, 'zw' ) ) THEN
2857	ALLOCATE( init_3d%zw_atmos(1:init_3d%nzw) )
2858	CALL get_variable( id_dynamic, 'zw', init_3d%zw_atmos )
2859	ENDIF
2860	!
2861	!-- Check for consistency between vertical coordinates in dynamic
2862	!-- driver and numeric grid.
2863	!-- Please note, depending on compiler options both may be
2864	!-- equal up to a certain threshold, and differences between
2865	!-- the numeric grid and vertical coordinate in the driver can built-
2866	!-- up to 10E-1-10E-0 m. For this reason, the check is performed not
2867	!-- for exactly matching values.
2868	IF ( ANY( ABS( zu(1:nzt) - init_3d%zu_atmos(1:init_3d%nzu) ) &
2869	> 10E-1 ) .OR. &
2870	ANY( ABS( zw(1:nzt-1) - init_3d%zw_atmos(1:init_3d%nzw) ) &
2871	> 10E-1 ) ) THEN
2872	message_string = 'Vertical grid in dynamic driver does not '// &
2873	'match the numeric grid.'
2874	CALL message( 'netcdf_data_input_mod', 'PA0543', 1, 2, 0, 6, 0 )
2875	ENDIF
2876	!
2877	!-- Read initial geostrophic wind components at
2878	!-- t = 0 (index 1 in file).
2879	IF ( check_existence( var_names, 'ls_forcing_ug' ) ) THEN
2880	ALLOCATE( init_3d%ug_init(nzb:nzt+1) )
2881	init_3d%ug_init = 0.0_wp
2882
2883	CALL get_variable_pr( id_dynamic, 'ls_forcing_ug', 1, &
2884	init_3d%ug_init(1:nzt) )
2885	!
2886	!-- Set top-boundary condition (Neumann)
2887	init_3d%ug_init(nzt+1) = init_3d%ug_init(nzt)
2888
2889	init_3d%from_file_ug = .TRUE.
2890	ELSE
2891	init_3d%from_file_ug = .FALSE.
2892	ENDIF
2893	IF ( check_existence( var_names, 'ls_forcing_vg' ) ) THEN
2894	ALLOCATE( init_3d%vg_init(nzb:nzt+1) )
2895	init_3d%vg_init = 0.0_wp
2896
2897	CALL get_variable_pr( id_dynamic, 'ls_forcing_vg', 1, &
2898	init_3d%vg_init(1:nzt) )
2899	!
2900	!-- Set top-boundary condition (Neumann)
2901	init_3d%vg_init(nzt+1) = init_3d%vg_init(nzt)
2902
2903	init_3d%from_file_vg = .TRUE.
2904	ELSE
2905	init_3d%from_file_vg = .FALSE.
2906	ENDIF
2907	!
2908	!-- Read inital 3D data of u, v, w, pt and q,
2909	!-- derived from COSMO model. Read PE-wise yz-slices.
2910	!-- Please note, the u-, v- and w-component are defined on different
2911	!-- grids with one element less in the x-, y-,
2912	!-- and z-direction, respectively. Hence, reading is subdivided
2913	!-- into separate loops.
2914	!-- Read u-component
2915	IF ( check_existence( var_names, 'init_atmosphere_u' ) ) THEN
2916	!
2917	!-- Read attributes for the fill value and level-of-detail
2918	CALL get_attribute( id_dynamic, char_fill, init_3d%fill_u, &
2919	.FALSE., 'init_atmosphere_u' )
2920	CALL get_attribute( id_dynamic, char_lod, init_3d%lod_u, &
2921	.FALSE., 'init_atmosphere_u' )
2922	!
2923	!-- level-of-detail 1 - read initialization profile
2924	IF ( init_3d%lod_u == 1 ) THEN
2925	ALLOCATE( init_3d%u_init(nzb:nzt+1) )
2926	init_3d%u_init = 0.0_wp
2927
2928	CALL get_variable( id_dynamic, 'init_atmosphere_u', &
2929	init_3d%u_init(nzb+1:nzt) )
2930	!
2931	!-- Set top-boundary condition (Neumann)
2932	init_3d%u_init(nzt+1) = init_3d%u_init(nzt)
2933	!
2934	!-- level-of-detail 2 - read 3D initialization data
2935	ELSEIF ( init_3d%lod_u == 2 ) THEN
2936	CALL get_variable( id_dynamic, 'init_atmosphere_u', &
2937	u(nzb+1:nzt,nys:nyn,nxlu:nxr), &
2938	nxlu, nys+1, nzb+1, &
2939	nxr-nxlu+1, nyn-nys+1, init_3d%nzu, &
2940	dynamic_3d )
2941	!
2942	!-- Set value at leftmost model grid point nxl = 0. This is because
2943	!-- Inifor provides data only from 1:nx-1 since it assumes non-cyclic
2944	!-- conditions.
2945	IF ( nxl == 0 ) &
2946	u(nzb+1:nzt,nys:nyn,nxl) = u(nzb+1:nzt,nys:nyn,nxlu)
2947	!
2948	!-- Set bottom and top-boundary
2949	u(nzb,:,:) = u(nzb+1,:,:)
2950	u(nzt+1,:,:) = u(nzt,:,:)
2951
2952	ENDIF
2953	init_3d%from_file_u = .TRUE.
2954	ELSE
2955	message_string = 'Missing initial data for u-component'
2956	CALL message( 'netcdf_data_input_mod', 'PA0544', 1, 2, 0, 6, 0 )
2957	ENDIF
2958	!
2959	!-- Read v-component
2960	IF ( check_existence( var_names, 'init_atmosphere_v' ) ) THEN
2961	!
2962	!-- Read attributes for the fill value and level-of-detail
2963	CALL get_attribute( id_dynamic, char_fill, init_3d%fill_v, &
2964	.FALSE., 'init_atmosphere_v' )
2965	CALL get_attribute( id_dynamic, char_lod, init_3d%lod_v, &
2966	.FALSE., 'init_atmosphere_v' )
2967	!
2968	!-- level-of-detail 1 - read initialization profile
2969	IF ( init_3d%lod_v == 1 ) THEN
2970	ALLOCATE( init_3d%v_init(nzb:nzt+1) )
2971	init_3d%v_init = 0.0_wp
2972
2973	CALL get_variable( id_dynamic, 'init_atmosphere_v', &
2974	init_3d%v_init(nzb+1:nzt) )
2975	!
2976	!-- Set top-boundary condition (Neumann)
2977	init_3d%v_init(nzt+1) = init_3d%v_init(nzt)
2978	!
2979	!-- level-of-detail 2 - read 3D initialization data
2980	ELSEIF ( init_3d%lod_v == 2 ) THEN
2981
2982	CALL get_variable( id_dynamic, 'init_atmosphere_v', &
2983	v(nzb+1:nzt,nysv:nyn,nxl:nxr), &
2984	nxl+1, nysv, nzb+1, &
2985	nxr-nxl+1, nyn-nysv+1, init_3d%nzu, &
2986	dynamic_3d )
2987	!
2988	!-- Set value at southmost model grid point nys = 0. This is because
2989	!-- Inifor provides data only from 1:ny-1 since it assumes non-cyclic
2990	!-- conditions.
2991	IF ( nys == 0 ) &
2992	v(nzb+1:nzt,nys,nxl:nxr) = v(nzb+1:nzt,nysv,nxl:nxr)
2993	!
2994	!-- Set bottom and top-boundary
2995	v(nzb,:,:) = v(nzb+1,:,:)
2996	v(nzt+1,:,:) = v(nzt,:,:)
2997
2998	ENDIF
2999	init_3d%from_file_v = .TRUE.
3000	ELSE
3001	message_string = 'Missing initial data for v-component'
3002	CALL message( 'netcdf_data_input_mod', 'PA0544', 1, 2, 0, 6, 0 )
3003	ENDIF
3004	!
3005	!-- Read w-component
3006	IF ( check_existence( var_names, 'init_atmosphere_w' ) ) THEN
3007	!
3008	!-- Read attributes for the fill value and level-of-detail
3009	CALL get_attribute( id_dynamic, char_fill, init_3d%fill_w, &
3010	.FALSE., 'init_atmosphere_w' )
3011	CALL get_attribute( id_dynamic, char_lod, init_3d%lod_w, &
3012	.FALSE., 'init_atmosphere_w' )
3013	!
3014	!-- level-of-detail 1 - read initialization profile
3015	IF ( init_3d%lod_w == 1 ) THEN
3016	ALLOCATE( init_3d%w_init(nzb:nzt+1) )
3017	init_3d%w_init = 0.0_wp
3018
3019	CALL get_variable( id_dynamic, 'init_atmosphere_w', &
3020	init_3d%w_init(nzb+1:nzt-1) )
3021	!
3022	!-- Set top-boundary condition (Neumann)
3023	init_3d%w_init(nzt:nzt+1) = init_3d%w_init(nzt-1)
3024	!
3025	!-- level-of-detail 2 - read 3D initialization data
3026	ELSEIF ( init_3d%lod_w == 2 ) THEN
3027
3028	CALL get_variable( id_dynamic, 'init_atmosphere_w', &
3029	w(nzb+1:nzt-1,nys:nyn,nxl:nxr), &
3030	nxl+1, nys+1, nzb+1, &
3031	nxr-nxl+1, nyn-nys+1, init_3d%nzw, &
3032	dynamic_3d )
3033	!
3034	!-- Set bottom and top-boundary
3035	w(nzb,:,:) = 0.0_wp
3036	w(nzt,:,:) = w(nzt-1,:,:)
3037	w(nzt+1,:,:) = w(nzt-1,:,:)
3038
3039	ENDIF
3040	init_3d%from_file_w = .TRUE.
3041	ELSE
3042	message_string = 'Missing initial data for w-component'
3043	CALL message( 'netcdf_data_input_mod', 'PA0544', 1, 2, 0, 6, 0 )
3044	ENDIF
3045	!
3046	!-- Read potential temperature
3047	IF ( .NOT. neutral ) THEN
3048	IF ( check_existence( var_names, 'init_atmosphere_pt' ) ) THEN
3049	!
3050	!-- Read attributes for the fill value and level-of-detail
3051	CALL get_attribute( id_dynamic, char_fill, init_3d%fill_pt, &
3052	.FALSE., 'init_atmosphere_pt' )
3053	CALL get_attribute( id_dynamic, char_lod, init_3d%lod_pt, &
3054	.FALSE., 'init_atmosphere_pt' )
3055	!
3056	!-- level-of-detail 1 - read initialization profile
3057	IF ( init_3d%lod_pt == 1 ) THEN
3058	ALLOCATE( init_3d%pt_init(nzb:nzt+1) )
3059
3060	CALL get_variable( id_dynamic, 'init_atmosphere_pt', &
3061	init_3d%pt_init(nzb+1:nzt) )
3062	!
3063	!-- Set Neumann top and surface boundary condition for initial
3064	!-- profil
3065	init_3d%pt_init(nzb) = init_3d%pt_init(nzb+1)
3066	init_3d%pt_init(nzt+1) = init_3d%pt_init(nzt)
3067	!
3068	!-- level-of-detail 2 - read 3D initialization data
3069	ELSEIF ( init_3d%lod_pt == 2 ) THEN
3070
3071	CALL get_variable( id_dynamic, 'init_atmosphere_pt', &
3072	pt(nzb+1:nzt,nys:nyn,nxl:nxr), &
3073	nxl+1, nys+1, nzb+1, &
3074	nxr-nxl+1, nyn-nys+1, init_3d%nzu, &
3075	dynamic_3d )
3076
3077	!
3078	!-- Set bottom and top-boundary
3079	pt(nzb,:,:) = pt(nzb+1,:,:)
3080	pt(nzt+1,:,:) = pt(nzt,:,:)
3081
3082	ENDIF
3083	init_3d%from_file_pt = .TRUE.
3084	ELSE
3085	message_string = 'Missing initial data for ' // &
3086	'potential temperature'
3087	CALL message( 'netcdf_data_input_mod', 'PA0544', 1, 2, 0, 6, 0 )
3088	ENDIF
3089	ENDIF
3090	!
3091	!-- Read mixing ratio
3092	IF ( humidity ) THEN
3093	IF ( check_existence( var_names, 'init_atmosphere_qv' ) ) THEN
3094	!
3095	!-- Read attributes for the fill value and level-of-detail
3096	CALL get_attribute( id_dynamic, char_fill, init_3d%fill_q, &
3097	.FALSE., 'init_atmosphere_qv' )
3098	CALL get_attribute( id_dynamic, char_lod, init_3d%lod_q, &
3099	.FALSE., 'init_atmosphere_qv' )
3100	!
3101	!-- level-of-detail 1 - read initialization profile
3102	IF ( init_3d%lod_q == 1 ) THEN
3103	ALLOCATE( init_3d%q_init(nzb:nzt+1) )
3104
3105	CALL get_variable( id_dynamic, 'init_atmosphere_qv', &
3106	init_3d%q_init(nzb+1:nzt) )
3107	!
3108	!-- Set bottom and top boundary condition (Neumann)
3109	init_3d%q_init(nzb) = init_3d%q_init(nzb+1)
3110	init_3d%q_init(nzt+1) = init_3d%q_init(nzt)
3111	!
3112	!-- level-of-detail 2 - read 3D initialization data
3113	ELSEIF ( init_3d%lod_q == 2 ) THEN
3114
3115	CALL get_variable( id_dynamic, 'init_atmosphere_qv', &
3116	q(nzb+1:nzt,nys:nyn,nxl:nxr), &
3117	nxl+1, nys+1, nzb+1, &
3118	nxr-nxl+1, nyn-nys+1, init_3d%nzu, &
3119	dynamic_3d )
3120
3121	!
3122	!-- Set bottom and top-boundary
3123	q(nzb,:,:) = q(nzb+1,:,:)
3124	q(nzt+1,:,:) = q(nzt,:,:)
3125
3126	ENDIF
3127	init_3d%from_file_q = .TRUE.
3128	ELSE
3129	message_string = 'Missing initial data for ' // &
3130	'mixing ratio'
3131	CALL message( 'netcdf_data_input_mod', 'PA0544', 1, 2, 0, 6, 0 )
3132	ENDIF
3133	ENDIF
3134	!
3135	!-- Read chemistry variables.
3136	!-- Please note, for the moment, only LOD=1 is allowed
3137	IF ( air_chemistry ) THEN
3138	!
3139	!-- Allocate chemistry input profiles, as well as arrays for fill values
3140	!-- and LOD's.
3141	ALLOCATE( init_3d%chem_init(nzb:nzt+1, &
3142	1:UBOUND(init_3d%var_names_chem, 1 )) )
3143	ALLOCATE( init_3d%fill_chem(1:UBOUND(init_3d%var_names_chem, 1)) )
3144	ALLOCATE( init_3d%lod_chem(1:UBOUND(init_3d%var_names_chem, 1)) )
3145
3146	DO n = 1, UBOUND(init_3d%var_names_chem, 1)
3147	IF ( check_existence( var_names, &
3148	TRIM( init_3d%var_names_chem(n) ) ) ) THEN
3149	!
3150	!-- Read attributes for the fill value and level-of-detail
3151	CALL get_attribute( id_dynamic, char_fill, &
3152	init_3d%fill_chem(n), &
3153	.FALSE., &
3154	TRIM( init_3d%var_names_chem(n) ) )
3155	CALL get_attribute( id_dynamic, char_lod, &
3156	init_3d%lod_chem(n), &
3157	.FALSE., &
3158	TRIM( init_3d%var_names_chem(n) ) )
3159	!
3160	!-- Give message that only LOD=1 is allowed.
3161	IF ( init_3d%lod_chem(n) /= 1 ) THEN
3162	message_string = 'For chemistry variables only LOD=1 is ' //&
3163	'allowed.'
3164	CALL message( 'netcdf_data_input_mod', 'PA0586', &
3165	1, 2, 0, 6, 0 )
3166	ENDIF
3167	!
3168	!-- level-of-detail 1 - read initialization profile
3169	CALL get_variable( id_dynamic, &
3170	TRIM( init_3d%var_names_chem(n) ), &
3171	init_3d%chem_init(nzb+1:nzt,n) )
3172	!
3173	!-- Set bottom and top boundary condition (Neumann)
3174	init_3d%chem_init(nzb,n) = init_3d%chem_init(nzb+1,n)
3175	init_3d%chem_init(nzt+1,n) = init_3d%chem_init(nzt,n)
3176
3177	init_3d%from_file_chem(n) = .TRUE.
3178	ENDIF
3179	ENDDO
3180	ENDIF
3181	!
3182	!-- Close input file
3183	CALL close_input_file( id_dynamic )
3184	#endif
3185	!
3186	!-- End of CPU measurement
3187	CALL cpu_log( log_point_s(85), 'NetCDF input init', 'stop' )
3188	!
3189	!-- Finally, check if the input data has any fill values. Please note,
3190	!-- checks depend on the LOD of the input data.
3191	IF ( init_3d%from_file_u ) THEN
3192	check_passed = .TRUE.
3193	IF ( init_3d%lod_u == 1 ) THEN
3194	IF ( ANY( init_3d%u_init(nzb+1:nzt+1) == init_3d%fill_u ) ) &
3195	check_passed = .FALSE.
3196	ELSEIF ( init_3d%lod_u == 2 ) THEN
3197	IF ( ANY( u(nzb+1:nzt+1,nys:nyn,nxlu:nxr) == init_3d%fill_u ) ) &
3198	check_passed = .FALSE.
3199	ENDIF
3200	IF ( .NOT. check_passed ) THEN
3201	message_string = 'NetCDF input for init_atmosphere_u must ' // &
3202	'not contain any _FillValues'
3203	CALL message( 'netcdf_data_input_mod', 'PA0545', 2, 2, 0, 6, 0 )
3204	ENDIF
3205	ENDIF
3206
3207	IF ( init_3d%from_file_v ) THEN
3208	check_passed = .TRUE.
3209	IF ( init_3d%lod_v == 1 ) THEN
3210	IF ( ANY( init_3d%v_init(nzb+1:nzt+1) == init_3d%fill_v ) ) &
3211	check_passed = .FALSE.
3212	ELSEIF ( init_3d%lod_v == 2 ) THEN
3213	IF ( ANY( v(nzb+1:nzt+1,nysv:nyn,nxl:nxr) == init_3d%fill_v ) ) &
3214	check_passed = .FALSE.
3215	ENDIF
3216	IF ( .NOT. check_passed ) THEN
3217	message_string = 'NetCDF input for init_atmosphere_v must ' // &
3218	'not contain any _FillValues'
3219	CALL message( 'netcdf_data_input_mod', 'PA0545', 2, 2, 0, 6, 0 )
3220	ENDIF
3221	ENDIF
3222
3223	IF ( init_3d%from_file_w ) THEN
3224	check_passed = .TRUE.
3225	IF ( init_3d%lod_w == 1 ) THEN
3226	IF ( ANY( init_3d%w_init(nzb+1:nzt) == init_3d%fill_w ) ) &
3227	check_passed = .FALSE.
3228	ELSEIF ( init_3d%lod_w == 2 ) THEN
3229	IF ( ANY( w(nzb+1:nzt,nys:nyn,nxl:nxr) == init_3d%fill_w ) ) &
3230	check_passed = .FALSE.
3231	ENDIF
3232	IF ( .NOT. check_passed ) THEN
3233	message_string = 'NetCDF input for init_atmosphere_w must ' // &
3234	'not contain any _FillValues'
3235	CALL message( 'netcdf_data_input_mod', 'PA0545', 2, 2, 0, 6, 0 )
3236	ENDIF
3237	ENDIF
3238
3239	IF ( init_3d%from_file_pt ) THEN
3240	check_passed = .TRUE.
3241	IF ( init_3d%lod_pt == 1 ) THEN
3242	IF ( ANY( init_3d%pt_init(nzb+1:nzt+1) == init_3d%fill_pt ) ) &
3243	check_passed = .FALSE.
3244	ELSEIF ( init_3d%lod_pt == 2 ) THEN
3245	IF ( ANY( pt(nzb+1:nzt+1,nys:nyn,nxl:nxr) == init_3d%fill_pt ) ) &
3246	check_passed = .FALSE.
3247	ENDIF
3248	IF ( .NOT. check_passed ) THEN
3249	message_string = 'NetCDF input for init_atmosphere_pt must ' // &
3250	'not contain any _FillValues'
3251	CALL message( 'netcdf_data_input_mod', 'PA0545', 2, 2, 0, 6, 0 )
3252	ENDIF
3253	ENDIF
3254
3255	IF ( init_3d%from_file_q ) THEN
3256	check_passed = .TRUE.
3257	IF ( init_3d%lod_q == 1 ) THEN
3258	IF ( ANY( init_3d%q_init(nzb+1:nzt+1) == init_3d%fill_q ) ) &
3259	check_passed = .FALSE.
3260	ELSEIF ( init_3d%lod_q == 2 ) THEN
3261	IF ( ANY( q(nzb+1:nzt+1,nys:nyn,nxl:nxr) == init_3d%fill_q ) ) &
3262	check_passed = .FALSE.
3263	ENDIF
3264	IF ( .NOT. check_passed ) THEN
3265	message_string = 'NetCDF input for init_atmosphere_q must ' // &
3266	'not contain any _FillValues'
3267	CALL message( 'netcdf_data_input_mod', 'PA0545', 2, 2, 0, 6, 0 )
3268	ENDIF
3269	ENDIF
3270	!
3271	!-- Workaround for cyclic conditions. Please see above for further explanation.
3272	IF ( bc_lr_cyc .AND. nxl == 0 ) nxlu = nxl
3273	IF ( bc_ns_cyc .AND. nys == 0 ) nysv = nys
3274
3275	END SUBROUTINE netcdf_data_input_init_3d
3276
3277	!------------------------------------------------------------------------------!
3278	! Description:
3279	! ------------
3280	!> Checks input file for consistency and minimum requirements.
3281	!------------------------------------------------------------------------------!
3282	SUBROUTINE netcdf_data_input_check_dynamic
3283
3284	USE control_parameters, &
3285	ONLY: initializing_actions, message_string
3286
3287	IMPLICIT NONE
3288	!
3289	!-- Dynamic input file must also be present if initialization via inifor is
3290	!-- prescribed.
3291	IF ( .NOT. input_pids_dynamic .AND. &
3292	INDEX( initializing_actions, 'inifor' ) /= 0 ) THEN
3293	message_string = 'initializing_actions = inifor requires dynamic ' //&
3294	'input file ' // TRIM( input_file_dynamic ) // &
3295	TRIM( coupling_char )
3296	CALL message( 'netcdf_data_input_mod', 'PA0547', 1, 2, 0, 6, 0 )
3297	ENDIF
3298
3299	END SUBROUTINE netcdf_data_input_check_dynamic
3300
3301	!------------------------------------------------------------------------------!
3302	! Description:
3303	! ------------
3304	!> Checks input file for consistency and minimum requirements.
3305	!------------------------------------------------------------------------------!
3306	SUBROUTINE netcdf_data_input_check_static
3307
3308	USE arrays_3d, &
3309	ONLY: zu
3310
3311	USE control_parameters, &
3312	ONLY: land_surface, message_string, urban_surface
3313
3314	USE indices, &
3315	ONLY: nxl, nxr, nyn, nys, wall_flags_total_0
3316
3317	IMPLICIT NONE
3318
3319	INTEGER(iwp) :: i !< loop index along x-direction
3320	INTEGER(iwp) :: j !< loop index along y-direction
3321	INTEGER(iwp) :: n_surf !< number of different surface types at given location
3322
3323	LOGICAL :: check_passed !< flag indicating if a check passed
3324
3325	!
3326	!-- Return if no static input file is available
3327	IF ( .NOT. input_pids_static ) RETURN
3328	!
3329	!-- Check for correct dimension of surface_fractions, should run from 0-2.
3330	IF ( surface_fraction_f%from_file ) THEN
3331	IF ( surface_fraction_f%nf-1 > 2 ) THEN
3332	message_string = 'nsurface_fraction must not be larger than 3.'
3333	CALL message( 'netcdf_data_input_mod', 'PA0580', 1, 2, 0, 6, 0 )
3334	ENDIF
3335	ENDIF
3336	!
3337	!-- Check orography for fill-values. For the moment, give an error message.
3338	!-- More advanced methods, e.g. a nearest neighbor algorithm as used in GIS
3339	!-- systems might be implemented later.
3340	!-- Please note, if no terrain height is provided, it is set to 0.
3341	IF ( ANY( terrain_height_f%var == terrain_height_f%fill ) ) THEN
3342	message_string = 'NetCDF variable zt is not ' // &
3343	'allowed to have missing data'
3344	CALL message( 'netcdf_data_input_mod', 'PA0550', 2, 2, myid, 6, 0 )
3345	ENDIF
3346	!
3347	!-- Check for negative terrain heights
3348	IF ( ANY( terrain_height_f%var < 0.0_wp ) ) THEN
3349	message_string = 'NetCDF variable zt is not ' // &
3350	'allowed to have negative values'
3351	CALL message( 'netcdf_data_input_mod', 'PA0551', 2, 2, myid, 6, 0 )
3352	ENDIF
3353	!
3354	!-- If 3D buildings are read, check if building information is consistent
3355	!-- to numeric grid.
3356	IF ( buildings_f%from_file ) THEN
3357	IF ( buildings_f%lod == 2 ) THEN
3358	IF ( buildings_f%nz > SIZE( zu ) ) THEN
3359	message_string = 'Reading 3D building data - too much ' // &
3360	'data points along the vertical coordinate.'
3361	CALL message( 'netcdf_data_input_mod', 'PA0552', 2, 2, 0, 6, 0 )
3362	ENDIF
3363
3364	IF ( ANY( ABS( buildings_f%z(0:buildings_f%nz-1) - &
3365	zu(0:buildings_f%nz-1) ) > 1E-6_wp ) ) THEN
3366	message_string = 'Reading 3D building data - vertical ' // &
3367	'coordinate do not match numeric grid.'
3368	CALL message( 'netcdf_data_input_mod', 'PA0553', 2, 2, 0, 6, 0 )
3369	ENDIF
3370	ENDIF
3371	ENDIF
3372
3373	!
3374	!-- Skip further checks concerning buildings and natural surface properties
3375	!-- if no urban surface and land surface model are applied.
3376	IF ( .NOT. land_surface .AND. .NOT. urban_surface ) RETURN
3377	!
3378	!-- Check for minimum requirement of surface-classification data in case
3379	!-- static input file is used.
3380	IF ( ( .NOT. vegetation_type_f%from_file .OR. &
3381	.NOT. pavement_type_f%from_file .OR. &
3382	.NOT. water_type_f%from_file .OR. &
3383	.NOT. soil_type_f%from_file ) .OR. &
3384	( urban_surface .AND. .NOT. building_type_f%from_file ) ) THEN
3385	message_string = 'Minimum requirement for surface classification ' //&
3386	'is not fulfilled. At least ' // &
3387	'vegetation_type, pavement_type, ' // &
3388	'soil_type and water_type are '// &
3389	'required. If urban-surface model is applied, ' // &
3390	'also building_type is required'
3391	CALL message( 'netcdf_data_input_mod', 'PA0554', 1, 2, 0, 6, 0 )
3392	ENDIF
3393	!
3394	!-- Check for general availability of input variables.
3395	!-- If vegetation_type is 0 at any location, vegetation_pars as well as
3396	!-- root_area_dens_s are required.
3397	IF ( vegetation_type_f%from_file ) THEN
3398	IF ( ANY( vegetation_type_f%var == 0 ) ) THEN
3399	IF ( .NOT. vegetation_pars_f%from_file ) THEN
3400	message_string = 'If vegetation_type = 0 at any location, ' // &
3401	'vegetation_pars is required'
3402	CALL message( 'netcdf_data_input_mod', 'PA0555', 2, 2, myid, 6, 0 )
3403	ENDIF
3404	IF ( .NOT. root_area_density_lsm_f%from_file ) THEN
3405	message_string = 'If vegetation_type = 0 at any location, ' // &
3406	'root_area_dens_s is required'
3407	CALL message( 'netcdf_data_input_mod', 'PA0556', 2, 2, myid, 6, 0 )
3408	ENDIF
3409	ENDIF
3410	ENDIF
3411	!
3412	!-- If soil_type is zero at any location, soil_pars is required.
3413	IF ( soil_type_f%from_file ) THEN
3414	check_passed = .TRUE.
3415	IF ( ALLOCATED( soil_type_f%var_2d ) ) THEN
3416	IF ( ANY( soil_type_f%var_2d == 0 ) ) THEN
3417	IF ( .NOT. soil_pars_f%from_file ) check_passed = .FALSE.
3418	ENDIF
3419	ELSE
3420	IF ( ANY( soil_type_f%var_3d == 0 ) ) THEN
3421	IF ( .NOT. soil_pars_f%from_file ) check_passed = .FALSE.
3422	ENDIF
3423	ENDIF
3424	IF ( .NOT. check_passed ) THEN
3425	message_string = 'If soil_type = 0 at any location, ' // &
3426	'soil_pars is required'
3427	CALL message( 'netcdf_data_input_mod', 'PA0557', 2, 2, myid, 6, 0 )
3428	ENDIF
3429	ENDIF
3430	!
3431	!-- Buildings require a type in case of urban-surface model.
3432	IF ( buildings_f%from_file .AND. .NOT. building_type_f%from_file ) THEN
3433	message_string = 'If buildings are provided, also building_type ' // &
3434	'is required'
3435	CALL message( 'netcdf_data_input_mod', 'PA0581', 2, 2, 0, 6, 0 )
3436	ENDIF
3437	!
3438	!-- Buildings require an ID.
3439	IF ( buildings_f%from_file .AND. .NOT. building_id_f%from_file ) THEN
3440	message_string = 'If buildings are provided, also building_id ' // &
3441	'is required'
3442	CALL message( 'netcdf_data_input_mod', 'PA0582', 2, 2, 0, 6, 0 )
3443	ENDIF
3444	!
3445	!-- If building_type is zero at any location, building_pars is required.
3446	IF ( building_type_f%from_file ) THEN
3447	IF ( ANY( building_type_f%var == 0 ) ) THEN
3448	IF ( .NOT. building_pars_f%from_file ) THEN
3449	message_string = 'If building_type = 0 at any location, ' // &
3450	'building_pars is required'
3451	CALL message( 'netcdf_data_input_mod', 'PA0558', 2, 2, myid, 6, 0 )
3452	ENDIF
3453	ENDIF
3454	ENDIF
3455	!
3456	!-- If building_type is provided, also building_id is needed (due to the
3457	!-- filtering algorithm).
3458	IF ( building_type_f%from_file .AND. .NOT. building_id_f%from_file ) &
3459	THEN
3460	message_string = 'If building_type is provided, also building_id '// &
3461	'is required'
3462	CALL message( 'netcdf_data_input_mod', 'PA0519', 2, 2, 0, 6, 0 )
3463	ENDIF
3464	!
3465	!-- If albedo_type is zero at any location, albedo_pars is required.
3466	IF ( albedo_type_f%from_file ) THEN
3467	IF ( ANY( albedo_type_f%var == 0 ) ) THEN
3468	IF ( .NOT. albedo_pars_f%from_file ) THEN
3469	message_string = 'If albedo_type = 0 at any location, ' // &
3470	'albedo_pars is required'
3471	CALL message( 'netcdf_data_input_mod', 'PA0559', 2, 2, myid, 6, 0 )
3472	ENDIF
3473	ENDIF
3474	ENDIF
3475	!
3476	!-- If pavement_type is zero at any location, pavement_pars is required.
3477	IF ( pavement_type_f%from_file ) THEN
3478	IF ( ANY( pavement_type_f%var == 0 ) ) THEN
3479	IF ( .NOT. pavement_pars_f%from_file ) THEN
3480	message_string = 'If pavement_type = 0 at any location, ' // &
3481	'pavement_pars is required'
3482	CALL message( 'netcdf_data_input_mod', 'PA0560', 2, 2, myid, 6, 0 )
3483	ENDIF
3484	ENDIF
3485	ENDIF
3486	!
3487	!-- If pavement_type is zero at any location, also pavement_subsurface_pars
3488	!-- is required.
3489	IF ( pavement_type_f%from_file ) THEN
3490	IF ( ANY( pavement_type_f%var == 0 ) ) THEN
3491	IF ( .NOT. pavement_subsurface_pars_f%from_file ) THEN
3492	message_string = 'If pavement_type = 0 at any location, ' // &
3493	'pavement_subsurface_pars is required'
3494	CALL message( 'netcdf_data_input_mod', 'PA0561', 2, 2, myid, 6, 0 )
3495	ENDIF
3496	ENDIF
3497	ENDIF
3498	!
3499	!-- If water_type is zero at any location, water_pars is required.
3500	IF ( water_type_f%from_file ) THEN
3501	IF ( ANY( water_type_f%var == 0 ) ) THEN
3502	IF ( .NOT. water_pars_f%from_file ) THEN
3503	message_string = 'If water_type = 0 at any location, ' // &
3504	'water_pars is required'
3505	CALL message( 'netcdf_data_input_mod', 'PA0562', 2, 2,myid, 6, 0 )
3506	ENDIF
3507	ENDIF
3508	ENDIF
3509	!
3510	!-- Check for local consistency of the input data.
3511	DO i = nxl, nxr
3512	DO j = nys, nyn
3513	!
3514	!-- For each (y,x)-location at least one of the parameters
3515	!-- vegetation_type, pavement_type, building_type, or water_type
3516	!-- must be set to a nonÂmissing value.
3517	IF ( land_surface .AND. .NOT. urban_surface ) THEN
3518	IF ( vegetation_type_f%var(j,i) == vegetation_type_f%fill .AND.&
3519	pavement_type_f%var(j,i) == pavement_type_f%fill .AND.&
3520	water_type_f%var(j,i) == water_type_f%fill ) THEN
3521	WRITE( message_string, * ) &
3522	'At least one of the parameters '// &
3523	'vegetation_type, pavement_type, ' // &
3524	'or water_type must be set '// &
3525	'to a non-missing value. Grid point: ', j, i
3526	CALL message( 'netcdf_data_input_mod', 'PA0563', 2, 2, myid, 6, 0 )
3527	ENDIF
3528	ELSEIF ( land_surface .AND. urban_surface ) THEN
3529	IF ( vegetation_type_f%var(j,i) == vegetation_type_f%fill .AND.&
3530	pavement_type_f%var(j,i) == pavement_type_f%fill .AND.&
3531	building_type_f%var(j,i) == building_type_f%fill .AND.&
3532	water_type_f%var(j,i) == water_type_f%fill ) THEN
3533	WRITE( message_string, * ) &
3534	'At least one of the parameters '// &
3535	'vegetation_type, pavement_type, ' // &
3536	'building_type, or water_type must be set '// &
3537	'to a non-missing value. Grid point: ', j, i
3538	CALL message( 'netcdf_data_input_mod', 'PA0563', 2, 2, myid, 6, 0 )
3539	ENDIF
3540	ENDIF
3541
3542	!
3543	!-- Note that a soil_type is required for each location (y,x) where
3544	!-- either vegetation_type or pavement_type is a nonÂmissing value.
3545	IF ( ( vegetation_type_f%var(j,i) /= vegetation_type_f%fill .OR. &
3546	pavement_type_f%var(j,i) /= pavement_type_f%fill ) ) THEN
3547	check_passed = .TRUE.
3548	IF ( ALLOCATED( soil_type_f%var_2d ) ) THEN
3549	IF ( soil_type_f%var_2d(j,i) == soil_type_f%fill ) &
3550	check_passed = .FALSE.
3551	ELSE
3552	IF ( ANY( soil_type_f%var_3d(:,j,i) == soil_type_f%fill) ) &
3553	check_passed = .FALSE.
3554	ENDIF
3555
3556	IF ( .NOT. check_passed ) THEN
3557	message_string = 'soil_type is required for each '// &
3558	'location (y,x) where vegetation_type or ' // &
3559	'pavement_type is a non-missing value.'
3560	CALL message( 'netcdf_data_input_mod', 'PA0564', &
3561	2, 2, myid, 6, 0 )
3562	ENDIF
3563	ENDIF
3564	!
3565	!-- Check for consistency of given types. At the moment, only one
3566	!-- of vegetation, pavement, or water-type can be set. This is
3567	!-- because no tile approach is yet implemented in the land-surface
3568	!-- model. Later, when this is possible, surface fraction need to be
3569	!-- given and the sum must not be larger than 1. Please note, in case
3570	!-- more than one type is given at a pixel, an error message will be
3571	!-- given.
3572	n_surf = 0
3573	IF ( vegetation_type_f%var(j,i) /= vegetation_type_f%fill ) &
3574	n_surf = n_surf + 1
3575	IF ( water_type_f%var(j,i) /= water_type_f%fill ) &
3576	n_surf = n_surf + 1
3577	IF ( pavement_type_f%var(j,i) /= pavement_type_f%fill ) &
3578	n_surf = n_surf + 1
3579
3580	IF ( n_surf > 1 ) THEN
3581	WRITE( message_string, * ) &
3582	'More than one surface type (vegetation, '// &
3583	'pavement, water) is given at a location. '// &
3584	'Please note, this is not possible at ' // &
3585	'the moment as no tile approach has been ' // &
3586	'yet implemented. (i,j) = ', i, j
3587	CALL message( 'netcdf_data_input_mod', 'PA0565', &
3588	2, 2, myid, 6, 0 )
3589
3590	! IF ( .NOT. surface_fraction_f%from_file ) THEN
3591	! message_string = 'More than one surface type (vegetation '//&
3592	! 'pavement, water) is given at a location. '// &
3593	! 'Please note, this is not possible at ' // &
3594	! 'the moment as no tile approach is yet ' // &
3595	! 'implemented.'
3596	! message_string = 'If more than one surface type is ' // &
3597	! 'given at a location, surface_fraction ' // &
3598	! 'must be provided.'
3599	! CALL message( 'netcdf_data_input_mod', 'PA0565', &
3600	! 2, 2, myid, 6, 0 )
3601	! ELSEIF ( ANY ( surface_fraction_f%frac(:,j,i) == &
3602	! surface_fraction_f%fill ) ) THEN
3603	! message_string = 'If more than one surface type is ' // &
3604	! 'given at a location, surface_fraction ' // &
3605	! 'must be provided.'
3606	! CALL message( 'netcdf_data_input_mod', 'PA0565', &
3607	! 2, 2, myid, 6, 0 )
3608	! ENDIF
3609	ENDIF
3610	!
3611	!-- Check for further mismatches. e.g. relative fractions exceed 1 or
3612	!-- vegetation_type is set but surface vegetation fraction is zero,
3613	!-- etc..
3614	IF ( surface_fraction_f%from_file ) THEN
3615	!
3616	!-- If surface fractions is given, also check that only one type
3617	!-- is given.
3618	IF ( SUM( MERGE( 1, 0, surface_fraction_f%frac(:,j,i) /= 0.0_wp&
3619	.AND. surface_fraction_f%frac(:,j,i) /= &
3620	surface_fraction_f%fill ) ) > 1 ) THEN
3621	WRITE( message_string, * ) &
3622	'surface_fraction is given for more ' // &
3623	'than one type. ' // &
3624	'Please note, this is not possible at ' // &
3625	'the moment as no tile approach has '// &
3626	'yet been implemented. (i, j) = ', i, j
3627	CALL message( 'netcdf_data_input_mod', 'PA0676', &
3628	2, 2, myid, 6, 0 )
3629	ENDIF
3630	!
3631	!-- Sum of relative fractions must be 1. Note, attributed to type
3632	!-- conversions due to reading, the sum of surface fractions
3633	!-- might be not exactly 1. Hence, the sum is check with a
3634	!-- tolerance. Later, in the land-surface model, the relative
3635	!-- fractions are normalized to one. Actually, surface fractions
3636	!-- shall be _FillValue at building grid points, however, in order
3637	!-- to relax this requirement and allow that surface-fraction can
3638	!-- also be zero at these grid points, only perform this check
3639	!-- at locations where some vegetation, pavement or water is defined.
3640	IF ( vegetation_type_f%var(j,i) /= vegetation_type_f%fill .OR.&
3641	pavement_type_f%var(j,i) /= pavement_type_f%fill .OR.&
3642	water_type_f%var(j,i) /= water_type_f%fill ) THEN
3643	IF ( SUM ( surface_fraction_f%frac(0:2,j,i) ) > &
3644	1.0_wp + 1E-8_wp .OR. &
3645	SUM ( surface_fraction_f%frac(0:2,j,i) ) < &
3646	1.0_wp - 1E-8_wp ) THEN
3647	WRITE( message_string, * ) &
3648	'The sum of all land-surface fractions ' //&
3649	'must equal 1. (i, j) = ', i, j
3650	CALL message( 'netcdf_data_input_mod', 'PA0566', &
3651	2, 2, myid, 6, 0 )
3652	ENDIF
3653	ENDIF
3654	!
3655	!-- Relative fraction for a type must not be zero at locations where
3656	!-- this type is set.
3657	IF ( &
3658	( vegetation_type_f%var(j,i) /= vegetation_type_f%fill .AND.&
3659	( surface_fraction_f%frac(ind_veg_wall,j,i) == 0.0_wp .OR. &
3660	surface_fraction_f%frac(ind_veg_wall,j,i) == &
3661	surface_fraction_f%fill ) &
3662	) .OR. &
3663	( pavement_type_f%var(j,i) /= pavement_type_f%fill .AND. &
3664	( surface_fraction_f%frac(ind_pav_green,j,i) == 0.0_wp .OR. &
3665	surface_fraction_f%frac(ind_pav_green,j,i) == &
3666	surface_fraction_f%fill ) &
3667	) .OR. &
3668	( water_type_f%var(j,i) /= water_type_f%fill .AND. &
3669	( surface_fraction_f%frac(ind_wat_win,j,i) == 0.0_wp .OR. &
3670	surface_fraction_f%frac(ind_wat_win,j,i) == &
3671	surface_fraction_f%fill ) &
3672	) ) THEN
3673	WRITE( message_string, * ) 'Mismatch in setting of ' // &
3674	'surface_fraction. Vegetation-, pavement-, or '// &
3675	'water surface is given at (i,j) = ( ', i, j, &
3676	' ), but surface fraction is 0 for the given type.'
3677	CALL message( 'netcdf_data_input_mod', 'PA0567', &
3678	2, 2, myid, 6, 0 )
3679	ENDIF
3680	!
3681	!-- Relative fraction for a type must not contain non-zero values
3682	!-- if this type is not set.
3683	IF ( &
3684	( vegetation_type_f%var(j,i) == vegetation_type_f%fill .AND.&
3685	( surface_fraction_f%frac(ind_veg_wall,j,i) /= 0.0_wp .AND. &
3686	surface_fraction_f%frac(ind_veg_wall,j,i) /= &
3687	surface_fraction_f%fill ) &
3688	) .OR. &
3689	( pavement_type_f%var(j,i) == pavement_type_f%fill .AND. &
3690	( surface_fraction_f%frac(ind_pav_green,j,i) /= 0.0_wp .AND. &
3691	surface_fraction_f%frac(ind_pav_green,j,i) /= &
3692	surface_fraction_f%fill ) &
3693	) .OR. &
3694	( water_type_f%var(j,i) == water_type_f%fill .AND. &
3695	( surface_fraction_f%frac(ind_wat_win,j,i) /= 0.0_wp .AND. &
3696	surface_fraction_f%frac(ind_wat_win,j,i) /= &
3697	surface_fraction_f%fill ) &
3698	) ) THEN
3699	WRITE( message_string, * ) 'Mismatch in setting of ' // &
3700	'surface_fraction. Vegetation-, pavement-, or '// &
3701	'water surface is not given at (i,j) = ( ', i, j, &
3702	' ), but surface fraction is not 0 for the ' // &
3703	'given type.'
3704	CALL message( 'netcdf_data_input_mod', 'PA0568', &
3705	2, 2, myid, 6, 0 )
3706	ENDIF
3707	ENDIF
3708	!
3709	!-- Check vegetation_pars. If vegetation_type is 0, all parameters
3710	!-- need to be set, otherwise, single parameters set by
3711	!-- vegetation_type can be overwritten.
3712	IF ( vegetation_type_f%from_file ) THEN
3713	IF ( vegetation_type_f%var(j,i) == 0 ) THEN
3714	IF ( ANY( vegetation_pars_f%pars_xy(:,j,i) == &
3715	vegetation_pars_f%fill ) ) THEN
3716	message_string = 'If vegetation_type(y,x) = 0, all ' // &
3717	'parameters of vegetation_pars at '// &
3718	'this location must be set.'
3719	CALL message( 'netcdf_data_input_mod', 'PA0569', &
3720	2, 2, myid, 6, 0 )
3721	ENDIF
3722	ENDIF
3723	ENDIF
3724	!
3725	!-- Check root distribution. If vegetation_type is 0, all levels must
3726	!-- be set.
3727	IF ( vegetation_type_f%from_file ) THEN
3728	IF ( vegetation_type_f%var(j,i) == 0 ) THEN
3729	IF ( ANY( root_area_density_lsm_f%var(:,j,i) == &
3730	root_area_density_lsm_f%fill ) ) THEN
3731	message_string = 'If vegetation_type(y,x) = 0, all ' // &
3732	'levels of root_area_dens_s ' // &
3733	'must be set at this location.'
3734	CALL message( 'netcdf_data_input_mod', 'PA0570', &
3735	2, 2, myid, 6, 0 )
3736	ENDIF
3737	ENDIF
3738	ENDIF
3739	!
3740	!-- Check soil parameters. If soil_type is 0, all parameters
3741	!-- must be set.
3742	IF ( soil_type_f%from_file ) THEN
3743	check_passed = .TRUE.
3744	IF ( ALLOCATED( soil_type_f%var_2d ) ) THEN
3745	IF ( soil_type_f%var_2d(j,i) == 0 ) THEN
3746	IF ( ANY( soil_pars_f%pars_xy(:,j,i) == &
3747	soil_pars_f%fill ) ) check_passed = .FALSE.
3748	ENDIF
3749	ELSE
3750	IF ( ANY( soil_type_f%var_3d(:,j,i) == 0 ) ) THEN
3751	IF ( ANY( soil_pars_f%pars_xy(:,j,i) == &
3752	soil_pars_f%fill ) ) check_passed = .FALSE.
3753	ENDIF
3754	ENDIF
3755	IF ( .NOT. check_passed ) THEN
3756	message_string = 'If soil_type(y,x) = 0, all levels of ' //&
3757	'soil_pars at this location must be set.'
3758	CALL message( 'netcdf_data_input_mod', 'PA0571', &
3759	2, 2, myid, 6, 0 )
3760	ENDIF
3761	ENDIF
3762
3763	!
3764	!-- Check building parameters. If building_type is 0, all parameters
3765	!-- must be set.
3766	IF ( building_type_f%from_file ) THEN
3767	IF ( building_type_f%var(j,i) == 0 ) THEN
3768	IF ( ANY( building_pars_f%pars_xy(:,j,i) == &
3769	building_pars_f%fill ) ) THEN
3770	message_string = 'If building_type(y,x) = 0, all ' // &
3771	'parameters of building_pars at this '//&
3772	'location must be set.'
3773	CALL message( 'netcdf_data_input_mod', 'PA0572', &
3774	2, 2, myid, 6, 0 )
3775	ENDIF
3776	ENDIF
3777	ENDIF
3778	!
3779	!-- Check if building_type is set at each building and vice versa.
3780	!-- Please note, buildings are already processed and filtered.
3781	!-- For this reason, consistency checks are based on wall_flags_total_0
3782	!-- rather than buildings_f (buildings are represented by bit 6 in
3783	!-- wall_flags_total_0).
3784	IF ( building_type_f%from_file .AND. buildings_f%from_file ) THEN
3785	IF ( ANY( BTEST ( wall_flags_total_0(:,j,i), 6 ) ) .AND. &
3786	building_type_f%var(j,i) == building_type_f%fill .OR. &
3787	.NOT. ANY( BTEST ( wall_flags_total_0(:,j,i), 6 ) ) .AND. &
3788	building_type_f%var(j,i) /= building_type_f%fill ) THEN
3789	WRITE( message_string, * ) 'Each location where a ' // &
3790	'building is set requires a type ' // &
3791	'( and vice versa ) in case the ' // &
3792	'urban-surface model is applied. ' // &
3793	'i, j = ', i, j
3794	CALL message( 'netcdf_data_input_mod', 'PA0573', &
3795	2, 2, myid, 6, 0 )
3796	ENDIF
3797	ENDIF
3798	!
3799	!-- Check if at each location where a building is present also an ID
3800	!-- is set and vice versa.
3801	IF ( buildings_f%from_file ) THEN
3802	IF ( ANY( BTEST ( wall_flags_total_0(:,j,i), 6 ) ) .AND. &
3803	building_id_f%var(j,i) == building_id_f%fill .OR. &
3804	.NOT. ANY( BTEST ( wall_flags_total_0(:,j,i), 6 ) ) .AND. &
3805	building_id_f%var(j,i) /= building_id_f%fill ) THEN
3806	WRITE( message_string, * ) 'Each location where a ' // &
3807	'building is set requires an ID ' // &
3808	'( and vice versa ). i, j = ', i, j
3809	CALL message( 'netcdf_data_input_mod', 'PA0574', &
3810	2, 2, myid, 6, 0 )
3811	ENDIF
3812	ENDIF
3813	!
3814	!-- Check if building ID is set where a bulding is defined.
3815	IF ( buildings_f%from_file ) THEN
3816	IF ( ANY( BTEST ( wall_flags_total_0(:,j,i), 6 ) ) .AND. &
3817	building_id_f%var(j,i) == building_id_f%fill ) THEN
3818	WRITE( message_string, * ) 'Each building grid point '// &
3819	'requires an ID.', i, j
3820	CALL message( 'netcdf_data_input_mod', 'PA0575', &
3821	2, 2, myid, 6, 0 )
3822	ENDIF
3823	ENDIF
3824	!
3825	!-- Check albedo parameters. If albedo_type is 0, all parameters
3826	!-- must be set.
3827	IF ( albedo_type_f%from_file ) THEN
3828	IF ( albedo_type_f%var(j,i) == 0 ) THEN
3829	IF ( ANY( albedo_pars_f%pars_xy(:,j,i) == &
3830	albedo_pars_f%fill ) ) THEN
3831	message_string = 'If albedo_type(y,x) = 0, all ' // &
3832	'parameters of albedo_pars at this ' // &
3833	'location must be set.'
3834	CALL message( 'netcdf_data_input_mod', 'PA0576', &
3835	2, 2, myid, 6, 0 )
3836	ENDIF
3837	ENDIF
3838	ENDIF
3839
3840	!
3841	!-- Check pavement parameters. If pavement_type is 0, all parameters
3842	!-- of pavement_pars must be set at this location.
3843	IF ( pavement_type_f%from_file ) THEN
3844	IF ( pavement_type_f%var(j,i) == 0 ) THEN
3845	IF ( ANY( pavement_pars_f%pars_xy(:,j,i) == &
3846	pavement_pars_f%fill ) ) THEN
3847	message_string = 'If pavement_type(y,x) = 0, all ' // &
3848	'parameters of pavement_pars at this '//&
3849	'location must be set.'
3850	CALL message( 'netcdf_data_input_mod', 'PA0577', &
3851	2, 2, myid, 6, 0 )
3852	ENDIF
3853	ENDIF
3854	ENDIF
3855	!
3856	!-- Check pavement-subsurface parameters. If pavement_type is 0,
3857	!-- all parameters of pavement_subsurface_pars must be set at this
3858	!-- location.
3859	IF ( pavement_type_f%from_file ) THEN
3860	IF ( pavement_type_f%var(j,i) == 0 ) THEN
3861	IF ( ANY( pavement_subsurface_pars_f%pars_xyz(:,:,j,i) == &
3862	pavement_subsurface_pars_f%fill ) ) THEN
3863	message_string = 'If pavement_type(y,x) = 0, all ' // &
3864	'parameters of ' // &
3865	'pavement_subsurface_pars at this '// &
3866	'location must be set.'
3867	CALL message( 'netcdf_data_input_mod', 'PA0578', &
3868	2, 2, myid, 6, 0 )
3869	ENDIF
3870	ENDIF
3871	ENDIF
3872
3873	!
3874	!-- Check water parameters. If water_type is 0, all parameters
3875	!-- must be set at this location.
3876	IF ( water_type_f%from_file ) THEN
3877	IF ( water_type_f%var(j,i) == 0 ) THEN
3878	IF ( ANY( water_pars_f%pars_xy(:,j,i) == &
3879	water_pars_f%fill ) ) THEN
3880	message_string = 'If water_type(y,x) = 0, all ' // &
3881	'parameters of water_pars at this ' // &
3882	'location must be set.'
3883	CALL message( 'netcdf_data_input_mod', 'PA0579', &
3884	2, 2, myid, 6, 0 )
3885	ENDIF
3886	ENDIF
3887	ENDIF
3888
3889	ENDDO
3890	ENDDO
3891
3892	END SUBROUTINE netcdf_data_input_check_static
3893
3894	!------------------------------------------------------------------------------!
3895	! Description:
3896	! ------------
3897	!> Resize 8-bit 2D Integer array: (nys:nyn,nxl:nxr) -> (nysg:nyng,nxlg:nxrg)
3898	!------------------------------------------------------------------------------!
3899	SUBROUTINE resize_array_2d_int8( var, js, je, is, ie )
3900
3901	IMPLICIT NONE
3902
3903	INTEGER(iwp) :: je !< upper index bound along y direction
3904	INTEGER(iwp) :: js !< lower index bound along y direction
3905	INTEGER(iwp) :: ie !< upper index bound along x direction
3906	INTEGER(iwp) :: is !< lower index bound along x direction
3907
3908	INTEGER(KIND=1), DIMENSION(:,:), ALLOCATABLE :: var !< treated variable
3909	INTEGER(KIND=1), DIMENSION(:,:), ALLOCATABLE :: var_tmp !< temporary copy
3910	!
3911	!-- Allocate temporary variable
3912	ALLOCATE( var_tmp(js-nbgp:je+nbgp,is-nbgp:ie+nbgp) )
3913	!
3914	!-- Temporary copy of the variable
3915	var_tmp(js:je,is:ie) = var(js:je,is:ie)
3916	!
3917	!-- Resize the array
3918	DEALLOCATE( var )
3919	ALLOCATE( var(js-nbgp:je+nbgp,is-nbgp:ie+nbgp) )
3920	!
3921	!-- Transfer temporary copy back to original array
3922	var(js:je,is:ie) = var_tmp(js:je,is:ie)
3923
3924	END SUBROUTINE resize_array_2d_int8
3925
3926	!------------------------------------------------------------------------------!
3927	! Description:
3928	! ------------
3929	!> Resize 32-bit 2D Integer array: (nys:nyn,nxl:nxr) -> (nysg:nyng,nxlg:nxrg)
3930	!------------------------------------------------------------------------------!
3931	SUBROUTINE resize_array_2d_int32( var, js, je, is, ie )
3932
3933	IMPLICIT NONE
3934
3935	INTEGER(iwp) :: je !< upper index bound along y direction
3936	INTEGER(iwp) :: js !< lower index bound along y direction
3937	INTEGER(iwp) :: ie !< upper index bound along x direction
3938	INTEGER(iwp) :: is !< lower index bound along x direction
3939
3940	INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE :: var !< treated variable
3941	INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE :: var_tmp !< temporary copy
3942	!
3943	!-- Allocate temporary variable
3944	ALLOCATE( var_tmp(js-nbgp:je+nbgp,is-nbgp:ie+nbgp) )
3945	!
3946	!-- Temporary copy of the variable
3947	var_tmp(js:je,is:ie) = var(js:je,is:ie)
3948	!
3949	!-- Resize the array
3950	DEALLOCATE( var )
3951	ALLOCATE( var(js-nbgp:je+nbgp,is-nbgp:ie+nbgp) )
3952	!
3953	!-- Transfer temporary copy back to original array
3954	var(js:je,is:ie) = var_tmp(js:je,is:ie)
3955
3956	END SUBROUTINE resize_array_2d_int32
3957
3958	!------------------------------------------------------------------------------!
3959	! Description:
3960	! ------------
3961	!> Resize 8-bit 3D Integer array: (:,nys:nyn,nxl:nxr) -> (:,nysg:nyng,nxlg:nxrg)
3962	!------------------------------------------------------------------------------!
3963	SUBROUTINE resize_array_3d_int8( var, ks, ke, js, je, is, ie )
3964
3965	IMPLICIT NONE
3966
3967	INTEGER(iwp) :: je !< upper index bound along y direction
3968	INTEGER(iwp) :: js !< lower index bound along y direction
3969	INTEGER(iwp) :: ie !< upper index bound along x direction
3970	INTEGER(iwp) :: is !< lower index bound along x direction
3971	INTEGER(iwp) :: ke !< upper bound of treated array in z-direction
3972	INTEGER(iwp) :: ks !< lower bound of treated array in z-direction
3973
3974	INTEGER(KIND=1), DIMENSION(:,:,:), ALLOCATABLE :: var !< treated variable
3975	INTEGER(KIND=1), DIMENSION(:,:,:), ALLOCATABLE :: var_tmp !< temporary copy
3976	!
3977	!-- Allocate temporary variable
3978	ALLOCATE( var_tmp(ks:ke,js-nbgp:je+nbgp,is-nbgp:ie+nbgp) )
3979	!
3980	!-- Temporary copy of the variable
3981	var_tmp(ks:ke,js:je,is:ie) = var(ks:ke,js:je,is:ie)
3982	!
3983	!-- Resize the array
3984	DEALLOCATE( var )
3985	ALLOCATE( var(ks:ke,js-nbgp:je+nbgp,is-nbgp:ie+nbgp) )
3986	!
3987	!-- Transfer temporary copy back to original array
3988	var(ks:ke,js:je,is:ie) = var_tmp(ks:ke,js:je,is:ie)
3989
3990	END SUBROUTINE resize_array_3d_int8
3991
3992	!------------------------------------------------------------------------------!
3993	! Description:
3994	! ------------
3995	!> Resize 3D Real array: (:,nys:nyn,nxl:nxr) -> (:,nysg:nyng,nxlg:nxrg)
3996	!------------------------------------------------------------------------------!
3997	SUBROUTINE resize_array_3d_real( var, ks, ke, js, je, is, ie )
3998
3999	IMPLICIT NONE
4000
4001	INTEGER(iwp) :: je !< upper index bound along y direction
4002	INTEGER(iwp) :: js !< lower index bound along y direction
4003	INTEGER(iwp) :: ie !< upper index bound along x direction
4004	INTEGER(iwp) :: is !< lower index bound along x direction
4005	INTEGER(iwp) :: ke !< upper bound of treated array in z-direction
4006	INTEGER(iwp) :: ks !< lower bound of treated array in z-direction
4007
4008	REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: var !< treated variable
4009	REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: var_tmp !< temporary copy
4010	!
4011	!-- Allocate temporary variable
4012	ALLOCATE( var_tmp(ks:ke,js-nbgp:je+nbgp,is-nbgp:ie+nbgp) )
4013	!
4014	!-- Temporary copy of the variable
4015	var_tmp(ks:ke,js:je,is:ie) = var(ks:ke,js:je,is:ie)
4016	!
4017	!-- Resize the array
4018	DEALLOCATE( var )
4019	ALLOCATE( var(ks:ke,js-nbgp:je+nbgp,is-nbgp:ie+nbgp) )
4020	!
4021	!-- Transfer temporary copy back to original array
4022	var(ks:ke,js:je,is:ie) = var_tmp(ks:ke,js:je,is:ie)
4023
4024	END SUBROUTINE resize_array_3d_real
4025
4026	!------------------------------------------------------------------------------!
4027	! Description:
4028	! ------------
4029	!> Resize 4D Real array: (:,:,nys:nyn,nxl:nxr) -> (:,nysg:nyng,nxlg:nxrg)
4030	!------------------------------------------------------------------------------!
4031	SUBROUTINE resize_array_4d_real( var, k1s, k1e, k2s, k2e, js, je, is, ie )
4032
4033	IMPLICIT NONE
4034
4035	INTEGER(iwp) :: je !< upper index bound along y direction
4036	INTEGER(iwp) :: js !< lower index bound along y direction
4037	INTEGER(iwp) :: ie !< upper index bound along x direction
4038	INTEGER(iwp) :: is !< lower index bound along x direction
4039	INTEGER(iwp) :: k1e !< upper bound of treated array in z-direction
4040	INTEGER(iwp) :: k1s !< lower bound of treated array in z-direction
4041	INTEGER(iwp) :: k2e !< upper bound of treated array along parameter space
4042	INTEGER(iwp) :: k2s !< lower bound of treated array along parameter space
4043
4044	REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: var !< treated variable
4045	REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: var_tmp !< temporary copy
4046	!
4047	!-- Allocate temporary variable
4048	ALLOCATE( var_tmp(k1s:k1e,k2s:k2e,js-nbgp:je+nbgp,is-nbgp:ie+nbgp) )
4049	!
4050	!-- Temporary copy of the variable
4051	var_tmp(k1s:k1e,k2s:k2e,js:je,is:ie) = var(k1s:k1e,k2s:k2e,js:je,is:ie)
4052	!
4053	!-- Resize the array
4054	DEALLOCATE( var )
4055	ALLOCATE( var(k1s:k1e,k2s:k2e,js-nbgp:je+nbgp,is-nbgp:ie+nbgp) )
4056	!
4057	!-- Transfer temporary copy back to original array
4058	var(k1s:k1e,k2s:k2e,js:je,is:ie) = var_tmp(k1s:k1e,k2s:k2e,js:je,is:ie)
4059
4060	END SUBROUTINE resize_array_4d_real
4061
4062	!------------------------------------------------------------------------------!
4063	! Description:
4064	! ------------
4065	!> Checks if a given variables is on file
4066	!------------------------------------------------------------------------------!
4067	FUNCTION check_existence( vars_in_file, var_name )
4068
4069	IMPLICIT NONE
4070
4071	CHARACTER(LEN=*) :: var_name !< variable to be checked
4072	CHARACTER(LEN=*), DIMENSION(:) :: vars_in_file !< list of variables in file
4073
4074	INTEGER(iwp) :: i !< loop variable
4075
4076	LOGICAL :: check_existence !< flag indicating whether a variable exist or not - actual return value
4077
4078	i = 1
4079	check_existence = .FALSE.
4080	DO WHILE ( i <= SIZE( vars_in_file ) )
4081	check_existence = TRIM( vars_in_file(i) ) == TRIM( var_name ) .OR. &
4082	check_existence
4083	i = i + 1
4084	ENDDO
4085
4086	RETURN
4087
4088	END FUNCTION check_existence
4089
4090
4091	!------------------------------------------------------------------------------!
4092	! Description:
4093	! ------------
4094	!> Closes an existing netCDF file.
4095	!------------------------------------------------------------------------------!
4096	SUBROUTINE close_input_file( id )
4097	#if defined( __netcdf )
4098
4099	USE pegrid
4100
4101	IMPLICIT NONE
4102
4103	INTEGER(iwp), INTENT(INOUT) :: id !< file id
4104
4105	nc_stat = NF90_CLOSE( id )
4106	CALL handle_error( 'close', 540 )
4107	#endif
4108	END SUBROUTINE close_input_file
4109
4110	!------------------------------------------------------------------------------!
4111	! Description:
4112	! ------------
4113	!> Opens an existing netCDF file for reading only and returns its id.
4114	!------------------------------------------------------------------------------!
4115	SUBROUTINE open_read_file( filename, id )
4116	#if defined( __netcdf )
4117
4118	USE pegrid
4119
4120	IMPLICIT NONE
4121
4122	CHARACTER (LEN=*), INTENT(IN) :: filename !< filename
4123	INTEGER(iwp), INTENT(INOUT) :: id !< file id
4124
4125	#if defined( __netcdf4_parallel )
4126	!
4127	!-- If __netcdf4_parallel is defined, parrallel NetCDF will be used.
4128	nc_stat = NF90_OPEN( filename, IOR( NF90_NOWRITE, NF90_MPIIO ), id, &
4129	COMM = comm2d, INFO = MPI_INFO_NULL )
4130	!
4131	!-- In case the previous open call fails, check for possible Netcdf 3 file,
4132	!-- and open it. However, this case, disable parallel access.
4133	IF( nc_stat /= NF90_NOERR ) THEN
4134	nc_stat = NF90_OPEN( filename, NF90_NOWRITE, id )
4135	collective_read = .FALSE.
4136	ELSE
4137	collective_read = .TRUE.
4138	ENDIF
4139	#else
4140	!
4141	!-- All MPI processes open the file and read it (but not in parallel).
4142	nc_stat = NF90_OPEN( filename, NF90_NOWRITE, id )
4143	#endif
4144
4145	CALL handle_error( 'open_read_file', 539 )
4146
4147	#endif
4148	END SUBROUTINE open_read_file
4149
4150	!------------------------------------------------------------------------------!
4151	! Description:
4152	! ------------
4153	!> Reads global or variable-related attributes of type INTEGER (32-bit)
4154	!------------------------------------------------------------------------------!
4155	SUBROUTINE get_attribute_int32( id, attribute_name, value, global, &
4156	variable_name )
4157
4158	USE pegrid
4159
4160	IMPLICIT NONE
4161
4162	CHARACTER(LEN=*) :: attribute_name !< attribute name
4163	CHARACTER(LEN=*), OPTIONAL :: variable_name !< variable name
4164
4165	INTEGER(iwp), INTENT(IN) :: id !< file id
4166	INTEGER(iwp) :: id_var !< variable id
4167	INTEGER(iwp), INTENT(INOUT) :: value !< read value
4168
4169	LOGICAL, INTENT(IN) :: global !< flag indicating global attribute
4170	#if defined( __netcdf )
4171
4172	!
4173	!-- Read global attribute
4174	IF ( global ) THEN
4175	nc_stat = NF90_GET_ATT( id, NF90_GLOBAL, TRIM( attribute_name ), value )
4176	CALL handle_error( 'get_attribute_int32 global', 522, attribute_name )
4177	!
4178	!-- Read attributes referring to a single variable. Therefore, first inquire
4179	!-- variable id
4180	ELSE
4181	nc_stat = NF90_INQ_VARID( id, TRIM( variable_name ), id_var )
4182	CALL handle_error( 'get_attribute_int32', 522, attribute_name )
4183	nc_stat = NF90_GET_ATT( id, id_var, TRIM( attribute_name ), value )
4184	CALL handle_error( 'get_attribute_int32', 522, attribute_name )
4185	ENDIF
4186	#endif
4187	END SUBROUTINE get_attribute_int32
4188
4189	!------------------------------------------------------------------------------!
4190	! Description:
4191	! ------------
4192	!> Reads global or variable-related attributes of type INTEGER (8-bit)
4193	!------------------------------------------------------------------------------!
4194	SUBROUTINE get_attribute_int8( id, attribute_name, value, global, &
4195	variable_name )
4196
4197	USE pegrid
4198
4199	IMPLICIT NONE
4200
4201	CHARACTER(LEN=*) :: attribute_name !< attribute name
4202	CHARACTER(LEN=*), OPTIONAL :: variable_name !< variable name
4203
4204	INTEGER(iwp), INTENT(IN) :: id !< file id
4205	INTEGER(iwp) :: id_var !< variable id
4206	INTEGER(KIND=1), INTENT(INOUT) :: value !< read value
4207
4208	LOGICAL, INTENT(IN) :: global !< flag indicating global attribute
4209	#if defined( __netcdf )
4210
4211	!
4212	!-- Read global attribute
4213	IF ( global ) THEN
4214	nc_stat = NF90_GET_ATT( id, NF90_GLOBAL, TRIM( attribute_name ), value )
4215	CALL handle_error( 'get_attribute_int8 global', 523, attribute_name )
4216	!
4217	!-- Read attributes referring to a single variable. Therefore, first inquire
4218	!-- variable id
4219	ELSE
4220	nc_stat = NF90_INQ_VARID( id, TRIM( variable_name ), id_var )
4221	CALL handle_error( 'get_attribute_int8', 523, attribute_name )
4222	nc_stat = NF90_GET_ATT( id, id_var, TRIM( attribute_name ), value )
4223	CALL handle_error( 'get_attribute_int8', 523, attribute_name )
4224	ENDIF
4225	#endif
4226	END SUBROUTINE get_attribute_int8
4227
4228	!------------------------------------------------------------------------------!
4229	! Description:
4230	! ------------
4231	!> Reads global or variable-related attributes of type REAL
4232	!------------------------------------------------------------------------------!
4233	SUBROUTINE get_attribute_real( id, attribute_name, value, global, &
4234	variable_name )
4235
4236	USE pegrid
4237
4238	IMPLICIT NONE
4239
4240	CHARACTER(LEN=*) :: attribute_name !< attribute name
4241	CHARACTER(LEN=*), OPTIONAL :: variable_name !< variable name
4242
4243	INTEGER(iwp), INTENT(IN) :: id !< file id
4244	INTEGER(iwp) :: id_var !< variable id
4245
4246	LOGICAL, INTENT(IN) :: global !< flag indicating global attribute
4247
4248	REAL(wp), INTENT(INOUT) :: value !< read value
4249	#if defined( __netcdf )
4250
4251
4252	!
4253	!-- Read global attribute
4254	IF ( global ) THEN
4255	nc_stat = NF90_GET_ATT( id, NF90_GLOBAL, TRIM( attribute_name ), value )
4256	CALL handle_error( 'get_attribute_real global', 524, attribute_name )
4257	!
4258	!-- Read attributes referring to a single variable. Therefore, first inquire
4259	!-- variable id
4260	ELSE
4261	nc_stat = NF90_INQ_VARID( id, TRIM( variable_name ), id_var )
4262	CALL handle_error( 'get_attribute_real', 524, attribute_name )
4263	nc_stat = NF90_GET_ATT( id, id_var, TRIM( attribute_name ), value )
4264	CALL handle_error( 'get_attribute_real', 524, attribute_name )
4265	ENDIF
4266	#endif
4267	END SUBROUTINE get_attribute_real
4268
4269	!------------------------------------------------------------------------------!
4270	! Description:
4271	! ------------
4272	!> Reads global or variable-related attributes of type CHARACTER
4273	!> Remark: reading attributes of type NF_STRING return an error code 56 -
4274	!> Attempt to convert between text & numbers.
4275	!------------------------------------------------------------------------------!
4276	SUBROUTINE get_attribute_string( id, attribute_name, value, global, &
4277	variable_name, no_abort )
4278
4279	USE pegrid
4280
4281	IMPLICIT NONE
4282
4283	CHARACTER(LEN=*) :: attribute_name !< attribute name
4284	CHARACTER(LEN=*), OPTIONAL :: variable_name !< variable name
4285	CHARACTER(LEN=*), INTENT(INOUT) :: value !< read value
4286
4287	INTEGER(iwp), INTENT(IN) :: id !< file id
4288	INTEGER(iwp) :: id_var !< variable id
4289
4290	LOGICAL :: check_error !< flag indicating if handle_error shall be checked
4291	LOGICAL, INTENT(IN) :: global !< flag indicating global attribute
4292	LOGICAL, INTENT(IN), OPTIONAL :: no_abort !< flag indicating if errors should be checked
4293	#if defined( __netcdf )
4294
4295	IF ( PRESENT( no_abort ) ) THEN
4296	check_error = no_abort
4297	ELSE
4298	check_error = .TRUE.
4299	ENDIF
4300	!
4301	!-- Read global attribute
4302	IF ( global ) THEN
4303	nc_stat = NF90_GET_ATT( id, NF90_GLOBAL, TRIM( attribute_name ), value )
4304	IF ( check_error) CALL handle_error( 'get_attribute_string global', 525, attribute_name )
4305	!
4306	!-- Read attributes referring to a single variable. Therefore, first inquire
4307	!-- variable id
4308	ELSE
4309	nc_stat = NF90_INQ_VARID( id, TRIM( variable_name ), id_var )
4310	IF ( check_error) CALL handle_error( 'get_attribute_string', 525, attribute_name )
4311
4312	nc_stat = NF90_GET_ATT( id, id_var, TRIM( attribute_name ), value )
4313	IF ( check_error) CALL handle_error( 'get_attribute_string',525, attribute_name )
4314
4315	ENDIF
4316	#endif
4317	END SUBROUTINE get_attribute_string
4318
4319
4320
4321	!------------------------------------------------------------------------------!
4322	! Description:
4323	! ------------
4324	!> Get dimension array for a given dimension
4325	!------------------------------------------------------------------------------!
4326	SUBROUTINE get_dimension_length( id, dim_len, variable_name )
4327	USE pegrid
4328
4329	IMPLICIT NONE
4330
4331	CHARACTER(LEN=*) :: variable_name !< dimension name
4332	CHARACTER(LEN=100) :: dum !< dummy variable to receive return character
4333
4334	INTEGER(iwp) :: dim_len !< dimension size
4335	INTEGER(iwp), INTENT(IN) :: id !< file id
4336	INTEGER(iwp) :: id_dim !< dimension id
4337
4338	#if defined( __netcdf )
4339	!
4340	!-- First, inquire dimension ID
4341	nc_stat = NF90_INQ_DIMID( id, TRIM( variable_name ), id_dim )
4342	CALL handle_error( 'get_dimension_length', 526, variable_name )
4343	!
4344	!-- Inquire dimension length
4345	nc_stat = NF90_INQUIRE_DIMENSION( id, id_dim, dum, LEN = dim_len )
4346	CALL handle_error( 'get_dimension_length', 526, variable_name )
4347
4348	#endif
4349	END SUBROUTINE get_dimension_length
4350
4351	!------------------------------------------------------------------------------!
4352	! Description:
4353	! ------------
4354	!> Routine for reading-in a character string from the chem emissions netcdf
4355	!> input file.
4356	!------------------------------------------------------------------------------!
4357	SUBROUTINE get_variable_string( id, variable_name, var_string, names_number)
4358	#if defined( __netcdf )
4359
4360	USE indices
4361	USE pegrid
4362
4363	IMPLICIT NONE
4364
4365	CHARACTER (LEN=25), ALLOCATABLE, DIMENSION(:), INTENT(INOUT) :: var_string
4366
4367	CHARACTER(LEN=*) :: variable_name !> variable name
4368
4369	CHARACTER (LEN=1), ALLOCATABLE, DIMENSION(:,:) :: tmp_var_string !> variable to be read
4370
4371
4372	INTEGER(iwp), INTENT(IN) :: id !> file id
4373
4374	INTEGER(iwp), INTENT(IN) :: names_number !> number of names
4375
4376	INTEGER(iwp) :: id_var !> variable id
4377
4378	INTEGER(iwp) :: i,j !> index to go through the length of the dimensions
4379
4380	INTEGER(iwp) :: max_string_length=25 !> this is both the maximum length of a name, but also
4381	! the number of the components of the first dimensions
4382	! (rows)
4383
4384
4385	ALLOCATE(tmp_var_string(max_string_length,names_number))
4386
4387	ALLOCATE(var_string(names_number))
4388
4389	!-- Inquire variable id
4390	nc_stat = NF90_INQ_VARID( id, TRIM( variable_name ), id_var )
4391
4392
4393	!-- Get variable
4394	!-- Start cycle over the emission species
4395	DO i = 1, names_number
4396	!-- read the first letter of each component
4397	nc_stat = NF90_GET_VAR( id, id_var, var_string(i), start = (/ 1,i /), &
4398	count = (/ 1,1 /) )
4399	CALL handle_error( 'get_variable_string', 701 )
4400
4401	!-- Start cycle over charachters
4402	DO j = 1, max_string_length
4403
4404	!-- read the rest of the components of the name
4405	nc_stat = NF90_GET_VAR( id, id_var, tmp_var_string(j,i), start = (/ j,i /),&
4406	count = (/ 1,1 /) )
4407	CALL handle_error( 'get_variable_string', 702 )
4408
4409	IF ( iachar(tmp_var_string(j,i) ) == 0 ) THEN
4410	tmp_var_string(j,i)=''
4411	ENDIF
4412
4413	IF ( j>1 ) THEN
4414	!-- Concatenate first letter of the name and the others
4415	var_string(i)=TRIM(var_string(i)) // TRIM(tmp_var_string(j,i))
4416
4417	ENDIF
4418	ENDDO
4419	ENDDO
4420
4421	#endif
4422	END SUBROUTINE get_variable_string
4423
4424	!------------------------------------------------------------------------------!
4425	! Description:
4426	! ------------
4427	!> Reads a character variable in a 1D array
4428	!------------------------------------------------------------------------------!
4429	SUBROUTINE get_variable_1d_char( id, variable_name, var )
4430
4431	USE pegrid
4432
4433	IMPLICIT NONE
4434
4435	CHARACTER(LEN=*) :: variable_name !< variable name
4436	CHARACTER(LEN=*), DIMENSION(:), INTENT(INOUT) :: var !< variable to be read
4437
4438	INTEGER(iwp) :: i !< running index over variable dimension
4439	INTEGER(iwp), INTENT(IN) :: id !< file id
4440	INTEGER(iwp) :: id_var !< dimension id
4441
4442	INTEGER(iwp), DIMENSION(2) :: dimid !< dimension IDs
4443	INTEGER(iwp), DIMENSION(2) :: dimsize !< dimension size
4444
4445	#if defined( __netcdf )
4446
4447	!
4448	!-- First, inquire variable ID
4449	nc_stat = NF90_INQ_VARID( id, TRIM( variable_name ), id_var )
4450	CALL handle_error( 'get_variable_1d_int', 527, variable_name )
4451	!
4452	!-- Inquire dimension IDs
4453	nc_stat = NF90_INQUIRE_VARIABLE( id, id_var, dimids = dimid(1:2) )
4454	CALL handle_error( 'get_variable_1d_char', 527, variable_name )
4455	!
4456	!-- Read dimesnion length
4457	nc_stat = NF90_INQUIRE_DIMENSION( id, dimid(1), LEN = dimsize(1) )
4458	nc_stat = NF90_INQUIRE_DIMENSION( id, dimid(2), LEN = dimsize(2) )
4459
4460	!
4461	!-- Read character array. Note, each element is read individually, in order
4462	!-- to better separate single strings.
4463	DO i = 1, dimsize(2)
4464	nc_stat = NF90_GET_VAR( id, id_var, var(i), &
4465	start = (/ 1, i /), &
4466	count = (/ dimsize(1), 1 /) )
4467	CALL handle_error( 'get_variable_1d_char', 527, variable_name )
4468	ENDDO
4469
4470	#endif
4471	END SUBROUTINE get_variable_1d_char
4472
4473
4474	!------------------------------------------------------------------------------!
4475	! Description:
4476	! ------------
4477	!> Reads a 1D integer variable from file.
4478	!------------------------------------------------------------------------------!
4479	SUBROUTINE get_variable_1d_int( id, variable_name, var )
4480
4481	USE pegrid
4482
4483	IMPLICIT NONE
4484
4485	CHARACTER(LEN=*) :: variable_name !< variable name
4486
4487	INTEGER(iwp), INTENT(IN) :: id !< file id
4488	INTEGER(iwp) :: id_var !< dimension id
4489
4490	INTEGER(iwp), DIMENSION(:), INTENT(INOUT) :: var !< variable to be read
4491	#if defined( __netcdf )
4492
4493	!
4494	!-- First, inquire variable ID
4495	nc_stat = NF90_INQ_VARID( id, TRIM( variable_name ), id_var )
4496	CALL handle_error( 'get_variable_1d_int', 527, variable_name )
4497	!
4498	!-- Inquire dimension length
4499	nc_stat = NF90_GET_VAR( id, id_var, var )
4500	CALL handle_error( 'get_variable_1d_int', 527, variable_name )
4501
4502	#endif
4503	END SUBROUTINE get_variable_1d_int
4504
4505	!------------------------------------------------------------------------------!
4506	! Description:
4507	! ------------
4508	!> Reads a 1D float variable from file.
4509	!------------------------------------------------------------------------------!
4510	SUBROUTINE get_variable_1d_real( id, variable_name, var )
4511
4512	USE pegrid
4513
4514	IMPLICIT NONE
4515
4516	CHARACTER(LEN=*) :: variable_name !< variable name
4517
4518	INTEGER(iwp), INTENT(IN) :: id !< file id
4519	INTEGER(iwp) :: id_var !< dimension id
4520
4521	REAL(wp), DIMENSION(:), INTENT(INOUT) :: var !< variable to be read
4522	#if defined( __netcdf )
4523
4524	!
4525	!-- First, inquire variable ID
4526	nc_stat = NF90_INQ_VARID( id, TRIM( variable_name ), id_var )
4527	CALL handle_error( 'get_variable_1d_real', 528, variable_name )
4528	!
4529	!-- Inquire dimension length
4530	nc_stat = NF90_GET_VAR( id, id_var, var )
4531	CALL handle_error( 'get_variable_1d_real', 528, variable_name )
4532
4533	#endif
4534	END SUBROUTINE get_variable_1d_real
4535
4536
4537	!------------------------------------------------------------------------------!
4538	! Description:
4539	! ------------
4540	!> Reads a time-dependent 1D float variable from file.
4541	!------------------------------------------------------------------------------!
4542	SUBROUTINE get_variable_pr( id, variable_name, t, var )
4543	#if defined( __netcdf )
4544
4545	USE pegrid
4546
4547	IMPLICIT NONE
4548
4549	CHARACTER(LEN=*) :: variable_name !< variable name
4550
4551	INTEGER(iwp), INTENT(IN) :: id !< file id
4552	INTEGER(iwp), DIMENSION(1:2) :: id_dim !< dimension ids
4553	INTEGER(iwp) :: id_var !< dimension id
4554	INTEGER(iwp) :: n_file !< number of data-points in file along z dimension
4555	INTEGER(iwp), INTENT(IN) :: t !< timestep number
4556
4557	REAL(wp), DIMENSION(:), INTENT(INOUT) :: var !< variable to be read
4558
4559	!
4560	!-- First, inquire variable ID
4561	nc_stat = NF90_INQ_VARID( id, TRIM( variable_name ), id_var )
4562	!
4563	!-- Inquire dimension size of vertical dimension
4564	nc_stat = NF90_INQUIRE_VARIABLE( id, id_var, DIMIDS = id_dim )
4565	nc_stat = NF90_INQUIRE_DIMENSION( id, id_dim(1), LEN = n_file )
4566	!
4567	!-- Read variable.
4568	nc_stat = NF90_GET_VAR( id, id_var, var, &
4569	start = (/ 1, t /), &
4570	count = (/ n_file, 1 /) )
4571	CALL handle_error( 'get_variable_pr', 529, variable_name )
4572
4573	#endif
4574	END SUBROUTINE get_variable_pr
4575
4576
4577	!------------------------------------------------------------------------------!
4578	! Description:
4579	! ------------
4580	!> Reads a per-surface pars variable from file. Because all surfaces are stored
4581	!> as flat 1-D array, each PE has to scan the data and find the surface indices
4582	!> belonging to its subdomain. During this scan, it also builds a necessary
4583	!> (j,i) index.
4584	!------------------------------------------------------------------------------!
4585	SUBROUTINE get_variable_surf( id, variable_name, surf )
4586	#if defined( __netcdf )
4587
4588	USE pegrid
4589
4590	USE indices, &
4591	ONLY: nxl, nxr, nys, nyn
4592
4593	USE control_parameters, &
4594	ONLY: dz, message_string
4595
4596	USE grid_variables, &
4597	ONLY: dx, dy
4598
4599	USE basic_constants_and_equations_mod, &
4600	ONLY: pi
4601
4602	IMPLICIT NONE
4603
4604	INTEGER, PARAMETER :: nsurf_pars_read = 1024**2 !< read buffer size
4605
4606	CHARACTER(LEN=*) :: variable_name !< variable name
4607
4608	INTEGER(iwp), DIMENSION(6) :: coords !< integer coordinates of surface
4609	INTEGER(iwp) :: i, j
4610	INTEGER(iwp) :: isurf !< netcdf surface index
4611	INTEGER(iwp) :: is !< local surface index
4612	INTEGER(iwp), INTENT(IN) :: id !< file id
4613	INTEGER(iwp), DIMENSION(2) :: id_dim !< dimension ids
4614	INTEGER(iwp) :: id_var !< variable id
4615	INTEGER(iwp) :: id_zs !< zs variable id
4616	INTEGER(iwp) :: id_ys !< ys variable id
4617	INTEGER(iwp) :: id_xs !< xs variable id
4618	INTEGER(iwp) :: id_zenith !< zeith variable id
4619	INTEGER(iwp) :: id_azimuth !< azimuth variable id
4620	INTEGER(iwp) :: is0, isc !< read surface start and count
4621	INTEGER(iwp) :: nsurf !< total number of surfaces in file
4622	INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE :: nsurf_ji !< numbers of surfaces by coords
4623
4624	TYPE(pars_surf) :: surf !< parameters variable to be loaded
4625	REAL(wp), DIMENSION(:,:), ALLOCATABLE :: pars_read !< read buffer
4626	REAL(wp), DIMENSION(:), ALLOCATABLE :: zs, ys, xs !< read buffer for zs(s), ys, xs
4627	REAL(wp), DIMENSION(:), ALLOCATABLE :: zenith !< read buffer for zenith(s)
4628	REAL(wp), DIMENSION(:), ALLOCATABLE :: azimuth !< read buffer for azimuth(s)
4629	REAL(wp) :: oro_max_l !< maximum terrain height under building
4630
4631	!
4632	!-- First, inquire variable ID
4633	nc_stat = NF90_INQ_VARID( id, TRIM( variable_name ), id_var )
4634	nc_stat = NF90_INQ_VARID( id, 'zs', id_zs )
4635	nc_stat = NF90_INQ_VARID( id, 'ys', id_ys )
4636	nc_stat = NF90_INQ_VARID( id, 'xs', id_xs )
4637	nc_stat = NF90_INQ_VARID( id, 'zenith', id_zenith )
4638	nc_stat = NF90_INQ_VARID( id, 'azimuth', id_azimuth )
4639	!
4640	!-- Inquire dimension sizes
4641	nc_stat = NF90_INQUIRE_VARIABLE( id, id_var, DIMIDS = id_dim )
4642	nc_stat = NF90_INQUIRE_DIMENSION( id, id_dim(1), LEN = nsurf )
4643	nc_stat = NF90_INQUIRE_DIMENSION( id, id_dim(2), LEN = surf%np )
4644
4645	ALLOCATE ( pars_read( nsurf_pars_read, surf%np ), &
4646	zs(nsurf_pars_read), ys(nsurf_pars_read), &
4647	xs(nsurf_pars_read), zenith(nsurf_pars_read), &
4648	azimuth(nsurf_pars_read), &
4649	nsurf_ji(nys:nyn, nxl:nxr) )
4650
4651	nsurf_ji(:,:) = 0
4652	!
4653	!-- Scan surface coordinates, count local
4654	is0 = 1
4655	DO
4656	isc = MIN(nsurf_pars_read, nsurf - is0 + 1)
4657	IF ( isc <= 0 ) EXIT
4658
4659	nc_stat = NF90_GET_VAR( id, id_ys, ys, &
4660	start = (/ is0 /), &
4661	count = (/ isc /) )
4662	nc_stat = NF90_GET_VAR( id, id_xs, xs, &
4663	start = (/ is0 /), &
4664	count = (/ isc /) )
4665	nc_stat = NF90_GET_VAR( id, id_zenith, zenith, &
4666	start = (/ is0 /), &
4667	count = (/ isc /) )
4668	nc_stat = NF90_GET_VAR( id, id_azimuth, azimuth, &
4669	start = (/ is0 /), &
4670	count = (/ isc /) )
4671	CALL handle_error( 'get_variable_surf', 682, 'azimuth' )
4672
4673	DO isurf = 1, isc
4674	!
4675	!-- Parse coordinates, detect if belongs to subdomain
4676	coords = transform_coords( xs(isurf), ys(isurf), &
4677	zenith(isurf), azimuth(isurf) )
4678	IF ( coords(2) < nys .OR. coords(2) > nyn .OR. &
4679	coords(3) < nxl .OR. coords(3) > nxr ) CYCLE
4680
4681	nsurf_ji(coords(2), coords(3)) = nsurf_ji(coords(2), coords(3)) + 1
4682	ENDDO
4683
4684	is0 = is0 + isc
4685	ENDDO
4686	!
4687	!-- Populate reverse index from surface counts
4688	ALLOCATE ( surf%index_ji( 2, nys:nyn, nxl:nxr ) )
4689
4690	isurf = 1
4691	DO j = nys, nyn
4692	DO i = nxl, nxr
4693	surf%index_ji(:,j,i) = (/ isurf, isurf + nsurf_ji(j,i) - 1 /)
4694	isurf = isurf + nsurf_ji(j,i)
4695	ENDDO
4696	ENDDO
4697
4698	surf%nsurf = isurf - 1
4699	ALLOCATE( surf%pars( 0:surf%np-1, surf%nsurf ), &
4700	surf%coords( 6, surf%nsurf ) )
4701	!
4702	!-- Scan surfaces again, saving pars into allocated structures
4703	nsurf_ji(:,:) = 0
4704	is0 = 1
4705	DO
4706	isc = MIN(nsurf_pars_read, nsurf - is0 + 1)
4707	IF ( isc <= 0 ) EXIT
4708
4709	nc_stat = NF90_GET_VAR( id, id_var, pars_read(1:isc, 1:surf%np), &
4710	start = (/ is0, 1 /), &
4711	count = (/ isc, surf%np /) )
4712	CALL handle_error( 'get_variable_surf', 683, variable_name )
4713
4714	nc_stat = NF90_GET_VAR( id, id_zs, zs, &
4715	start = (/ is0 /), &
4716	count = (/ isc /) )
4717	nc_stat = NF90_GET_VAR( id, id_ys, ys, &
4718	start = (/ is0 /), &
4719	count = (/ isc /) )
4720	nc_stat = NF90_GET_VAR( id, id_xs, xs, &
4721	start = (/ is0 /), &
4722	count = (/ isc /) )
4723	nc_stat = NF90_GET_VAR( id, id_zenith, zenith, &
4724	start = (/ is0 /), &
4725	count = (/ isc /) )
4726	nc_stat = NF90_GET_VAR( id, id_azimuth, azimuth, &
4727	start = (/ is0 /), &
4728	count = (/ isc /) )
4729
4730	DO isurf = 1, isc
4731	!
4732	!-- Parse coordinates, detect if belongs to subdomain
4733	coords = transform_coords( xs(isurf), ys(isurf), &
4734	zenith(isurf), azimuth(isurf) )
4735	IF ( coords(2) < nys .OR. coords(2) > nyn .OR. &
4736	coords(3) < nxl .OR. coords(3) > nxr ) CYCLE
4737	!
4738	!-- Determine maximum terrain under building (base z-coordinate). Using
4739	!-- normal vector to locate building inner coordinates.
4740	oro_max_l = buildings_f%oro_max(coords(2)-coords(5), coords(3)-coords(6))
4741	IF ( oro_max_l == buildings_f%fill1 ) THEN
4742	WRITE( message_string, * ) 'Found building surface on ' // &
4743	'non-building coordinates (xs, ys, zenith, azimuth): ', &
4744	xs(isurf), ys(isurf), zenith(isurf), azimuth(isurf)
4745	CALL message( 'get_variable_surf', 'PA0684', 2, 2, myid, 6, 0 )
4746	ENDIF
4747	!
4748	!-- Urban layer has no stretching, therefore using dz(1) instead of linear
4749	!-- searching through zu/zw
4750	coords(1) = NINT((zs(isurf) + oro_max_l) / dz(1) + &
4751	0.5_wp + 0.5_wp * coords(4), KIND=iwp)
4752	!
4753	!-- Save surface entry
4754	is = surf%index_ji(1, coords(2), coords(3)) + nsurf_ji(coords(2), coords(3))
4755	surf%pars(:,is) = pars_read(isurf,:)
4756	surf%coords(:,is) = coords(:)
4757
4758	nsurf_ji(coords(2), coords(3)) = nsurf_ji(coords(2), coords(3)) + 1
4759	ENDDO
4760
4761	is0 = is0 + isc
4762	ENDDO
4763
4764	DEALLOCATE( pars_read, zs, ys, xs, zenith, azimuth, nsurf_ji )
4765
4766	CONTAINS
4767
4768	PURE FUNCTION transform_coords( x, y, zenith, azimuth )
4769
4770	REAL(wp), INTENT(in) :: x, y !< surface centre coordinates in metres from origin
4771	REAL(wp), INTENT(in) :: zenith !< surface normal zenith angle in degrees
4772	REAL(wp), INTENT(in) :: azimuth !< surface normal azimuth angle in degrees
4773
4774	INTEGER(iwp), DIMENSION(6) :: transform_coords !< (k,j,i,norm_z,norm_y,norm_x)
4775
4776	transform_coords(4) = NINT(COS(zenith*pi/180._wp), KIND=iwp)
4777	IF ( transform_coords(4) == 0 ) THEN
4778	transform_coords(5) = NINT(COS(azimuth*pi/180._wp), KIND=iwp)
4779	transform_coords(6) = NINT(SIN(azimuth*pi/180._wp), KIND=iwp)
4780	ELSE
4781	transform_coords(5) = 0._wp
4782	transform_coords(6) = 0._wp
4783	ENDIF
4784
4785	transform_coords(1) = -999._wp ! not calculated here
4786	transform_coords(2) = NINT(y/dy - 0.5_wp + 0.5_wp*transform_coords(5), KIND=iwp)
4787	transform_coords(3) = NINT(x/dx - 0.5_wp + 0.5_wp*transform_coords(6), KIND=iwp)
4788
4789	END FUNCTION transform_coords
4790
4791	#endif
4792	END SUBROUTINE get_variable_surf
4793
4794
4795	!------------------------------------------------------------------------------!
4796	! Description:
4797	! ------------
4798	!> Reads a 2D REAL variable from a file. Reading is done processor-wise,
4799	!> i.e. each core reads its own domain in slices along x.
4800	!------------------------------------------------------------------------------!
4801	SUBROUTINE get_variable_2d_real( id, variable_name, var, is, ie, js, je )
4802
4803	USE indices
4804	USE pegrid
4805
4806	IMPLICIT NONE
4807
4808	CHARACTER(LEN=*) :: variable_name !< variable name
4809
4810	INTEGER(iwp) :: i !< running index along x direction
4811	INTEGER(iwp) :: ie !< start index for subdomain input along x direction
4812	INTEGER(iwp) :: is !< end index for subdomain input along x direction
4813	INTEGER(iwp), INTENT(IN) :: id !< file id
4814	INTEGER(iwp) :: id_var !< variable id
4815	INTEGER(iwp) :: j !< running index along y direction
4816	INTEGER(iwp) :: je !< start index for subdomain input along y direction
4817	INTEGER(iwp) :: js !< end index for subdomain input along y direction
4818
4819	REAL(wp), DIMENSION(:,:), ALLOCATABLE :: tmp !< temporary variable to read data from file according
4820	!< to its reverse memory access
4821	REAL(wp), DIMENSION(:,:), INTENT(INOUT) :: var !< variable to be read
4822	#if defined( __netcdf )
4823	!
4824	!-- Inquire variable id
4825	nc_stat = NF90_INQ_VARID( id, TRIM( variable_name ), id_var )
4826	!
4827	!-- Check for collective read-operation and set respective NetCDF flags if
4828	!-- required.
4829	IF ( collective_read ) THEN
4830	#if defined( __netcdf4_parallel )
4831	nc_stat = NF90_VAR_PAR_ACCESS (id, id_var, NF90_COLLECTIVE)
4832	#endif
4833	ENDIF
4834
4835	!
4836	!-- Allocate temporary variable according to memory access on file.
4837	ALLOCATE( tmp(is:ie,js:je) )
4838	!
4839	!-- Get variable
4840	nc_stat = NF90_GET_VAR( id, id_var, tmp, &
4841	start = (/ is+1, js+1 /), &
4842	count = (/ ie-is + 1, je-js+1 /) )
4843	CALL handle_error( 'get_variable_2d_real', 530, variable_name )
4844	!
4845	!-- Resort data. Please note, dimension subscripts of var all start at 1.
4846	DO i = is, ie
4847	DO j = js, je
4848	var(j-js+1,i-is+1) = tmp(i,j)
4849	ENDDO
4850	ENDDO
4851
4852	DEALLOCATE( tmp )
4853
4854	#endif
4855	END SUBROUTINE get_variable_2d_real
4856
4857	!------------------------------------------------------------------------------!
4858	! Description:
4859	! ------------
4860	!> Reads a 2D 32-bit INTEGER variable from file. Reading is done processor-wise,
4861	!> i.e. each core reads its own domain in slices along x.
4862	!------------------------------------------------------------------------------!
4863	SUBROUTINE get_variable_2d_int32( id, variable_name, var, is, ie, js, je )
4864
4865	USE indices
4866	USE pegrid
4867
4868	IMPLICIT NONE
4869
4870	CHARACTER(LEN=*) :: variable_name !< variable name
4871
4872	INTEGER(iwp) :: i !< running index along x direction
4873	INTEGER(iwp) :: ie !< start index for subdomain input along x direction
4874	INTEGER(iwp) :: is !< end index for subdomain input along x direction
4875	INTEGER(iwp), INTENT(IN) :: id !< file id
4876	INTEGER(iwp) :: id_var !< variable id
4877	INTEGER(iwp) :: j !< running index along y direction
4878	INTEGER(iwp) :: je !< start index for subdomain input along y direction
4879	INTEGER(iwp) :: js !< end index for subdomain input along y direction
4880
4881	INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE :: tmp !< temporary variable to read data from file according
4882	!< to its reverse memory access
4883	INTEGER(iwp), DIMENSION(:,:), INTENT(INOUT) :: var !< variable to be read
4884	#if defined( __netcdf )
4885	!
4886	!-- Inquire variable id
4887	nc_stat = NF90_INQ_VARID( id, TRIM( variable_name ), id_var )
4888	!
4889	!-- Check for collective read-operation and set respective NetCDF flags if
4890	!-- required.
4891	IF ( collective_read ) THEN
4892	#if defined( __netcdf4_parallel )
4893	nc_stat = NF90_VAR_PAR_ACCESS (id, id_var, NF90_COLLECTIVE)
4894	#endif
4895	ENDIF
4896	!
4897	!-- Allocate temporary variable according to memory access on file.
4898	ALLOCATE( tmp(is:ie,js:je) )
4899	!
4900	!-- Get variable
4901	nc_stat = NF90_GET_VAR( id, id_var, tmp, &
4902	start = (/ is+1, js+1 /), &
4903	count = (/ ie-is + 1, je-js+1 /) )
4904
4905	CALL handle_error( 'get_variable_2d_int32', 531, variable_name )
4906	!
4907	!-- Resort data. Please note, dimension subscripts of var all start at 1.
4908	DO i = is, ie
4909	DO j = js, je
4910	var(j-js+1,i-is+1) = tmp(i,j)
4911	ENDDO
4912	ENDDO
4913
4914	DEALLOCATE( tmp )
4915
4916	#endif
4917	END SUBROUTINE get_variable_2d_int32
4918
4919	!------------------------------------------------------------------------------!
4920	! Description:
4921	! ------------
4922	!> Reads a 2D 8-bit INTEGER variable from file. Reading is done processor-wise,
4923	!> i.e. each core reads its own domain in slices along x.
4924	!------------------------------------------------------------------------------!
4925	SUBROUTINE get_variable_2d_int8( id, variable_name, var, is, ie, js, je )
4926
4927	USE indices
4928	USE pegrid
4929
4930	IMPLICIT NONE
4931
4932	CHARACTER(LEN=*) :: variable_name !< variable name
4933
4934	INTEGER(iwp) :: i !< running index along x direction
4935	INTEGER(iwp) :: ie !< start index for subdomain input along x direction
4936	INTEGER(iwp) :: is !< end index for subdomain input along x direction
4937	INTEGER(iwp), INTENT(IN) :: id !< file id
4938	INTEGER(iwp) :: id_var !< variable id
4939	INTEGER(iwp) :: j !< running index along y direction
4940	INTEGER(iwp) :: je !< start index for subdomain input along y direction
4941	INTEGER(iwp) :: js !< end index for subdomain input along y direction
4942
4943	INTEGER(KIND=1), DIMENSION(:,:), ALLOCATABLE :: tmp !< temporary variable to read data from file according
4944	!< to its reverse memory access
4945	INTEGER(KIND=1), DIMENSION(:,:), INTENT(INOUT) :: var !< variable to be read
4946	#if defined( __netcdf )
4947	!
4948	!-- Inquire variable id
4949	nc_stat = NF90_INQ_VARID( id, TRIM( variable_name ), id_var )
4950	!
4951	!-- Check for collective read-operation and set respective NetCDF flags if
4952	!-- required.
4953	IF ( collective_read ) THEN
4954	#if defined( __netcdf4_parallel )
4955	nc_stat = NF90_VAR_PAR_ACCESS (id, id_var, NF90_COLLECTIVE)
4956	#endif
4957	ENDIF
4958	!
4959	!-- Allocate temporary variable according to memory access on file.
4960	ALLOCATE( tmp(is:ie,js:je) )
4961	!
4962	!-- Get variable
4963	nc_stat = NF90_GET_VAR( id, id_var, tmp, &
4964	start = (/ is+1, js+1 /), &
4965	count = (/ ie-is + 1, je-js+1 /) )
4966
4967	CALL handle_error( 'get_variable_2d_int8', 532, variable_name )
4968	!
4969	!-- Resort data. Please note, dimension subscripts of var all start at 1.
4970	DO i = is, ie
4971	DO j = js, je
4972	var(j-js+1,i-is+1) = tmp(i,j)
4973	ENDDO
4974	ENDDO
4975
4976	DEALLOCATE( tmp )
4977
4978	#endif
4979	END SUBROUTINE get_variable_2d_int8
4980
4981
4982	!------------------------------------------------------------------------------!
4983	! Description:
4984	! ------------
4985	!> Reads a 3D 8-bit INTEGER variable from file.
4986	!------------------------------------------------------------------------------!
4987	SUBROUTINE get_variable_3d_int8( id, variable_name, var, is, ie, js, je, &
4988	ks, ke )
4989
4990	USE indices
4991	USE pegrid
4992
4993	IMPLICIT NONE
4994
4995	CHARACTER(LEN=*) :: variable_name !< variable name
4996
4997	INTEGER(iwp) :: i !< index along x direction
4998	INTEGER(iwp) :: ie !< start index for subdomain input along x direction
4999	INTEGER(iwp) :: is !< end index for subdomain input along x direction
5000	INTEGER(iwp), INTENT(IN) :: id !< file id
5001	INTEGER(iwp) :: id_var !< variable id
5002	INTEGER(iwp) :: j !< index along y direction
5003	INTEGER(iwp) :: je !< start index for subdomain input along y direction
5004	INTEGER(iwp) :: js !< end index for subdomain input along y direction
5005	INTEGER(iwp) :: k !< index along any 3rd dimension
5006	INTEGER(iwp) :: ke !< start index of 3rd dimension
5007	INTEGER(iwp) :: ks !< end index of 3rd dimension
5008
5009	INTEGER(KIND=1), DIMENSION(:,:,:), ALLOCATABLE :: tmp !< temporary variable to read data from file according
5010	!< to its reverse memory access
5011
5012	INTEGER(KIND=1), DIMENSION(:,:,:), INTENT(INOUT) :: var !< variable to be read
5013	#if defined( __netcdf )
5014
5015	!
5016	!-- Inquire variable id
5017	nc_stat = NF90_INQ_VARID( id, TRIM( variable_name ), id_var )
5018	!
5019	!-- Check for collective read-operation and set respective NetCDF flags if
5020	!-- required.
5021	IF ( collective_read ) THEN
5022	#if defined( __netcdf4_parallel )
5023	nc_stat = NF90_VAR_PAR_ACCESS (id, id_var, NF90_COLLECTIVE)
5024	#endif
5025	ENDIF
5026	!
5027	!-- Allocate temporary variable according to memory access on file.
5028	ALLOCATE( tmp(is:ie,js:je,ks:ke) )
5029	!
5030	!-- Get variable
5031	nc_stat = NF90_GET_VAR( id, id_var, tmp, &
5032	start = (/ is+1, js+1, ks+1 /), &
5033	count = (/ ie-is+1, je-js+1, ke-ks+1 /) )
5034
5035	CALL handle_error( 'get_variable_3d_int8', 533, variable_name )
5036	!
5037	!-- Resort data. Please note, dimension subscripts of var all start at 1.
5038	DO i = is, ie
5039	DO j = js, je
5040	DO k = ks, ke
5041	var(k-ks+1,j-js+1,i-is+1) = tmp(i,j,k)
5042	ENDDO
5043	ENDDO
5044	ENDDO
5045
5046	DEALLOCATE( tmp )
5047
5048	#endif
5049	END SUBROUTINE get_variable_3d_int8
5050
5051
5052	!------------------------------------------------------------------------------!
5053	! Description:
5054	! ------------
5055	!> Reads a 3D float variable from file.
5056	!------------------------------------------------------------------------------!
5057	SUBROUTINE get_variable_3d_real( id, variable_name, var, is, ie, js, je, &
5058	ks, ke )
5059
5060	USE indices
5061	USE pegrid
5062
5063	IMPLICIT NONE
5064
5065	CHARACTER(LEN=*) :: variable_name !< variable name
5066
5067	INTEGER(iwp) :: i !< index along x direction
5068	INTEGER(iwp) :: ie !< start index for subdomain input along x direction
5069	INTEGER(iwp) :: is !< end index for subdomain input along x direction
5070	INTEGER(iwp), INTENT(IN) :: id !< file id
5071	INTEGER(iwp) :: id_var !< variable id
5072	INTEGER(iwp) :: j !< index along y direction
5073	INTEGER(iwp) :: je !< start index for subdomain input along y direction
5074	INTEGER(iwp) :: js !< end index for subdomain input along y direction
5075	INTEGER(iwp) :: k !< index along any 3rd dimension
5076	INTEGER(iwp) :: ke !< start index of 3rd dimension
5077	INTEGER(iwp) :: ks !< end index of 3rd dimension
5078
5079	REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: tmp !< temporary variable to read data from file according
5080	!< to its reverse memory access
5081
5082	REAL(wp), DIMENSION(:,:,:), INTENT(INOUT) :: var !< variable to be read
5083	#if defined( __netcdf )
5084
5085	!
5086	!-- Inquire variable id
5087	nc_stat = NF90_INQ_VARID( id, TRIM( variable_name ), id_var )
5088	!
5089	!-- Check for collective read-operation and set respective NetCDF flags if
5090	!-- required.
5091	IF ( collective_read ) THEN
5092	#if defined( __netcdf4_parallel )
5093	nc_stat = NF90_VAR_PAR_ACCESS (id, id_var, NF90_COLLECTIVE)
5094	#endif
5095	ENDIF
5096	!
5097	!-- Allocate temporary variable according to memory access on file.
5098	ALLOCATE( tmp(is:ie,js:je,ks:ke) )
5099	!
5100	!-- Get variable
5101	nc_stat = NF90_GET_VAR( id, id_var, tmp, &
5102	start = (/ is+1, js+1, ks+1 /), &
5103	count = (/ ie-is+1, je-js+1, ke-ks+1 /) )
5104
5105	CALL handle_error( 'get_variable_3d_real', 534, variable_name )
5106	!
5107	!-- Resort data. Please note, dimension subscripts of var all start at 1.
5108	DO i = is, ie
5109	DO j = js, je
5110	DO k = ks, ke
5111	var(k-ks+1,j-js+1,i-is+1) = tmp(i,j,k)
5112	ENDDO
5113	ENDDO
5114	ENDDO
5115
5116	DEALLOCATE( tmp )
5117
5118	#endif
5119	END SUBROUTINE get_variable_3d_real
5120
5121	!------------------------------------------------------------------------------!
5122	! Description:
5123	! ------------
5124	!> Reads a 4D float variable from file.
5125	!------------------------------------------------------------------------------!
5126	SUBROUTINE get_variable_4d_real( id, variable_name, var, is, ie, js, je, &
5127	k1s, k1e, k2s, k2e )
5128
5129	USE indices
5130	USE pegrid
5131
5132	IMPLICIT NONE
5133
5134	CHARACTER(LEN=*) :: variable_name !< variable name
5135
5136	INTEGER(iwp) :: i !< index along x direction
5137	INTEGER(iwp) :: ie !< start index for subdomain input along x direction
5138	INTEGER(iwp) :: is !< end index for subdomain input along x direction
5139	INTEGER(iwp), INTENT(IN) :: id !< file id
5140	INTEGER(iwp) :: id_var !< variable id
5141	INTEGER(iwp) :: j !< index along y direction
5142	INTEGER(iwp) :: je !< start index for subdomain input along y direction
5143	INTEGER(iwp) :: js !< end index for subdomain input along y direction
5144	INTEGER(iwp) :: k1 !< index along 3rd direction
5145	INTEGER(iwp) :: k1e !< start index for 3rd dimension
5146	INTEGER(iwp) :: k1s !< end index for 3rd dimension
5147	INTEGER(iwp) :: k2 !< index along 4th direction
5148	INTEGER(iwp) :: k2e !< start index for 4th dimension
5149	INTEGER(iwp) :: k2s !< end index for 4th dimension
5150
5151	REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: tmp !< temporary variable to read data from file according
5152	!< to its reverse memory access
5153	REAL(wp), DIMENSION(:,:,:,:), INTENT(INOUT) :: var !< variable to be read
5154	#if defined( __netcdf )
5155
5156	!
5157	!-- Inquire variable id
5158	nc_stat = NF90_INQ_VARID( id, TRIM( variable_name ), id_var )
5159	!
5160	!-- Check for collective read-operation and set respective NetCDF flags if
5161	!-- required.
5162	IF ( collective_read ) THEN
5163	#if defined( __netcdf4_parallel )
5164	nc_stat = NF90_VAR_PAR_ACCESS (id, id_var, NF90_COLLECTIVE)
5165	#endif
5166	ENDIF
5167
5168	!
5169	!-- Allocate temporary variable according to memory access on file.
5170	ALLOCATE( tmp(is:ie,js:je,k1s:k1e,k2s:k2e) )
5171	!
5172	!-- Get variable
5173	nc_stat = NF90_GET_VAR( id, id_var, tmp, &
5174	start = (/ is+1, js+1, k1s+1, k2s+1 /), &
5175	count = (/ ie-is+1, je-js+1, k1e-k1s+1, k2e-k2s+1 /) )
5176
5177	CALL handle_error( 'get_variable_4d_real', 535, variable_name )
5178	!
5179	!-- Resort data. Please note, dimension subscripts of var all start at 1.
5180	DO i = is, ie
5181	DO j = js, je
5182	DO k1 = k1s, k1e
5183	DO k2 = k2s, k2e
5184	var(k2-k2s+1,k1-k1s+1,j-js+1,i-is+1) = tmp(i,j,k1,k2)
5185	ENDDO
5186	ENDDO
5187	ENDDO
5188	ENDDO
5189
5190	DEALLOCATE( tmp )
5191
5192	#endif
5193
5194	END SUBROUTINE get_variable_4d_real
5195
5196	!------------------------------------------------------------------------------!
5197	! Description:
5198	! ------------
5199	!> Reads a 4D float variable from file and store it to a 3-d variable.
5200	!------------------------------------------------------------------------------!
5201	SUBROUTINE get_variable_4d_to_3d_real( id, variable_name, var, ns, is, ie, js, je, &
5202	ks, ke )
5203
5204	USE indices
5205	USE pegrid
5206
5207	IMPLICIT NONE
5208
5209	CHARACTER(LEN=*) :: variable_name !< variable name
5210
5211	INTEGER(iwp) :: i !< index along x direction
5212	INTEGER(iwp) :: ie !< end index for subdomain input along x direction
5213	INTEGER(iwp) :: is !< start index for subdomain input along x direction
5214	INTEGER(iwp), INTENT(IN) :: id !< file id
5215	INTEGER(iwp) :: id_var !< variable id
5216	INTEGER(iwp) :: j !< index along y direction
5217	INTEGER(iwp) :: je !< end index for subdomain input along y direction
5218	INTEGER(iwp) :: js !< start index for subdomain input along y direction
5219	INTEGER(iwp) :: k !< index along any 4th dimension
5220	INTEGER(iwp) :: ke !< end index of 4th dimension
5221	INTEGER(iwp) :: ks !< start index of 4th dimension
5222	INTEGER(iwp) :: ns !< start index for subdomain input along n dimension
5223
5224	REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: tmp !< temporary variable to read data from file according
5225	!< to its reverse memory access
5226
5227	REAL(wp), DIMENSION(:,:,:), INTENT(INOUT) :: var !< variable where the read data have to be stored:
5228	!< one dimension is reduced in the process
5229	#if defined( __netcdf )
5230
5231	!
5232	!-- Inquire variable id
5233	nc_stat = NF90_INQ_VARID( id, TRIM( variable_name ), id_var )
5234	!
5235	!-- Check for collective read-operation and set respective NetCDF flags if
5236	!-- required.
5237	IF ( collective_read ) THEN
5238	nc_stat = NF90_VAR_PAR_ACCESS (id, id_var, NF90_COLLECTIVE)
5239	ENDIF
5240	!
5241	!-- Allocate temporary variable according to memory access on file.
5242	ALLOCATE( tmp(is:ie,js:je,ks:ke) )
5243	!
5244	!-- Get variable
5245	nc_stat = NF90_GET_VAR( id, id_var, tmp, &
5246	start = (/ is+1, js+1, ks+1, ns+1 /), &
5247	count = (/ ie-is+1, je-js+1, ke-ks+1, 1 /) )
5248
5249	CALL handle_error( 'get_variable_4d_to_3d_real', 536, variable_name )
5250	!
5251	!-- Resort data. Please note, dimension subscripts of var all start at 1.
5252	DO i = is, ie
5253	DO j = js, je
5254	DO k = ks, ke
5255	var(k-ks+1,j-js+1,i-is+1) = tmp(i,j,k)
5256	ENDDO
5257	ENDDO
5258	ENDDO
5259
5260	DEALLOCATE( tmp )
5261
5262	#endif
5263	END SUBROUTINE get_variable_4d_to_3d_real
5264
5265	!------------------------------------------------------------------------------!
5266	! Description:
5267	! ------------
5268	!> Reads a 3D float variables from dynamic driver, such as time-dependent xy-,
5269	!> xz- or yz-boundary data as well as 3D initialization data. Please note,
5270	!> the passed arguments are start indices and number of elements in each
5271	!> dimension, which is in contrast to the other 3d versions where start- and
5272	!> end indices are passed. The different handling of 3D dynamic variables is
5273	!> due to its asymmetry for the u- and v component.
5274	!------------------------------------------------------------------------------!
5275	SUBROUTINE get_variable_3d_real_dynamic( id, variable_name, var, &
5276	i1s, i2s, i3s, &
5277	count_1, count_2, count_3, &
5278	par_access )
5279
5280	USE indices
5281	USE pegrid
5282
5283	IMPLICIT NONE
5284
5285	CHARACTER(LEN=*) :: variable_name !< variable name
5286
5287	LOGICAL :: par_access !< additional flag indicating whether parallel read operations should be performed or not
5288
5289	INTEGER(iwp) :: count_1 !< number of elements to be read along 1st dimension (with respect to file)
5290	INTEGER(iwp) :: count_2 !< number of elements to be read along 2nd dimension (with respect to file)
5291	INTEGER(iwp) :: count_3 !< number of elements to be read along 3rd dimension (with respect to file)
5292	INTEGER(iwp) :: i1 !< running index along 1st dimension on file
5293	INTEGER(iwp) :: i1s !< start index for subdomain input along 1st dimension (with respect to file)
5294	INTEGER(iwp) :: i2 !< running index along 2nd dimension on file
5295	INTEGER(iwp) :: i2s !< start index for subdomain input along 2nd dimension (with respect to file)
5296	INTEGER(iwp) :: i3 !< running index along 3rd dimension on file
5297	INTEGER(iwp) :: i3s !< start index of 3rd dimension, in dynamic file this is either time (2D boundary) or z (3D)
5298	INTEGER(iwp), INTENT(IN) :: id !< file id
5299	INTEGER(iwp) :: id_var !< variable id
5300	INTEGER(iwp) :: lb1 !< lower bound of 1st dimension (with respect to file)
5301	INTEGER(iwp) :: lb2 !< lower bound of 2nd dimension (with respect to file)
5302	INTEGER(iwp) :: lb3 !< lower bound of 3rd dimension (with respect to file)
5303	INTEGER(iwp) :: ub1 !< upper bound of 1st dimension (with respect to file)
5304	INTEGER(iwp) :: ub2 !< upper bound of 2nd dimension (with respect to file)
5305	INTEGER(iwp) :: ub3 !< upper bound of 3rd dimension (with respect to file)
5306
5307	REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: tmp !< temporary variable to read data from file according
5308	!< to its reverse memory access
5309
5310	REAL(wp), DIMENSION(:,:,:), INTENT(INOUT) :: var !< input variable
5311
5312	#if defined( __netcdf )
5313	!
5314	!-- Inquire variable id.
5315	nc_stat = NF90_INQ_VARID( id, TRIM( variable_name ), id_var )
5316	!
5317	!-- Check for collective read-operation and set respective NetCDF flags if
5318	!-- required.
5319	!-- Please note, in contrast to the other input routines where each PEs
5320	!-- reads its subdomain data, dynamic input data not by all PEs, only
5321	!-- by those which encompass lateral model boundaries. Hence, collective
5322	!-- read operations are only enabled for top-boundary data.
5323	IF ( collective_read .AND. par_access ) THEN
5324	#if defined( __netcdf4_parallel )
5325	nc_stat = NF90_VAR_PAR_ACCESS (id, id_var, NF90_COLLECTIVE)
5326	#endif
5327	ENDIF
5328	!
5329	!-- Allocate temporary variable according to memory access on file.
5330	!-- Therefore, determine dimension bounds of input array.
5331	lb1 = LBOUND(var,3)
5332	ub1 = UBOUND(var,3)
5333	lb2 = LBOUND(var,2)
5334	ub2 = UBOUND(var,2)
5335	lb3 = LBOUND(var,1)
5336	ub3 = UBOUND(var,1)
5337	ALLOCATE( tmp(lb1:ub1,lb2:ub2,lb3:ub3) )
5338	!
5339	!-- Get variable
5340	nc_stat = NF90_GET_VAR( id, id_var, tmp, &
5341	start = (/ i1s, i2s, i3s /), &
5342	count = (/ count_1, count_2, count_3 /) )
5343
5344	CALL handle_error( 'get_variable_3d_real_dynamic', 537, variable_name )
5345	!
5346	!-- Resort data. Please note, dimension subscripts of var all start at 1.
5347	DO i3 = lb3, ub3
5348	DO i2 = lb2, ub2
5349	DO i1 = lb1, ub1
5350	var(i3,i2,i1) = tmp(i1,i2,i3)
5351	ENDDO
5352	ENDDO
5353	ENDDO
5354
5355	DEALLOCATE( tmp )
5356	#endif
5357	END SUBROUTINE get_variable_3d_real_dynamic
5358
5359	!------------------------------------------------------------------------------!
5360	! Description:
5361	! ------------
5362	!> Reads a 5D float variable from file and store it to a 4-d variable.
5363	!------------------------------------------------------------------------------!
5364	SUBROUTINE get_variable_5d_to_4d_real( id, variable_name, var, &
5365	ns, ts, te, is, ie, js, je, ks, ke )
5366
5367	USE indices
5368	USE pegrid
5369
5370	IMPLICIT NONE
5371
5372	CHARACTER(LEN=*) :: variable_name !< variable name
5373
5374	INTEGER(iwp) :: ns !< start index for subdomain input along n dimension:
5375	!< ns coincides here with ne, since, we select only one
5376	!< value along the 1st dimension n
5377
5378	INTEGER(iwp) :: t !< index along t direction
5379	INTEGER(iwp) :: te !< end index for subdomain input along t direction
5380	INTEGER(iwp) :: ts !< start index for subdomain input along t direction
5381
5382	INTEGER(iwp) :: i !< index along x direction
5383	INTEGER(iwp) :: ie !< end index for subdomain input along x direction
5384	INTEGER(iwp) :: is !< start index for subdomain input along x direction
5385	INTEGER(iwp), INTENT(IN) :: id !< file id
5386	INTEGER(iwp) :: id_var !< variable id
5387	INTEGER(iwp) :: j !< index along y direction
5388	INTEGER(iwp) :: je !< end index for subdomain input along y direction
5389	INTEGER(iwp) :: js !< start index for subdomain input along y direction
5390	INTEGER(iwp) :: k !< index along any 5th dimension
5391	INTEGER(iwp) :: ke !< end index of 5th dimension
5392	INTEGER(iwp) :: ks !< start index of 5th dimension
5393
5394	REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: tmp !< temporary variable to read data from file according
5395	! to its reverse memory access
5396	REAL(wp), DIMENSION(:,:,:,:), INTENT(INOUT) :: var !< variable to be read
5397	#if defined( __netcdf )
5398	!
5399	!-- Inquire variable id
5400	nc_stat = NF90_INQ_VARID( id, TRIM( variable_name ), id_var )
5401	!
5402	!-- Check for collective read-operation and set respective NetCDF flags if
5403	!-- required.
5404	IF ( collective_read ) THEN
5405	nc_stat = NF90_VAR_PAR_ACCESS (id, id_var, NF90_COLLECTIVE)
5406	ENDIF
5407	!
5408	!-- Allocate temporary variable according to memory access on file.
5409	ALLOCATE( tmp(ks:ke,js:je,is:is,ts:te) )
5410	!
5411	!-- Get variable
5412	nc_stat = NF90_GET_VAR( id, id_var, tmp, &
5413	start = (/ ks+1, js+1, is+1, ts+1, ns /), &
5414	count = (/ ke-ks+1, je-js+1, ie-is+1, te-ts+1, 1 /) )
5415
5416	CALL handle_error( 'get_variable_5d_to_4d_real', 538, variable_name )
5417	!
5418	!-- Resort data. Please note, dimension subscripts of var all start at 1.
5419
5420	DO t = ts, te
5421	DO i = is, ie
5422	DO j = js, je
5423	DO k = ks, ke
5424	var(t-ts+1,i-is+1,j-js+1,k-ks+1) = tmp(k,j,i,t)
5425	ENDDO
5426	ENDDO
5427	ENDDO
5428	ENDDO
5429
5430	DEALLOCATE( tmp )
5431	#endif
5432	END SUBROUTINE get_variable_5d_to_4d_real
5433
5434
5435	!------------------------------------------------------------------------------!
5436	! Description:
5437	! ------------
5438	!> Reads a 5D float variable from file.
5439	!> NOTE - This subroutine is used specific for reading NC variable
5440	!> emission_values having a "z" dimension. Said dimension
5441	!> is to be removed in the future and this subroutine shall
5442	!> be depreciated accordingly (ecc 20190418)
5443	!------------------------------------------------------------------------------!
5444	SUBROUTINE get_variable_5d_real( id, variable_name, var, is, ie, js, je, &
5445	k1s, k1e, k2s, k2e, k3s, k3e )
5446
5447	USE indices
5448	USE pegrid
5449
5450	IMPLICIT NONE
5451
5452	CHARACTER(LEN=*) :: variable_name !< variable name
5453
5454	INTEGER(iwp) :: i !< i index
5455	INTEGER(iwp) :: ie !< i index start
5456	INTEGER(iwp) :: is !< i index end
5457	INTEGER(iwp) :: id_var !< netCDF variable ID (varid)
5458	INTEGER(iwp) :: j !< j index
5459	INTEGER(iwp) :: je !< j index start
5460	INTEGER(iwp) :: js !< j index end
5461	INTEGER(iwp) :: k1 !< k1 index
5462	INTEGER(iwp) :: k1e !< k1 index start
5463	INTEGER(iwp) :: k1s !< k1 index end
5464	INTEGER(iwp) :: k2 !< k2 index
5465	INTEGER(iwp) :: k2e !< k2 index start
5466	INTEGER(iwp) :: k2s !< k2 index end
5467	INTEGER(iwp) :: k3 !< k3 index
5468	INTEGER(iwp) :: k3e !< k3 index start
5469	INTEGER(iwp) :: k3s !< k3 index end
5470	INTEGER(iwp), INTENT(IN) :: id !< netCDF file ID (ncid)
5471
5472	REAL(wp), DIMENSION(:,:,:,:,:), ALLOCATABLE :: tmp !< temp array to read data from file
5473	REAL(wp), DIMENSION(:,:,:,:,:), INTENT(INOUT) :: var !< variable to be read
5474
5475	#if defined( __netcdf )
5476
5477	!
5478	!-- Inquire variable id
5479
5480	nc_stat = NF90_INQ_VARID( id, TRIM( variable_name ), id_var )
5481
5482	!
5483	!-- Check for collective read-operation and set respective NetCDF flags if required.
5484
5485	IF ( collective_read ) THEN
5486
5487	#if defined( __netcdf4_parallel )
5488	nc_stat = NF90_VAR_PAR_ACCESS (id, id_var, NF90_COLLECTIVE)
5489	#endif
5490
5491	ENDIF
5492
5493	!
5494	!-- Allocate temporary variable according to memory access on file.
5495
5496	ALLOCATE( tmp(is:ie,js:je,k1s:k1e,k2s:k2e,k3s:k3e) )
5497
5498	!
5499	!-- Get variable from file
5500
5501	nc_stat = NF90_GET_VAR ( id, id_var, tmp, &
5502	start = (/ is+1, js+1, k1s+1, k2s+1, k3s+1 /), &
5503	count = (/ ie-is+1, je-js+1, k1e-k1s+1, k2e-k2s+1, k3e-k3s+1 /) )
5504
5505	CALL handle_error( 'get_variable_5d_real', 535, variable_name )
5506
5507	!
5508	!-- Resort (reverse index order) and standardize (from 1 to N) output array
5509
5510	DO i = is, ie
5511	DO j = js, je
5512	DO k1 = k1s, k1e
5513	DO k2 = k2s, k2e
5514	DO k3 = k3s, k3e
5515	var(k3-k3s+1,k2-k2s+1,k1-k1s+1,j-js+1,i-is+1) = tmp(i,j,k1,k2,k3)
5516	ENDDO
5517	ENDDO
5518	ENDDO
5519	ENDDO
5520	ENDDO
5521
5522	DEALLOCATE( tmp )
5523
5524	#endif
5525
5526	END SUBROUTINE get_variable_5d_real
5527
5528
5529	!------------------------------------------------------------------------------!
5530	! Description:
5531	! ------------
5532	!> Reads a 5D float variables from dynamic driver, such as time-dependent xy-,
5533	!> xz- or yz-boundary data as well as 5D initialization data. Please note,
5534	!> the passed arguments are start indices and number of elements in each
5535	!> dimension, which is in contrast to the other 3d versions where start- and
5536	!> end indices are passed. The different handling of 5D dynamic variables is
5537	!> due to its asymmetry for the u- and v component.
5538	!> NOTE(1) - This subroutine is more flexible than get_variable_xd_real as it
5539	!> provides much better control over starting and count indices
5540	!> (ecc 20190418)
5541	!> NOTE(2) - This subroutine is used specific for reading NC variable
5542	!> emission_values having a "z" dimension. Said dimension
5543	!> is to be removed in the future and this subroutine shall
5544	!> be depreciated accordingly (ecc 20190418)
5545	!------------------------------------------------------------------------------!
5546
5547	SUBROUTINE get_variable_5d_real_dynamic( id, variable_name, var, &
5548	i1s, i2s, i3s, i4s, i5s, &
5549	count_1, count_2, count_3, count_4, count_5, &
5550	par_access )
5551
5552	USE indices
5553	USE pegrid
5554
5555	IMPLICIT NONE
5556
5557	CHARACTER(LEN=*) :: variable_name !< variable name
5558
5559	LOGICAL :: par_access !< additional flag indicating parallel read
5560
5561	INTEGER(iwp) :: count_1 !< # elements read in dimension 1 wrt file
5562	INTEGER(iwp) :: count_2 !< # elements read in dimension 2 wrt file
5563	INTEGER(iwp) :: count_3 !< # elements read in dimension 3 wrt file
5564	INTEGER(iwp) :: count_4 !< # elements read in dimension 4 wrt file
5565	INTEGER(iwp) :: count_5 !< # elements read in dimension 5 wrt file
5566	INTEGER(iwp) :: i1 !< index for dimension 1 on file
5567	INTEGER(iwp) :: i1s !< starting index for dimension 1 hyperslab
5568	INTEGER(iwp) :: i2 !< index for dimension 2 on file
5569	INTEGER(iwp) :: i2s !< starting index for dimension 2 hyperslab
5570	INTEGER(iwp) :: i3 !< index for dimension 3 on file
5571	INTEGER(iwp) :: i3s !< starting index for dimension 3 hyperslab
5572	INTEGER(iwp) :: i4 !< index for dimension 4 on file
5573	INTEGER(iwp) :: i4s !< starting index for dimension 4 hyperslab
5574	INTEGER(iwp) :: i5 !< index for dimension 5 on file
5575	INTEGER(iwp) :: i5s !< starting index for dimension 5 hyperslab
5576	INTEGER(iwp) :: id_var !< netCDF variable id (varid)
5577	INTEGER(iwp) :: lb1 !< lower bound of dimension 1 wrt file
5578	INTEGER(iwp) :: lb2 !< lower bound of dimension 2 wrt file
5579	INTEGER(iwp) :: lb3 !< lower bound of dimension 3 wrt file
5580	INTEGER(iwp) :: lb4 !< lower bound of dimension 4 wrt file
5581	INTEGER(iwp) :: lb5 !< lower bound of dimension 5 wrt file
5582	INTEGER(iwp) :: ub1 !< upper bound of dimension 1 wrt file
5583	INTEGER(iwp) :: ub2 !< upper bound of dimension 2 wrt file
5584	INTEGER(iwp) :: ub3 !< upper bound of dimension 3 wrt file
5585	INTEGER(iwp) :: ub4 !< upper bound of dimension 4 wrt file
5586	INTEGER(iwp) :: ub5 !< upper bound of dimension 5 wrt file
5587	INTEGER(iwp), INTENT(IN) :: id !< netCDF file id (ncid)
5588
5589	REAL(wp), DIMENSION(:,:,:,:,:), ALLOCATABLE :: tmp !< temporary variable to read data
5590	!< from file according is reverse
5591	!< array index order
5592	REAL(wp), DIMENSION(:,:,:,:,:), INTENT(INOUT) :: var !< input variable
5593
5594	#if defined( __netcdf )
5595
5596	!
5597	!-- Inquire variable id.
5598
5599	nc_stat = NF90_INQ_VARID( id, TRIM( variable_name ), id_var )
5600
5601	!
5602	!-- Check for collective read-operation and set respective NetCDF flags if required.
5603	!-- Please note, in contrast to the other input routines where each PEs
5604	!-- reads its subdomain data, dynamic input data not by all PEs, only
5605	!-- by those which encompass lateral model boundaries. Hence, collective
5606	!-- read operations are only enabled for top-boundary data.
5607
5608	IF ( collective_read .AND. par_access ) THEN
5609
5610	#if defined( __netcdf4_parallel )
5611	nc_stat = NF90_VAR_PAR_ACCESS (id, id_var, NF90_COLLECTIVE)
5612	#endif
5613
5614	ENDIF
5615
5616	!
5617	!-- Allocate temporary variable according to memory access on file.
5618	!-- Therefore, determine dimension bounds of input array.
5619
5620	lb1 = LBOUND(var,5)
5621	ub1 = UBOUND(var,5)
5622	lb2 = LBOUND(var,4)
5623	ub2 = UBOUND(var,4)
5624	lb3 = LBOUND(var,3)
5625	ub3 = UBOUND(var,3)
5626	lb4 = LBOUND(var,2)
5627	ub4 = UBOUND(var,2)
5628	lb5 = LBOUND(var,1)
5629	ub5 = UBOUND(var,1)
5630	ALLOCATE ( tmp(lb1:ub1,lb2:ub2,lb3:ub3,lb4:ub4,lb5:ub5) )
5631
5632	!
5633	!-- Get variable
5634
5635	nc_stat = NF90_GET_VAR( id, id_var, tmp, &
5636	start = (/ i1s, i2s, i3s, i4s, i5s /), &
5637	count = (/ count_1, count_2, count_3, count_4, count_5 /) )
5638
5639	CALL handle_error( 'get_variable_3d_real_dynamic', 537, variable_name )
5640
5641	!
5642	!-- Assign temp array to output. Note reverse index order
5643
5644	DO i5 = lb5, ub5
5645	DO i4 = lb4, ub4
5646	DO i3 = lb3, ub3
5647	DO i2 = lb2, ub2
5648	DO i1 = lb1, ub1
5649	var(i5,i4,i3,i2,i1) = tmp(i1,i2,i3,i4,i5)
5650	ENDDO
5651	ENDDO
5652	ENDDO
5653	ENDDO
5654	ENDDO
5655
5656	DEALLOCATE( tmp )
5657
5658	#endif
5659
5660	END SUBROUTINE get_variable_5d_real_dynamic
5661
5662
5663	!------------------------------------------------------------------------------!
5664	! Description:
5665	! ------------
5666	!> Inquires the number of variables in a file
5667	!------------------------------------------------------------------------------!
5668	SUBROUTINE inquire_num_variables( id, num_vars )
5669
5670	USE indices
5671	USE pegrid
5672
5673	IMPLICIT NONE
5674
5675	INTEGER(iwp), INTENT(IN) :: id !< file id
5676	INTEGER(iwp), INTENT(INOUT) :: num_vars !< number of variables in a file
5677	#if defined( __netcdf )
5678
5679	nc_stat = NF90_INQUIRE( id, NVARIABLES = num_vars )
5680	CALL handle_error( 'inquire_num_variables', 539 )
5681
5682	#endif
5683	END SUBROUTINE inquire_num_variables
5684
5685
5686	!------------------------------------------------------------------------------!
5687	! Description:
5688	! ------------
5689	!> Inquires the variable names belonging to a file.
5690	!------------------------------------------------------------------------------!
5691	SUBROUTINE inquire_variable_names( id, var_names )
5692
5693	USE indices
5694	USE pegrid
5695
5696	IMPLICIT NONE
5697
5698	CHARACTER(LEN=*), DIMENSION(:), INTENT(INOUT) :: var_names !< return variable - variable names
5699	INTEGER(iwp) :: i !< loop variable
5700	INTEGER(iwp), INTENT(IN) :: id !< file id
5701	INTEGER(iwp) :: num_vars !< number of variables (unused return parameter)
5702	INTEGER(iwp), DIMENSION(:), ALLOCATABLE :: varids !< dummy array to strore variable ids temporarily
5703	#if defined( __netcdf )
5704
5705	ALLOCATE( varids(1:SIZE(var_names)) )
5706	nc_stat = NF90_INQ_VARIDS( id, NVARS = num_vars, VARIDS = varids )
5707	CALL handle_error( 'inquire_variable_names', 540 )
5708
5709	DO i = 1, SIZE(var_names)
5710	nc_stat = NF90_INQUIRE_VARIABLE( id, varids(i), NAME = var_names(i) )
5711	CALL handle_error( 'inquire_variable_names', 540 )
5712	ENDDO
5713
5714	DEALLOCATE( varids )
5715	#endif
5716	END SUBROUTINE inquire_variable_names
5717
5718	!------------------------------------------------------------------------------!
5719	! Description:
5720	! ------------
5721	!> Prints out a text message corresponding to the current status.
5722	!------------------------------------------------------------------------------!
5723	SUBROUTINE handle_error( routine_name, errno, name )
5724
5725	USE control_parameters, &
5726	ONLY: message_string
5727
5728	IMPLICIT NONE
5729
5730	CHARACTER(LEN=6) :: message_identifier !< string for the error number
5731	CHARACTER(LEN=*) :: routine_name !< routine name where the error happened
5732	CHARACTER(LEN=*), OPTIONAL :: name !< name of variable where reading failed
5733
5734	INTEGER(iwp) :: errno
5735	#if defined( __netcdf )
5736
5737	IF ( nc_stat /= NF90_NOERR ) THEN
5738
5739	WRITE( message_identifier, '(''NC'',I4.4)' ) errno
5740
5741	IF ( PRESENT( name ) ) THEN
5742	message_string = "Problem reading attribute/variable - " // &
5743	TRIM(name) // ": " // &
5744	TRIM( NF90_STRERROR( nc_stat ) )
5745	ELSE
5746	message_string = TRIM( NF90_STRERROR( nc_stat ) )
5747	ENDIF
5748
5749	CALL message( routine_name, message_identifier, 2, 2, myid, 6, 1 )
5750
5751	ENDIF
5752
5753	#endif
5754	END SUBROUTINE handle_error
5755
5756
5757	END MODULE netcdf_data_input_mod

Note: See TracBrowser for help on using the repository browser.

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |